X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=lib%2FZOOM%2FIRSpy%2FTest%2FRecord%2FFetch.pm;h=af0b52949d73b5489214a1e361f9147476787362;hp=22887152e13f39bc8aea112966d2e0273a241fda;hb=c4aef4c3e4fb86ba75feefedce3ffd7d0a4a5b16;hpb=e61887a109576fa0e066547c0ce033631a290f8f

diff --git a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm
index 2288715..af0b529 100644
--- a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm
+++ b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm
@@ -10,8 +10,8 @@ use warnings;
 use ZOOM::IRSpy::Test;
 our @ISA = qw(ZOOM::IRSpy::Test);
 
+our $max_timeout_errors = $ZOOM::IRSpy::max_timeout_errors;
 
-# These queries 
 my @queries = (
 	       "\@attr 1=4 mineral",
 	       "\@attr 1=4 computer",
@@ -20,14 +20,34 @@ my @queries = (
 	       ### We can add more queries here
 	       );
 
+my @syntax = (
+	       'canmarc',
+	       'danmarc',
+	       'grs-1',
+	       'ibermarc',
+	       'intermarc',
+	       'jpmarc',
+	       'librismarc',
+	       'mab',
+	       'normarc',
+	       'opac',
+	       'picamarc',
+	       'rusmarc',
+	       'summary',
+	       'sutrs',
+	       'swemarc',
+	       'ukmarc',
+	       'unimarc',
+	       'usmarc',
+	       'xml'
+	    );
+#@syntax = qw(grs-1 sutrs usmarc xml); # simplify for debugging
+
 
 sub start {
     my $class = shift();
     my($conn) = @_;
 
-    # Here I want to get a use attribute from the session, which we've
-    # managed to search for in the Search/Bib1 or Search/Dan1 tests.
-    # But how?  So far we search for title: 1=4
     $conn->irspy_search_pqf($queries[0], { queryindex => 0 }, {},
 			    ZOOM::Event::ZEND, \&completed_search,
 			    exception => \&completed_search);
@@ -41,12 +61,22 @@ sub completed_search {
     $conn->log("irspy_test", "Fetch test search (", $task->render_query(), ") ",
 	       ref $event && $event->isa("ZOOM::Exception") ?
 	       "failed: $event" : "found $n records (event=$event)");
+
+    # remember how often a target record hit a timeout
+    if (ref $event && $event->isa("ZOOM::Exception")) {
+	if ($event =~ /Timeout/i) {
+	    $conn->record->zoom_error->{TIMEOUT}++;
+            $conn->log("irspy_test", "Increase timeout error counter to: " . 
+		$conn->record->zoom_error->{TIMEOUT});
+        }
+    }
+
     if ($n == 0) {
 	$task->{rs}->destroy();
 	my $qindex = $udata->{queryindex}+1;
 	my $q = $queries[$qindex];
 	return ZOOM::IRSpy::Status::TEST_SKIPPED
-	    if !defined $q;
+	    if !defined $q || $conn->record->zoom_error->{TIMEOUT} >= $max_timeout_errors;
 
 	$conn->log("irspy_test", "Trying another search ...");
 	$conn->irspy_search_pqf($queries[$qindex], { queryindex => $qindex }, {},
@@ -55,28 +85,6 @@ sub completed_search {
 	return ZOOM::IRSpy::Status::TASK_DONE;
     }
 
-    my @syntax = (
-                   'canmarc',
-                   'danmarc',
-                   'grs-1',
-                   'ibermarc',
-                   'intermarc',
-                   'jpmarc',
-                   'librismarc',
-                   'mab',
-                   'normarc',
-#                   'opac',
-                   'picamarc',
-                   'rusmarc',
-                   'summary',
-                   'sutrs',
-                   'swemarc',
-                   'ukmarc',
-                   'unimarc',
-                   'usmarc',
-                   'xml'
-                );
-    #@syntax = qw(grs-1 sutrs usmarc xml); # simplify for debugging
     foreach my $i (0 ..$#syntax) {
 	my $syntax = $syntax[$i];
 	$conn->irspy_rs_record($task->{rs}, 0,
@@ -97,7 +105,7 @@ sub record {
     my $syn = $udata->{'syntax'};
     my $rs = $task->{rs};
 
-    my $record = _fetch_record($rs, 0, $syn);
+    my $record = _fetch_record($conn, $rs, 0, $syn);
     my $ok = 0;
     if (!$record || $record->error()) {
 	$conn->log("irspy_test", "retrieval of $syn record failed: ",
@@ -125,13 +133,28 @@ sub record {
 }
 
 
+# By the time this is called, the record has already been physically
+# fetched from the server in the correct syntax, and placed in the
+# result-set's cache.  But in order to actually get hold of it from
+# that cache, we need to set the record-syntax again, to the same
+# value, otherwise ZOOM will make a fresh request.
+#
+# ZOOM::IRSpy::Task::Retrieve sets options into the connection object
+# rather than the result-set object (because it's a subclass of
+# ZOOM::IRSpy::Task, which doesn't know about result-sets).  Therefore
+# it's important that this function also set into the connection:
+# otherwise any value subsequently set into the connection by
+# ZOOM::IRSpy::Task::Retrieve will be ignored by ZOOM-C operations, as
+# the value previously set into the result-set will override it.
+# (This was the very subtle cause of bug #3534).
+#
 sub _fetch_record {
-    my($rs, $index0, $syntax) = @_;
+    my($conn, $rs, $index0, $syntax) = @_;
 
-    my $oldSyntax = $rs->option(preferredRecordSyntax => $syntax);
+    my $oldSyntax = $conn->option(preferredRecordSyntax => $syntax);
     my $record = $rs->record(0);
     $oldSyntax = "" if !defined $oldSyntax;
-    $rs->option(preferredRecordSyntax => $oldSyntax);
+    $conn->option(preferredRecordSyntax => $oldSyntax);
 
     return $record;
 }