File Coverage

blib/lib/Tree/Simple/Visitor/FindByPath.pm
Criterion Covered Total %
statement 60 60 100.0
branch 18 18 100.0
condition 9 14 64.2
subroutine 11 11 100.0
pod 4 4 100.0
total 102 107 95.3


line stmt bran cond sub pod time code
1             package Tree::Simple::Visitor::FindByPath;
2              
3 2     2   61192 use strict;
  2         11  
  2         48  
4 2     2   8 use warnings;
  2         4  
  2         66  
5              
6             our $VERSION = '0.16';
7              
8 2     2   10 use Scalar::Util qw(blessed);
  2         3  
  2         85  
9              
10 2     2   18 use base qw(Tree::Simple::Visitor);
  2         3  
  2         1001  
11              
12             sub new {
13 2     2 1 2843 my ($_class) = @_;
14 2   33     13 my $class = ref($_class) || $_class;
15 2         3 my $visitor = {};
16 2         5 bless($visitor, $class);
17 2         5 $visitor->_init();
18 2         17 return $visitor;
19             }
20              
21             sub _init {
22 2     2   4 my ($self) = @_;
23 2         10 $self->{search_path} = undef;
24 2         4 $self->{success} = 0;
25 2         10 $self->SUPER::_init();
26             }
27              
28             sub setSearchPath {
29 8     8 1 12491 my ($self, @path) = @_;
30 8 100       28 (@path) || die "Insufficient Arguments : You must specify a path";
31 7         19 $self->{search_path} = \@path;
32             }
33              
34             sub visit {
35 11     11 1 1400 my ($self, $tree) = @_;
36 11 100 100     81 (blessed($tree) && $tree->isa("Tree::Simple"))
37             || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
38              
39             # reset our success flag
40 7         11 $self->{success} = 0;
41              
42             # get our filter function
43 7         10 my $func;
44 7 100       16 if ($self->{_filter_function}) {
45             $func = sub {
46 12     12   19 my ($tree, $test) = @_;
47 12         18 return (($self->{_filter_function}->($tree) . "") eq $test);
48 3         11 };
49             }
50             else {
51             $func = sub {
52 18     18   24 my ($tree, $test) = @_;
53 18         37 return (($tree->getNodeValue() . "") eq $test);
54 4         31 };
55             }
56              
57             # get ready with our results
58 7         12 my @results;
59              
60             # get our path
61 7         9 my @path = @{$self->{search_path}};
  7         23  
62              
63             # get our variables ready
64 7         9 my $current_path;
65 7         24 my $current_tree = $tree;
66              
67             # check to see if we have been
68             # asked to include the trunk
69 7 100       20 if ($self->includeTrunk()) {
70             # if we don't match the root of the path
71             # then we have failed already and so return
72 2 100 50     13 $self->setResults(()) && return
73             unless $func->($current_tree, $path[0]);
74             # if we do match, then remove it off the path
75 1         7 shift @path;
76             }
77              
78             TOP: {
79             # if we have no more @path we have found it
80 16 100       49 unless (@path) {
  16         27  
81             # store the current tree as
82             # our last result
83 2         9 $self->setResults(@results, $current_tree);
84             # and set the success flag
85 2         11 $self->{success} = 1;
86 2         9 return;
87             }
88             # otherwise we need to keep looking ...
89             # get the next element in the path
90 14         19 $current_path = shift @path;
91             # now check all the current tree's children
92             # for a match
93 14         26 foreach my $child ($current_tree->getAllChildren()) {
94 28 100       145 if ($func->($child, $current_path)) {
95             # if we find a match, then
96             # we store the current tree
97             # in our results, and
98 10         50 push @results => $current_tree;
99             # we change our current tree
100 10         12 $current_tree = $child;
101             # and go back to the TOP
102 10         46 goto TOP;
103             }
104             }
105              
106             # if we do not find a match, then we can fall off
107             # this block and the whole subroutine for that matter
108             # since we know the match has failed.
109             push @results => $current_tree
110 4 100 66     29 if (@path || $self->{success} == 0) && $current_tree != $tree;
      66        
111             }
112             # we do however, store the
113             # results as far as we got,
114             # so that the user can maybe
115             # do something else to recover
116 4         10 $self->setResults(@results);
117             }
118              
119             sub getResult {
120 7     7 1 63 my ($self) = @_;
121             # if we did not succeed, then
122             # we return undef, ...
123 7 100       27 return undef unless $self->{success};
124             # otherwise we return the
125             # last in the results
126 2         7 return $self->getResults()->[-1];
127             }
128              
129             1;
130              
131             __END__