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