test.pl

   1 # Before `make install' is performed this script should be runnable with
   2 # `make test'. After `make install' it should work as `perl test.pl'
   3
   4 ######################### We start with some black magic to print on failure.
   5
   6 # Change 1..1 below to 1..last_test_to_print .
   7 # (It may become useful if the test is moved to ./t subdirectory.)
   8
   9 BEGIN { $| = 1; print "1..4\n"; }
  10 END {print "not ok 1\n" unless $loaded;}
  11 use Net::Z3950::SimpleServer;
  12 $loaded = 1;
  13 print "ok 1\n";
  14
  15 ######################### End of black magic.
  16
  17 print "not " if Net::Z3950::SimpleServer::yaz_diag_srw_to_bib1(11) != 3;
  18 print "ok 2\n";
  19
  20 print "not " if Net::Z3950::SimpleServer::yaz_diag_bib1_to_srw(3) != 11;
  21 print "ok 3\n";
  22
  23 # Insert your test code below (better if it prints "ok 13"
  24 # (correspondingly "not ok 13") depending on the success of chunk 13
  25 # of the test code):
  26
  27 sub my_init_handler {
  28         my $href = shift;
  29         my %log = ();
  30
  31         $log{"init"} = "Ok";
  32         $href->{HANDLE} = \%log;
  33 }
  34
  35 sub my_search_handler {
  36         my $href = shift;
  37         my %log = %{$href->{HANDLE}};
  38
  39         $log{"search"} = "Ok";
  40         $href->{HANDLE} = \%log;
  41         $href->{HITS} = 1;
  42 }
  43
  44 sub my_fetch_handler {
  45         my $href = shift;
  46         my %log = %{$href->{HANDLE}};
  47         my $record = "<xml><head>Headline</head><body>I am a record</body></xml>";
  48
  49         $log{"fetch"} = "Ok";
  50         $href->{HANDLE} = \%log;
  51         $href->{RECORD} = $record;
  52         $href->{LEN} = length($record);
  53         $href->{NUMBER} = 1;
  54         $href->{BASENAME} = "Test";
  55 }
  56
  57 sub my_close_handler {
  58         my @services = ("init", "search", "fetch", "close");
  59         my $href = shift;
  60         my %log = %{$href->{HANDLE}};
  61         my $status;
  62         my $service;
  63         my $error = 0;
  64
  65         $log{"close"} = "Ok";
  66
  67         print "\n-----------------------------------------------\n";
  68         print "Available Z39.50 services:\n\n";
  69
  70         foreach $service (@services) {
  71                 print "Called $service: ";
  72                 if (defined($status = $log{$service})) {
  73                         print "$status\n";
  74                 } else {
  75                         print "FAILED!!!\n";
  76                         $error = 1;
  77                 }
  78         }
  79         if ($error) {
  80                 print "make test: Failed due to lack of required Z39.50 service\n";
  81         } else {
  82                 print "\nEverything is ok!\n";
  83         }
  84         print "-----------------------------------------------\n";
  85         print "not " if $error;
  86         print "ok 4\n";
  87 }
  88
  89
  90 my $socketFile = "/tmp/SimpleServer-test-$$";
  91 my $socket = "unix:$socketFile";
  92
  93 if (!defined($pid = fork() )) {
  94         die "Cannot fork: $!\n";
  95 } elsif ($pid) {                                        ## Parent launches server
  96         my $handler = Net::Z3950::SimpleServer->new(
  97                 INIT            =>      \&my_init_handler,
  98                 CLOSE           =>      \&my_close_handler,
  99                 SEARCH          =>      \&my_search_handler,
 100                 FETCH           =>      \&my_fetch_handler);
 101
 102         $handler->launch_server("test.pl", "-1", $socket);
 103 } else {                                                ## Child starts the client
 104         sleep(1);
 105         open(CLIENT, "| yaz-client $socket > /dev/null")
 106                 or die "Couldn't fork client: $!\n";
 107         print CLIENT "f test\n";
 108         print CLIENT "s\n";
 109         print CLIENT "close\n";
 110         print CLIENT "quit\n";
 111         close(CLIENT) or die "Couldn't close: $!\n";
 112         unlink($socketFile);
 113 }