From: Mike Taylor <mike@indexdata.com>
Date: Fri, 13 Oct 2006 15:17:25 +0000 (+0000)
Subject: Rewrite each record as its target's tests complete.
X-Git-Tag: CPAN-v1.02~54^2~910
X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=9f74222ecbca15c4ca23236b07c08c2ced5d2430;hp=51cd1348401e8436ff7331258d261d8305f405c3

Rewrite each record as its target's tests complete.
---

diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm
index 398765a..aad702c 100644
--- a/lib/ZOOM/IRSpy.pm
+++ b/lib/ZOOM/IRSpy.pm
@@ -1,4 +1,4 @@
-# $Id: IRSpy.pm,v 1.30 2006-10-13 13:41:56 sondberg Exp $
+# $Id: IRSpy.pm,v 1.31 2006-10-13 15:17:25 mike Exp $
 
 package ZOOM::IRSpy;
 
@@ -225,28 +225,27 @@ sub _render_record {
 }
 
 
-sub _rewrite_records {
+sub _rewrite_record {
     my $this = shift();
-
-    # Write modified records back to database
-    foreach my $conn (@{ $this->{connections} }) {
-	my $rec = $conn->record();
-	my $p = $this->{conn}->package();
-	$p->option(action => "specialUpdate");
-	my $xml = $rec->{zeerex}->toString();
-	$p->option(record => $xml);
-	$p->send("update");
-	$p->destroy();
-
-	$p = $this->{conn}->package();
-	$p->send("commit");
-	$p->destroy();
-	if (0) {
-	    $xml =~ s/&/&amp/g;
-	    $xml =~ s/</&lt;/g;
-	    $xml =~ s/>/&gt;/g;
-	    print "Updated with xml=<br/>\n<pre>$xml</pre>\n";
-	}
+    my($conn) = @_;
+
+    $conn->log("irspy", "rewriting XML record");
+    my $rec = $conn->record();
+    my $p = $this->{conn}->package();
+    $p->option(action => "specialUpdate");
+    my $xml = $rec->{zeerex}->toString();
+    $p->option(record => $xml);
+    $p->send("update");
+    $p->destroy();
+
+    $p = $this->{conn}->package();
+    $p->send("commit");
+    $p->destroy();
+    if (0) {
+	$xml =~ s/&/&amp/g;
+	$xml =~ s/</&lt;/g;
+	$xml =~ s/>/&gt;/g;
+	print "Updated $conn with xml=<br/>\n<pre>$xml</pre>\n";
     }
 }
 
@@ -293,9 +292,10 @@ sub check {
 
     while (1) {
 	my @copy_conn = @conn;	# avoid alias problems after splice()
+	my $nconn = scalar(@copy_conn);
 	foreach my $i0 (0 .. $#copy_conn) {
 	    my $conn = $copy_conn[$i0];
-	    #print "connection $i0 of ", scalar(@copy_conn), " from ", scalar(@conn), " is $conn\n";
+	    #print "connection $i0 of $nconn/", scalar(@conn), " is $conn\n";
 	    if (!$conn->current_task()) {
 		if (!$conn->next_task()) {
 		    # Out of tasks: we need a new test
@@ -305,12 +305,14 @@ sub check {
 		    if (!defined $address) {
 			$nextaddr = "";
 		    } else {
-			$this->log("irspy_test", "checking for next test after '$address'");
+			$this->log("irspy_test",
+				   "checking for next test after '$address'");
 			$nextaddr = $this->_next_test($address);
 		    }
 		    if (!defined $nextaddr) {
 			$conn->log("irspy", "has no more tests: removing");
 			splice @conn, $i0, 1;
+			$this->_rewrite_record($conn);
 			next;
 		    }
 
@@ -318,7 +320,8 @@ sub check {
 			or die "invalid nextaddr '$nextaddr'";
 		    $conn->option(current_test_address => $nextaddr);
 		    my $tname = $node->name();
-		    $conn->log("irspy_test", "starting test '$nextaddr' = $tname");
+		    $conn->log("irspy_test",
+			       "starting test '$nextaddr' = $tname");
 		    my $tasks = $conn->tasks();
 		    my $oldcount = @$tasks;
 		    "ZOOM::IRSpy::Test::$tname"->start($conn);
@@ -327,7 +330,8 @@ sub check {
 			# Prepare to start the first of the newly added tasks
 			$conn->next_task($tasks->[$oldcount]);
 		    } else {
-			$conn->log("irspy_task", "no tasks added by new test $tname");
+			$conn->log("irspy_task",
+				   "no tasks added by new test $tname");
 			goto NEXT_TEST;
 		    }
 		}
@@ -344,7 +348,8 @@ sub check {
 	}
 
 	my $i0 = ZOOM::event(\@conn);
-	$this->log("irspy_event", "ZOOM_event(", scalar(@conn), " connections) = $i0");
+	$this->log("irspy_event",
+		   "ZOOM_event(", scalar(@conn), " connections) = $i0");
 	last if $i0 == 0 || $i0 == -3; # no events or no connections
 	my $conn = $conn[$i0-1];
 	my $ev = $conn->last_event();
@@ -411,8 +416,6 @@ sub check {
     }
 
     $this->log("irspy", "exiting main loop");
-
-    #$this->_rewrite_records();
     return $nskipped;
 }