X-Git-Url: http://git.indexdata.com/?p=simpleserver-moved-to-github.git;a=blobdiff_plain;f=ztest.pl;h=40a91014a04e5dbeb359c9ef309e2a8eaf097c8f;hp=02a004273d065fdb3fb2c05eaf3e7780b2603737;hb=13c67418144d0a5281e3f9724a49a231226c2f70;hpb=7bfe5e677b5333fc520cab05cf926de252be7226 diff --git a/ztest.pl b/ztest.pl index 02a0042..40a9101 100755 --- a/ztest.pl +++ b/ztest.pl @@ -1,11 +1,37 @@ #!/usr/bin/perl -w +## This file is part of simpleserver +## Copyright (C) 2000-2013 Index Data. +## All rights reserved. +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## * Redistributions of source code must retain the above copyright +## notice, this list of conditions and the following disclaimer. +## * Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## * Neither the name of Index Data nor the names of its contributors +## may be used to endorse or promote products derived from this +## software without specific prior written permission. +## +## THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY +## EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +## WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +## DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY +## DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +## (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +## (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +## THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + use ExtUtils::testlib; +use Data::Dumper; use Net::Z3950::SimpleServer; use Net::Z3950::OID; use strict; - sub dump_hash { my $href = shift; my $key; @@ -21,13 +47,65 @@ sub my_init_handler { my $session = {}; $args->{IMP_NAME} = "DemoServer"; + $args->{IMP_ID} = "81"; $args->{IMP_VER} = "3.14159"; $args->{ERR_CODE} = 0; $args->{HANDLE} = $session; + if (defined($args->{PASS}) && defined($args->{USER})) { + printf("Received USER/PASS=%s/%s\n", $args->{USER},$args->{PASS}); + } + } -sub my_search_handler { + +sub my_sort_handler { + my ($args) = @_; + + print "Sort handler called\n"; + print Dumper( $args ); +} + +sub my_scan_handler { my $args = shift; + my $term = $args->{TERM}; + my $entries = [ + { TERM => 'Number 1', + DISPLAY_TERM => 'Number .1', + OCCURRENCE => 10 }, + { TERM => 'Number 2', + OCCURRENCE => 8 }, + { TERM => 'Number 3', + OCCURRENCE => 8 }, + { TERM => 'Number 4', + OCCURRENCE => 8 }, + { TERM => 'Number 5', + OCCURRENCE => 8 }, + { TERM => 'Number 6', + OCCURRENCE => 8 }, + { TERM => 'Number 7', + OCCURRENCE => 8 }, + { TERM => 'Number 8', + OCCURRENCE => 8 }, + { TERM => 'Number 9', + OCCURRENCE => 8 }, + { TERM => 'Number 10', + OCCURRENCE => 4 }, + ]; + $args->{NUMBER} = 10; + $args->{ENTRIES} = $entries; + $args->{STATUS} = Net::Z3950::SimpleServer::ScanPartial; + print "Welcome to scan....\n"; + $args->{EXTRA_RESPONSE_DATA} = 'b'; + print "You scanned for term '$term'\n"; +} + + +my $_fail_frequency = 0; +my $_counter = 0; + +sub my_search_handler { + my $args = shift; + my $data = [{ name => "Peter Dornan", title => "Spokesman", @@ -44,19 +122,32 @@ sub my_search_handler { my $session = $args->{HANDLE}; my $set_id = $args->{SETNAME}; + my $rpn = $args->{RPN}; my @database_list = @{ $args->{DATABASES} }; my $query = $args->{QUERY}; + my $facets = $args->{INPUTFACETS}; my $hits = 3; print "------------------------------------------------------------\n"; print "Processing query : $query\n"; printf("Database set : %s\n", join(" ", @database_list)); print "Setname : $set_id\n"; + print " inputfacets:\n"; + print Dumper($facets); + print " extra args:\n"; + print Dumper($args->{EXTRA_ARGS}); print "------------------------------------------------------------\n"; + $args->{OUTPUTFACETS} = $facets; + + $args->{EXTRA_RESPONSE_DATA} = 'b'; $args->{HITS} = $hits; $session->{$set_id} = $data; $session->{__HITS} = $hits; + if ($_fail_frequency != 0 && ++$_counter % $_fail_frequency == 0) { + print "Exiting to be nasty to client\n"; + exit(1); + } } @@ -83,17 +174,24 @@ sub my_fetch_handler { } } +sub my_start_handler { + my $args = shift; + my $config = $args->{CONFIG}; +} -my $handler = Net::Z3950::SimpleServer->new({ - INIT => \&my_init_handler, - SEARCH => \&my_search_handler, - FETCH => \&my_fetch_handler }); - -$handler->launch_server("ztest.pl", @ARGV); - +Net::Z3950::SimpleServer::yazlog("hello"); -## $Log: ztest.pl,v $ -## Revision 1.7 2001-03-13 14:20:21 sondberg -## Added CVS logging -## +my $handler = new Net::Z3950::SimpleServer( + START => "main::my_start_handler", + INIT => "main::my_init_handler", + SEARCH => "main::my_search_handler", + SCAN => "main::my_scan_handler", + SORT => "main::my_sort_handler", + FETCH => "main::my_fetch_handler" ); +if (@ARGV >= 2 && $ARGV[0] eq "-n") { + $_fail_frequency = $ARGV[1]; + shift; + shift; +} +$handler->launch_server("ztest.pl", @ARGV);