local-lib5/lib/perl5/Tree/Simple/Visitor/LoadClassHierarchy.pm

   1
   2 package Tree::Simple::Visitor::LoadClassHierarchy;
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.02';
   8
   9 use Scalar::Util qw(blessed);
  10
  11 use base qw(Tree::Simple::Visitor);
  12
  13 sub 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
  22 sub _init {
  23     my ($self) = @_;
  24     $self->{class_to_load} = undef;
  25     $self->{include_methods} = 0;
  26     $self->SUPER::_init();
  27 }
  28
  29 sub 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
  35 sub includeMethods {
  36     my ($self, $boolean) = @_;
  37     $self->{include_methods} = ($boolean ? 1 : 0) if defined $boolean;
  38     return $self->{include_methods};
  39 }
  40
  41 sub 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
  70 sub _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
  87 sub _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
  99 1;
 100
 101 __END__
 102
 103 =head1 NAME
 104
 105 Tree::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
 127 This 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
 135 There 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
 139 Setting 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
 143 Setting 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
 145 B<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
 149 The 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
 153 This 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
 157 This 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
 159 The 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
 169 I 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
 173 This 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
 179 None 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
 183 See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion.
 184
 185 =head1 SEE ALSO
 186
 187 These 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
 191 stevan little, E<lt>stevan@iinteractive.comE<gt>
 192
 193 =head1 COPYRIGHT AND LICENSE
 194
 195 Copyright 2004, 2005 by Infinity Interactive, Inc.
 196
 197 L<http://www.iinteractive.com>
 198
 199 This library is free software; you can redistribute it and/or modify
 200 it under the same terms as Perl itself.
 201
 202 =cut
 203