Add licence.
[simpleserver-moved-to-github.git] / 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