File Coverage

blib/lib/Tree/Simple/Visitor/FindByNodeValue.pm
Criterion Covered Total %
statement 57 57 100.0
branch 26 26 100.0
condition 13 15 86.6
subroutine 12 12 100.0
pod 5 5 100.0
total 113 115 98.2


line stmt bran cond sub pod time code
1             package Tree::Simple::Visitor::FindByNodeValue;
2              
3 1     1   20297 use strict;
  1         2  
  1         25  
4 1     1   3 use warnings;
  1         2  
  1         33  
5              
6             our $VERSION = '0.15';
7              
8 1     1   3 use Scalar::Util qw(blessed);
  1         1  
  1         99  
9              
10 1     1   4 use base qw(Tree::Simple::Visitor);
  1         1  
  1         426  
11              
12             sub new {
13 7     7 1 5940 my ($_class) = @_;
14 7   33     28 my $class = ref($_class) || $_class;
15 7         7 my $visitor = {};
16 7         8 bless($visitor, $class);
17 7         11 $visitor->_init();
18 7         35 return $visitor;
19             }
20              
21             sub _init {
22 7     7   7 my ($self) = @_;
23 7         13 $self->{success} = 0;
24 7         12 $self->{node_value_to_find} = undef;
25 7         19 $self->SUPER::_init();
26             }
27              
28             sub searchForNodeValue {
29 9     9 1 4648 my ($self, $node_value) = @_;
30 9 100       32 (defined($node_value)) || die "Insufficient Arguments : You must provide a node value to search for";
31 7         14 $self->{node_value_to_find} = $node_value;
32             }
33              
34             sub setTraversalMethod {
35 6     6 1 1202 my ($self, $visitor) = @_;
36 6 100 100     74 (blessed($visitor) && $visitor->isa("Tree::Simple::Visitor"))
37             || die "Insufficient Arguments : You must supply a valid Tree::Simple::Visitor object";
38 2         5 $self->{traversal_method} = $visitor;
39             }
40              
41             sub visit {
42 13     13 1 2264 my ($self, $tree) = @_;
43 13 100 100     105 (blessed($tree) && $tree->isa("Tree::Simple"))
44             || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
45              
46             # reset our success flag
47 9         12 $self->{success} = 0;
48              
49 9         9 my $node_value = $self->{node_value_to_find};
50 9 100       19 (defined($node_value)) || die "Illegal Operation : You cannot search for a node_value without setting one first";
51             # create our filter function
52             # NOTE:
53             # in order to get an immediate exit
54             # from the traversal once a match is
55             # found, we use 'die'. It is a somewhat
56             # unorthodox way of using this, but it
57             # works. The found tree is propagated
58             # up the call chain and returned from
59             # this function.
60 8         8 my $func;
61 8 100       17 if ($self->{_filter_function}) {
62             $func = sub {
63 39     39   368 my ($tree, $test) = @_;
64 39 100 100     47 (($tree->getNodeValue() eq $node_value) && $self->{_filter_function}->($tree)) && die $tree;
65 4         14 };
66             }
67             else {
68             $func = sub {
69 22     22   69 my ($tree, $test) = @_;
70 22 100       26 ($tree->getNodeValue() eq $node_value) && die $tree;
71 4         16 };
72             }
73              
74             # we eval this so we can catch the tree
75             # match when it is thrown with 'die'
76 8         10 eval {
77 8 100       16 unless (defined($self->{traversal_method})) {
78             # include the trunk in our
79             # search if needed
80 6 100       15 $func->($tree) if $self->includeTrunk();
81             # and traverse
82 5         31 $tree->traverse($func);
83             }
84             else {
85             # include the trunk in our
86             # search if needed
87 2 100       4 $self->{traversal_method}->includeTrunk(1) if $self->includeTrunk();
88             # and visit
89 2         18 $self->{traversal_method}->setNodeFilter($func);
90 2         11 $self->{traversal_method}->visit($tree);
91             }
92             };
93             # now see what we have ...
94 8 100       79 if ($@) {
95             # if we caught a Tree::Simple object
96             # then we have found a match, and ...
97 7 100 100     37 if (blessed($@) && $@->isa('Tree::Simple')) {
98             # we assign it to our results
99 5         16 $self->setResults($@);
100 5         44 $self->{success} = 1;
101             }
102             # however, if it is not a Tree::Simple
103             # object then it is likely a real exception
104             else {
105             # so we re-throw it
106 2         10 die $@;
107             }
108             }
109             else {
110             # if no exception is thrown though,
111             # we failed in our search, and so we
112             # set our success flag to false
113 1         5 $self->{success} = 0;
114             }
115             }
116              
117             sub getResult {
118 6     6 1 13 my ($self) = @_;
119             # if we did not succeed, then
120             # we return undef, ...
121 6 100       13 return undef unless $self->{success};
122             # otherwise we return the results
123 5         10 return $self->getResults()->[0];
124             }
125              
126             1;
127              
128             __END__