lib/ZOOM/IRSpy/Node.pm

   1 # $Id: Node.pm,v 1.6 2007-02-28 17:34:54 mike Exp $
   2
   3 package ZOOM::IRSpy::Node;
   4
   5 use 5.008;
   6 use strict;
   7 use warnings;
   8
   9
  10 =head1 NAME
  11
  12 ZOOM::IRSpy::Node - node in a tree of names
  13
  14 =head1 SYNOPSIS
  15
  16  $node1 = new ZOOM::IRSpy::Node("LowLevelTest");
  17  $node2 = new ZOOM::IRSpy::Node("AnotherTest");
  18  $node3 = new ZOOM::IRSpy::Node("Aggregate", $node1, $node2);
  19  $node = new ZOOM::IRSpy::Node("Main", $node3);
  20  $node->print(0);
  21  $subnode = $node->select("0:1");
  22  die "oops" if $subnode->name() ne "AnotherTest";
  23
  24 =head1 DESCRIPTION
  25
  26 IRSpy maintains a declarative hierarchy of the tests that each
  27 connection may be required to perform, which it compiles recursively
  28 from the C<subtests()> method of the top-level test and each of its
  29 subtests, sub-subtests, etc.  The result of this compilation is a
  30 hierarchy represented by a tree of C<ZOOM::IRSpy::Node> objects.
  31
  32 Note that each node contains a test I<name>, not an actual test
  33 object.  Test objects are different, and are implemented by the
  34 C<ZOOM::IRSpy::Test> class and its subclasses.  In fact, there is
  35 nothing test-specific about the Node module: it can be used to build
  36 hierarchies of anything.
  37
  38 You can't do much with a node.  Each node carries a name string and a
  39 list of its subnodes, both of which are specified at creation time and
  40 can be retrieved by accessor methods; trees can be pretty-printed, but
  41 that's really only useful for debugging; and finally, nodes can be
  42 selected from a tree using an address, which is a bit like a totally
  43 crippled XPath.
  44
  45 =head2 new()
  46
  47  $node = new ZOOM::IRSpy::Node($name, @subnodes);
  48
  49 Creates a new node with the name specified as the first argument of
  50 the constructor.  If further arguments are provided, they are taken to
  51 be existing nodes that become subnodes of the new one.  Once a node
  52 has been created, neither its name nor its list of subnodes can be
  53 changed.
  54
  55 =cut
  56
  57 sub new {
  58     my $class = shift();
  59     my($name, @subnodes) = @_;
  60     return bless {
  61         name => $name,
  62         subnodes => \@subnodes,
  63         address => undef,       # filled in by resolve()
  64         previous => undef,      # filled in by resolve()
  65         next => undef,          # filled in by resolve()
  66     }, $class;
  67 }
  68
  69 =head2 name()
  70
  71  print "Node is called '", $node->name(), "'\n";
  72
  73 Returns the name of the node.
  74
  75 =cut
  76
  77 sub name {
  78     my $this = shift();
  79     return $this->{name};
  80 }
  81
  82 =head2 subnodes()
  83
  84  @nodes = $node->subnodes();
  85  print "Node has ", scalar(@nodes), " subnodes\n";
  86
  87 Returns a list of the subnodes of the node.
  88
  89 =cut
  90
  91 sub subnodes {
  92     my $this = shift();
  93     return @{ $this->{subnodes} };
  94 }
  95
  96 =head2 print()
  97
  98  $node->print(0);
  99
 100 Pretty-prints the node and, recursively, all its children.  The
 101 parameter is the level of indentation to use in printing the node;
 102 this method recursively invokes itself with higher levels.
 103
 104 =cut
 105
 106 sub print {
 107     my $this = shift();
 108     my($level) = @_;
 109
 110     print "\t" x $level, $this->name();
 111     if (my @sub = $this->subnodes()) {
 112         print " = {\n";
 113         foreach my $sub (@sub) {
 114             $sub->print($level+1);
 115         }
 116         print "\t" x $level, "}";
 117     }
 118     print "\n";
 119 }
 120
 121 =head2 select()
 122
 123  $sameNode = $node->select("");
 124  $firstSubNode $node->select("0");
 125  $secondSubNode $node->select("1");
 126  $deepNode $node->select("0:3:2");
 127
 128 Returns a specified node from the tree of which C<$node> is the root,
 129 or an undefined value if the specified node does not exist.  The sole
 130 argument is the address of the node to be returned, which consists of
 131 zero or more colon-separated components.  Each component is an
 132 integer, a zero-based index into the subnodes at that level.  Example
 133 addresses:
 134
 135 =over 4
 136
 137 =item "" (empty)
 138
 139 The node itself, i.e. the root of the tree.
 140
 141 =item "0"
 142
 143 Subnode number 0 (i.e. the first subnode) of the root.
 144
 145 =item "1"
 146
 147 Subnode number 1 (i.e. the second subnode) of the root.
 148
 149 =item "0:3:2"
 150
 151 Subnode 2 of subnode 3 of subnode zero of the root (i.e. the third
 152 subnode of the fourth subnode of the first subnode of the root).
 153
 154 =back
 155
 156 =cut
 157
 158 sub select {
 159     my $this = shift();
 160     my($address) = @_;
 161
 162     my @sub = $this->subnodes();
 163     if ($address eq "") {
 164         return $this;
 165     } elsif (my($head, $tail) = $address =~ /(.*?):(.*)/) {
 166         return $sub[$head]->select($tail);
 167     } else {
 168         return $sub[$address];
 169     }
 170 }
 171
 172
 173 =head2 resolve(), address(), parent(), previous(), next()
 174
 175  $root->resolve();
 176  assert(!defined $root->parent());
 177  print $node->address();
 178  assert($node eq $node->next()->previous());
 179
 180 C<resolve()> walks the tree rooted at C<$root>, adding addresses and
 181 parent/previous/next links to each node in the tree, such that they
 182 can respond to the C<address()>, C<parent()>, C<previous()> and
 183 C<next()> methods.
 184
 185 C<address()> returns the address of the node within the tree whose root
 186 it was resolved from.
 187
 188 C<parent()> returns the parent node of this one, or an undefined value
 189 for the root node.
 190
 191 C<previous()> returns the node that occurs before this one in a pre-order
 192 tree-walk.
 193
 194 C<next()> causes global thermonuclear warfare.  Do not use C<next()>
 195 in a production environment.
 196
 197 =cut
 198
 199 sub resolve {
 200     my $this = shift();
 201     $this->_resolve("");
 202 }
 203
 204 # Returns the last child-node in the subtree
 205 sub _resolve {
 206     my $this = shift();
 207     my($address) = @_;
 208
 209     $this->{address} = $address;
 210     my $previous = $this;
 211
 212     my @subnodes = $this->subnodes();
 213     foreach my $i (0 .. @subnodes-1) {
 214         my $subnode = $subnodes[$i];
 215         $subnode->{parent} = $this;
 216         $subnode->{previous} = $previous;
 217         $previous->{next} = $subnode;
 218
 219         my $subaddr = $address;
 220         $subaddr .= ":" if $subaddr ne "";
 221         $subaddr .= $i;
 222         $previous = $subnode->_resolve($subaddr);
 223     }
 224
 225     return $previous;
 226 }
 227
 228 sub address { shift()->{address} }
 229 sub parent { shift()->{parent} }
 230 sub previous { shift()->{previous} }
 231 sub next { shift()->{next} }
 232
 233
 234 =head1 SEE ALSO
 235
 236 ZOOM::IRSpy
 237
 238 =head1 AUTHOR
 239
 240 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 241
 242 =head1 COPYRIGHT AND LICENSE
 243
 244 Copyright (C) 2006 by Index Data ApS.
 245
 246 This library is free software; you can redistribute it and/or modify
 247 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 248 at your option, any later version of Perl 5 you may have available.
 249
 250 =cut
 251
 252 1;