1 2package Tree::Simple::Visitor::VariableDepthClone; 3 4use strict; 5use warnings; 6 7use Scalar::Util 'blessed'; 8 9our $VERSION = '0.03'; 10 11use base qw(Tree::Simple::Visitor); 12 13sub 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 22sub _init { 23 my ($self) = @_; 24 $self->{clone_depth} = undef; 25 $self->SUPER::_init(); 26} 27 28sub setCloneDepth { 29 my ($self, $clone_depth) = @_; 30 (defined($clone_depth)) 31 || die "Insufficient Arguments : you must supply a clone depth"; 32 $self->{clone_depth} = $clone_depth; 33} 34 35sub getClone { 36 my ($self) = @_; 37 return $self->getResults()->[0]; 38} 39 40sub visit { 41 my ($self, $tree) = @_; 42 (blessed($tree) && $tree->isa("Tree::Simple")) 43 || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; 44 45 my $filter = $self->getNodeFilter(); 46 47 # get a new instance of the root tree type 48 my $new_root = blessed($tree)->new($tree->ROOT); 49 my $new_tree = $new_root; 50 51 if ($self->includeTrunk()) { 52 my $cloned_trunk = blessed($tree)->new(); 53 $cloned_trunk->setNodeValue( 54 Tree::Simple::_cloneNode($tree->getNodeValue()) 55 ); 56 $filter->($tree, $cloned_trunk) if defined $filter; 57 $new_tree->addChild($cloned_trunk); 58 $new_tree = $cloned_trunk; 59 } 60 61 $self->_cloneTree($tree, $new_tree, $self->{clone_depth}, $filter); 62 63 $self->setResults($new_root); 64} 65 66sub _cloneTree { 67 my ($self, $tree, $clone, $depth, $filter) = @_; 68 return if $depth <= 0; 69 foreach my $child ($tree->getAllChildren()) { 70 my $cloned_child = blessed($child)->new(); 71 $cloned_child->setNodeValue( 72 Tree::Simple::_cloneNode($child->getNodeValue()) 73 ); 74 $filter->($child, $cloned_child) if defined $filter; 75 $clone->addChild($cloned_child); 76 $self->_cloneTree($child, $cloned_child, $depth - 1, $filter) unless $child->isLeaf(); 77 } 78} 79 801; 81 82__END__ 83 84=head1 NAME 85 86Tree::Simple::Visitor::VariableDepthClone - A Visitor for cloning parts of Tree::Simple hierarchy 87 88=head1 SYNOPSIS 89 90 use Tree::Simple::Visitor::VariableDepthClone; 91 92 # create an visitor 93 my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); 94 95 $visitor->setCloneDepth(3); 96 97 # pass our visitor to the tree 98 $tree->accept($visitor); 99 100 my $partial_tree = $visitor->getClone(); 101 102=head1 DESCRIPTION 103 104This visitor will clone 105 106=head1 METHODS 107 108=over 4 109 110=item B<new> 111 112There are no arguments to the constructor the object will be in its default state. You can use the C<setNodeFilter> method to customize its behavior. 113 114=item B<includeTrunk ($boolean)> 115 116Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the traversal as well. This basically means it will clone the root node as well. 117 118=item B<setCloneDepth ($number)> 119 120=item B<setNodeFilter ($filter_function)> 121 122This 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 cloned. 123 124=item B<visit ($tree)> 125 126This 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. 127 128=item B<getClone> 129 130This method returns the cloned partial tree. 131 132=back 133 134=head1 BUGS 135 136None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. 137 138=head1 CODE COVERAGE 139 140See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion. 141 142=head1 SEE ALSO 143 144These 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. 145 146=head1 AUTHOR 147 148stevan little, E<lt>stevan@iinteractive.comE<gt> 149 150=head1 COPYRIGHT AND LICENSE 151 152Copyright 2005 by Infinity Interactive, Inc. 153 154L<http://www.iinteractive.com> 155 156This library is free software; you can redistribute it and/or modify 157it under the same terms as Perl itself. 158 159=cut 160 161