lib/ZOOM/IRSpy/Node.pm

   1
   2 package ZOOM::IRSpy::Node;
   3
   4 use 5.008;
   5 use strict;
   6 use warnings;
   7
   8 use Scalar::Util;
   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     my $this = 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     return $this;
  69 }
  70
  71 =head2 name()
  72
  73  print "Node is called '", $node->name(), "'\n";
  74
  75 Returns the name of the node.
  76
  77 =cut
  78
  79 sub name {
  80     my $this = shift();
  81     return $this->{name};
  82 }
  83
  84 =head2 subnodes()
  85
  86  @nodes = $node->subnodes();
  87  print "Node has ", scalar(@nodes), " subnodes\n";
  88
  89 Returns a list of the subnodes of the node.
  90
  91 =cut
  92
  93 sub subnodes {
  94     my $this = shift();
  95     return @{ $this->{subnodes} };
  96 }
  97
  98 =head2 print()
  99
 100  $node->print(0);
 101
 102 Pretty-prints the node and, recursively, all its children.  The
 103 parameter is the level of indentation to use in printing the node;
 104 this method recursively invokes itself with higher levels.
 105
 106 =cut
 107
 108 sub print {
 109     my $this = shift();
 110     my($level) = @_;
 111
 112     print "\t" x $level, $this->name();
 113     if (my @sub = $this->subnodes()) {
 114         print " = {\n";
 115         foreach my $sub (@sub) {
 116             $sub->print($level+1);
 117         }
 118         print "\t" x $level, "}";
 119     }
 120     print "\n";
 121 }
 122
 123 =head2 select()
 124
 125  $sameNode = $node->select("");
 126  $firstSubNode $node->select("0");
 127  $secondSubNode $node->select("1");
 128  $deepNode $node->select("0:3:2");
 129
 130 Returns a specified node from the tree of which C<$node> is the root,
 131 or an undefined value if the specified node does not exist.  The sole
 132 argument is the address of the node to be returned, which consists of
 133 zero or more colon-separated components.  Each component is an
 134 integer, a zero-based index into the subnodes at that level.  Example
 135 addresses:
 136
 137 =over 4
 138
 139 =item "" (empty)
 140
 141 The node itself, i.e. the root of the tree.
 142
 143 =item "0"
 144
 145 Subnode number 0 (i.e. the first subnode) of the root.
 146
 147 =item "1"
 148
 149 Subnode number 1 (i.e. the second subnode) of the root.
 150
 151 =item "0:3:2"
 152
 153 Subnode 2 of subnode 3 of subnode zero of the root (i.e. the third
 154 subnode of the fourth subnode of the first subnode of the root).
 155
 156 =back
 157
 158 =cut
 159
 160 sub select {
 161     my $this = shift();
 162     my($address) = @_;
 163
 164     my @sub = $this->subnodes();
 165     if ($address eq "") {
 166         return $this;
 167     } elsif (my($head, $tail) = $address =~ /(.*?):(.*)/) {
 168         return $sub[$head]->select($tail);
 169     } else {
 170         return $sub[$address];
 171     }
 172 }
 173
 174
 175 =head2 resolve(), address(), parent(), previous(), next()
 176
 177  $root->resolve();
 178  assert(!defined $root->parent());
 179  print $node->address();
 180  assert($node eq $node->next()->previous());
 181
 182 C<resolve()> walks the tree rooted at C<$root>, adding addresses and
 183 parent/previous/next links to each node in the tree, such that they
 184 can respond to the C<address()>, C<parent()>, C<previous()> and
 185 C<next()> methods.
 186
 187 C<address()> returns the address of the node within the tree whose root
 188 it was resolved from.
 189
 190 C<parent()> returns the parent node of this one, or an undefined value
 191 for the root node.
 192
 193 C<previous()> returns the node that occurs before this one in a pre-order
 194 tree-walk.
 195
 196 C<next()> causes global thermonuclear warfare.  Do not use C<next()>
 197 in a production environment.
 198
 199 =cut
 200
 201 sub resolve {
 202     my $this = shift();
 203     $this->_resolve("");
 204 }
 205
 206 # Returns the last child-node in the subtree
 207 sub _resolve {
 208     my $this = shift();
 209     my($address) = @_;
 210
 211     $this->{address} = $address;
 212     my $previous = $this;
 213
 214     my @subnodes = $this->subnodes();
 215     foreach my $i (0 .. @subnodes-1) {
 216         my $subnode = $subnodes[$i];
 217         $subnode->{parent} = $this;
 218         $subnode->{previous} = $previous;
 219         $previous->{next} = $subnode;
 220
 221         my $subaddr = $address;
 222         $subaddr .= ":" if $subaddr ne "";
 223         $subaddr .= $i;
 224         $previous = $subnode->_resolve($subaddr);
 225     }
 226
 227     return $previous;
 228 }
 229
 230 sub address { shift()->{address} }
 231 sub parent { shift()->{parent} }
 232 sub previous { shift()->{previous} }
 233 sub next { shift()->{next} }
 234
 235
 236 =head1 SEE ALSO
 237
 238 ZOOM::IRSpy
 239
 240 =head1 AUTHOR
 241
 242 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 243
 244 =head1 COPYRIGHT AND LICENSE
 245
 246 Copyright (C) 2006 by Index Data ApS.
 247
 248 This library is free software; you can redistribute it and/or modify
 249 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 250 at your option, any later version of Perl 5 you may have available.
 251
 252 =cut
 253
 254 1;