1 2package Tree::Simple::Visitor::LoadClassHierarchy; 3 4use strict; 5use warnings; 6 7our $VERSION = '0.02'; 8 9use Scalar::Util qw(blessed); 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->{class_to_load} = undef; 25 $self->{include_methods} = 0; 26 $self->SUPER::_init(); 27} 28 29sub setClass { 30 my ($self, $class_to_load) = @_; 31 (defined($class_to_load)) || die "Insufficient Arguments : Must provide a class to load"; 32 $self->{class_to_load} = $class_to_load; 33} 34 35sub includeMethods { 36 my ($self, $boolean) = @_; 37 $self->{include_methods} = ($boolean ? 1 : 0) if defined $boolean; 38 return $self->{include_methods}; 39} 40 41sub visit { 42 my ($self, $tree) = @_; 43 (blessed($tree) && $tree->isa("Tree::Simple")) 44 || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; 45 # it must be a leaf 46 ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a class hierarchy"; 47 (defined $self->{class_to_load}) || die "Insufficient Arguments : Must provide a class to load"; 48 # get the filter 49 my $filter = $self->getNodeFilter(); 50 # get the class to load 51 my $class_to_load = ref($self->{class_to_load}) || $self->{class_to_load}; 52 53 # deal with the include trunk functionality 54 if ($self->includeTrunk()) { 55 $tree->setNodeValue(defined $filter ? $filter->($class_to_load) : $class_to_load); 56 } 57 else { 58 my $new_tree = Tree::Simple->new(defined $filter ? $filter->($class_to_load) : $class_to_load); 59 $tree->addChild($new_tree); 60 if ($self->includeMethods()) { 61 $self->_loadMethods($new_tree, $class_to_load, $filter); 62 } 63 $tree = $new_tree; 64 } 65 66 # and load it recursively 67 $self->_loadClass($tree, $class_to_load, $filter); 68} 69 70sub _loadClass { 71 my ($self, $tree, $class_to_load, $filter) = @_; 72 my @superclasses; 73 { 74 no strict 'refs'; 75 @superclasses = @{"${class_to_load}::ISA"}; 76 } 77 foreach my $superclass (@superclasses) { 78 my $new_tree = Tree::Simple->new(defined $filter ? $filter->($superclass) : $superclass); 79 $tree->addChild($new_tree); 80 if ($self->includeMethods()) { 81 $self->_loadMethods($new_tree, $superclass, $filter); 82 } 83 $self->_loadClass($new_tree, $superclass, $filter); 84 } 85} 86 87sub _loadMethods { 88 my ($self, $tree, $class, $filter) = @_; 89 my @methods; 90 { 91 no strict 'refs'; 92 @methods = sort grep { defined &{"${class}::$_"} } keys %{"${class}::"}; 93 } 94 foreach my $method (@methods) { 95 $tree->addChild(Tree::Simple->new(defined $filter ? $filter->($method) : $method)); 96 } 97} 98 991; 100 101__END__ 102 103=head1 NAME 104 105Tree::Simple::Visitor::LoadClassHierarchy - A Visitor for loading class hierarchies into a Tree::Simple hierarchy 106 107=head1 SYNOPSIS 108 109 use Tree::Simple::Visitor::LoadClassHierarchy; 110 111 # create an visitor 112 my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); 113 114 # set class as an instance, or 115 $visitor->setClass($class); 116 117 # as a package name 118 $visitor->setClass("My::Class"); 119 120 # pass our visitor to the tree 121 $tree->accept($visitor); 122 123 # the $tree now mirrors the inheritance hierarchy of the $class 124 125=head1 DESCRIPTION 126 127This visitor will traverse a class's inheritance hierarchy (through the @ISA arrays) and create a Tree::Simple hierarchy which mirrors it. 128 129=head1 METHODS 130 131=over 4 132 133=item B<new> 134 135There 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. 136 137=item B<includeTrunk ($boolean)> 138 139Setting 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 heirarchy. Setting it to false (C<0>), or not setting it, will result in the first value in the class heirarchy creating a new node level. 140 141=item B<includeMethods ($boolean)> 142 143Setting 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. 144 145B<NOTE:> Methods are sorted ascii-betically before they are added to the tree. This allows a more predictable heirarchy. 146 147=item B<setClass ($class)> 148 149The 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. 150 151=item B<setNodeFilter ($filter_function)> 152 153This 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. 154 155=item B<visit ($tree)> 156 157This 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. 158 159The 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. 160 161=back 162 163=head1 TO DO 164 165=over 166 167=item Improve the C<includeMethods> functionality 168 169I 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. 170 171=item Add C<includeFullSymbolTable> functionality 172 173This 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. 174 175=back 176 177=head1 BUGS 178 179None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. 180 181=head1 CODE COVERAGE 182 183See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion. 184 185=head1 SEE ALSO 186 187These 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. 188 189=head1 AUTHOR 190 191stevan little, E<lt>stevan@iinteractive.comE<gt> 192 193=head1 COPYRIGHT AND LICENSE 194 195Copyright 2004, 2005 by Infinity Interactive, Inc. 196 197L<http://www.iinteractive.com> 198 199This library is free software; you can redistribute it and/or modify 200it under the same terms as Perl itself. 201 202=cut 203 204