X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=lib%2FZOOM%2FIRSpy.pm;h=b3c0aeb15e8de464b155625bccabe60bd052d75d;hp=a496c67e78bf2115dc3e4fb63142d2fa953ec0ba;hb=09a78b8e8d348d62681278705447c19070cbd6b1;hpb=494c25dbeed5f8200b6200fa211330793a1b03e4

diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm
index a496c67..b3c0aeb 100644
--- 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'";