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