Added a reasonable test script: ztest.pl

diff --git a/SimpleServer.pm b/SimpleServer.pm
index 9dcfe5e..b2c27a1 100644 (file)
--- a/SimpleServer.pm
+++ b/SimpleServer.pm
@@ -122,7 +122,6 @@ Net::Z3950::SimpleServer - Simple Perl API for building Z39.50 servers.
        my $record = fetch_a_record($args->{OFFSET);
 
        $args->{RECORD} = $record;
-       $args->{LEN} = length($record);
        if (number_of_hits() == $args->{OFFSET}) {      ## Last record in set?
                $args->{LAST} = 1;
        } else {

diff --git a/ztest.pl b/ztest.pl
index 27446d4..486ff11 100755 (executable)
--- a/ztest.pl
+++ b/ztest.pl
@@ -1,136 +1,83 @@
 #!/usr/bin/perl -w
+
 use ExtUtils::testlib;
 use Net::Z3950::SimpleServer;
 use Net::Z3950::OID;
-
-
-sub udskriv_hash {
-
-       my $href = shift;
-       my $key;
-       my $item;
-
-       foreach $key (keys %{ $href }) {
-               print "$key = ";
-               if ($key eq "DATABASES") {
-                       foreach $item ( @{ $href->{DATABASES} }) {
-                               print "$item  ";
-                       }
-                       print "\n";
-               } elsif ($key eq "HANDLE") {
-                       foreach $item ( keys %{ $href->{HANDLE} }) {
-                               print "        $item  => ";
-                               print ${ $href->{HANDLE}}{$item};
-                               print "\n";
-                       }
-               } else {
-                       print $href->{$key};
-                       print "\n";
-               }
-       }
-}
-
-
+use strict;
 
 sub my_init_handler {
+       my $args = shift;
+       my $session = {};
 
-       my $href = shift;
-       my $hash = {};
-
-       $hash->{Anders} = "Sønderberg Mortensen";
-       $hash->{Birgit} = "Stenhøj Andersen";
-       $href->{IMP_NAME} = "MyServer";
-       $href->{IMP_VER} = "3.14159";
-       $href->{ERR_CODE} = 0;
-       $href->{HANDLE} = $hash;
-       print "\n";
-       print "---------------------------------------------------------------\n";
-       print "Connection established\n";
-       print "\n";
-       udskriv_hash($href);
-       print "---------------------------------------------------------------\n";
+       $args->{IMP_NAME} = "DemoServer";
+       $args->{IMP_VER} = "3.14159";
+       $args->{ERR_CODE} = 0;
+       $args->{HANDLE} = $session;
 }
 
 sub my_search_handler { 
+       my $args = shift;
+       my $data = [{
+                       name            =>      "Peter Dornan",
+                       title           =>      "Spokesman",
+                       collaboration   =>      "ATLAS"
+                   }, {
+                       name            =>      "Jorn Dines Hansen",
+                       title           =>      "Professor",
+                       collaboration   =>      "HERA-B"
+                   }, {
+                       name            =>      "Alain Blondel",
+                       title           =>      "Head of coll.",
+                       collaboration   =>      "ALEPH"
+                   }];
+
+       my $session = $args->{HANDLE};
+       my $set_id = $args->{SETNAME};
+       my @database_list = @{ $args->{DATABASES} };
+       my $query = $args->{QUERY};
+       my $hits = 3;
 
-       my $href = shift;
-       my $key;
-       my $hash = $href->{HANDLE};
-#      my $hash = {};
-
-       $href->{HITS} = 1;
-       $href->{ERR_STR} = "A";
-       $hash->{Search} = "Search Handler er besøgt";
-#      $href->{HANDLE} = $hash;
-       print "\n";
-       print "---------------------------------------------------------------\n";
-       print "Search handler\n";
-       print "\n";
-       udskriv_hash($href);
-       print "---------------------------------------------------------------\n";
-}
-
-
-sub my_present_handler {
-       my $href = shift;
-
-       $href->{ERR_CODE} = 0;
-
-       $href->{ERR_STR} = "";
-       print "\n";
-       print "--------------------------------------------------------------\n";
-       print "Present handler\n";
-       print "\n";
-       udskriv_hash($href);
-       print "--------------------------------------------------------------\n";
-       return;
-}
-
-sub my_close_handler {
-       my $href = shift;
-
-       print "\n";
-       print "-------------------------------------------------------------\n";
-       print "Connection closed\n";
-       print "\n";
-       udskriv_hash($href);
-       print "-------------------------------------------------------------\n";
+       print "------------------------------------------------------------\n";
+       print "Processing query : $query\n";
+       printf("Database set     : %s\n", join(" ", @database_list));
+       print "Setname          : $set_id\n";
+       print "------------------------------------------------------------\n";
 
+       $args->{HITS} = $hits;
+       $session->{$set_id} = $data;
+       $session->{__HITS} = $hits;
 }
 
 
 sub my_fetch_handler {
-       my $href = shift;
-       my $hash = $href->{HANDLE};
-
-       $hash->{Fetch} = "Fetch handler er besøgt";
-       ##$href->{RECORD} = "<head>Overskrift</head> <text>Her kommer teksten</text>";
-       $href->{RECORD} = "<xml><head>Overskrift</head><body>Der var engang en mand</body></xml>";
-       $href->{NUMBER} = 1;
-       $href->{BASENAME} = "MS-Gud";
-       $href->{LAST} = 1;
-       ## $href->{HANDLE} = \%hash;
-       print "\n";
-       print "------------------------------------------------------------\n";
-       print "Fetch handler\n";
-       print "\n";
-       udskriv_hash($href);
-       if ($href->{REQ_FORM} eq Net::Z3950::OID::unimarc) {
-               print "Formatet UNIMARC\n";
-       } else {
-               print "Formatet er IKKE unimarc\n";
+       my $args = shift;
+       my $session = $args->{HANDLE};
+       my $set_id = $args->{SETNAME};
+       my $data = $session->{$set_id};
+       my $offset = $args->{OFFSET};
+       my $record = "<xml>";
+       my $field;
+       my $hits = $session->{__HITS};
+       my $href = $data->[$offset];
+
+       $args->{REP_FORM} = Net::Z3950::OID::xml;
+
+       foreach $field (keys %$href) {
+               $record .= "<" . $field . ">" . $href->{$field} . "</" . $field . ">";
        }
-       print "------------------------------------------------------------\n";
-       
-}
 
+       $record .= "</xml>";
+       $args->{RECORD} = $record;
+       if ($offset == $session->{__HITS}) {
+               $args->{LAST} = 1;
+       }
+}
 
 
-my $handler = Net::Z3950::SimpleServer->new({ INIT     =>      \&my_init_handler,
-                               CLOSE   =>      \&my_close_handler,
-                               SEARCH  =>      \&my_search_handler,
-                           FETCH       =>      \&my_fetch_handler
-                         });
+my $handler = Net::Z3950::SimpleServer->new({ 
+               INIT    =>      \&my_init_handler,
+               SEARCH  =>      \&my_search_handler,
+               FETCH   =>      \&my_fetch_handler });
 
 $handler->launch_server("ztest.pl", @ARGV);