File Coverage

blib/lib/Tree/Simple/View/HTML.pm
Criterion Covered Total %
statement 161 163 98.7
branch 66 70 94.2
condition 15 24 62.5
subroutine 23 23 100.0
pod 4 4 100.0
total 269 284 94.7


line stmt bran cond sub pod time code
1              
2             package Tree::Simple::View::HTML;
3              
4 4     4   45177 use strict;
  4         5  
  4         90  
5 4     4   11 use warnings;
  4         5  
  4         120  
6              
7             our $VERSION = '0.19';
8              
9 4     4   1075 use parent 'Tree::Simple::View';
  4         625  
  4         15  
10              
11 4     4   126 use Tree::Simple::View::Exceptions;
  4         4  
  4         71  
12              
13 4     4   12 use constant OPEN_TAG => 1;
  4         4  
  4         224  
14 4     4   14 use constant CLOSE_TAG => 2;
  4         5  
  4         136  
15 4     4   13 use constant EXPANDED => 3;
  4         2  
  4         4273  
16              
17             my(%tags) =
18             (
19             xhtml => { OL => 'ol', UL => 'ul', LI => 'li', STYLE => q{ style='}, CLASS => q{ class='} },
20             html => { OL => 'OL', UL => 'UL', LI => 'LI', STYLE => q{ STYLE='}, CLASS => q{ CLASS='} },
21             );
22              
23             ## public methods
24              
25             sub expandPathSimple {
26 8     8 1 17 my ($self, $tree, $current_path, @path) = @_;
27 8         8 my @results;
28             # if we were not called from this routine, and
29             # include trunk has been turned on then, this is
30             # the first time we have been called, so ...
31 8 100 100     56 if ($self->{include_trunk} && (caller(1))[3] !~ /expandPathSimple$/) {
32 1         3 push @results => '
    ';
33 1         4 push @results => ('
  • ' . $tree->getNodeValue() . '
  • ');
    34             # now recurse but dont change any of the args,
    35             # (if we are supposed to that is, based on the path)
    36 1 50 33     17 push @results => ($self->expandPathSimple($tree, @path))
    37             if (defined $current_path && $tree->getNodeValue() eq $current_path);
    38 1         2 push @results => '';
    39             }
    40             else {
    41 7         8 push @results => '
      ';
    42 7         15 foreach my $child ($tree->getAllChildren()) {
    43 22 100 100     114 if (defined $current_path && $self->_compareNodeToPath($current_path, $child)) {
    44 4         24 push @results => ('
  • ' . $child->getNodeValue() . '
  • ');
    45 4         27 push @results => ($self->expandPathSimple($child, @path));
    46             }
    47             else {
    48 18         68 push @results => ('
  • ' . $child->getNodeValue() . '
  • ');
    49             }
    50             }
    51 7         38 push @results => '';
    52             }
    53 8         34 return (join "\n" => @results);
    54             }
    55              
    56             sub expandPathComplex {
    57 10     10 1 17 my ($self, $tree, $config, $current_path, @path) = @_;
    58             # get the config
    59 10         14 my ($list_func, $list_item_func) = $self->_processConfig($config);
    60              
    61             # use the helper function to recurse
    62             my $_expandPathComplex = sub {
    63 20     20   28 my ($self_func, $list_func, $list_item_func, $tree, $current_path, @path) = @_;
    64 20         372 my @results = ($list_func->(OPEN_TAG));
    65 20         43 foreach my $child ($tree->getAllChildren()) {
    66 64 100 100     225 if (defined $current_path && $self->_compareNodeToPath($current_path, $child)) {
    67 10 50       56 unless ($child->isLeaf()) {
    68 10         229 push @results => ($list_item_func->($child, EXPANDED));
    69 10         57 push @results => ($self_func->($self_func, $list_func, $list_item_func, $child, @path));
    70             }
    71             else {
    72 0         0 push @results => ($list_item_func->($child));
    73             }
    74             }
    75             else {
    76 54         1063 push @results => ($list_item_func->($child));
    77             }
    78             }
    79 20         375 push @results => ($list_func->(CLOSE_TAG));
    80 20         72 return (join "\n" => @results);
    81 10         34 };
    82              
    83 10         8 my @results;
    84 10 100       21 if ($self->{include_trunk}) {
    85 2         35 push @results => ($list_func->(OPEN_TAG));
    86 2 50 33     10 if (defined $current_path && $self->_compareNodeToPath($current_path, $tree)) {
    87 2         65 push @results => ($list_item_func->($tree, EXPANDED));
    88 2         6 push @results => $_expandPathComplex->($_expandPathComplex, $list_func, $list_item_func, $tree, @path);
    89             }
    90             else {
    91 0         0 push @results => ($list_item_func->($tree));
    92             }
    93 2         33 push @results => ($list_func->(CLOSE_TAG));
    94             }
    95             else {
    96 8         16 push @results => $_expandPathComplex->($_expandPathComplex, $list_func, $list_item_func, $tree, $current_path, @path);
    97             }
    98              
    99 10         286 return (join "\n" => @results);
    100             }
    101              
    102             sub expandAllSimple {
    103 2     2 1 7 my ($self) = @_;
    104              
    105 2         4 my @results = ('
      ');
    106 2         4 my $root_depth = $self->{tree}->getDepth() + 1;
    107 2         5 my $last_depth = -1;
    108             my $traversal_sub = sub {
    109 31     31   206 my ($t) = @_;
    110 31         34 my $current_depth = $t->getDepth();
    111 31 100       68 push @results => ('' x ($last_depth - $current_depth)) if ($last_depth > $current_depth);
    112 31         35 push @results => ('
  • ' . $t->getNodeValue() . '
  • ');
    113 31 100       75 push @results => '
      ' unless $t->isLeaf();
    114 31         123 $last_depth = $current_depth;
    115 2         6 };
    116 2 100       5 $traversal_sub->($self->{tree}) if $self->{include_trunk};
    117 2         4 $self->{tree}->traverse($traversal_sub);
    118 2         15 $last_depth -= $root_depth;
    119 2 100       5 $last_depth++ if $self->{include_trunk};
    120 2         4 push @results => ('' x ($last_depth + 1));
    121 2         15 return (join "\n" => @results);
    122             }
    123              
    124             sub expandAllComplex
    125             {
    126 11     11 1 13 my($self, $config) = @_;
    127 11 100       24 my($html5) = $$config{html5} ? 1 : 0;
    128 11         11 my($last_depth) = -1;
    129 11         21 my($list_func, $list_item_func) = $self->_processConfig($config);
    130 10         31 my($root_depth) = $self->{tree}->getDepth + 1;
    131              
    132 10         32 my(@results);
    133              
    134 10 100       18 if ($html5)
    135             {
    136 2         2 @results = ();
    137 2         5 my($css, $expanded_css, $node_formatter) = $self->_processListItemConfig(%$config);
    138 2         3 $css = $expanded_css;
    139             my($pre_sub) = sub
    140             {
    141 13     13   129 my($t) = @_;
    142 13 50       26 my($node_value) = $node_formatter ? $node_formatter->($t) : $t->getNodeValue;
    143              
    144 13 100       31 push @results, "<$tags{html}{UL}$css>" if ($t->isFirstChild);
    145 13         169 push @results, "<$tags{html}{LI}$css>$node_value";
    146 2         7 };
    147             my($post_sub) = sub
    148             {
    149 13     13   114 my($t) = @_;
    150              
    151 13         17 push @results, "";
    152 13 100       18 push @results, "" if ($t->isLastChild);
    153 2         5 };
    154              
    155 2 100       4 if ($self->{include_trunk})
    156             {
    157 1         19 push @results, $list_func->(OPEN_TAG);
    158              
    159 1         2 $pre_sub->($self->{tree});
    160             }
    161              
    162 2         5 $self->{tree}->traverse($pre_sub, $post_sub);
    163              
    164 2 100       40 if ($self->{include_trunk})
    165             {
    166 1         3 $post_sub->($self->{tree});
    167              
    168 1         23 push @results, $list_func->(CLOSE_TAG);
    169             }
    170             }
    171             else
    172             {
    173             my($traversal_sub) = sub
    174             {
    175 122     122   1013 my($t) = @_;
    176 122         174 my($current_depth) = $t->getDepth;
    177              
    178 122 100       817 push @results, ($list_func->(CLOSE_TAG) x ($last_depth - $current_depth) ) if ($last_depth > $current_depth);
    179              
    180 122 100       160 if ($t->isLeaf)
    181             {
    182 80         1619 push @results, ($list_item_func->($t) );
    183             }
    184             else
    185             {
    186 42         875 push @results, $list_item_func->($t, EXPANDED);
    187             }
    188              
    189 122 100       181 push @results, $list_func->(OPEN_TAG) unless $t->isLeaf;
    190              
    191 122         402 $last_depth = $current_depth;
    192 8         29 };
    193              
    194 8         172 push @results, $list_func->(OPEN_TAG);
    195              
    196 8 100       18 $traversal_sub->($self->{tree}) if $self->{include_trunk};
    197 8         21 $self->{tree}->traverse($traversal_sub);
    198              
    199 8         88 $last_depth -= $root_depth;
    200              
    201 8 100       17 $last_depth++ if $self->{include_trunk};
    202              
    203 8         136 push @results, ($list_func->(CLOSE_TAG) x ($last_depth + 1) );
    204             }
    205              
    206 10         253 return (join "\n" => @results);
    207              
    208             } # End of expandAllComplex.
    209              
    210             ## private methods
    211              
    212             # process configurations
    213              
    214             sub _processConfig {
    215 33     33   31 my ($self, $config) = @_;
    216 33         26 my %config = %{$config};
      33         102  
    217              
    218             # Make sure the tag style is always set to something we know &
    219             # set tags to be the hashref of tags we want to save extra indirection later
    220 33 100       77 if ( !exists $config{ tag_style } ) {
        100          
    221 23         30 $config{ tags } = $tags{ html };
    222             }
    223             elsif ( !exists( $tags{ $config{ tag_style } }) ) {
    224 1         12 throw Tree::Simple::View::CompilationFailed "Unknown tag_style $config{ tag_style }";
    225             }
    226             else {
    227 9         12 $config{ tags } = $tags{ $config{ tag_style } };
    228             }
    229              
    230 32   33     64 my $list_func = $self->_buildListFunction(%config)
    231             || throw Tree::Simple::View::CompilationFailed "List function didn't compile", $@;
    232 32   33     106 my $list_item_func = $self->_buildListItemFunction(%config)
    233             || throw Tree::Simple::View::CompilationFailed "List item function didn't compile", $@;
    234              
    235 32         98 return ($list_func, $list_item_func);
    236             }
    237              
    238             ## code strings to be evaluated
    239              
    240 4         197 use constant LIST_FUNCTION_CODE_STRING => q|
    241             sub {
    242             my ($tag_type) = @_;
    243             return '<' . $config{tags}->{$list_type} . ${list_css} . '>' if ($tag_type == OPEN_TAG);
    244             return '{$list_type} .'>' if ($tag_type == CLOSE_TAG);
    245             }
    246 4     4   17 |;
      4         4  
    247              
    248 4         1999 use constant LIST_ITEM_FUNCTION_CODE_STRING => q|;
    249             sub {
    250             my($t, $is_expanded) = @_;
    251             my($item_css) = $list_item_css;
    252             $item_css = $expanded_item_css if ($is_expanded && $expanded_item_css);
    253             my($node_value) = $node_formatter ? $node_formatter->($t) : $t->getNodeValue;
    254              
    255             return "<${$config{tags} }{LI}$item_css>$node_value";
    256             }
    257 4     4   13 |;
      4         4  
    258              
    259             ## list config processing
    260             sub _processListConfig {
    261 32     32   49 my ($self, %config) = @_;
    262              
    263 32         35 my $list_type = 'UL';
    264 32 100       71 $list_type = (($config{list_type} eq 'unordered') ? 'UL' : 'OL') if exists $config{list_type};
        100          
    265              
    266 32         21 my $list_css = '';
    267 32 100       67 if (exists $config{list_css}) {
        100          
    268             # make sure we have a proper ';' at the end
    269             # of the CSS code here, it is needed by the
    270             # DHTML subclass when we add the display property
    271             # to it, no other element requires this so far,
    272             # but if it did, this same idiom could be reused
    273 6         8 my $_list_css = $config{list_css};
    274 6 100       23 $_list_css .= ';' unless ($_list_css =~ /\;$/);
    275 6         16 $list_css = $config{tags}->{STYLE} . "${_list_css}'";
    276             }
    277             elsif (exists $config{list_css_class}) {
    278 9         20 $list_css = $config{tags}->{CLASS} . $config{list_css_class} . "'";
    279             }
    280             # otherwise do nothing and stick with default
    281              
    282 32         66 return ($list_type, $list_css);
    283             }
    284              
    285             sub _buildListFunction {
    286 32     32   59 my ($self, %config) = @_;
    287             # process the configuration directives
    288 32         71 my ($list_type, $list_css) = $self->_processListConfig(%config);
    289             # now compile the subroutine in the current environment
    290 32         4380 return eval $self->LIST_FUNCTION_CODE_STRING;
    291             }
    292              
    293             ## list item config processing
    294              
    295             sub _processListItemConfig {
    296 34     34   51 my ($self, %config) = @_;
    297              
    298 34         58 my $list_item_css = '';
    299 34 100       79 if (exists $config{list_item_css}) {
        100          
    300 6         15 $list_item_css = $config{tags}->{STYLE} . $config{list_item_css} . "'";
    301             }
    302             elsif (exists $config{list_item_css_class}) {
    303 9         20 $list_item_css = $config{tags}->{CLASS} . $config{list_item_css_class} . "'";
    304             }
    305             # otherwise do nothing and stick with default
    306              
    307 34         27 my $expanded_item_css = '';
    308 34 100       70 if (exists $config{expanded_item_css}) {
        100          
    309 6         14 $expanded_item_css = $config{tags}->{STYLE} . $config{expanded_item_css} . "'";
    310             }
    311             elsif (exists $config{expanded_item_css_class}) {
    312 9         15 $expanded_item_css = $config{tags}->{CLASS} . $config{expanded_item_css_class} . "'";
    313             }
    314             # otherwise do nothing and stick with default
    315              
    316 34         29 my $node_formatter;
    317             $node_formatter = $config{node_formatter}
    318 34 100 66     102 if (exists $config{node_formatter} && ref($config{node_formatter}) eq 'CODE');
    319              
    320 34         79 return ($list_item_css, $expanded_item_css, $node_formatter);
    321             }
    322              
    323             sub _buildListItemFunction {
    324 20     20   50 my ($self, %config) = @_;
    325             # process the configuration directives
    326 20         52 my ($list_item_css, $expanded_item_css, $node_formatter) = $self->_processListItemConfig(%config);
    327             # now compile the subroutine in the current environment
    328 20         2509 return eval $self->LIST_ITEM_FUNCTION_CODE_STRING;
    329             }
    330              
    331             1;
    332              
    333             __END__