Commit | Line | Data |
3fea05b9 |
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 | |