1package Tree::Simple::Visitor::LoadClassHierarchy; 2 3use strict; 4use warnings; 5 6our $VERSION = '0.16'; 7 8use Scalar::Util qw(blessed); 9 10use base qw(Tree::Simple::Visitor); 11 12sub new { 13 my ($_class) = @_; 14 my $class = ref($_class) || $_class; 15 my $visitor = {}; 16 bless($visitor, $class); 17 $visitor->_init(); 18 return $visitor; 19} 20 21sub _init { 22 my ($self) = @_; 23 $self->{class_to_load} = undef; 24 $self->{include_methods} = 0; 25 $self->SUPER::_init(); 26} 27 28sub setClass { 29 my ($self, $class_to_load) = @_; 30 (defined($class_to_load)) || die "Insufficient Arguments : Must provide a class to load"; 31 $self->{class_to_load} = $class_to_load; 32} 33 34sub includeMethods { 35 my ($self, $boolean) = @_; 36 $self->{include_methods} = ($boolean ? 1 : 0) if defined $boolean; 37 return $self->{include_methods}; 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 # it must be a leaf 45 ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a class hierarchy"; 46 (defined $self->{class_to_load}) || die "Insufficient Arguments : Must provide a class to load"; 47 # get the filter 48 my $filter = $self->getNodeFilter(); 49 # get the class to load 50 my $class_to_load = ref($self->{class_to_load}) || $self->{class_to_load}; 51 52 # deal with the include trunk functionality 53 if ($self->includeTrunk()) { 54 $tree->setNodeValue(defined $filter ? $filter->($class_to_load) : $class_to_load); 55 } 56 else { 57 my $new_tree = Tree::Simple->new(defined $filter ? $filter->($class_to_load) : $class_to_load); 58 $tree->addChild($new_tree); 59 if ($self->includeMethods()) { 60 $self->_loadMethods($new_tree, $class_to_load, $filter); 61 } 62 $tree = $new_tree; 63 } 64 65 # and load it recursively 66 $self->_loadClass($tree, $class_to_load, $filter); 67} 68 69sub _loadClass { 70 my ($self, $tree, $class_to_load, $filter) = @_; 71 my @superclasses; 72 { 73 no strict 'refs'; 74 @superclasses = @{"${class_to_load}::ISA"}; 75 } 76 foreach my $superclass (@superclasses) { 77 my $new_tree = Tree::Simple->new(defined $filter ? $filter->($superclass) : $superclass); 78 $tree->addChild($new_tree); 79 if ($self->includeMethods()) { 80 $self->_loadMethods($new_tree, $superclass, $filter); 81 } 82 $self->_loadClass($new_tree, $superclass, $filter); 83 } 84} 85 86sub _loadMethods { 87 my ($self, $tree, $class, $filter) = @_; 88 my @methods; 89 { 90 no strict 'refs'; 91 @methods = sort grep { defined &{"${class}::$_"} } keys %{"${class}::"}; 92 } 93 foreach my $method (@methods) { 94 $tree->addChild(Tree::Simple->new(defined $filter ? $filter->($method) : $method)); 95 } 96} 97 981; 99 100__END__ 101 102=head1 NAME 103 104Tree::Simple::Visitor::LoadClassHierarchy - A Visitor for loading class hierarchies into a Tree::Simple hierarchy 105 106=head1 SYNOPSIS 107 108 use Tree::Simple::Visitor::LoadClassHierarchy; 109 110 # create an visitor 111 my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); 112 113 # set class as an instance, or 114 $visitor->setClass($class); 115 116 # as a package name 117 $visitor->setClass("My::Class"); 118 119 # pass our visitor to the tree 120 $tree->accept($visitor); 121 122 # the $tree now mirrors the inheritance hierarchy of the $class 123 124=head1 DESCRIPTION 125 126This visitor will traverse a class's inheritance hierarchy (through the @ISA arrays) and create a Tree::Simple hierarchy which mirrors it. 127 128=head1 METHODS 129 130=over 4 131 132=item B<new> 133 134There 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. 135 136=item B<includeTrunk ($boolean)> 137 138Setting the C<$boolean> value to true (C<1>) will cause the node value of the C<$tree> object passed into C<visit> to be set with the root value found in the class hierarchy. Setting it to false (C<0>), or not setting it, will result in the first value in the class hierarchy creating a new node level. 139 140=item B<includeMethods ($boolean)> 141 142Setting the C<$boolean> value to true (C<1>) will cause methods to be added as a children of the class node. Setting it to false (C<0>), or not setting it, will result in this not happening. 143 144B<NOTE:> Methods are sorted ascii-betically before they are added to the tree. This allows a more predictable hierarchy. 145 146=item B<setClass ($class)> 147 148The argument C<$class> should be either a class name or an instance, it is then used as the root from which to determine the class hierarchy. 149 150=item B<setNodeFilter ($filter_function)> 151 152This 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 created, the C<$filter_function> is passed the node value extracted from the hash prior to it being inserted into the tree being built. The C<$filter_function> is expected to return the value desired for inclusion into the tree. 153 154=item B<visit ($tree)> 155 156This 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. 157 158The C<$tree> argument which is passed to C<visit> must be a leaf node. This is because this Visitor will create all the sub-nodes for this tree. If the tree is not a leaf, an exception is thrown. We do not require the tree to be a root though, and this Visitor will not affect any nodes above the C<$tree> argument. 159 160=back 161 162=head1 TO DO 163 164=over 165 166=item Improve the C<includeMethods> functionality 167 168I am not sure the tree this creates is the optimal tree for this situation. It is sufficient for now, until I have more of an I<actual> need for this functionality. 169 170=item Add C<includeFullSymbolTable> functionality 171 172This would traverse the full symbol tables and produce a detailed tree of everything it finds. This takes a lot more work, and as I have no current need for it, it remains in the TO DO list. 173 174=back 175 176=head1 Repository 177 178L<https://github.com/ronsavage/Tree-Simple-VisitorFactory> 179 180=head1 SUPPORT 181 182Bugs should be reported via the CPAN bug tracker at 183 184L<https://github.com/ronsavage/Tree-Simple-VisitorFactory/issues> 185 186=head1 CODE COVERAGE 187 188See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more information. 189 190=head1 SEE ALSO 191 192These 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. 193 194=head1 AUTHOR 195 196stevan little, E<lt>stevan@iinteractive.comE<gt> 197 198=head1 COPYRIGHT AND LICENSE 199 200Copyright 2004, 2005 by Infinity Interactive, Inc. 201 202L<http://www.iinteractive.com> 203 204This library is free software; you can redistribute it and/or modify 205it under the same terms as Perl itself. 206 207=cut 208 209