File Coverage

blib/lib/Tree/Simple/Visitor/FindByUID.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::FindByUID;
2              
3 1     1   19787 use strict;
  1         2  
  1         21  
4 1     1   3 use warnings;
  1         1  
  1         30  
5              
6             our $VERSION = '0.15';
7              
8 1     1   3 use Scalar::Util qw(blessed);
  1         2  
  1         85  
9              
10 1     1   4 use base qw(Tree::Simple::Visitor);
  1         1  
  1         429  
11              
12             sub new {
13 7     7 1 5896 my ($_class) = @_;
14 7   33     24 my $class = ref($_class) || $_class;
15 7         8 my $visitor = {};
16 7         7 bless($visitor, $class);
17 7         15 $visitor->_init();
18 7         33 return $visitor;
19             }
20              
21             sub _init {
22 7     7   2 my ($self) = @_;
23 7         14 $self->{success} = 0;
24 7         7 $self->{UID_to_find} = undef;
25 7         17 $self->SUPER::_init();
26             }
27              
28             sub searchForUID {
29 9     9 1 4520 my ($self, $UID) = @_;
30 9 100       30 (defined($UID)) || die "Insufficient Arguments : You must provide a UID to search for";
31 7         14 $self->{UID_to_find} = $UID;
32             }
33              
34             sub setTraversalMethod {
35 6     6 1 1163 my ($self, $visitor) = @_;
36 6 100 100     57 (blessed($visitor) && $visitor->isa("Tree::Simple::Visitor"))
37             || die "Insufficient Arguments : You must supply a valid Tree::Simple::Visitor object";
38 2         4 $self->{traversal_method} = $visitor;
39             }
40              
41             sub visit {
42 13     13 1 2468 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         10 $self->{success} = 0;
48              
49 9         10 my $UID = $self->{UID_to_find};
50 9 100       19 (defined($UID)) || die "Illegal Operation : You cannot search for a UID 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         5 my $func;
61 8 100       12 if ($self->{_filter_function}) {
62             $func = sub {
63 39     39   362 my ($tree, $test) = @_;
64 39 100 100     43 (($tree->getUID() eq $UID) && $self->{_filter_function}->($tree)) && die $tree;
65 4         15 };
66             }
67             else {
68             $func = sub {
69 22     22   65 my ($tree, $test) = @_;
70 22 100       25 ($tree->getUID() eq $UID) && die $tree;
71 4         19 };
72             }
73              
74             # we eval this so we can catch the tree
75             # match when it is thrown with 'die'
76 8         11 eval {
77 8 100       11 unless (defined($self->{traversal_method})) {
78             # include the trunk in our
79             # search if needed
80 6 100       16 $func->($tree) if $self->includeTrunk();
81             # and traverse
82 5         28 $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         16 $self->{traversal_method}->setNodeFilter($func);
90 2         11 $self->{traversal_method}->visit($tree);
91             }
92             };
93             # now see what we have ...
94 8 100       72 if ($@) {
95             # if we caught a Tree::Simple object
96             # then we have found a match, and ...
97 7 100 100     38 if (blessed($@) && $@->isa('Tree::Simple')) {
98             # we assign it to our results
99 5         15 $self->setResults($@);
100 5         40 $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         9 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         4 $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__