File Coverage

blib/lib/Tree/Simple/Visitor/LoadClassHierarchy.pm
Criterion Covered Total %
statement 68 68 100.0
branch 19 26 73.0
condition 3 9 33.3
subroutine 13 13 100.0
pod 4 4 100.0
total 107 120 89.1


line stmt bran cond sub pod time code
1             package Tree::Simple::Visitor::LoadClassHierarchy;
2              
3 1     1   18546 use strict;
  1         2  
  1         25  
4 1     1   3 use warnings;
  1         1  
  1         32  
5              
6             our $VERSION = '0.14';
7              
8 1     1   4 use Scalar::Util qw(blessed);
  1         1  
  1         106  
9              
10 1     1   4 use base qw(Tree::Simple::Visitor);
  1         1  
  1         462  
11              
12             sub new {
13 4     4 1 12061 my ($_class) = @_;
14 4   33     34 my $class = ref($_class) || $_class;
15 4         12 my $visitor = {};
16 4         9 bless($visitor, $class);
17 4         18 $visitor->_init();
18 4         45 return $visitor;
19             }
20              
21             sub _init {
22 4     4   8 my ($self) = @_;
23 4         15 $self->{class_to_load} = undef;
24 4         8 $self->{include_methods} = 0;
25 4         44 $self->SUPER::_init();
26             }
27              
28             sub setClass {
29 4     4 1 6342 my ($self, $class_to_load) = @_;
30 4 50       17 (defined($class_to_load)) || die "Insufficient Arguments : Must provide a class to load";
31 4         15 $self->{class_to_load} = $class_to_load;
32             }
33              
34             sub includeMethods {
35 24     24 1 1116 my ($self, $boolean) = @_;
36 24 50       67 $self->{include_methods} = ($boolean ? 1 : 0) if defined $boolean;
    100          
37 24         66 return $self->{include_methods};
38             }
39              
40             sub visit {
41 4     4 1 4826 my ($self, $tree) = @_;
42 4 50 33     50 (blessed($tree) && $tree->isa("Tree::Simple"))
43             || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
44             # it must be a leaf
45 4 50       21 ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a class hierarchy";
46 4 50       66 (defined $self->{class_to_load}) || die "Insufficient Arguments : Must provide a class to load";
47             # get the filter
48 4         22 my $filter = $self->getNodeFilter();
49             # get the class to load
50 4   33     39 my $class_to_load = ref($self->{class_to_load}) || $self->{class_to_load};
51              
52             # deal with the include trunk functionality
53 4 100       23 if ($self->includeTrunk()) {
54 1 50       37 $tree->setNodeValue(defined $filter ? $filter->($class_to_load) : $class_to_load);
55             }
56             else {
57 3 100       52 my $new_tree = Tree::Simple->new(defined $filter ? $filter->($class_to_load) : $class_to_load);
58 3         112 $tree->addChild($new_tree);
59 3 100       346 if ($self->includeMethods()) {
60 1         6 $self->_loadMethods($new_tree, $class_to_load, $filter);
61             }
62 3         167 $tree = $new_tree;
63             }
64              
65             # and load it recursively
66 4         23 $self->_loadClass($tree, $class_to_load, $filter);
67             }
68              
69             sub _loadClass {
70 24     24   48 my ($self, $tree, $class_to_load, $filter) = @_;
71 24         23 my @superclasses;
72             {
73 1     1   1122 no strict 'refs';
  1         1  
  1         144  
  24         20  
74 24         22 @superclasses = @{"${class_to_load}::ISA"};
  24         162  
75             }
76 24         77 foreach my $superclass (@superclasses) {
77 20 100       77 my $new_tree = Tree::Simple->new(defined $filter ? $filter->($superclass) : $superclass);
78 20         628 $tree->addChild($new_tree);
79 20 100       1807 if ($self->includeMethods()) {
80 2         7 $self->_loadMethods($new_tree, $superclass, $filter);
81             }
82 20         337 $self->_loadClass($new_tree, $superclass, $filter);
83             }
84             }
85              
86             sub _loadMethods {
87 3     3   6 my ($self, $tree, $class, $filter) = @_;
88 3         4 my @methods;
89             {
90 1     1   5 no strict 'refs';
  1         1  
  1         91  
  3         5  
91 3         5 @methods = sort grep { defined &{"${class}::$_"} } keys %{"${class}::"};
  6         6  
  6         34  
  3         17  
92             }
93 3         7 foreach my $method (@methods) {
94 4 50       227 $tree->addChild(Tree::Simple->new(defined $filter ? $filter->($method) : $method));
95             }
96             }
97              
98             1;
99              
100             __END__