Commit | Line | Data |
3fea05b9 |
1 | |
2 | package Tree::Simple::Visitor::VariableDepthClone; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Scalar::Util 'blessed'; |
8 | |
9 | our $VERSION = '0.03'; |
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->{clone_depth} = undef; |
25 | $self->SUPER::_init(); |
26 | } |
27 | |
28 | sub 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 | |
35 | sub getClone { |
36 | my ($self) = @_; |
37 | return $self->getResults()->[0]; |
38 | } |
39 | |
40 | sub 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 | |
66 | sub _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 | |
80 | 1; |
81 | |
82 | __END__ |
83 | |
84 | =head1 NAME |
85 | |
86 | Tree::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 | |
104 | This visitor will clone |
105 | |
106 | =head1 METHODS |
107 | |
108 | =over 4 |
109 | |
110 | =item B<new> |
111 | |
112 | There 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 | |
116 | Based 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 | |
122 | 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 cloned. |
123 | |
124 | =item B<visit ($tree)> |
125 | |
126 | 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. |
127 | |
128 | =item B<getClone> |
129 | |
130 | This method returns the cloned partial tree. |
131 | |
132 | =back |
133 | |
134 | =head1 BUGS |
135 | |
136 | None 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 | |
140 | See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion. |
141 | |
142 | =head1 SEE ALSO |
143 | |
144 | 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. |
145 | |
146 | =head1 AUTHOR |
147 | |
148 | stevan little, E<lt>stevan@iinteractive.comE<gt> |
149 | |
150 | =head1 COPYRIGHT AND LICENSE |
151 | |
152 | Copyright 2005 by Infinity Interactive, Inc. |
153 | |
154 | L<http://www.iinteractive.com> |
155 | |
156 | This library is free software; you can redistribute it and/or modify |
157 | it under the same terms as Perl itself. |
158 | |
159 | =cut |
160 | |