Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / Tree / Simple / Visitor / ToNestedHash.pm
CommitLineData
3fea05b9 1
2package Tree::Simple::Visitor::ToNestedHash;
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 visit {
23 my ($self, $tree) = @_;
24 (blessed($tree) && $tree->isa("Tree::Simple"))
25 || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
26 # grab our filter (if we have one)
27 my $filter = $self->getNodeFilter();
28 my %results;
29 # get the array
30 $self->_buildHash($tree, \%results, $filter);
31 # add the trunk if we need to
32 %results = (
33 ((defined($filter)) ?
34 $filter->($tree)
35 :
36 $tree->getNodeValue()) => { %results }
37 ) if $self->includeTrunk();
38 # set results
39 $self->setResults(\%results);
40}
41
42sub _buildHash {
43 my ($self, $tree, $accumulator, $filter) = @_;
44 foreach my $child ($tree->getAllChildren()) {
45 my $node_value = {};
46 my $node_key = (defined($filter) ? $filter->($child) : $child->getNodeValue());
47 $self->_buildHash($child, $node_value, $filter) unless $child->isLeaf();
48 $accumulator->{$node_key} = $node_value;
49 }
50 return $accumulator;
51}
52
53
541;
55
56__END__
57
58=head1 NAME
59
60Tree::Simple::Visitor::ToNestedHash - A Visitor for creating nested hash trees from Tree::Simple objects.
61
62=head1 SYNOPSIS
63
64 use Tree::Simple::Visitor::ToNestedHash;
65
66 my $visitor = Tree::Simple::Visitor::ToNestedHash->new();
67
68 # given this Tree::Simple tree
69 my $tree = Tree::Simple->new("Root")
70 ->addChildren(
71 Tree::Simple->new("Child1")
72 ->addChildren(
73 Tree::Simple->new("GrandChild1"),
74 Tree::Simple->new("GrandChild2")
75 ),
76 Tree::Simple->new("Child2"),
77 );
78
79 $tree->accept($visitor);
80
81 my $array_tree = $visitor->getResults();
82
83 # this then creates the equivalent nested array tree:
84 # {
85 # Root => {
86 # Child1 => {
87 # GrandChild1 => {},
88 # GrandChild2 => {}
89 # },
90 # Child2 => {}
91 # }
92 # }
93
94=head1 DESCRIPTION
95
96Given a tree constructed from a Tree::Simple heirarchy, this Visitor will create the equivalent tree of nested hashes.
97
98=head1 METHODS
99
100=over 4
101
102=item B<new>
103
104There are no arguments to the constructor the object will be in its default state. You can use the C<setNodeFilter> and C<includTrunk> methods to customize its behavior.
105
106=item B<includTrunk ($boolean)>
107
108Setting the C<$boolean> value to true (C<1>) will cause the node value of the tree's root to be included in the nested hash output, setting it to false will do the opposite.
109
110=item B<setNodeFilter ($filter_function)>
111
112This 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 placed into the hash tree. The C<$filter_function> is passed a Tree::Simple object, and is expected to return the value desired for inclusion into the hash tree.
113
114=item B<visit ($tree)>
115
116This 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.
117
118=item B<getResults>
119
120This method will return the hash tree constructed.
121
122=back
123
124=head1 BUGS
125
126None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it.
127
128=head1 CODE COVERAGE
129
130See the B<CODE COVERAGE> section in L<Tree::Simple::VisitorFactory> for more inforamtion.
131
132=head1 SEE ALSO
133
134These 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.
135
136=head1 AUTHOR
137
138stevan little, E<lt>stevan@iinteractive.comE<gt>
139
140=head1 COPYRIGHT AND LICENSE
141
142Copyright 2004, 2005 by Infinity Interactive, Inc.
143
144L<http://www.iinteractive.com>
145
146This library is free software; you can redistribute it and/or modify
147it under the same terms as Perl itself.
148
149=cut