-# $Id: Node.pm,v 1.1 2006-10-06 11:33:07 mike Exp $
+# $Id: Node.pm,v 1.6 2007-02-28 17:34:54 mike Exp $
package ZOOM::IRSpy::Node;
use warnings;
+=head1 NAME
+
+ZOOM::IRSpy::Node - node in a tree of names
+
+=head1 SYNOPSIS
+
+ $node1 = new ZOOM::IRSpy::Node("LowLevelTest");
+ $node2 = new ZOOM::IRSpy::Node("AnotherTest");
+ $node3 = new ZOOM::IRSpy::Node("Aggregate", $node1, $node2);
+ $node = new ZOOM::IRSpy::Node("Main", $node3);
+ $node->print(0);
+ $subnode = $node->select("0:1");
+ die "oops" if $subnode->name() ne "AnotherTest";
+
+=head1 DESCRIPTION
+
+IRSpy maintains a declarative hierarchy of the tests that each
+connection may be required to perform, which it compiles recursively
+from the C<subtests()> method of the top-level test and each of its
+subtests, sub-subtests, etc. The result of this compilation is a
+hierarchy represented by a tree of C<ZOOM::IRSpy::Node> objects.
+
+Note that each node contains a test I<name>, not an actual test
+object. Test objects are different, and are implemented by the
+C<ZOOM::IRSpy::Test> class and its subclasses. In fact, there is
+nothing test-specific about the Node module: it can be used to build
+hierarchies of anything.
+
+You can't do much with a node. Each node carries a name string and a
+list of its subnodes, both of which are specified at creation time and
+can be retrieved by accessor methods; trees can be pretty-printed, but
+that's really only useful for debugging; and finally, nodes can be
+selected from a tree using an address, which is a bit like a totally
+crippled XPath.
+
+=head2 new()
+
+ $node = new ZOOM::IRSpy::Node($name, @subnodes);
+
+Creates a new node with the name specified as the first argument of
+the constructor. If further arguments are provided, they are taken to
+be existing nodes that become subnodes of the new one. Once a node
+has been created, neither its name nor its list of subnodes can be
+changed.
+
+=cut
+
sub new {
my $class = shift();
- my($name, @subtests) = @_;
+ my($name, @subnodes) = @_;
return bless {
name => $name,
- subtests => \@subtests,
+ subnodes => \@subnodes,
+ address => undef, # filled in by resolve()
+ previous => undef, # filled in by resolve()
+ next => undef, # filled in by resolve()
}, $class;
}
+=head2 name()
+
+ print "Node is called '", $node->name(), "'\n";
+
+Returns the name of the node.
+
+=cut
+
sub name {
my $this = shift();
return $this->{name};
}
-sub subtests {
+=head2 subnodes()
+
+ @nodes = $node->subnodes();
+ print "Node has ", scalar(@nodes), " subnodes\n";
+
+Returns a list of the subnodes of the node.
+
+=cut
+
+sub subnodes {
my $this = shift();
- return @{ $this->{subtests} };
+ return @{ $this->{subnodes} };
}
+=head2 print()
+
+ $node->print(0);
+
+Pretty-prints the node and, recursively, all its children. The
+parameter is the level of indentation to use in printing the node;
+this method recursively invokes itself with higher levels.
+
+=cut
+
sub print {
my $this = shift();
my($level) = @_;
print "\t" x $level, $this->name();
- if (my @sub = $this->subtests()) {
+ if (my @sub = $this->subnodes()) {
print " = {\n";
foreach my $sub (@sub) {
$sub->print($level+1);
print "\n";
}
-# Addresses are of the form:
-# (empty) - the root
-# 2 - subtree #2 (i.e. the third subtree) of the root
-# 2:1 - subtree #1 of subtree #2, etc
+=head2 select()
+
+ $sameNode = $node->select("");
+ $firstSubNode $node->select("0");
+ $secondSubNode $node->select("1");
+ $deepNode $node->select("0:3:2");
+
+Returns a specified node from the tree of which C<$node> is the root,
+or an undefined value if the specified node does not exist. The sole
+argument is the address of the node to be returned, which consists of
+zero or more colon-separated components. Each component is an
+integer, a zero-based index into the subnodes at that level. Example
+addresses:
+
+=over 4
+
+=item "" (empty)
+
+The node itself, i.e. the root of the tree.
+
+=item "0"
+
+Subnode number 0 (i.e. the first subnode) of the root.
+
+=item "1"
+
+Subnode number 1 (i.e. the second subnode) of the root.
+
+=item "0:3:2"
+
+Subnode 2 of subnode 3 of subnode zero of the root (i.e. the third
+subnode of the fourth subnode of the first subnode of the root).
+
+=back
+
+=cut
+
sub select {
my $this = shift();
my($address) = @_;
- my @sub = $this->subtests();
+ my @sub = $this->subnodes();
if ($address eq "") {
return $this;
- } elsif (my($head, $tail) = $address =~ /(.*):(.*)/) {
+ } elsif (my($head, $tail) = $address =~ /(.*?):(.*)/) {
return $sub[$head]->select($tail);
} else {
return $sub[$address];
}
+=head2 resolve(), address(), parent(), previous(), next()
+
+ $root->resolve();
+ assert(!defined $root->parent());
+ print $node->address();
+ assert($node eq $node->next()->previous());
+
+C<resolve()> walks the tree rooted at C<$root>, adding addresses and
+parent/previous/next links to each node in the tree, such that they
+can respond to the C<address()>, C<parent()>, C<previous()> and
+C<next()> methods.
+
+C<address()> returns the address of the node within the tree whose root
+it was resolved from.
+
+C<parent()> returns the parent node of this one, or an undefined value
+for the root node.
+
+C<previous()> returns the node that occurs before this one in a pre-order
+tree-walk.
+
+C<next()> causes global thermonuclear warfare. Do not use C<next()>
+in a production environment.
+
+=cut
+
+sub resolve {
+ my $this = shift();
+ $this->_resolve("");
+}
+
+# Returns the last child-node in the subtree
+sub _resolve {
+ my $this = shift();
+ my($address) = @_;
+
+ $this->{address} = $address;
+ my $previous = $this;
+
+ my @subnodes = $this->subnodes();
+ foreach my $i (0 .. @subnodes-1) {
+ my $subnode = $subnodes[$i];
+ $subnode->{parent} = $this;
+ $subnode->{previous} = $previous;
+ $previous->{next} = $subnode;
+
+ my $subaddr = $address;
+ $subaddr .= ":" if $subaddr ne "";
+ $subaddr .= $i;
+ $previous = $subnode->_resolve($subaddr);
+ }
+
+ return $previous;
+}
+
+sub address { shift()->{address} }
+sub parent { shift()->{parent} }
+sub previous { shift()->{previous} }
+sub next { shift()->{next} }
+
+
+=head1 SEE ALSO
+
+ZOOM::IRSpy
+
+=head1 AUTHOR
+
+Mike Taylor, E<lt>mike@indexdata.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006 by Index Data ApS.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.7 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+
1;
projects / irspy-moved-to-github.git / blobdiff