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