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=87c04bd6be6767847c6cfb4a84af111a963b266d;hp=ee29f08572ed1cdbb67f7f4afaea098e15ca30e2;hb=765072147a3a859b2e596edfda01d03eed726746;hpb=31a606fa33c4f62083ece8216276b5d1cf5ea94f diff --git a/lib/ZOOM/IRSpy/Test/Record/Fetch.pm b/lib/ZOOM/IRSpy/Test/Record/Fetch.pm index ee29f08..87c04bd 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.1 2006-10-23 13:54:52 sondberg Exp $ # See the "Main" test package for documentation @@ -11,13 +10,64 @@ 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", + "\@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 + ); + sub start { - print STDERR "Got here\n"; - exit 1; my $class = shift(); my($conn) = @_; - my @syntax = ( 'canmarc', + + # 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); +} + + +sub completed_search { + my($conn, $task, $udata, $event) = @_; + + 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; + } + + my @syntax = ( + 'canmarc', 'danmarc', 'grs-1', 'ibermarc', @@ -26,57 +76,95 @@ sub start { 'librismarc', 'mab', 'normarc', - 'opac', +# 'opac', 'picamarc', 'rusmarc', 'summary', 'sutrs', - 'swemarc' + 'swemarc', 'ukmarc', 'unimarc', 'usmarc', - 'xml', + 'xml' ); - - foreach my $syn (@syntax) { - $conn->option('preferredRecordSyntax' => $syn); - $conn->option('start' => 0); - $conn->option('count' => 1); - - ## 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", - {'syntax' => $syn}, - ZOOM::Event::RECV_RECORD, \&record, - exception => \&error); + #@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, + { syntax => $syntax, + last => ($i == $#syntax) }, + { start => 0, count => 1, + preferredRecordSyntax => $syntax }, + ZOOM::Event::ZEND, \&record, + exception => \&fetch_error); } + + return ZOOM::IRSpy::Status::TASK_DONE; } sub record { - my($conn, $task, $test_args, $event) = @_; - my $syn = $test_args->{'syn'}; + my($conn, $task, $udata, $event) = @_; + my $syn = $udata->{'syntax'}; + my $rs = $task->{rs}; + + my $record = _fetch_record($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->log("irspy_test", "search on access-point $attr found $n record", - $n==1 ? "" : "s"); $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 { +sub _fetch_record { + my($rs, $index0, $syntax) = @_; + + my $oldSyntax = $rs->option(preferredRecordSyntax => $syntax); + my $record = $rs->record(0); + $oldSyntax = "" if !defined $oldSyntax; + $rs->option(preferredRecordSyntax => $oldSyntax); + + return $record; +} + + +sub __UNUSED_search_error { my($conn, $task, $test_args, $exception) = @_; - my $syn = $test_args->{'syn'}; - $conn->log("irspy_test", "search on access-point $attr had error: ", - $exception); + $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; }