X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=lib%2FZOOM%2FIRSpy%2FNode.pm;h=f912b94217a843c7d62477c3f1d25db8b9fd71c3;hp=20559a29f3a251317f7d8292d166c78f0de7e726;hb=3ea30e178e31c74782e5cf6751791615c7e65125;hpb=a8be7db5305925fc720f3dac7e6afc8fba7b9e60 diff --git a/lib/ZOOM/IRSpy/Node.pm b/lib/ZOOM/IRSpy/Node.pm index 20559a2..f912b94 100644 --- a/lib/ZOOM/IRSpy/Node.pm +++ b/lib/ZOOM/IRSpy/Node.pm @@ -1,4 +1,4 @@ -# $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; @@ -7,31 +7,108 @@ use strict; 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 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 objects. + +Note that each node contains a test I, not an actual test +object. Test objects are different, and are implemented by the +C 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); @@ -41,18 +118,51 @@ sub print { 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]; @@ -60,4 +170,83 @@ sub select { } +=head2 resolve(), address(), parent(), previous(), next() + + $root->resolve(); + assert(!defined $root->parent()); + print $node->address(); + assert($node eq $node->next()->previous()); + +C 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, C, C and +C methods. + +C returns the address of the node within the tree whose root +it was resolved from. + +C returns the parent node of this one, or an undefined value +for the root node. + +C returns the node that occurs before this one in a pre-order +tree-walk. + +C causes global thermonuclear warfare. Do not use C +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, Emike@indexdata.comE + +=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;