Add built local::lib
[catagits/Gitalist.git] / local-lib5 / lib / perl5 / Tree / Simple.pm
1
2 package Tree::Simple;
3
4 use 5.006;
5
6 use strict;
7 use warnings;
8
9 our $VERSION = '1.18';
10
11 use Scalar::Util qw(blessed);
12
13 ## ----------------------------------------------------------------------------
14 ## Tree::Simple
15 ## ----------------------------------------------------------------------------
16
17 my $USE_WEAK_REFS;
18
19 sub import {
20     shift;
21     return unless @_;
22     if (lc($_[0]) eq 'use_weak_refs') {
23         $USE_WEAK_REFS++;
24         *Tree::Simple::weaken = \&Scalar::Util::weaken;
25     }
26 }
27
28 ## class constants
29 use constant ROOT => "root";
30
31 ### constructor
32
33 sub new {
34     my ($_class, $node, $parent) = @_;
35     my $class = ref($_class) || $_class;
36     my $tree = bless({}, $class);
37     $tree->_init($node, $parent, []);  
38     return $tree;
39 }
40
41 ### ---------------------------------------------------------------------------
42 ### methods
43 ### ---------------------------------------------------------------------------
44
45 ## ----------------------------------------------------------------------------
46 ## private methods
47
48 sub _init {
49     my ($self, $node, $parent, $children) = @_;
50     # set the value of the unique id
51     ($self->{_uid}) = ("$self" =~ /\((.*?)\)$/);
52     # set the value of the node
53     $self->{_node} = $node;
54     # and set the value of _children
55     $self->{_children} = $children;    
56     $self->{_height} = 1;
57     $self->{_width} = 1;
58     # Now check our $parent value
59     if (defined($parent)) {
60         if (blessed($parent) && $parent->isa("Tree::Simple")) {
61             # and set it as our parent
62             $parent->addChild($self);
63         }
64         elsif ($parent eq $self->ROOT) {
65             $self->_setParent( $self->ROOT );
66         }
67         else {
68             die "Insufficient Arguments : parent argument must be a Tree::Simple object";
69         }
70     }
71     else {
72         $self->_setParent( $self->ROOT );
73     }
74 }
75
76 sub _setParent {
77     my ($self, $parent) = @_;
78     (defined($parent) && 
79         (($parent eq $self->ROOT) || (blessed($parent) && $parent->isa("Tree::Simple"))))
80         || die "Insufficient Arguments : parent also must be a Tree::Simple object";
81     $self->{_parent} = $parent;    
82     if ($parent eq $self->ROOT) {
83         $self->{_depth} = -1;
84     }
85     else {
86         weaken($self->{_parent}) if $USE_WEAK_REFS;    
87         $self->{_depth} = $parent->getDepth() + 1;
88     }
89 }
90
91 sub _detachParent {
92     return if $USE_WEAK_REFS;
93     my ($self) = @_;
94     $self->{_parent} = undef;
95 }
96
97 sub _setHeight {
98     my ($self, $child) = @_;
99     my $child_height = $child->getHeight();
100     return if ($self->{_height} >= $child_height + 1);
101     $self->{_height} = $child_height + 1;
102     
103     # and now bubble up to the parent (unless we are the root)
104     $self->getParent()->_setHeight($self) unless $self->isRoot();
105 }
106
107 sub _setWidth {
108     my ($self, $child_width) = @_;
109     if (ref($child_width)) {
110         return if ($self->{_width} > $self->getChildCount());    
111         $child_width = $child_width->getWidth();
112     }
113     $self->{_width} += $child_width;
114     # and now bubble up to the parent (unless we are the root)
115     $self->getParent()->_setWidth($child_width) unless $self->isRoot();            
116 }
117
118 ## ----------------------------------------------------------------------------
119 ## mutators
120
121 sub setNodeValue {
122     my ($self, $node_value) = @_;
123     (defined($node_value)) || die "Insufficient Arguments : must supply a value for node";
124     $self->{_node} = $node_value;
125 }
126
127 sub setUID {
128     my ($self, $uid) = @_;
129     ($uid) || die "Insufficient Arguments : Custom Unique ID's must be a true value";
130     $self->{_uid} = $uid;
131 }
132
133 ## ----------------------------------------------
134 ## child methods
135
136 sub addChild {
137     splice @_, 1, 0, $_[0]->getChildCount;
138     goto &insertChild;
139 }
140
141 sub addChildren {
142     splice @_, 1, 0, $_[0]->getChildCount;
143     goto &insertChildren;
144 }
145
146 sub _insertChildAt {
147     my ($self, $index, @trees) = @_;
148
149     (defined($index)) 
150         || die "Insufficient Arguments : Cannot insert child without index";
151
152     # check the bounds of our children 
153     # against the index given
154     my $max = $self->getChildCount();
155     ($index <= $max)
156         || die "Index Out of Bounds : got ($index) expected no more than (" . $self->getChildCount() . ")";
157
158     (@trees) 
159         || die "Insufficient Arguments : no tree(s) to insert";    
160
161     foreach my $tree (@trees) {
162         (blessed($tree) && $tree->isa("Tree::Simple")) 
163             || die "Insufficient Arguments : Child must be a Tree::Simple object";    
164         $tree->_setParent($self);
165         $self->_setHeight($tree);   
166         $self->_setWidth($tree);                         
167         $tree->fixDepth() unless $tree->isLeaf();
168     }
169
170     # if index is zero, use this optimization
171     if ($index == 0) {
172         unshift @{$self->{_children}} => @trees;
173     }
174     # if index is equal to the number of children
175     # then use this optimization    
176     elsif ($index == $max) {
177         push @{$self->{_children}} => @trees;
178     }
179     # otherwise do some heavy lifting here
180     else {
181         splice @{$self->{_children}}, $index, 0, @trees;
182     }
183
184     $self;
185 }
186
187 *insertChildren = \&_insertChildAt;
188
189 # insertChild is really the same as insertChildren, you are just
190 # inserting an array of one tree
191 *insertChild = \&insertChildren;
192
193 sub removeChildAt {
194     my ($self, $index) = @_;
195     (defined($index)) 
196         || die "Insufficient Arguments : Cannot remove child without index.";
197     ($self->getChildCount() != 0) 
198         || die "Illegal Operation : There are no children to remove";        
199     # check the bounds of our children 
200     # against the index given        
201     ($index < $self->getChildCount()) 
202         || die "Index Out of Bounds : got ($index) expected no more than (" . $self->getChildCount() . ")";        
203     my $removed_child;
204     # if index is zero, use this optimization    
205     if ($index == 0) {
206         $removed_child = shift @{$self->{_children}};
207     }
208     # if index is equal to the number of children
209     # then use this optimization    
210     elsif ($index == $#{$self->{_children}}) {
211         $removed_child = pop @{$self->{_children}};    
212     }
213     # otherwise do some heavy lifting here    
214     else {
215         $removed_child = $self->{_children}->[$index];
216         splice @{$self->{_children}}, $index, 1;
217     }
218     # make sure we fix the height
219     $self->fixHeight();
220     $self->fixWidth();    
221     # make sure that the removed child
222     # is no longer connected to the parent
223     # so we change its parent to ROOT
224     $removed_child->_setParent($self->ROOT);
225     # and now we make sure that the depth 
226     # of the removed child is aligned correctly
227     $removed_child->fixDepth() unless $removed_child->isLeaf();    
228     # return ths removed child
229     # it is the responsibility 
230     # of the user of this module
231     # to properly dispose of this
232     # child (and all its sub-children)
233     return $removed_child;
234 }
235
236 sub removeChild {
237     my ($self, $child_to_remove) = @_;
238     (defined($child_to_remove))
239         || die "Insufficient Arguments : you must specify a child to remove";
240     # maintain backwards compatability
241     # so any non-ref arguments will get 
242     # sent to removeChildAt
243     return $self->removeChildAt($child_to_remove) unless ref($child_to_remove);
244     # now that we are confident it's a reference
245     # make sure it is the right kind
246     (blessed($child_to_remove) && $child_to_remove->isa("Tree::Simple")) 
247         || die "Insufficient Arguments : Only valid child type is a Tree::Simple object";
248     my $index = 0;
249     foreach my $child ($self->getAllChildren()) {
250         ("$child" eq "$child_to_remove") && return $self->removeChildAt($index);
251         $index++;
252     }
253     die "Child Not Found : cannot find object ($child_to_remove) in self";
254 }
255
256 sub getIndex {
257     my ($self) = @_;
258     return -1 if $self->{_parent} eq $self->ROOT;
259     my $index = 0;
260     foreach my $sibling ($self->{_parent}->getAllChildren()) {
261         ("$sibling" eq "$self") && return $index;
262         $index++;
263     }
264 }
265
266 ## ----------------------------------------------
267 ## Sibling methods
268
269 # these addSibling and addSiblings functions 
270 # just pass along their arguments to the addChild
271 # and addChildren method respectively, this 
272 # eliminates the need to overload these method
273 # in things like the Keyable Tree object
274
275 sub addSibling {
276     my ($self, @args) = @_;
277     (!$self->isRoot()) 
278         || die "Insufficient Arguments : cannot add a sibling to a ROOT tree";
279     $self->{_parent}->addChild(@args);
280 }
281
282 sub addSiblings {
283     my ($self, @args) = @_;
284     (!$self->isRoot()) 
285         || die "Insufficient Arguments : cannot add siblings to a ROOT tree";
286     $self->{_parent}->addChildren(@args);
287 }
288
289 sub insertSiblings {
290     my ($self, @args) = @_;
291     (!$self->isRoot()) 
292         || die "Insufficient Arguments : cannot insert sibling(s) to a ROOT tree";
293     $self->{_parent}->insertChildren(@args);
294 }
295
296 # insertSibling is really the same as
297 # insertSiblings, you are just inserting
298 # and array of one tree
299 *insertSibling = \&insertSiblings;
300
301 # I am not permitting the removal of siblings 
302 # as I think in general it is a bad idea
303
304 ## ----------------------------------------------------------------------------
305 ## accessors
306
307 sub getUID       { $_[0]{_uid}    }
308 sub getParent    { $_[0]{_parent} }
309 sub getDepth     { $_[0]{_depth}  }
310 sub getNodeValue { $_[0]{_node}   }
311 sub getWidth     { $_[0]{_width}  }
312 sub getHeight    { $_[0]{_height} }
313
314 # for backwards compatability
315 *height = \&getHeight;
316
317 sub getChildCount { $#{$_[0]{_children}} + 1 }
318
319 sub getChild {
320     my ($self, $index) = @_;
321     (defined($index)) 
322         || die "Insufficient Arguments : Cannot get child without index";
323     return $self->{_children}->[$index];
324 }
325
326 sub getAllChildren {
327     my ($self) = @_;
328     return wantarray ?
329         @{$self->{_children}}
330         :
331         $self->{_children};
332 }
333
334 sub getSibling {
335     my ($self, $index) = @_;
336     (!$self->isRoot()) 
337         || die "Insufficient Arguments : cannot get siblings from a ROOT tree";    
338     $self->getParent()->getChild($index);
339 }
340
341 sub getAllSiblings {
342     my ($self) = @_;
343     (!$self->isRoot()) 
344         || die "Insufficient Arguments : cannot get siblings from a ROOT tree";    
345     $self->getParent()->getAllChildren();
346 }
347
348 ## ----------------------------------------------------------------------------
349 ## informational
350
351 sub isLeaf { $_[0]->getChildCount == 0 }
352
353 sub isRoot {
354     my ($self) = @_;
355     return (!defined($self->{_parent}) || $self->{_parent} eq $self->ROOT);
356 }
357
358 sub size {
359     my ($self) = @_;
360     my $size = 1;
361     foreach my $child ($self->getAllChildren()) {
362         $size += $child->size();    
363     }
364     return $size;
365 }
366
367 ## ----------------------------------------------------------------------------
368 ## misc
369
370 # NOTE:
371 # Occasionally one wants to have the 
372 # depth available for various reasons
373 # of convience. Sometimes that depth 
374 # field is not always correct.
375 # If you create your tree in a top-down
376 # manner, this is usually not an issue
377 # since each time you either add a child
378 # or create a tree you are doing it with 
379 # a single tree and not a hierarchy.
380 # If however you are creating your tree
381 # bottom-up, then you might find that 
382 # when adding hierarchies of trees, your
383 # depth fields are all out of whack.
384 # This is where this method comes into play
385 # it will recurse down the tree and fix the
386 # depth fields appropriately.
387 # This method is called automatically when 
388 # a subtree is added to a child array
389 sub fixDepth {
390     my ($self) = @_;
391     # make sure the tree's depth 
392     # is up to date all the way down
393     $self->traverse(sub {
394             my ($tree) = @_;
395             return if $tree->isRoot();
396             $tree->{_depth} = $tree->getParent()->getDepth() + 1;
397         }
398     );
399 }
400
401 # NOTE:
402 # This method is used to fix any height 
403 # discrepencies which might arise when 
404 # you remove a sub-tree
405 sub fixHeight {
406     my ($self) = @_;
407     # we must find the tallest sub-tree
408     # and use that to define the height
409     my $max_height = 0;
410     unless ($self->isLeaf()) {
411         foreach my $child ($self->getAllChildren()) {
412             my $child_height = $child->getHeight();
413             $max_height = $child_height if ($max_height < $child_height);
414         }
415     }
416     # if there is no change, then we 
417     # need not bubble up through the
418     # parents
419     return if ($self->{_height} == ($max_height + 1));
420     # otherwise ...
421     $self->{_height} = $max_height + 1;
422     # now we need to bubble up through the parents 
423     # in order to rectify any issues with height
424     $self->getParent()->fixHeight() unless $self->isRoot();
425 }
426
427 sub fixWidth {
428     my ($self) = @_;
429     my $fixed_width = 0;
430     $fixed_width += $_->getWidth() foreach $self->getAllChildren();
431     $self->{_width} = $fixed_width;
432     $self->getParent()->fixWidth() unless $self->isRoot();
433 }
434
435 sub traverse {
436     my ($self, $func, $post) = @_;
437     (defined($func)) || die "Insufficient Arguments : Cannot traverse without traversal function";
438     (ref($func) eq "CODE") || die "Incorrect Object Type : traversal function is not a function";
439     (ref($post) eq "CODE") || die "Incorrect Object Type : post traversal function is not a function"
440         if defined($post);
441     foreach my $child ($self->getAllChildren()) { 
442         $func->($child);
443         $child->traverse($func, $post);
444         defined($post) && $post->($child);
445     }
446 }
447
448 # this is an improved version of the 
449 # old accept method, it now it more
450 # accepting of its arguments
451 sub accept {
452     my ($self, $visitor) = @_;
453     # it must be a blessed reference and ...
454     (blessed($visitor) && 
455         # either a Tree::Simple::Visitor object, or ...
456         ($visitor->isa("Tree::Simple::Visitor") || 
457             # it must be an object which has a 'visit' method avaiable
458             $visitor->can('visit')))
459         || die "Insufficient Arguments : You must supply a valid Visitor object";
460     $visitor->visit($self);
461 }
462
463 ## ----------------------------------------------------------------------------
464 ## cloning 
465
466 sub clone {
467     my ($self) = @_;
468     # first clone the value in the node
469     my $cloned_node = _cloneNode($self->getNodeValue());
470     # create a new Tree::Simple object 
471     # here with the cloned node, however
472     # we do not assign the parent node
473     # since it really does not make a lot
474     # of sense. To properly clone it would
475     # be to clone back up the tree as well,
476     # which IMO is not intuitive. So in essence
477     # when you clone a tree, you detach it from
478     # any parentage it might have
479     my $clone = $self->new($cloned_node);
480     # however, because it is a recursive thing
481     # when you clone all the children, and then
482     # add them to the clone, you end up setting
483     # the parent of the children to be that of
484     # the clone (which is correct)
485     $clone->addChildren(
486                 map { $_->clone() } $self->getAllChildren()
487                 ) unless $self->isLeaf();
488     # return the clone            
489     return $clone;
490 }
491     
492 # this allows cloning of single nodes while 
493 # retaining connections to a tree, this is sloppy
494 sub cloneShallow {
495     my ($self) = @_;
496     my $cloned_tree = { %{$self} };
497     bless($cloned_tree, ref($self));    
498     # just clone the node (if you can)
499     $cloned_tree->setNodeValue(_cloneNode($self->getNodeValue()));
500     return $cloned_tree;    
501 }
502
503 # this is a helper function which 
504 # recursively clones the node
505 sub _cloneNode {
506     my ($node, $seen) = @_;
507     # create a cache if we dont already
508     # have one to prevent circular refs
509     # from being copied more than once
510     $seen = {} unless defined $seen;
511     # now here we go...
512     my $clone;
513     # if it is not a reference, then lets just return it
514     return $node unless ref($node);
515     # if it is in the cache, then return that
516     return $seen->{$node} if exists ${$seen}{$node};
517     # if it is an object, then ...    
518     if (blessed($node)) {
519         # see if we can clone it
520         if ($node->can('clone')) {
521             $clone = $node->clone();
522         }
523         # otherwise respect that it does 
524         # not want to be cloned
525         else {
526             $clone = $node;
527         }
528     }
529     else {
530         # if the current slot is a scalar reference, then
531         # dereference it and copy it into the new object
532         if (ref($node) eq "SCALAR" || ref($node) eq "REF") {
533             my $var = "";
534             $clone = \$var;
535             ${$clone} = _cloneNode(${$node}, $seen);
536         }
537         # if the current slot is an array reference
538         # then dereference it and copy it
539         elsif (ref($node) eq "ARRAY") {
540             $clone = [ map { _cloneNode($_, $seen) } @{$node} ];
541         }
542         # if the current reference is a hash reference
543         # then dereference it and copy it
544         elsif (ref($node) eq "HASH") {
545             $clone = {};
546             foreach my $key (keys %{$node}) {
547                 $clone->{$key} = _cloneNode($node->{$key}, $seen);
548             }
549         }
550         else {
551             # all other ref types are not copied
552             $clone = $node;
553         }
554     }
555     # store the clone in the cache and 
556     $seen->{$node} = $clone;        
557     # then return the clone
558     return $clone;
559 }
560
561
562 ## ----------------------------------------------------------------------------
563 ## Desctructor
564
565 sub DESTROY {
566     # if we are using weak refs 
567     # we dont need to worry about
568     # destruction, it will just happen
569     return if $USE_WEAK_REFS;
570     my ($self) = @_;
571     # we want to detach all our children from 
572     # ourselves, this will break most of the 
573     # connections and allow for things to get
574     # reaped properly
575     unless (!$self->{_children} && scalar(@{$self->{_children}}) == 0) {
576         foreach my $child (@{$self->{_children}}) { 
577             defined $child && $child->_detachParent();
578         }
579     }
580     # we do not need to remove or undef the _children
581     # of the _parent fields, this will cause some 
582     # unwanted releasing of connections. 
583 }
584
585 ## ----------------------------------------------------------------------------
586 ## end Tree::Simple
587 ## ----------------------------------------------------------------------------
588
589 1;
590
591 __END__
592
593 =head1 NAME
594
595 Tree::Simple - A simple tree object
596
597 =head1 SYNOPSIS
598
599   use Tree::Simple;
600   
601   # make a tree root
602   my $tree = Tree::Simple->new("0", Tree::Simple->ROOT);
603   
604   # explicity add a child to it
605   $tree->addChild(Tree::Simple->new("1"));
606   
607   # specify the parent when creating
608   # an instance and it adds the child implicity
609   my $sub_tree = Tree::Simple->new("2", $tree);
610   
611   # chain method calls
612   $tree->getChild(0)->addChild(Tree::Simple->new("1.1"));
613   
614   # add more than one child at a time
615   $sub_tree->addChildren(
616             Tree::Simple->new("2.1"),
617             Tree::Simple->new("2.2")
618             );
619
620   # add siblings
621   $sub_tree->addSibling(Tree::Simple->new("3"));
622   
623   # insert children a specified index
624   $sub_tree->insertChild(1, Tree::Simple->new("2.1a"));
625   
626   # clean up circular references
627   $tree->DESTROY();
628
629 =head1 DESCRIPTION
630
631 This module in an fully object-oriented implementation of a simple n-ary 
632 tree. It is built upon the concept of parent-child relationships, so 
633 therefore every B<Tree::Simple> object has both a parent and a set of 
634 children (who themselves may have children, and so on). Every B<Tree::Simple> 
635 object also has siblings, as they are just the children of their immediate 
636 parent. 
637
638 It is can be used to model hierarchal information such as a file-system, 
639 the organizational structure of a company, an object inheritance hierarchy, 
640 versioned files from a version control system or even an abstract syntax 
641 tree for use in a parser. It makes no assumptions as to your intended usage, 
642 but instead simply provides the structure and means of accessing and 
643 traversing said structure. 
644
645 This module uses exceptions and a minimal Design By Contract style. All method 
646 arguments are required unless specified in the documentation, if a required 
647 argument is not defined an exception will usually be thrown. Many arguments 
648 are also required to be of a specific type, for instance the C<$parent> 
649 argument to the constructor B<must> be a B<Tree::Simple> object or an object 
650 derived from B<Tree::Simple>, otherwise an exception is thrown. This may seems 
651 harsh to some, but this allows me to have the confidence that my code works as 
652 I intend, and for you to enjoy the same level of confidence when using this 
653 module. Note however that this module does not use any Exception or Error module, 
654 the exceptions are just strings thrown with C<die>. 
655
656 I consider this module to be production stable, it is based on a module which has 
657 been in use on a few production systems for approx. 2 years now with no issue. 
658 The only difference is that the code has been cleaned up a bit, comments added and 
659 the thorough tests written for its public release. I am confident it behaves as 
660 I would expect it to, and is (as far as I know) bug-free. I have not stress-tested 
661 it under extreme duress, but I don't so much intend for it to be used in that 
662 type of situation. If this module cannot keep up with your Tree needs, i suggest 
663 switching to one of the modules listed in the L<OTHER TREE MODULES> section below.
664
665 =head1 CONSTANTS
666
667 =over 4
668
669 =item B<ROOT>
670
671 This class constant serves as a placeholder for the root of our tree. If a tree 
672 does not have a parent, then it is considered a root. 
673
674 =back
675
676 =head1 METHODS
677
678 =head2 Constructor
679
680 =over 4
681
682 =item B<new ($node, $parent)>
683
684 The constructor accepts two arguments a C<$node> value and an optional C<$parent>. 
685 The C<$node> value can be any scalar value (which includes references and objects). 
686 The optional C<$parent> value must be a B<Tree::Simple> object, or an object 
687 derived from B<Tree::Simple>. Setting this value implies that your new tree is a 
688 child of the parent tree, and therefore adds it to the parent's children. If the 
689 C<$parent> is not specified then its value defaults to ROOT.
690
691 =back
692
693 =head2 Mutator Methods
694
695 =over 4
696
697 =item B<setNodeValue ($node_value)>
698
699 This sets the node value to the scalar C<$node_value>, an exception is thrown if 
700 C<$node_value> is not defined.
701
702 =item B<setUID ($uid)>
703
704 This allows you to set your own unique ID for this specific Tree::Simple object. 
705 A default value derived from the object's hex address is provided for you, so use 
706 of this method is entirely optional. It is the responsibility of the user to 
707 ensure the value's uniqueness, all that is tested by this method is that C<$uid> 
708 is a true value (evaluates to true in a boolean context). For even more information 
709 about the Tree::Simple UID see the C<getUID> method.
710
711 =item B<addChild ($tree)>
712
713 This method accepts only B<Tree::Simple> objects or objects derived from 
714 B<Tree::Simple>, an exception is thrown otherwise. This method will append 
715 the given C<$tree> to the end of it's children list, and set up the correct 
716 parent-child relationships. This method is set up to return its invocant so 
717 that method call chaining can be possible. Such as:
718
719   my $tree = Tree::Simple->new("root")->addChild(Tree::Simple->new("child one"));
720
721 Or the more complex:
722
723   my $tree = Tree::Simple->new("root")->addChild(
724                          Tree::Simple->new("1.0")->addChild(
725                                      Tree::Simple->new("1.0.1")     
726                                      )
727                          );
728
729 =item B<addChildren (@trees)>
730
731 This method accepts an array of B<Tree::Simple> objects, and adds them to 
732 it's children list. Like C<addChild> this method will return its invocant 
733 to allow for method call chaining.
734
735 =item B<insertChild ($index, $tree)>
736
737 This method accepts a numeric C<$index> and a B<Tree::Simple> object (C<$tree>), 
738 and inserts the C<$tree> into the children list at the specified C<$index>. 
739 This results in the shifting down of all children after the C<$index>. The 
740 C<$index> is checked to be sure it is the bounds of the child list, if it 
741 out of bounds an exception is thrown. The C<$tree> argument's type is 
742 verified to be a B<Tree::Simple> or B<Tree::Simple> derived object, if 
743 this condition fails, an exception is thrown. 
744
745 =item B<insertChildren ($index, @trees)>
746
747 This method functions much as insertChild does, but instead of inserting a 
748 single B<Tree::Simple>, it inserts an array of B<Tree::Simple> objects. It 
749 too bounds checks the value of C<$index> and type checks the objects in 
750 C<@trees> just as C<insertChild> does.
751
752 =item B<removeChild> ($child | $index)>
753
754 Accepts two different arguemnts. If given a B<Tree::Simple> object (C<$child>), 
755 this method finds that specific C<$child> by comparing it with all the other 
756 children until it finds a match. At which point the C<$child> is removed. If 
757 no match is found, and exception is thrown. If a non-B<Tree::Simple> object 
758 is given as the C<$child> argument, an exception is thrown. 
759
760 This method also accepts a numeric C<$index> and removes the child found at 
761 that index from it's list of children. The C<$index> is bounds checked, if 
762 this condition fail, an exception is thrown.
763
764 When a child is removed, it results in the shifting up of all children after 
765 it, and the removed child is returned. The removed child is properly 
766 disconnected from the tree and all its references to its old parent are 
767 removed. However, in order to properly clean up and circular references 
768 the removed child might have, it is advised to call it's C<DESTROY> method. 
769 See the L<CIRCULAR REFERENCES> section for more information.
770
771 =item B<addSibling ($tree)>
772
773 =item B<addSiblings (@trees)>
774
775 =item B<insertSibling ($index, $tree)>
776
777 =item B<insertSiblings ($index, @trees)>
778
779 The C<addSibling>, C<addSiblings>, C<insertSibling> and C<insertSiblings> 
780 methods pass along their arguments to the C<addChild>, C<addChildren>, 
781 C<insertChild> and C<insertChildren> methods of their parent object 
782 respectively. This eliminates the need to overload these methods in subclasses 
783 which may have specialized versions of the *Child(ren) methods. The one 
784 exceptions is that if an attempt it made to add or insert siblings to the 
785 B<ROOT> of the tree then an exception is thrown.
786
787 =back
788
789 B<NOTE:>
790 There is no C<removeSibling> method as I felt it was probably a bad idea. 
791 The same effect can be achieved by manual upwards traversal. 
792
793 =head2 Accessor Methods
794
795 =over 4
796
797 =item B<getNodeValue>
798
799 This returns the value stored in the object's node field.
800
801 =item B<getUID>
802
803 This returns the unique ID associated with this particular tree. This can 
804 be custom set using the C<setUID> method, or you can just use the default. 
805 The default is the hex-address extracted from the stringified Tree::Simple 
806 object. This may not be a I<universally> unique identifier, but it should 
807 be adequate for at least the current instance of your perl interpreter. If 
808 you need a UUID, one can be generated with an outside module (there are 
809     many to choose from on CPAN) and the C<setUID> method (see above).
810
811 =item B<getChild ($index)>
812
813 This returns the child (a B<Tree::Simple> object) found at the specified 
814 C<$index>. Note that we do use standard zero-based array indexing.
815
816 =item B<getAllChildren>
817
818 This returns an array of all the children (all B<Tree::Simple> objects). 
819 It will return an array reference in scalar context. 
820
821 =item B<getSibling ($index)>
822
823 =item B<getAllSiblings>
824
825 Much like C<addSibling> and C<addSiblings>, these two methods simply call 
826 C<getChild> and C<getAllChildren> on the invocant's parent.
827
828 =item B<getDepth>
829
830 Returns a number representing the invocant's depth within the hierarchy of 
831 B<Tree::Simple> objects. 
832
833 B<NOTE:> A C<ROOT> tree has the depth of -1. This be because Tree::Simple 
834 assumes that a tree's root will usually not contain data, but just be an 
835 anchor for the data-containing branches. This may not be intuitive in all 
836 cases, so I mention it here.
837
838 =item B<getParent>
839
840 Returns the invocant's parent, which could be either B<ROOT> or a 
841 B<Tree::Simple> object.
842
843 =item B<getHeight>
844
845 Returns a number representing the length of the longest path from the current 
846 tree to the furthest leaf node.
847
848 =item B<getWidth>
849
850 Returns the a number representing the breadth of the current tree, basically 
851 it is a count of all the leaf nodes.
852
853 =item B<getChildCount>
854
855 Returns the number of children the invocant contains.
856
857 =item B<getIndex>
858
859 Returns the index of this tree within its parent's child list. Returns -1 if 
860 the tree is the root.
861
862 =back
863
864 =head2 Predicate Methods
865
866 =over 4
867
868 =item B<isLeaf>
869
870 Returns true (1) if the invocant does not have any children, false (0) otherwise.
871
872 =item B<isRoot>
873
874 Returns true (1) if the invocant's "parent" field is B<ROOT>, returns false 
875 (0) otherwise.
876
877 =back
878
879 =head2 Recursive Methods
880
881 =over 4
882
883 =item B<traverse ($func, ?$postfunc)>
884
885 This method accepts two arguments a mandatory C<$func> and an optional
886 C<$postfunc>. If the argument C<$func> is not defined then an exception
887 is thrown. If C<$func> or C<$postfunc> are not in fact CODE references
888 then an exception is thrown. The function C<$func> is then applied
889 recursively to all the children of the invocant. If given, the function
890 C<$postfunc> will be applied to each child after the child's children
891 have been traversed.
892
893 Here is an example of a traversal function that will print out the
894 hierarchy as a tabbed in list.
895
896   $tree->traverse(sub {
897       my ($_tree) = @_;
898       print (("\t" x $_tree->getDepth()), $_tree->getNodeValue(), "\n");
899   });
900
901 Here is an example of a traversal function that will print out the 
902 hierarchy in an XML-style format.
903
904   $tree->traverse(sub {
905       my ($_tree) = @_;
906       print ((' ' x $_tree->getDepth()),
907               '<', $_tree->getNodeValue(),'>',"\n");
908   },
909   sub {
910       my ($_tree) = @_;
911       print ((' ' x $_tree->getDepth()),
912               '</', $_tree->getNodeValue(),'>',"\n");
913   });
914         
915 =item B<size>
916
917 Returns the total number of nodes in the current tree and all its sub-trees.
918
919 =item B<height>
920
921 This method has also been B<deprecated> in favor of the C<getHeight> method above, 
922 it remains as an alias to C<getHeight> for backwards compatability. 
923
924 B<NOTE:> This is also no longer a recursive method which get's it's value on demand, 
925 but a value stored in the Tree::Simple object itself, hopefully making it much 
926 more efficient and usable.
927
928 =back
929
930 =head2 Visitor Methods
931
932 =over 4     
933
934 =item B<accept ($visitor)>
935
936 It accepts either a B<Tree::Simple::Visitor> object (which includes classes derived 
937     from B<Tree::Simple::Visitor>), or an object who has the C<visit> method available 
938     (tested with C<$visitor-E<gt>can('visit')>). If these qualifications are not met, 
939     and exception will be thrown. We then run the Visitor's C<visit> method giving the 
940     current tree as its argument. 
941
942 I have also created a number of Visitor objects and packaged them into the 
943 B<Tree::Simple::VisitorFactory>. 
944
945 =back
946
947 =head2 Cloning Methods
948
949 Cloning a tree can be an extremly expensive operation for large trees, so we provide 
950 two options for cloning, a deep clone and a shallow clone.
951
952 When a Tree::Simple object is cloned, the node is deep-copied in the following manner. 
953 If we find a normal scalar value (non-reference), we simply copy it. If we find an 
954 object, we attempt to call C<clone> on it, otherwise we just copy the reference (since 
955 we assume the object does not want to be cloned). If we find a SCALAR, REF reference we 
956 copy the value contained within it. If we find a HASH or ARRAY reference we copy the 
957 reference and recursively copy all the elements within it (following these exact 
958 guidelines). We also do our best to assure that circular references are cloned 
959 only once and connections restored correctly. This cloning will not be able to copy 
960 CODE, RegExp and GLOB references, as they are pretty much impossible to clone. We 
961 also do not handle C<tied> objects, and they will simply be copied as plain 
962 references, and not re-C<tied>. 
963
964 =over 4
965
966 =item B<clone>
967
968 The clone method does a full deep-copy clone of the object, calling C<clone> recursively 
969 on all its children. This does not call C<clone> on the parent tree however. Doing 
970 this would result in a slowly degenerating spiral of recursive death, so it is not 
971 recommended and therefore not implemented. What happens is that the tree instance 
972 that C<clone> is actually called upon is detached from the tree, and becomes a root 
973 node, all if the cloned children are then attached as children of that tree. I personally 
974 think this is more intuitive then to have the cloning crawl back I<up> the tree is not 
975 what I think most people would expect. 
976
977 =item B<cloneShallow>
978
979 This method is an alternate option to the plain C<clone> method. This method allows the 
980 cloning of single B<Tree::Simple> object while retaining connections to the rest of the 
981 tree/hierarchy.
982
983 =back
984
985 =head2 Misc. Methods
986
987 =over 4
988
989 =item B<DESTROY>
990
991 To avoid memory leaks through uncleaned-up circular references, we implement the 
992 C<DESTROY> method. This method will attempt to call C<DESTROY> on each of its 
993 children (if it has any). This will result in a cascade of calls to C<DESTROY> on 
994 down the tree. It also cleans up it's parental relations as well. 
995
996 Because of perl's reference counting scheme and how that interacts with circular 
997 references, if you want an object to be properly reaped you should manually call 
998 C<DESTROY>. This is especially nessecary if your object has any children. See the 
999 section on L<CIRCULAR REFERENCES> for more information.
1000
1001 =item B<fixDepth>
1002
1003 Tree::Simple will manage your tree's depth field for you using this method. You 
1004 should never need to call it on your own, however if you ever did need to, here 
1005 is it. Running this method will traverse your all the invocant's sub-trees 
1006 correcting the depth as it goes.
1007
1008 =item B<fixHeight>
1009
1010 Tree::Simple will manage your tree's height field for you using this method. 
1011 You should never need to call it on your own, however if you ever did need to, 
1012 here is it. Running this method will correct the heights of the current tree 
1013 and all it's ancestors.
1014
1015 =item B<fixWidth>
1016
1017 Tree::Simple will manage your tree's width field for you using this method. You 
1018 should never need to call it on your own, however if you ever did need to, 
1019 here is it. Running this method will correct the widths of the current tree 
1020 and all it's ancestors.
1021
1022 =back
1023
1024 =head2 Private Methods
1025
1026 I would not normally document private methods, but in case you need to subclass 
1027 Tree::Simple, here they are.
1028
1029 =over 4
1030
1031 =item B<_init ($node, $parent, $children)>
1032
1033 This method is here largely to facilitate subclassing. This method is called by 
1034 new to initialize the object, where new's primary responsibility is creating 
1035 the instance.
1036
1037 =item B<_setParent ($parent)>
1038
1039 This method sets up the parental relationship. It is for internal use only.
1040
1041 =item B<_setHeight ($child)>
1042
1043 This method will set the height field based upon the height of the given C<$child>.
1044
1045 =back
1046
1047 =head1 CIRCULAR REFERENCES
1048
1049 I have revised the model by which Tree::Simple deals with ciruclar references. 
1050 In the past all circular references had to be manually destroyed by calling 
1051 DESTROY. The call to DESTROY would then call DESTROY on all the children, and 
1052 therefore cascade down the tree. This however was not always what was needed, 
1053 nor what made sense, so I have now revised the model to handle things in what 
1054 I feel is a more consistent and sane way. 
1055
1056 Circular references are now managed with the simple idea that the parent makes 
1057 the descisions for the child. This means that child-to-parent references are 
1058 weak, while parent-to-child references are strong. So if a parent is destroyed 
1059 it will force all it's children to detach from it, however, if a child is 
1060 destroyed it will not be detached from it's parent.
1061
1062 =head2 Optional Weak References
1063
1064 By default, you are still required to call DESTROY in order for things to 
1065 happen. However I have now added the option to use weak references, which 
1066 alleviates the need for the manual call to DESTROY and allows Tree::Simple 
1067 to manage this automatically. This is accomplished with a compile time 
1068 setting like this:
1069
1070   use Tree::Simple 'use_weak_refs';
1071   
1072 And from that point on Tree::Simple will use weak references to allow for 
1073 perl's reference counting to clean things up properly.
1074
1075 For those who are unfamilar with weak references, and how they affect the 
1076 reference counts, here is a simple illustration. First is the normal model 
1077 that Tree::Simple uses:
1078  
1079  +---------------+
1080  | Tree::Simple1 |<---------------------+
1081  +---------------+                      |
1082  | parent        |                      |
1083  | children      |-+                    |
1084  +---------------+ |                    |
1085                    |                    |
1086                    |  +---------------+ |
1087                    +->| Tree::Simple2 | |
1088                       +---------------+ |
1089                       | parent        |-+
1090                       | children      |
1091                       +---------------+
1092                       
1093 Here, Tree::Simple1 has a reference count of 2 (one for the original 
1094 variable it is assigned to, and one for the parent reference in 
1095 Tree::Simple2), and Tree::Simple2 has a reference count of 1 (for the 
1096 child reference in Tree::Simple2).                       
1097                      
1098 Now, with weak references:
1099                      
1100  +---------------+
1101  | Tree::Simple1 |.......................
1102  +---------------+                      :
1103  | parent        |                      :
1104  | children      |-+                    : <--[ weak reference ]
1105  +---------------+ |                    :
1106                    |                    :
1107                    |  +---------------+ :
1108                    +->| Tree::Simple2 | :
1109                       +---------------+ :
1110                       | parent        |..
1111                       | children      |
1112                       +---------------+   
1113                       
1114 Now Tree::Simple1 has a reference count of 1 (for the variable it is 
1115 assigned to) and 1 weakened reference (for the parent reference in 
1116 Tree::Simple2). And Tree::Simple2 has a reference count of 1, just 
1117 as before.                                                            
1118
1119 =head1 BUGS
1120
1121 None that I am aware of. The code is pretty thoroughly tested (see 
1122 L<CODE COVERAGE> below) and is based on an (non-publicly released) 
1123 module which I had used in production systems for about 3 years without 
1124 incident. Of course, if you find a bug, let me know, and I will be sure 
1125 to fix it. 
1126
1127 =head1 CODE COVERAGE
1128
1129 I use L<Devel::Cover> to test the code coverage of my tests, below 
1130 is the L<Devel::Cover> report on this module's test suite.
1131  
1132  ---------------------------- ------ ------ ------ ------ ------ ------ ------
1133  File                           stmt branch   cond    sub    pod   time  total
1134  ---------------------------- ------ ------ ------ ------ ------ ------ ------
1135  Tree/Simple.pm                 99.6   96.0   92.3  100.0   97.0   95.5   98.0
1136  Tree/Simple/Visitor.pm        100.0   96.2   88.2  100.0  100.0    4.5   97.7
1137  ---------------------------- ------ ------ ------ ------ ------ ------ ------
1138  Total                          99.7   96.1   91.1  100.0   97.6  100.0   97.9
1139  ---------------------------- ------ ------ ------ ------ ------ ------ ------
1140
1141 =head1 SEE ALSO
1142
1143 I have written a number of other modules which use or augment this 
1144 module, they are describes below and available on CPAN.
1145
1146 =over 4
1147
1148 =item L<Tree::Parser> - A module for parsing formatted files into Tree::Simple hierarchies.
1149
1150 =item L<Tree::Simple::View> - A set of classes for viewing Tree::Simple hierarchies in various output formats.
1151
1152 =item L<Tree::Simple::VisitorFactory> - A set of several useful Visitor objects for Tree::Simple objects.
1153
1154 =item L<Tree::Binary> - If you are looking for a binary tree, this you might want to check this one out.
1155
1156 =back
1157
1158 Also, the author of L<Data::TreeDumper> and I have worked together 
1159 to make sure that B<Tree::Simple> and his module work well together. 
1160 If you need a quick and handy way to dump out a Tree::Simple heirarchy, 
1161 this module does an excellent job (and plenty more as well).
1162
1163 I have also recently stumbled upon some packaged distributions of 
1164 Tree::Simple for the various Unix flavors. Here  are some links:
1165
1166 =over 4
1167
1168 =item FreeBSD Port - L<http://www.freshports.org/devel/p5-Tree-Simple/>
1169
1170 =item Debian Package - L<http://packages.debian.org/unstable/perl/libtree-simple-perl>
1171
1172 =item Linux RPM - L<http://rpmpan.sourceforge.net/Tree.html>
1173
1174 =back
1175
1176 =head1 OTHER TREE MODULES
1177
1178 There are a few other Tree modules out there, here is a quick comparison 
1179 between B<Tree::Simple> and them. Obviously I am biased, so take what I say 
1180 with a grain of salt, and keep in mind, I wrote B<Tree::Simple> because I 
1181 could not find a Tree module that suited my needs. If B<Tree::Simple> does 
1182 not fit your needs, I recommend looking at these modules. Please note that 
1183 I am only listing Tree::* modules I am familiar with here, if you think I 
1184 have missed a module, please let me know. I have also seen a few tree-ish 
1185 modules outside of the Tree::* namespace, but most of them are part of 
1186 another distribution (B<HTML::Tree>, B<Pod::Tree>, etc) and are likely 
1187 specialized in purpose. 
1188
1189 =over 4
1190
1191 =item L<Tree::DAG_Node>
1192
1193 This module seems pretty stable and very robust with a lot of functionality. 
1194 However, B<Tree::DAG_Node> does not come with any automated tests. It's 
1195 I<test.pl> file simply checks the module loads and nothing else. While I 
1196 am sure the author tested his code, I would feel better if I was able to 
1197 see that. The module is approx. 3000 lines with POD, and 1,500 without the 
1198 POD. The shear depth and detail of the documentation and the ratio of code 
1199 to documentation is impressive, and not to be taken lightly. But given that 
1200 it is a well known fact that the likeliness of bugs increases along side the 
1201 size of the code, I do not feel comfortable with large modules like this 
1202 which have no tests.
1203
1204 All this said, I am not a huge fan of the API either, I prefer the gender 
1205 neutral approach in B<Tree::Simple> to the mother/daughter style of B<Tree::DAG_Node>. 
1206 I also feel very strongly that B<Tree::DAG_Node> is trying to do much more 
1207 than makes sense in a single module, and is offering too many ways to do 
1208 the same or similar things. 
1209
1210 However, of all the Tree::* modules out there, B<Tree::DAG_Node> seems to 
1211 be one of the favorites, so it may be worth investigating.
1212
1213 =item L<Tree::MultiNode>
1214
1215 I am not very familiar with this module, however, I have heard some good 
1216 reviews of it, so I thought it deserved mention here. I believe it is 
1217 based upon C++ code found in the book I<Algorithms in C++> by Robert Sedgwick. 
1218 It uses a number of interesting ideas, such as a ::Handle object to traverse 
1219 the tree with (similar to Visitors, but also seem to be to be kind of like 
1220 a cursor). However, like B<Tree::DAG_Node>, it is somewhat lacking in tests 
1221 and has only 6 tests in its suite. It also has one glaring bug, which is 
1222 that there is currently no way to remove a child node.
1223
1224 =item L<Tree::Nary>
1225
1226 It is a (somewhat) direct translation of the N-ary tree from the GLIB 
1227 library, and the API is based on that. GLIB is a C library, which means 
1228 this is a very C-ish API. That doesn't appeal to me, it might to you, to 
1229 each their own.
1230
1231 This module is similar in intent to B<Tree::Simple>. It implements a tree 
1232 with I<n> branches and has polymorphic node containers. It implements much 
1233 of the same methods as B<Tree::Simple> and a few others on top of that, but 
1234 being based on a C library, is not very OO. In most of the method calls 
1235 the C<$self> argument is not used and the second argument C<$node> is. 
1236 B<Tree::Simple> is a much more OO module than B<Tree::Nary>, so while they 
1237 are similar in functionality they greatly differ in implementation style.
1238
1239 =item L<Tree>
1240
1241 This module is pretty old, it has not been updated since Oct. 31, 1999 and 
1242 is still on version 0.01. It also seems to be (from the limited documentation) 
1243 a binary and a balanced binary tree, B<Tree::Simple> is an I<n>-ary tree, and 
1244 makes no attempt to balance anything.
1245
1246 =item L<Tree::Ternary>
1247
1248 This module is older than B<Tree>, last update was Sept. 24th, 1999. It 
1249 seems to be a special purpose tree, for storing and accessing strings, 
1250 not general purpose like B<Tree::Simple>. 
1251
1252 =item L<Tree::Ternary_XS>
1253
1254 This module is an XS implementation of the above tree type. 
1255
1256 =item L<Tree::Trie>
1257
1258 This too is a specialized tree type, it sounds similar to the B<Tree::Ternary>, 
1259 but it much newer (latest release in 2003). It seems specialized for the lookup 
1260 and retrieval of information like a hash.
1261
1262 =item L<Tree::M>
1263
1264 Is a wrapper for a C++ library, whereas B<Tree::Simple> is pure-perl. It also 
1265 seems to be a more specialized implementation of a tree, therefore not really 
1266 the same as B<Tree::Simple>. 
1267
1268 =item L<Tree::Fat>
1269
1270 Is a wrapper around a C library, again B<Tree::Simple> is pure-perl. The author 
1271 describes FAT-trees as a combination of a Tree and an array. It looks like a 
1272 pretty mean and lean module, and good if you need speed and are implementing a 
1273 custom data-store of some kind. The author points out too that the module is 
1274 designed for embedding and there is not default embedding, so you can't really 
1275 use it "out of the box".
1276
1277 =back
1278
1279 =head1 ACKNOWLEDGEMENTS
1280
1281 =over 4
1282
1283 =item Thanks to Nadim Ibn Hamouda El Khemir for making L<Data::TreeDumper> work 
1284 with B<Tree::Simple>.
1285
1286 =item Thanks to Brett Nuske for his idea for the C<getUID> and C<setUID> methods.
1287
1288 =item Thanks to whomever submitted the memory leak bug to RT (#7512). 
1289
1290 =item Thanks to Mark Thomas for his insight into how to best handle the I<height> 
1291 and I<width> properties without unessecary recursion.
1292
1293 =item Thanks for Mark Lawrence for the &traverse post-func patch, tests and docs.
1294
1295 =back
1296
1297 =head1 AUTHOR
1298
1299 Stevan Little, E<lt>stevan@iinteractive.comE<gt>
1300
1301 Rob Kinyon, E<lt>rob@iinteractive.comE<gt>
1302
1303 =head1 COPYRIGHT AND LICENSE
1304
1305 Copyright 2004-2006 by Infinity Interactive, Inc.
1306
1307 L<http://www.iinteractive.com>
1308
1309 This library is free software; you can redistribute it and/or modify
1310 it under the same terms as Perl itself. 
1311
1312 =cut