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

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