File Coverage

blib/lib/App/CPANIDX/Renderer.pm
Criterion Covered Total %
statement 45 47 95.7
branch 4 8 50.0
condition 2 5 40.0
subroutine 11 11 100.0
pod 3 3 100.0
total 65 74 87.8


line stmt bran cond sub pod time code
1             package App::CPANIDX::Renderer;
2              
3 2     2   16440 use strict;
  2         3  
  2         49  
4 2     2   6 use warnings;
  2         2  
  2         41  
5 2     2   1029 use YAML::Tiny;
  2         8897  
  2         114  
6 2     2   1643 use JSON::XS;
  2         10607  
  2         185  
7 2     2   1677 use XML::Simple;
  2         15045  
  2         21  
8 2     2   1697 use HTML::Tiny;
  2         4821  
  2         91  
9 2     2   18 use vars qw[$VERSION];
  2         3  
  2         1275  
10              
11             $VERSION = '0.40';
12              
13             my %types = (
14             'yaml', 'application/x-yaml; charset=utf-8',
15             'json', 'application/json; charset=utf-8',
16             'xml', 'application/xml; charset=utf-8',
17             'html', 'text/html',
18             );
19              
20             my %renderers = (
21             'yaml', sub {
22             my $ref = shift;
23             my $string;
24             eval { $string = YAML::Tiny::Dump( $ref ); };
25             return $string;
26             },
27             'json', sub {
28             my $ref = shift;
29             my $string;
30             eval { $string = JSON::XS->new->utf8(1)->pretty(1)->encode( $ref ); };
31             return $string;
32             },
33             'xml', sub {
34             my $ref = shift;
35             my $type = shift || 'opt';
36             my %data;
37             $data{$type} = $ref;
38             my $string;
39             eval { $string = XMLout(\%data, RootName => 'results' ); };
40             return $string;
41             },
42             'html', sub {
43             my $ref = shift;
44             return _gen_html( @{ $ref } );;
45             },
46             );
47              
48             sub renderers {
49 1     1 1 38 return sort keys %renderers;
50             }
51              
52             sub new {
53 4     4 1 1977 my $package = shift;
54 4         5 my $data = shift;
55 4 50 33     25 return unless $data and ref $data eq 'ARRAY';
56 4   50     11 my $format = shift || 'yaml';
57 4         6 $format = lc $format;
58 4 50       6 return unless exists $types{ $format };
59 4         14 bless { _data => $data, _format => $format }, $package;
60             }
61              
62             sub render {
63 4     4 1 820 my $self = shift;
64 4         6 my $type = shift;
65 4         8 my $contype = $types{ $self->{_format} };
66 4         10 my $content = $renderers{ $self->{_format} }->( $self->{_data}, $type );
67 4 50       132 return ($contype, $content) if wantarray;
68 0         0 return [ $contype, $content ];
69             }
70              
71             sub _gen_html {
72 1     1   3 my @results = @_;
73 1         9 my $h = HTML::Tiny->new();
74 1         60 my $data;
75 1 50       4 if ( !scalar @results ) {
76 0         0 $data = $h->p('There were no results, sorry');
77             }
78             else {
79 1         2 my @th = sort keys %{ $results[0] };
  1         5  
80             $data = $h->table( { border => 1, cellspacing => 0, width => '100%' },
81             [
82             \'tr',
83             [ \'th', @th ],
84 1         9 map { my $href = $_;
  1         3  
85 1         4 [ \'td', map { $href->{$_} } sort keys %$href ] } @results,
  3         11  
86             ]
87             );
88             }
89 1         385 return $h->html(
90             [
91             $h->head( $h->title( 'Results' ) ),
92             $h->body(
93             [
94             $data
95             ]
96             )
97             ]
98             );
99             }
100              
101             1;
102              
103             __END__