lib/ZOOM/IRSpy/Node.pm

   1 # $Id: Node.pm,v 1.5 2006-10-11 16:36:03 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 its subclasses.  In fact, there is nothing
  35 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     }, $class;
  64 }
  65
  66 =head2 name()
  67
  68  print "Node is called '", $node->name(), "'\n";
  69
  70 Returns the name of the node.
  71
  72 =cut
  73
  74 sub name {
  75     my $this = shift();
  76     return $this->{name};
  77 }
  78
  79 =head2 subnodes()
  80
  81  @nodes = $node->subnodes();
  82  print "Node has ", scalar(@nodes), " subnodes\n";
  83
  84 Returns a list of the subnodes of the node.
  85
  86 =cut
  87
  88 sub subnodes {
  89     my $this = shift();
  90     return @{ $this->{subnodes} };
  91 }
  92
  93 =head2 print()
  94
  95  $node->print(0);
  96
  97 Pretty-prints the node and, recursively, all its children.  The
  98 parameter is the level of indentation to use in printing the node;
  99 this method recursively invokes itself with higher levels.
 100
 101 =cut
 102
 103 sub print {
 104     my $this = shift();
 105     my($level) = @_;
 106
 107     print "\t" x $level, $this->name();
 108     if (my @sub = $this->subnodes()) {
 109         print " = {\n";
 110         foreach my $sub (@sub) {
 111             $sub->print($level+1);
 112         }
 113         print "\t" x $level, "}";
 114     }
 115     print "\n";
 116 }
 117
 118 =head2 select()
 119
 120  $sameNode = $node->select("");
 121  $firstSubNode $node->select("0");
 122  $secondSubNode $node->select("1");
 123  $deepNode $node->select("0:3:2");
 124
 125 Returns a specified node from the tree of which C<$node> is the root,
 126 or an undefined value if the specified node does not exist.  The sole
 127 argument is the address of the node to be returned, which consists of
 128 zero or more colon-separated components.  Each component is an
 129 integer, a zero-based index into the subnodes at that level.  Example
 130 addresses:
 131
 132 =over 4
 133
 134 =item "" (empty)
 135
 136 The node itself, i.e. the root of the tree.
 137
 138 =item "0"
 139
 140 Subnode number 0 (i.e. the first subnode) of the root.
 141
 142 =item "1"
 143
 144 Subnode number 1 (i.e. the second subnode) of the root.
 145
 146 =item "0:3:2"
 147
 148 Subnode 2 of subnode 3 of subnode zero of the root (i.e. the third
 149 subnode of the fourth subnode of the first subnode of the root).
 150
 151 =back
 152
 153 =cut
 154
 155 sub select {
 156     my $this = shift();
 157     my($address) = @_;
 158
 159     my @sub = $this->subnodes();
 160     if ($address eq "") {
 161         return $this;
 162     } elsif (my($head, $tail) = $address =~ /(.*?):(.*)/) {
 163         return $sub[$head]->select($tail);
 164     } else {
 165         return $sub[$address];
 166     }
 167 }
 168
 169
 170 =head1 SEE ALSO
 171
 172 ZOOM::IRSpy
 173
 174 =head1 AUTHOR
 175
 176 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 177
 178 =head1 COPYRIGHT AND LICENSE
 179
 180 Copyright (C) 2006 by Index Data ApS.
 181
 182 This library is free software; you can redistribute it and/or modify
 183 it under the same terms as Perl itself, either Perl version 5.8.7 or,
 184 at your option, any later version of Perl 5 you may have available.
 185
 186 =cut
 187
 188 1;