File Coverage

lib/Data/HTML/TreeDumper.pm
Criterion Covered Total %
statement 104 105 99.0
branch 29 34 85.2
condition 12 18 66.6
subroutine 23 23 100.0
pod 0 8 0.0
total 168 188 89.3


line stmt bran cond sub pod time code
1             package Data::HTML::TreeDumper;
2 2     2   86988 use 5.010;
  2         67  
3 2     2   12 use strict;
  2         4  
  2         47  
4 2     2   12 use warnings;
  2         8  
  2         106  
5 2     2   15 use utf8;
  2         4  
  2         18  
6 2     2   1149 use Encode;
  2         20965  
  2         145  
7 2     2   16 use Carp qw(croak);
  2         4  
  2         128  
8 2     2   479 use YAML::Syck qw(Load LoadFile Dump DumpFile);
  2         1795  
  2         196  
9 2     2   1020 use Ref::Util qw(is_ref is_scalarref is_arrayref is_hashref);
  2         3225  
  2         161  
10 2     2   925 use Const::Fast;
  2         5329  
  2         12  
11 2     2   1120 use HTML::Entities;
  2         12070  
  2         143  
12              
13 2     2   986 use version 0.77; our $VERSION = version->declare("v0.0.2");
  2         3805  
  2         16  
