From: Anders S. Mortensen <sondberg@indexdata.dk>
Date: Thu, 2 Nov 2006 11:46:40 +0000 (+0000)
Subject: Adding named result set test.
X-Git-Tag: CPAN-v1.02~846
X-Git-Url: http://lists.indexdata.com/cgi-bin?a=commitdiff_plain;h=eb28bd29ed17e00209d4a95f8ebe4046cdb8319d;p=irspy-moved-to-github.git

Adding named result set test.
---

diff --git a/lib/ZOOM/IRSpy/Test/Main.pm b/lib/ZOOM/IRSpy/Test/Main.pm
index 8973b45..f49090a 100644
--- a/lib/ZOOM/IRSpy/Test/Main.pm
+++ b/lib/ZOOM/IRSpy/Test/Main.pm
@@ -1,4 +1,4 @@
-# $Id: Main.pm,v 1.12 2006-10-26 12:50:17 mike Exp $
+# $Id: Main.pm,v 1.13 2006-11-02 11:46:40 sondberg Exp $
 
 package ZOOM::IRSpy::Test::Main;
 
@@ -24,8 +24,7 @@ I<## To follow>
 
 =cut
 
-sub subtests { qw(Ping Search::Main Record::Main) }
-#sub subtests { qw(Ping Search::Explain Record::Fetch) } # Nice, small example of old Explain-failure
+sub subtests { qw(Ping Search::Main Record::Main ResultSet::Main) }
 
 sub start {
     my $class = shift();
diff --git a/lib/ZOOM/IRSpy/Test/ResultSet/Main.pm b/lib/ZOOM/IRSpy/Test/ResultSet/Main.pm
new file mode 100644
index 0000000..7b3e3ab
--- /dev/null
+++ b/lib/ZOOM/IRSpy/Test/ResultSet/Main.pm
@@ -0,0 +1,56 @@
+# $Id: Main.pm,v 1.1 2006-11-02 11:46:40 sondberg Exp $
+
+package ZOOM::IRSpy::Test::ResultSet::Main;
+
+use 5.008;
+use strict;
+use warnings;
+
+use ZOOM::IRSpy::Test;
+our @ISA = qw(ZOOM::IRSpy::Test);
+
+
+=head1 NAME
+
+ZOOM::IRSpy::Test::Main - a single test for IRSpy
+
+=head1 SYNOPSIS
+
+ ## To follow
+
+=head1 DESCRIPTION
+
+I<## To follow>
+
+=cut
+
+sub subtests { qw(ResultSet::Named) }
+
+sub start {
+    my $class = shift();
+    my($conn) = @_;
+
+    $conn->log("irspy_test", "Main test no-opping");
+    # Do nothing -- this test is just a subtest container
+}
+
+
+=head1 SEE ALSO
+
+ZOOM::IRSpy
+
+=head1 AUTHOR
+
+Mike Taylor, E<lt>mike@indexdata.comE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2006 by Index Data ApS.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.7 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
+
+1;
diff --git a/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm b/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm
new file mode 100644
index 0000000..3a5a950
--- /dev/null
+++ b/lib/ZOOM/IRSpy/Test/ResultSet/Named.pm
@@ -0,0 +1,100 @@
+# $Id: Named.pm,v 1.1 2006-11-02 11:46:40 sondberg Exp $
+
+# See the "Main" test package for documentation
+
+package ZOOM::IRSpy::Test::ResultSet::Named;
+
+use 5.008;
+use strict;
+use warnings;
+
+use ZOOM::IRSpy::Test;
+our @ISA = qw(ZOOM::IRSpy::Test);
+
+
+sub start {
+    my $class = shift();
+    my($conn) = @_;
+
+    $conn->log('irspy_test', 'Testing for named resultset support');
+
+    $conn->irspy_search_pqf("\@attr 1=4 mineral", {},
+                            {'setname' => 'a', 'start' => 0, 'count' => 0},	
+			    ZOOM::Event::RECV_SEARCH, \&completed_search_a,
+			    exception => \&error);
+}
+
+
+sub completed_search_a {
+    my ($conn, $task, $test_args, $event) = @_;
+    my $rs = $task->{rs};
+    my $record = '';
+    my $hits = $rs->size();
+
+    ## How should be handle the situation when there is 0 hits?
+    if ($hits > 0) {
+        $record = $rs->record(0)->raw(); 
+    } 
+
+    $conn->irspy_search_pqf("\@attr 1=4 4ds9da94",
+                            {'record_a' => $record, 'hits_a' => $hits,
+                             'rs_a' => $rs},
+                            {'setname' => 'b'},	
+			    ZOOM::Event::RECV_SEARCH, \&completed_search_b,
+			    exception => \&error);
+
+    return ZOOM::IRSpy::Status::TASK_DONE;
+}
+
+
+sub completed_search_b {
+    my($conn, $task, $test_args, $event) = @_;
+    my $rs = $test_args->{rs_a};
+    my $record = '';
+    my $error = '';
+
+    $rs->cache_reset();
+
+    if ($test_args->{'hits_a'} > 0) {
+        my $hits = $rs->size();
+        my $record = $rs->record(0)->raw();
+
+        if ($hits != $test_args->{'hits_a'}) {
+            $conn->log('irspy_test', 'Named result set not supported: ',
+                                     'Mis-matching hit counts');
+            $error = 'hitcount';
+        }
+
+        if ($record ne $test_args->{'record_a'}) {
+            $conn->log('irspy_test', 'Named result set not supported: ',
+                                     'Mis-matching records');
+            $error = 'record';
+        }
+    }
+
+    update($conn, $error eq '' ? 1 : 0, $error);
+
+    return ZOOM::IRSpy::Status::TASK_DONE;
+}
+
+
+sub error {
+    my($conn, $task, $test_args, $exception) = @_;
+
+    $conn->log("irspy_test", "Named resultset check failed:", $exception);
+    return ZOOM::IRSpy::Status::TASK_DONE;
+}
+
+
+sub update {
+    my ($conn, $ok, $error) = @_;
+    my %args = ('ok' => $ok);
+
+    if (!$ok) {
+        $args{'error'} = $error;
+    }
+
+    $conn->record()->store_result('named_resultset', %args); 
+}
+
+1;
diff --git a/xsl/irspy2zeerex.xsl b/xsl/irspy2zeerex.xsl
index a76c27a..939f462 100644
--- a/xsl/irspy2zeerex.xsl
+++ b/xsl/irspy2zeerex.xsl
@@ -1,6 +1,6 @@
 <?xml version="1.0"?>
 <!--
-    $Id: irspy2zeerex.xsl,v 1.10 2006-11-02 08:28:20 sondberg Exp $
+    $Id: irspy2zeerex.xsl,v 1.11 2006-11-02 11:46:41 sondberg Exp $
 
     This stylesheet is used by IRSpy to map the internal mixed Zeerex/IRSpy
     record format into the Zeerex record which we store.
@@ -88,6 +88,7 @@
     <irspy:status>
       <xsl:for-each select="*/irspy:probe   |
                             */irspy:boolean |
+                            */irspy:named_resultset |
                             */irspy:explain">
         <xsl:copy-of select="."/>
       </xsl:for-each>