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   80749 use strict;
  1         13  
  1         32  
4 1     1   5 use warnings;
  1         2  
  1         30  
5              
6 1     1   6 use Scalar::Util 'blessed';
  1         2  
  1         115  
7              
8             our $VERSION = '0.16';
9              
10 1     1   8 use base qw(Tree::Simple::Visitor);
  1         2  
  1         863  
11              
12             sub new {
13 13     13 1 12730 my ($_class) = @_;
14 13   33     66 my $class = ref($_class) || $_class;
15 13         30 my $visitor = {};
16 13         30 bless($visitor, $class);
17 13         44 $visitor->_init();
18 13         112 return $visitor;
19             }
20              
21             sub _init {
22 13     13   32 my ($self) = @_;
23 13         40 $self->{clone_depth} = undef;
24 13         43 $self->SUPER::_init();
25             }
26              
27             sub setCloneDepth {
28 13     13 1 5924 my ($self, $clone_depth) = @_;
29 13 100       71 (defined($clone_depth))
30             || die "Insufficient Arguments : you must supply a clone depth";
31 12         38 $self->{clone_depth} = $clone_depth;
32             }
33              
34             sub getClone {
35 12     12 1 115 my ($self) = @_;
36 12         33 return $self->getResults()->[0];
37             }
38              
39             sub visit {
40 16     16 1 1731 my ($self, $tree) = @_;
41 16 100 100     140 (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         106 my $new_root = blessed($tree)->new($tree->ROOT);
48 12         489 my $new_tree = $new_root;
49              
50 12 100       36 if ($self->includeTrunk()) {
51 5         43 my $cloned_trunk = blessed($tree)->new();
52 5         144 $cloned_trunk->setNodeValue(
53             Tree::Simple::_cloneNode($tree->getNodeValue())
54             );
55 5 100       94 $filter->($tree, $cloned_trunk) if defined $filter;
56 5         29 $new_tree->addChild($cloned_trunk);
57 5         452 $new_tree = $cloned_trunk;
58             }
59              
60 12         89 $self->_cloneTree($tree, $new_tree, $self->{clone_depth}, $filter);
61              
62 12         73 $self->setResults($new_root);
63             }
64              
65             sub _cloneTree {
66 33     33   195 my ($self, $tree, $clone, $depth, $filter) = @_;
67 33 100       78 return if $depth <= 0;
68 21         50 foreach my $child ($tree->getAllChildren()) {
69 55         480 my $cloned_child = blessed($child)->new();
70 55         1818 $cloned_child->setNodeValue(
71             Tree::Simple::_cloneNode($child->getNodeValue())
72             );
73 55 100       1128 $filter->($child, $cloned_child) if defined $filter;
74 55         236 $clone->addChild($cloned_child);
75 55 100       4466 $self->_cloneTree($child, $cloned_child, $depth - 1, $filter) unless $child->isLeaf();
76             }
77             }
78              
79             1;
80              
81             __END__