lib/ZOOM/IRSpy/Test/Search/Explain.pm

   1
   2 # See the "Main" test package for documentation
   3
   4 package ZOOM::IRSpy::Test::Search::Explain;
   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     my @explain = qw(CategoryList TargetInfo DatabaseInfo SchemaInfo TagSetInfo
  18                      RecordSyntaxInfo AttributeSetInfo TermListInfo
  19                      ExtendedServicesInfo AttributeDetails TermListDetails
  20                      ElementSetDetails RetrivalRecordDetails SortDetails
  21                      Processing VariantSetInfo UnitSet);
  22
  23     foreach my $category (@explain) {
  24         $conn->irspy_search_pqf('@attr exp-1 1=1 ' . $category,
  25                                 {'category' => $category},
  26                                 { databaseName => 'IR-Explain-1' },
  27                                 ZOOM::Event::ZEND, \&found,
  28                                 exception => \&error);
  29     }
  30 }
  31
  32
  33 sub found {
  34     my($conn, $task, $test_args, $event) = @_;
  35     my $category = $test_args->{'category'};
  36
  37     my $n = $task->{rs}->size();
  38     $task->{rs}->destroy();
  39     my $ok = ($n > 0);
  40     $conn->log("irspy_test", "Explain category ", $category, " gave ", $n,
  41                " hit(s).");
  42
  43     update($conn, $category, $ok);
  44
  45     return ZOOM::IRSpy::Status::TASK_DONE;
  46 }
  47
  48
  49 sub error {
  50     my($conn, $task, $test_args, $exception) = @_;
  51     my $category = $test_args->{'category'};
  52
  53     $task->{rs}->destroy();
  54     $conn->log("irspy_test", "Explain category lookup failed: ", $exception);
  55     update($conn, $category, 0);
  56
  57     return ZOOM::IRSpy::Status::TEST_BAD
  58         if ($exception->code() == 109 || # Database unavailable
  59             $exception->code() == 235); # Database does not exist
  60
  61     return ZOOM::IRSpy::Status::TASK_DONE;
  62 }
  63
  64
  65 sub update {
  66     my ($conn, $category, $ok) = @_;
  67     $conn->record()->store_result('explain', 'category'  => $category,
  68                                              'ok'        => $ok);
  69 }
  70
  71 1;