lib/ZOOM/IRSpy/Test/Record/Fetch.pm

   1
   2 # See the "Main" test package for documentation
   3
   4 package ZOOM::IRSpy::Test::Record::Fetch;
   5
   6 use 5.008;
   7 use strict;
   8 use warnings;
   9
  10 use ZOOM::IRSpy::Test;
  11 our @ISA = qw(ZOOM::IRSpy::Test);
  12
  13 our $max_timeout_errors = $ZOOM::IRSpy::max_timeout_errors;
  14
  15 my @queries = (
  16                "\@attr 1=4 mineral",
  17                "\@attr 1=4 computer",
  18                "\@attr 1=44 mineral", # Smithsonian doesn't support AP 4!
  19                "\@attr 1=1016 water", # Connector Framework only does 1016
  20                ### We can add more queries here
  21                );
  22
  23 # Certain fetch attempts cause the connection to be lost (e.g. the
  24 # decoding of OPAC records fails for the National Library of
  25 # Education, Denmark (grundtvig.dpu.dk:2100/S), after which all
  26 # subsequent fetches fail -- see bug #3548.  To amerliorate the
  27 # consequences of this, we check the record syntaxes in order of
  28 # importance and likelihood of not causing the connection to be
  29 # dropped.  Of course, for well-behaved servers, this makes no
  30 # difference at all.
  31
  32 #@syntax = qw(grs-1 sutrs usmarc xml); # simplify for debugging
  33 my @syntax = (
  34                'usmarc',
  35                'canmarc',
  36                'danmarc',
  37                'ibermarc',
  38                'intermarc',
  39                'jpmarc',
  40                'librismarc',
  41                'mab',
  42                'normarc',
  43                'picamarc',
  44                'rusmarc',
  45                'swemarc',
  46                'ukmarc',
  47                'unimarc',
  48                'sutrs',
  49                'xml',
  50                'grs-1',
  51                'summary',
  52                'opac',
  53             );
  54
  55
  56 sub start {
  57     my $class = shift();
  58     my($conn) = @_;
  59
  60     $conn->irspy_search_pqf($queries[0], { queryindex => 0 }, {},
  61                             ZOOM::Event::ZEND, \&completed_search,
  62                             exception => \&completed_search);
  63 }
  64
  65
  66 sub completed_search {
  67     my($conn, $task, $udata, $event) = @_;
  68
  69     my $n = $task->{rs}->size();
  70     $conn->log("irspy_test", "Fetch test search (", $task->render_query(), ") ",
  71                ref $event && $event->isa("ZOOM::Exception") ?
  72                "failed: $event" : "found $n records (event=$event)");
  73
  74     # remember how often a target record hit a timeout
  75     if (ref $event && $event->isa("ZOOM::Exception")) {
  76         if ($event =~ /Timeout/i) {
  77             $conn->record->zoom_error->{TIMEOUT}++;
  78             $conn->log("irspy_test", "Increase timeout error counter to: " .
  79                 $conn->record->zoom_error->{TIMEOUT});
  80         }
  81     }
  82
  83     if ($n == 0) {
  84         $task->{rs}->destroy();
  85         my $qindex = $udata->{queryindex}+1;
  86         my $q = $queries[$qindex];
  87         return ZOOM::IRSpy::Status::TEST_SKIPPED
  88             if !defined $q || $conn->record->zoom_error->{TIMEOUT} >= $max_timeout_errors;
  89
  90         $conn->log("irspy_test", "Trying another search ...");
  91         $conn->irspy_search_pqf($queries[$qindex], { queryindex => $qindex }, {},
  92                                 ZOOM::Event::ZEND, \&completed_search,
  93                                 exception => \&completed_search);
  94         return ZOOM::IRSpy::Status::TASK_DONE;
  95     }
  96
  97     foreach my $i (0 ..$#syntax) {
  98         my $syntax = $syntax[$i];
  99         $conn->irspy_rs_record($task->{rs}, 0,
 100                                { syntax => $syntax,
 101                                  last => ($i == $#syntax) },
 102                                { start => 0, count => 1,
 103                                  preferredRecordSyntax => $syntax },
 104                                 ZOOM::Event::ZEND, \&record,
 105                                 exception => \&fetch_error);
 106     }
 107
 108     return ZOOM::IRSpy::Status::TASK_DONE;
 109 }
 110
 111
 112 sub record {
 113     my($conn, $task, $udata, $event) = @_;
 114     my $syn = $udata->{'syntax'};
 115     my $rs = $task->{rs};
 116
 117     my $record = _fetch_record($conn, $rs, 0, $syn);
 118     my $ok = 0;
 119     if (!$record || $record->error()) {
 120         $conn->log("irspy_test", "retrieval of $syn record failed: ",
 121                    defined $record ? $record->exception() :
 122                                      $conn->exception());
 123     } else {
 124         $ok = 1;
 125         my $text = $record->render();
 126         $conn->log("irspy_test", "Successfully retrieved a $syn record");
 127         if (0) {
 128             print STDERR "Hits: ", $rs->size(), "\n";
 129             print STDERR "Syntax: ", $syn, "\n";
 130             print STDERR $text;
 131         }
 132     }
 133
 134     $conn->record()->store_result('record_fetch',
 135                                   'syntax'   => $syn,
 136                                   'ok'       => $ok);
 137
 138     $rs->destroy() if $udata->{last};
 139     return ($udata->{last} ?
 140             ZOOM::IRSpy::Status::TEST_GOOD :
 141             ZOOM::IRSpy::Status::TASK_DONE);
 142 }
 143
 144
 145 # By the time this is called, the record has already been physically
 146 # fetched from the server in the correct syntax, and placed in the
 147 # result-set's cache.  But in order to actually get hold of it from
 148 # that cache, we need to set the record-syntax again, to the same
 149 # value, otherwise ZOOM will make a fresh request.
 150 #
 151 # ZOOM::IRSpy::Task::Retrieve sets options into the connection object
 152 # rather than the result-set object (because it's a subclass of
 153 # ZOOM::IRSpy::Task, which doesn't know about result-sets).  Therefore
 154 # it's important that this function also set into the connection:
 155 # otherwise any value subsequently set into the connection by
 156 # ZOOM::IRSpy::Task::Retrieve will be ignored by ZOOM-C operations, as
 157 # the value previously set into the result-set will override it.
 158 # (This was the very subtle cause of bug #3534).
 159 #
 160 sub _fetch_record {
 161     my($conn, $rs, $index0, $syntax) = @_;
 162
 163     my $oldSyntax = $conn->option(preferredRecordSyntax => $syntax);
 164     my $record = $rs->record(0);
 165     $oldSyntax = "" if !defined $oldSyntax;
 166     $conn->option(preferredRecordSyntax => $oldSyntax);
 167
 168     return $record;
 169 }
 170
 171
 172 sub __UNUSED_search_error {
 173     my($conn, $task, $test_args, $exception) = @_;
 174
 175     $conn->log("irspy_test", "Initial search failed: ", $exception);
 176     return ZOOM::IRSpy::Status::TEST_SKIPPED;
 177 }
 178
 179
 180 sub fetch_error {
 181     my($conn, $task, $udata, $exception) = @_;
 182     my $syn = $udata->{'syntax'};
 183
 184     $conn->log("irspy_test", "Retrieval of $syn record failed: ", $exception);
 185     $conn->record()->store_result('record_fetch',
 186                                   'syntax'       => $syn,
 187                                   'ok'        => 0);
 188     $task->{rs}->destroy() if $udata->{last};
 189     return ZOOM::IRSpy::Status::TASK_DONE;
 190 }
 191
 192
 193 1;