Use new $node->next()/address() to correctly skip tests.

[irspy-moved-to-github.git] / lib / ZOOM / IRSpy.pm

diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm
index a496c67..b3c0aeb 100644 (file)
--- a/lib/ZOOM/IRSpy.pm
+++ b/lib/ZOOM/IRSpy.pm
@@ -1,4 +1,4 @@
-# $Id: IRSpy.pm,v 1.66 2007-02-23 13:18:43 mike Exp $
+# $Id: IRSpy.pm,v 1.72 2007-02-28 17:36:00 mike Exp $
 
 package ZOOM::IRSpy;
 
@@ -132,6 +132,15 @@ sub targets {
 }
 
 
+sub find_targets {
+    my $this = shift();
+    my($query) = @_;
+
+    $this->{allrecords} = 0;    
+    $this->{query} = $query;
+}
+
+
 # Also used by ZOOM::IRSpy::Record
 sub _parse_target_string {
     my($target) = @_;
@@ -179,7 +188,7 @@ sub initialise {
        # access point -- not even 1035 "everywhere" -- so instead we
        # hack together a search that we know will find all records.
        $this->{query} = "port=?*";
-    } else {
+    } elsif ($this->{targets}) {
        # Prepopulate the target map with nulls so that after we fill
        # in what we can from the database query, we know which target
        # IDs we need new records for.
@@ -190,8 +199,10 @@ sub initialise {
 
     $this->log("irspy_debug", "query '", $this->{query}, "'");
     my $rs = $this->{conn}->search(new ZOOM::Query::CQL($this->{query}));
+    $this->log("irspy", "'", $this->{query}, "' found ",
+              $rs->size(), " target records");
     delete $this->{query};     # No longer needed at all
-    $this->log("irspy_debug", "found ", $rs->size(), " target records");
+    my $gatherTargets = !$this->{targets};
     foreach my $i (1 .. $rs->size()) {
        my $target = _render_record($rs, $i-1, "id");
        my $zeerex = _render_record($rs, $i-1, "zeerex");
@@ -199,7 +210,7 @@ sub initialise {
        $target2record{lc($target)} =
            new ZOOM::IRSpy::Record($this, $target, $zeerex);
        push @{ $this->{targets} }, $target
-           if $this->{allrecords};
+           if $gatherTargets;
     }
 
     # Make records for targets not previously in the database
@@ -252,7 +263,8 @@ sub _irspy_to_zeerex {
 
     if ($save_xml) {
        unlink('/tmp/irspy_orig.xml');
-       open FH, '>/tmp/irspy_orig.xml';
+       open FH, '>/tmp/irspy_orig.xml'
+           or die "can't write irspy_orig.xml: $!";
        print FH $irspy_doc->toString();
        close FH;
     }
@@ -260,7 +272,8 @@ sub _irspy_to_zeerex {
     my $result = $this->{irspy_to_zeerex_style}->transform($irspy_doc, %params);
     if ($save_xml) {
        unlink('/tmp/irspy_transformed.xml');
-       open FH, '>/tmp/irspy_transformed.xml';
+       open FH, '>/tmp/irspy_transformed.xml'
+           or die "can't write irspy_transformed.xml: $!";
        print FH $result->toString();
        close FH;
     }
@@ -336,6 +349,7 @@ sub check {
     $tname = "Main" if !defined $tname;
     $this->{tree} = $this->_gather_tests($tname)
        or die "No tests defined for '$tname'";
+    $this->{tree}->resolve();
     #$this->{tree}->print(0);
     my $nskipped = 0;
 
@@ -400,6 +414,7 @@ sub check {
            }
        }
 
+      NEXT_EVENT:
        my $i0 = ZOOM::event(\@conn);
        $this->log("irspy_event",
                   "ZOOM_event(", scalar(@conn), " connections) = $i0");
@@ -420,35 +435,19 @@ sub check {
        my $ev = $conn->last_event();
        my $evstr = ZOOM::event_str($ev);
        $conn->log("irspy_event", "event $ev ($evstr)");
+       goto NEXT_EVENT if $ev != ZOOM::Event::ZEND;
 
        my $task = $conn->current_task();
        die "$conn has no current task for event $ev ($evstr)" if !$task;
-       eval { $conn->_check() };
-       if ($@ &&
-           ($ev == ZOOM::Event::RECV_DATA ||
-            $ev == ZOOM::Event::ZEND ||
-            ($ev == ZOOM::Event::RECV_APDU &&
-             !$task->isa("ZOOM::IRSpy::Task::Connect")))) {
-           # An error in, say, a search response, becomes visible to
-           # ZOOM before the Receive Data event is sent and persists
-           # until after the End, which means that successive events
-           # each report the same error.  So we just ignore errors on
-           # "unimportant" events.  We can also ignore errors on
-           # RECV_APDU in most cases, but since there is no RECV_INIT
-           # event, we need to avoid doing this if the task is
-           # Connect.  Yuck -- special cases.
-           # ### But this doesn't work for, say, a Connection Refused,
-           # as the only event that shows us this error is the ZEND.
-           $conn->log("irspy_event", "ignoring error ",
-                      "on event $ev ($evstr): $@");
-           next;
-       }
 
        my $res;
-       if ($@) {
+       eval { $conn->check() };
+       if ($@ && ref $@ && $@->isa("ZOOM::Exception")) {
            my $sub = $task->{cb}->{exception};
            die $@ if !defined $sub;
            $res = &$sub($conn, $task, $task->udata(), $@);
+       } elsif ($@) {
+           die "Unexpected non-ZOOM exception: " . ref($@) . " ($@)";
        } else {
            my $sub = $task->{cb}->{$ev};
            if (!defined $sub) {
@@ -479,19 +478,29 @@ sub check {
            $conn->next_task(0);
            if ($res == ZOOM::IRSpy::Status::TEST_BAD) {
                my $address = $conn->option('current_test_address');
-               ($address, my $n) = $this->_last_sibling_test($address);
-               if (defined $address) {
-                   $conn->log("irspy_test", "skipped $n tests");
-                   $conn->option(current_test_address => $address);
-                   $nskipped += $n;
+               $conn->log("irspy", "top-level test failed!")
+                   if $address eq "";
+               my $node = $this->{tree}->select($address);
+               my $skipcount = 0;
+               while (defined $node->next() &&
+                      length($node->next()->address()) >= length($address)) {
+                   $conn->log("irspy_debug", "skipping from '",
+                              $node->address(), "' to '",
+                              $node->next()->address(), "'");
+                   $node = $node->next();
+                   $skipcount++;
                }
+
+               $conn->option(current_test_address => $node->address());
+               $conn->log("irspy_test", "skipped $skipcount tests");
+               $nskipped += $skipcount;
            }
 
        } elsif ($res == ZOOM::IRSpy::Status::TEST_SKIPPED) {
            $conn->log("irspy_test", "test skipped during task $task");
            $conn->current_task(0);
            $conn->next_task(0);
-           # I think that's all we need to do
+           $nskipped++;
 
        } else {
            die "unknown callback return-value '$res'";