From: Mike Taylor <mike@indexdata.com>
Date: Tue, 18 Sep 2007 16:57:37 +0000 (+0000)
Subject: Refactor to use new _next_connection() both at startup and when
X-Git-Tag: CPAN-v1.02~54^2~292
X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=0f262d6879a2aef5751a0f471bf31a322845d8f4;ds=sidebyside

Refactor to use new _next_connection() both at startup and when
	subsequently adding another connection to the active pool.
Enhance this method to implement restrict_modulo()
---

diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm
index 6c87cd9..8e6d3ac 100644
--- a/lib/ZOOM/IRSpy.pm
+++ b/lib/ZOOM/IRSpy.pm
@@ -1,4 +1,4 @@
-# $Id: IRSpy.pm,v 1.87 2007-07-16 11:54:17 mike Exp $
+# $Id: IRSpy.pm,v 1.88 2007-09-18 16:57:37 mike Exp $
 
 package ZOOM::IRSpy;
 
@@ -87,6 +87,8 @@ sub new {
     my $this = bless {
 	conn => $conn,
 	query => "cql.allRecords=1", # unless overridden
+	modn => undef,		# Filled in by restrict_modulo()
+	modi => undef,		# Filled in by restrict_modulo()
 	targets => undef,	# Filled in later if targets() is
 				# called; used only to keep state from
 				# targets() until initialise() is
@@ -96,6 +98,7 @@ sub new {
         libxml => $libxml,
         irspy_to_zeerex_style => $irspy_to_zeerex_style,
 	test => undef,		# Filled in by initialise()
+	timeout => undef,	# Filled in by initialise()
 	tests => undef,		# Tree of tests to be executed
 	activeSetSize => defined $activeSetSize ? $activeSetSize : 10,
     }, $class;
@@ -163,6 +166,15 @@ sub _parse_target_string {
 }
 
 
+sub restrict_modulo {
+    my $this = shift();
+    my($n, $i) = @_;
+
+    $this->{modn} = $n;
+    $this->{modi} = $i;
+}
+
+
 # Records must be fetched for all records satisfying $this->{query} If
 # $this->{targets} is already set (i.e. a specific list of targets to
 # check was specified by a call to targets()), then new, empty records
@@ -179,7 +191,7 @@ sub initialise {
     $this->{tree}->resolve();
     #$this->{tree}->print(0);
 
-    my $timeout = "ZOOM::IRSpy::Test::$tname"->timeout();
+    $this->{timeout} = "ZOOM::IRSpy::Test::$tname"->timeout();
 
     my @targets;
     my $targets = $this->{targets};
@@ -200,16 +212,49 @@ sub initialise {
     my $n = $this->{activeSetSize};
     $n = @targets if $n == 0 || $n > @targets;
 
-    my @connections;
-    foreach my $i (1..$n) {
-	push @connections, create ZOOM::IRSpy::Connection($this,
-							  shift @targets,
-							  async => 1,
-							  timeout => $timeout);
+    $this->{queue} = \@targets;
+    $this->{connections} = [];
+    while (@{ $this->{connections} } < $n) {
+	my $conn = $this->_next_connection();
+	last if !defined $conn;
+	push @{ $this->{connections} }, $conn;
     }
+}
 
-    $this->{connections} = \@connections;
-    $this->{queue} = \@targets;
+
+sub _next_connection {
+    my $this = shift();
+
+    my $target;
+    my $n = $this->{modn};
+    my $i = $this->{modi};
+    if (!defined $n) {
+	$target = shift @{ $this->{queue} };
+    } else {
+	while (1) {
+	    $target = shift @{ $this->{queue} };
+	    return undef if !defined $target;
+	    my $h = _hash($target);
+	    my $hmodn = $h % $n;
+	    last if $hmodn == $i;
+	    $this->log("irspy", "'$target' hash $h % $n = $hmodn != $i");
+	}
+    }
+
+    return create ZOOM::IRSpy::Connection($this, $target, async => 1,
+					  timeout => $this->{timeout});
+}
+
+
+sub _hash {
+    my($target) = @_;
+
+    my $n = 0;
+    foreach my $s (split //, $target) {
+	$n += ord($s);
+    }
+
+    return $n;
 }
 
 
@@ -354,7 +399,7 @@ sub check {
     my $this = shift();
 
     my $topname = $this->{tree}->name();
-    my $timeout = "ZOOM::IRSpy::Test::$topname"->timeout();
+    my $timeout = $this->{timeout};
     $this->log("irspy", "beginnning with test '$topname' (timeout $timeout)");
 
     my $nskipped = 0;
@@ -386,15 +431,13 @@ sub check {
 			$conn->log("irspy", "has no more tests: removing");
 			$this->_rewrite_record($conn);
 			$conn->option(rewrote_record => 1);
-			if (@{ $this->{queue} } == 0) {
-			    # Do not destroy: we need this for later sanity checks
+			my $newconn = $this->_next_connection();
+			if (!defined $newconn) {
+			    # Do not destroy: needed for later sanity checks
 			    splice @conn, $i0, 1;
 			} else {
 			    $conn->destroy();
-			    $conn[$i0] = create
-				ZOOM::IRSpy::Connection($this,
-					shift @{ $this->{queue} }, async => 1,
-							timeout => $timeout);
+			    $conn[$i0] = $newconn;
 			    $conn[$i0]->option(current_test_address => "");
 			    $conn[$i0]->log("irspy", "entering active pool - ",
 					    scalar(@{ $this->{queue} }),