87c04bd6be6767847c6cfb4a84af111a963b266d
[irspy-moved-to-github.git] / 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 # These queries 
16 my @queries = (
17                "\@attr 1=4 mineral",
18                "\@attr 1=4 computer",
19                "\@attr 1=44 mineral", # Smithsonian doesn't support AP 4!
20                "\@attr 1=1016 water", # Connector Framework only does 1016
21                ### We can add more queries here
22                );
23
24
25 sub start {
26     my $class = shift();
27     my($conn) = @_;
28
29     # Here I want to get a use attribute from the session, which we've
30     # managed to search for in the Search/Bib1 or Search/Dan1 tests.
31     # But how?  So far we search for title: 1=4
32     $conn->irspy_search_pqf($queries[0], { queryindex => 0 }, {},
33                             ZOOM::Event::ZEND, \&completed_search,
34                             exception => \&completed_search);
35 }
36
37
38 sub completed_search {
39     my($conn, $task, $udata, $event) = @_;
40
41     my $n = $task->{rs}->size();
42     $conn->log("irspy_test", "Fetch test search (", $task->render_query(), ") ",
43                ref $event && $event->isa("ZOOM::Exception") ?
44                "failed: $event" : "found $n records (event=$event)");
45
46     # remember how often a target record hit a timeout
47     if (ref $event && $event->isa("ZOOM::Exception")) {
48         if ($event =~ /Timeout/i) {
49             $conn->record->zoom_error->{TIMEOUT}++;
50             $conn->log("irspy_test", "Increase timeout error counter to: " . 
51                 $conn->record->zoom_error->{TIMEOUT});
52         }
53     }
54
55     if ($n == 0) {
56         $task->{rs}->destroy();
57         my $qindex = $udata->{queryindex}+1;
58         my $q = $queries[$qindex];
59         return ZOOM::IRSpy::Status::TEST_SKIPPED
60             if !defined $q || $conn->record->zoom_error->{TIMEOUT} >= $max_timeout_errors;
61
62         $conn->log("irspy_test", "Trying another search ...");
63         $conn->irspy_search_pqf($queries[$qindex], { queryindex => $qindex }, {},
64                                 ZOOM::Event::ZEND, \&completed_search,
65                                 exception => \&completed_search);
66         return ZOOM::IRSpy::Status::TASK_DONE;
67     }
68
69     my @syntax = (
70                    'canmarc',
71                    'danmarc',
72                    'grs-1',
73                    'ibermarc',
74                    'intermarc',
75                    'jpmarc',
76                    'librismarc',
77                    'mab',
78                    'normarc',
79 #                   'opac',
80                    'picamarc',
81                    'rusmarc',
82                    'summary',
83                    'sutrs',
84                    'swemarc',
85                    'ukmarc',
86                    'unimarc',
87                    'usmarc',
88                    'xml'
89                 );
90     #@syntax = qw(grs-1 sutrs usmarc xml); # simplify for debugging
91     foreach my $i (0 ..$#syntax) {
92         my $syntax = $syntax[$i];
93         $conn->irspy_rs_record($task->{rs}, 0,
94                                { syntax => $syntax,
95                                  last => ($i == $#syntax) },
96                                { start => 0, count => 1,
97                                  preferredRecordSyntax => $syntax },
98                                 ZOOM::Event::ZEND, \&record,
99                                 exception => \&fetch_error);
100     }
101
102     return ZOOM::IRSpy::Status::TASK_DONE;
103 }
104
105
106 sub record {
107     my($conn, $task, $udata, $event) = @_;
108     my $syn = $udata->{'syntax'};
109     my $rs = $task->{rs};
110
111     my $record = _fetch_record($rs, 0, $syn);
112     my $ok = 0;
113     if (!$record || $record->error()) {
114         $conn->log("irspy_test", "retrieval of $syn record failed: ",
115                    defined $record ? $record->exception() :
116                                      $conn->exception());
117     } else {
118         $ok = 1;
119         my $text = $record->render();
120         $conn->log("irspy_test", "Successfully retrieved a $syn record");
121         if (0) {
122             print STDERR "Hits: ", $rs->size(), "\n";
123             print STDERR "Syntax: ", $syn, "\n";
124             print STDERR $text;
125         }
126     }
127
128     $conn->record()->store_result('record_fetch',
129                                   'syntax'   => $syn,
130                                   'ok'       => $ok);
131
132     $rs->destroy() if $udata->{last};
133     return ($udata->{last} ?
134             ZOOM::IRSpy::Status::TEST_GOOD :
135             ZOOM::IRSpy::Status::TASK_DONE);
136 }
137
138
139 sub _fetch_record {
140     my($rs, $index0, $syntax) = @_;
141
142     my $oldSyntax = $rs->option(preferredRecordSyntax => $syntax);
143     my $record = $rs->record(0);
144     $oldSyntax = "" if !defined $oldSyntax;
145     $rs->option(preferredRecordSyntax => $oldSyntax);
146
147     return $record;
148 }
149
150
151 sub __UNUSED_search_error {
152     my($conn, $task, $test_args, $exception) = @_;
153
154     $conn->log("irspy_test", "Initial search failed: ", $exception);
155     return ZOOM::IRSpy::Status::TEST_SKIPPED;
156 }
157
158
159 sub fetch_error {
160     my($conn, $task, $udata, $exception) = @_;
161     my $syn = $udata->{'syntax'};
162
163     $conn->log("irspy_test", "Retrieval of $syn record failed: ", $exception);
164     $conn->record()->store_result('record_fetch',
165                                   'syntax'       => $syn,
166                                   'ok'        => 0);
167     $task->{rs}->destroy() if $udata->{last};
168     return ZOOM::IRSpy::Status::TASK_DONE;
169 }
170
171
172 1;