+#!/usr/bin/perl -w
+
+use ExtUtils::testlib;
+use Net::Z3950::SimpleServer;
+use Net::Z3950::OID;
+use Net::Z3950::GRS1;
+use strict;
+
+
+sub dump_hash {
+ my $href = shift;
+ my $key;
+
+ foreach $key (keys %$href) {
+ printf("%10s => %s\n", $key, $href->{$key});
+ }
+}
+
+
+sub my_init_handler {
+ my $args = shift;
+ my $session = {};
+
+ $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;
+
+ 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 $args = shift;
+ my $session = $args->{HANDLE};
+ my $set_id = $args->{SETNAME};
+ my $data = $session->{$set_id};
+ my $offset = $args->{OFFSET};
+ my $grs1 = new Net::Z3950::GRS1;
+ my $grs2 = new Net::Z3950::GRS1;
+ my $grs3 = new Net::Z3950::GRS1;
+ my $grs4 = new Net::Z3950::GRS1;
+ my $field;
+ my $record;
+ my $hits = $session->{__HITS};
+ my $href = $data->[$offset - 1];
+
+ $args->{REP_FORM} = Net::Z3950::OID::grs1;
+ foreach $field (keys %$href) {
+ $grs1->AddElement(1, $field, &Net::Z3950::GRS1::ElementData::String, $href->{$field});
+ }
+ $grs4->AddElement(4,1, &Net::Z3950::GRS1::ElementData::String, "Level 4");
+ $grs4->AddElement(4,2, &Net::Z3950::GRS1::ElementData::String, "Lige et felt mere");
+ $grs3->AddElement(3,1, &Net::Z3950::GRS1::ElementData::String, "Mit navn er Svend Gønge");
+ $grs3->AddElement(3,1, &Net::Z3950::GRS1::ElementData::Subtree, $grs4);
+ $grs3->AddElement(3,1, &Net::Z3950::GRS1::ElementData::String, "Og det er bare dejligt");
+ $grs2->AddElement(2,1, &Net::Z3950::GRS1::ElementData::Subtree, $grs3);
+ $grs2->AddElement(2,2, &Net::Z3950::GRS1::ElementData::String, "Underfelt");
+ $grs1->AddElement(1, 'subfield', &Net::Z3950::GRS1::ElementData::Subtree, $grs2);
+ $grs1->AddElement(1, 10, &Net::Z3950::GRS1::ElementData::String, 'Imle bimle bumle');
+ $grs1->Render(POOL => \$record);
+ $args->{RECORD} = $record;
+ if ($offset == $session->{__HITS}) {
+ $args->{LAST} = 1;
+ }
+}
+
+
+my $handler = Net::Z3950::SimpleServer->new({
+ INIT => \&my_init_handler,
+ SEARCH => \&my_search_handler,
+ FETCH => \&my_fetch_handler });
+
+$handler->launch_server("ztest.pl", @ARGV);
+
+
+## $Log: grs_test.pl,v $
+## Revision 1.1 2001-03-13 14:19:28 sondberg
+## Added a modified version of ztest.pl called grs_test.pl, which shows how to
+## implement support of GRS-1 record syntax.
+##
+