# $Id: Node.pm,v 1.6 2007-02-28 17:34:54 mike Exp $ package ZOOM::IRSpy::Node; use 5.008; 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, @subnodes) = @_; return bless { name => $name, 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}; } =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->{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->subnodes()) { print " = {\n"; foreach my $sub (@sub) { $sub->print($level+1); } print "\t" x $level, "}"; } print "\n"; } =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->subnodes(); if ($address eq "") { return $this; } 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 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;