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