File Coverage

blib/lib/HTML/Tested/Value/Tree.pm
Criterion Covered Total %
statement 59 59 100.0
branch 16 16 100.0
condition 13 13 100.0
subroutine 11 11 100.0
pod 1 2 50.0
total 100 101 99.0


line stmt bran cond sub pod time code
1 1     1   184710 use strict;
  1         3  
  1         832  
2 1     1   8 use warnings FATAL => 'all';
  1         2  
  1         2692  
3              
4             package HTML::Tested::Value::Tree;
5 1     1   14 use base 'HTML::Tested::Value';
  1         2  
  1         4020  
6              
7 4     4 0 15 sub transform_value { return $_[2]; }
8              
9             sub _render_from_selection_tree {
10 15     15   36 my ($self, $context, $nodes, $sel_tree, $ident) = @_;
11 15         32 my $res = "$ident
    \n";
12 15         35 for my $n (@$nodes) {
13 27         49 my $sa = $context->{selection_attribute};
14 27 100       83 my $n_sel = $sa ? $sel_tree->{ $n->{ $sa } } : undef;
15 27         52 my $new_ident = "$ident ";
16 27         738 $res .= "$new_ident
  • \n";
  • 17 27 100       58 if ($n_sel) {
    18 14         51 $res .= $self->_render_selected_node(
    19             $context, $n, "$new_ident ");
    20 14 100       93 $res .= $self->_render_from_selection_tree(
    21             $context, $n->{children}, $n_sel,
    22             "$ident ") if $n->{children};
    23             } else {
    24 13         60 $res .= $self->_render_collapsed_node(
    25             $context, $n, "$new_ident ");
    26             }
    27 27         84 $res .= "$new_ident\n";
    28             }
    29 15         105 return $res . "$ident\n";
    30             }
    31              
    32             sub _build_selection_tree {
    33 8     8   16 my ($self, $nodes, $selections, $sel_attr) = @_;
    34 8         16 my $tree = {};
    35 8         23 for my $n (@$nodes) {
    36 14         27 my $v = $n->{$sel_attr};
    37 14         21 my $nt = {};
    38 14 100       43 if (my $c = $n->{children}) {
    39 5         28 $nt = $self->_build_selection_tree(
    40             $c, $selections, $sel_attr);
    41             }
    42 14 100 100     84 next unless (%$nt || $selections->{$v});
    43 8         29 $tree->{$v} = $nt;
    44             }
    45 8         21 return $tree;
    46             }
    47              
    48             sub _get_tree_option {
    49 28     28   84 my ($self, $caller, $val, $opt) = @_;
    50 28         46 my $res = $val->{$opt};
    51 28 100 100     137 return $res if ($res || !$caller);
    52              
    53 15         54 $res = $caller->ht_get_widget_option($self->name, $opt);
    54 15         51 $val->{$opt} = $res;
    55 15         27 return $res;
    56             }
    57              
    58             sub value_to_string {
    59 7     7 1 50 my ($self, $name, $val, $caller) = @_;
    60              
    61             # Copy var aside, we'll modify it in _get_tree_option
    62 7 100       44 $val = $val ? { %$val } : {};
    63              
    64 7         31 my $input = $self->_get_tree_option($caller, $val, 'input_tree');
    65 7         22 my $sel_attr = $self->_get_tree_option($caller, $val
    66             , 'selection_attribute');
    67              
    68             # Put those into context
    69 7         25 $self->_get_tree_option($caller, $val, 'collapsed_format');
    70 7         23 $self->_get_tree_option($caller, $val, 'selected_format');
    71              
    72 7         16 my $tree = $val->{selection_tree};
    73 4         25 $tree = $self->_build_selection_tree($input
    74 7 100 100     44 , { map { ($_, 1) } @{ $val->{selections} } }
      3         10  
    75             , $sel_attr) if (!$tree && $sel_attr);
    76 7         40 return $self->_render_from_selection_tree($val, $input, $tree, '');
    77             }
    78              
    79             sub _render_from_format {
    80 27     27   51 my ($self, $format, $node, $ident) = @_;
    81 27         1348 my $res = $ident . $format . "\n";
    82 27         209 while (my ($n, $v) = each %$node) {
    83 52         729 $res =~ s/\%$n\%/$v/g;
    84             }
    85 27         92 return $res;
    86             }
    87              
    88             sub _render_selected_node {
    89 14     14   23 my ($self, $context, $node, $ident) = @_;
    90 14   100     68 return $self->_render_from_format($context->{selected_format}
    91             || '%value%'
    92             , $node, $ident);
    93             }
    94              
    95             sub _render_collapsed_node {
    96 13     13   27 my ($self, $context, $node, $ident) = @_;
    97 13   100     62 return $self->_render_from_format($context->{collapsed_format}
    98             || '%value%', $node, $ident);
    99             }
    100              
    101             1;