File Coverage

blib/lib/Data/TreeDumper/Renderer/DHTML.pm
Criterion Covered Total %
statement 15 127 11.8
branch 0 46 0.0
condition 0 6 0.0
subroutine 5 9 55.5
pod 0 4 0.0
total 20 192 10.4


line stmt bran cond sub pod time code
1             package Data::TreeDumper::Renderer::DHTML;
2              
3 1     1   4837 use 5.006;
  1         3  
  1         29  
4 1     1   4 use strict;
  1         1  
  1         23  
5 1     1   4 use warnings;
  1         11  
  1         30  
6              
7             require Exporter;
8 1     1   762 use AutoLoader qw(AUTOLOAD);
  1         1334  
  1         4  
9              
10             our @ISA = qw(Exporter);
11             our %EXPORT_TAGS = ( 'all' => [ qw() ] );
12             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
13             our @EXPORT = qw();
14              
15             our $VERSION = '0.09';
16              
17 1     1   95 use constant DHTML_CLASS => 'data_treedumper_dhtml' ;
  1         3  
  1         1752  
18              
19             my $uuuid = int(rand(100_000)) ;
20              
21             my %ascii_to_html =
22             (
23             '<' => '<',
24             '>' => '>',
25             '&' => '&',
26             "'" => ''',
27             '"' => '"',
28             ' ' => ' ',
29             ) ;
30              
31             #-------------------------------------------------------------------------------------------
32              
33             sub GetRenderer
34             {
35 0     0 0   my $expand_collapse_button_id = "expand_collapse_button_${uuuid}" ;
36 0           $uuuid++ ;
37              
38 0           my $search_button_id = "search_button_${uuuid}" ;
39 0           $uuuid++ ;
40              
41             return
42             (
43             {
44 0           BEGIN => \&RenderDhtmlBegin,
45             NODE => \&RenderDhtmlNode,
46             END => \&RenderDhtmlEnd,
47            
48             # data needed by the renderer
49             EXPAND_COLLAPSE_BUTTON_ID => $expand_collapse_button_id,
50             SEARCH_BUTTON_ID => $search_button_id,
51            
52             PREVIOUS_LEVEL => -1,
53             PREVIOUS_ADDRESS => "c_${uuuid}_ROOT",
54             TABULATION => 0,
55             @_,
56             }
57             ) ;
58             }
59              
60              
61             #-------------------------------------------------------------------------------------------
62              
63             sub RenderDhtmlBegin
64             {
65 0     0 0   my ($title, $td_address, $element, $perl_size, $perl_address, $setup) = @_ ;
66              
67 0   0       my $class = $setup->{RENDERER}{CLASS} || DHTML_CLASS ;
68              
69 0           my $button_container = '' ;
70 0 0         if(exists $setup->{RENDERER}{BUTTON})
71             {
72 0           $button_container .= "
\n" ;
73            
74 0 0         if($setup->{RENDERER}{BUTTON}{COLLAPSE_EXPAND})
75             {
76 0 0         if($setup->{RENDERER}{COLLAPSED})
77             {
78 0           $button_container .= " \n" ;
79             }
80             else
81             {
82 0           $button_container .= " \n" ;
83             }
84             }
85            
86 0 0         if($setup->{RENDERER}{BUTTON}{SEARCH})
87             {
88 0           $button_container .= " \n" ;
89             }
90            
91 0           $button_container .= "\n\n" ;
92             }
93              
94 0           my $collapsed = '' ;
95 0 0         if($setup->{RENDERER}{COLLAPSED})
96             {
97 0           $collapsed = "ul.$class ul {display: none}" ;
98             }
99              
100 0           my $style = <
101            
110             EOS
111              
112 0 0         if(defined $setup->{RENDERER}{STYLE})
113             {
114 0 0         if('SCALAR' eq ref $setup->{RENDERER}{STYLE})
115             {
116 0           ${$setup->{RENDERER}{STYLE}} = $style ;
  0            
117 0           $style = '' ;
118             }
119             else
120             {
121 0           $style = $setup->{RENDERER}{STYLE} ;
122             }
123             }
124            
125 0 0         $style = '' if(exists $setup->{RENDERER}{NO_STYLE}) ;
126              
127 0 0         $perl_size = "<$perl_size>" if $perl_size ne '' ;
128              
129 0 0         my $address = $setup->{DISPLAY_ADDRESS} ? "[$td_address] " : '';
130              
131 0           my $header = <
132            
133            
    • 134             $title $address $perl_size $perl_address
    135             EOH
    136              
    137 0           $setup->{RENDERER}{TABULATION} = 2 ;
    138 0           push @{$setup->{RENDERER}{NODES}{A_IDS}}, "\"a_${uuuid}_ROOT\"";
      0            
    139 0           push @{$setup->{RENDERER}{NODES}{COLLAPSABLE_IDS}}, "\"c_${uuuid}_ROOT\"" ;
      0            
    140              
    141 0           $setup->{RENDERER}{PREVIOUS_ADDRESS} = "c_${uuuid}_ROOT" ;
    142 0           $uuuid++ ;
    143              
    144 0           return($style . $button_container . $header) ;
    145             }
    146              
    147             #-------------------------------------------------------------------------------------------
    148              
    149             sub RenderDhtmlNode
    150             {
    151             my
    152             (
    153 0     0 0   $element,
    154             $level,
    155             $is_terminal,
    156             $previous_level_separator,
    157             $separator,
    158             $element_name,
    159             $element_value,
    160             $td_address,
    161             $address_link,
    162             $perl_size,
    163             $perl_address,
    164             $setup,
    165             ) = @_ ;
    166            
    167             # HTMLify args
    168 0           my $glyph = '' ;
    169 0 0         unless ($setup->{RENDERER}{NO_GLYPH})
    170             {
    171 0           $glyph = $previous_level_separator. $separator ;
    172 0           $glyph =~ s/ / /g ;
    173             }
    174              
    175 0 0         $perl_size = "<$perl_size>" if $perl_size ne '' ;
    176              
    177 0 0         if($element_value ne '')
    178             {
    179 0           $element_value =~ s/(<|>|&|\'|\"|\ )/$ascii_to_html{$1}/eg ;
      0            
    180 0           $element_value = " = $element_value" ;
    181             }
    182              
    183             #setup
    184 0           my $tabulation = $setup->{RENDERER}{TABULATION} ;
    185 0   0       my $class = $setup->{RENDERER}{CLASS} || DHTML_CLASS ;
    186              
    187 0           my $node = '' ;
    188              
    189             # HTML list formating
    190 0 0         if($level > $setup->{RENDERER}{PREVIOUS_LEVEL})
    191             {
    192 0 0         if($setup->{RENDERER}{COLLAPSED})
    193             {
    194 0           $node = ' ' x $tabulation . "
    195             }
    196             else
    197             {
    198 0           $node = ' ' x $tabulation . "
      \n" ;
    199             }
    200            
    201 0           $tabulation++ ;
    202             }
    203             else
    204             {
    205 0 0         if($level < $setup->{RENDERER}{PREVIOUS_LEVEL})
    206             {
    207 0           for (my $i = 0 ; $i < $setup->{RENDERER}{PREVIOUS_LEVEL} - $level ; $i++)
    208             {
    209 0           $tabulation-- ;
    210 0           $node .= ' ' x $tabulation . "\n" ;
    211            
    212 0           $tabulation-- ;
    213 0           $node .= ' ' x $tabulation . "\n" ;
    214             }
    215             }
    216             }
    217              
    218             # keep nodes id for search
    219 0           push @{$setup->{RENDERER}{NODES}{A_IDS}}, "\"a_${uuuid}_$td_address\"" ;
      0            
    220              
    221 0 0         if($is_terminal)
    222             {
    223 0           my $list_format_head = ' ' x $tabulation . "
  • " ;
    • 224 0           my $id = "" ;
    225 0           my $name_value = " $glyph$element_name$element_value" ;
    226            
    227 0           my $address = '' ;
    228 0 0         if($setup->{DISPLAY_ADDRESS})
    229             {
    230 0           $address .= " [$td_address" ;
    231            
    232 0 0         $address .= " -> $address_link" if(defined $address_link) ;
    233            
    234 0           $address .= " ]" ;
    235             }
    236            
    237 0           my $perl_data = " $perl_size $perl_address" ;
    238 0           my $list_format_foot = "" ;
    239            
    240 0           $node .= $list_format_head . $id . $name_value . $address . $perl_data . $list_format_foot . "\n" ;
    241             }
    242             else
    243             {
    244 0 0         if($setup->{RENDERER}{BUTTON}{COLLAPSE_EXPAND})
    245             {
    246 0           push @{$setup->{RENDERER}{NODES}{COLLAPSABLE_IDS}}, "\"c_${uuuid}_$td_address\"" ;
      0            
    247             }
    248            
    249 0           my $list_format_head = (' ' x $tabulation) . "
  • \n" ;
    • 250 0           $tabulation++ ;
    251            
    252 0           my $alignment = ' ' x $tabulation ;
    253            
    254 0           my $id_and_click_head = "" ;
    255 0           my $name_value = "$glyph$element_name$element_value" ;
    256 0           my $id_and_click_foot = "" ;
    257            
    258 0 0         my $address = $setup->{DISPLAY_ADDRESS} ? "[$td_address] " : '';
    259 0           my $perl_data = " $perl_size $perl_address" ;
    260              
    261 0           $node .= $list_format_head . $alignment . $id_and_click_head . $name_value . $id_and_click_foot . $address . $perl_data . "\n";
    262             }
    263            
    264             # setup
    265 0           $setup->{RENDERER}{TABULATION} = $tabulation ;
    266 0           $setup->{RENDERER}{PREVIOUS_LEVEL} = $level ;
    267 0           $setup->{RENDERER}{PREVIOUS_ADDRESS} = "c_${uuuid}_$td_address" ;
    268 0           $uuuid++ ;
    269              
    270 0           return($node) ;
    271             }
    272            
    273             #-------------------------------------------------------------------------------------------
    274              
    275             sub RenderDhtmlEnd
    276             {
    277 0     0 0   my $setup = shift ;
    278              
    279 0           my $closing_ul_li = '' ;
    280 0           my $tabulation = $setup->{RENDERER}{TABULATION} ;
    281              
    282 0           for (my $i = 0 ; $i < $setup->{RENDERER}{PREVIOUS_LEVEL} ; $i++)
    283             {
    284 0           $tabulation-- ;
    285 0           $closing_ul_li .= ' ' x $tabulation . "\n" ;
    286            
    287 0           $tabulation-- ;
    288 0           $closing_ul_li .= ' ' x $tabulation . "\n" ;
    289             }
    290            
    291 0 0         unless(exists $setup->{RENDERER}{BUTTON})
    292             {
    293 0           "$closing_ul_li \n\n" ;
    294             }
    295             else
    296             {
    297 0           my $a_ids = join "\n\t\t, ", @{$setup->{RENDERER}{NODES}{A_IDS}} ;
      0            
    298 0           my $collapsable_ids = join "\n\t\t\t\t, ", @{$setup->{RENDERER}{NODES}{COLLAPSABLE_IDS}} ;
      0            
    299            
    300 0           my $collapsed = 0 ;
    301 0 0         $collapsed++ if($setup->{RENDERER}{COLLAPSED}) ;
    302            
    303 0   0       my $class = $setup->{RENDERER}{CLASS} || DHTML_CLASS ;
    304              
    305             <
    306             $closing_ul_li
    307            
    308            
    309            
    310              
    311            
    504             EOS
    505 0           }
    506             }
    507              
    508             #-------------------------------------------------------------------------------------------
    509             1 ;
    510              
    511             __END__