ztest.pl

   1 #!/usr/bin/perl -w
   2 use ExtUtils::testlib;
   3 use Net::Z3950::SimpleServer;
   4 use Net::Z3950::OID;
   5
   6
   7 sub udskriv_hash {
   8
   9         my $href = shift;
  10         my $key;
  11         my $item;
  12
  13         foreach $key (keys %{ $href }) {
  14                 print "$key = ";
  15                 if ($key eq "DATABASES") {
  16                         foreach $item ( @{ $href->{DATABASES} }) {
  17                                 print "$item  ";
  18                         }
  19                         print "\n";
  20                 } elsif ($key eq "HANDLE") {
  21                         foreach $item ( keys %{ $href->{HANDLE} }) {
  22                                 print "        $item  => ";
  23                                 print ${ $href->{HANDLE}}{$item};
  24                                 print "\n";
  25                         }
  26                 } else {
  27                         print $href->{$key};
  28                         print "\n";
  29                 }
  30         }
  31 }
  32
  33
  34
  35 sub my_init_handler {
  36
  37         my $href = shift;
  38         my $hash = {};
  39
  40         $hash->{Anders} = "Sønderberg Mortensen";
  41         $hash->{Birgit} = "Stenhøj Andersen";
  42         $href->{IMP_NAME} = "MyServer";
  43         $href->{IMP_VER} = "3.14159";
  44         $href->{ERR_CODE} = 0;
  45         $href->{HANDLE} = $hash;
  46         print "\n";
  47         print "---------------------------------------------------------------\n";
  48         print "Connection established\n";
  49         print "\n";
  50         udskriv_hash($href);
  51         print "---------------------------------------------------------------\n";
  52 }
  53
  54 sub my_search_handler {
  55
  56         my $href = shift;
  57         my $key;
  58         my $hash = $href->{HANDLE};
  59 #       my $hash = {};
  60
  61         $href->{HITS} = 1;
  62         $href->{ERR_STR} = "A";
  63         $hash->{Search} = "Search Handler er besøgt";
  64 #       $href->{HANDLE} = $hash;
  65         print "\n";
  66         print "---------------------------------------------------------------\n";
  67         print "Search handler\n";
  68         print "\n";
  69         udskriv_hash($href);
  70         print "---------------------------------------------------------------\n";
  71 }
  72
  73
  74 sub my_present_handler {
  75         my $href = shift;
  76
  77         $href->{ERR_CODE} = 0;
  78
  79         $href->{ERR_STR} = "";
  80         print "\n";
  81         print "--------------------------------------------------------------\n";
  82         print "Present handler\n";
  83         print "\n";
  84         udskriv_hash($href);
  85         print "--------------------------------------------------------------\n";
  86         return;
  87 }
  88
  89 sub my_close_handler {
  90         my $href = shift;
  91
  92         print "\n";
  93         print "-------------------------------------------------------------\n";
  94         print "Connection closed\n";
  95         print "\n";
  96         udskriv_hash($href);
  97         print "-------------------------------------------------------------\n";
  98
  99 }
 100
 101
 102 sub my_fetch_handler {
 103         my $href = shift;
 104         my $hash = $href->{HANDLE};
 105
 106         $hash->{Fetch} = "Fetch handler er besøgt";
 107         ##$href->{RECORD} = "<head>Overskrift</head> <text>Her kommer teksten</text>";
 108         $href->{RECORD} = "<xml><head>Overskrift</head><body>Der var engang en mand</body></xml>";
 109         $href->{NUMBER} = 1;
 110         $href->{BASENAME} = "MS-Gud";
 111         $href->{LAST} = 1;
 112         ## $href->{HANDLE} = \%hash;
 113         print "\n";
 114         print "------------------------------------------------------------\n";
 115         print "Fetch handler\n";
 116         print "\n";
 117         udskriv_hash($href);
 118         if ($href->{REQ_FORM} eq Net::Z3950::OID::unimarc) {
 119                 print "Formatet UNIMARC\n";
 120         } else {
 121                 print "Formatet er IKKE unimarc\n";
 122         }
 123         print "------------------------------------------------------------\n";
 124
 125 }
 126
 127
 128
 129 my $handler = Net::Z3950::SimpleServer->new({ INIT      =>      \&my_init_handler,
 130                                 CLOSE   =>      \&my_close_handler,
 131                                 SEARCH  =>      \&my_search_handler,
 132                             FETCH       =>      \&my_fetch_handler
 133                           });
 134
 135 $handler->launch_server("ztest.pl", @ARGV);
 136