Implemented ExplainCategory probing.

[irspy-moved-to-github.git] / lib / ZOOM / IRSpy / Test / Search / Explain.pm

diff --git a/lib/ZOOM/IRSpy/Test/Search/Explain.pm b/lib/ZOOM/IRSpy/Test/Search/Explain.pm
new file mode 100644 (file)
index 0000000..b665541
--- /dev/null
+++ b/lib/ZOOM/IRSpy/Test/Search/Explain.pm
@@ -0,0 +1,69 @@
+# $Id: Explain.pm,v 1.1 2006-10-25 12:44:55 sondberg Exp $
+
+# See the "Main" test package for documentation
+
+package ZOOM::IRSpy::Test::Search::Explain;
+
+use 5.008;
+use strict;
+use warnings;
+
+use ZOOM::IRSpy::Test;
+our @ISA = qw(ZOOM::IRSpy::Test);
+
+
+sub start {
+    my $class = shift();
+    my($conn) = @_;
+    my @explain = qw(CategoryList TargetInfo DatabaseInfo SchemaInfo TagSetInfo
+                     RecordSyntaxInfo AttributeSetInfo TermListInfo
+                     ExtendedServicesInfo AttributeDetails TermListDetails
+                     ElementSetDetails RetrivalRecordDetails SortDetails
+                     Processing VariantSetInfo UnitSet);
+
+    foreach my $category (@explain) {
+        $conn->option('databaseName', 'IR-Explain-1');
+       $conn->irspy_search_pqf('@attr exp-1 1=1 ' . $category,
+                                {'category' => $category}, {},
+                               ZOOM::Event::RECV_SEARCH, \&found,
+                               exception => \&error);
+    }
+}
+
+
+sub found {
+    my($conn, $task, $test_args, $event) = @_;
+    my $category = $test_args->{'category'};
+    my $n = $task->{rs}->size();
+    my $ok = 0;
+
+    $conn->log("irspy_test", "Explain category ", $category, " gave, ", $n,
+               " hit(s).");
+    if ($n > 0) {
+        $ok = 1;
+    }
+
+    update($conn, $category, $ok);
+
+    return ZOOM::IRSpy::Status::TASK_DONE;
+}
+
+
+sub error {
+    my($conn, $task, $test_args, $exception) = @_;
+    my $category = $test_args->{'category'};
+
+    $conn->log("irspy_test", "Explain category lookup failed: ", $exception);
+    update($conn, $category, 0);
+
+    return ZOOM::IRSpy::Status::TASK_DONE;
+}
+
+
+sub update {
+    my ($conn, $category, $ok) = @_;
+    $conn->record()->store_result('explain', 'category'  => $category,
+                                             'ok'        => $ok);
+}
+
+1;