lib/ZOOM/IRSpy/Test/ResultSet/Named.pm

   1
   2 # See the "Main" test package for documentation
   3
   4 package ZOOM::IRSpy::Test::ResultSet::Named;
   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
  14 sub start {
  15     my $class = shift();
  16     my($conn) = @_;
  17
  18     $conn->log('irspy_test', 'Testing for named resultset support');
  19
  20     $conn->irspy_search_pqf("\@attr 1=4 mineral", {},
  21                             {'setname' => 'a', 'start' => 0, 'count' => 0},
  22                             ZOOM::Event::ZEND, \&completed_search_a,
  23                             exception => \&error);
  24 }
  25
  26
  27 sub completed_search_a {
  28     my ($conn, $task, $test_args, $event) = @_;
  29     my $rs = $task->{rs};
  30     my $record = '';
  31     my $hits = $rs->size();
  32
  33     if ($hits == 0) {
  34         ### We should try other searches as in Record::Fetch
  35         $rs->destroy();
  36         return ZOOM::IRSpy::Status::TEST_BAD;
  37     } else {
  38         my $rsrec = $rs->record(0);
  39         if (!defined $rsrec) {
  40             # I thought this was a "can't happen", but it sometimes
  41             # does, as for example documented for
  42             # kat.vkol.cz:9909/svk02 at ../../../../../tmp/bad-run-1
  43             $rs->destroy();
  44             eval { $conn->check() };
  45             return error($conn, $task, $test_args, $@);
  46         }
  47         $record = $rsrec->raw();
  48     }
  49
  50     $conn->irspy_search_pqf("\@attr 1=4 4ds9da94",
  51                             {'record_a' => $record, 'hits_a' => $hits,
  52                              'rs_a' => $rs},
  53                             {'setname' => 'b'},
  54                             ZOOM::Event::ZEND, \&completed_search_b,
  55                             exception => \&error);
  56
  57     return ZOOM::IRSpy::Status::TASK_DONE;
  58 }
  59
  60
  61 sub completed_search_b {
  62     my($conn, $task, $test_args, $event) = @_;
  63     my $rs = $test_args->{rs_a};
  64     my $record = '';
  65     my $error = '';
  66
  67     $task->{rs}->destroy();     # We only care about the original search
  68     $rs->cache_reset();
  69
  70     if ($test_args->{'hits_a'} == 0) {
  71         die "can't happen: hits_a == 0";
  72     } else {
  73         my $hits = $rs->size();
  74         my $rsrec = $rs->record(0);
  75         if (!defined $rsrec) {
  76             $rs->destroy();
  77             eval { $conn->check() };
  78             return error($conn, $task, $test_args, $@);
  79         }
  80         my $record = $rsrec->raw();
  81
  82         if ($hits != $test_args->{'hits_a'}) {
  83             $conn->log('irspy_test', 'Named result set not supported: ',
  84                                      'Mis-matching hit counts');
  85             $error = 'hitcount';
  86         }
  87
  88         if (!defined $record || $record ne $test_args->{'record_a'}) {
  89             $conn->log('irspy_test', 'Named result set not supported: ',
  90                                      'Mis-matching records');
  91             $error = 'record';
  92         }
  93     }
  94
  95     update($conn, $error eq '' ? 1 : 0, $error);
  96
  97     $rs->destroy();
  98     return ZOOM::IRSpy::Status::TASK_DONE;
  99 }
 100
 101
 102 sub error {
 103     my($conn, $task, $test_args, $exception) = @_;
 104
 105     $conn->log("irspy_test", "Named resultset check failed:", $exception);
 106     zoom_error_timeout_update($conn, $exception);
 107     return ZOOM::IRSpy::Status::TASK_DONE;
 108 }
 109
 110
 111 sub update {
 112     my ($conn, $ok, $error) = @_;
 113     my %args = ('ok' => $ok);
 114
 115     if (!$ok) {
 116         $args{'error'} = $error;
 117     }
 118
 119     $conn->record()->store_result('named_resultset', %args);
 120 }
 121
 122 1;