grs_test.pl

   1 #!/usr/bin/perl -w
   2
   3 use ExtUtils::testlib;
   4 use Net::Z3950::SimpleServer;
   5 use Net::Z3950::OID;
   6 use Net::Z3950::GRS1;
   7 use strict;
   8
   9
  10 sub dump_hash {
  11         my $href = shift;
  12         my $key;
  13
  14         foreach $key (keys %$href) {
  15                 printf("%10s    =>      %s\n", $key, $href->{$key});
  16         }
  17 }
  18
  19
  20 sub my_init_handler {
  21         my $args = shift;
  22         my $session = {};
  23
  24         $args->{IMP_NAME} = "DemoServer";
  25         $args->{IMP_VER} = "3.14159";
  26         $args->{ERR_CODE} = 0;
  27         $args->{HANDLE} = $session;
  28 }
  29
  30 sub my_search_handler {
  31         my $args = shift;
  32         my $data = [{
  33                         name            =>      "Peter Dornan",
  34                         title           =>      "Spokesman",
  35                         collaboration   =>      "ATLAS"
  36                     }, {
  37                         name            =>      "Jorn Dines Hansen",
  38                         title           =>      "Professor",
  39                         collaboration   =>      "HERA-B"
  40                     }, {
  41                         name            =>      "Alain Blondel",
  42                         title           =>      "Head of coll.",
  43                         collaboration   =>      "ALEPH"
  44                     }];
  45
  46         my $session = $args->{HANDLE};
  47         my $set_id = $args->{SETNAME};
  48         my @database_list = @{ $args->{DATABASES} };
  49         my $query = $args->{QUERY};
  50         my $hits = 3;
  51
  52         print "------------------------------------------------------------\n";
  53         print "Processing query : $query\n";
  54         printf("Database set     : %s\n", join(" ", @database_list));
  55         print "Setname          : $set_id\n";
  56         print "------------------------------------------------------------\n";
  57
  58         $args->{HITS} = $hits;
  59         $session->{$set_id} = $data;
  60         $session->{__HITS} = $hits;
  61 }
  62
  63
  64 sub my_fetch_handler {
  65         my $args = shift;
  66         my $session = $args->{HANDLE};
  67         my $set_id = $args->{SETNAME};
  68         my $data = $session->{$set_id};
  69         my $offset = $args->{OFFSET};
  70         my $grs1 = new Net::Z3950::GRS1;
  71         my $grs2 = new Net::Z3950::GRS1;
  72         my $grs3 = new Net::Z3950::GRS1;
  73         my $grs4 = new Net::Z3950::GRS1;
  74         my $field;
  75         my $record;
  76         my $hits = $session->{__HITS};
  77         my $href = $data->[$offset - 1];
  78
  79         $args->{REP_FORM} = Net::Z3950::OID::grs1;
  80         foreach $field (keys %$href) {
  81                 $grs1->AddElement(1, $field, &Net::Z3950::GRS1::ElementData::String, $href->{$field});
  82         }
  83         $grs4->AddElement(4,1, &Net::Z3950::GRS1::ElementData::String, "Level 4");
  84         $grs4->AddElement(4,2, &Net::Z3950::GRS1::ElementData::String, "Lige et felt mere");
  85         $grs3->AddElement(3,1, &Net::Z3950::GRS1::ElementData::String, "Mit navn er Svend Gønge");
  86         $grs3->AddElement(3,1, &Net::Z3950::GRS1::ElementData::Subtree, $grs4);
  87         $grs3->AddElement(3,1, &Net::Z3950::GRS1::ElementData::String, "Og det er bare dejligt");
  88         $grs2->AddElement(2,1, &Net::Z3950::GRS1::ElementData::Subtree, $grs3);
  89         $grs2->AddElement(2,2, &Net::Z3950::GRS1::ElementData::String, "Underfelt");
  90         $grs1->AddElement(1, 'subfield', &Net::Z3950::GRS1::ElementData::Subtree, $grs2);
  91         $grs1->AddElement(1, 10, &Net::Z3950::GRS1::ElementData::String, 'Imle bimle bumle');
  92         $grs1->Render(POOL => \$record);
  93         $args->{RECORD} = $record;
  94         if ($offset == $session->{__HITS}) {
  95                 $args->{LAST} = 1;
  96         }
  97 }
  98
  99
 100 my $handler = new Net::Z3950::SimpleServer(
 101                 INIT    =>      \&my_init_handler,
 102                 SEARCH  =>      \&my_search_handler,
 103                 FETCH   =>      \&my_fetch_handler );
 104
 105 $handler->launch_server("ztest.pl", @ARGV);
 106
 107
 108 ## $Log: grs_test.pl,v $
 109 ## Revision 1.2  2001-09-11 13:07:07  sondberg
 110 ## Minor changes.
 111 ##
 112 ## Revision 1.1  2001/03/13 14:19:28  sondberg
 113 ## Added a modified version of ztest.pl called grs_test.pl, which shows how to
 114 ## implement support of GRS-1 record syntax.
 115 ##
 116