X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=blobdiff_plain;f=lib%2FZOOM%2FIRSpy%2FTest%2FPing.pm;h=2eeda3bc53c6cce5c3c7b3aef381854cbc48325a;hp=402a98ee0820985cd1a1a945d6cc57c9c4602463;hb=eae0cc5511d06761d8067d7046d110ba8f25dd64;hpb=d18f6c2cbf1d5afff1d16a0524581d8cccd2ddb9 diff --git a/lib/ZOOM/IRSpy/Test/Ping.pm b/lib/ZOOM/IRSpy/Test/Ping.pm index 402a98e..2eeda3b 100644 --- a/lib/ZOOM/IRSpy/Test/Ping.pm +++ b/lib/ZOOM/IRSpy/Test/Ping.pm @@ -1,4 +1,4 @@ -# $Id: Ping.pm,v 1.1 2006-06-20 16:32:42 mike Exp $ +# $Id: Ping.pm,v 1.18 2006-12-15 17:23:27 mike Exp $ # See the "Main" test package for documentation @@ -9,83 +9,56 @@ use strict; use warnings; use ZOOM::IRSpy::Test; -our @ISA; -@ISA = qw(ZOOM::IRSpy::Test); +our @ISA = qw(ZOOM::IRSpy::Test); +use ZOOM::IRSpy::Utils qw(isodate); -sub run { - my $this = shift(); - print "Running 'Ping' test\n"; - ### Now actually do it - return 0; +sub start { + my $class = shift(); + my($conn) = @_; + + $conn->irspy_connect(undef, {}, + ZOOM::Event::RECV_APDU, \&connected, + exception => \¬_connected); } -# Some of this Pod-using code may be useful. -# -#my $pod = new ZOOM::Pod(@ARGV); -#$pod->option(elementSetName => "b"); -#$pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search); -#$pod->callback(ZOOM::Event::RECV_RECORD, \&got_record); -##$pod->callback(exception => \&exception_thrown); -#$pod->search_pqf("the"); -#my $err = $pod->wait(); -#die "$pod->wait() failed with error $err" if $err; -# -#sub completed_search { -# my($conn, $state, $rs, $event) = @_; -# print $conn->option("host"), ": found ", $rs->size(), " records\n"; -# $state->{next_to_fetch} = 0; -# $state->{next_to_show} = 0; -# request_records($conn, $rs, $state, 2); -# return 0; -#} -# -#sub got_record { -# my($conn, $state, $rs, $event) = @_; -# -# { -# # Sanity-checking assertions. These should be impossible -# my $ns = $state->{next_to_show}; -# my $nf = $state->{next_to_fetch}; -# if ($ns > $nf) { -# die "next_to_show > next_to_fetch ($ns > $nf)"; -# } elsif ($ns == $nf) { -# die "next_to_show == next_to_fetch ($ns)"; -# } -# } -# -# my $i = $state->{next_to_show}++; -# my $rec = $rs->record($i); -# print $conn->option("host"), ": record $i is ", render_record($rec), "\n"; -# request_records($conn, $rs, $state, 3) -# if $i == $state->{next_to_fetch}-1; -# -# return 0; -#} -# -#sub exception_thrown { -# my($conn, $state, $rs, $exception) = @_; -# print "Uh-oh! $exception\n"; -# return 0; -#} -# -#sub request_records { -# my($conn, $rs, $state, $count) = @_; -# -# my $i = $state->{next_to_fetch}; -# ZOOM::Log::log("irspy", "requesting $count records from $i"); -# $rs->records($i, $count, 0); -# $state->{next_to_fetch} += $count; -#} -# -#sub render_record { -# my($rec) = @_; -# -# return "undefined" if !defined $rec; -# return "'" . $rec->render() . "'"; -#} +sub connected { maybe_connected(@_, 1) } +sub not_connected { maybe_connected(@_, 0) } + +sub maybe_connected { + my($conn, $task, $__UNUSED_udata, $event, $ok) = @_; + + $conn->log("irspy_test", ($ok ? "" : "not "), "connected"); + my $rec = $conn->record(); + $rec->append_entry("irspy:status", "" . + isodate(time()) . ""); + + if ($ok) { + foreach my $opt (qw(search present delSet resourceReport + triggerResourceCtrl resourceCtrl + accessCtrl scan sort extendedServices + level_1Segmentation level_2Segmentation + concurrentOperations namedResultSets + encapsulation resultCount negotiationModel + duplicationDetection queryType104 + pQESCorrection stringSchema)) { + $conn->record()->store_result('init_opt', option => $opt) + if $conn->option("init_opt_$opt"); + } + + foreach my $opt (qw(serverImplementationId + serverImplementationName + serverImplementationVersion)) { + $conn->record()->store_result($opt, value => $conn->option($opt)); + } + } + + + return $ok ? ZOOM::IRSpy::Status::TEST_GOOD : + ZOOM::IRSpy::Status::TEST_BAD; +} 1;