File Coverage

blib/lib/JSON/ToHTML.pm
Criterion Covered Total %
statement 27 35 77.1
branch 13 26 50.0
condition 1 4 25.0
subroutine 8 8 100.0
pod 0 4 0.0
total 49 77 63.6


line stmt bran cond sub pod time code
1 1     1   154080 use 5.006; use strict; use warnings;
  1     1   4  
  1     1   7  
  1         10  
  1         48  
  1         6  
  1         2  
  1         109  
2              
3             package JSON::ToHTML;
4              
5             our $VERSION = '0.001';
6              
7 1     1   8 use Scalar::Util ();
  1         2  
  1         1046  
8              
9             sub json_object_to_html;
10             sub json_array_to_html;
11              
12             sub json_values_to_html {
13 3     3 0 244625 my $copy;
14             map +(
15             ( not defined $_ ) ? 'null'
16             : 'HASH' eq ref $_ ? json_object_to_html $_
17             : 'ARRAY' eq ref $_ ? json_array_to_html $_
18 3 0 50     24 : eval { $$_ eq 1 or $$_ eq 0 } ? ( $$_ ? 'true' : 'false' )
  4 0       70  
    100          
    50          
    100          
    100          
    50          
19             : Scalar::Util::looks_like_number $_ ? qq'
$_
'
20             : grep s!([<>"'&@\x{80}-\x{10FFFF}])!'&#'.(ord $1).';'!ge || 1, $copy = $_
21             ), @_
22             }
23              
24             sub json_identical_keys {
25 1 50   1 0 6 return if grep 'HASH' ne ref, @_;
26 1         3 my $keyset = join ':', map length . $_, my @sk = sort keys %{ shift @_ };
  1         17  
27 1   0     5 $keyset eq ( join ':', map length . $_, sort keys %$_ ) or return for @_;
28 1         4 @sk;
29             }
30              
31             sub json_object_to_html {
32 1     1 0 3 my ( $o ) = @_;
33              
34 1         4 my @sk = sort keys %$o;
35 1 50       6 return 'empty object' unless @sk;
36              
37 0 0       0 my @ik = @sk > 1 ? json_identical_keys values %$o : ();
38             return
39             ( '
key'
40             . ( join '', json_values_to_html @ik )
41             . '
'
42 0 0       0 . ( join '
', map join( '', json_values_to_html $_, @{ $o->{$_} }{ @ik } ), @sk )
  0         0  
43             . '
'
44             ) if @ik;
45              
46 0         0 my @k = json_values_to_html @sk;
47 0         0 my @v = json_values_to_html @$o{ @sk };
48 0         0 join '', '', ( map "", 0 .. $#k ), '
$k[$_]$v[$_]
'
49             }
50              
51             sub json_array_to_html {
52 2     2 0 5 my ( $a ) = @_;
53              
54 2 100       18 return '
empty array
' unless @$a;
55              
56 1         5 my @ik = json_identical_keys @$a;
57             return
58             ( '
#'
59             . ( join '', json_values_to_html @ik )
60             . '
'
61 1 50       7 . ( join '
', map join( '', "$_", json_values_to_html @{ $a->[$_] }{ @ik } ), 0 .. $#$a )
  1         6  
62             . '
'
63             ) if @ik;
64              
65 0           my $i;
66 0           join '', (
67             '', ', json_values_to_html @$a ),
68             ( map '
'.$i++.qq'
$_
69             '
',
70             );
71             }
72              
73             1;
74              
75             __END__