Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

initial commit

  • Loading branch information...
commit f376db97a3aed07d9598f56a34fb3a843bf7de47 0 parents
@Takadonet authored
15 MANIFEST
@@ -0,0 +1,15 @@
+MANIFEST
+README
+lib/Tree/Simple.pm
+lib/Tree/Simple/Visitor.pm
+t/10_Tree_Simple_test.t
+t/11_Tree_Simple_fixDepth_test.t
+t/12_Tree_Simple_exceptions_test.t
+t/13_Tree_Simple_clone_test.t
+t/14_Tree_Simple_leak_test.t
+t/14a_Tree_Simple_weak_refs_test.t
+t/15_Tree_Simple_height_test.t
+t/16_Tree_Simple_width_test.t
+t/20_Tree_Simple_Visitor_test.t
+t/pod.t
+t/pod_coverage.t
36 README
@@ -0,0 +1,36 @@
+Current Status: Not functional
+
+Building Tree::Simple
+
+$ ufo && make
+
+Below is the original README file for the cpan perl 5 version. Will need to be updated
+
+Tree/Simple version 1.18
+========================
+
+See the module documentation for more information.
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires no other modules and libraries outside of the core
+for normal usage. However it uses Test::Exception in the test suite.
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2004-2006 Infinity Interactive, Inc.
+
+http://www.iinteractive.com
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
1,333 lib/Tree/Simple.pm
@@ -0,0 +1,1333 @@
+class Tree::Simple {
+ ## class constants
+ #should not be has should be 'our'
+ has $.ROOT = "root";
+
+# # set the value of the unique id
+# ($self->{_uid}) = ("$self" =~ /\((.*?)\)$/);
+# # set the value of the node
+# $self->{_node} = $node;
+# # and set the value of _children
+# $self->{_children} = $children;
+# $self->{_height} = 1;
+# $self->{_width} = 1;
+
+ has $!uid;
+ has $.node is rw;
+ has @.children is rw;
+ has $.height is rw = 1;
+ has $.width is rw = 1;
+ has $.parent is rw;
+ has $.depth is rw =-1;
+
+
+# ## ----------------------------------------------------------------------------
+# ## Tree::Simple
+# ## ----------------------------------------------------------------------------
+
+# my $USE_WEAK_REFS;
+
+# sub import {
+# shift;
+# return unless @_;
+# if (lc($_[0]) eq 'use_weak_refs') {
+# $USE_WEAK_REFS++;
+# *Tree::Simple::weaken = \&Scalar::Util::weaken;
+# }
+# }
+
+
+# ### constructor
+#todo need to find hash reference so we can set it to uid
+
+multi method new($node) {
+ self.bless(*, node => $node,parent => 'root');
+}
+
+multi method new($node,'root'){
+ self.bless(*, node => $node,parent =>'root');
+}
+
+
+method _init {
+# my ($self, $node, $parent, $children) = @_;
+# # set the value of the unique id
+# ($self->{_uid}) = ("$self" =~ /\((.*?)\)$/);
+# # set the value of the node
+# $self->{_node} = $node;
+# # and set the value of _children
+# $self->{_children} = $children;
+# $self->{_height} = 1;
+# $self->{_width} = 1;
+# # Now check our $parent value
+# if (defined($parent)) {
+# if (blessed($parent) && $parent->isa("Tree::Simple")) {
+# # and set it as our parent
+# $parent->addChild($self);
+# }
+# elsif ($parent eq $self->ROOT) {
+# $self->_setParent( $self->ROOT );
+# }
+# else {
+# die "Insufficient Arguments : parent argument must be a Tree::Simple object";
+# }
+# }
+# else {
+# $self->_setParent( $self->ROOT );
+# }
+}
+
+ #believe parameter check would be Tree::Simple
+ #also should be private but cannot modify others setParent
+method setParent($parent) {
+# my ($self, $parent) = @_;
+# (defined($parent) &&
+# (($parent eq $self->ROOT) || (blessed($parent) && $parent->isa("Tree::Simple"))))
+# || die "Insufficient Arguments : parent also must be a Tree::Simple object";
+ $.parent = $parent;
+ if ($parent eq $.ROOT) {
+ $._depth = -1;
+ }
+ else {
+# weaken($self->{_parent}) if $USE_WEAK_REFS;
+# $self->{_depth} = $parent->getDepth() + 1;
+ $.depth = $parent.getDepth() + 1;
+ }
+}
+
+method _detachParent {
+# return if $USE_WEAK_REFS;
+# my ($self) = @_;
+# $self->{_parent} = undef;
+}
+
+method setHeight(Tree::Simple $child) {
+
+ my $child_height = $child.getHeight();
+# return if ($self->{_height} >= $child_height + 1);
+ if self.height < $child_height +1 {
+ self.height = $child_height+1;
+ }
+
+
+# $self->{_height} = $child_height + 1;
+
+ # and now bubble up to the parent (unless we are the root)
+ if ! self.isRoot() {
+ self.getParent().setHeight(self);
+ }
+}
+
+multi method setWidth(Tree::Simple $child_width) {
+ return if self.width > self.getChildCount();
+
+ self.width += $child_width.getWidth();
+ # and now bubble up to the parent (unless we are the root)
+ self.getParent().setWidth($child_width) unless .self.isRoot();
+}
+
+
+multi method setWidth(Int $child_width) {
+ self.width += $child_width;
+ # and now bubble up to the parent (unless we are the root)
+ self.getParent().setWidth($child_width) unless .self.isRoot();
+}
+
+# ## ----------------------------------------------------------------------------
+# ## mutators
+
+method setNodeValue {
+# my ($self, $node_value) = @_;
+# (defined($node_value)) || die "Insufficient Arguments : must supply a value for node";
+# $self->{_node} = $node_value;
+}
+
+method setUID {
+# my ($self, $uid) = @_;
+# ($uid) || die "Insufficient Arguments : Custom Unique ID's must be a true value";
+# $self->{_uid} = $uid;
+}
+
+# ## ----------------------------------------------
+# ## child methods
+
+#around type method like moose
+method addChild(Tree::Simple $child) {
+ #provides the index
+# splice @_, 1, 0, $_[0]->getChildCount;
+ my $index = self.getChildCount();
+ self.insertChildAt($index,$child);
+}
+
+method addChildren {
+# splice @_, 1, 0, $_[0]->getChildCount;
+# goto &insertChildren;
+}
+
+ #need to have an index and at least one child
+method insertChildAt(Int $index where { $index >= 0 },*@trees where { @trees.elems() > 0 }) {
+ # check the bounds of our children
+ # against the index given
+ my $max = self.getChildCount();
+ if $index > $max {
+ die "Index Out of Bounds : got ($index) expected no more than (" ~ $max ~ ")";
+ }
+
+
+ for @trees -> $tree is rw {
+# (blessed($tree) && $tree->isa("Tree::Simple"))
+# || die "Insufficient Arguments : Child must be a Tree::Simple object";
+ $tree.setParent(self);
+ self.setHeight($tree);
+ self.setWidth($tree);
+ $tree.fixDepth() unless $tree.isLeaf();
+ }
+
+ # if index is zero, use this optimization
+ if $index == 0 {
+ unshift self.children , @trees;
+# unshift @{$self->{_children}} => @trees;
+ }
+ # if index is equal to the number of children
+ # then use this optimization
+ elsif $index == $max {
+ push self.children , @trees;
+# push @{$self->{_children}} => @trees;
+ }
+ # otherwise do some heavy lifting here
+ else {
+ say 'nyi 199';
+# splice @{$self->{_children}}, $index, 0, @trees;
+ }
+}
+
+# *insertChildren = \&_insertChildAt;
+
+# # insertChild is really the same as insertChildren, you are just
+# # inserting an array of one tree
+# *insertChild = \&insertChildren;
+
+method removeChildAt {
+# my ($self, $index) = @_;
+# (defined($index))
+# || die "Insufficient Arguments : Cannot remove child without index.";
+# ($self->getChildCount() != 0)
+# || die "Illegal Operation : There are no children to remove";
+# # check the bounds of our children
+# # against the index given
+# ($index < $self->getChildCount())
+# || die "Index Out of Bounds : got ($index) expected no more than (" . $self->getChildCount() . ")";
+# my $removed_child;
+# # if index is zero, use this optimization
+# if ($index == 0) {
+# $removed_child = shift @{$self->{_children}};
+# }
+# # if index is equal to the number of children
+# # then use this optimization
+# elsif ($index == $#{$self->{_children}}) {
+# $removed_child = pop @{$self->{_children}};
+# }
+# # otherwise do some heavy lifting here
+# else {
+# $removed_child = $self->{_children}->[$index];
+# splice @{$self->{_children}}, $index, 1;
+# }
+# # make sure we fix the height
+# $self->fixHeight();
+# $self->fixWidth();
+# # make sure that the removed child
+# # is no longer connected to the parent
+# # so we change its parent to ROOT
+# $removed_child->_setParent($self->ROOT);
+# # and now we make sure that the depth
+# # of the removed child is aligned correctly
+# $removed_child->fixDepth() unless $removed_child->isLeaf();
+# # return ths removed child
+# # it is the responsibility
+# # of the user of this module
+# # to properly dispose of this
+# # child (and all its sub-children)
+# return $removed_child;
+}
+
+method removeChild {
+# my ($self, $child_to_remove) = @_;
+# (defined($child_to_remove))
+# || die "Insufficient Arguments : you must specify a child to remove";
+# # maintain backwards compatability
+# # so any non-ref arguments will get
+# # sent to removeChildAt
+# return $self->removeChildAt($child_to_remove) unless ref($child_to_remove);
+# # now that we are confident it's a reference
+# # make sure it is the right kind
+# (blessed($child_to_remove) && $child_to_remove->isa("Tree::Simple"))
+# || die "Insufficient Arguments : Only valid child type is a Tree::Simple object";
+# my $index = 0;
+# foreach my $child ($self->getAllChildren()) {
+# ("$child" eq "$child_to_remove") && return $self->removeChildAt($index);
+# $index++;
+# }
+# die "Child Not Found : cannot find object ($child_to_remove) in self";
+}
+
+method getIndex {
+ return -1 if $.parent eq $.ROOT;
+ my $index = 0;
+ for self.parent.getAllChildren() -> $sibling {
+ #probably stringify the object to see if they are the same. Nice short circuit as well
+ ("$sibling" eq self) && return $index;
+ $index++;
+ }
+ return $index;
+}
+
+# ## ----------------------------------------------
+# ## Sibling methods
+
+# # these addSibling and addSiblings functions
+# # just pass along their arguments to the addChild
+# # and addChildren method respectively, this
+# # eliminates the need to overload these method
+# # in things like the Keyable Tree object
+
+method addSibling {
+# my ($self, @args) = @_;
+# (!$self->isRoot())
+# || die "Insufficient Arguments : cannot add a sibling to a ROOT tree";
+# $self->{_parent}->addChild(@args);
+}
+
+method addSiblings {
+# my ($self, @args) = @_;
+# (!$self->isRoot())
+# || die "Insufficient Arguments : cannot add siblings to a ROOT tree";
+# $self->{_parent}->addChildren(@args);
+}
+
+method insertSiblings {
+# my ($self, @args) = @_;
+# (!$self->isRoot())
+# || die "Insufficient Arguments : cannot insert sibling(s) to a ROOT tree";
+# $self->{_parent}->insertChildren(@args);
+}
+
+# # insertSibling is really the same as
+# # insertSiblings, you are just inserting
+# # and array of one tree
+# *insertSibling = \&insertSiblings;
+
+# # I am not permitting the removal of siblings
+# # as I think in general it is a bad idea
+
+# ## ----------------------------------------------------------------------------
+## accessors
+#todo remove them and add the alias to the attributes
+method getUID { $_[0]{_uid} }
+method getParent { $.parent; }
+method getDepth { $.depth; }
+method getNodeValue { $.node; }
+method getWidth { $_[0]{_width} }
+method getHeight { $.height; }
+
+# # for backwards compatability
+# *height = \&getHeight;
+
+method getChildCount {
+ #$#{$_[0]{_children}} + 1
+ @.children.elems();
+
+}
+
+method getChild(Int $index) {
+ return self.children[$index];
+}
+
+method getAllChildren {
+# my ($self) = @_;
+# return wantarray ?
+# @{$self->{_children}}
+# :
+# $self->{_children};
+}
+
+method getSibling {
+# my ($self, $index) = @_;
+# (!$self->isRoot())
+# || die "Insufficient Arguments : cannot get siblings from a ROOT tree";
+# $self->getParent()->getChild($index);
+}
+
+method getAllSiblings {
+# my ($self) = @_;
+# (!$self->isRoot())
+# || die "Insufficient Arguments : cannot get siblings from a ROOT tree";
+# $self->getParent()->getAllChildren();
+}
+
+# ## ----------------------------------------------------------------------------
+# ## informational
+
+method isLeaf {
+# $_[0]->getChildCount == 0
+ self.getChildCount() == 0;
+}
+
+method isRoot {
+ return (!defined($.parent) || $.parent eq $.ROOT);
+}
+
+method size {
+# my ($self) = @_;
+# my $size = 1;
+# foreach my $child ($self->getAllChildren()) {
+# $size += $child->size();
+# }
+# return $size;
+}
+
+# ## ----------------------------------------------------------------------------
+# ## misc
+
+# # NOTE:
+# # Occasionally one wants to have the
+# # depth available for various reasons
+# # of convience. Sometimes that depth
+# # field is not always correct.
+# # If you create your tree in a top-down
+# # manner, this is usually not an issue
+# # since each time you either add a child
+# # or create a tree you are doing it with
+# # a single tree and not a hierarchy.
+# # If however you are creating your tree
+# # bottom-up, then you might find that
+# # when adding hierarchies of trees, your
+# # depth fields are all out of whack.
+# # This is where this method comes into play
+# # it will recurse down the tree and fix the
+# # depth fields appropriately.
+# # This method is called automatically when
+# # a subtree is added to a child array
+method fixDepth {
+ # make sure the tree's depth
+ # is up to date all the way down
+ say 'nyi 414';
+ self.traverse(sub ($tree) {
+ return if $tree.isRoot();
+ $tree.depth = $tree.getParent().getDepth() + 1;
+ }
+ );
+}
+
+# # NOTE:
+# # This method is used to fix any height
+# # discrepencies which might arise when
+# # you remove a sub-tree
+method fixHeight {
+# my ($self) = @_;
+# # we must find the tallest sub-tree
+# # and use that to define the height
+# my $max_height = 0;
+# unless ($self->isLeaf()) {
+# foreach my $child ($self->getAllChildren()) {
+# my $child_height = $child->getHeight();
+# $max_height = $child_height if ($max_height < $child_height);
+# }
+# }
+# # if there is no change, then we
+# # need not bubble up through the
+# # parents
+# return if ($self->{_height} == ($max_height + 1));
+# # otherwise ...
+# $self->{_height} = $max_height + 1;
+# # now we need to bubble up through the parents
+# # in order to rectify any issues with height
+# $self->getParent()->fixHeight() unless $self->isRoot();
+}
+
+method fixWidth {
+# my ($self) = @_;
+# my $fixed_width = 0;
+# $fixed_width += $_->getWidth() foreach $self->getAllChildren();
+# $self->{_width} = $fixed_width;
+# $self->getParent()->fixWidth() unless $self->isRoot();
+}
+
+method traverse {
+# my ($self, $func, $post) = @_;
+# (defined($func)) || die "Insufficient Arguments : Cannot traverse without traversal function";
+# (ref($func) eq "CODE") || die "Incorrect Object Type : traversal function is not a function";
+# (ref($post) eq "CODE") || die "Incorrect Object Type : post traversal function is not a function"
+# if defined($post);
+# foreach my $child ($self->getAllChildren()) {
+# $func->($child);
+# $child->traverse($func, $post);
+# defined($post) && $post->($child);
+# }
+}
+
+# # this is an improved version of the
+# # old accept method, it now it more
+# # accepting of its arguments
+method accept {
+# my ($self, $visitor) = @_;
+# # it must be a blessed reference and ...
+# (blessed($visitor) &&
+# # either a Tree::Simple::Visitor object, or ...
+# ($visitor->isa("Tree::Simple::Visitor") ||
+# # it must be an object which has a 'visit' method avaiable
+# $visitor->can('visit')))
+# || die "Insufficient Arguments : You must supply a valid Visitor object";
+# $visitor->visit($self);
+}
+
+# ## ----------------------------------------------------------------------------
+# ## cloning
+
+method clone {
+# my ($self) = @_;
+# # first clone the value in the node
+# my $cloned_node = _cloneNode($self->getNodeValue());
+# # create a new Tree::Simple object
+# # here with the cloned node, however
+# # we do not assign the parent node
+# # since it really does not make a lot
+# # of sense. To properly clone it would
+# # be to clone back up the tree as well,
+# # which IMO is not intuitive. So in essence
+# # when you clone a tree, you detach it from
+# # any parentage it might have
+# my $clone = $self->new($cloned_node);
+# # however, because it is a recursive thing
+# # when you clone all the children, and then
+# # add them to the clone, you end up setting
+# # the parent of the children to be that of
+# # the clone (which is correct)
+# $clone->addChildren(
+# map { $_->clone() } $self->getAllChildren()
+# ) unless $self->isLeaf();
+# # return the clone
+# return $clone;
+}
+
+# # this allows cloning of single nodes while
+# # retaining connections to a tree, this is sloppy
+method cloneShallow {
+# my ($self) = @_;
+# my $cloned_tree = { %{$self} };
+# bless($cloned_tree, ref($self));
+# # just clone the node (if you can)
+# $cloned_tree->setNodeValue(_cloneNode($self->getNodeValue()));
+# return $cloned_tree;
+}
+
+# # this is a helper function which
+# # recursively clones the node
+method _cloneNode {
+# my ($node, $seen) = @_;
+# # create a cache if we dont already
+# # have one to prevent circular refs
+# # from being copied more than once
+# $seen = {} unless defined $seen;
+# # now here we go...
+# my $clone;
+# # if it is not a reference, then lets just return it
+# return $node unless ref($node);
+# # if it is in the cache, then return that
+# return $seen->{$node} if exists ${$seen}{$node};
+# # if it is an object, then ...
+# if (blessed($node)) {
+# # see if we can clone it
+# if ($node->can('clone')) {
+# $clone = $node->clone();
+# }
+# # otherwise respect that it does
+# # not want to be cloned
+# else {
+# $clone = $node;
+# }
+# }
+# else {
+# # if the current slot is a scalar reference, then
+# # dereference it and copy it into the new object
+# if (ref($node) eq "SCALAR" || ref($node) eq "REF") {
+# my $var = "";
+# $clone = \$var;
+# ${$clone} = _cloneNode(${$node}, $seen);
+# }
+# # if the current slot is an array reference
+# # then dereference it and copy it
+# elsif (ref($node) eq "ARRAY") {
+# $clone = [ map { _cloneNode($_, $seen) } @{$node} ];
+# }
+# # if the current reference is a hash reference
+# # then dereference it and copy it
+# elsif (ref($node) eq "HASH") {
+# $clone = {};
+# foreach my $key (keys %{$node}) {
+# $clone->{$key} = _cloneNode($node->{$key}, $seen);
+# }
+# }
+# else {
+# # all other ref types are not copied
+# $clone = $node;
+# }
+# }
+# # store the clone in the cache and
+# $seen->{$node} = $clone;
+# # then return the clone
+# return $clone;
+}
+
+
+# ## ----------------------------------------------------------------------------
+# ## Desctructor
+
+method DESTROY {
+# # if we are using weak refs
+# # we dont need to worry about
+# # destruction, it will just happen
+# return if $USE_WEAK_REFS;
+# my ($self) = @_;
+# # we want to detach all our children from
+# # ourselves, this will break most of the
+# # connections and allow for things to get
+# # reaped properly
+# unless (!$self->{_children} && scalar(@{$self->{_children}}) == 0) {
+# foreach my $child (@{$self->{_children}}) {
+# defined $child && $child->_detachParent();
+# }
+# }
+# # we do not need to remove or undef the _children
+# # of the _parent fields, this will cause some
+# # unwanted releasing of connections.
+}
+
+## ----------------------------------------------------------------------------
+## end Tree::Simple
+## ----------------------------------------------------------------------------
+
+};
+
+
+# __END__
+
+# =head1 NAME
+
+# Tree::Simple - A simple tree object
+
+# =head1 SYNOPSIS
+
+# use Tree::Simple;
+
+# # make a tree root
+# my $tree = Tree::Simple->new("0", Tree::Simple->ROOT);
+
+# # explicity add a child to it
+# $tree->addChild(Tree::Simple->new("1"));
+
+# # specify the parent when creating
+# # an instance and it adds the child implicity
+# my $sub_tree = Tree::Simple->new("2", $tree);
+
+# # chain method calls
+# $tree->getChild(0)->addChild(Tree::Simple->new("1.1"));
+
+# # add more than one child at a time
+# $sub_tree->addChildren(
+# Tree::Simple->new("2.1"),
+# Tree::Simple->new("2.2")
+# );
+
+# # add siblings
+# $sub_tree->addSibling(Tree::Simple->new("3"));
+
+# # insert children a specified index
+# $sub_tree->insertChild(1, Tree::Simple->new("2.1a"));
+
+# # clean up circular references
+# $tree->DESTROY();
+
+# =head1 DESCRIPTION
+
+# This module in an fully object-oriented implementation of a simple n-ary
+# tree. It is built upon the concept of parent-child relationships, so
+# therefore every B<Tree::Simple> object has both a parent and a set of
+# children (who themselves may have children, and so on). Every B<Tree::Simple>
+# object also has siblings, as they are just the children of their immediate
+# parent.
+
+# It is can be used to model hierarchal information such as a file-system,
+# the organizational structure of a company, an object inheritance hierarchy,
+# versioned files from a version control system or even an abstract syntax
+# tree for use in a parser. It makes no assumptions as to your intended usage,
+# but instead simply provides the structure and means of accessing and
+# traversing said structure.
+
+# This module uses exceptions and a minimal Design By Contract style. All method
+# arguments are required unless specified in the documentation, if a required
+# argument is not defined an exception will usually be thrown. Many arguments
+# are also required to be of a specific type, for instance the C<$parent>
+# argument to the constructor B<must> be a B<Tree::Simple> object or an object
+# derived from B<Tree::Simple>, otherwise an exception is thrown. This may seems
+# harsh to some, but this allows me to have the confidence that my code works as
+# I intend, and for you to enjoy the same level of confidence when using this
+# module. Note however that this module does not use any Exception or Error module,
+# the exceptions are just strings thrown with C<die>.
+
+# I consider this module to be production stable, it is based on a module which has
+# been in use on a few production systems for approx. 2 years now with no issue.
+# The only difference is that the code has been cleaned up a bit, comments added and
+# the thorough tests written for its public release. I am confident it behaves as
+# I would expect it to, and is (as far as I know) bug-free. I have not stress-tested
+# it under extreme duress, but I don't so much intend for it to be used in that
+# type of situation. If this module cannot keep up with your Tree needs, i suggest
+# switching to one of the modules listed in the L<OTHER TREE MODULES> section below.
+
+# =head1 CONSTANTS
+
+# =over 4
+
+# =item B<ROOT>
+
+# This class constant serves as a placeholder for the root of our tree. If a tree
+# does not have a parent, then it is considered a root.
+
+# =back
+
+# =head1 METHODS
+
+# =head2 Constructor
+
+# =over 4
+
+# =item B<new ($node, $parent)>
+
+# The constructor accepts two arguments a C<$node> value and an optional C<$parent>.
+# The C<$node> value can be any scalar value (which includes references and objects).
+# The optional C<$parent> value must be a B<Tree::Simple> object, or an object
+# derived from B<Tree::Simple>. Setting this value implies that your new tree is a
+# child of the parent tree, and therefore adds it to the parent's children. If the
+# C<$parent> is not specified then its value defaults to ROOT.
+
+# =back
+
+# =head2 Mutator Methods
+
+# =over 4
+
+# =item B<setNodeValue ($node_value)>
+
+# This sets the node value to the scalar C<$node_value>, an exception is thrown if
+# C<$node_value> is not defined.
+
+# =item B<setUID ($uid)>
+
+# This allows you to set your own unique ID for this specific Tree::Simple object.
+# A default value derived from the object's hex address is provided for you, so use
+# of this method is entirely optional. It is the responsibility of the user to
+# ensure the value's uniqueness, all that is tested by this method is that C<$uid>
+# is a true value (evaluates to true in a boolean context). For even more information
+# about the Tree::Simple UID see the C<getUID> method.
+
+# =item B<addChild ($tree)>
+
+# This method accepts only B<Tree::Simple> objects or objects derived from
+# B<Tree::Simple>, an exception is thrown otherwise. This method will append
+# the given C<$tree> to the end of it's children list, and set up the correct
+# parent-child relationships. This method is set up to return its invocant so
+# that method call chaining can be possible. Such as:
+
+# my $tree = Tree::Simple->new("root")->addChild(Tree::Simple->new("child one"));
+
+# Or the more complex:
+
+# my $tree = Tree::Simple->new("root")->addChild(
+# Tree::Simple->new("1.0")->addChild(
+# Tree::Simple->new("1.0.1")
+# )
+# );
+
+# =item B<addChildren (@trees)>
+
+# This method accepts an array of B<Tree::Simple> objects, and adds them to
+# it's children list. Like C<addChild> this method will return its invocant
+# to allow for method call chaining.
+
+# =item B<insertChild ($index, $tree)>
+
+# This method accepts a numeric C<$index> and a B<Tree::Simple> object (C<$tree>),
+# and inserts the C<$tree> into the children list at the specified C<$index>.
+# This results in the shifting down of all children after the C<$index>. The
+# C<$index> is checked to be sure it is the bounds of the child list, if it
+# out of bounds an exception is thrown. The C<$tree> argument's type is
+# verified to be a B<Tree::Simple> or B<Tree::Simple> derived object, if
+# this condition fails, an exception is thrown.
+
+# =item B<insertChildren ($index, @trees)>
+
+# This method functions much as insertChild does, but instead of inserting a
+# single B<Tree::Simple>, it inserts an array of B<Tree::Simple> objects. It
+# too bounds checks the value of C<$index> and type checks the objects in
+# C<@trees> just as C<insertChild> does.
+
+# =item B<removeChild> ($child | $index)>
+
+# Accepts two different arguemnts. If given a B<Tree::Simple> object (C<$child>),
+# this method finds that specific C<$child> by comparing it with all the other
+# children until it finds a match. At which point the C<$child> is removed. If
+# no match is found, and exception is thrown. If a non-B<Tree::Simple> object
+# is given as the C<$child> argument, an exception is thrown.
+
+# This method also accepts a numeric C<$index> and removes the child found at
+# that index from it's list of children. The C<$index> is bounds checked, if
+# this condition fail, an exception is thrown.
+
+# When a child is removed, it results in the shifting up of all children after
+# it, and the removed child is returned. The removed child is properly
+# disconnected from the tree and all its references to its old parent are
+# removed. However, in order to properly clean up and circular references
+# the removed child might have, it is advised to call it's C<DESTROY> method.
+# See the L<CIRCULAR REFERENCES> section for more information.
+
+# =item B<addSibling ($tree)>
+
+# =item B<addSiblings (@trees)>
+
+# =item B<insertSibling ($index, $tree)>
+
+# =item B<insertSiblings ($index, @trees)>
+
+# The C<addSibling>, C<addSiblings>, C<insertSibling> and C<insertSiblings>
+# methods pass along their arguments to the C<addChild>, C<addChildren>,
+# C<insertChild> and C<insertChildren> methods of their parent object
+# respectively. This eliminates the need to overload these methods in subclasses
+# which may have specialized versions of the *Child(ren) methods. The one
+# exceptions is that if an attempt it made to add or insert siblings to the
+# B<ROOT> of the tree then an exception is thrown.
+
+# =back
+
+# B<NOTE:>
+# There is no C<removeSibling> method as I felt it was probably a bad idea.
+# The same effect can be achieved by manual upwards traversal.
+
+# =head2 Accessor Methods
+
+# =over 4
+
+# =item B<getNodeValue>
+
+# This returns the value stored in the object's node field.
+
+# =item B<getUID>
+
+# This returns the unique ID associated with this particular tree. This can
+# be custom set using the C<setUID> method, or you can just use the default.
+# The default is the hex-address extracted from the stringified Tree::Simple
+# object. This may not be a I<universally> unique identifier, but it should
+# be adequate for at least the current instance of your perl interpreter. If
+# you need a UUID, one can be generated with an outside module (there are
+# many to choose from on CPAN) and the C<setUID> method (see above).
+
+# =item B<getChild ($index)>
+
+# This returns the child (a B<Tree::Simple> object) found at the specified
+# C<$index>. Note that we do use standard zero-based array indexing.
+
+# =item B<getAllChildren>
+
+# This returns an array of all the children (all B<Tree::Simple> objects).
+# It will return an array reference in scalar context.
+
+# =item B<getSibling ($index)>
+
+# =item B<getAllSiblings>
+
+# Much like C<addSibling> and C<addSiblings>, these two methods simply call
+# C<getChild> and C<getAllChildren> on the invocant's parent.
+
+# =item B<getDepth>
+
+# Returns a number representing the invocant's depth within the hierarchy of
+# B<Tree::Simple> objects.
+
+# B<NOTE:> A C<ROOT> tree has the depth of -1. This be because Tree::Simple
+# assumes that a tree's root will usually not contain data, but just be an
+# anchor for the data-containing branches. This may not be intuitive in all
+# cases, so I mention it here.
+
+# =item B<getParent>
+
+# Returns the invocant's parent, which could be either B<ROOT> or a
+# B<Tree::Simple> object.
+
+# =item B<getHeight>
+
+# Returns a number representing the length of the longest path from the current
+# tree to the furthest leaf node.
+
+# =item B<getWidth>
+
+# Returns the a number representing the breadth of the current tree, basically
+# it is a count of all the leaf nodes.
+
+# =item B<getChildCount>
+
+# Returns the number of children the invocant contains.
+
+# =item B<getIndex>
+
+# Returns the index of this tree within its parent's child list. Returns -1 if
+# the tree is the root.
+
+# =back
+
+# =head2 Predicate Methods
+
+# =over 4
+
+# =item B<isLeaf>
+
+# Returns true (1) if the invocant does not have any children, false (0) otherwise.
+
+# =item B<isRoot>
+
+# Returns true (1) if the invocant's "parent" field is B<ROOT>, returns false
+# (0) otherwise.
+
+# =back
+
+# =head2 Recursive Methods
+
+# =over 4
+
+# =item B<traverse ($func, ?$postfunc)>
+
+# This method accepts two arguments a mandatory C<$func> and an optional
+# C<$postfunc>. If the argument C<$func> is not defined then an exception
+# is thrown. If C<$func> or C<$postfunc> are not in fact CODE references
+# then an exception is thrown. The function C<$func> is then applied
+# recursively to all the children of the invocant. If given, the function
+# C<$postfunc> will be applied to each child after the child's children
+# have been traversed.
+
+# Here is an example of a traversal function that will print out the
+# hierarchy as a tabbed in list.
+
+# $tree->traverse(sub {
+# my ($_tree) = @_;
+# print (("\t" x $_tree->getDepth()), $_tree->getNodeValue(), "\n");
+# });
+
+# Here is an example of a traversal function that will print out the
+# hierarchy in an XML-style format.
+
+# $tree->traverse(sub {
+# my ($_tree) = @_;
+# print ((' ' x $_tree->getDepth()),
+# '<', $_tree->getNodeValue(),'>',"\n");
+# },
+# sub {
+# my ($_tree) = @_;
+# print ((' ' x $_tree->getDepth()),
+# '</', $_tree->getNodeValue(),'>',"\n");
+# });
+
+# =item B<size>
+
+# Returns the total number of nodes in the current tree and all its sub-trees.
+
+# =item B<height>
+
+# This method has also been B<deprecated> in favor of the C<getHeight> method above,
+# it remains as an alias to C<getHeight> for backwards compatability.
+
+# B<NOTE:> This is also no longer a recursive method which get's it's value on demand,
+# but a value stored in the Tree::Simple object itself, hopefully making it much
+# more efficient and usable.
+
+# =back
+
+# =head2 Visitor Methods
+
+# =over 4
+
+# =item B<accept ($visitor)>
+
+# It accepts either a B<Tree::Simple::Visitor> object (which includes classes derived
+# from B<Tree::Simple::Visitor>), or an object who has the C<visit> method available
+# (tested with C<$visitor-E<gt>can('visit')>). If these qualifications are not met,
+# and exception will be thrown. We then run the Visitor's C<visit> method giving the
+# current tree as its argument.
+
+# I have also created a number of Visitor objects and packaged them into the
+# B<Tree::Simple::VisitorFactory>.
+
+# =back
+
+# =head2 Cloning Methods
+
+# Cloning a tree can be an extremly expensive operation for large trees, so we provide
+# two options for cloning, a deep clone and a shallow clone.
+
+# When a Tree::Simple object is cloned, the node is deep-copied in the following manner.
+# If we find a normal scalar value (non-reference), we simply copy it. If we find an
+# object, we attempt to call C<clone> on it, otherwise we just copy the reference (since
+# we assume the object does not want to be cloned). If we find a SCALAR, REF reference we
+# copy the value contained within it. If we find a HASH or ARRAY reference we copy the
+# reference and recursively copy all the elements within it (following these exact
+# guidelines). We also do our best to assure that circular references are cloned
+# only once and connections restored correctly. This cloning will not be able to copy
+# CODE, RegExp and GLOB references, as they are pretty much impossible to clone. We
+# also do not handle C<tied> objects, and they will simply be copied as plain
+# references, and not re-C<tied>.
+
+# =over 4
+
+# =item B<clone>
+
+# The clone method does a full deep-copy clone of the object, calling C<clone> recursively
+# on all its children. This does not call C<clone> on the parent tree however. Doing
+# this would result in a slowly degenerating spiral of recursive death, so it is not
+# recommended and therefore not implemented. What happens is that the tree instance
+# that C<clone> is actually called upon is detached from the tree, and becomes a root
+# node, all if the cloned children are then attached as children of that tree. I personally
+# think this is more intuitive then to have the cloning crawl back I<up> the tree is not
+# what I think most people would expect.
+
+# =item B<cloneShallow>
+
+# This method is an alternate option to the plain C<clone> method. This method allows the
+# cloning of single B<Tree::Simple> object while retaining connections to the rest of the
+# tree/hierarchy.
+
+# =back
+
+# =head2 Misc. Methods
+
+# =over 4
+
+# =item B<DESTROY>
+
+# To avoid memory leaks through uncleaned-up circular references, we implement the
+# C<DESTROY> method. This method will attempt to call C<DESTROY> on each of its
+# children (if it has any). This will result in a cascade of calls to C<DESTROY> on
+# down the tree. It also cleans up it's parental relations as well.
+
+# Because of perl's reference counting scheme and how that interacts with circular
+# references, if you want an object to be properly reaped you should manually call
+# C<DESTROY>. This is especially nessecary if your object has any children. See the
+# section on L<CIRCULAR REFERENCES> for more information.
+
+# =item B<fixDepth>
+
+# Tree::Simple will manage your tree's depth field for you using this method. You
+# should never need to call it on your own, however if you ever did need to, here
+# is it. Running this method will traverse your all the invocant's sub-trees
+# correcting the depth as it goes.
+
+# =item B<fixHeight>
+
+# Tree::Simple will manage your tree's height field for you using this method.
+# You should never need to call it on your own, however if you ever did need to,
+# here is it. Running this method will correct the heights of the current tree
+# and all it's ancestors.
+
+# =item B<fixWidth>
+
+# Tree::Simple will manage your tree's width field for you using this method. You
+# should never need to call it on your own, however if you ever did need to,
+# here is it. Running this method will correct the widths of the current tree
+# and all it's ancestors.
+
+# =back
+
+# =head2 Private Methods
+
+# I would not normally document private methods, but in case you need to subclass
+# Tree::Simple, here they are.
+
+# =over 4
+
+# =item B<_init ($node, $parent, $children)>
+
+# This method is here largely to facilitate subclassing. This method is called by
+# new to initialize the object, where new's primary responsibility is creating
+# the instance.
+
+# =item B<_setParent ($parent)>
+
+# This method sets up the parental relationship. It is for internal use only.
+
+# =item B<_setHeight ($child)>
+
+# This method will set the height field based upon the height of the given C<$child>.
+
+# =back
+
+# =head1 CIRCULAR REFERENCES
+
+# I have revised the model by which Tree::Simple deals with ciruclar references.
+# In the past all circular references had to be manually destroyed by calling
+# DESTROY. The call to DESTROY would then call DESTROY on all the children, and
+# therefore cascade down the tree. This however was not always what was needed,
+# nor what made sense, so I have now revised the model to handle things in what
+# I feel is a more consistent and sane way.
+
+# Circular references are now managed with the simple idea that the parent makes
+# the descisions for the child. This means that child-to-parent references are
+# weak, while parent-to-child references are strong. So if a parent is destroyed
+# it will force all it's children to detach from it, however, if a child is
+# destroyed it will not be detached from it's parent.
+
+# =head2 Optional Weak References
+
+# By default, you are still required to call DESTROY in order for things to
+# happen. However I have now added the option to use weak references, which
+# alleviates the need for the manual call to DESTROY and allows Tree::Simple
+# to manage this automatically. This is accomplished with a compile time
+# setting like this:
+
+# use Tree::Simple 'use_weak_refs';
+
+# And from that point on Tree::Simple will use weak references to allow for
+# perl's reference counting to clean things up properly.
+
+# For those who are unfamilar with weak references, and how they affect the
+# reference counts, here is a simple illustration. First is the normal model
+# that Tree::Simple uses:
+
+# +---------------+
+# | Tree::Simple1 |<---------------------+
+# +---------------+ |
+# | parent | |
+# | children |-+ |
+# +---------------+ | |
+# | |
+# | +---------------+ |
+# +->| Tree::Simple2 | |
+# +---------------+ |
+# | parent |-+
+# | children |
+# +---------------+
+
+# Here, Tree::Simple1 has a reference count of 2 (one for the original
+# variable it is assigned to, and one for the parent reference in
+# Tree::Simple2), and Tree::Simple2 has a reference count of 1 (for the
+# child reference in Tree::Simple2).
+
+# Now, with weak references:
+
+# +---------------+
+# | Tree::Simple1 |.......................
+# +---------------+ :
+# | parent | :
+# | children |-+ : <--[ weak reference ]
+# +---------------+ | :
+# | :
+# | +---------------+ :
+# +->| Tree::Simple2 | :
+# +---------------+ :
+# | parent |..
+# | children |
+# +---------------+
+
+# Now Tree::Simple1 has a reference count of 1 (for the variable it is
+# assigned to) and 1 weakened reference (for the parent reference in
+# Tree::Simple2). And Tree::Simple2 has a reference count of 1, just
+# as before.
+
+# =head1 BUGS
+
+# None that I am aware of. The code is pretty thoroughly tested (see
+# L<CODE COVERAGE> below) and is based on an (non-publicly released)
+# module which I had used in production systems for about 3 years without
+# incident. Of course, if you find a bug, let me know, and I will be sure
+# to fix it.
+
+# =head1 CODE COVERAGE
+
+# I use L<Devel::Cover> to test the code coverage of my tests, below
+# is the L<Devel::Cover> report on this module's test suite.
+
+# ---------------------------- ------ ------ ------ ------ ------ ------ ------
+# File stmt branch cond sub pod time total
+# ---------------------------- ------ ------ ------ ------ ------ ------ ------
+# Tree/Simple.pm 99.6 96.0 92.3 100.0 97.0 95.5 98.0
+# Tree/Simple/Visitor.pm 100.0 96.2 88.2 100.0 100.0 4.5 97.7
+# ---------------------------- ------ ------ ------ ------ ------ ------ ------
+# Total 99.7 96.1 91.1 100.0 97.6 100.0 97.9
+# ---------------------------- ------ ------ ------ ------ ------ ------ ------
+
+# =head1 SEE ALSO
+
+# I have written a number of other modules which use or augment this
+# module, they are describes below and available on CPAN.
+
+# =over 4
+
+# =item L<Tree::Parser> - A module for parsing formatted files into Tree::Simple hierarchies.
+
+# =item L<Tree::Simple::View> - A set of classes for viewing Tree::Simple hierarchies in various output formats.
+
+# =item L<Tree::Simple::VisitorFactory> - A set of several useful Visitor objects for Tree::Simple objects.
+
+# =item L<Tree::Binary> - If you are looking for a binary tree, this you might want to check this one out.
+
+# =back
+
+# Also, the author of L<Data::TreeDumper> and I have worked together
+# to make sure that B<Tree::Simple> and his module work well together.
+# If you need a quick and handy way to dump out a Tree::Simple heirarchy,
+# this module does an excellent job (and plenty more as well).
+
+# I have also recently stumbled upon some packaged distributions of
+# Tree::Simple for the various Unix flavors. Here are some links:
+
+# =over 4
+
+# =item FreeBSD Port - L<http://www.freshports.org/devel/p5-Tree-Simple/>
+
+# =item Debian Package - L<http://packages.debian.org/unstable/perl/libtree-simple-perl>
+
+# =item Linux RPM - L<http://rpmpan.sourceforge.net/Tree.html>
+
+# =back
+
+# =head1 OTHER TREE MODULES
+
+# There are a few other Tree modules out there, here is a quick comparison
+# between B<Tree::Simple> and them. Obviously I am biased, so take what I say
+# with a grain of salt, and keep in mind, I wrote B<Tree::Simple> because I
+# could not find a Tree module that suited my needs. If B<Tree::Simple> does
+# not fit your needs, I recommend looking at these modules. Please note that
+# I am only listing Tree::* modules I am familiar with here, if you think I
+# have missed a module, please let me know. I have also seen a few tree-ish
+# modules outside of the Tree::* namespace, but most of them are part of
+# another distribution (B<HTML::Tree>, B<Pod::Tree>, etc) and are likely
+# specialized in purpose.
+
+# =over 4
+
+# =item L<Tree::DAG_Node>
+
+# This module seems pretty stable and very robust with a lot of functionality.
+# However, B<Tree::DAG_Node> does not come with any automated tests. It's
+# I<test.pl> file simply checks the module loads and nothing else. While I
+# am sure the author tested his code, I would feel better if I was able to
+# see that. The module is approx. 3000 lines with POD, and 1,500 without the
+# POD. The shear depth and detail of the documentation and the ratio of code
+# to documentation is impressive, and not to be taken lightly. But given that
+# it is a well known fact that the likeliness of bugs increases along side the
+# size of the code, I do not feel comfortable with large modules like this
+# which have no tests.
+
+# All this said, I am not a huge fan of the API either, I prefer the gender
+# neutral approach in B<Tree::Simple> to the mother/daughter style of B<Tree::DAG_Node>.
+# I also feel very strongly that B<Tree::DAG_Node> is trying to do much more
+# than makes sense in a single module, and is offering too many ways to do
+# the same or similar things.
+
+# However, of all the Tree::* modules out there, B<Tree::DAG_Node> seems to
+# be one of the favorites, so it may be worth investigating.
+
+# =item L<Tree::MultiNode>
+
+# I am not very familiar with this module, however, I have heard some good
+# reviews of it, so I thought it deserved mention here. I believe it is
+# based upon C++ code found in the book I<Algorithms in C++> by Robert Sedgwick.
+# It uses a number of interesting ideas, such as a ::Handle object to traverse
+# the tree with (similar to Visitors, but also seem to be to be kind of like
+# a cursor). However, like B<Tree::DAG_Node>, it is somewhat lacking in tests
+# and has only 6 tests in its suite. It also has one glaring bug, which is
+# that there is currently no way to remove a child node.
+
+# =item L<Tree::Nary>
+
+# It is a (somewhat) direct translation of the N-ary tree from the GLIB
+# library, and the API is based on that. GLIB is a C library, which means
+# this is a very C-ish API. That doesn't appeal to me, it might to you, to
+# each their own.
+
+# This module is similar in intent to B<Tree::Simple>. It implements a tree
+# with I<n> branches and has polymorphic node containers. It implements much
+# of the same methods as B<Tree::Simple> and a few others on top of that, but
+# being based on a C library, is not very OO. In most of the method calls
+# the C<$self> argument is not used and the second argument C<$node> is.
+# B<Tree::Simple> is a much more OO module than B<Tree::Nary>, so while they
+# are similar in functionality they greatly differ in implementation style.
+
+# =item L<Tree>
+
+# This module is pretty old, it has not been updated since Oct. 31, 1999 and
+# is still on version 0.01. It also seems to be (from the limited documentation)
+# a binary and a balanced binary tree, B<Tree::Simple> is an I<n>-ary tree, and
+# makes no attempt to balance anything.
+
+# =item L<Tree::Ternary>
+
+# This module is older than B<Tree>, last update was Sept. 24th, 1999. It
+# seems to be a special purpose tree, for storing and accessing strings,
+# not general purpose like B<Tree::Simple>.
+
+# =item L<Tree::Ternary_XS>
+
+# This module is an XS implementation of the above tree type.
+
+# =item L<Tree::Trie>
+
+# This too is a specialized tree type, it sounds similar to the B<Tree::Ternary>,
+# but it much newer (latest release in 2003). It seems specialized for the lookup
+# and retrieval of information like a hash.
+
+# =item L<Tree::M>
+
+# Is a wrapper for a C++ library, whereas B<Tree::Simple> is pure-perl. It also
+# seems to be a more specialized implementation of a tree, therefore not really
+# the same as B<Tree::Simple>.
+
+# =item L<Tree::Fat>
+
+# Is a wrapper around a C library, again B<Tree::Simple> is pure-perl. The author
+# describes FAT-trees as a combination of a Tree and an array. It looks like a
+# pretty mean and lean module, and good if you need speed and are implementing a
+# custom data-store of some kind. The author points out too that the module is
+# designed for embedding and there is not default embedding, so you can't really
+# use it "out of the box".
+
+# =back
+
+# =head1 ACKNOWLEDGEMENTS
+
+# =over 4
+
+# =item Thanks to Nadim Ibn Hamouda El Khemir for making L<Data::TreeDumper> work
+# with B<Tree::Simple>.
+
+# =item Thanks to Brett Nuske for his idea for the C<getUID> and C<setUID> methods.
+
+# =item Thanks to whomever submitted the memory leak bug to RT (#7512).
+
+# =item Thanks to Mark Thomas for his insight into how to best handle the I<height>
+# and I<width> properties without unessecary recursion.
+
+# =item Thanks for Mark Lawrence for the &traverse post-func patch, tests and docs.
+
+# =back
+
+# =head1 AUTHOR
+
+# Stevan Little, E<lt>stevan@iinteractive.comE<gt>
+
+# Rob Kinyon, E<lt>rob@iinteractive.comE<gt>
+
+# =head1 COPYRIGHT AND LICENSE
+
+# Copyright 2004-2006 by Infinity Interactive, Inc.
+
+# L<http://www.iinteractive.com>
+
+# This library is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+
+# =cut
270 lib/Tree/Simple/Visitor.pm
@@ -0,0 +1,270 @@
+
+package Tree::Simple::Visitor;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.11';
+
+use Scalar::Util qw(blessed);
+
+## class constants
+
+use constant RECURSIVE => 0x01;
+use constant CHILDREN_ONLY => 0x10;
+
+### constructor
+
+sub new {
+ my ($_class, $func, $depth) = @_;
+ if (defined($depth)){
+ ($depth =~ /\d+/ && ($depth == RECURSIVE || $depth == CHILDREN_ONLY))
+ || die "Insufficient Arguments : Depth arguement must be either RECURSIVE or CHILDREN_ONLY";
+ }
+ my $class = ref($_class) || $_class;
+ # if we have not supplied a $func
+ # it is automatically RECURSIVE
+ $depth = RECURSIVE unless defined $func;
+ my $visitor = {
+ depth => $depth || 0
+ };
+ bless($visitor, $class);
+ $visitor->_init();
+ if (defined $func) {
+ $visitor->setNodeFilter($func);
+ $visitor->includeTrunk(1);
+ }
+ return $visitor;
+}
+
+### methods
+
+sub _init {
+ my ($self) = @_;
+ $self->{_include_trunk} = 0;
+ $self->{_filter_function} = undef;
+ $self->{_results} = [];
+}
+
+sub includeTrunk {
+ my ($self, $boolean) = @_;
+ $self->{_include_trunk} = ($boolean ? 1 : 0) if defined $boolean;
+ return $self->{_include_trunk};
+}
+
+# node filter methods
+
+sub getNodeFilter {
+ my ($self) = @_;
+ return $self->{_filter_function};
+}
+
+sub clearNodeFilter {
+ my ($self) = @_;
+ $self->{_filter_function} = undef;
+}
+
+sub setNodeFilter {
+ my ($self, $filter_function) = @_;
+ (defined($filter_function) && ref($filter_function) eq "CODE")
+ || die "Insufficient Arguments : filter function argument must be a subroutine reference";
+ $self->{_filter_function} = $filter_function;
+}
+
+# results methods
+
+sub setResults {
+ my ($self, @results) = @_;
+ $self->{results} = \@results;
+}
+
+sub getResults {
+ my ($self) = @_;
+ return wantarray ?
+ @{$self->{results}}
+ :
+ $self->{results};
+}
+
+# visit routine
+sub visit {
+ my ($self, $tree) = @_;
+ (blessed($tree) && $tree->isa("Tree::Simple"))
+ || die "Insufficient Arguments : You must supply a valid Tree::Simple object";
+ # get all things set up
+ my @results;
+ my $func;
+ if ($self->{_filter_function}) {
+ $func = sub { push @results => $self->{_filter_function}->(@_) };
+ }
+ else {
+ $func = sub { push @results => $_[0]->getNodeValue() };
+ }
+ # always apply the function
+ # to the tree's node
+ $func->($tree) unless defined $self->{_include_trunk};
+ # then recursively to all its children
+ # if the object is configured that way
+ $tree->traverse($func) if ($self->{depth} == RECURSIVE);
+ # or just visit its immediate children
+ # if the object is configured that way
+ if ($self->{depth} == CHILDREN_ONLY) {
+ $func->($_) foreach $tree->getAllChildren();
+ }
+ # now store the results we got
+ $self->setResults(@results);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Tree::Simple::Visitor - Visitor object for Tree::Simple objects
+
+=head1 SYNOPSIS
+
+ use Tree::Simple;
+ use Tree::Simple::Visitor;
+
+ # create a visitor instance
+ my $visitor = Tree::Simple::Visitor->new();
+
+ # create a tree to visit
+ my $tree = Tree::Simple->new(Tree::Simple->ROOT)
+ ->addChildren(
+ Tree::Simple->new("1.0"),
+ Tree::Simple->new("2.0")
+ ->addChild(
+ Tree::Simple->new("2.1.0")
+ ),
+ Tree::Simple->new("3.0")
+ );
+
+ # by default this will collect all the
+ # node values in depth-first order into
+ # our results
+ $tree->accept($visitor);
+
+ # get our results and print them
+ print join ", ", $visitor->getResults(); # prints "1.0, 2.0, 2.1.0, 3.0"
+
+ # for more complex node objects, you can specify
+ # a node filter which will be used to extract the
+ # information desired from each node
+ $visitor->setNodeFilter(sub {
+ my ($t) = @_;
+ return $t->getNodeValue()->description();
+ });
+
+ # NOTE: this object has changed, but it still remains
+ # backwards compatible to the older version, see the
+ # DESCRIPTION section below for more details
+
+=head1 DESCRIPTION
+
+This object has been revised into what I think is more intelligent approach to Visitor objects. This is now a more suitable base class for building your own Visitors. It is also the base class for the visitors found in the B<Tree::Simple::VisitorFactory> distribution, which includes a number of useful pre-built Visitors.
+
+While I have changed a number of things about this module, I have kept it backwards compatible to the old way of using it. So the original example code still works:
+
+ my @accumulator;
+ my $visitor = Tree::Simple::Visitor->new(sub {
+ my ($tree) = @_;
+ push @accumlator, $tree->getNodeValue();
+ },
+ Tree::Simple::Visitor->RECURSIVE);
+
+ $tree->accept($visitor);
+
+ print join ", ", @accumulator; # prints "1.0, 2.0, 2.1.0, 3.0"
+
+But is better expressed as this:
+
+ my $visitor = Tree::Simple::Visitor->new();
+ $tree->accept($visitor);
+ print join ", ", $visitor->getResults(); # prints "1.0, 2.0, 2.1.0, 3.0"
+
+This object is still pretty much a wrapper around the Tree::Simple C<traverse> method, and can be thought of as a depth-first traversal Visitor object.
+
+=head1 METHODS
+
+=over 4
+
+=item B<new ($func, $depth)>
+
+The new style interface means that all arguments to the constructor are now optional. As a means of defining the usage of the old and new, when no arguments are sent to the constructor, it is assumed that the new style interface is being used. In the new style, the C<$depth> is always assumed to be equivalent to C<RECURSIVE> and the C<$func> argument can be set with C<setNodeFilter> instead. This is the recommended way of doing things now. If you have been using the old way, it is still there, and I will maintain backwards compatability for a few more version before removing it entirely. If you are using this module (and I don't even know if anyone actually is) you have been warned. Please contact me if this will be a problem.
+
+The old style constructor documentation is retained her for reference:
+
+The first argument to the constructor is a code reference to a function which expects a B<Tree::Simple> object as its only argument. The second argument is optional, it can be used to set the depth to which the function is applied. If no depth is set, the function is applied to the current B<Tree::Simple> instance. If C<$depth> is set to C<CHILDREN_ONLY>, then the function will be applied to the current B<Tree::Simple> instance and all its immediate children. If C<$depth> is set to C<RECURSIVE>, then the function will be applied to the current B<Tree::Simple> instance and all its immediate children, and all of their children recursively on down the tree. If no C<$depth> is passed to the constructor, then the function will only be applied to the current B<Tree::Simple> object and none of its children.
+
+=item B<includeTrunk ($boolean)>
+
+Based upon the value of C<$boolean>, this will tell the visitor to collect the trunk of the tree as well. It is defaulted to false (C<0>) in the new style interface, but is defaulted to true (C<1>) in the old style interface.
+
+=item B<getNodeFilter>
+
+This method returns the CODE reference set with C<setNodeFilter> argument.
+
+=item B<clearNodeFilter>
+
+This method clears node filter field.
+
+=item B<setNodeFilter ($filter_function)>
+
+This method accepts a CODE reference as its C<$filter_function> argument. This code reference is used to filter the tree nodes as they are collected. This can be used to customize output, or to gather specific information from a more complex tree node. The filter function should accept a single argument, which is the current Tree::Simple object.
+
+=item B<getResults>
+
+This method returns the accumulated results of the application of the node filter to the tree.
+
+=item B<setResults>
+
+This method should not really be used outside of this class, as it just would not make any sense to. It is included in this class and in this documenation to facilitate subclassing of this class for your own needs. If you desire to clear the results, then you can simply call C<setResults> with no argument.
+
+=item B<visit ($tree)>
+
+The C<visit> method accepts a B<Tree::Simple> and applies the function set in C<new> or C<setNodeFilter> appropriately. The results of this application can be retrieved with C<getResults>
+
+=back
+
+=head1 CONSTANTS
+
+These constants are part of the old-style interface, and therefore will eventually be deprecated.
+
+=over 4
+
+=item B<RECURSIVE>
+
+If passed this constant in the constructor, the function will be applied recursively down the hierarchy of B<Tree::Simple> objects.
+
+=item B<CHILDREN_ONLY>
+
+If passed this constant in the constructor, the function will be applied to the immediate children of the B<Tree::Simple> object.
+
+=back
+
+=head1 BUGS
+
+None that I am aware of. The code is pretty thoroughly tested (see B<CODE COVERAGE> section in B<Tree::Simple>) and is based on an (non-publicly released) module which I had used in production systems for about 2 years without incident. Of course, if you find a bug, let me know, and I will be sure to fix it.
+
+=head1 SEE ALSO
+
+I have written a set of pre-built Visitor objects, available on CPAN as B<Tree::Simple::VisitorFactory>.
+
+=head1 AUTHOR
+
+stevan little, E<lt>stevan@iinteractive.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2004-2006 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
1,038 t/10_Tree_Simple_test.t
@@ -0,0 +1,1038 @@
+use v6;
+use Test;
+plan 292;
+BEGIN
+{
+ @*INC.push('lib');
+ @*INC.push('blib');
+}
+
+
+
+eval_lives_ok 'use Tree::Simple', 'Can use Tree::Simple';
+
+use Tree::Simple;
+
+
+
+## ----------------------------------------------------------------------------
+## Test for Tree::Simple
+## ----------------------------------------------------------------------------
+# NOTE:
+# This test checks the base functionality of the Tree::Simple object. The test
+# is so large because (at the moment) each test relies upon the tree created
+# by the previous tests. It is not the most efficient or sensible thing to do
+# i know, but its how it is for now. There are close to 300 tests here, so
+# splitting them up would be a chore.
+## ----------------------------------------------------------------------------
+
+# # check that we have a constructor
+# can_ok("Tree::Simple", 'new');
+# # and that our ROOT constant is properly defined
+# can_ok("Tree::Simple", 'ROOT');
+
+# make a root for our tree
+# my $tree = Tree::Simple->new("root tree", Tree::Simple->ROOT);
+#see if we can do positional based as well as named based
+
+my $tree = Tree::Simple.new("root tree",'root');
+
+ok($tree ~~ Tree::Simple, 'Tree::Simple object');
+
+# test the interface
+
+#todo need to test to see if they exist since they are private
+#can_ok($tree, '_init');
+#can_ok($tree, '_setParent');
+
+
+my @methods= < isRoot isLeaf setNodeValue getNodeValue getDepth fixDepth getParent
+getChildCount addChild addChildren insertChild insertChildren removeChildAt removeChild
+getChild getAllChildren addSibling addSiblings insertSibling insertSiblings getSibling
+getAllSiblings traverse accept clone cloneShallow DESTROY getUID>;
+for @methods -> $method {
+ ok $tree.can($method),"Can do method '$method'";
+}
+
+
+
+# verfiy that it is a root
+ok($tree.isRoot());
+
+# and since it has no children
+# it is also a leaf node
+ok($tree.isLeaf());
+
+# check the value of the node,
+# it should be root
+is($tree.getNodeValue(), "root tree", '... this tree is a root');
+
+# we have no children yet
+is($tree.getChildCount(), 0, '... we have no children yet');
+
+# check the depth
+is($tree.getDepth(), -1, '... we have no depth yet');
+
+# check the index
+is($tree.getIndex(), -1, '... root trees have no index');
+
+
+# is($tree->getUID(), $tree->getUID(), '... UIDs match for the same object');
+# is("$tree", "Tree::Simple=HASH(" . $tree->getUID() . ")", '... our UID is derived from our hex address');
+
+# can_ok($tree, 'setUID');
+# $tree->setUID("This is our unique identifier");
+
+# is($tree->getUID(), 'This is our unique identifier', '... UIDs match what we have set it to');
+# isnt("$tree", "Tree::Simple=HASH(" . $tree->getUID() . ")", '... our UID is no longer derived from our hex address');
+
+## ----------------------------------------------------------------------------
+## testing adding children
+## ----------------------------------------------------------------------------
+
+# create a child
+
+my $sub_tree = Tree::Simple.new('1.0');
+ok($sub_tree ~~ Tree::Simple, 'Tree::Simple object');
+
+
+# check the node value
+is($sub_tree.getNodeValue(), "1.0", '... this tree is 1.0');
+
+# since we have not assigned a parent it
+# will still be considered a root
+ok($sub_tree.isRoot());
+
+# and since it has no children
+# it is also a leaf node
+ok($sub_tree.isLeaf());
+
+# now add the child to our root
+$tree.addChild($sub_tree);
+
+# tree is no longer a leaf node
+# now that we have a child
+ok(!$tree.isLeaf());
+
+# now that we have assigned a parent it
+# will no longer be considered a root
+ok(!$sub_tree.isRoot());
+
+# check the depth of the sub_tree
+is($sub_tree.getDepth(), 0, '... depth should be 0 now');
+
+# check the index
+is($sub_tree.getIndex(), 0, '... index should be 0 now');
+
+# check the child count,
+# it should be one now
+is($tree.getChildCount(), 1, '... we should have 1 children now');
+
+# get the child we inserted
+# and compare it with sub_tree
+# they should be the same
+is($tree.getChild(0), $sub_tree, '... make sure our sub_tree is fetchable');
+
+# get the parent of sub_tree
+my $sub_tree_parent = $sub_tree.getParent();
+
+# now test that the parent of
+# our sub_tree is the same as
+# our root
+is($tree, $sub_tree_parent, '... make sure our sub_tree parent is tree');
+
+## ----------------------------------------------------------------------------
+## testing adding siblings
+## ----------------------------------------------------------------------------
+
+# create another sub_tree
+my $sub_tree_2 = Tree::Simple.new("2.0");
+ok($sub_tree_2 ~~ Tree::Simple, 'Tree::Simple object');
+
+# # check its node value
+# is($sub_tree_2->getNodeValue(), "2.0", '... this tree is 2.0');
+
+# # since we have not assigned a parent to
+# # the new sub_tree it will still be
+# # considered a root
+# ok($sub_tree_2->isRoot());
+
+# # and since it has no children
+# # it is also a leaf node
+# ok($sub_tree_2->isLeaf());
+
+# # add our new subtree as a sibling
+# # of our first sub_tree
+# $sub_tree->addSibling($sub_tree_2);
+
+# # now that we have assigned a parent to
+# # the new sub_tree, it will no longer be
+# # considered a root
+# ok(!$sub_tree_2->isRoot());
+
+# # check the depth of the sub_tree
+# cmp_ok($sub_tree_2->getDepth(), '==', 0, '... depth should be 0 now');
+
+# # check the index
+# cmp_ok($sub_tree_2->getIndex(), '==', 1, '... index should be 1');
+
+# # make sure that we now have 2 children in our root
+# cmp_ok($tree->getChildCount(), '==', 2, '... we should have 2 children now');
+
+# # and verify that the child at index 1
+# # is actually our second sub_tree
+# is($tree->getChild(1), $sub_tree_2, '... make sure our sub_tree is fetchable');
+
+# # get the parent of our second sub_tree
+# my $sub_tree_2_parent = $sub_tree_2->getParent();
+
+# # and make sure that it is the
+# # same as our root
+# is($tree, $sub_tree_2_parent, '... make sure our sub_tree_2 parent is tree');
+
+# ## ----------------------------------------------------------------------------
+# ## test adding child by giving parent as a constructor argument
+# ## ----------------------------------------------------------------------------
+
+# # we create our new sub_tree and attach it
+# # to our root through its constructor
+# my $sub_tree_4 = Tree::Simple->new("4.0", $tree);
+
+# # check its node value
+# is($sub_tree_4->getNodeValue(), "4.0", '... this tree is 4.0');
+
+# # since we have assigned a parent to
+# # the new sub_tree, it will no longer be
+# # considered a root
+# ok(!$sub_tree_4->isRoot());
+
+# # check the depth of the sub_tree
+# cmp_ok($sub_tree_4->getDepth(), '==', 0, '... depth should be 0 now');
+
+# # check the index
+# cmp_ok($sub_tree_4->getIndex(), '==', 2, '... index should be 2 now');
+
+# # but since it has no children
+# # it is also a leaf node
+# ok($sub_tree_4->isLeaf());
+
+# # make sure that we now have 3 children in our root
+# cmp_ok($tree->getChildCount(), '==', 3, '... we should have 3 children now');
+
+# # and verify that the child at index 2
+# # is actually our latest sub_tree
+# is($tree->getChild(2), $sub_tree_4, '... make sure our sub_tree is fetchable');
+
+# # and make sure that the new sub-trees
+# # parent is the same as our root
+# is($tree, $sub_tree_4->getParent(), '... make sure our sub_tree_4 parent is tree');
+
+# ## ----------------------------------------------------------------------------
+# ## test inserting child
+# ## ----------------------------------------------------------------------------
+
+# # we create our new sub_tree
+# my $sub_tree_3 = Tree::Simple->new("3.0");
+
+# # check its node value
+# is($sub_tree_3->getNodeValue(), "3.0", '... this tree is 3.0');
+
+# # since we have not assigned a parent to
+# # the new sub_tree it will still be
+# # considered a root
+# ok($sub_tree_3->isRoot());
+
+# # but since it has no children
+# # it is also a leaf node
+# ok($sub_tree_3->isLeaf());
+
+# # now insert the child at index 2
+# $tree->insertChild(2, $sub_tree_3);
+
+# # since we now have assigned a parent to
+# # the new sub_tree, it will no longer be
+# # considered a root
+# ok(!$sub_tree_3->isRoot());
+
+# # check the depth of the sub_tree
+# cmp_ok($sub_tree_3->getDepth(), '==', 0, '... depth should be 0 now');
+
+# # check the index of 3
+# cmp_ok($sub_tree_3->getIndex(), '==', 2, '... index should be 2 now');
+
+# # check the index of 4 now
+# cmp_ok($sub_tree_4->getIndex(), '==', 3, '... index should be 3 now');
+
+# # make sure that we now have 3 children in our root
+# cmp_ok($tree->getChildCount(), '==', 4, '... we should have 4 children now');
+
+# # and verify that the child at index 2
+# # is actually our latest sub_tree
+# is($tree->getChild(2), $sub_tree_3, '... make sure our sub_tree is fetchable');
+
+# # and verify that the child that was
+# # at index 2 is actually now actually
+# # at index 3
+# is($tree->getChild(3), $sub_tree_4, '... make sure our sub_tree is fetchable');
+
+# # and make sure that the new sub-trees
+# # parent is the same as our root
+# is($tree, $sub_tree_3->getParent(), '... make sure our sub_tree_3 parent is tree');
+
+# ## ----------------------------------------------------------------------------
+# ## test getting all children and siblings
+# ## ----------------------------------------------------------------------------
+
+# # get it in scalar context and
+# # check that our arrays are equal
+# my $children = $tree->getAllChildren();
+# ok eq_array($children, [ $sub_tree, $sub_tree_2, $sub_tree_3, $sub_tree_4 ]);
+
+# # get it in array context and
+# # check that our arrays are equal
+# my @children = $tree->getAllChildren();
+# ok eq_array(\@children, [ $sub_tree, $sub_tree_2, $sub_tree_3, $sub_tree_4 ]);
+
+# # check that the values from both
+# # contexts are equal to one another
+# ok eq_array($children, \@children);
+
+# # now check that the siblings of all the
+# # sub_trees are the same as the children
+# foreach my $_sub_tree (@children) {
+# # test siblings in scalar context
+# my $siblings = $sub_tree->getAllSiblings();
+# ok eq_array($children, $siblings);
+# # and now in array context
+# my @siblings = $sub_tree->getAllSiblings();
+# ok eq_array($children, \@siblings);
+# }
+
+# ## ----------------------------------------------------------------------------
+# ## test addChildren
+# ## ----------------------------------------------------------------------------
+
+# my @sub_children = (
+# Tree::Simple->new("1.1"),
+# Tree::Simple->new("1.5"),
+# Tree::Simple->new("1.6")
+# );
+
+# # now go through the children and test them
+# foreach my $sub_child (@sub_children) {
+# # they should think they are root
+# ok($sub_child->isRoot());
+
+# # and they should all be leaves
+# ok($sub_child->isLeaf());
+
+# # and their node values
+# like($sub_child->getNodeValue(), qr/1\.[0-9]/, '... they at least have "1." followed by a digit');
+
+# # and they should all have a depth of -1
+# cmp_ok($sub_child->getDepth(), '==', -1, '... depth should be -1');
+# }
+
+# # check to see if we can add children
+# $sub_tree->addChildren(@sub_children);
+
+# # we are no longer a leaf node now
+# ok(!$sub_tree->isLeaf());
+
+# # make sure that we now have 3 children now
+# cmp_ok($sub_tree->getChildCount(), '==', 3, '... we should have 3 children now');
+
+# # now check that sub_tree's children
+# # are the same as our list
+# ok eq_array([ $sub_tree->getAllChildren() ], \@sub_children);
+
+# # now go through the children again
+# # and test them
+# foreach my $sub_child (@sub_children) {
+# # they should no longer think
+# # they are root
+# ok(!$sub_child->isRoot());
+
+# # but they should still think they
+# # are leaves
+# ok($sub_child->isLeaf());
+
+# # now we test their parental relationship
+# is($sub_tree, $sub_child->getParent(), '... their parent is the sub_tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($sub_child->getDepth(), '==', 1, '... depth should be 1');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $sub_tree->getAllChildren() ], [ $sub_child->getAllSiblings() ]);
+# }
+
+# ## ----------------------------------------------------------------------------
+# ## test insertingChildren
+# ## ----------------------------------------------------------------------------
+
+# my @more_sub_children = (
+# Tree::Simple->new("1.2"),
+# Tree::Simple->new("1.3"),
+# Tree::Simple->new("1.4")
+# );
+
+# # now go through the children and test them
+# foreach my $sub_child (@more_sub_children) {
+# # they should think they are root
+# ok($sub_child->isRoot());
+
+# # and they should all be leaves
+# ok($sub_child->isLeaf());
+
+# # and their node values
+# like($sub_child->getNodeValue(), qr/1\.[0-9]/, '... they at least have "1." followed by a digit');
+
+# # and they should all have a depth of -1
+# cmp_ok($sub_child->getDepth(), '==', -1, '... depth should be -1');
+# }
+
+# # check to see if we can insert children
+# $sub_tree->insertChildren(1, @more_sub_children);
+
+# # make sure that we now have 6 children now
+# cmp_ok($sub_tree->getChildCount(), '==', 6, '... we should have 6 children now');
+
+# # now check that sub_tree's children
+# # are the same as our list
+# ok eq_array([ $sub_tree->getAllChildren() ], [ $sub_children[0], @more_sub_children, @sub_children[1 .. $#sub_children] ]);
+
+# # now go through the children again
+# # and test them
+# foreach my $sub_child (@more_sub_children) {
+# # they should no longer think
+# # they are roots
+# ok(!$sub_child->isRoot());
+
+# # but they should still think they
+# # are leaves
+# ok($sub_child->isLeaf());
+
+# # now we test their parental relationship
+# is($sub_tree, $sub_child->getParent(), '... their parent is the sub_tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($sub_child->getDepth(), '==', 1, '... depth should be 1');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $sub_tree->getAllChildren() ], [ $sub_child->getAllSiblings() ]);
+# }
+
+# ## ----------------------------------------------------------------------------
+# ## test addingSiblings
+# ## ----------------------------------------------------------------------------
+
+# my @more_children = (
+# Tree::Simple->new("5.0"),
+# Tree::Simple->new("9.0")
+# );
+
+# # now go through the children and test them
+# foreach my $sub_child (@more_children) {
+# # they should think they are root
+# ok($sub_child->isRoot());
+
+# # and they should all be leaves
+# ok($sub_child->isLeaf());
+
+# # and their node values
+# like($sub_child->getNodeValue(), qr/[0-9]\.0/, '... they at least have digit followed by ".0"');
+
+# # and they should all have a depth of -1
+# cmp_ok($sub_child->getDepth(), '==', -1, '... depth should be -1');
+# }
+
+# # check to see if we can insert children
+# $sub_tree->addSiblings(@more_children);
+
+# # make sure that we now have 6 children now
+# cmp_ok($tree->getChildCount(), '==', 6, '... we should have 6 children now');
+
+# # now check that tree's new children
+# # are the same as our list
+# is($tree->getChild(4), $more_children[0], '... they are the same');
+# is($tree->getChild(5), $more_children[1], '... they are the same');
+
+# # now go through the children again
+# # and test them
+# foreach my $sub_child (@more_children) {
+# # they should no longer think
+# # they are roots
+# ok(!$sub_child->isRoot());
+
+# # but they should still think they
+# # are leaves
+# ok($sub_child->isLeaf());
+
+# # now we test their parental relationship
+# is($tree, $sub_child->getParent(), '... their parent is the tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($sub_child->getDepth(), '==', 0, '... depth should be 0');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $tree->getAllChildren() ], [ $sub_child->getAllSiblings() ]);
+# }
+
+# ## ----------------------------------------------------------------------------
+# ## test insertSibling
+# ## ----------------------------------------------------------------------------
+
+# my $new_sibling = Tree::Simple->new("8.0");
+
+# # they should think they are root
+# ok($new_sibling->isRoot());
+
+# # and they should all be leaves
+# ok($new_sibling->isLeaf());
+
+# # and their node values
+# is($new_sibling->getNodeValue(), "8.0", '... node value should be 6.0');
+
+# # and they should all have a depth of -1
+# cmp_ok($new_sibling->getDepth(), '==', -1, '... depth should be -1');
+
+# # check to see if we can insert children
+# $sub_tree->insertSibling(5, $new_sibling);
+
+# # make sure that we now have 6 children now
+# cmp_ok($tree->getChildCount(), '==', 7, '... we should have 7 children now');
+
+# # now check that sub_tree's new sibling
+# # is in the right place and that it
+# # should have displaced the old value at
+# # that index to index + 1
+# is($tree->getChild(4), $more_children[0], '... they are the same');
+# is($tree->getChild(5), $new_sibling, '... they are the same');
+# is($tree->getChild(6), $more_children[1], '... they are the same');
+
+# # they should no longer think
+# # they are roots
+# ok(!$new_sibling->isRoot());
+
+# # but they should still think they
+# # are leaves
+# ok($new_sibling->isLeaf());
+
+# # now we test their parental relationship
+# is($tree, $new_sibling->getParent(), '... their parent is the tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($new_sibling->getDepth(), '==', 0, '... depth should be 0');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $tree->getAllChildren() ], [ $new_sibling->getAllSiblings() ]);
+
+# ## ----------------------------------------------------------------------------
+# ## test inserting Siblings
+# ## ----------------------------------------------------------------------------
+
+# my @even_more_children = (
+# Tree::Simple->new("6.0"),
+# Tree::Simple->new("7.0")
+# );
+
+# # now go through the children and test them
+# foreach my $sub_child (@even_more_children) {
+# # they should think they are root
+# ok($sub_child->isRoot());
+
+# # and they should all be leaves
+# ok($sub_child->isLeaf());
+
+# # and their node values
+# like($sub_child->getNodeValue(), qr/[0-9]\.0/, '... they at least have digit followed by ".0"');
+
+# # and they should all have a depth of -1
+# cmp_ok($sub_child->getDepth(), '==', -1, '... depth should be -1');
+# }
+
+# # check to see if we can insert children
+# $sub_tree->insertSiblings(5, @even_more_children);
+
+# # make sure that we now have 6 children now
+# cmp_ok($tree->getChildCount(), '==', 9, '... we should have 6 children now');
+
+# # now check that tree's new children
+# # are the same as our list
+# is($tree->getChild(4), $more_children[0], '... they are the same');
+# is($tree->getChild(5), $even_more_children[0], '... they are the same');
+# is($tree->getChild(6), $even_more_children[1], '... they are the same');
+# is($tree->getChild(7), $new_sibling, '... they are the same');
+# is($tree->getChild(8), $more_children[1], '... they are the same');
+
+# # now go through the children again
+# # and test them
+# foreach my $sub_child (@even_more_children) {
+# # they should no longer think
+# # they are roots
+# ok(!$sub_child->isRoot());
+
+# # but they should still think they
+# # are leaves
+# ok($sub_child->isLeaf());
+
+# # now we test their parental relationship
+# is($tree, $sub_child->getParent(), '... their parent is the tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($sub_child->getDepth(), '==', 0, '... depth should be 0');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $tree->getAllChildren() ], [ $sub_child->getAllSiblings() ]);
+# }
+
+# ## ----------------------------------------------------------------------------
+# ## test getChild and getSibling
+# ## ----------------------------------------------------------------------------
+
+# # make sure that getChild returns the
+# # same as getSibling
+# is($tree->getChild($_), $sub_tree->getSibling($_), '... siblings are the same as children')
+# foreach (0 .. $tree->getChildCount());
+
+# ## ----------------------------------------------------------------------------
+# ## test self referential returns
+# ## ----------------------------------------------------------------------------
+
+# # addChildren's return value is actually $self
+# # so that method calls can be chained
+# my $self_ref_tree_test = Tree::Simple->new("3.1", $sub_tree_3)
+# ->addChildren(
+# Tree::Simple->new("3.1.1"),
+# Tree::Simple->new("3.1.2")
+# );
+# # make sure that it true
+# isa_ok($self_ref_tree_test, 'Tree::Simple');
+
+# # it shouldnt be a root
+# ok(!$self_ref_tree_test->isRoot());
+
+# # and it shouldnt be a leaf
+# ok(!$self_ref_tree_test->isLeaf());
+
+# # make sure that the parent in the constructor worked
+# is($sub_tree_3, $self_ref_tree_test->getParent(), '... should be the same');
+
+# # and the parents count should be 1
+# cmp_ok($sub_tree_3->getChildCount(), '==', 1, '... we should have 1 child here');
+
+# # make sure they show up in the count test
+# cmp_ok($self_ref_tree_test->getChildCount(), '==', 2, '... we should have 2 children here');
+
+# foreach my $sub_child ($self_ref_tree_test->getAllChildren()) {
+# # they should not think
+# # they are roots
+# ok(!$sub_child->isRoot());
+
+# # but they should think they
+# # are leaves
+# ok($sub_child->isLeaf());
+
+# # now we test their parental relationship
+# is($self_ref_tree_test, $sub_child->getParent(), '... their parent is the tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($sub_child->getDepth(), '==', 2, '... depth should be 0');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $self_ref_tree_test->getAllChildren() ], [ $sub_child->getAllSiblings() ]);
+# }
+
+# ## ----------------------------------------------------------------------------
+# ## Test self-referential version of addChild
+# ## ----------------------------------------------------------------------------
+
+# # addChild's return value is actually $self
+# # so that method calls can be chained
+# my $self_ref_tree_test_2 = Tree::Simple->new("2.1", $sub_tree_2)
+# ->addChild(
+# Tree::Simple->new("2.1.1")
+# );
+# # make sure that it true
+# isa_ok($self_ref_tree_test_2, 'Tree::Simple');
+
+# # it shouldnt be a root
+# ok(!$self_ref_tree_test_2->isRoot());
+
+# # and it shouldnt be a leaf
+# ok(!$self_ref_tree_test_2->isLeaf());
+
+# # make sure that the parent in the constructor worked
+# is($sub_tree_2, $self_ref_tree_test_2->getParent(), '... should be the same');
+
+# # and the parents count should be 1
+# cmp_ok($sub_tree_2->getChildCount(), '==', 1, '... we should have 1 child here');
+
+# # make sure they show up in the count test
+# cmp_ok($self_ref_tree_test_2->getChildCount(), '==', 1, '... we should have 1 child here');
+
+# my $sub_child = $self_ref_tree_test_2->getChild(0);
+
+# # they should not think
+# # they are roots
+# ok(!$sub_child->isRoot());
+
+# # but they should think they
+# # are leaves
+# ok($sub_child->isLeaf());
+
+# # now we test their parental relationship
+# is($self_ref_tree_test_2, $sub_child->getParent(), '... their parent is the tree');
+
+# # and they should all have a depth of 1
+# cmp_ok($sub_child->getDepth(), '==', 2, '... depth should be 0');
+
+# # now check that its siblings are the same
+# # as the children of its parent
+# ok eq_array([ $self_ref_tree_test_2->getAllChildren() ], [ $sub_child->getAllSiblings() ]);
+
+# ## ----------------------------------------------------------------------------
+# ## test removeChildAt
+# ## ----------------------------------------------------------------------------
+
+# my $sub_tree_of_tree_to_remove = Tree::Simple->new("1.1.a.1");
+# # make a node to remove
+# my $tree_to_remove = Tree::Simple->new("1.1.a")->addChild($sub_tree_of_tree_to_remove);
+
+# # test that its a root
+# ok($tree_to_remove->isRoot());
+
+# # and that its depth is -1
+# cmp_ok($tree_to_remove->getDepth(), '==', -1, '... the depth should be -1');
+# # and the sub-trees depth is 0
+# cmp_ok($sub_tree_of_tree_to_remove->getDepth(), '==', 0, '... the depth should be 0');
+
+# # insert it into the sub_tree
+# $sub_tree->insertChild(1, $tree_to_remove);
+
+# # test that it no longer thinks its a root
+# ok(!$tree_to_remove->isRoot());
+
+# # check thats its depth is now 1
+# cmp_ok($tree_to_remove->getDepth(), '==', 1, '... the depth should be 1');
+# # and the sub-trees depth is 2
+# cmp_ok($sub_tree_of_tree_to_remove->getDepth(), '==', 2, '... the depth should be 2');
+
+# # make sure it is there
+# is($sub_tree->getChild(1), $tree_to_remove, '... these tree should be equal');
+
+# # remove the subtree (it will be returned)
+# my $removed_tree = $sub_tree->removeChildAt(1);
+
+# # now check that the one removed it the one
+# # we inserted origianlly
+# is($removed_tree, $tree_to_remove, '... these tree should be equal');
+
+# # it should think its a root again
+# ok($tree_to_remove->isRoot());
+# # and its depth should be back to -1
+# cmp_ok($tree_to_remove->getDepth(), '==', -1, '... the depth should be -1');
+# # and the sub-trees depth is 0
+# cmp_ok($sub_tree_of_tree_to_remove->getDepth(), '==', 0, '... the depth should be 0');
+
+# ## ----------------------------------------------------------------------------
+# ## test removeChild
+# ## ----------------------------------------------------------------------------
+
+# my $sub_tree_of_tree_to_remove2 = Tree::Simple->new("1.1.a.1");
+# # make a node to remove
+# my $tree_to_remove2 = Tree::Simple->new("1.1.a")->addChild($sub_tree_of_tree_to_remove2);
+
+# # test that its a root
+# ok($tree_to_remove2->isRoot());
+
+# # and that its depth is -1
+# cmp_ok($tree_to_remove2->getDepth(), '==', -1, '... the depth should be -1');
+# # and the sub-trees depth is 0
+# cmp_ok($sub_tree_of_tree_to_remove2->getDepth(), '==', 0, '... the depth should be 0');
+
+# # insert it into the sub_tree
+# $sub_tree->insertChild(1, $tree_to_remove2);
+
+# # test that it no longer thinks its a root
+# ok(!$tree_to_remove2->isRoot());
+
+# # check thats its depth is now 1
+# cmp_ok($tree_to_remove2->getDepth(), '==', 1, '... the depth should be 1');
+# # and the sub-trees depth is 2
+# cmp_ok($sub_tree_of_tree_to_remove2->getDepth(), '==', 2, '... the depth should be 2');
+
+# # make sure it is there
+# is($sub_tree->getChild(1), $tree_to_remove2, '... these tree should be equal');
+
+# # remove the subtree (it will be returned)
+# my $removed_tree2 = $sub_tree->removeChild($tree_to_remove2);
+
+# # now check that the one removed it the one
+# # we inserted origianlly
+# is($removed_tree2, $tree_to_remove2, '... these tree should be equal');
+
+# # it should think its a root again
+# ok($tree_to_remove2->isRoot());
+# # and its depth should be back to -1
+# cmp_ok($tree_to_remove2->getDepth(), '==', -1, '... the depth should be -1');
+# # and the sub-trees depth is 0
+# cmp_ok($sub_tree_of_tree_to_remove2->getDepth(), '==', 0, '... the depth should be 0');
+
+# ## ----------------------------------------------------------------------------
+# ## test removeChild backwards compatability
+# ## ----------------------------------------------------------------------------
+
+# # make a node to remove
+# my $tree_to_remove3 = Tree::Simple->new("1.1.a");
+
+# # test that its a root
+# ok($tree_to_remove3->isRoot());
+
+# # and that its depth is -1
+# cmp_ok($tree_to_remove3->getDepth(), '==', -1, '... the depth should be -1');
+
+# # insert it into the sub_tree
+# $sub_tree->insertChild(1, $tree_to_remove3);
+
+# # test that it no longer thinks its a root
+# ok(!$tree_to_remove3->isRoot());
+
+# # check thats its depth is now 1
+# cmp_ok($tree_to_remove3->getDepth(), '==', 1, '... the depth should be 1');
+
+# # make sure it is there
+# is($sub_tree->getChild(1), $tree_to_remove3, '... these tree should be equal');
+
+# # remove the subtree (it will be returned)
+# my $removed_tree3 = $sub_tree->removeChild(1);
+
+# # now check that the one removed it the one
+# # we inserted origianlly
+# is($removed_tree3, $tree_to_remove3, '... these tree should be equal');
+
+# # it should think its a root again
+# ok($tree_to_remove3->isRoot());
+# # and its depth should be back to -1
+# cmp_ok($tree_to_remove3->getDepth(), '==', -1, '... the depth should be -1');
+
+# ## ----------------------------------------------
+# ## now test the edge cases
+# ## ----------------------------------------------
+
+# # trees at the end
+
+# # make a node to remove
+# my $tree_to_remove_2 = Tree::Simple->new("1.7");
+
+# # add it into the sub_tree
+# $sub_tree->addChild($tree_to_remove_2);
+
+# # make sure it is there
+# is($sub_tree->getChild($sub_tree->getChildCount() - 1), $tree_to_remove_2, '... these tree should be equal');
+
+# # remove the subtree (it will be returned)
+# my $removed_tree_2 = $sub_tree->removeChildAt($sub_tree->getChildCount() - 1);
+
+# # now check that the one removed it the one
+# # we inserted origianlly
+# is($removed_tree_2, $tree_to_remove_2, '... these tree should be equal');
+
+# # trees at the beginging
+
+# # make a node to remove
+# my $tree_to_remove_3 = Tree::Simple->new("1.1.-1");
+
+# # add it into the sub_tree
+# $sub_tree->insertChild(0, $tree_to_remove_3);
+
+# # make sure it is there
+# is($sub_tree->getChild(0), $tree_to_remove_3, '... these tree should be equal');
+
+# # remove the subtree (it will be returned)
+# my $removed_tree_3 = $sub_tree->removeChildAt(0);
+
+# # now check that the one removed it the one
+# # we inserted origianlly
+# is($removed_tree_3, $tree_to_remove_3, '... these tree should be equal');
+
+# ## ----------------------------------------------------------------------------
+# ## test traverse
+# ## ----------------------------------------------------------------------------
+
+# # make a control set of
+# # all the nodes we have
+# my @_all_node_values = qw(
+# 1.0
+# 1.1
+# 1.2
+# 1.3
+# 1.4
+# 1.5
+# 1.6
+# 2.0
+# 2.1
+# 2.1.1
+# 3.0
+# 3.1
+# 3.1.1
+# 3.1.2
+# 4.0
+# 5.0
+# 6.0
+# 7.0
+# 8.0
+# 9.0
+# );
+
+# my @all_node_values;
+# # now collect the nodes in the actual tree
+# $tree->traverse(sub {
+# my ($_tree) = @_;
+# push @all_node_values => $_tree->getNodeValue();
+# });
+
+# # and compare the two
+# is_deeply(\@_all_node_values, \@all_node_values, '... our nodes match our control nodes');
+
+# # test traverse with both pre- and post- methods
+# # make a control set of
+# # all the nodes we have with XML-style
+# my @_all_node_values_post_traverse = qw(
+# 1.0
+# 1.1
+# 1.1
+# 1.2
+# 1.2
+# 1.3
+# 1.3
+# 1.4
+# 1.4
+# 1.5
+# 1.5
+# 1.6
+# 1.6
+# 1.0
+# 2.0
+# 2.1
+# 2.1.1
+# 2.1.1
+# 2.1
+# 2.0
+# 3.0
+# 3.1
+# 3.1.1
+# 3.1.1
+# 3.1.2
+# 3.1.2
+# 3.1
+# 3.0
+# 4.0
+# 4.0
+# 5.0
+# 5.0
+# 6.0
+# 6.0
+# 7.0
+# 7.0
+# 8.0
+# 8.0
+# 9.0
+# 9.0
+# );
+
+
+# my @all_node_values_post_traverse;
+# # now collect the nodes in the actual tree
+# $tree->traverse(sub {
+# my ($_tree) = @_;
+# push @all_node_values_post_traverse => $_tree->getNodeValue();
+# },
+# sub {
+# my ($_tree) = @_;