From: Anders S. Mortensen <sondberg@indexdata.dk>
Date: Wed, 25 Oct 2006 12:44:55 +0000 (+0000)
Subject: Implemented ExplainCategory probing.
X-Git-Tag: CPAN-v1.02~54^2~863
X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=e3621dfcffc65dff8191cd5d97ca0a9dbb1e6fd6

Implemented ExplainCategory probing.
---

diff --git a/lib/ZOOM/IRSpy/Test/Search/Explain.pm b/lib/ZOOM/IRSpy/Test/Search/Explain.pm
new file mode 100644
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;
diff --git a/lib/ZOOM/IRSpy/Test/Search/Main.pm b/lib/ZOOM/IRSpy/Test/Search/Main.pm
index 72b4742..f96465a 100644
--- a/lib/ZOOM/IRSpy/Test/Search/Main.pm
+++ b/lib/ZOOM/IRSpy/Test/Search/Main.pm
@@ -1,4 +1,4 @@
-# $Id: Main.pm,v 1.5 2006-10-25 10:09:45 sondberg Exp $
+# $Id: Main.pm,v 1.6 2006-10-25 12:44:55 sondberg Exp $
 
 package ZOOM::IRSpy::Test::Search::Main;
 
@@ -9,7 +9,8 @@ use warnings;
 use ZOOM::IRSpy::Test;
 our @ISA = qw(ZOOM::IRSpy::Test);
 
-sub subtests { qw(Search::Title Search::Bib1 Search::Dan1 Search::Boolean) }
+sub subtests { qw(Search::Title Search::Bib1 Search::Dan1 Search::Boolean
+                  Search::Explain) }
 
 sub start {
     my $class = shift();