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