Tree-Simple-VisitorFactory-0.15/0000755000175000017500000000000012712221611014723 5ustar ronronTree-Simple-VisitorFactory-0.15/MANIFEST.SKIP0000644000175000017500000000115612710341606016631 0ustar ronron# Avoid version control files. ,v$ \B\.cvsignore$ \B\.git\b \B\.gitignore\b \B\.svn\b \bCVS\b \bRCS\b # Avoid Makemaker generated and utility files. \bblib \bblibdirs$ \bpm_to_blib$ \bMakefile$ \bMakeMaker-\d # Avoid Module::Build generated and utility files. \b_build \bBuild$ \bBuild.bat$ # Avoid Devel::Cover generated files \bcover_db # Avoid temp and backup files. ~$ \#$ \.# \.bak$ \.old$ \.rej$ \.tmp$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid UltraEdit files. \.prj$ \.pui$ ^MYMETA.yml$ ^MYMETA\.json$ ^Tree-Simple-VisitorFactory-.*Tree-Simple-VisitorFactory-0.15/README0000644000175000017500000000267512254707010015620 0ustar ronronREADME file for Tree::Simple::VisitorFactory. See also: CHANGES and Changelog.ini. Warning: WinZip 8.1 and 9.0 both contain an 'accidental' bug which stops them recognizing POSIX-style directory structures in valid tar files. You are better off using a reliable tool such as InfoZip: ftp://ftp.info-zip.org/pub/infozip/ 1 Installing from a Unix-like distro ------------------------------------ shell>gunzip Tree-Simple-VisitorFactory-0.12.tgz shell>tar mxvf Tree-Simple-VisitorFactory-0.12.tar On Unix-like systems, assuming you have installed Module::Build V 0.25+: shell>perl Build.PL shell>./Build shell>./Build test shell>./Build install On MS Windows-like systems, assuming you have installed Module::Build V 0.25+: shell>perl Build.PL shell>perl Build shell>perl Build test shell>perl Build install Alternately, without Module::Build, you do this: Note: 'make' on MS Windows-like systems may be called 'nmake' or 'dmake'. shell>perl Makefile.PL shell>make shell>make test shell>su (for Unix-like systems) shell>make install shell>exit (for Unix-like systems) On all systems: Run VisitorFactory.pm through your favourite pod2html translator. 2 Installing from an ActiveState distro --------------------------------------- shell>unzip Tree-Simple-VisitorFactory-0.12.zip shell>ppm install --location=. Tree-Simple-VisitorFactory shell>del Tree-Simple-VisitorFactory-0.12.ppd shell>del PPM-Tree-Simple-VisitorFactory-0.12.tar.gz Tree-Simple-VisitorFactory-0.15/META.json0000644000175000017500000000312112712221611016341 0ustar ronron{ "abstract" : "A factory object for dispensing Visitor objects", "author" : [ "Stevan Little " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.14, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Tree-Simple-VisitorFactory", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Spec" : "0.6", "Scalar::Util" : "1.1", "Tree::Simple" : "1.12", "Tree::Simple::Visitor" : "1.22", "base" : "0", "strict" : "0", "warnings" : "0" } }, "test" : { "requires" : { "Test::Exception" : "0.15", "Test::More" : "1.001014" } } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/ronsavage/Tree-Simple-VisitorFactory.git", "web" : "https://github.com/ronsavage/Tree-Simple-VisitorFactory" } }, "version" : "0.15", "x_serialization_backend" : "JSON::PP version 2.27203" } Tree-Simple-VisitorFactory-0.15/Makefile.PL0000644000175000017500000000267012710341646016713 0ustar ronronuse strict; use warnings; use ExtUtils::MakeMaker; # ---------------- my(%params) = ( ($] ge '5.005') ? ( AUTHOR => 'Stevan Little ', ABSTRACT => 'A factory object for dispensing Visitor objects', ) : (), clean => { FILES => 'blib/* Makefile Tree-Simple-VisitorFactory-*' }, dist => { COMPRESS => 'gzip', SUFFIX => 'gz' }, DISTNAME => 'Tree-Simple-VisitorFactory', NAME => 'Tree::Simple::VisitorFactory', PL_FILES => {}, PREREQ_PM => { 'base' => 0, 'File::Spec' => 0.60, 'Scalar::Util' => 1.10, 'Tree::Simple' => 1.12, 'Tree::Simple::Visitor' => 1.22, 'strict' => 0, 'warnings' => 0, }, TEST_REQUIRES => { 'Test::Exception' => '0.15', 'Test::More' => 1.001014, }, VERSION_FROM => 'lib/Tree/Simple/VisitorFactory.pm', ); if ( ($ExtUtils::MakeMaker::VERSION =~ /^\d\.\d\d$/) && ($ExtUtils::MakeMaker::VERSION > 6.30) ) { $params{LICENSE} = 'perl'; } if ($ExtUtils::MakeMaker::VERSION ge '6.46') { $params{META_MERGE} = { 'meta-spec' => { version => 2, }, resources => { bugtracker => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Tree-Simple-VisitorFactorye', license => 'http://dev.perl.org/licenses/', repository => { type => 'git', url => 'https://github.com/ronsavage/Tree-Simple-VisitorFactory.git', web => 'https://github.com/ronsavage/Tree-Simple-VisitorFactory', }, }, }; } WriteMakefile(%params); Tree-Simple-VisitorFactory-0.15/lib/0000755000175000017500000000000012712221611015471 5ustar ronronTree-Simple-VisitorFactory-0.15/lib/Tree/0000755000175000017500000000000012712221611016370 5ustar ronronTree-Simple-VisitorFactory-0.15/lib/Tree/Simple/0000755000175000017500000000000012712221611017621 5ustar ronronTree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/0000755000175000017500000000000012712221611021260 5ustar ronronTree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/ToNestedHash.pm0000644000175000017500000001041212712221607024152 0ustar ronronpackage Tree::Simple::Visitor::ToNestedHash; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # grab our filter (if we have one) my $filter = $self->getNodeFilter(); my %results; # get the array $self->_buildHash($tree, \%results, $filter); # add the trunk if we need to %results = ( ((defined($filter)) ? $filter->($tree) : $tree->getNodeValue()) => { %results } ) if $self->includeTrunk(); # set results $self->setResults(\%results); } sub _buildHash { my ($self, $tree, $accumulator, $filter) = @_; foreach my $child ($tree->getAllChildren()) { my $node_value = {}; my $node_key = (defined($filter) ? $filter->($child) : $child->getNodeValue()); $self->_buildHash($child, $node_value, $filter) unless $child->isLeaf(); $accumulator->{$node_key} = $node_value; } return $accumulator; } 1; __END__ =head1 NAME Tree::Simple::Visitor::ToNestedHash - A Visitor for creating nested hash trees from Tree::Simple objects. =head1 SYNOPSIS use Tree::Simple::Visitor::ToNestedHash; my $visitor = Tree::Simple::Visitor::ToNestedHash->new(); # given this Tree::Simple tree my $tree = Tree::Simple->new("Root") ->addChildren( Tree::Simple->new("Child1") ->addChildren( Tree::Simple->new("GrandChild1"), Tree::Simple->new("GrandChild2") ), Tree::Simple->new("Child2"), ); $tree->accept($visitor); my $array_tree = $visitor->getResults(); # this then creates the equivalent nested array tree: # { # Root => { # Child1 => { # GrandChild1 => {}, # GrandChild2 => {} # }, # Child2 => {} # } # } =head1 DESCRIPTION Given a tree constructed from a Tree::Simple hierarchy, this Visitor will create the equivalent tree of nested hashes. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C and C methods to customize its behavior. =item B Setting the C<$boolean> value to true (C<1>) will cause the node value of the tree's root to be included in the nested hash output, setting it to false will do the opposite. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are placed into the hash tree. The C<$filter_function> is passed a Tree::Simple object, and is expected to return the value desired for inclusion into the hash tree. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method will return the hash tree constructed. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/FindByUID.pm0000644000175000017500000001545112712221607023346 0ustar ronronpackage Tree::Simple::Visitor::FindByUID; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{success} = 0; $self->{UID_to_find} = undef; $self->SUPER::_init(); } sub searchForUID { my ($self, $UID) = @_; (defined($UID)) || die "Insufficient Arguments : You must provide a UID to search for"; $self->{UID_to_find} = $UID; } sub setTraversalMethod { my ($self, $visitor) = @_; (blessed($visitor) && $visitor->isa("Tree::Simple::Visitor")) || die "Insufficient Arguments : You must supply a valid Tree::Simple::Visitor object"; $self->{traversal_method} = $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # reset our success flag $self->{success} = 0; my $UID = $self->{UID_to_find}; (defined($UID)) || die "Illegal Operation : You cannot search for a UID without setting one first"; # create our filter function # NOTE: # in order to get an immediate exit # from the traversal once a match is # found, we use 'die'. It is a somewhat # unorthodox way of using this, but it # works. The found tree is propagated # up the call chain and returned from # this function. my $func; if ($self->{_filter_function}) { $func = sub { my ($tree, $test) = @_; (($tree->getUID() eq $UID) && $self->{_filter_function}->($tree)) && die $tree; }; } else { $func = sub { my ($tree, $test) = @_; ($tree->getUID() eq $UID) && die $tree; }; } # we eval this so we can catch the tree # match when it is thrown with 'die' eval { unless (defined($self->{traversal_method})) { # include the trunk in our # search if needed $func->($tree) if $self->includeTrunk(); # and traverse $tree->traverse($func); } else { # include the trunk in our # search if needed $self->{traversal_method}->includeTrunk(1) if $self->includeTrunk(); # and visit $self->{traversal_method}->setNodeFilter($func); $self->{traversal_method}->visit($tree); } }; # now see what we have ... if ($@) { # if we caught a Tree::Simple object # then we have found a match, and ... if (blessed($@) && $@->isa('Tree::Simple')) { # we assign it to our results $self->setResults($@); $self->{success} = 1; } # however, if it is not a Tree::Simple # object then it is likely a real exception else { # so we re-throw it die $@; } } else { # if no exception is thrown though, # we failed in our search, and so we # set our success flag to false $self->{success} = 0; } } sub getResult { my ($self) = @_; # if we did not succeed, then # we return undef, ... return undef unless $self->{success}; # otherwise we return the results return $self->getResults()->[0]; } 1; __END__ =head1 NAME Tree::Simple::Visitor::FindByUID - A Visitor for finding an element in a Tree::Simple hierarchy by UID =head1 SYNOPSIS use Tree::Simple::Visitor::FindByUID; # create a visitor object my $visitor = Tree::Simple::Visitor::FindByUID->new(); # set the search path for our tree $visitor->searchForUID("MyTreeUID"); # pass the visitor to a tree $tree->accept($visitor); # fetch the result, which will # be the Tree::Simple object that # we have found, or undefined my $result = $visitor->getResult() || die "No Tree found"; =head1 DESCRIPTION Given a UID and Tree::Simple hierarchy, this Visitor will attempt to find the node with the same UID. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C, C, C and C methods to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the search as well. =item B By default we will use Tree::Simple's built in depth-first (pre-order) traverse method. If however, you desire the tree to be search in a different ordering, this can be accomplished using a different traversal method, you can supply a C<$visitor> object implementing that traversal type to this method (See B, B and B). =item B This is the UID we will attempt to find within the tree. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to further check the tree nodes as they are searched and so can be used to customize search behavior. For instance, you could to check against the UID as well as some other criteria. The filter function should accept a single argument, which is the current Tree::Simple object and return either true (C<1>) on success, or false (C<0>) on failure. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method will return the tree found with the specified UID (set by the C method) or C if no tree is found. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 ACKNOWLEDGEMENTS =over 4 =item Thanks to Vitor Mori for the idea for this Visitor. =back =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/FromNestedArray.pm0000644000175000017500000001652712712221607024703 0ustar ronronpackage Tree::Simple::Visitor::FromNestedArray; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{array_tree} = undef; $self->SUPER::_init(); } sub setArrayTree { my ($self, $array_tree) = @_; (defined($array_tree) && ref($array_tree) eq 'ARRAY') || die "Insufficient Arguments : You must supply a valid ARRAY reference"; # validate the tree ... # it must not be empty (scalar @{$array_tree} != 0) || die "Insufficient Arguments : The array tree provided is empty"; # it's first element must not be an array (ref($array_tree->[0]) ne 'ARRAY') || die "Incorrect Object Type : The first value in the array tree is an array reference"; # and it must be a single rooted tree (ref($array_tree->[1]) eq 'ARRAY') || die "Incorrect Object Type : The second value in the array tree must be an array reference" if defined($array_tree->[1]); $self->{array_tree} = $array_tree; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; $self->_buildTree( $tree, # our array tree $self->{array_tree}, # get a node filter if we have one $self->getNodeFilter(), # pass the value of includeTrunk too $self->includeTrunk() ); } sub _buildTree { my ($self, $tree, $array, $node_filter, $include_trunk) = @_; my $i = 0; while ($i < scalar @{$array}) { my $node = $array->[$i]; # check to make sure we have a well formed tree (ref($node) ne 'ARRAY') || die "Incorrect Object Type : The node value should never be an array reference"; # filter the node if necessary $node = $node_filter->($node) if defined($node_filter); # create the new tree my $new_tree; if ($include_trunk) { $tree->setNodeValue($node); $new_tree = $tree; } else { $new_tree = Tree::Simple->new($node); $tree->addChild($new_tree); } # increment the index value $i++; # NOTE: # the value of include trunk is only # passed in the recursion, so that # the trunk/root can be populated, # we have no more need for it after # that time. $self->_buildTree($new_tree, $array->[$i++], $node_filter) if ref($array->[$i]) eq 'ARRAY'; } } 1; __END__ =head1 NAME Tree::Simple::Visitor::FromNestedArray - A Visitor for creating Tree::Simple objects from nested array trees. =head1 SYNOPSIS use Tree::Simple::Visitor::FromNestedArray; my $visitor = Tree::Simple::Visitor::FromNestedArray->new(); # given this nested array tree my $array_tree = [ 'Root', [ 'Child1', [ 'GrandChild1', 'GrandChild2' ], 'Child2' ] ]; # set the array tree we # are going to convert $visitor->setArrayTree($array_tree); $tree->accept($visitor); # this then creates the equivalent Tree::Simple object: # Tree::Simple->new("Root") # ->addChildren( # Tree::Simple->new("Child1") # ->addChildren( # Tree::Simple->new("GrandChild1"), # Tree::Simple->new("GrandChild2") # ), # Tree::Simple->new("Child2"), # ); =head1 DESCRIPTION Given a tree constructed from nested arrays, this Visitor will create the equivalent Tree::Simple hierarchy. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C, C and C methods to customize its behavior. =item B Setting the C<$boolean> value to true (C<1>) will cause the node value of the C<$tree> object passed into C to be set with the root value found in the C<$array_tree>. Setting it to false (C<0>), or not setting it, will result in the first value in the C<$array_tree> creating a new node level. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are created, the C<$filter_function> is passed the node value extracted from the array prior to it being inserted into the tree being built. The C<$filter_function> is expected to return the value desired for inclusion into the tree. =item B This method is used to set the C<$array_tree> that our Tree::Simple hierarchy will be constructed from. It must be in the following form: [ 'Root', [ 'Child1', [ 'GrandChild1', 'GrandChild2' ], 'Child2' ] ] Basically each element in the array is considered a node, unless it is an array reference, in which case it is interpreted as containing the children of the node created from the previous element in the array. The tree is validated prior being accepted, if it fails validation an exception will be thrown. The rules are as follows; =over 4 =item The array tree must not be empty. It makes not sense to create a tree out of nothing, so it is assumed that this is a sign of something wrong. =item All nodes of the array tree must not be array references. The root node is validated against this in this function, but all subsequent nodes are checked as the tree is built. Any nodes found to be array references are rejected and an exception is thrown. If you desire your node values to be array references, you can use the node filtering mechanism to achieve this as the node is filtered I it is validated. =item The array tree must be a single rooted tree. If there is a second element in the array tree, it is assumed to be the children of the root, and therefore must be in the form of an array reference. =back =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/Sort.pm0000644000175000017500000001725212712221607022561 0ustar ronronpackage Tree::Simple::Visitor::Sort; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{sort_function} = undef; $self->SUPER::_init(); } sub REVERSE { sub ($$) { $_[1]->getNodeValue() cmp $_[0]->getNodeValue() }}; sub NUMERIC { sub ($$) { $_[0]->getNodeValue() <=> $_[1]->getNodeValue() }}; sub REVERSE_NUMERIC { sub ($$) { $_[1]->getNodeValue() <=> $_[0]->getNodeValue() }}; sub ALPHABETICAL { sub ($$) { lc($_[0]->getNodeValue()) cmp lc($_[1]->getNodeValue()) }}; sub REVERSE_ALPHABETICAL { sub ($$) { lc($_[1]->getNodeValue()) cmp lc($_[0]->getNodeValue()) }}; sub setSortFunction { my ($self, $sort_function) = @_; (defined($sort_function) && ref($sort_function) eq "CODE") || die "Insufficient Arguments : You must supply a CODE reference for the sort function"; $self->{sort_function} = $sort_function; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # No childs, nothing to sort return if $tree->isLeaf(); my $sort_function; if ($self->{sort_function}) { $sort_function = $self->{sort_function}; } else { # get the node filter my $filter_func = $self->getNodeFilter(); if ($filter_func) { $sort_function = sub { $filter_func->($a) cmp $filter_func->($b) }; } else { $sort_function = sub { $a->getNodeValue() cmp $b->getNodeValue() }; } } # otherwise sort them $self->_sortTree($sort_function, $tree); } sub _sortTree { my ($self, $sort_function, $tree) = @_; # sort children, using the sort filter my @childs = sort { $sort_function->($a, $b) } $tree->getAllChildren(); # Create the new sequence foreach my $child (@childs) { # get the removed child $child = $tree->removeChild($child); # and be sure that is the one # we re-insert $tree->addChild($child); # only sort the child if # it is not a leaf $self->_sortTree($sort_function, $child) unless $child->isLeaf(); } } 1; __END__ =head1 NAME Tree::Simple::Visitor::Sort - A Visitor for sorting a Tree::Simple object hierarchy =head1 SYNOPSIS use Tree::Simple::Visitor::Sort; # create a visitor object my $visitor = Tree::Simple::Visitor::Sort->new(); $tree->accept($visitor); # the tree is now sorted ascii-betically # set the sort function to # use a numeric comparison $visitor->setSortFunction($visitor->NUMERIC); $tree->accept($visitor); # the tree is now sorted numerically # set a custom sort function $visitor->setSortFunction(sub { my ($left, $right) = @_; lc($left->getNodeValue()->{name}) cmp lc($right->getNodeValue()->{name}); }); $tree->accept($visitor); # the tree's node are now sorted appropriately =head1 DESCRIPTION This implements a recursive multi-level sort of a Tree::Simple hierarchy. I think this deserves some more explanation, and the best way to do that is visually. Given the tree: 1 1.3 1.2 1.2.2 1.2.1 1.1 4 4.1 2 2.1 3 3.3 3.2 3.1 A normal sort would produce the following tree: 1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 3 3.1 3.2 3.3 4 4.1 A sort using the built-in REVERSE sort function would produce the following tree: 4 4.1 3 3.3 3.2 3.1 2 2.1 1 1.3 1.2 1.2.2 1.2.1 1.1 As you can see, no node is moved up or down from it's current depth, but sorted with it's siblings. Flexible customized sorting is possible within this framework, however, this cannot be used for tree-balancing or anything as complex as that. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C and C methods to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the sort as well. =item B This method accepts a CODE reference as it's C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are sorted. This can be used 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 This method accepts a CODE reference as it's C<$sort_function> argument and throws an exception if it is not a code reference. The C<$sort_function> is used by perl's builtin C routine to sort each level of the tree. The C<$sort_function> is passed two Tree::Simple objects, and must return 1 (greater than), 0 (equal to) or -1 (less than). The sort function will override and bypass any node filters which have been applied (see C method above), they cannot be used together. Several pre-built sort functions are provided. All of these functions assume that calling C on the Tree::Simple object will return a suitable sortable value. =over 4 =item REVERSE This is the reverse of the normal sort using C. =item NUMERIC This uses the numeric comparison operator C=E> to sort. =item REVERSE_NUMERIC The reverse of the above. =item ALPHABETICAL This lowercases the node value before using C to sort. This results in a true alphabetical sorting. =item REVERSE_ALPHABETICAL The reverse of the above. =back If you need to implement one of these sorting routines, but need special handling of your Tree::Simple objects (such as would be done with a node filter), I suggest you read the source code and copy and modify your own sort routine. If it is requested enough I will provide this feature in future versions, but for now I am not sure there is a large need. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. It should be noted that this is a I action, since the sort happens I and does not produce a copy of the tree. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 ACKNOWLEDGEMENTS =over 4 =item Thanks to Vitor Mori for the idea and much of the code for this Visitor. =back =head1 AUTHORS Vitor Mori, Evvvv767@hotmail.comE stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Vitor Mori & Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/BreadthFirstTraversal.pm0000644000175000017500000001043012712221607026066 0ustar ronronpackage Tree::Simple::Visitor::BreadthFirstTraversal; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->SUPER::_init(); } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # create a holder for our results my @results; # get our filter function my $filter_function = $self->getNodeFilter(); # now create a queue for # processing depth first my @queue; # if we are to include the trunk if ($self->includeTrunk()) { # then enqueue that @queue = ($tree); } # if we are not including the trunk else { # then we enqueue all the # trunks children instead @queue = ($tree->getAllChildren()); } # until our queue is empty while (scalar(@queue) != 0){ # get the first item off the queue my $current_tree = shift @queue; # enqueue all the current tree's children push @queue => $current_tree->getAllChildren(); # now collect the results push @results => (($filter_function) ? $filter_function->($current_tree) : $current_tree->getNodeValue()); } # store our results $self->setResults(@results); } 1; __END__ =head1 NAME Tree::Simple::Visitor::BreadthFirstTraversal - A Visitor for breadth-first traversal a Tree::Simple hierarchy =head1 SYNOPSIS use Tree::Simple::Visitor::BreadthFirstTraversal; # create an visitor my $visitor = Tree::Simple::Visitor::BreadthFirstTraversal->new(); # pass our visitor to the tree $tree->accept($visitor); # print our results print join ", " => $visitor->getResults(); # this will print this: # 1, 2, 3, 1.1, 1.2, 2.1, 3.1, 1.1.1 # assuming your tree is like this: # 1 # 1.1 # 1.1.1 # 1.2 # 2 # 2.1 # 3 # 3.1 =head1 DESCRIPTION This implements a breadth-first traversal of a Tree::Simple hierarchy. This can be an alternative to the built in depth-first traversal of the Tree::Simple C method. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C method to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the traversal as well. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are 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 This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method returns the accumulated results of the application of the node filter to the tree. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/LoadDirectoryTree.pm0000644000175000017500000001736612712221607025224 0ustar ronronpackage Tree::Simple::Visitor::LoadDirectoryTree; use strict; use warnings; our $VERSION = '0.15'; use File::Spec; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{sort_function} = undef; $self->SUPER::_init(); } # pre-built sort functions sub SORT_FILES_FIRST { return sub ($$$) { my ($path, $left, $right) = @_; $left = File::Spec->catdir($path, $left); $right = File::Spec->catdir($path, $right); return ((-d $left && -f $right) ? 1 : # file beats directory (-d $right && -f $left) ? -1 : # file beats directory (lc($left) cmp lc($right))) # otherwise just sort 'em } } sub SORT_DIRS_FIRST { return sub ($$$) { my ($path, $left, $right) = @_; $left = File::Spec->catdir($path, $left); $right = File::Spec->catdir($path, $right); return ((-d $left && -f $right) ? -1 : # directory beats file (-d $right && -f $left) ? 1 : # directory beats file (lc($left) cmp lc($right))) # otherwise just sort 'em } } sub setSortStyle { my ($self, $sort_function) = @_; (defined($sort_function) && ref($sort_function) eq "CODE") || die "Insufficient Arguments : sort function argument must be a subroutine reference"; $self->{sort_function} = $sort_function; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # it must be a leaf ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a directory"; # check that our directory is valid my $root_dir = $tree->getNodeValue(); (-e $root_dir && -d $root_dir) || die "Incorrect Type : The tree's node value must be a valid directory"; # and load it recursively $self->_recursiveLoad($tree, $root_dir); } sub _recursiveLoad { my ($self, $t, $path) = @_; # get a node filter if we have one my $filter = $self->getNodeFilter(); # get the contents of the directory opendir(DIR, $path) || die "IO Error : Could not open directory : $!"; # avoid the . and .. symbolic links my @dir_contents = grep { $_ ne File::Spec->curdir() && $_ ne File::Spec->updir() } readdir(DIR); close(DIR); # sort them if we need to with full paths @dir_contents = sort { $self->{sort_function}->($path, $a, $b) } @dir_contents if $self->{sort_function}; # now traverse ... foreach my $item (@dir_contents) { # filter based on the item name $filter->($item) || next if defined($filter); # get the full path for checking # the item type and recursion my $full_path = File::Spec->catdir($path, $item); if (-d $full_path) { my $new_tree = $t->new($item); $t->addChild($new_tree); $self->_recursiveLoad($new_tree, $full_path); } elsif (-f $full_path) { $t->addChild($t->new($item)); } } } 1; __END__ =head1 NAME Tree::Simple::Visitor::LoadDirectoryTree - A Visitor for loading the contents of a directory into a Tree::Simple object =head1 SYNOPSIS use Tree::Simple::Visitor::LoadDirectoryTree; # create a Tree::Simple object whose # node is path to a directory my $tree = Tree::Simple->new("./"); # create an instance of our visitor my $visitor = Tree::Simple::Visitor::LoadDirectoryTree->new(); # set the directory sorting style $visitor->setSortStyle($visitor->SORT_FILES_FIRST); # create node filter to filter # out certain files and directories $visitor->setNodeFilter(sub { my ($item) = @_; return 0 if $item =~ /CVS/; return 1; }); # pass the visitor to a Tree::Simple object $tree->accept($visitor); # the tree now mirrors the structure of the directory =head1 DESCRIPTION This visitor can be used to load a directory tree into a Tree::Simple hierarchy. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C and C methods to customize its behavior. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are created. The function is given the current directory or file being added to the tree, and it is expected to return either true (C<1>) of false (C<0>) to determine if that directory should be traversed or file added to the tree. =item B This method accepts a CODE reference as its C<$sort_function> argument and throws an exception if it is not a code reference. This function is used to sort the individual levels of the directory tree right before it is added to the tree being built. The function is passed the current path, followed by the two items being sorted. The reason for passing the path in is so that sorting operations can be performed on the entire path if desired. Two pre-built functions are supplied and described below. =over 4 =item B This sorting function will sort files before directories, so that files are sorted alphabetically first in the list followed by directories sorted alphabetically. Here is example of how that would look: Tree/ Simple.pm Simple/ Visitor.pm VisitorFactory.pm Visitor/ PathToRoot.pm =item B This sorting function will sort directories before files, so that directories are sorted alphabetically first in the list followed by files sorted alphabetically. Here is example of how that would look: Tree/ Simple/ Visitor/ PathToRoot.pm Visitor.pm VisitorFactory.pm Simple.pm =back =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. The node value of the C<$tree> argument (gotten by calling C) is considered the root directory from which we begin our traversal. We use File::Spec to keep our paths cross-platform, but it is expected that you will feed in a valid path for your OS. If the path either does not exist, or is not a directory, then an exception is thrown. The C<$tree> argument which is passed to C must be a leaf node. This is because this Visitor will create all the sub-nodes for this tree. If the tree is not a leaf, an exception is thrown. We do not require the tree to be a root though, and this Visitor will not affect any nodes above the C<$tree> argument. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/FindByNodeValue.pm0000644000175000017500000001561712712221607024613 0ustar ronronpackage Tree::Simple::Visitor::FindByNodeValue; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{success} = 0; $self->{node_value_to_find} = undef; $self->SUPER::_init(); } sub searchForNodeValue { my ($self, $node_value) = @_; (defined($node_value)) || die "Insufficient Arguments : You must provide a node value to search for"; $self->{node_value_to_find} = $node_value; } sub setTraversalMethod { my ($self, $visitor) = @_; (blessed($visitor) && $visitor->isa("Tree::Simple::Visitor")) || die "Insufficient Arguments : You must supply a valid Tree::Simple::Visitor object"; $self->{traversal_method} = $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # reset our success flag $self->{success} = 0; my $node_value = $self->{node_value_to_find}; (defined($node_value)) || die "Illegal Operation : You cannot search for a node_value without setting one first"; # create our filter function # NOTE: # in order to get an immediate exit # from the traversal once a match is # found, we use 'die'. It is a somewhat # unorthodox way of using this, but it # works. The found tree is propagated # up the call chain and returned from # this function. my $func; if ($self->{_filter_function}) { $func = sub { my ($tree, $test) = @_; (($tree->getNodeValue() eq $node_value) && $self->{_filter_function}->($tree)) && die $tree; }; } else { $func = sub { my ($tree, $test) = @_; ($tree->getNodeValue() eq $node_value) && die $tree; }; } # we eval this so we can catch the tree # match when it is thrown with 'die' eval { unless (defined($self->{traversal_method})) { # include the trunk in our # search if needed $func->($tree) if $self->includeTrunk(); # and traverse $tree->traverse($func); } else { # include the trunk in our # search if needed $self->{traversal_method}->includeTrunk(1) if $self->includeTrunk(); # and visit $self->{traversal_method}->setNodeFilter($func); $self->{traversal_method}->visit($tree); } }; # now see what we have ... if ($@) { # if we caught a Tree::Simple object # then we have found a match, and ... if (blessed($@) && $@->isa('Tree::Simple')) { # we assign it to our results $self->setResults($@); $self->{success} = 1; } # however, if it is not a Tree::Simple # object then it is likely a real exception else { # so we re-throw it die $@; } } else { # if no exception is thrown though, # we failed in our search, and so we # set our success flag to false $self->{success} = 0; } } sub getResult { my ($self) = @_; # if we did not succeed, then # we return undef, ... return undef unless $self->{success}; # otherwise we return the results return $self->getResults()->[0]; } 1; __END__ =head1 NAME Tree::Simple::Visitor::FindByNodeValue - A Visitor for finding an element in a Tree::Simple hierarchy by node value =head1 SYNOPSIS use Tree::Simple::Visitor::FindByNodeValue; # create a visitor object my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); # set the search path for our tree $visitor->searchForNodeValue("My Tree Node"); # pass the visitor to a tree $tree->accept($visitor); # fetch the result, which will # be the Tree::Simple object that # we have found, or undefined my $result = $visitor->getResult() || die "No Tree found"; =head1 DESCRIPTION Given a node value and Tree::Simple hierarchy, this Visitor will attempt to find the node with the same node value. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C, C, C and C methods to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the search as well. =item B By default we will use Tree::Simple's built in depth-first (pre-order) traverse method. If however, you desire the tree to be search in a different ordering, this can be accomplished using a different traversal method, you can supply a C<$visitor> object implementing that traversal type to this method (See B, B and B). =item B This is the node value we will attempt to find within the tree. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to further check the tree nodes as they are searched and so can be used to customize search behavior. For instance, you could to check against the node value as well as some other criteria. The filter function should accept a single argument, which is the current Tree::Simple object and return either true (C<1>) on success, or false (C<0>) on failure. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method will return the tree found with the specified node value (set by the C method) or C if no tree is found. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/FindByPath.pm0000644000175000017500000001510512712221607023615 0ustar ronronpackage Tree::Simple::Visitor::FindByPath; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{search_path} = undef; $self->{success} = 0; $self->SUPER::_init(); } sub setSearchPath { my ($self, @path) = @_; (@path) || die "Insufficient Arguments : You must specify a path"; $self->{search_path} = \@path; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # reset our success flag $self->{success} = 0; # get our filter function my $func; if ($self->{_filter_function}) { $func = sub { my ($tree, $test) = @_; return (($self->{_filter_function}->($tree) . "") eq $test); }; } else { $func = sub { my ($tree, $test) = @_; return (($tree->getNodeValue() . "") eq $test); }; } # get ready with our results my @results; # get our path my @path = @{$self->{search_path}}; # get our variables ready my $current_path; my $current_tree = $tree; # check to see if we have been # asked to include the trunk if ($self->includeTrunk()) { # if we don't match the root of the path # then we have failed already and so return $self->setResults(()) && return unless $func->($current_tree, $path[0]); # if we do match, then remove it off the path shift @path; } TOP: { # if we have no more @path we have found it unless (@path) { # store the current tree as # our last result $self->setResults(@results, $current_tree); # and set the success flag $self->{success} = 1; return; } # otherwise we need to keep looking ... # get the next element in the path $current_path = shift @path; # now check all the current tree's children # for a match foreach my $child ($current_tree->getAllChildren()) { if ($func->($child, $current_path)) { # if we find a match, then # we store the current tree # in our results, and push @results => $current_tree; # we change our current tree $current_tree = $child; # and go back to the TOP goto TOP; } } # if we do not find a match, then we can fall off # this block and the whole subroutine for that matter # since we know the match has failed. push @results => $current_tree if (@path || $self->{success} == 0) && $current_tree != $tree; } # we do however, store the # results as far as we got, # so that the user can maybe # do something else to recover $self->setResults(@results); } sub getResult { my ($self) = @_; # if we did not succeed, then # we return undef, ... return undef unless $self->{success}; # otherwise we return the # last in the results return $self->getResults()->[-1]; } 1; __END__ =head1 NAME Tree::Simple::Visitor::FindByPath - A Visitor for finding an element in a Tree::Simple hierarchy with a path =head1 SYNOPSIS use Tree::Simple::Visitor::FindByPath; # create a visitor object my $visitor = Tree::Simple::Visitor::FindByPath->new(); # set the search path for our tree $visitor->setSearchPath(qw(1 1.2 1.2.2)); # pass the visitor to a tree $tree->accept($visitor); # fetch the result, which will # be the Tree::Simple object that # we have found, or undefined my $result = $visitor->getResult() || die "No Tree found"; # our result's node value should match # the last element in our path print $result->getNodeValue(); # this should print 1.2.2 =head1 DESCRIPTION Given a path and Tree::Simple hierarchy, this Visitor will attempt to find the node specified by the path. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C and C methods to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the search as well. =item B This is the path we will attempt to follow down the tree. We will do a stringified comparison of each element of the path and the current tree's node (or the value returned by the node filter if it is set). =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are 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 This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method will return the tree found at the specified path (set by the C method) or C if no tree is found. =item B This method will return the tree's that make up the path specified in C. In the case of a failed search, this can be used to find the elements which did successfully match along the way. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/ToNestedArray.pm0000644000175000017500000001107312712221607024351 0ustar ronronpackage Tree::Simple::Visitor::ToNestedArray; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # grab our filter (if we have one) my $filter = $self->getNodeFilter(); my @results; # get the array $self->_buildArray($tree, \@results, $filter); # add the trunk if we need to @results = ( ((defined($filter)) ? $filter->($tree) : $tree->getNodeValue()), [ @results ] ) if $self->includeTrunk(); # set results $self->setResults(\@results); } sub _buildArray { my ($self, $tree, $accumulator, $filter) = @_; foreach my $child ($tree->getAllChildren()) { push @{$accumulator} => (defined($filter) ? $filter->($child) : $child->getNodeValue()); push @{$accumulator} => $self->_buildArray($child, [], $filter) unless $child->isLeaf(); } return $accumulator; } 1; __END__ =head1 NAME Tree::Simple::Visitor::ToNestedArray - A Visitor for creating nested array trees from Tree::Simple objects. =head1 SYNOPSIS use Tree::Simple::Visitor::ToNestedArray; my $visitor = Tree::Simple::Visitor::ToNestedArray->new(); # given this Tree::Simple tree my $tree = Tree::Simple->new("Root") ->addChildren( Tree::Simple->new("Child1") ->addChildren( Tree::Simple->new("GrandChild1"), Tree::Simple->new("GrandChild2") ), Tree::Simple->new("Child2"), ); # include the trunk (Root) $visitor->includeTrunk(1); # visit the tree $tree->accept($visitor); my $array_tree = $visitor->getResults(); # this then creates the equivalent nested array tree: # [ # 'Root', [ # 'Child1', [ # 'GrandChild1', # 'GrandChild2' # ], # 'Child2' # ] # ] # if you don't include the trunk (Root) then ... $tree->accept($visitor); my $array_tree = $visitor->getResults(); # this then creates the following nested array tree: # [ # 'Child1', [ # 'GrandChild1', # 'GrandChild2' # ], # 'Child2' # ] =head1 DESCRIPTION Given a tree constructed from a Tree::Simple hierarchy, this Visitor will create the equivalent tree of nested arrays. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C and C methods to customize its behavior. =item B Setting the C<$boolean> value to true (C<1>) will cause the node value of the tree's root to be included in the nested array output, setting it to false will do the opposite. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are placed into the array tree. The C<$filter_function> is passed a Tree::Simple object, and is expected to return the value desired for inclusion into the array tree. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method will return the array tree constructed. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/PostOrderTraversal.pm0000644000175000017500000001104212712221607025426 0ustar ronronpackage Tree::Simple::Visitor::PostOrderTraversal; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # get our filter function my $filter_function = $self->getNodeFilter(); # use an inner subroutine to accomplish # this traversal using recursion my $_postOrderTraversal = sub { my ($current_tree, $traversal_function) = @_; # get a temporary results container my @results; # process each child foreach my $child ($current_tree->getAllChildren()) { # recurse our inner subroutine by passing itself # to itself, and then collect the results of this # recursion push @results => $traversal_function->($child, $traversal_function); } # if we are root and we are not including the trunk then # we can return our results now return @results if $current_tree->isRoot() && !$self->includeTrunk(); # however, if we don't meet those conditions, then we # need to process the current tree and add it to our # results push @results => (($filter_function) ? $filter_function->($current_tree) : $current_tree->getNodeValue()); # and then return the results return @results; }; # now store the results in our object $self->setResults($_postOrderTraversal->($tree, $_postOrderTraversal)); } 1; __END__ =head1 NAME Tree::Simple::Visitor::PostOrderTraversal - A Visitor for post-order traversal a Tree::Simple hierarchy =head1 SYNOPSIS use Tree::Simple::Visitor::PostOrderTraversal; # create an visitor my $visitor = Tree::Simple::Visitor::PostOrderTraversal->new(); # pass our visitor to the tree $tree->accept($visitor); # print our results print join ", " => $visitor->getResults(); # this will print this: # 1.1.1 1.1 1.2 1 2.1 2 3.1 3 # assuming your tree is like this: # 1 # 1.1 # 1.1.1 # 1.2 # 2 # 2.1 # 3 # 3.1 =head1 DESCRIPTION Post-order traversal is a variation of the depth-first traversal in which the sub-tree's are processed I the parent. It is another alternative to Tree::Simple's C method which implements a depth-first, pre-order traversal. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C method to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the traversal as well. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are 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 This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method returns the accumulated results of the application of the node filter to the tree. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/VariableDepthClone.pm0000644000175000017500000001016512712221607025321 0ustar ronronpackage Tree::Simple::Visitor::VariableDepthClone; use strict; use warnings; use Scalar::Util 'blessed'; our $VERSION = '0.15'; use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{clone_depth} = undef; $self->SUPER::_init(); } sub setCloneDepth { my ($self, $clone_depth) = @_; (defined($clone_depth)) || die "Insufficient Arguments : you must supply a clone depth"; $self->{clone_depth} = $clone_depth; } sub getClone { my ($self) = @_; return $self->getResults()->[0]; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; my $filter = $self->getNodeFilter(); # get a new instance of the root tree type my $new_root = blessed($tree)->new($tree->ROOT); my $new_tree = $new_root; if ($self->includeTrunk()) { my $cloned_trunk = blessed($tree)->new(); $cloned_trunk->setNodeValue( Tree::Simple::_cloneNode($tree->getNodeValue()) ); $filter->($tree, $cloned_trunk) if defined $filter; $new_tree->addChild($cloned_trunk); $new_tree = $cloned_trunk; } $self->_cloneTree($tree, $new_tree, $self->{clone_depth}, $filter); $self->setResults($new_root); } sub _cloneTree { my ($self, $tree, $clone, $depth, $filter) = @_; return if $depth <= 0; foreach my $child ($tree->getAllChildren()) { my $cloned_child = blessed($child)->new(); $cloned_child->setNodeValue( Tree::Simple::_cloneNode($child->getNodeValue()) ); $filter->($child, $cloned_child) if defined $filter; $clone->addChild($cloned_child); $self->_cloneTree($child, $cloned_child, $depth - 1, $filter) unless $child->isLeaf(); } } 1; __END__ =head1 NAME Tree::Simple::Visitor::VariableDepthClone - A Visitor for cloning parts of Tree::Simple hierarchy =head1 SYNOPSIS use Tree::Simple::Visitor::VariableDepthClone; # create an visitor my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); $visitor->setCloneDepth(3); # pass our visitor to the tree $tree->accept($visitor); my $partial_tree = $visitor->getClone(); =head1 DESCRIPTION This visitor will clone =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C method to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the traversal as well. This basically means it will clone the root node as well. =item B =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are cloned. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method returns the cloned partial tree. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/PathToRoot.pm0000644000175000017500000001120412712221607023664 0ustar ronronpackage Tree::Simple::Visitor::PathToRoot; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # create an array for our path my @path; # we need to climb up the tree and # collect the nodes my $filter_function = $self->getNodeFilter(); my $current_tree = $tree; until ($current_tree->isRoot()) { unshift @path => ($filter_function ? $filter_function->($current_tree) : $current_tree->getNodeValue()); $current_tree = $current_tree->getParent(); } # now grab the trunk if specified unshift @path => ($filter_function ? $filter_function->($current_tree) : $current_tree->getNodeValue()) if $self->includeTrunk(); # now store our path in results $self->setResults(@path); } sub getPath { my ($self) = @_; return $self->getResults(); } sub getPathAsString { my ($self, $delimiter) = @_; $delimiter ||= ", "; return join $delimiter => $self->getResults(); } 1; __END__ =head1 NAME Tree::Simple::Visitor::PathToRoot - A Visitor for finding the path back a Tree::Simple object's root =head1 SYNOPSIS use Tree::Simple::Visitor::PathToRoot; # create an instance of our visitor my $visitor = Tree::Simple::Visitor::PathToRoot->new(); # pass the visitor to a Tree::Simple object $tree->accept($visitor); # now get the accumulated path as a string # with the '/' character as the delimiter print $visitor->getPathAsString("/"); # include the tree's trunk in your # output as well $visitor->includeTrunk(); # 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(); }); # you can also get the path back as an array my @path = $visitor->getPath(); =head1 DESCRIPTION Given a Tree::Simple object, this Visitor will find the path back to the tree's root node. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C and C methods to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to collect the trunk of the tree as well. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are 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 This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This will return the collected path as an array, or in scalar context, as an array reference. =item B This will return the collected path as a string with the path elements joined by a C<$delimiter>. If no C<$delimiter> is specified, the default (', ') will be used. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/PreOrderTraversal.pm0000644000175000017500000000612012712221607025230 0ustar ronronpackage Tree::Simple::Visitor::PreOrderTraversal; use strict; use warnings; our $VERSION = '0.15'; use base qw(Tree::Simple::Visitor); # make sure we use the "new" interface # so we enforce it here sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = $class->SUPER::new(); return $visitor; } 1; __END__ =head1 NAME Tree::Simple::Visitor::PreOrderTraversal - A Visitor for pre-order traversal a Tree::Simple hierarchy =head1 SYNOPSIS use Tree::Simple::Visitor::PreOrderTraversal; # create an visitor my $visitor = Tree::Simple::Visitor::PreOrderTraversal->new(); # pass our visitor to the tree $tree->accept($visitor); # print our results print join ", " => $visitor->getResults(); # this will print this: # 1 1.1 1.1.1 1.2 2 2.1 3 3.1 # assuming your tree is like this: # 1 # 1.1 # 1.1.1 # 1.2 # 2 # 2.1 # 3 # 3.1 =head1 DESCRIPTION Pre-order traversal is a depth-first traversal method in which the sub-tree's are processed I the parent. It is essentially a wrapper around the base Tree::Simple::Visitor class, and is a separate module here for completeness. (If you have a post-order, you should have a pre-order too). =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C method to customize its behavior. =item B Based upon the value of C<$boolean>, this will tell the visitor to include the trunk of the tree in the traversal as well. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are 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 This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method returns the accumulated results of the application of the node filter to the tree. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/LoadClassHierarchy.pm0000644000175000017500000001532212712221607025332 0ustar ronronpackage Tree::Simple::Visitor::LoadClassHierarchy; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{class_to_load} = undef; $self->{include_methods} = 0; $self->SUPER::_init(); } sub setClass { my ($self, $class_to_load) = @_; (defined($class_to_load)) || die "Insufficient Arguments : Must provide a class to load"; $self->{class_to_load} = $class_to_load; } sub includeMethods { my ($self, $boolean) = @_; $self->{include_methods} = ($boolean ? 1 : 0) if defined $boolean; return $self->{include_methods}; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # it must be a leaf ($tree->isLeaf()) || die "Illegal Operation : The tree must be a leaf node to load a class hierarchy"; (defined $self->{class_to_load}) || die "Insufficient Arguments : Must provide a class to load"; # get the filter my $filter = $self->getNodeFilter(); # get the class to load my $class_to_load = ref($self->{class_to_load}) || $self->{class_to_load}; # deal with the include trunk functionality if ($self->includeTrunk()) { $tree->setNodeValue(defined $filter ? $filter->($class_to_load) : $class_to_load); } else { my $new_tree = Tree::Simple->new(defined $filter ? $filter->($class_to_load) : $class_to_load); $tree->addChild($new_tree); if ($self->includeMethods()) { $self->_loadMethods($new_tree, $class_to_load, $filter); } $tree = $new_tree; } # and load it recursively $self->_loadClass($tree, $class_to_load, $filter); } sub _loadClass { my ($self, $tree, $class_to_load, $filter) = @_; my @superclasses; { no strict 'refs'; @superclasses = @{"${class_to_load}::ISA"}; } foreach my $superclass (@superclasses) { my $new_tree = Tree::Simple->new(defined $filter ? $filter->($superclass) : $superclass); $tree->addChild($new_tree); if ($self->includeMethods()) { $self->_loadMethods($new_tree, $superclass, $filter); } $self->_loadClass($new_tree, $superclass, $filter); } } sub _loadMethods { my ($self, $tree, $class, $filter) = @_; my @methods; { no strict 'refs'; @methods = sort grep { defined &{"${class}::$_"} } keys %{"${class}::"}; } foreach my $method (@methods) { $tree->addChild(Tree::Simple->new(defined $filter ? $filter->($method) : $method)); } } 1; __END__ =head1 NAME Tree::Simple::Visitor::LoadClassHierarchy - A Visitor for loading class hierarchies into a Tree::Simple hierarchy =head1 SYNOPSIS use Tree::Simple::Visitor::LoadClassHierarchy; # create an visitor my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); # set class as an instance, or $visitor->setClass($class); # as a package name $visitor->setClass("My::Class"); # pass our visitor to the tree $tree->accept($visitor); # the $tree now mirrors the inheritance hierarchy of the $class =head1 DESCRIPTION This visitor will traverse a class's inheritance hierarchy (through the @ISA arrays) and create a Tree::Simple hierarchy which mirrors it. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C method to customize its behavior. =item B Setting the C<$boolean> value to true (C<1>) will cause the node value of the C<$tree> object passed into C to be set with the root value found in the class hierarchy. Setting it to false (C<0>), or not setting it, will result in the first value in the class hierarchy creating a new node level. =item B Setting the C<$boolean> value to true (C<1>) will cause methods to be added as a children of the class node. Setting it to false (C<0>), or not setting it, will result in this not happening. B Methods are sorted ascii-betically before they are added to the tree. This allows a more predictable hierarchy. =item B The argument C<$class> should be either a class name or an instance, it is then used as the root from which to determine the class hierarchy. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are created, the C<$filter_function> is passed the node value extracted from the hash prior to it being inserted into the tree being built. The C<$filter_function> is expected to return the value desired for inclusion into the tree. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. The C<$tree> argument which is passed to C must be a leaf node. This is because this Visitor will create all the sub-nodes for this tree. If the tree is not a leaf, an exception is thrown. We do not require the tree to be a root though, and this Visitor will not affect any nodes above the C<$tree> argument. =back =head1 TO DO =over =item Improve the C functionality I am not sure the tree this creates is the optimal tree for this situation. It is sufficient for now, until I have more of an I need for this functionality. =item Add C functionality This would traverse the full symbol tables and produce a detailed tree of everything it finds. This takes a lot more work, and as I have no current need for it, it remains in the TO DO list. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/CreateDirectoryTree.pm0000644000175000017500000001572712712221607025547 0ustar ronronpackage Tree::Simple::Visitor::CreateDirectoryTree; use strict; use warnings; our $VERSION = '0.15'; use File::Spec; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{file_handler} = sub { my ($filepath) = @_; open(FILE, ">", $filepath) || die "IO Error : Cannot create file ($filepath) : $!"; close(FILE); }; $self->{dir_handler} = sub { my ($dirpath) = @_; mkdir($dirpath) || die "IO Error : Cannot make directory ($dirpath) : $!"; }; $self->SUPER::_init(); } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # pass on to our recursive subroutine $self->_createDirectoryStructure($tree); } sub setFileHandler { my ($self, $file_handler) = @_; (defined($file_handler) && ref($file_handler) eq 'CODE') || die "Insufficient Arguments : file handler must be a subroutine reference"; $self->{file_handler} = $file_handler; } sub setDirectoryHandler { my ($self, $dir_handler) = @_; (defined($dir_handler) && ref($dir_handler) eq 'CODE') || die "Insufficient Arguments : directory handler must be a subroutine reference"; $self->{dir_handler} = $dir_handler; } sub _createDirectoryStructure { my ($self, $tree, @path) = @_; my $node = $tree->getNodeValue(); # filter the nodes if need be my $filter_function = $self->getNodeFilter(); $node = $filter_function->($node) if $filter_function; # if its a leaf and it # doesn't end with a / # then its a file if ($tree->isLeaf() && $node !~ /\/|\\$/) { $self->{file_handler}->(File::Spec->catfile(@path, $node)); } # otherwise we are going # to treat it as a directory else { $node =~ s/\/|\\$//; $self->{dir_handler}->(File::Spec->catdir(@path, $node)); foreach my $child ($tree->getAllChildren()) { $self->_createDirectoryStructure($child, (@path, $node)); } } } 1; __END__ =head1 NAME Tree::Simple::Visitor::CreateDirectoryTree - A Visitor for create a set of directories and files from a Tree::Simple object =head1 SYNOPSIS use Tree::Simple::Visitor::CreateDirectoryTree; # create a Tree::Simple object which # represents a directory heirarchy my $tree = Tree::Simple->new("www/") ->addChildren( Tree::Simple->new("conf/") ->addChildren( Tree::Simple->new("startup.pl"), Tree::Simple->new("httpd.conf") ), Tree::Simple->new("cgi-bin/"), Tree::Simple->new("ht_docs/"), Tree::Simple->new("logs/") ->addChildren( Tree::Simple->new("error.log"), Tree::Simple->new("access.log") ), ); # create an instance of our visitor my $visitor = Tree::Simple::Visitor::CreateDirectoryTree->new(); # pass the visitor to a Tree::Simple object $tree->accept($visitor); # the www/ directory now mirrors the structure of the tree =head1 DESCRIPTION This visitor can be used to create a set of directories and files from a Tree::Simple object hierarchy. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C, C and C methods to customize its behavior. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are used to create the directory tree, it can be basically used as a node pre-processor. An example usage of this might be to enforce the C<8.3> naming rules of DOS, or the 32 character limit of older macintoshes. =item B This method accepts a CODE reference as its C<$file_handler> argument and throws an exception if it is not a CODE reference. This method can be used to create custom file creation behavior. The default behavior is to just create the file and nothing else, but by using this method it is possible to implement some other custom behavior, such as creating a file based on a template. The function is passed the full path of the file to be created (as built by File::Spec). =item B This method accepts a CODE reference as its C<$dir_handler> argument and throws an exception if it is not a CODE reference. This method can be used to create custom directory creation behavior. The default behavior is to just create the directory and nothing else, but by using this method it is possible to implement some other custom behavior, such as creating a directory on a remote server. The function is passed the full path of the directory to be created (as built by File::Spec). =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. The tree is processed as follows: =over 4 =item Any node which is not a leaf is considered a directory. Obviously since files themselves are leaf nodes, this makes sense that non-leaves will be directories. =item Any node (including leaf nodes) which ends in either the character C or C<\> is considered a directory. I think it is a pretty standard convention to have directory names ending in a separator. The separator itself is stripped off before the directory name is passed to File::Spec where the platform specific directory path is created. This means that it does not matter which one you use, it will be completely cross platform (at least as cross-platform as File::Spec is). =item All other nodes are considered to be files. =back =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/GetAllDescendents.pm0000644000175000017500000001201112712221607025146 0ustar ronronpackage Tree::Simple::Visitor::GetAllDescendents; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{traversal_method} = undef; $self->SUPER::_init(); } sub setTraversalMethod { my ($self, $visitor) = @_; (blessed($visitor) && $visitor->isa("Tree::Simple::Visitor")) || die "Insufficient Arguments : You must supply a valid Tree::Simple::Visitor object"; $self->{traversal_method} = $visitor; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; # create an closure for the # collection function my @descendents; my $filter_function = $self->getNodeFilter(); # build a collection function my $collection_function = sub { my ($t) = @_; push @descendents => ($filter_function ? $filter_function->($t) : $t->getNodeValue()); }; # and collect our descendents with the # traversal method specified unless (defined($self->{traversal_method})) { $tree->traverse($collection_function); } else { $self->{traversal_method}->setNodeFilter($collection_function); $self->{traversal_method}->visit($tree); } # now store our collected descendents $self->setResults(@descendents); } sub getAllDescendents { my ($self) = @_; return $self->getResults(); } 1; __END__ =head1 NAME Tree::Simple::Visitor::GetAllDescendents - A Visitor for fetching all the descendents of a Tree::Simple object =head1 SYNOPSIS use Tree::Simple::Visitor::GetAllDescendents; # create an instance of our visitor my $visitor = Tree::Simple::Visitor::GetAllDescendents->new(); # pass the visitor to a Tree::Simple object $tree->accept($visitor); # you can also get the descendents # back as an array of node values my @descendents = $visitor->getDescendents(); # 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(); }); =head1 DESCRIPTION Given a Tree::Simple instance this Visitor will return all the descendents recursively on down the hierarchy. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C method to customize its behavior. =item B By default we will use Tree::Simple's built in depth-first (pre-order) traverse method. If however, you desire the descendents to be returned in a different ordering, this can be accomplished using a different traversal method, you can supply a C<$visitor> object implementing that traversal type to this method (See B, B and B). =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are 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 This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =item B This method will give back and array of descendents in depth-first order (pre-order) or in the order specified by the C. If called in scalar context it will give an array reference, in list context it will return a regular array. This method is the same as calling C. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/Visitor/FromNestedHash.pm0000644000175000017500000001325412712221607024502 0ustar ronronpackage Tree::Simple::Visitor::FromNestedHash; use strict; use warnings; our $VERSION = '0.15'; use Scalar::Util qw(blessed); use base qw(Tree::Simple::Visitor); sub new { my ($_class) = @_; my $class = ref($_class) || $_class; my $visitor = {}; bless($visitor, $class); $visitor->_init(); return $visitor; } sub _init { my ($self) = @_; $self->{hash_tree} = undef; $self->SUPER::_init(); } sub setHashTree { my ($self, $hash_tree) = @_; (defined($hash_tree) && ref($hash_tree) eq 'HASH') || die "Insufficient Arguments : You must supply a valid HASH reference"; # validate the tree ... # it must not be empty (scalar keys %{$hash_tree} == 1) || die "Insufficient Arguments : The hash tree provided must be a single rooted tree"; $self->{hash_tree} = $hash_tree; } sub visit { my ($self, $tree) = @_; (blessed($tree) && $tree->isa("Tree::Simple")) || die "Insufficient Arguments : You must supply a valid Tree::Simple object"; $self->_buildTree( $tree, $self->{hash_tree}, $self->getNodeFilter(), $self->includeTrunk() ); } sub _buildTree { my ($self, $tree, $hash, $node_filter, $include_trunk) = @_; foreach my $key (sort keys %{$hash}) { my $node = $key; $node = $node_filter->($node) if $node_filter; my $new_tree; if ($include_trunk) { $tree->setNodeValue($node); $new_tree = $tree; } else { $new_tree = Tree::Simple->new($node); $tree->addChild($new_tree); } $self->_buildTree($new_tree, $hash->{$key}, $node_filter) if ref($hash->{$key}) eq 'HASH'; } } 1; __END__ =head1 NAME Tree::Simple::Visitor::FromNestedHash - A Visitor for creating Tree::Simple objects from nested hash trees. =head1 SYNOPSIS use Tree::Simple::Visitor::FromNestedHash; my $visitor = Tree::Simple::Visitor::FromNestedHash->new(); # given this nested hash tree my $hash_tree = { Root => { Child1 => { GrandChild1 => {}, GrandChild2 => {} }, Child2 => {} } }; # set the array tree we # are going to convert $visitor->setHashTree($hash_tree); $tree->accept($visitor); # this then creates the equivalent Tree::Simple object: # Tree::Simple->new("Root") # ->addChildren( # Tree::Simple->new("Child1") # ->addChildren( # Tree::Simple->new("GrandChild1"), # Tree::Simple->new("GrandChild2") # ), # Tree::Simple->new("Child2"), # ); =head1 DESCRIPTION Given a tree constructed from nested hashes, this Visitor will create the equivalent Tree::Simple hierarchy. =head1 METHODS =over 4 =item B There are no arguments to the constructor the object will be in its default state. You can use the C methods to customize its behavior. =item B This method accepts a CODE reference as its C<$filter_function> argument and throws an exception if it is not a code reference. This code reference is used to filter the tree nodes as they are created, the C<$filter_function> is passed the node value extracted from the hash prior to it being inserted into the tree being built. The C<$filter_function> is expected to return the value desired for inclusion into the tree. =item B This method is used to set the C<$hash_tree> that our Tree::Simple hierarchy will be constructed from. It must be in the following form: { Root => { Child1 => { GrandChild1 => {}, GrandChild2 => {} }, Child2 => {} } } Basically each key in the hash is considered a node, values are ignored unless it is a hash reference with at least one key in it, in which case it is interpreted as containing the children of the node created from the key. The tree is validated prior being accepted, if it fails validation an exception will be thrown. The rules are as follows; =over 4 =item The hash tree must not be empty. It makes not sense to create a tree out of nothing, so it is assumed that this is a sign of something wrong. =item The hash tree must be a single rooted tree. The hash tree should have only one key in it's first level, if it has more than one, then it is not a single rooted tree. =back B Hash keys are sorted ascii-betically before being added to the tree, this results in a somewhat more predictable hierarchy. =item B This is the method that is used by Tree::Simple's C method. It can also be used on its own, it requires the C<$tree> argument to be a Tree::Simple object (or derived from a Tree::Simple object), and will throw and exception otherwise. =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE See the B section in L for more information. =head1 SEE ALSO These Visitor classes are all subclasses of B, which can be found in the B module, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/lib/Tree/Simple/VisitorFactory.pm0000644000175000017500000001771312712221607023164 0ustar ronronpackage Tree::Simple::VisitorFactory; use strict; use warnings; our $VERSION = '0.15'; sub new { my ($class) = @_; return bless \$class; } sub get { my ($class, $visitor) = @_; (defined($visitor)) || die "Insufficient Arguments : You must specify a Visitor to load"; $visitor = "Tree::Simple::Visitor::$visitor"; eval "require $visitor"; die "Illegal Operation : Could not load Visitor ($visitor) because $@" if $@; return $visitor->new(); } *getVisitor = \&get; 1; __END__ =head1 NAME Tree::Simple::VisitorFactory - A factory object for dispensing Visitor objects =head1 SYNOPSIS use Tree::Simple::VisitorFactory; my $tf = Tree::Simple::VisitorFactory->new(); my $visitor = $tf->get("PathToRoot"); # or call it as a class method my $visitor = Tree::Simple::VisitorFactory->getVisitor("PathToRoot"); =head1 DESCRIPTION This object is really just a factory for dispensing Tree::Simple::Visitor::* objects. It is not required to use this package in order to use all the Visitors, it is just a somewhat convenient way to avoid having to type their long class names. I considered making this a Singleton, but I did not because I thought that some people might not want that. I know that I am very picky about using Singletons, especially in multiprocess environments like mod_perl, so I implemented the smallest instance I knew how to, and made sure all other methods could be called as class methods too. =head1 METHODS =over 4 =item B Returns an minimal instance of this object, basically just a reference back to the package (literally, see the source if you care). =item B Attempts to load the C<$visitor_type> and returns an instance of it if successful. If no C<$visitor_type> is specified an exception is thrown, if C<$visitor_type> fails to load, and exception is thrown. =item B This is an alias of C. =back =head1 AVAILABLE VISITORS This distribution provides a number of Visitor objects which can be loaded just by giving their name. Below is a description of the available Visitors and a sort description of what they do. I have attempted to classify the Visitors into groups which are related to their use. This factory will load any module contained inside the B namespace. Given a name, it will attempt to C the module BIE.pm>. This allows others to create Visitors which can be accessed with this factory, without needed to include them in this distribution. =head2 Search/Path Related Visitors =over 4 =item B Given a Tree::Simple object, this Visitor will find the path back to the tree's root node. =item B Given a path and Tree::Simple hierarchy, this Visitor will attempt to find the node specified by the path. =item B Given a UID and Tree::Simple hierarchy, this Visitor will attempt to find the node with the same UID. =item B Given a node value and Tree::Simple hierarchy, this Visitor will attempt to find the node with the same node value. =back =head2 Traversal Visitors =over 4 =item B This implements a breadth-first traversal of a Tree::Simple hierarchy. =item B Post-order traversal is a variation of the depth-first traversal in which the sub-tree's are processed I the parent. =item B Pre-order traversal is a depth-first traversal method in which the sub-tree's are processed I the parent. =back =head2 FileSystem Visitors =over 4 =item B This visitor can be used to load a directory tree into a Tree::Simple hierarchy. =item B This visitor can be used to create a set of directories and files from a Tree::Simple object hierarchy. =back =head2 Conversion Visitors =over 4 =item B Given a tree constructed from nested arrays, this Visitor will create the equivalent Tree::Simple hierarchy. =item B Given a Tree::Simple hierarchy, this Visitor will create the equivalent tree constructed from nested arrays. =item B Given a tree constructed from nested hashs, this Visitor will create the equivalent Tree::Simple hierarchy. =item B Given a Tree::Simple hierarchy, this Visitor will create the equivalent tree constructed from nested hashes. =back =head2 Reflective Visitors =over 4 =item B Given a class name or instance, this Visitor will create a Tree::Simple hierarchy which models the classes inheritance hierarchy. =back =head2 Misc. Visitors =over 4 =item B Given a Tree::Simple instance this Visitor will return all the descendents recursively on down the hierarchy. =item B This implements a multi-level sort of a Tree::Simple hierarchy. =item B A Visitor for cloning parts of Tree::Simple hierarchy =back =head1 BUGS None that I am aware of. Of course, if you find a bug, let me know, and I will be sure to fix it. =head1 CODE COVERAGE I use B to test the code coverage of my tests, below is the B report on this module test suite. -------------------------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt branch cond sub pod time total -------------------------------------------- ------ ------ ------ ------ ------ ------ ------ Tree/Simple/VisitorFactory.pm 100.0 100.0 n/a 100.0 100.0 0.4 100.0 Tree/Simple/Visitor/BreadthFirstTraversal.pm 100.0 100.0 66.7 100.0 100.0 2.5 96.3 Tree/Simple/Visitor/PostOrderTraversal.pm 100.0 100.0 77.8 100.0 100.0 1.7 96.3 Tree/Simple/Visitor/PreOrderTraversal.pm 100.0 n/a 33.3 100.0 100.0 0.7 90.5 Tree/Simple/Visitor/CreateDirectoryTree.pm 100.0 85.7 86.7 100.0 100.0 3.4 95.8 Tree/Simple/Visitor/LoadClassHierarchy.pm 100.0 73.1 33.3 100.0 100.0 4.9 89.2 Tree/Simple/Visitor/LoadDirectoryTree.pm 100.0 89.3 85.2 100.0 100.0 26.1 94.7 Tree/Simple/Visitor/FindByNodeValue.pm 100.0 100.0 86.7 100.0 100.0 3.1 98.3 Tree/Simple/Visitor/FindByPath.pm 100.0 100.0 66.7 100.0 100.0 1.2 97.9 Tree/Simple/Visitor/FindByUID.pm 100.0 100.0 86.7 100.0 100.0 2.9 98.3 Tree/Simple/Visitor/GetAllDescendents.pm 100.0 100.0 77.8 100.0 100.0 2.3 97.1 Tree/Simple/Visitor/PathToRoot.pm 100.0 87.5 75.0 100.0 100.0 0.8 95.1 Tree/Simple/Visitor/Sort.pm 100.0 100.0 77.8 100.0 100.0 8.8 98.1 Tree/Simple/Visitor/ToNestedArray.pm 100.0 100.0 66.7 100.0 100.0 1.5 96.5 Tree/Simple/Visitor/ToNestedHash.pm 100.0 100.0 66.7 100.0 100.0 1.4 96.5 Tree/Simple/Visitor/FromNestedArray.pm 100.0 94.4 81.8 100.0 100.0 8.1 96.6 Tree/Simple/Visitor/FromNestedHash.pm 100.0 91.7 77.8 100.0 100.0 4.8 95.9 Tree/Simple/Visitor/VariableDepthClone.pm 100.0 100.0 66.7 100.0 100.0 25.5 97.3 -------------------------------------------- ------ ------ ------ ------ ------ ------ ------ Total 100.0 93.8 76.3 100.0 100.0 100.0 96.1 -------------------------------------------- ------ ------ ------ ------ ------ ------ ------ =head1 SEE ALSO These Visitor classes are meant to work with L hierarchies, you should refer to that module for more information. =head1 AUTHOR stevan little, Estevan@iinteractive.comE Ron Savage Eron@savage.net.auE has taken over maintenance as of V 0.11. =head1 REPOSITORY L. =head1 COPYRIGHT AND LICENSE Copyright 2004, 2005 by Infinity Interactive, Inc. L This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tree-Simple-VisitorFactory-0.15/Changelog.ini0000644000175000017500000000754312712221607017331 0ustar ronron[Module] Name=Tree::Simple::VisitorFactory: Changelog.Creator=Module::Metadata::Changes V 2.09 Changelog.Parser=Config::IniFiles V 2.88 [V 0.14] Date=2016-04-27T17:35:00 Comments= < 15; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::PostOrderTraversal'); } use Tree::Simple; my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), Tree::Simple->new("1.2.2") ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2"), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::PostOrderTraversal", 'new'); my $visitor = Tree::Simple::Visitor::PostOrderTraversal->new(); isa_ok($visitor, 'Tree::Simple::Visitor::PostOrderTraversal'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $tree->accept($visitor); is_deeply( [ $visitor->getResults() ], [ qw(1.1 1.2.1 1.2.2 1.2 1.3 1 2.1 2.2 2 3.1 3.2 3.3 3 4.1 4) ], '... our results are as expected'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { "Tree_" . $_[0]->getNodeValue() }); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); $tree->accept($visitor); is_deeply( [ $visitor->getResults() ], [ qw(Tree_1.1 Tree_1.2.1 Tree_1.2.2 Tree_1.2 Tree_1.3 Tree_1 Tree_2.1 Tree_2.2 Tree_2 Tree_3.1 Tree_3.2 Tree_3.3 Tree_3 Tree_4.1 Tree_4 Tree_root) ], '... our results are as expected'); # test some error conditions throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... this should die';Tree-Simple-VisitorFactory-0.15/t/93_Tree_Simple_Visitor_ToNestedArray_test.t0000644000175000017500000000725710265333657025512 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 33; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::ToNestedArray'); } use Tree::Simple; my $tree = Tree::Simple->new("Root") ->addChildren( Tree::Simple->new("Child1") ->addChildren( Tree::Simple->new("GrandChild1"), Tree::Simple->new("GrandChild2") ), Tree::Simple->new("Child2"), ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::ToNestedArray", 'new'); { my $visitor = Tree::Simple::Visitor::ToNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'includeTrunk'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $visitor->includeTrunk(1); $tree->accept($visitor); is_deeply($visitor->getResults(), [ 'Root', [ 'Child1', [ 'GrandChild1', 'GrandChild2' ], 'Child2' ]], '... got the whole tree'); } { my $visitor = Tree::Simple::Visitor::ToNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $tree->accept($visitor); is_deeply($visitor->getResults(), [ 'Child1', [ 'GrandChild1', 'GrandChild2' ], 'Child2' ], '... got the tree minus the root'); } { my $visitor = Tree::Simple::Visitor::ToNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { return uc($_[0]->getNodeValue()); }); $tree->accept($visitor); is_deeply($visitor->getResults(), [ 'CHILD1', [ 'GRANDCHILD1', 'GRANDCHILD2' ], 'CHILD2' ], '... got the tree minus the root and uppercased'); } { my $visitor = Tree::Simple::Visitor::ToNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'includeTrunk'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { return uc($_[0]->getNodeValue()); }); $visitor->includeTrunk(1); $tree->accept($visitor); is_deeply($visitor->getResults(), [ 'ROOT', [ 'CHILD1', [ 'GRANDCHILD1', 'GRANDCHILD2' ], 'CHILD2' ]], '... got the tree minus the root and uppercased'); } { my $visitor = Tree::Simple::Visitor::ToNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; }Tree-Simple-VisitorFactory-0.15/t/20_Tree_Simple_Visitor_PathToRoot_test.t0000644000175000017500000001027010265333657025004 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 23; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::PathToRoot'); } use Tree::Simple; my $very_deep = Tree::Simple->new("1.2.2.1"); isa_ok($very_deep, 'Tree::Simple'); my $kind_of_deep = Tree::Simple->new("2.2.1"); isa_ok($kind_of_deep, 'Tree::Simple'); my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), Tree::Simple->new("1.2.2") ->addChild($very_deep) ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ->addChild($kind_of_deep) ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2"), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::PathToRoot", 'new'); my $visitor = Tree::Simple::Visitor::PathToRoot->new(); isa_ok($visitor, 'Tree::Simple::Visitor::PathToRoot'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getPathAsString'); can_ok($visitor, 'getPath'); $kind_of_deep->accept($visitor); is($visitor->getPathAsString("/"), "2/2.2/2.2.1", '... our paths match'); is_deeply( [ $visitor->getPath() ], [ qw/2 2.2 2.2.1/ ], '... our paths match'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { "~" . $_[0]->getNodeValue() . "~" }); $visitor->includeTrunk(1); $very_deep->accept($visitor); is($visitor->getPathAsString(), "~root~, ~1~, ~1.2~, ~1.2.2~, ~1.2.2.1~", '... our paths match again'); is_deeply( [ $visitor->getPath() ], [ qw/~root~ ~1~ ~1.2~ ~1.2.2~ ~1.2.2.1~/ ], '... our paths match again'); $visitor->includeTrunk(0); $tree->accept($visitor); is($visitor->getPathAsString("|"), "", '... we got nothing'); is_deeply( scalar $visitor->getPath(), [ ], '... no path means no results'); $visitor->includeTrunk(1); $tree->accept($visitor); is($visitor->getPathAsString(), "~root~", '... we got nothing'); is_deeply( scalar $visitor->getPath(), [ "~root~" ], '... but include root and we have something at least'); # test some error conditions throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... this should die'; Tree-Simple-VisitorFactory-0.15/t/95_Tree_Simple_Visitor_LoadClassHierarchy_test.t0000644000175000017500000001350510265333657026465 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 50; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::LoadClassHierarchy'); } use Tree::Simple; can_ok("Tree::Simple::Visitor::LoadClassHierarchy", 'new'); # --------------------------- # classic diamond inheritance # --------------------------- # A B # / \ / # C D # \ / # E # --------------------------- # modeled as this tree # --------------------------- # A A B # \ \ / # C D # \ / # E # --------------------------- { package A; package B; package C; @C::ISA = ('A'); package D; @D::ISA = ('A', 'B'); package E; @E::ISA = ('C', 'D'); } { my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setClass'); $visitor->setClass('E'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); isa_ok($tree, 'Tree::Simple'); can_ok($visitor, 'visit'); $tree->accept($visitor); my $current = $tree->getChild(0); is($current->getNodeValue(), 'E', '... got the value we expected'); is($current->getChild(0)->getNodeValue(), 'C', '... got the value we expected'); is($current->getChild(0)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); is($current->getChild(1)->getNodeValue(), 'D', '... got the value we expected'); is($current->getChild(1)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); is($current->getChild(1)->getChild(1)->getNodeValue(), 'B', '... got the value we expected'); } { my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setClass'); $visitor->setClass('E'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); isa_ok($tree, 'Tree::Simple'); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); can_ok($visitor, 'visit'); $tree->accept($visitor); my $current = $tree; is($current->getNodeValue(), 'E', '... got the value we expected'); is($current->getChild(0)->getNodeValue(), 'C', '... got the value we expected'); is($current->getChild(0)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); is($current->getChild(1)->getNodeValue(), 'D', '... got the value we expected'); is($current->getChild(1)->getChild(0)->getNodeValue(), 'A', '... got the value we expected'); is($current->getChild(1)->getChild(1)->getNodeValue(), 'B', '... got the value we expected'); } { my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setClass'); $visitor->setClass('E'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); isa_ok($tree, 'Tree::Simple'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { "Package::" . $_[0] }); can_ok($visitor, 'visit'); $tree->accept($visitor); my $current = $tree->getChild(0); is($current->getNodeValue(), 'Package::E', '... got the value we expected'); is($current->getChild(0)->getNodeValue(), 'Package::C', '... got the value we expected'); is($current->getChild(0)->getChild(0)->getNodeValue(), 'Package::A', '... got the value we expected'); is($current->getChild(1)->getNodeValue(), 'Package::D', '... got the value we expected'); is($current->getChild(1)->getChild(0)->getNodeValue(), 'Package::A', '... got the value we expected'); is($current->getChild(1)->getChild(1)->getNodeValue(), 'Package::B', '... got the value we expected'); } { package One; sub new {} sub one {} package Two; @Two::ISA = ('One'); sub two {} package Three; @Three::ISA = ('Two'); sub three {} } { my $visitor = Tree::Simple::Visitor::LoadClassHierarchy->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadClassHierarchy'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setClass'); $visitor->setClass('Three'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); isa_ok($tree, 'Tree::Simple'); can_ok($visitor, 'includeMethods'); $visitor->includeMethods(1); can_ok($visitor, 'visit'); $tree->accept($visitor); my $current = $tree->getChild(0); is($current->getNodeValue(), 'Three', '... got the value we expected'); is($current->getChild(0)->getNodeValue(), 'three', '... got the value we expected'); is($current->getChild(1)->getNodeValue(), 'Two', '... got the value we expected'); is($current->getChild(1)->getChild(0)->getNodeValue(), 'two', '... got the value we expected'); is($current->getChild(1)->getChild(1)->getNodeValue(), 'One', '... got the value we expected'); is($current->getChild(1)->getChild(1)->getChild(0)->getNodeValue(), 'new', '... got the value we expected'); is($current->getChild(1)->getChild(1)->getChild(1)->getNodeValue(), 'one', '... got the value we expected'); } Tree-Simple-VisitorFactory-0.15/t/91_Tree_Simple_Visitor_FromNestedArray_test.t0000644000175000017500000001477110265333657026030 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 58; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::FromNestedArray'); } use Tree::Simple; my $array_tree = [ 'Root', [ 'Child1', [ 'GrandChild1', 'GrandChild2' ], 'Child2' ] ]; can_ok("Tree::Simple::Visitor::FromNestedArray", 'new'); { # check normal behavior my $visitor = Tree::Simple::Visitor::FromNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setArrayTree'); $visitor->setArrayTree($array_tree); can_ok($visitor, 'visit'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); my $root = $tree->getChild(0); is($root->getNodeValue(), 'Root', '... got the value we expected from Root'); cmp_ok($root->getChildCount(), '==', 2, '... Root has 2 children'); my ($child1, $child2) = $root->getAllChildren(); is($child1->getNodeValue(), 'Child1', '... got the value we expected from Child1'); cmp_ok($child1->getChildCount(), '==', 2, '... Child1 has 2 children'); my ($grandchild1, $grandchild2) = $child1->getAllChildren(); is($grandchild1->getNodeValue(), 'GrandChild1', '... got the value we expected from GrandChild1'); ok($grandchild1->isLeaf(), '... GrandChild1 is a leaf node'); is($grandchild2->getNodeValue(), 'GrandChild2', '... got the value we expected from GrandChild2'); ok($grandchild2->isLeaf(), '... GrandChild2 is a leaf node'); is($child2->getNodeValue(), 'Child2', '... got the value we expected from Child2'); ok($child2->isLeaf(), '... Child2 is a leaf node'); } { # check includeTrunk behavior my $visitor = Tree::Simple::Visitor::FromNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setArrayTree'); $visitor->setArrayTree($array_tree); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); can_ok($visitor, 'visit'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); my $root = $tree; is($root->getNodeValue(), 'Root', '... got the value we expected from Root'); cmp_ok($root->getChildCount(), '==', 2, '... Root has 2 children'); my ($child1, $child2) = $root->getAllChildren(); is($child1->getNodeValue(), 'Child1', '... got the value we expected from Child1'); cmp_ok($child1->getChildCount(), '==', 2, '... Child1 has 2 children'); my ($grandchild1, $grandchild2) = $child1->getAllChildren(); is($grandchild1->getNodeValue(), 'GrandChild1', '... got the value we expected from GrandChild1'); ok($grandchild1->isLeaf(), '... GrandChild1 is a leaf node'); is($grandchild2->getNodeValue(), 'GrandChild2', '... got the value we expected from GrandChild2'); ok($grandchild2->isLeaf(), '... GrandChild2 is a leaf node'); is($child2->getNodeValue(), 'Child2', '... got the value we expected from Child2'); ok($child2->isLeaf(), '... Child2 is a leaf node'); } { # check nodeFilter behavior my $visitor = Tree::Simple::Visitor::FromNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setArrayTree'); $visitor->setArrayTree($array_tree); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { my ($node) = @_; return uc($node); }); can_ok($visitor, 'visit'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); my $root = $tree->getChild(0); is($root->getNodeValue(), 'ROOT', '... got the value we expected from Root'); cmp_ok($root->getChildCount(), '==', 2, '... Root has 2 children'); my ($child1, $child2) = $root->getAllChildren(); is($child1->getNodeValue(), 'CHILD1', '... got the value we expected from Child1'); cmp_ok($child1->getChildCount(), '==', 2, '... Child1 has 2 children'); my ($grandchild1, $grandchild2) = $child1->getAllChildren(); is($grandchild1->getNodeValue(), 'GRANDCHILD1', '... got the value we expected from GrandChild1'); ok($grandchild1->isLeaf(), '... GrandChild1 is a leaf node'); is($grandchild2->getNodeValue(), 'GRANDCHILD2', '... got the value we expected from GrandChild2'); ok($grandchild2->isLeaf(), '... GrandChild2 is a leaf node'); is($child2->getNodeValue(), 'CHILD2', '... got the value we expected from Child2'); ok($child2->isLeaf(), '... Child2 is a leaf node'); } { my $visitor = Tree::Simple::Visitor::FromNestedArray->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedArray'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check setHashTree throws_ok { $visitor->setArrayTree(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setArrayTree("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setArrayTree([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setArrayTree([[]]); } qr/Incorrect Object Type/, '... got the error we expected'; throws_ok { $visitor->setArrayTree(['root', 'Fail']); } qr/Incorrect Object Type/, '... got the error we expected'; $visitor->setArrayTree(['root', [[]]]); throws_ok { $visitor->visit(Tree::Simple->new(Tree::Simple->ROOT)); } qr/Incorrect Object Type/, '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/30_Tree_Simple_Visitor_FindByPath_test.t0000644000175000017500000001477410327240142024730 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 46; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::FindByPath'); } use Tree::Simple; my $first_search = Tree::Simple->new("1.2.2"); isa_ok($first_search, 'Tree::Simple'); my $second_search = Tree::Simple->new("3.2.1"); isa_ok($second_search, 'Tree::Simple'); my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), $first_search ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2")->addChild($second_search), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::FindByPath", 'new'); my $visitor = Tree::Simple::Visitor::FindByPath->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByPath'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setSearchPath'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResult'); # test our first search path $visitor->setSearchPath(qw(1 1.2 1.2.2)); $tree->accept($visitor); is($visitor->getResult(), $first_search, '... this should be what we got back'); { my @results = $visitor->getResults(); is(scalar(@results), 4, '... go four results (including root)'); is($results[0], $tree, '... got the right first result'); is($results[1], $tree->getChild(0), '... got the right next result'); is($results[2], $tree->getChild(0)->getChild(1), '... got the right next result'); is($results[3], $first_search, '... got the right next result'); } # test our first failing search path $visitor->setSearchPath(qw(1 1.2 1.2.3)); $tree->accept($visitor); ok(!defined($visitor->getResult()), '... match failed so we get undef back'); { my @results = $visitor->getResults(); is(scalar(@results), 3, '... go three results (including root)'); is($results[0], $tree, '... got the right first result'); is($results[1], $tree->getChild(0), '... got the right next result'); is($results[2], $tree->getChild(0)->getChild(1), '... got the right next result'); } # test our next failing search path $visitor->setSearchPath(qw(1 1.5 1.2.3)); $tree->accept($visitor); ok(!defined($visitor->getResult()), '... match failed so we get undef back'); { my @results = $visitor->getResults(); is(scalar(@results), 2, '... go two results (including root)'); is($results[0], $tree, '... got the right first result'); is($results[1], $tree->getChild(0), '... got the right next result'); } # test our next failing search path $visitor->setSearchPath(qw(100 1.5 1.2.3)); $tree->accept($visitor); ok(!defined($visitor->getResult()), '... match failed so we get undef back'); { my @results = $visitor->getResults(); is(scalar(@results), 0, '... go no results (including root)'); } # add a node filter can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { "Tree_" . $_[0]->getNodeValue() }); # test our new search path with filter $visitor->setSearchPath(qw(Tree_3 Tree_3.2 Tree_3.2.1)); $tree->accept($visitor); is($visitor->getResult(), $second_search, '... this should be what we got back'); { my @results = $visitor->getResults(); is(scalar(@results), 4, '... go four results (including root)'); is($results[0], $tree, '... got the right first result'); is($results[1], $tree->getChild(2), '... got the right next result'); is($results[2], $tree->getChild(2)->getChild(1), '... got the right next result'); is($results[3], $second_search, '... got the right next result'); } # use the trunk can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); # test path failure $visitor->setSearchPath(qw(Tree_root Tree_1 Tree_5 Tree_35)); $tree->accept($visitor); ok(!defined($visitor->getResult()), '... should fail, and we get back undef'); { my @results = $visitor->getResults(); is(scalar(@results), 2, '... we should have gotten the root, and 1'); is($results[0], $tree, '... we should not have gotten farther than the 1'); is($results[1], $tree->getChild(0), '... we should not have gotten farther than the 1'); } # test total path failure $visitor->setSearchPath(qw(8 5 35)); $tree->accept($visitor); ok(!defined($visitor->getResult()), '... should fail, and we get back undef'); { my @results = $visitor->getResults(); is(scalar(@results), 0, '... we should have gotten nothing at all'); } # test some error conditions throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->setSearchPath(); } qr/Insufficient Arguments/, '... this should die'; Tree-Simple-VisitorFactory-0.15/t/80_Tree_Simple_Visitor_Sort_test.t0000644000175000017500000002002110265333657023671 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 37; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::Sort'); use_ok('Tree::Simple::Visitor::GetAllDescendents'); } use Tree::Simple; my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.3"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.2"), Tree::Simple->new("1.2.1") ), Tree::Simple->new("1.1") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.3"), Tree::Simple->new("3.2"), Tree::Simple->new("3.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::Sort", 'new'); # try normal sort { my $visitor = Tree::Simple::Visitor::Sort->new(); isa_ok($visitor, 'Tree::Simple::Visitor::Sort'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); $tree->accept($visitor); my $visitor_check = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor_check, 'Tree::Simple::Visitor::GetAllDescendents'); $tree->accept($visitor_check); is_deeply( [ $visitor_check->getAllDescendents() ], [ qw/1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1/ ], '... our tree is as expected after sort'); } # try sort with a node filter { my $visitor = Tree::Simple::Visitor::Sort->new(); isa_ok($visitor, 'Tree::Simple::Visitor::Sort'); my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new([ 1 ]) ->addChildren( Tree::Simple->new([ 1, 3 ]), Tree::Simple->new([ 1, 2 ]) ->addChildren( Tree::Simple->new([ 1, 2, 2 ]), Tree::Simple->new([ 1, 2, 1 ]) ), Tree::Simple->new([ 1, 1]) ), Tree::Simple->new([ 2 ]) ->addChildren( Tree::Simple->new([ 2, 1 ]), Tree::Simple->new([ 2, 2 ] ) ) ); isa_ok($tree, 'Tree::Simple'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { my ($t) = @_; # sort on the last part of the node return $t->getNodeValue()->[-1]; }); $tree->accept($visitor); my $visitor_check = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor_check, 'Tree::Simple::Visitor::GetAllDescendents'); $tree->accept($visitor_check); is_deeply( [ $visitor_check->getAllDescendents() ], [ [1], [1, 1], [1, 2], [1, 2, 1], [1, 2, 2], [1, 3], [2], [2, 1], [2, 2] ], '... our tree is as expected after sort'); } # try custom sort function { my $visitor = Tree::Simple::Visitor::Sort->new(); isa_ok($visitor, 'Tree::Simple::Visitor::Sort'); can_ok($visitor, 'setSortFunction'); $visitor->setSortFunction($visitor->REVERSE); $tree->accept($visitor); my $visitor_check = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor_check, 'Tree::Simple::Visitor::GetAllDescendents'); $tree->accept($visitor_check); is_deeply( [ $visitor_check->getAllDescendents() ], [ qw/4 4.1 3 3.3 3.2 3.1 2 2.2 2.1 1 1.3 1.2 1.2.2 1.2.1 1.1 / ], '... our tree is as expected after sort'); } # check all our pre-built functions is(ref(Tree::Simple::Visitor::Sort->REVERSE), 'CODE', '... it is a code reference'); # already tested above is(ref(Tree::Simple::Visitor::Sort->NUMERIC), 'CODE', '... it is a code reference'); cmp_ok(Tree::Simple::Visitor::Sort->NUMERIC->(Tree::Simple->new(5), Tree::Simple->new(4)), '==', 1, '... the numeric sort works'); is(ref(Tree::Simple::Visitor::Sort->REVERSE_NUMERIC), 'CODE', '... it is a code reference'); cmp_ok(Tree::Simple::Visitor::Sort->REVERSE_NUMERIC->(Tree::Simple->new(5), Tree::Simple->new(4)), '==', -1, '... the reverse numeric sort works'); is(ref(Tree::Simple::Visitor::Sort->ALPHABETICAL), 'CODE', '... it is a code reference'); cmp_ok(Tree::Simple::Visitor::Sort->ALPHABETICAL->(Tree::Simple->new("A"), Tree::Simple->new("a")), '==', 0, '... the alphabetical sort works'); is(ref(Tree::Simple::Visitor::Sort->REVERSE_ALPHABETICAL), 'CODE', '... it is a code reference'); cmp_ok(Tree::Simple::Visitor::Sort->REVERSE_ALPHABETICAL->(Tree::Simple->new("a"), Tree::Simple->new("b")), '==', 1, '... the reverse alphabetical sort works'); # test some weird stuff { my $visitor = Tree::Simple::Visitor::Sort->new(); isa_ok($visitor, 'Tree::Simple::Visitor::Sort'); # test visitiing a leaf node my $leaf = Tree::Simple->new("leaf"); $leaf->accept($visitor); } # test the errors { my $visitor = Tree::Simple::Visitor::Sort->new(); isa_ok($visitor, 'Tree::Simple::Visitor::Sort'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check the handler errors throws_ok { $visitor->setSortFunction(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setSortFunction("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setSortFunction([]); } qr/Insufficient Arguments/, '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/65_Tree_Simple_Visitor_PreOrederTraversal_test.t0000644000175000017500000000513410265333657026530 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 8; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::PreOrderTraversal'); } use Tree::Simple; my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), Tree::Simple->new("1.2.2") ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2"), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::PreOrderTraversal", 'new'); my $visitor = Tree::Simple::Visitor::PreOrderTraversal->new(); isa_ok($visitor, 'Tree::Simple::Visitor::PreOrderTraversal'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $tree->accept($visitor); is_deeply( [ $visitor->getResults() ], [ qw(1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], '... our results are as expected'); Tree-Simple-VisitorFactory-0.15/t/50_Tree_Simple_Visitor_BreadthFirstTraversal_test.t0000644000175000017500000000671310265333657027220 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 15; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::BreadthFirstTraversal'); } use Tree::Simple; my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), Tree::Simple->new("1.2.2") ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2"), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::BreadthFirstTraversal", 'new'); my $visitor = Tree::Simple::Visitor::BreadthFirstTraversal->new(); isa_ok($visitor, 'Tree::Simple::Visitor::BreadthFirstTraversal'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $tree->accept($visitor); is_deeply( [ $visitor->getResults() ], [ qw(1 2 3 4 1.1 1.2 1.3 2.1 2.2 3.1 3.2 3.3 4.1 1.2.1 1.2.2) ], '... our results are as expected'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { "Tree_" . $_[0]->getNodeValue() }); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); $tree->accept($visitor); is_deeply( [ $visitor->getResults() ], [ qw(Tree_root Tree_1 Tree_2 Tree_3 Tree_4 Tree_1.1 Tree_1.2 Tree_1.3 Tree_2.1 Tree_2.2 Tree_3.1 Tree_3.2 Tree_3.3 Tree_4.1 Tree_1.2.1 Tree_1.2.2) ], '... our results are as expected'); # test some error conditions throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... this should die'; Tree-Simple-VisitorFactory-0.15/t/35_Tree_Simple_Visitor_FindByUID_test.t0000644000175000017500000001772510265333657024500 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 49; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::FindByUID'); use_ok('Tree::Simple::Visitor::BreadthFirstTraversal'); } use Tree::Simple; my $first_search = Tree::Simple->new("1.2.2"); isa_ok($first_search, 'Tree::Simple'); my $first_search_UID = $first_search->getUID(); my $second_search = Tree::Simple->new("3.2.1"); isa_ok($second_search, 'Tree::Simple'); my $second_search_UID = $second_search->getUID(); my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), $first_search ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2")->addChild($second_search), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::FindByUID", 'new'); # check the normal behavior { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'searchForUID'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResult'); $visitor->searchForUID($first_search_UID); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $first_search, '... and it is our first search tree'); } # test the node filter and make it fail { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); $visitor->searchForUID($first_search_UID); # make our search fail $visitor->setNodeFilter(sub { my ($tree) = @_; return $tree->getNodeValue() ne "1.2.2"; }); $tree->accept($visitor); my $match = $visitor->getResult(); ok(!defined($match), '... match failed as expected'); } # test the second match { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); $visitor->searchForUID($second_search_UID); # make our search succed $visitor->setNodeFilter(sub { my ($tree) = @_; return $tree->getNodeValue() eq "3.2.1"; }); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... match succedded as expected'); is($match, $second_search, '... and it is our second search tree'); } # check the normal behavior with includeTrunk { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); $visitor->searchForUID($tree->getUID()); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $tree, '... and it is our base tree'); } # check the traversal method behavior { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setTraversalMethod'); $visitor->setTraversalMethod(Tree::Simple::Visitor::BreadthFirstTraversal->new()); $visitor->searchForUID($first_search_UID); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $first_search, '... and it is our first search tree'); } # check the traversal method behavior with includeTrunk { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); $visitor->setTraversalMethod(Tree::Simple::Visitor::BreadthFirstTraversal->new()); $visitor->includeTrunk(1); $visitor->searchForUID($tree->getUID()); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $tree, '... and it is our base tree'); } # check errors { my $visitor = Tree::Simple::Visitor::FindByUID->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByUID'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check UID throws_ok { $visitor->searchForUID(); } qr/Insufficient Arguments/, '... got the error we expected'; # try to visit without a UID throws_ok { $visitor->visit($tree); } qr/Illegal Operation/, '... got the error we expected'; # check setTraversalMethod throws_ok { $visitor->setTraversalMethod(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setTraversalMethod("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setTraversalMethod([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setTraversalMethod(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->searchForUID(); } qr/Insufficient Arguments/, '... got the error we expected'; # test some edge cases $visitor->searchForUID($first_search_UID); $visitor->setNodeFilter(sub { die "Nothing really" }); throws_ok { $visitor->visit($tree); } qr/Nothing really/, '... got the error we expected'; $visitor->setNodeFilter(sub { die bless({}, "NothingReally") }); throws_ok { $visitor->visit($tree); } "NothingReally", '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/32_Tree_Simple_Visitor_FindByNodeValue_test.t0000644000175000017500000002027510265333657025730 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 49; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::FindByNodeValue'); use_ok('Tree::Simple::Visitor::BreadthFirstTraversal'); } use Tree::Simple; my $first_search = Tree::Simple->new("1.2.2"); isa_ok($first_search, 'Tree::Simple'); my $first_search_NodeValue = '1.2.2'; my $second_search = Tree::Simple->new("3.2.1"); isa_ok($second_search, 'Tree::Simple'); my $second_search_NodeValue = '3.2.1'; my $second_search_UID = $second_search->getUID(); my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), $first_search ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2")->addChild($second_search), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::FindByNodeValue", 'new'); # check the normal behavior { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'searchForNodeValue'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResult'); $visitor->searchForNodeValue($first_search_NodeValue); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $first_search, '... and it is our first search tree'); } # test the node filter and make it fail { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); $visitor->searchForNodeValue($first_search_NodeValue); # make our search fail $visitor->setNodeFilter(sub { my ($tree) = @_; return $tree->getNodeValue() ne "1.2.2"; }); $tree->accept($visitor); my $match = $visitor->getResult(); ok(!defined($match), '... match failed as expected'); } # test the second match { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); $visitor->searchForNodeValue($second_search_NodeValue); # make our search succed $visitor->setNodeFilter(sub { my ($tree) = @_; return $tree->getUID() eq $second_search_UID; }); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... match succedded as expected'); is($match, $second_search, '... and it is our second search tree'); } # check the normal behavior with includeTrunk { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); $visitor->searchForNodeValue($tree->getNodeValue()); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $tree, '... and it is our base tree'); } # check the traversal method behavior { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setTraversalMethod'); $visitor->setTraversalMethod(Tree::Simple::Visitor::BreadthFirstTraversal->new()); $visitor->searchForNodeValue($first_search_NodeValue); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $first_search, '... and it is our first search tree'); } # check the traversal method behavior with includeTrunk { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); $visitor->setTraversalMethod(Tree::Simple::Visitor::BreadthFirstTraversal->new()); $visitor->includeTrunk(1); $visitor->searchForNodeValue($tree->getNodeValue()); $tree->accept($visitor); my $match = $visitor->getResult(); ok(defined($match), '... we got a result'); is($match, $tree, '... and it is our base tree'); } # check errors { my $visitor = Tree::Simple::Visitor::FindByNodeValue->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FindByNodeValue'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check UID throws_ok { $visitor->searchForNodeValue(); } qr/Insufficient Arguments/, '... got the error we expected'; # try to visit without a UID throws_ok { $visitor->visit($tree); } qr/Illegal Operation/, '... got the error we expected'; # check setTraversalMethod throws_ok { $visitor->setTraversalMethod(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setTraversalMethod("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setTraversalMethod([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setTraversalMethod(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->searchForNodeValue(); } qr/Insufficient Arguments/, '... got the error we expected'; # test some edge cases $visitor->searchForNodeValue($first_search_NodeValue); $visitor->setNodeFilter(sub { die "Nothing really" }); throws_ok { $visitor->visit($tree); } qr/Nothing really/, '... got the error we expected'; $visitor->setNodeFilter(sub { die bless({}, "NothingReally") }); throws_ok { $visitor->visit($tree); } "NothingReally", '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/70_Tree_Simple_Visitor_LoadDirectoryTree_test.t0000644000175000017500000002440112710343255026323 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 32; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::LoadDirectoryTree'); use_ok('Tree::Simple::Visitor::GetAllDescendents'); } use Tree::Simple; use File::Spec; can_ok("Tree::Simple::Visitor::LoadDirectoryTree", 'new'); my @normal = qw( Changes Changelog.ini lib Tree Simple Visitor BreadthFirstTraversal.pm CreateDirectoryTree.pm FindByPath.pm FindByUID.pm FindByNodeValue.pm FromNestedArray.pm FromNestedHash.pm GetAllDescendents.pm LoadClassHierarchy.pm LoadDirectoryTree.pm PathToRoot.pm PostOrderTraversal.pm PreOrderTraversal.pm Sort.pm ToNestedArray.pm ToNestedHash.pm VariableDepthClone.pm VisitorFactory.pm LICENSE Makefile.PL MANIFEST.SKIP README t 10_Tree_Simple_VisitorFactory_test.t 20_Tree_Simple_Visitor_PathToRoot_test.t 30_Tree_Simple_Visitor_FindByPath_test.t 32_Tree_Simple_Visitor_FindByNodeValue_test.t 35_Tree_Simple_Visitor_FindByUID_test.t 40_Tree_Simple_Visitor_GetAllDescendents_test.t 50_Tree_Simple_Visitor_BreadthFirstTraversal_test.t 60_Tree_Simple_Visitor_PostOrderTraversal_test.t 65_Tree_Simple_Visitor_PreOrederTraversal_test.t 70_Tree_Simple_Visitor_LoadDirectoryTree_test.t 75_Tree_Simple_Visitor_CreateDirectoryTree_test.t 80_Tree_Simple_Visitor_Sort_test.t 90_Tree_Simple_Visitor_FromNestedHash_test.t 91_Tree_Simple_Visitor_FromNestedArray_test.t 92_Tree_Simple_Visitor_ToNestedHash_test.t 93_Tree_Simple_Visitor_ToNestedArray_test.t 95_Tree_Simple_Visitor_LoadClassHierarchy_test.t 96_Tree_Simple_Visitor_VariableDepthClone_test.t ); my %normal = map { $_ => undef } @normal; my $node_filter = sub { my ($item) = @_; return 0 unless exists $normal{$item}; return 1; }; # normal order { my $dir_tree = Tree::Simple->new(File::Spec->curdir(), Tree::Simple->ROOT); isa_ok($dir_tree, 'Tree::Simple'); my $visitor = Tree::Simple::Visitor::LoadDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); # just examine the files in the MANIFEST # not the ones created by the makefile $visitor->setNodeFilter($node_filter); $dir_tree->accept($visitor); my $visitor_check = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor_check, 'Tree::Simple::Visitor::GetAllDescendents'); $dir_tree->accept($visitor_check); # we have to sort these because different OSes # will return the results in different orders. is_deeply( [ sort $visitor_check->getResults() ], [ sort @normal ], '... our tree is in the proper order'); } # file first order { my $dir_tree = Tree::Simple->new(File::Spec->curdir(), Tree::Simple->ROOT); isa_ok($dir_tree, 'Tree::Simple'); my $visitor = Tree::Simple::Visitor::LoadDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); # just examine the files in the MANIFEST # not the ones created by the makefile $visitor->setNodeFilter($node_filter); can_ok($visitor, 'SORT_FILES_FIRST'); $visitor->setSortStyle($visitor->SORT_FILES_FIRST); $dir_tree->accept($visitor); my @files_first = qw( Changelog.ini Changes LICENSE Makefile.PL MANIFEST.SKIP README lib Tree Simple VisitorFactory.pm Visitor BreadthFirstTraversal.pm CreateDirectoryTree.pm FindByNodeValue.pm FindByPath.pm FindByUID.pm FromNestedArray.pm FromNestedHash.pm GetAllDescendents.pm LoadClassHierarchy.pm LoadDirectoryTree.pm PathToRoot.pm PostOrderTraversal.pm PreOrderTraversal.pm Sort.pm ToNestedArray.pm ToNestedHash.pm VariableDepthClone.pm t 10_Tree_Simple_VisitorFactory_test.t 20_Tree_Simple_Visitor_PathToRoot_test.t 30_Tree_Simple_Visitor_FindByPath_test.t 32_Tree_Simple_Visitor_FindByNodeValue_test.t 35_Tree_Simple_Visitor_FindByUID_test.t 40_Tree_Simple_Visitor_GetAllDescendents_test.t 50_Tree_Simple_Visitor_BreadthFirstTraversal_test.t 60_Tree_Simple_Visitor_PostOrderTraversal_test.t 65_Tree_Simple_Visitor_PreOrederTraversal_test.t 70_Tree_Simple_Visitor_LoadDirectoryTree_test.t 75_Tree_Simple_Visitor_CreateDirectoryTree_test.t 80_Tree_Simple_Visitor_Sort_test.t 90_Tree_Simple_Visitor_FromNestedHash_test.t 91_Tree_Simple_Visitor_FromNestedArray_test.t 92_Tree_Simple_Visitor_ToNestedHash_test.t 93_Tree_Simple_Visitor_ToNestedArray_test.t 95_Tree_Simple_Visitor_LoadClassHierarchy_test.t 96_Tree_Simple_Visitor_VariableDepthClone_test.t ); my $visitor_check = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor_check, 'Tree::Simple::Visitor::GetAllDescendents'); $dir_tree->accept($visitor_check); is_deeply( [ $visitor_check->getResults() ], \@files_first, '... our tree is in the file first order'); } # dir first order { my $dir_tree = Tree::Simple->new(File::Spec->curdir(), Tree::Simple->ROOT); isa_ok($dir_tree, 'Tree::Simple'); my $visitor = Tree::Simple::Visitor::LoadDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); # just examine the files in the MANIFEST # not the ones created by the makefile $visitor->setNodeFilter($node_filter); can_ok($visitor, 'SORT_DIRS_FIRST'); $visitor->setSortStyle($visitor->SORT_DIRS_FIRST); $dir_tree->accept($visitor); my @dirs_first = qw( lib Tree Simple Visitor BreadthFirstTraversal.pm CreateDirectoryTree.pm FindByNodeValue.pm FindByPath.pm FindByUID.pm FromNestedArray.pm FromNestedHash.pm GetAllDescendents.pm LoadClassHierarchy.pm LoadDirectoryTree.pm PathToRoot.pm PostOrderTraversal.pm PreOrderTraversal.pm Sort.pm ToNestedArray.pm ToNestedHash.pm VariableDepthClone.pm VisitorFactory.pm t 10_Tree_Simple_VisitorFactory_test.t 20_Tree_Simple_Visitor_PathToRoot_test.t 30_Tree_Simple_Visitor_FindByPath_test.t 32_Tree_Simple_Visitor_FindByNodeValue_test.t 35_Tree_Simple_Visitor_FindByUID_test.t 40_Tree_Simple_Visitor_GetAllDescendents_test.t 50_Tree_Simple_Visitor_BreadthFirstTraversal_test.t 60_Tree_Simple_Visitor_PostOrderTraversal_test.t 65_Tree_Simple_Visitor_PreOrederTraversal_test.t 70_Tree_Simple_Visitor_LoadDirectoryTree_test.t 75_Tree_Simple_Visitor_CreateDirectoryTree_test.t 80_Tree_Simple_Visitor_Sort_test.t 90_Tree_Simple_Visitor_FromNestedHash_test.t 91_Tree_Simple_Visitor_FromNestedArray_test.t 92_Tree_Simple_Visitor_ToNestedHash_test.t 93_Tree_Simple_Visitor_ToNestedArray_test.t 95_Tree_Simple_Visitor_LoadClassHierarchy_test.t 96_Tree_Simple_Visitor_VariableDepthClone_test.t Changelog.ini Changes LICENSE Makefile.PL MANIFEST.SKIP README ); my $visitor_check = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor_check, 'Tree::Simple::Visitor::GetAllDescendents'); $dir_tree->accept($visitor_check); is_deeply( [ $visitor_check->getResults() ], \@dirs_first, '... our tree is in the dir first order'); } # test the errors { my $visitor = Tree::Simple::Visitor::LoadDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::LoadDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check setSortStyle can_ok($visitor, 'setSortStyle'); throws_ok { $visitor->setSortStyle(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setSortStyle("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setSortStyle([]); } qr/Insufficient Arguments/, '... got the error we expected'; # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check that tree is a leaf my $tree = Tree::Simple->new("test")->addChild(Tree::Simple->new("test 2")); throws_ok { $visitor->visit($tree); } qr/Illegal Operation/, '... got the error we expected'; throws_ok { $visitor->visit($tree->getChild(0)); } qr/Incorrect Type/, '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/75_Tree_Simple_Visitor_CreateDirectoryTree_test.t0000644000175000017500000001400210265333657026660 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 57; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::CreateDirectoryTree'); } use Tree::Simple; use File::Spec; my $dir_tree = Tree::Simple->new("test/") ->addChildren( Tree::Simple->new("sub_test/"), Tree::Simple->new("test.pm"), Tree::Simple->new("sub_test2\\") ->addChildren( Tree::Simple->new("sub_sub_test/"), Tree::Simple->new("sub_test.pm"), Tree::Simple->new("sub_sub_sub_test\\") ->addChildren( Tree::Simple->new("sub_sub_sub_test.pm") ) ) ); isa_ok($dir_tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::CreateDirectoryTree", 'new'); # test the default behavior { my $visitor = Tree::Simple::Visitor::CreateDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::CreateDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); $dir_tree->accept($visitor); # these are all the files we created my @files = ( File::Spec->catfile("test", "test.pm"), File::Spec->catfile("test", "sub_test2", "sub_test.pm"), File::Spec->catfile("test", "sub_test2", "sub_sub_sub_test", "sub_sub_sub_test.pm") ); # loop through and check them # and then remove them foreach my $filename (@files) { ok(-e $filename, '... file exists'); ok(-f $filename, '... and it is a file'); # now remove it cmp_ok(unlink($filename), '==', 1, '... removed file'); ok(!-e $filename, '... file is actually gone'); } # these are all the directories # we created (in reverse order) my @directories = reverse( "test", File::Spec->catdir("test", "sub_test"), File::Spec->catdir("test", "sub_test2"), File::Spec->catdir("test", "sub_test2", "sub_sub_test"), File::Spec->catdir("test", "sub_test2", "sub_sub_sub_test") ); # loop through and check them # and remove them (reverse order # insures that they are empty when # we remove them) foreach my $dirname (@directories) { ok(-e $dirname, '... directory exists'); ok(-d $dirname, '... and it is a directory'); # now remove it cmp_ok(rmdir($dirname), '==', 1, '... removed directory'); ok(!-e $dirname, '... directory is actually gone'); } } # test the file and dir handlers { my $visitor = Tree::Simple::Visitor::CreateDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::CreateDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'setFileHandler'); can_ok($visitor, 'setDirectoryHandler'); $visitor->setNodeFilter(sub { my ($node) = @_; return "_$node"; }); # capture the directories # in an array, but don't bother # to create anything my @dirs; $visitor->setDirectoryHandler(sub { my ($dir_path) = @_; push @dirs => $dir_path; }); # these are the expected values my @expected_dirs = ( "_test", File::Spec->catdir("_test", "_sub_test"), File::Spec->catdir("_test", "_sub_test2"), File::Spec->catdir("_test", "_sub_test2", "_sub_sub_test"), File::Spec->catdir("_test", "_sub_test2", "_sub_sub_sub_test") ); # capture the files # in an array, but don't bother # to create anything my @files; $visitor->setFileHandler(sub { my ($file_path) = @_; push @files => $file_path; }); # these are the expected values my @expected_files = ( File::Spec->catfile("_test", "_test.pm"), File::Spec->catfile("_test", "_sub_test2", "_sub_test.pm"), File::Spec->catfile("_test", "_sub_test2", "_sub_sub_sub_test", "_sub_sub_sub_test.pm") ); $dir_tree->accept($visitor); is_deeply(\@dirs, \@expected_dirs, '... got the directories we expected'); is_deeply(\@files, \@expected_files, '... got the files we expected'); } # test the errors { my $visitor = Tree::Simple::Visitor::CreateDirectoryTree->new(); isa_ok($visitor, 'Tree::Simple::Visitor::CreateDirectoryTree'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check the handler errors throws_ok { $visitor->setDirectoryHandler(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setDirectoryHandler("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setDirectoryHandler([]); } qr/Insufficient Arguments/, '... got the error we expected'; # check the handler errors throws_ok { $visitor->setFileHandler(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setFileHandler("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setFileHandler([]); } qr/Insufficient Arguments/, '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/96_Tree_Simple_Visitor_VariableDepthClone_test.t0000644000175000017500000002235210327240142026436 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 36; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::VariableDepthClone'); } use Tree::Simple; use Tree::Simple::Visitor::PreOrderTraversal; my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), Tree::Simple->new("1.2.2") ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2"), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::VariableDepthClone", 'new'); { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setCloneDepth'); can_ok($visitor, 'getClone'); $visitor->setCloneDepth(2); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1 1.1 1.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->setCloneDepth(1); $visitor->setNodeFilter(sub { my ($old, $new) = @_; $new->setNodeValue($old->getNodeValue() . "new"); }); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1new 2new 3new 4new) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->setCloneDepth(3); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->setCloneDepth(100); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->setCloneDepth(0); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->setCloneDepth(-1); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->setCloneDepth(-100); $tree->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [], '... our results are as expected'); } # check with trunk { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->includeTrunk(1); $visitor->setCloneDepth(2); $visitor->setNodeFilter(sub { my ($old, $new) = @_; $new->setNodeValue($old->getNodeValue() . "new"); }); $tree->getChild(0)->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1new 1.1new 1.2new 1.2.1new 1.2.2new 1.3new) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->includeTrunk(1); $visitor->setCloneDepth(1); $tree->getChild(0)->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1 1.1 1.2 1.3) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->includeTrunk(1); $visitor->setCloneDepth(0); $tree->getChild(0)->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->includeTrunk(1); $visitor->setCloneDepth(-1); $tree->getChild(0)->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1) ], '... our results are as expected'); } { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); $visitor->includeTrunk(1); $visitor->setCloneDepth(-100); $tree->getChild(0)->getChild(0)->accept($visitor); my $cloned = $visitor->getClone(); my $checker = Tree::Simple::Visitor::PreOrderTraversal->new(); $cloned->accept($checker); is_deeply( [ $checker->getResults() ], [ qw(1.1) ], '... our results are as expected'); } # check some errors # check errors { my $visitor = Tree::Simple::Visitor::VariableDepthClone->new(); isa_ok($visitor, 'Tree::Simple::Visitor::VariableDepthClone'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setCloneDepth(); } qr/Insufficient Arguments/, '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/t/40_Tree_Simple_Visitor_GetAllDescendents_test.t0000644000175000017500000001030410265333657026271 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 22; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::GetAllDescendents'); } use Tree::Simple; my $tree = Tree::Simple->new(Tree::Simple->ROOT) ->addChildren( Tree::Simple->new("1") ->addChildren( Tree::Simple->new("1.1"), Tree::Simple->new("1.2") ->addChildren( Tree::Simple->new("1.2.1"), Tree::Simple->new("1.2.2") ), Tree::Simple->new("1.3") ), Tree::Simple->new("2") ->addChildren( Tree::Simple->new("2.1"), Tree::Simple->new("2.2") ), Tree::Simple->new("3") ->addChildren( Tree::Simple->new("3.1"), Tree::Simple->new("3.2"), Tree::Simple->new("3.3") ), Tree::Simple->new("4") ->addChildren( Tree::Simple->new("4.1") ) ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::GetAllDescendents", 'new'); my $visitor = Tree::Simple::Visitor::GetAllDescendents->new(); isa_ok($visitor, 'Tree::Simple::Visitor::GetAllDescendents'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getAllDescendents'); can_ok($visitor, 'setTraversalMethod'); can_ok($visitor, 'setNodeFilter'); $tree->accept($visitor); is_deeply( [ $visitor->getAllDescendents() ], [ qw/1 1.1 1.2 1.2.1 1.2.2 1.3 2 2.1 2.2 3 3.1 3.2 3.3 4 4.1/ ], '... our descendents match'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { "*" . $_[0]->getNodeValue() }); $tree->accept($visitor); is_deeply( [ $visitor->getAllDescendents() ], [ qw/*1 *1.1 *1.2 *1.2.1 *1.2.2 *1.3 *2 *2.1 *2.2 *3 *3.1 *3.2 *3.3 *4 *4.1/ ], '... our paths descendents again'); use_ok('Tree::Simple::Visitor::BreadthFirstTraversal'); $visitor->setNodeFilter(sub { $_[0]->getNodeValue() }); $visitor->setTraversalMethod(Tree::Simple::Visitor::BreadthFirstTraversal->new()); $tree->accept($visitor); is_deeply( [ $visitor->getAllDescendents() ], [ qw/1 2 3 4 1.1 1.2 1.3 2.1 2.2 3.1 3.2 3.3 4.1 1.2.1 1.2.2/ ], '... our bredth-first descendents match'); # test some error conditions throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->setTraversalMethod(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->setTraversalMethod("Fail"); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->setTraversalMethod([]); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $visitor->setTraversalMethod(bless({}, "Fail")); } qr/Insufficient Arguments/, '... this should die'; Tree-Simple-VisitorFactory-0.15/t/90_Tree_Simple_Visitor_FromNestedHash_test.t0000644000175000017500000001452710265333657025633 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 57; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::FromNestedHash'); } use Tree::Simple; my $hash_tree = { Root => { Child1 => { GrandChild1 => {}, GrandChild2 => {} }, Child2 => {} } }; can_ok("Tree::Simple::Visitor::FromNestedHash", 'new'); { my $visitor = Tree::Simple::Visitor::FromNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setHashTree'); $visitor->setHashTree($hash_tree); can_ok($visitor, 'visit'); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); my $root = $tree->getChild(0); is($root->getNodeValue(), 'Root', '... got the node value we expected from Root'); cmp_ok($root->getChildCount(), '==', 2, '... Root has 2 children'); my ($child1, $child2) = $root->getAllChildren(); is($child1->getNodeValue(), 'Child1', '... got the node value we expected from Child1'); cmp_ok($child1->getChildCount(), '==', 2, '... Child1 has 2 children'); my ($grandchild1, $grandchild2) = $child1->getAllChildren(); is($grandchild1->getNodeValue(), 'GrandChild1', '... got the node value we expected from GrandChild1'); ok($grandchild1->isLeaf(), '... GrandChild1 is a leaf node'); is($grandchild2->getNodeValue(), 'GrandChild2', '... got the node value we expected from GrandChild2'); ok($grandchild2->isLeaf(), '... GrandChild2 is a leaf node'); is($child2->getNodeValue(), 'Child2', '... got the node value we expected from Child2'); ok($child2->isLeaf(), '... Child2 is a leaf node'); } { my $visitor = Tree::Simple::Visitor::FromNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setHashTree'); $visitor->setHashTree($hash_tree); can_ok($visitor, 'visit'); can_ok($visitor, 'includeTrunk'); $visitor->includeTrunk(1); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); my $root = $tree; is($root->getNodeValue(), 'Root', '... got the node value we expected from Root'); cmp_ok($root->getChildCount(), '==', 2, '... Root has 2 children'); my ($child1, $child2) = $root->getAllChildren(); is($child1->getNodeValue(), 'Child1', '... got the node value we expected from Child1'); cmp_ok($child1->getChildCount(), '==', 2, '... Child1 has 2 children'); my ($grandchild1, $grandchild2) = $child1->getAllChildren(); is($grandchild1->getNodeValue(), 'GrandChild1', '... got the node value we expected from GrandChild1'); ok($grandchild1->isLeaf(), '... GrandChild1 is a leaf node'); is($grandchild2->getNodeValue(), 'GrandChild2', '... got the node value we expected from GrandChild2'); ok($grandchild2->isLeaf(), '... GrandChild2 is a leaf node'); is($child2->getNodeValue(), 'Child2', '... got the node value we expected from Child2'); ok($child2->isLeaf(), '... Child2 is a leaf node'); } { my $visitor = Tree::Simple::Visitor::FromNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'setHashTree'); $visitor->setHashTree($hash_tree); can_ok($visitor, 'visit'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { my $node = shift; return uc($node); }); my $tree = Tree::Simple->new(Tree::Simple->ROOT); $tree->accept($visitor); my $root = $tree->getChild(0); is($root->getNodeValue(), 'ROOT', '... got the node value we expected from Root'); cmp_ok($root->getChildCount(), '==', 2, '... Root has 2 children'); my ($child1, $child2) = $root->getAllChildren(); is($child1->getNodeValue(), 'CHILD1', '... got the node value we expected from Child1'); cmp_ok($child1->getChildCount(), '==', 2, '... Child1 has 2 children'); my ($grandchild1, $grandchild2) = $child1->getAllChildren(); is($grandchild1->getNodeValue(), 'GRANDCHILD1', '... got the node value we expected from GrandChild1'); ok($grandchild1->isLeaf(), '... GrandChild1 is a leaf node'); is($grandchild2->getNodeValue(), 'GRANDCHILD2', '... got the node value we expected from GrandChild2'); ok($grandchild2->isLeaf(), '... GrandChild2 is a leaf node'); is($child2->getNodeValue(), 'CHILD2', '... got the node value we expected from Child2'); ok($child2->isLeaf(), '... Child2 is a leaf node'); } { my $visitor = Tree::Simple::Visitor::FromNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::FromNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; # check setHashTree throws_ok { $visitor->setHashTree(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setHashTree("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setHashTree([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setHashTree({}); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->setHashTree({ one => 1, two => 2 }); } qr/Insufficient Arguments/, '... got the error we expected'; }Tree-Simple-VisitorFactory-0.15/t/10_Tree_Simple_VisitorFactory_test.t0000644000175000017500000000161010265333657024206 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 9; use Test::Exception; BEGIN { use_ok('Tree::Simple::VisitorFactory'); } can_ok("Tree::Simple::VisitorFactory", 'new'); my $vf = Tree::Simple::VisitorFactory->new(); isa_ok($vf, 'Tree::Simple::VisitorFactory'); # test instance method { can_ok($vf, 'get'); my $visitor = $vf->get("PathToRoot"); isa_ok($visitor, 'Tree::Simple::Visitor::PathToRoot'); } # test class method { can_ok("Tree::Simple::VisitorFactory", 'getVisitor'); my $visitor = Tree::Simple::VisitorFactory->getVisitor("FindByPath"); isa_ok($visitor, 'Tree::Simple::Visitor::FindByPath'); } # test a few error conditions throws_ok { Tree::Simple::VisitorFactory->get(); } qr/Insufficient Arguments/, '... this should die'; throws_ok { $vf->getVisitor("ThisVisitorDoesNotExist"); } qr/Illegal Operation/, '... this should die';Tree-Simple-VisitorFactory-0.15/t/92_Tree_Simple_Visitor_ToNestedHash_test.t0000644000175000017500000000713710265333657025313 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More tests => 33; use Test::Exception; BEGIN { use_ok('Tree::Simple::Visitor::ToNestedHash'); } use Tree::Simple; my $tree = Tree::Simple->new("Root") ->addChildren( Tree::Simple->new("Child1") ->addChildren( Tree::Simple->new("GrandChild1"), Tree::Simple->new("GrandChild2") ), Tree::Simple->new("Child2"), ); isa_ok($tree, 'Tree::Simple'); can_ok("Tree::Simple::Visitor::ToNestedHash", 'new'); { my $visitor = Tree::Simple::Visitor::ToNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $tree->accept($visitor); is_deeply($visitor->getResults(), { 'Child1' => { 'GrandChild1' => {}, 'GrandChild2' => {}}, 'Child2' => {}}, '... got the whole tree'); } { my $visitor = Tree::Simple::Visitor::ToNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'includeTrunk'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); $visitor->includeTrunk(1); $tree->accept($visitor); is_deeply($visitor->getResults(), { 'Root' => { 'Child1' => { 'GrandChild1' => {}, 'GrandChild2' => {}}, 'Child2' => {}}}, '... got the whole tree'); } { my $visitor = Tree::Simple::Visitor::ToNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { return uc($_[0]->getNodeValue()); }); $tree->accept($visitor); is_deeply($visitor->getResults(), { 'CHILD1' => { 'GRANDCHILD1' => {}, 'GRANDCHILD2' => {}}, 'CHILD2' => {}}, '... got the whole tree'); } { my $visitor = Tree::Simple::Visitor::ToNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); can_ok($visitor, 'includeTrunk'); can_ok($visitor, 'visit'); can_ok($visitor, 'getResults'); can_ok($visitor, 'setNodeFilter'); $visitor->setNodeFilter(sub { return uc($_[0]->getNodeValue()); }); $visitor->includeTrunk(1); $tree->accept($visitor); is_deeply($visitor->getResults(), { 'ROOT' => { 'CHILD1' => { 'GRANDCHILD1' => {}, 'GRANDCHILD2' => {}}, 'CHILD2' => {}}}, '... got the whole tree'); } { my $visitor = Tree::Simple::Visitor::ToNestedHash->new(); isa_ok($visitor, 'Tree::Simple::Visitor::ToNestedHash'); isa_ok($visitor, 'Tree::Simple::Visitor'); # check visit throws_ok { $visitor->visit(); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit("Fail"); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit([]); } qr/Insufficient Arguments/, '... got the error we expected'; throws_ok { $visitor->visit(bless({}, "Fail")); } qr/Insufficient Arguments/, '... got the error we expected'; } Tree-Simple-VisitorFactory-0.15/xt/0000755000175000017500000000000012712221611015356 5ustar ronronTree-Simple-VisitorFactory-0.15/xt/author/0000755000175000017500000000000012712221611016660 5ustar ronronTree-Simple-VisitorFactory-0.15/xt/author/pod_coverage.t0000644000175000017500000000031610265333657021521 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok();Tree-Simple-VisitorFactory-0.15/xt/author/pod.t0000644000175000017500000000025712471746330017647 0ustar ronron#!/usr/bin/perl use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Tree-Simple-VisitorFactory-0.15/Changes0000644000175000017500000000760112712221464016230 0ustar ronronRevision history for Perl extension Tree::Simple::VisitorFactory: 0.15 2016-05-04T08;15:00 - Correct physical address of Free Software Foundation in LICENSE file. See RT#114149. Thanx to Petr Pisar. 0.14 2016-04-27T17:35:00 - No code changes. - Adopt workflow techniques suggested by Kent Fredric. This means a cleaner workdir and a much more reliable dist. The latter now has auto-generated MANIFEST and META.* files. 0.13 2016-04-25T09:26:00 - No code changes. - Delete Build.PL. - Fix my licence (sic) mess so all references are to Perl. This involves edits to Makefile.PL and LICENSE. See RT#113949. Thanx Kent Fredric. - Fix Makefile.PL so modules only used for testing are in TEST_REQUIRES and not PREREQ_PM. See RT#113948. Thanx Kent Fredric. - Fix README so it more-or-less conforms to the Perl Foundation's guidelines at http://www.perlfoundation.org/cpan_licensing_guidelines. 0.12 2013-11-01T09:23:00 - Update pre-reqs. - Many, many doc typo fixes via github from dsteinbrunner. - Add repos to Build.PL and Makefile.PL. 0.11 2013-09-23T11:07:00 - Maintenance now by Ron Savage. - Rectify datestamp format in this file. - Add Changelog.ini. - Add Build.PL. - Clean up Makefile.PL. - RT#40504: Add META.*. 0.10 2005-11-25T12:00:00 - removing OS X resource fork files which are causeing the pod test to fail 0.09 2005-11-07T12:00:00 - fixing an error in the Tree::Simple::Visitor::LoadDirectoryTree test 0.08 2005-07-18T12:00:00 - small bug fix in Tree::Simple::Visitor::VariableDepthClone visitor - small bug fix with Tree::Simple::Visitor::FindByPath visitor 0.07 2005-07-18T12:00:00 - forgot to implement the node filter in the Tree::Simple::Visitor::VariableDepthClone visitor - added this code and tested it 0.06 2005-07-13T12:00:00 - added Tree::Simple::Visitor::VariableDepthClone - added tests and docs for this - bumped up the Tree::Simple version requirement to support this new Visitor 0.05 2004-11-18T12:00:00 - now using Scalar::Util::blessed() instead of the convoluted UNIVERSAL::isa() stuff. - added Scalar::Util as a dependency 0.04 2004-10-27T12:00:00 - fixed broken test (70_Tree_Simple_Visitor_LoadDirectoryTree_test.t) it made assumptions about directory ordering across OSes which was not correct. - added Tree::Simple::Visitor::FindByNodeValue - added tests for this - added docs for this 0.03 2004-10-12T12:00:00 - fixed documentation in Tree::Simple::Visitor::Sort - added Tree::Simple::Visitor::LoadClassHierarchy - added tests for this - added docs for this - changed behavior in Tree::Simple::FromNestedHash so that it sorts the hash keys before they are put into the tree 0.02 2004-09-29T12:00:00 - changed all Visitors to use 'base' for inheritance, it just cuts down on the line noise. - improved the documentation in Tree::Simple::VisitorFactory to include a categorized list of available visitors - added Tree::Simple::Visitor::LoadDirectoryTree Visitor - added tests for this - added Tree::Simple::Visitor::CreateDirectoryTree Visitor - added tests for this - added Tree::Simple::Visitor::FindByUID Visitor - added tests for this - thanks to Vitor Mori for the idea for this Visitor - added Tree::Simple::Visitor::PreOrderTraversal Visitor - added tests for this - added Tree::Simple::Visitor::Sort Visitor - added tests for this - thanks to Vitor Mori for most of the code and the idea for this Visitor - added Tree::Simple::FromNestedArray, Tree::Simple::FromNestedHash and their compliments Tree::Simple::ToNestedArray and Tree::Simple::ToNestedHash - added tests for these - added the pod.t and pod_coverage.t tests 0.01 2004-06-23T09:24:07 - module createdTree-Simple-VisitorFactory-0.15/META.yml0000644000175000017500000000156612712221611016204 0ustar ronron--- abstract: 'A factory object for dispensing Visitor objects' author: - 'Stevan Little ' build_requires: ExtUtils::MakeMaker: '0' Test::Exception: '0.15' Test::More: '1.001014' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.14, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Tree-Simple-VisitorFactory no_index: directory: - t - inc requires: File::Spec: '0.6' Scalar::Util: '1.1' Tree::Simple: '1.12' Tree::Simple::Visitor: '1.22' base: '0' strict: '0' warnings: '0' resources: license: http://dev.perl.org/licenses/ repository: https://github.com/ronsavage/Tree-Simple-VisitorFactory.git version: '0.15' x_serialization_backend: 'CPAN::Meta::YAML version 0.012' Tree-Simple-VisitorFactory-0.15/MANIFEST0000644000175000017500000000356312712221611016063 0ustar ronronChangelog.ini Changes lib/Tree/Simple/Visitor/BreadthFirstTraversal.pm lib/Tree/Simple/Visitor/CreateDirectoryTree.pm lib/Tree/Simple/Visitor/FindByNodeValue.pm lib/Tree/Simple/Visitor/FindByPath.pm lib/Tree/Simple/Visitor/FindByUID.pm lib/Tree/Simple/Visitor/FromNestedArray.pm lib/Tree/Simple/Visitor/FromNestedHash.pm lib/Tree/Simple/Visitor/GetAllDescendents.pm lib/Tree/Simple/Visitor/LoadClassHierarchy.pm lib/Tree/Simple/Visitor/LoadDirectoryTree.pm lib/Tree/Simple/Visitor/PathToRoot.pm lib/Tree/Simple/Visitor/PostOrderTraversal.pm lib/Tree/Simple/Visitor/PreOrderTraversal.pm lib/Tree/Simple/Visitor/Sort.pm lib/Tree/Simple/Visitor/ToNestedArray.pm lib/Tree/Simple/Visitor/ToNestedHash.pm lib/Tree/Simple/Visitor/VariableDepthClone.pm lib/Tree/Simple/VisitorFactory.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP README t/10_Tree_Simple_VisitorFactory_test.t t/20_Tree_Simple_Visitor_PathToRoot_test.t t/30_Tree_Simple_Visitor_FindByPath_test.t t/32_Tree_Simple_Visitor_FindByNodeValue_test.t t/35_Tree_Simple_Visitor_FindByUID_test.t t/40_Tree_Simple_Visitor_GetAllDescendents_test.t t/50_Tree_Simple_Visitor_BreadthFirstTraversal_test.t t/60_Tree_Simple_Visitor_PostOrderTraversal_test.t t/65_Tree_Simple_Visitor_PreOrederTraversal_test.t t/70_Tree_Simple_Visitor_LoadDirectoryTree_test.t t/75_Tree_Simple_Visitor_CreateDirectoryTree_test.t t/80_Tree_Simple_Visitor_Sort_test.t t/90_Tree_Simple_Visitor_FromNestedHash_test.t t/91_Tree_Simple_Visitor_FromNestedArray_test.t t/92_Tree_Simple_Visitor_ToNestedHash_test.t t/93_Tree_Simple_Visitor_ToNestedArray_test.t t/95_Tree_Simple_Visitor_LoadClassHierarchy_test.t t/96_Tree_Simple_Visitor_VariableDepthClone_test.t xt/author/pod.t xt/author/pod_coverage.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Tree-Simple-VisitorFactory-0.15/LICENSE0000644000175000017500000004740712712215064015751 0ustar ronronTerms of Perl itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" ---------------------------------------------------------------------------- The General Public License (GPL) Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS ---------------------------------------------------------------------------- The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End