Fix variable-name typo, caused infinite retry loop after bad search.
[irspy-moved-to-github.git] / lib / ZOOM / IRSpy / Test / Record / Fetch.pm
1 # $Id: Fetch.pm,v 1.23 2007-02-13 16:49:14 mike Exp $
2
3 # See the "Main" test package for documentation
4
5 package ZOOM::IRSpy::Test::Record::Fetch;
6
7 use 5.008;
8 use strict;
9 use warnings;
10
11 use ZOOM::IRSpy::Test;
12 our @ISA = qw(ZOOM::IRSpy::Test);
13
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                ### We can add more queries here
21                );
22
23
24 sub start {
25     my $class = shift();
26     my($conn) = @_;
27
28     # Here I want to get a use attribute from the session, which we've
29     # managed to search for in the Search/Bib1 or Search/Dan1 tests.
30     # But how?  So far we search for title: 1=4
31     $conn->irspy_search_pqf($queries[0], { queryindex => 0 }, {},
32                             ZOOM::Event::RECV_SEARCH, \&completed_search,
33                             exception => \&completed_search);
34 }
35
36
37 sub completed_search {
38     my($conn, $task, $udata, $event) = @_;
39
40     my $n = $task->{rs}->size();
41     $conn->log("irspy_test", "Fetch test search found $n records");
42     if ($n == 0) {
43         my $qindex = $udata->{queryindex}+1;
44         my $q = $queries[$qindex];
45         return ZOOM::IRSpy::Status::TEST_SKIPPED
46             if !defined $q;
47
48         $conn->log("irspy_test", "Trying another search ...");
49         $conn->irspy_search_pqf($queries[$qindex], { queryindex => $qindex }, {},
50                                 ZOOM::Event::RECV_SEARCH, \&completed_search,
51                                 exception => \&completed_search);
52         return ZOOM::IRSpy::Status::TASK_DONE;
53     }
54
55     my @syntax = (
56                    'canmarc',
57                    'danmarc',
58                    'grs-1',
59                    'ibermarc',
60                    'intermarc',
61                    'jpmarc',
62                    'librismarc',
63                    'mab',
64                    'normarc',
65 #                   'opac',
66                    'picamarc',
67                    'rusmarc',
68                    'summary',
69                    'sutrs',
70                    'swemarc',
71                    'ukmarc',
72                    'unimarc',
73                    'usmarc',
74                    'xml'
75                 );
76     #@syntax = qw(grs-1 sutrs usmarc xml); # simplify for debugging
77     foreach my $i (0 ..$#syntax) {
78         my $syntax = $syntax[$i];
79         $conn->irspy_rs_record($task->{rs}, 0,
80                                { syntax => $syntax,
81                                  last => ($i == $#syntax) },
82                                { start => 0, count => 1,
83                                  preferredRecordSyntax => $syntax },
84                                 ZOOM::Event::RECV_RECORD, \&record,
85                                 exception => \&fetch_error);
86     }
87
88     return ZOOM::IRSpy::Status::TASK_DONE;
89 }
90
91
92 sub record {
93     my($conn, $task, $udata, $event) = @_;
94     my $syn = $udata->{'syntax'};
95     my $rs = $task->{rs};
96
97     my $record = _fetch_record($rs, 0, $syn);
98     my $ok = 0;
99     if ($record->error()) {
100         $conn->log("irspy_test", "retrieval of $syn record failed: ",
101                    $record->exception());
102     } else {
103         $ok = 1;
104         my $text = $record->render();
105         $conn->log("irspy_test", "Successfully retrieved a $syn record");
106         if (0) {
107             print STDERR "Hits: ", $rs->size(), "\n";
108             print STDERR "Syntax: ", $syn, "\n";
109             print STDERR $text;
110         }
111     }
112
113     $conn->record()->store_result('record_fetch',
114                                   'syntax'   => $syn,
115                                   'ok'       => $ok);
116
117     return ($udata->{last} ?
118             ZOOM::IRSpy::Status::TEST_GOOD :
119             ZOOM::IRSpy::Status::TASK_DONE);
120 }
121
122
123 sub _fetch_record {
124     my($rs, $index0, $syntax) = @_;
125
126     my $oldSyntax = $rs->option(preferredRecordSyntax => $syntax);
127     my $record = $rs->record(0);
128     $oldSyntax = "" if !defined $oldSyntax;
129     $rs->option(preferredRecordSyntax => $oldSyntax);
130
131     return $record;
132 }
133
134
135 sub __UNUSED_search_error {
136     my($conn, $task, $test_args, $exception) = @_;
137
138     $conn->log("irspy_test", "Initial search failed: ", $exception);
139     return ZOOM::IRSpy::Status::TEST_SKIPPED;
140 }
141
142
143 sub fetch_error {
144     my($conn, $task, $test_args, $exception) = @_;
145     my $syn = $test_args->{'syntax'};
146
147     $conn->log("irspy_test", "Retrieval of $syn record failed: ", $exception);
148     $conn->record()->store_result('record_fetch',
149                                   'syntax'       => $syn,
150                                   'ok'        => 0);
151     return ZOOM::IRSpy::Status::TASK_DONE;
152 }
153
154
155 1;