14              
15             $YAML::Syck::ImplicitUnicode = 1;
16             $YAML::Syck::ImplicitTyping = 1;
17             $YAML::Syck::Headless = 1;
18              
19             const my %default => (
20             ClassKey => 'trdKey',
21             ClassValue => 'trdValue',
22             ClassOrderedList => 'trdOL',
23             ClassUnorderedList => 'trdUL',
24             StartOrderedList => 0,
25             MaxDepth => 32,
26             );
27              
28             #region Class methods
29              
30             sub new {
31 2     2 0 2631 my $class = shift;
32             my $args = {
33             %default,
34             MaxDepth => 8,
35 2 50       24 ( is_hashref( $_[0] ) ? %{ $_[0] } : @_ ),
  0         0  
36             };
37 2         6 my $self = {};
38 2         4 bless $self, $class;
39 2         8 $self->ClassKey( $args->{ClassKey} );
40 2         7 $self->ClassValue( $args->{ClassValue} );
41 2         7 $self->ClassOrderedList( $args->{ClassOrderedList} );
42 2         5 $self->ClassUnorderedList( $args->{ClassUnorderedList} );
43 2         6 $self->StartOrderedList( $args->{StartOrderedList} );
44 2         6 $self->MaxDepth( $args->{MaxDepth} );
45 2         7 return $self;
46             }
47              
48             #endregion
49              
50             #region Properties
51              
52             sub ClassKey {
53 52     52 0 77 my $self = shift;
54 52 100       101 if (@_) {
55 2         8 $self->{ClassKey} = shift;
56             }
57 52         123 return $self->{ClassKey};
58             }
59              
60             sub ClassValue {
61 46     46 0 129 my $self = shift;
62 46 100       95 if (@_) {
63 2         5 $self->{ClassValue} = shift;
64             }
65 46         130 return $self->{ClassValue};
66             }
67              
68             sub ClassOrderedList {
69 16     16 0 218 my $self = shift;
70 16 100       33 if (@_) {
71 2         4 $self->{ClassOrderedList} = shift;
72             }
73 16         36 return $self->{ClassOrderedList};
74             }
75              
76             sub ClassUnorderedList {
77 22     22 0 262 my $self = shift;
78 22 100       43 if (@_) {
79 2         4 $self->{ClassUnorderedList} = shift;
80             }
81 22         135 return $self->{ClassUnorderedList};
82             }
83              
84             sub StartOrderedList {
85 16     16 0 23 my $self = shift;
86 16 100       32 if (@_) {
87 2         5 $self->{StartOrderedList} = shift;
88             }
89 16         75 return $self->{StartOrderedList};
90             }
91              
92             sub MaxDepth {
93 38     38 0 52 my $self = shift;
94 38 100       77 if (@_) {
95 2         3 my $value = shift;
96             $self->{MaxDepth}
97             = $value < 0 ? 0
98             : $value > $default{MaxDepth} ? $default{MaxDepth}
99 2 50       10 : $value;
    50          
100             }
101 38         79 return $self->{MaxDepth};
102             }
103              
104             #endregion
105              
106             #region Instance methods
107              
108             sub dump {
109 67     67 0 18257 my $self = shift;
110 67   100     162 my $x = shift // return $self->_dumpRaw('[undef]');
111 64         126 my $name = $self->_normalizeName( $x, shift );
112 64   100     160 my $depth = shift || 0;
113             my $result
114             = !is_ref($x) ? $self->_dumpRaw( $x, $name )
115 64 50       220 : is_scalarref($x) ? $self->dump( ${$x}, $name, $depth + 1 )
  6 100       17  
    100          
    100          
116             : is_arrayref($x) ? $self->_dumpArray( $x, $name, $depth + 1 )
117             : is_hashref($x) ? $self->_dumpHash( $x, $name, $depth + 1 )
118             : $self->_dumpRaw( $x, $name );
119 64         796 return $result;
120             }
121              
122             sub _normalizeName {
123 142     142   198 my $self = shift;
124 142         185 my $x = shift;
125 142         183 my $name = shift;
126 142   100     390 return $name || ref($x) || 'unnamed';
127             }
128              
129             sub _dumpRaw {
130 42     42   57 my $self = shift;
131 42   50     79 my $x = shift // '';
132 42         68 my $name = $self->_normalizeName( $x, shift );
133 42   50     114 my $depth = shift || 0;
134 42         82 return sprintf( '%s', $self->ClassValue(), encode_entities($x) );
135             }
136              
137             sub _dumpArray {
138 15     15   21 my $self = shift;
139 15   50     31 my $x = shift // '';
140 15         26 my $name = $self->_normalizeName( $x, shift );
141 15   50     34 my $depth = shift || 0;
142 15 100       31 if ( $depth > $self->MaxDepth() ) {
143 1         16 return sprintf( '%s: [...]',
144             $self->ClassKey(), encode_entities($name), $self->ClassValue() );
145             }
146             my $inner
147 14         24 = join( "", map { sprintf( '
  • %s
  • ', $self->dump( $_, undef, $depth ) ); } @{$x} );
      24         50  
      14         28  
    148 14         55 return sprintf(
    149             '
    %s
      %s
    ',
    150             $self->ClassKey(), encode_entities($name),
    151             $self->ClassOrderedList(),
    152             $self->StartOrderedList(), $inner
    153             );
    154             }
    155              
    156             sub _dumpHash {
    157 21     21   36 my $self = shift;
    158 21   50     41 my $x = shift // '';
    159 21         45 my $name = $self->_normalizeName( $x, shift );
    160 21   50     45 my $depth = shift || 0;
    161 21 100       44 if ( $depth > $self->MaxDepth() ) {
    162 1         3 return sprintf( '%s: {...}',
    163             $self->ClassKey(), encode_entities($name), $self->ClassValue() );
    164             }
    165             my $inner = join(
    166             "",
    167             map {
    168             is_arrayref( $x->{$_} )
    169             ? sprintf( '
  • %s
  • ', $self->_dumpArray( $x->{$_}, $_, $depth + 1 ) )
    170             : is_hashref( $x->{$_} )
    171             ? sprintf( '
  • %s
  • ', $self->_dumpHash( $x->{$_}, $_, $depth + 1 ) )
    172             : sprintf( '
  • %s: %s
  • ',
    173 31 100       110 $self->ClassKey(), encode_entities($_), $self->dump( $x->{$_}, $_, $depth + 1 ) )
        50          
    174 20         33 } sort( keys( %{$x} ) )
      20         74  
    175             );
    176 20         66 return sprintf( '
    %s
      %s
    ',
    177             $self->ClassKey(), encode_entities($name), $self->ClassUnorderedList(), $inner );
    178             }
    179              
    180             #endregion
    181              
    182             1;
    183             __END__