1 2package Tree::Simple; 3 4use 5.006; 5 6use strict; 7use warnings; 8 9our $VERSION = '1.18'; 10 11use Scalar::Util qw(blessed); 12 13## ---------------------------------------------------------------------------- 14## Tree::Simple 15## ---------------------------------------------------------------------------- 16 17my $USE_WEAK_REFS; 18 19sub 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 29use constant ROOT => "root"; 30 31### constructor 32 33sub 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 48sub _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 76sub _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 91sub _detachParent { 92 return if $USE_WEAK_REFS; 93 my ($self) = @_; 94 $self->{_parent} = undef; 95} 96 97sub _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 107sub _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 121sub 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 127sub 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 136sub addChild { 137 splice @_, 1, 0, $_[0]->getChildCount; 138 goto &insertChild; 139} 140 141sub addChildren { 142 splice @_, 1, 0, $_[0]->getChildCount; 143 goto &insertChildren; 144} 145 146sub _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 193sub 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 236sub 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 256sub 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 275sub 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 282sub 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 289sub 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 307sub getUID { $_[0]{_uid} } 308sub getParent { $_[0]{_parent} } 309sub getDepth { $_[0]{_depth} } 310sub getNodeValue { $_[0]{_node} } 311sub getWidth { $_[0]{_width} } 312sub getHeight { $_[0]{_height} } 313 314# for backwards compatability 315*height = \&getHeight; 316 317sub getChildCount { $#{$_[0]{_children}} + 1 } 318 319sub getChild { 320 my ($self, $index) = @_; 321 (defined($index)) 322 || die "Insufficient Arguments : Cannot get child without index"; 323 return $self->{_children}->[$index]; 324} 325 326sub getAllChildren { 327 my ($self) = @_; 328 return wantarray ? 329 @{$self->{_children}} 330 : 331 $self->{_children}; 332} 333 334sub 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 341sub 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 351sub isLeaf { $_[0]->getChildCount == 0 } 352 353sub isRoot { 354 my ($self) = @_; 355 return (!defined($self->{_parent}) || $self->{_parent} eq $self->ROOT); 356} 357 358sub 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 389sub 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 405sub 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 427sub 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 435sub 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 451sub 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 466sub 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 494sub 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 505sub _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 565sub 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 5891; 590 591__END__ 592 593=head1 NAME 594 595Tree::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 631This module in an fully object-oriented implementation of a simple n-ary 632tree. It is built upon the concept of parent-child relationships, so 633therefore every B<Tree::Simple> object has both a parent and a set of 634children (who themselves may have children, and so on). Every B<Tree::Simple> 635object also has siblings, as they are just the children of their immediate 636parent. 637 638It is can be used to model hierarchal information such as a file-system, 639the organizational structure of a company, an object inheritance hierarchy, 640versioned files from a version control system or even an abstract syntax 641tree for use in a parser. It makes no assumptions as to your intended usage, 642but instead simply provides the structure and means of accessing and 643traversing said structure. 644 645This module uses exceptions and a minimal Design By Contract style. All method 646arguments are required unless specified in the documentation, if a required 647argument is not defined an exception will usually be thrown. Many arguments 648are also required to be of a specific type, for instance the C<$parent> 649argument to the constructor B<must> be a B<Tree::Simple> object or an object 650derived from B<Tree::Simple>, otherwise an exception is thrown. This may seems 651harsh to some, but this allows me to have the confidence that my code works as 652I intend, and for you to enjoy the same level of confidence when using this 653module. Note however that this module does not use any Exception or Error module, 654the exceptions are just strings thrown with C<die>. 655 656I consider this module to be production stable, it is based on a module which has 657been in use on a few production systems for approx. 2 years now with no issue. 658The only difference is that the code has been cleaned up a bit, comments added and 659the thorough tests written for its public release. I am confident it behaves as 660I would expect it to, and is (as far as I know) bug-free. I have not stress-tested 661it under extreme duress, but I don't so much intend for it to be used in that 662type of situation. If this module cannot keep up with your Tree needs, i suggest 663switching 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 671This class constant serves as a placeholder for the root of our tree. If a tree 672does 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 684The constructor accepts two arguments a C<$node> value and an optional C<$parent>. 685The C<$node> value can be any scalar value (which includes references and objects). 686The optional C<$parent> value must be a B<Tree::Simple> object, or an object 687derived from B<Tree::Simple>. Setting this value implies that your new tree is a 688child of the parent tree, and therefore adds it to the parent's children. If the 689C<$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 699This sets the node value to the scalar C<$node_value>, an exception is thrown if 700C<$node_value> is not defined. 701 702=item B<setUID ($uid)> 703 704This allows you to set your own unique ID for this specific Tree::Simple object. 705A default value derived from the object's hex address is provided for you, so use 706of this method is entirely optional. It is the responsibility of the user to 707ensure the value's uniqueness, all that is tested by this method is that C<$uid> 708is a true value (evaluates to true in a boolean context). For even more information 709about the Tree::Simple UID see the C<getUID> method. 710 711=item B<addChild ($tree)> 712 713This method accepts only B<Tree::Simple> objects or objects derived from 714B<Tree::Simple>, an exception is thrown otherwise. This method will append 715the given C<$tree> to the end of it's children list, and set up the correct 716parent-child relationships. This method is set up to return its invocant so 717that method call chaining can be possible. Such as: 718 719 my $tree = Tree::Simple->new("root")->addChild(Tree::Simple->new("child one")); 720 721Or 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 731This method accepts an array of B<Tree::Simple> objects, and adds them to 732it's children list. Like C<addChild> this method will return its invocant 733to allow for method call chaining. 734 735=item B<insertChild ($index, $tree)> 736 737This method accepts a numeric C<$index> and a B<Tree::Simple> object (C<$tree>), 738and inserts the C<$tree> into the children list at the specified C<$index>. 739This results in the shifting down of all children after the C<$index>. The 740C<$index> is checked to be sure it is the bounds of the child list, if it 741out of bounds an exception is thrown. The C<$tree> argument's type is 742verified to be a B<Tree::Simple> or B<Tree::Simple> derived object, if 743this condition fails, an exception is thrown. 744 745=item B<insertChildren ($index, @trees)> 746 747This method functions much as insertChild does, but instead of inserting a 748single B<Tree::Simple>, it inserts an array of B<Tree::Simple> objects. It 749too bounds checks the value of C<$index> and type checks the objects in 750C<@trees> just as C<insertChild> does. 751 752=item B<removeChild> ($child | $index)> 753 754Accepts two different arguemnts. If given a B<Tree::Simple> object (C<$child>), 755this method finds that specific C<$child> by comparing it with all the other 756children until it finds a match. At which point the C<$child> is removed. If 757no match is found, and exception is thrown. If a non-B<Tree::Simple> object 758is given as the C<$child> argument, an exception is thrown. 759 760This method also accepts a numeric C<$index> and removes the child found at 761that index from it's list of children. The C<$index> is bounds checked, if 762this condition fail, an exception is thrown. 763 764When a child is removed, it results in the shifting up of all children after 765it, and the removed child is returned. The removed child is properly 766disconnected from the tree and all its references to its old parent are 767removed. However, in order to properly clean up and circular references 768the removed child might have, it is advised to call it's C<DESTROY> method. 769See 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 779The C<addSibling>, C<addSiblings>, C<insertSibling> and C<insertSiblings> 780methods pass along their arguments to the C<addChild>, C<addChildren>, 781C<insertChild> and C<insertChildren> methods of their parent object 782respectively. This eliminates the need to overload these methods in subclasses 783which may have specialized versions of the *Child(ren) methods. The one 784exceptions is that if an attempt it made to add or insert siblings to the 785B<ROOT> of the tree then an exception is thrown. 786 787=back 788 789B<NOTE:> 790There is no C<removeSibling> method as I felt it was probably a bad idea. 791The same effect can be achieved by manual upwards traversal. 792 793=head2 Accessor Methods 794 795=over 4 796 797=item B<getNodeValue> 798 799This returns the value stored in the object's node field. 800 801=item B<getUID> 802 803This returns the unique ID associated with this particular tree. This can 804be custom set using the C<setUID> method, or you can just use the default. 805The default is the hex-address extracted from the stringified Tree::Simple 806object. This may not be a I<universally> unique identifier, but it should 807be adequate for at least the current instance of your perl interpreter. If 808you 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 813This returns the child (a B<Tree::Simple> object) found at the specified 814C<$index>. Note that we do use standard zero-based array indexing. 815 816=item B<getAllChildren> 817 818This returns an array of all the children (all B<Tree::Simple> objects). 819It will return an array reference in scalar context. 820 821=item B<getSibling ($index)> 822 823=item B<getAllSiblings> 824 825Much like C<addSibling> and C<addSiblings>, these two methods simply call 826C<getChild> and C<getAllChildren> on the invocant's parent. 827 828=item B<getDepth> 829 830Returns a number representing the invocant's depth within the hierarchy of 831B<Tree::Simple> objects. 832 833B<NOTE:> A C<ROOT> tree has the depth of -1. This be because Tree::Simple 834assumes that a tree's root will usually not contain data, but just be an 835anchor for the data-containing branches. This may not be intuitive in all 836cases, so I mention it here. 837 838=item B<getParent> 839 840Returns the invocant's parent, which could be either B<ROOT> or a 841B<Tree::Simple> object. 842 843=item B<getHeight> 844 845Returns a number representing the length of the longest path from the current 846tree to the furthest leaf node. 847 848=item B<getWidth> 849 850Returns the a number representing the breadth of the current tree, basically 851it is a count of all the leaf nodes. 852 853=item B<getChildCount> 854 855Returns the number of children the invocant contains. 856 857=item B<getIndex> 858 859Returns the index of this tree within its parent's child list. Returns -1 if 860the tree is the root. 861 862=back 863 864=head2 Predicate Methods 865 866=over 4 867 868=item B<isLeaf> 869 870Returns true (1) if the invocant does not have any children, false (0) otherwise. 871 872=item B<isRoot> 873 874Returns 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 885This method accepts two arguments a mandatory C<$func> and an optional 886C<$postfunc>. If the argument C<$func> is not defined then an exception 887is thrown. If C<$func> or C<$postfunc> are not in fact CODE references 888then an exception is thrown. The function C<$func> is then applied 889recursively to all the children of the invocant. If given, the function 890C<$postfunc> will be applied to each child after the child's children 891have been traversed. 892 893Here is an example of a traversal function that will print out the 894hierarchy as a tabbed in list. 895 896 $tree->traverse(sub { 897 my ($_tree) = @_; 898 print (("\t" x $_tree->getDepth()), $_tree->getNodeValue(), "\n"); 899 }); 900 901Here is an example of a traversal function that will print out the 902hierarchy 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 917Returns the total number of nodes in the current tree and all its sub-trees. 918 919=item B<height> 920 921This method has also been B<deprecated> in favor of the C<getHeight> method above, 922it remains as an alias to C<getHeight> for backwards compatability. 923 924B<NOTE:> This is also no longer a recursive method which get's it's value on demand, 925but a value stored in the Tree::Simple object itself, hopefully making it much 926more efficient and usable. 927 928=back 929 930=head2 Visitor Methods 931 932=over 4 933 934=item B<accept ($visitor)> 935 936It 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 942I have also created a number of Visitor objects and packaged them into the 943B<Tree::Simple::VisitorFactory>. 944 945=back 946 947=head2 Cloning Methods 948 949Cloning a tree can be an extremly expensive operation for large trees, so we provide 950two options for cloning, a deep clone and a shallow clone. 951 952When a Tree::Simple object is cloned, the node is deep-copied in the following manner. 953If we find a normal scalar value (non-reference), we simply copy it. If we find an 954object, we attempt to call C<clone> on it, otherwise we just copy the reference (since 955we assume the object does not want to be cloned). If we find a SCALAR, REF reference we 956copy the value contained within it. If we find a HASH or ARRAY reference we copy the 957reference and recursively copy all the elements within it (following these exact 958guidelines). We also do our best to assure that circular references are cloned 959only once and connections restored correctly. This cloning will not be able to copy 960CODE, RegExp and GLOB references, as they are pretty much impossible to clone. We 961also do not handle C<tied> objects, and they will simply be copied as plain 962references, and not re-C<tied>. 963 964=over 4 965 966=item B<clone> 967 968The clone method does a full deep-copy clone of the object, calling C<clone> recursively 969on all its children. This does not call C<clone> on the parent tree however. Doing 970this would result in a slowly degenerating spiral of recursive death, so it is not 971recommended and therefore not implemented. What happens is that the tree instance 972that C<clone> is actually called upon is detached from the tree, and becomes a root 973node, all if the cloned children are then attached as children of that tree. I personally 974think this is more intuitive then to have the cloning crawl back I<up> the tree is not 975what I think most people would expect. 976 977=item B<cloneShallow> 978 979This method is an alternate option to the plain C<clone> method. This method allows the 980cloning of single B<Tree::Simple> object while retaining connections to the rest of the 981tree/hierarchy. 982 983=back 984 985=head2 Misc. Methods 986 987=over 4 988 989=item B<DESTROY> 990 991To avoid memory leaks through uncleaned-up circular references, we implement the 992C<DESTROY> method. This method will attempt to call C<DESTROY> on each of its 993children (if it has any). This will result in a cascade of calls to C<DESTROY> on 994down the tree. It also cleans up it's parental relations as well. 995 996Because of perl's reference counting scheme and how that interacts with circular 997references, if you want an object to be properly reaped you should manually call 998C<DESTROY>. This is especially nessecary if your object has any children. See the 999section on L<CIRCULAR REFERENCES> for more information. 1000 1001=item B<fixDepth> 1002 1003Tree::Simple will manage your tree's depth field for you using this method. You 1004should never need to call it on your own, however if you ever did need to, here 1005is it. Running this method will traverse your all the invocant's sub-trees 1006correcting the depth as it goes. 1007 1008=item B<fixHeight> 1009 1010Tree::Simple will manage your tree's height field for you using this method. 1011You should never need to call it on your own, however if you ever did need to, 1012here is it. Running this method will correct the heights of the current tree 1013and all it's ancestors. 1014 1015=item B<fixWidth> 1016 1017Tree::Simple will manage your tree's width field for you using this method. You 1018should never need to call it on your own, however if you ever did need to, 1019here is it. Running this method will correct the widths of the current tree 1020and all it's ancestors. 1021 1022=back 1023 1024=head2 Private Methods 1025 1026I would not normally document private methods, but in case you need to subclass 1027Tree::Simple, here they are. 1028 1029=over 4 1030 1031=item B<_init ($node, $parent, $children)> 1032 1033This method is here largely to facilitate subclassing. This method is called by 1034new to initialize the object, where new's primary responsibility is creating 1035the instance. 1036 1037=item B<_setParent ($parent)> 1038 1039This method sets up the parental relationship. It is for internal use only. 1040 1041=item B<_setHeight ($child)> 1042 1043This method will set the height field based upon the height of the given C<$child>. 1044 1045=back 1046 1047=head1 CIRCULAR REFERENCES 1048 1049I have revised the model by which Tree::Simple deals with ciruclar references. 1050In the past all circular references had to be manually destroyed by calling 1051DESTROY. The call to DESTROY would then call DESTROY on all the children, and 1052therefore cascade down the tree. This however was not always what was needed, 1053nor what made sense, so I have now revised the model to handle things in what 1054I feel is a more consistent and sane way. 1055 1056Circular references are now managed with the simple idea that the parent makes 1057the descisions for the child. This means that child-to-parent references are 1058weak, while parent-to-child references are strong. So if a parent is destroyed 1059it will force all it's children to detach from it, however, if a child is 1060destroyed it will not be detached from it's parent. 1061 1062=head2 Optional Weak References 1063 1064By default, you are still required to call DESTROY in order for things to 1065happen. However I have now added the option to use weak references, which 1066alleviates the need for the manual call to DESTROY and allows Tree::Simple 1067to manage this automatically. This is accomplished with a compile time 1068setting like this: 1069 1070 use Tree::Simple 'use_weak_refs'; 1071 1072And from that point on Tree::Simple will use weak references to allow for 1073perl's reference counting to clean things up properly. 1074 1075For those who are unfamilar with weak references, and how they affect the 1076reference counts, here is a simple illustration. First is the normal model 1077that 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 1093Here, Tree::Simple1 has a reference count of 2 (one for the original 1094variable it is assigned to, and one for the parent reference in 1095Tree::Simple2), and Tree::Simple2 has a reference count of 1 (for the 1096child reference in Tree::Simple2). 1097 1098Now, 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 1114Now Tree::Simple1 has a reference count of 1 (for the variable it is 1115assigned to) and 1 weakened reference (for the parent reference in 1116Tree::Simple2). And Tree::Simple2 has a reference count of 1, just 1117as before. 1118 1119=head1 BUGS 1120 1121None that I am aware of. The code is pretty thoroughly tested (see 1122L<CODE COVERAGE> below) and is based on an (non-publicly released) 1123module which I had used in production systems for about 3 years without 1124incident. Of course, if you find a bug, let me know, and I will be sure 1125to fix it. 1126 1127=head1 CODE COVERAGE 1128 1129I use L<Devel::Cover> to test the code coverage of my tests, below 1130is 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 1143I have written a number of other modules which use or augment this 1144module, 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 1158Also, the author of L<Data::TreeDumper> and I have worked together 1159to make sure that B<Tree::Simple> and his module work well together. 1160If you need a quick and handy way to dump out a Tree::Simple heirarchy, 1161this module does an excellent job (and plenty more as well). 1162 1163I have also recently stumbled upon some packaged distributions of 1164Tree::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 1178There are a few other Tree modules out there, here is a quick comparison 1179between B<Tree::Simple> and them. Obviously I am biased, so take what I say 1180with a grain of salt, and keep in mind, I wrote B<Tree::Simple> because I 1181could not find a Tree module that suited my needs. If B<Tree::Simple> does 1182not fit your needs, I recommend looking at these modules. Please note that 1183I am only listing Tree::* modules I am familiar with here, if you think I 1184have missed a module, please let me know. I have also seen a few tree-ish 1185modules outside of the Tree::* namespace, but most of them are part of 1186another distribution (B<HTML::Tree>, B<Pod::Tree>, etc) and are likely 1187specialized in purpose. 1188 1189=over 4 1190 1191=item L<Tree::DAG_Node> 1192 1193This module seems pretty stable and very robust with a lot of functionality. 1194However, B<Tree::DAG_Node> does not come with any automated tests. It's 1195I<test.pl> file simply checks the module loads and nothing else. While I 1196am sure the author tested his code, I would feel better if I was able to 1197see that. The module is approx. 3000 lines with POD, and 1,500 without the 1198POD. The shear depth and detail of the documentation and the ratio of code 1199to documentation is impressive, and not to be taken lightly. But given that 1200it is a well known fact that the likeliness of bugs increases along side the 1201size of the code, I do not feel comfortable with large modules like this 1202which have no tests. 1203 1204All this said, I am not a huge fan of the API either, I prefer the gender 1205neutral approach in B<Tree::Simple> to the mother/daughter style of B<Tree::DAG_Node>. 1206I also feel very strongly that B<Tree::DAG_Node> is trying to do much more 1207than makes sense in a single module, and is offering too many ways to do 1208the same or similar things. 1209 1210However, of all the Tree::* modules out there, B<Tree::DAG_Node> seems to 1211be one of the favorites, so it may be worth investigating. 1212 1213=item L<Tree::MultiNode> 1214 1215I am not very familiar with this module, however, I have heard some good 1216reviews of it, so I thought it deserved mention here. I believe it is 1217based upon C++ code found in the book I<Algorithms in C++> by Robert Sedgwick. 1218It uses a number of interesting ideas, such as a ::Handle object to traverse 1219the tree with (similar to Visitors, but also seem to be to be kind of like 1220a cursor). However, like B<Tree::DAG_Node>, it is somewhat lacking in tests 1221and has only 6 tests in its suite. It also has one glaring bug, which is 1222that there is currently no way to remove a child node. 1223 1224=item L<Tree::Nary> 1225 1226It is a (somewhat) direct translation of the N-ary tree from the GLIB 1227library, and the API is based on that. GLIB is a C library, which means 1228this is a very C-ish API. That doesn't appeal to me, it might to you, to 1229each their own. 1230 1231This module is similar in intent to B<Tree::Simple>. It implements a tree 1232with I<n> branches and has polymorphic node containers. It implements much 1233of the same methods as B<Tree::Simple> and a few others on top of that, but 1234being based on a C library, is not very OO. In most of the method calls 1235the C<$self> argument is not used and the second argument C<$node> is. 1236B<Tree::Simple> is a much more OO module than B<Tree::Nary>, so while they 1237are similar in functionality they greatly differ in implementation style. 1238 1239=item L<Tree> 1240 1241This module is pretty old, it has not been updated since Oct. 31, 1999 and 1242is still on version 0.01. It also seems to be (from the limited documentation) 1243a binary and a balanced binary tree, B<Tree::Simple> is an I<n>-ary tree, and 1244makes no attempt to balance anything. 1245 1246=item L<Tree::Ternary> 1247 1248This module is older than B<Tree>, last update was Sept. 24th, 1999. It 1249seems to be a special purpose tree, for storing and accessing strings, 1250not general purpose like B<Tree::Simple>. 1251 1252=item L<Tree::Ternary_XS> 1253 1254This module is an XS implementation of the above tree type. 1255 1256=item L<Tree::Trie> 1257 1258This too is a specialized tree type, it sounds similar to the B<Tree::Ternary>, 1259but it much newer (latest release in 2003). It seems specialized for the lookup 1260and retrieval of information like a hash. 1261 1262=item L<Tree::M> 1263 1264Is a wrapper for a C++ library, whereas B<Tree::Simple> is pure-perl. It also 1265seems to be a more specialized implementation of a tree, therefore not really 1266the same as B<Tree::Simple>. 1267 1268=item L<Tree::Fat> 1269 1270Is a wrapper around a C library, again B<Tree::Simple> is pure-perl. The author 1271describes FAT-trees as a combination of a Tree and an array. It looks like a 1272pretty mean and lean module, and good if you need speed and are implementing a 1273custom data-store of some kind. The author points out too that the module is 1274designed for embedding and there is not default embedding, so you can't really 1275use 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 1284with 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> 1291and 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 1299Stevan Little, E<lt>stevan@iinteractive.comE<gt> 1300 1301Rob Kinyon, E<lt>rob@iinteractive.comE<gt> 1302 1303=head1 COPYRIGHT AND LICENSE 1304 1305Copyright 2004-2006 by Infinity Interactive, Inc. 1306 1307L<http://www.iinteractive.com> 1308 1309This library is free software; you can redistribute it and/or modify 1310it under the same terms as Perl itself. 1311 1312=cut 1313