local-lib5/lib/perl5/Tree/Simple/Visitor/FindByPath.pm

   1
   2 package Tree::Simple::Visitor::FindByPath;
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.03';
   8
   9 use Scalar::Util qw(blessed);
  10
  11 use base qw(Tree::Simple::Visitor);
  12
  13 sub new {
  14     my ($_class) = @_;
  15     my $class = ref($_class) || $_class;
  16     my $visitor = {};
  17     bless($visitor, $class);
  18     $visitor->_init();
  19     return $visitor;
  20 }
  21
  22 sub _init {
  23     my ($self) = @_;
  24     $self->{search_path} = undef;
  25     $self->{success} = 0;
  26     $self->SUPER::_init();
  27 }
  28
  29 sub setSearchPath {
  30     my ($self, @path) = @_;
  31     (@path) || die "Insufficient Arguments : You must specify a path";
  32     $self->{search_path} = \@path;
  33 }
  34
  35 sub visit {
  36         my ($self, $tree) = @_;
  37         (blessed($tree) && $tree->isa("Tree::Simple"))
  38                 || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
  39
  40     # reset our success flag
  41     $self->{success} = 0;
  42
  43     # get our filter function
  44         my $func;
  45     if ($self->{_filter_function}) {
  46         $func = sub {
  47             my ($tree, $test) = @_;
  48             return (($self->{_filter_function}->($tree) . "") eq $test);
  49             };
  50     }
  51     else {
  52         $func = sub {
  53             my ($tree, $test) = @_;
  54             return (($tree->getNodeValue() . "") eq $test);
  55             };
  56     }
  57
  58     # get ready with our results
  59     my @results;
  60
  61     # get our path
  62     my @path = @{$self->{search_path}};
  63
  64     # get our variables ready
  65     my $current_path;
  66     my $current_tree = $tree;
  67
  68     # check to see if we have been
  69     # asked to include the trunk
  70     if ($self->includeTrunk()) {
  71         # if we dont match the root of the path
  72         # then we have failed already and so return
  73         $self->setResults(()) && return
  74             unless $func->($current_tree, $path[0]);
  75         # if we do match, then remove it off the path
  76         shift @path;
  77     }
  78
  79     TOP: {
  80         # if we have no more @path we have found it
  81         unless (@path) {
  82             # store the current tree as
  83             # our last result
  84             $self->setResults(@results, $current_tree);
  85             # and set the sucess flag
  86             $self->{success} = 1;
  87             return;
  88         }
  89         # otherwise we need to keep looking ...
  90         # get the next element in the path
  91         $current_path = shift @path;
  92         # now check all the current tree's children
  93         # for a match
  94         foreach my $child ($current_tree->getAllChildren()) {
  95             if ($func->($child, $current_path)) {
  96                 # if we find a match, then
  97                 # we store the current tree
  98                 # in our results, and
  99                 push @results => $current_tree;
 100                 # we change our current tree
 101                 $current_tree = $child;
 102                 # and go back to the TOP
 103                 goto TOP;
 104             }
 105         }
 106
 107         # if we do not find a match, then we can fall off
 108         # this block and the whole subroutine for that matter
 109         # since we know the match has failed.
 110         push @results => $current_tree
 111             if (@path || $self->{success} == 0) && $current_tree != $tree;
 112     }
 113     # we do however, store the
 114     # results as far as we got,
 115     # so that the user can maybe
 116     # do something else to recover
 117     $self->setResults(@results);
 118 }
 119
 120 sub getResult {
 121     my ($self) = @_;
 122     # if we did not succeed, then
 123     # we return undef, ...
 124     return undef unless $self->{success};
 125     # otherwise we return the
 126     # last in the results
 127     return $self->getResults()->[-1];
 128 }
 129
 130 1;
 131
 132 __END__
 133
 134 =head1 NAME
 135
 136 Tree::Simple::Visitor::FindByPath - A Visitor for finding an element in a Tree::Simple hierarchy with a path
 137
 138 =head1 SYNOPSIS
 139
 140   use Tree::Simple::Visitor::FindByPath;
 141
 142   # create a visitor object
 143   my $visitor = Tree::Simple::Visitor::FindByPath->new();
 144
 145   # set the search path for our tree
 146   $visitor->setSearchPath(qw(1 1.2 1.2.2));
 147
 148   # pass the visitor to a tree
 149   $tree->accept($visitor);
 150
 151   # fetch the result, which will
 152   # be the Tree::Simple object that
 153   # we have found, or undefined
 154   my $result = $visitor->getResult() || die "No Tree found";
 155
 156   # our result's node value should match
 157   # the last element in our path
 158   print $result->getNodeValue(); # this should print 1.2.2
 159
 160 =head1 DESCRIPTION
 161
 162 Given a path and Tree::Simple hierarchy, this Visitor will attempt to find the node specified by the path.
 163
 164 =head1 METHODS
 165
 166 =over 4
 167
 168 =item B<new>
 169
 170 There are no arguments to the constructor the object will be in its default state. You can use the C<setSearchPath> and C<setNodeFilter> methods to customize its behavior.
 171
 172 =item B<includeTrunk ($boolean)>
 173
 174 Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the search as well.
 175
 176 =item B<setSearchPath (@path)>
 177
 178 This is the path we will attempt to follow down the tree. We will do a stringified comparison of each element of the path and the current tree's node (or the value returned by the node filter if it is set).
 179
 180 =item B<setNodeFilter ($filter_function)>
 181
 182 This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are collected. This can be used to customize output, or to gather specific information from a more complex tree node. The filter function should accept a single argument, which is the current Tree::Simple object.
 183
 184 =item B<visit ($tree)>
 185
 186 This is the method that is used by Tree::Simple's C<accept> method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise.
 187
 188 =item B<getResult>
 189
 190 This method will return the tree found at the specified path (set by the C<setSearchPath> method) or C<undef> if no tree is found.
 191
 192 =item B<getResults>
 193
 194 This method will return the tree's that make up the path specified in C<setSearchPath>. In the case of a failed search, this can be used to find the elements which did successfully match along the way.
 195
 196 =back
 197
 198 =head1 BUGS
 199
 200 None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it.
 201
 202 =head1 CODE COVERAGE
 203
 204 See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion.
 205
 206 =head1 SEE ALSO
 207
 208 These Visitor classes are all subclasses of B<Tree::Simple::Visitor>, which can be found in the B<Tree::Simple> module, you should refer to that module for more information.
 209
 210 =head1 AUTHOR
 211
 212 stevan little, E<lt>stevan@iinteractive.comE<gt>
 213
 214 =head1 COPYRIGHT AND LICENSE
 215
 216 Copyright 2004, 2005 by Infinity Interactive, Inc.
 217
 218 L<http://www.iinteractive.com>
 219
 220 This library is free software; you can redistribute it and/or modify
 221 it under the same terms as Perl itself.
 222
 223 =cut
 224