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