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=5e62a969523073a43a4262f3875fc2ebd58e1c87;hp=2e0b591f372ccc97b5c6b1cdaac106b6eb91298a;hb=403ced66f3b48705e1e58c3e8caa6336c4008637;hpb=6f3e46e6da867d23c86d7148751e4a7172e28df3 diff --git a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm index 2e0b591..5e62a96 100644 --- a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm +++ b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm @@ -1,4 +1,3 @@ -# $Id: Fetch.pm,v 1.7 2006-10-25 15:44:50 mike Exp $ # See the "Main" test package for documentation @@ -11,53 +10,99 @@ use warnings; use ZOOM::IRSpy::Test; our @ISA = qw(ZOOM::IRSpy::Test); +our $max_timeout_errors = $ZOOM::IRSpy::max_timeout_errors; + +my @queries = ( + "\@attr 1=4 mineral", + "\@attr 1=4 computer", + "\@attr 1=44 mineral", # Smithsonian doesn't support AP 4! + "\@attr 1=1016 water", # Connector Framework only does 1016 + ### We can add more queries here + ); + +# Certain fetch attempts cause the connection to be lost (e.g. the +# decoding of OPAC records fails for the National Library of +# Education, Denmark (grundtvig.dpu.dk:2100/S), after which all +# subsequent fetches fail -- see bug #3548. To amerliorate the +# consequences of this, we check the record syntaxes in order of +# importance and likelihood of not causing the connection to be +# dropped. Of course, for well-behaved servers, this makes no +# difference at all. + +#@syntax = qw(grs-1 sutrs usmarc xml); # simplify for debugging +my @syntax = ( + 'usmarc', + 'canmarc', + 'danmarc', + 'ibermarc', + 'intermarc', + 'jpmarc', + 'librismarc', + 'mab', + 'normarc', + 'picamarc', + 'rusmarc', + 'swemarc', + 'ukmarc', + 'unimarc', + 'sutrs', + 'xml', + 'grs-1', + 'summary', + 'opac', + ); + 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("\@attr 1=4 mineral", {}, {}, - ZOOM::Event::RECV_SEARCH, \&completed_search, - exception => \&error); + $conn->irspy_search_pqf($queries[0], { queryindex => 0 }, {}, + ZOOM::Event::ZEND, \&completed_search, + exception => \&completed_search); } sub completed_search { my($conn, $task, $udata, $event) = @_; - $conn->log("irspy_test", "Fetch test search succeeded"); - 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 $syntax (@syntax) { + my $n = $task->{rs}->size(); + $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 || $conn->record->zoom_error->{TIMEOUT} >= $max_timeout_errors; + + $conn->log("irspy_test", "Trying another search ..."); + $conn->irspy_search_pqf($queries[$qindex], { queryindex => $qindex }, {}, + ZOOM::Event::ZEND, \&completed_search, + exception => \&completed_search); + return ZOOM::IRSpy::Status::TASK_DONE; + } + + foreach my $i (0 ..$#syntax) { + my $syntax = $syntax[$i]; $conn->irspy_rs_record($task->{rs}, 0, - { syntax => $syntax }, + { syntax => $syntax, + last => ($i == $#syntax) }, { start => 0, count => 1, preferredRecordSyntax => $syntax }, - ZOOM::Event::RECV_RECORD, \&record, - exception => \&error); + ZOOM::Event::ZEND, \&record, + exception => \&fetch_error); } return ZOOM::IRSpy::Status::TASK_DONE; @@ -65,33 +110,82 @@ sub completed_search { sub record { - my($conn, $task, $test_args, $event) = @_; - my $syn = $test_args->{'syntax'}; + my($conn, $task, $udata, $event) = @_; + my $syn = $udata->{'syntax'}; my $rs = $task->{rs}; - $conn->log("irspy_test", "Successfully retrieved a $syn record"); - if (1) { - print STDERR "Hits: ", $rs->size(), "\n"; - print STDERR "Syntax: ", $syn, "\n"; - print STDERR $rs->record(0)->render(); + my $record = _fetch_record($conn, $rs, 0, $syn); + my $ok = 0; + if (!$record || $record->error()) { + $conn->log("irspy_test", "retrieval of $syn record failed: ", + defined $record ? $record->exception() : + $conn->exception()); + } else { + $ok = 1; + my $text = $record->render(); + $conn->log("irspy_test", "Successfully retrieved a $syn record"); + if (0) { + print STDERR "Hits: ", $rs->size(), "\n"; + print STDERR "Syntax: ", $syn, "\n"; + print STDERR $text; + } } $conn->record()->store_result('record_fetch', 'syntax' => $syn, - 'ok' => 1); + 'ok' => $ok); - return ZOOM::IRSpy::Status::TASK_DONE; + $rs->destroy() if $udata->{last}; + return ($udata->{last} ? + ZOOM::IRSpy::Status::TEST_GOOD : + ZOOM::IRSpy::Status::TASK_DONE); } -sub error { +# 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($conn, $rs, $index0, $syntax) = @_; + + my $oldSyntax = $conn->option(preferredRecordSyntax => $syntax); + my $record = $rs->record(0); + $oldSyntax = "" if !defined $oldSyntax; + $conn->option(preferredRecordSyntax => $oldSyntax); + + return $record; +} + + +sub __UNUSED_search_error { my($conn, $task, $test_args, $exception) = @_; - my $syn = $test_args->{'syntax'}; + + $conn->log("irspy_test", "Initial search failed: ", $exception); + return ZOOM::IRSpy::Status::TEST_SKIPPED; +} + + +sub fetch_error { + my($conn, $task, $udata, $exception) = @_; + my $syn = $udata->{'syntax'}; $conn->log("irspy_test", "Retrieval of $syn record failed: ", $exception); $conn->record()->store_result('record_fetch', 'syntax' => $syn, 'ok' => 0); + $task->{rs}->destroy() if $udata->{last}; return ZOOM::IRSpy::Status::TASK_DONE; }