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

   1 # $Id: Named.pm,v 1.4 2007-03-08 14:51:01 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     ## How should we handle the situation when there is 0 hits?
  35     if ($hits > 0) {
  36         my $rsrec = $rs->record(0);
  37         if (!defined $rsrec) {
  38             # I thought this was a "can't happen", but it sometimes
  39             # does, as for example documented for
  40             # kat.vkol.cz:9909/svk02 at ../../../../../tmp/bad-run-1
  41             eval { $conn->check() };
  42             return error($conn, $task, $test_args, $@);
  43         }
  44         $record = $rsrec->raw();
  45     }
  46
  47     $conn->irspy_search_pqf("\@attr 1=4 4ds9da94",
  48                             {'record_a' => $record, 'hits_a' => $hits,
  49                              'rs_a' => $rs},
  50                             {'setname' => 'b'},
  51                             ZOOM::Event::ZEND, \&completed_search_b,
  52                             exception => \&error);
  53
  54     return ZOOM::IRSpy::Status::TASK_DONE;
  55 }
  56
  57
  58 sub completed_search_b {
  59     my($conn, $task, $test_args, $event) = @_;
  60     my $rs = $test_args->{rs_a};
  61     my $record = '';
  62     my $error = '';
  63
  64     $rs->cache_reset();
  65
  66     if ($test_args->{'hits_a'} > 0) {
  67         my $hits = $rs->size();
  68         my $rsrec = $rs->record(0);
  69         if (!defined $rsrec) {
  70             eval { $conn->check() };
  71             return error($conn, $task, $test_args, $@);
  72         }
  73         my $record = $rsrec->raw();
  74
  75         if ($hits != $test_args->{'hits_a'}) {
  76             $conn->log('irspy_test', 'Named result set not supported: ',
  77                                      'Mis-matching hit counts');
  78             $error = 'hitcount';
  79         }
  80
  81         if ($record ne $test_args->{'record_a'}) {
  82             $conn->log('irspy_test', 'Named result set not supported: ',
  83                                      'Mis-matching records');
  84             $error = 'record';
  85         }
  86     }
  87
  88     update($conn, $error eq '' ? 1 : 0, $error);
  89
  90     return ZOOM::IRSpy::Status::TASK_DONE;
  91 }
  92
  93
  94 sub error {
  95     my($conn, $task, $test_args, $exception) = @_;
  96
  97     $conn->log("irspy_test", "Named resultset check failed:", $exception);
  98     return ZOOM::IRSpy::Status::TASK_DONE;
  99 }
 100
 101
 102 sub update {
 103     my ($conn, $ok, $error) = @_;
 104     my %args = ('ok' => $ok);
 105
 106     if (!$ok) {
 107         $args{'error'} = $error;
 108     }
 109
 110     $conn->record()->store_result('named_resultset', %args);
 111 }
 112
 113 1;