From 191029ee1ff351327632cb49127c7bc541b6a9b3 Mon Sep 17 00:00:00 2001 From: "Anders S. Mortensen" Date: Wed, 25 Oct 2006 12:44:55 +0000 Subject: [PATCH] Implemented ExplainCategory probing. --- lib/ZOOM/IRSpy/Test/Search/Explain.pm | 69 +++++++++++++++++++++++++++++++++ lib/ZOOM/IRSpy/Test/Search/Main.pm | 5 ++- 2 files changed, 72 insertions(+), 2 deletions(-) create mode 100644 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 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(); -- 1.7.10.4