File Coverage

blib/lib/Tree/Simple/Visitor/VariableDepthClone.pm
Criterion Covered Total %
statement 47 47 100.0
branch 14 14 100.0
condition 4 6 66.6
subroutine 10 10 100.0
pod 4 4 100.0
total 79 81 97.5


line stmt bran cond sub pod time code
1             package Tree::Simple::Visitor::VariableDepthClone;
2              
3 1     1   32923 use strict;
  1         3  
  1         38  
4 1     1   19 use warnings;
  1         3  
  1         39  
5              
6 1     1   6 use Scalar::Util 'blessed';
  1         2  
  1         168  
7              
8             our $VERSION = '0.14';
9              
10 1     1   6 use base qw(Tree::Simple::Visitor);
  1         1  
  1         740  
11              
12             sub new {
13 13     13 1 13443 my ($_class) = @_;
14 13   33     78 my $class = ref($_class) || $_class;
15 13         23 my $visitor = {};
16 13         21 bless($visitor, $class);
17 13         28 $visitor->_init();
18 13         102 return $visitor;
19             }
20              
21             sub _init {
22 13     13   14 my ($self) = @_;
23 13         31 $self->{clone_depth} = undef;
24 13         46 $self->SUPER::_init();
25             }
26              
27             sub setCloneDepth {
28 13     13 1 8078 my ($self, $clone_depth) = @_;
29 13 100       45 (defined($clone_depth))
30             || die "Insufficient Arguments : you must supply a clone depth";
31 12         34 $self->{clone_depth} = $clone_depth;
32             }
33              
34             sub getClone {
35 12     12 1 98 my ($self) = @_;
36 12         33 return $self->getResults()->[0];
37             }
38              
39             sub visit {
40 16     16 1 2462 my ($self, $tree) = @_;
41 16 100 100     187 (blessed($tree) && $tree->isa("Tree::Simple"))
42             || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
43              
44 12         42 my $filter = $self->getNodeFilter();
45              
46             # get a new instance of the root tree type
47 12         110 my $new_root = blessed($tree)->new($tree->ROOT);
48 12         395 my $new_tree = $new_root;
49              
50 12 100       37 if ($self->includeTrunk()) {
51 5         45 my $cloned_trunk = blessed($tree)->new();
52 5         137 $cloned_trunk->setNodeValue(
53             Tree::Simple::_cloneNode($tree->getNodeValue())
54             );
55 5 100       70 $filter->($tree, $cloned_trunk) if defined $filter;
56 5         23 $new_tree->addChild($cloned_trunk);
57 5         339 $new_tree = $cloned_trunk;
58             }
59              
60 12         66 $self->_cloneTree($tree, $new_tree, $self->{clone_depth}, $filter);
61              
62 12         75 $self->setResults($new_root);
63             }
64              
65             sub _cloneTree {
66 33     33   191 my ($self, $tree, $clone, $depth, $filter) = @_;
67 33 100       89 return if $depth <= 0;
68 21         50 foreach my $child ($tree->getAllChildren()) {
69 55         515 my $cloned_child = blessed($child)->new();
70 55         1614 $cloned_child->setNodeValue(
71             Tree::Simple::_cloneNode($child->getNodeValue())
72             );
73 55 100       687 $filter->($child, $cloned_child) if defined $filter;
74 55         188 $clone->addChild($cloned_child);
75 55 100       3859 $self->_cloneTree($child, $cloned_child, $depth - 1, $filter) unless $child->isLeaf();
76             }
77             }
78              
79             1;
80              
81             __END__