From: Mike Taylor Date: Mon, 25 Mar 2013 22:01:22 +0000 (+0000) Subject: Resolve X-Git-Url: http://git.indexdata.com/?p=irspy-moved-to-github.git;a=commitdiff_plain;h=457847fe14b13d67ac9fa616ac4821ac90d47b07;hp=e5314fd4ee4849af51fdc529233f58161cafe578 Resolve --- diff --git a/.gitignore b/.gitignore index 0b5bd39..f7bca28 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ +MYMETA.yml Makefile blib pm_to_blib +log diff --git a/Changes b/Changes index f904207..9c27ea2 100644 --- a/Changes +++ b/Changes @@ -27,6 +27,15 @@ Revision history for Perl extension ZOOM::IRSpy. - Record::OPAC test check that record returned in piggyback after OPAC-record request really is an OPAC record. Fixes bug IR-331. + - Add new test, Record::PiggyBack, with support for viewing, + editing and storing results. Fixes bug IR-333. + - IDs used in URLs for full-record links are properly + CQL-quoted. Fixes part of IR-303. + - Move aside the old, unused lib/ZOOM/Pod.pm. Will be removed + from distribution entirely in a subsequent release. + - Support new "irspy_data" log-level to register information + written to target description record. + - need a nagios alert script to check irspy updates, IR-336 1.02 Wed Jul 7 16:43:36 BST 2010 - Enhance setrlimit program so that it can set maximum diff --git a/MANIFEST b/MANIFEST index 0d2b86b..d2224dc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -32,6 +32,7 @@ lib/ZOOM/IRSpy/Test/Quick.pm lib/ZOOM/IRSpy/Test/Record/Fetch.pm lib/ZOOM/IRSpy/Test/Record/Main.pm lib/ZOOM/IRSpy/Test/Record/OPAC.pm +lib/ZOOM/IRSpy/Test/Record/PiggyBack.pm lib/ZOOM/IRSpy/Test/ResultSet/Main.pm lib/ZOOM/IRSpy/Test/ResultSet/Named.pm lib/ZOOM/IRSpy/Test/Search/Bath.pm diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index adea0b5..3cd43f3 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -17,7 +17,7 @@ lib/CVS lib/ZOOM/CVS lib/ZOOM/IRSpy/CVS lib/ZOOM/IRSpy/x.pl -lib/ZOOM/Pod.pm +lib/ZOOM/__UNUSED/Pod.pm lib/ZOOM/XML t/CVS web/conf/apache2.0/cartney-dev.conf diff --git a/README b/README index 8020b8d..93d10aa 100644 --- a/README +++ b/README @@ -18,7 +18,7 @@ package store, using apt-get: sudo apt-get install \ libnet-z3950-zoom-perl \ - libxml-libxml-common-perl \ + libxml-libxml-perl \ liburi-perl \ libxml-libxml-perl \ libapache2-mod-perl2 \ diff --git a/bin/irspy-nagios.pl b/bin/irspy-nagios.pl new file mode 100755 index 0000000..8ec764b --- /dev/null +++ b/bin/irspy-nagios.pl @@ -0,0 +1,61 @@ +#!/usr/bin/perl +# Copyright (c) 2013 IndexData ApS, http://indexdata.com +# +# irspy-nagios.pl - check if IRSpy updates run + +use strict; +use warnings; + +use LWP::Simple; +use HTTP::Date; +use Getopt::Long; + +my $help; +my $debug = 0; +my $update_cycle_days = 7; +my $url = 'http://irspy.indexdata.com/raw.html?id=Z39.50%3Aopencontent.indexdata.com%3A210%2Foaister'; + +sub usage () { + < \$debug, + "days=i" => \$update_cycle_days, + "url=s" => \$url, +) or die usage; +die usage if $help; + +my $data = get $url; + +die "No data for $url\n" if !defined $data; +warn $data if $debug >= 2; + +if ($data =~ m,(.*?),) { + my $date = $1; + my $time = str2time($date); + + my $last_update = time() - $time; + warn "last update: $last_update seconds ago\n" if $debug; + + if ($last_update > 24*3600* $update_cycle_days) { + die "Last update is older than $last_update seconds: $date\n"; + } + +} else { + die "cannot parse date field from $url\n"; +} + +exit 0; + diff --git a/bin/irspy.pl b/bin/irspy.pl index bd6e0f7..2e90ce9 100755 --- a/bin/irspy.pl +++ b/bin/irspy.pl @@ -13,6 +13,7 @@ # irspy_unhandled -- unhandled events (not very interesting) # irspy_test -- adding, queueing and running tests # irspy_task -- adding, queueing and running tasks +# irspy_data -- XML data written to registry # I have no idea why this directory is not in Ubuntu's default Perl # path, but we need it because just occasionally overload.pm:88 diff --git a/lib/ZOOM/IRSpy.pm b/lib/ZOOM/IRSpy.pm index 7b7abd2..fe1984c 100644 --- a/lib/ZOOM/IRSpy.pm +++ b/lib/ZOOM/IRSpy.pm @@ -65,6 +65,7 @@ BEGIN { ZOOM::Log::mask_str("irspy_unhandled"); ZOOM::Log::mask_str("irspy_test"); ZOOM::Log::mask_str("irspy_task"); + ZOOM::Log::mask_str("irspy_data"); } sub new { @@ -641,9 +642,9 @@ sub check { my $skipcount = 0; while (defined $node->next() && length($node->next()->address()) >= length($address)) { - $conn->log("irspy_debug", "skipping from '", + $conn->log("irspy_test", "skipping from '", $node->address(), "' to '", - $node->next()->address(), "'"); + $node->next()->address(), "' (", $node->next()->name(), ")"); $node = $node->next(); $skipcount++; } diff --git a/lib/ZOOM/IRSpy/Record.pm b/lib/ZOOM/IRSpy/Record.pm index c5b6c1b..29160ec 100644 --- a/lib/ZOOM/IRSpy/Record.pm +++ b/lib/ZOOM/IRSpy/Record.pm @@ -117,9 +117,10 @@ sub store_result { $xml .= " $key=\"" . xml_encode($info{$key}) . "\""; } - $xml .= ">" . isodate(time()) . "\n"; + $xml .= ">" . isodate(time()) . ""; - $this->append_entry('irspy:status', $xml); + $this->{irspy}->log("irspy_data", $xml); + $this->append_entry('irspy:status', $xml . "\n"); } diff --git a/lib/ZOOM/IRSpy/Test/Quick.pm b/lib/ZOOM/IRSpy/Test/Quick.pm index c184ccd..a690c9e 100644 --- a/lib/ZOOM/IRSpy/Test/Quick.pm +++ b/lib/ZOOM/IRSpy/Test/Quick.pm @@ -8,7 +8,7 @@ use warnings; use ZOOM::IRSpy::Test; our @ISA = qw(ZOOM::IRSpy::Test); -sub subtests { qw(Ping Record::Fetch) } +sub subtests { qw(Ping Record::PiggyBack) } sub timeout { 20 } diff --git a/lib/ZOOM/IRSpy/Test/Record/Main.pm b/lib/ZOOM/IRSpy/Test/Record/Main.pm index 42090d0..5bb3de0 100644 --- a/lib/ZOOM/IRSpy/Test/Record/Main.pm +++ b/lib/ZOOM/IRSpy/Test/Record/Main.pm @@ -23,7 +23,7 @@ I<## To follow> =cut -sub subtests { qw(Record::Fetch Record::OPAC) } +sub subtests { qw(Record::Fetch Record::OPAC Record::PiggyBack) } sub start { my $class = shift(); diff --git a/lib/ZOOM/IRSpy/Test/Record/PiggyBack.pm b/lib/ZOOM/IRSpy/Test/Record/PiggyBack.pm new file mode 100644 index 0000000..47a3f08 --- /dev/null +++ b/lib/ZOOM/IRSpy/Test/Record/PiggyBack.pm @@ -0,0 +1,96 @@ +# See the "Main" test package for documentation + +### Too much common code with OPAC.pm: need to refactor + +package ZOOM::IRSpy::Test::Record::PiggyBack; + +use 5.008; +use strict; +use warnings; + +use ZOOM::IRSpy::Test; +our @ISA = qw(ZOOM::IRSpy::Test); + +my @queries = ( + "\@attr 1=4 mineral", + "\@attr 1=4 computer", + "\@attr 1=44 mineral", # Smithsonian doesn't support AP 4! + "\@attr 1=1016 water", # Connector Framework only does 1016 + ### We can add more queries here + ); + +# We'd like to use this temporary-options hash to set +# preferredRecordSyntax, as well But that doesn't work because the +# same value needs to be in force later on when we make the +# record_immediate() call, otherwise it misses its cache. +my %options = ( + piggyback => 1, + count => 3, +# preferredRecordSyntax => "usmarc" + ); + +sub start { + my $class = shift(); + my($conn) = @_; + + ### It would be better to consult previous tests to find a working RS + $conn->option(preferredRecordSyntax => "usmarc"); + $conn->irspy_search_pqf($queries[0], { queryindex => 0 }, \%options, + ZOOM::Event::ZEND, \&completed_search, + exception => \&completed_search); +} + + +sub completed_search { + my($conn, $task, $udata, $event) = @_; + + # $event can be a ZOOM::Event::* number or a ZOOM::Exception object + if (ref $event && + $event->isa("ZOOM::Exception") && + $event->code() == 1005) { + $conn->log("irspy_test", "Piggyback searching not supported"); + $conn->record()->store_result('piggyback', 'ok' => 0); + return ZOOM::IRSpy::Status::TEST_BAD; + } + + my $n = $task->{rs}->size(); + $conn->log("irspy_test", "Piggyback test search (", $task->render_query(), ") ", + ref $event && $event->isa("ZOOM::Exception") ? + "failed: $event" : "found $n records (event=$event)"); + + # remember how often a target record hit a timeout + if (ref $event && $event->isa("ZOOM::Exception")) { + if ($event =~ /Timeout/i) { + $conn->record->zoom_error->{TIMEOUT}++; + $conn->log("irspy_test", "Increase timeout error counter to: " . + $conn->record->zoom_error->{TIMEOUT}); + } + } + + if ($n < 3) { + $task->{rs}->destroy(); + my $qindex = $udata->{queryindex}+1; + my $q = $queries[$qindex]; + return ZOOM::IRSpy::Status::TEST_SKIPPED + if !defined $q || $conn->record->zoom_error->{TIMEOUT} >= $ZOOM::IRSpy::max_timeout_errors; + + $conn->log("irspy_test", "Trying another search ..."); + $conn->irspy_search_pqf($queries[$qindex], { queryindex => $qindex }, \%options, + ZOOM::Event::ZEND, \&completed_search, + exception => \&completed_search); + return ZOOM::IRSpy::Status::TASK_DONE; + } + + # We have a result-set of three of more records, and we requested + # that those records be included in the Search Response using + # piggybacking. Was it done? + my $rec = $task->{rs}->record_immediate(2); + my $ok = defined $rec && $rec->error() == 0; + + $task->{rs}->destroy(); + $conn->record()->store_result('piggyback', 'ok' => $ok); + return $ok ? ZOOM::IRSpy::Status::TEST_GOOD : ZOOM::IRSpy::Status::TEST_BAD; +} + + +1; diff --git a/lib/ZOOM/IRSpy/Test/Search/Bib1.pm b/lib/ZOOM/IRSpy/Test/Search/Bib1.pm index fd4d1d6..1d5c0e7 100644 --- a/lib/ZOOM/IRSpy/Test/Search/Bib1.pm +++ b/lib/ZOOM/IRSpy/Test/Search/Bib1.pm @@ -53,10 +53,11 @@ sub error { update($conn, $attr, 0); zoom_error_timeout_update($conn, $exception); - return ZOOM::IRSpy::Status::TEST_BAD - if ($exception->code() == 1 || # permanent system error - $exception->code() == 235 || # Database does not exist - $exception->code() == 109); # Database unavailable +# Commented out because TEST_BAD causes sibling tests to be skipped. +# return ZOOM::IRSpy::Status::TEST_BAD +# if ($exception->code() == 1 || # permanent system error +# $exception->code() == 235 || # Database does not exist +# $exception->code() == 109); # Database unavailable return ZOOM::IRSpy::Status::TASK_DONE; } diff --git a/lib/ZOOM/IRSpy/Test/Search/Explain.pm b/lib/ZOOM/IRSpy/Test/Search/Explain.pm index 087b846..2c2645f 100644 --- a/lib/ZOOM/IRSpy/Test/Search/Explain.pm +++ b/lib/ZOOM/IRSpy/Test/Search/Explain.pm @@ -55,7 +55,7 @@ sub error { update($conn, $category, 0); zoom_error_timeout_update($conn, $exception); - return ZOOM::IRSpy::Status::TEST_BAD + return ZOOM::IRSpy::Status::TEST_GOOD if ($exception->code() == 109 || # Database unavailable $exception->code() == 235); # Database does not exist diff --git a/lib/ZOOM/IRSpy/Test/Search/Main.pm b/lib/ZOOM/IRSpy/Test/Search/Main.pm index 6408cbe..2e337c7 100644 --- a/lib/ZOOM/IRSpy/Test/Search/Main.pm +++ b/lib/ZOOM/IRSpy/Test/Search/Main.pm @@ -10,6 +10,7 @@ our @ISA = qw(ZOOM::IRSpy::Test); sub subtests { qw(Search::Bib1 Search::Dan1 Search::Boolean Search::Explain Search::CQL Search::Bath) } +# Why no Search::DBDate or Search::Title? sub start { my $class = shift(); diff --git a/lib/ZOOM/IRSpy/Utils.pm b/lib/ZOOM/IRSpy/Utils.pm index 53e53fc..0583662 100644 --- a/lib/ZOOM/IRSpy/Utils.pm +++ b/lib/ZOOM/IRSpy/Utils.pm @@ -163,7 +163,7 @@ sub cql_quote { my($term) = @_; $term =~ s/([""\\*?])/\\$1/g; - $term = qq["$term"] if $term =~ /[\s""\/]/; + $term = qq["$term"] if $term =~ /[\s""\/\\]/; return $term; } @@ -180,8 +180,7 @@ sub cql_target { $id = $protocol; } - return "rec.id=" . cql_quote($id); - #return "rec.id_raw=" . cql_quote($id); + return "rec.id==" . cql_quote($id); } diff --git a/lib/ZOOM/Pod.pm b/lib/ZOOM/Pod.pm deleted file mode 100644 index 15644ed..0000000 --- a/lib/ZOOM/Pod.pm +++ /dev/null @@ -1,404 +0,0 @@ - -package ZOOM::Pod; - -use strict; -use warnings; - -use ZOOM; - -BEGIN { - # Just register the names: this doesn't turn the levels on - ZOOM::Log::mask_str("pod"); - ZOOM::Log::mask_str("pod_unhandled"); -} - -=head1 NAME - -ZOOM::Pod - Perl extension for handling pods of concurrent ZOOM connections - -=head1 SYNOPSIS - - use ZOOM::Pod; - - $pod = new ZOOM::Pod("bagel.indexdata.com/gils", - "bagel.indexdata.com/marc"); - $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search); - $pod->callback(ZOOM::Event::RECV_RECORD, \&got_record); - $pod->search_pqf("the"); - $err = $pod->wait(); - die "$pod->wait() failed with error $err" if $err; - - sub completed_search { - ($conn, undef, $rs) = @_; - print $conn->option("host"), ": found ", $rs->size(), " records\n"; - $rs->records(0, 1, 0); # Queues a request for the record - return 0; - } - - sub got_record { - ($conn, undef, $rs) = @_; - $rec = $rs->record(0); - print $conn->option("host"), ": got $rec = '", $rec->render(), "'\n"; - return 0; - } - -=head1 DESCRIPTION - -C provides an API that simplifies asynchronous programming -using ZOOM. A pod is a collection of asynchronous connections that -are run simultaneously to achieve broadcast searching and retrieval. -When a pod is created, a set of connections (or target-strings to -connect to) are specified. Thereafter, they are treated as a unit, -and methods for searching, option-setting, etc. that are invoked on -the pod are delegated to each of its members. - -The key method on a pod is C, which enters a loop accepting -and dispatching events occurring on any of the connections in the pod. -Unless interrupted,the loop runs until there are no more events left, -i.e. no searches are outstanding and no requested records have still -to be received. - -Event dispatching is done by means of callback functions, which can be -registered for each event. A registered callback is invoked whenever -a corresponding event occurs. A special callback can be nominated to -handle errors. - -=head1 METHODS - -=head2 new() - - $pod = new ZOOM::Pod($conn1, $conn2, $conn3); - $pod = new ZOOM::Pod("bagel.indexdata.com/gils", - "bagel.indexdata.com/marc"); - -Creates a new pod containing one or more connections. Each connection -may be specified either by an existing C object, -which I be asynchronous; or by a ZOOM target string, in which -case the pod module will make the connection object itself. - -Returns the new pod. - -=cut - -# Functionality to be added: -# -# If the constructor's first argument is a number, then it is -# taken as a limit on the number of connections to handle at any -# one time. In this case, the pod initially multiplexes between -# the first I connections, and brings further connections -# into the active subset whenever already-active connections are -# closed. - -sub new { - my $class = shift(); - my(@conn) = @_; - - die "$class with no connections" if @conn == 0; - foreach my $conn (@conn) { - if (!ref $conn) { - $conn = new ZOOM::Connection($conn, 0, async => 1); - # The $conn object is always made, even if no there's no - # server. Such errors are caught later, by the _check() - # call in wait(). - } - } - - return bless { - conn => \@conn, - rs => [], - callback => {}, - }, $class; -} - - -=head2 connections() - - @c = $pod->connections(); - -Returns a list of the connection objects in the pod. - -=cut - -sub connections { - my $this = shift(); - return @{ $this->{conn} } -} - - -=head2 option() - - $oldElemSet = $pod->option("elementSetName"); - $pod->option(elementSetName => "b"); - -Sets a specified option in all the connections in a pod. Returns the -old value that the option had in first of the connections in the pod: -be aware that this value was not necessarily shared by all the members -of the pod ... but that is true often enough to be useful. - -=cut - -sub option { - my $this = shift(); - my($key, $value) = @_; - - my $old = $this->{conn}->[0]->option($key); - foreach my $conn (@{ $this->{conn} }) { - $conn->option($key, $value); - } - - return $old; -} - -=head2 callback() - - $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search); - $pod->callback("exception", sub { print "never mind: $@\n"; return 0 } ); - -Registers a callback to be invoked by the pod when an event happens. -Callback functions are invoked by C (q.v.). - -When registering a callback, the first argument is an event-code - one -of those defined in the C enumeration - and the second is -a function reference, or equivalently an inline code-fragment. It is -acceptable to nominate the same function as the callback for multiple -events, by multiple invocations of C. - -When an event occurs during the execution of C, the relevant -callback function is called with four arguments: the connection that the -event happened on; the argument that was passed into C; -the result-set associated with the connection (if there is one); and the -event-type (so that a single function that handles events of multiple -types can switch on the code where necessary). The callback function -can handle the event as it wishes, finishing up by returning an -integer. If this is zero, then C continues as normal; if it -is anything else, then that value is immediately returned from -C. - -So a simple event-handler might look like this: - - sub got_event { - ($conn, $arg, $rs, $event) = @_; - print "event $event on connection ", $conn->option("host"), "\n"; - print "Found ", $rs->size(), " records\n" - if $event == ZOOM::Event::RECV_SEARCH; - return 0; - } - -In addition to the event-type callbacks discussed above, there is a -special callback, C<"exception">, which is invoked if an exception -occurs. This will nearly always be a ZOOM error, but this can be -tested using C<$exception-Eisa("ZOOM::Exception")>. This callback is -invoked with the same arguments as described above, except that -instead of the event-type, the fourth argument is a copy of the -exception, C<$@>. Exception-handling callbacks may of course re-throw -the exception using C. - -So a simple error-handler might look like this: - - sub got_error { - ($conn, $arg, $rs, $exception) = @_; - if ($exception->isa("ZOOM::Exception")) { - print "Caught error $exception - continuing"; - return 0; - } - die $exception; - } - -The C<$arg> argument could be anything at all - it is whatever the -application code passed into C. For example, it could be -a reference to a hash indexed by the host string of the connections to -yield some per-connection state information. -An application might use such information -to keep a record of which was the last record -retrieved from the associated connection. - -=cut - -sub callback { - my $this = shift(); - my($event, $sub) = @_; - - my $old = $this->{callback}->{$event}; - $this->{callback}->{$event} = $sub; - - return $old; -} - -=head2 remove_callbacks() - - $pod->remove_callbacks(); - -Removes all registed callbacks from the pod. This is useful when the -pod has completed one operation and is about to start the next. - -=cut - -sub remove_callbacks { - my $this = shift(); - $this->{callback} = {}; -} - -=head2 search_pqf() - - $pod->search_pqf("@attr 1=1003 wedel"); - -Submits the specified query to each of the connections in a pod, -delegating to the same-named method of the C class -and storing each result in a result-set object associated with the -connection that generated it. Returns no value: success or failure -must subsequently be detected by inspecting the events and exceptions -generated by Cing on the pod. - -B -An important simplifying assumption is that each connection can only -have one search active on it at a time: this allows the pod to -maintain the one-to-one mapping between connections and result-sets. -Submitting a new search on a connection before the old one has -completed will result in a total failure in the nature of causality, -and the spontaneous existence-failure of the universe. Try to avoid -doing this too often. - -=cut - -sub search_pqf { - my $this = shift(); - my($pqf) = @_; - - foreach my $i (0..@{ $this->{conn} }-1) { - my $conn = $this->{conn}->[$i]; - $this->{rs}->[$i] = $conn->search_pqf($pqf) - if !$conn->option("pod_omit"); - } -} - -=head2 wait() - - $err = $pod->wait(); - # or - $err = $pod->wait($arg); - die "$pod->wait() failed with error $err" if $err; - -Waits for events on the connections that make up the pod, usually -continuing until there are no more events left and then returning -zero. Whenever an event occurs, a callback function is dispatched as -described above; if an argument was passed to C, then that -same argument is also passed to each callback invocation. If -that function returns a non-zero value, then C terminates -immediately, whether or not any events remain, and returns that value. - -If an error occurs on one of the connection in the pod, then it is -normally thrown as a C. If, however, there is a -special C<"exception"> callback registered, then the exception object -is passed to this instead. As usual, the return value of the callback -indicates whether C should continue (return-value 0) or return -immediately (any other value). Exception-handling callbacks may of -course re-throw the exception. - -Connections that have the C option set are omitted from -consideration. This is useful if, for example, a connection that is -part of a pod is known to have encountered an unrecoverable error. - -=cut - -sub wait { - my $this = shift(); - my($arg) = @_; - - my $res = 0; - - while (1) { - my @conn; - my @idxmap; # maps indexes into conn to global indexes - foreach my $i (0 .. @{ $this->{conn} }-1) { - my $conn = $this->{conn}->[$i]; - if ($conn->option("pod_omit")) { - #ZOOM::Log::log("pod", "connection $i omitted (", - #$conn->option("host"), ")"); - } else { - push @conn, $conn; - push @idxmap, $i; - #ZOOM::Log::log("pod", "connection $i included (", - #$conn->option("host"), ")"); - } - } - - last if @conn == 0; - my $i0 = ZOOM::event(\@conn); - last if $i0 == 0; - my $i = 1+$idxmap[$i0-1]; - my $conn = $this->{conn}->[$i-1]; - die "connection-mapping screwup" if $conn ne $conn[$i0-1]; - - my $ev = $conn->last_event(); - my $evstr = ZOOM::event_str($ev); - ZOOM::Log::log("pod", "connection ", $i-1, ": event $ev ($evstr)"); - - eval { - $conn->_check(); - }; if ($@) { - my $sub = $this->{callback}->{exception}; - die $@ if !defined $sub; - $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $@); - last if $res != 0; - next; - } - - my $sub = $this->{callback}->{$ev}; - if (defined $sub) { - $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $ev); - last if $res != 0; - } else { - ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)"); - } - } - - return $res; -} - - -=head1 LOGGING - -This module generates logging messages using C, -which in turn relies on the YAZ logging facilities. It uses two -logging levels: - -=over 4 - -=item pod - -Logs all events. - -=item pod_unhandled - -Logs unhandled events, i.e. events of types for which no callback has -been registered. - -=back - -These logging levels can be turned on by setting the C -environment variable to C. - -=head1 SEE ALSO - -The underlying -C -module (part of the -C -distribution). - -=head1 AUTHOR - -Mike Taylor, Emike@indexdata.comE - -=head1 COPYRIGHT AND LICENCE - -Copyright (C) 2006 by Index Data. - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself, either Perl version 5.8.4 or, -at your option, any later version of Perl 5 you may have available. - -=cut - - -1; diff --git a/lib/ZOOM/__UNUSED/Pod.pm b/lib/ZOOM/__UNUSED/Pod.pm new file mode 100644 index 0000000..15644ed --- /dev/null +++ b/lib/ZOOM/__UNUSED/Pod.pm @@ -0,0 +1,404 @@ + +package ZOOM::Pod; + +use strict; +use warnings; + +use ZOOM; + +BEGIN { + # Just register the names: this doesn't turn the levels on + ZOOM::Log::mask_str("pod"); + ZOOM::Log::mask_str("pod_unhandled"); +} + +=head1 NAME + +ZOOM::Pod - Perl extension for handling pods of concurrent ZOOM connections + +=head1 SYNOPSIS + + use ZOOM::Pod; + + $pod = new ZOOM::Pod("bagel.indexdata.com/gils", + "bagel.indexdata.com/marc"); + $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search); + $pod->callback(ZOOM::Event::RECV_RECORD, \&got_record); + $pod->search_pqf("the"); + $err = $pod->wait(); + die "$pod->wait() failed with error $err" if $err; + + sub completed_search { + ($conn, undef, $rs) = @_; + print $conn->option("host"), ": found ", $rs->size(), " records\n"; + $rs->records(0, 1, 0); # Queues a request for the record + return 0; + } + + sub got_record { + ($conn, undef, $rs) = @_; + $rec = $rs->record(0); + print $conn->option("host"), ": got $rec = '", $rec->render(), "'\n"; + return 0; + } + +=head1 DESCRIPTION + +C provides an API that simplifies asynchronous programming +using ZOOM. A pod is a collection of asynchronous connections that +are run simultaneously to achieve broadcast searching and retrieval. +When a pod is created, a set of connections (or target-strings to +connect to) are specified. Thereafter, they are treated as a unit, +and methods for searching, option-setting, etc. that are invoked on +the pod are delegated to each of its members. + +The key method on a pod is C, which enters a loop accepting +and dispatching events occurring on any of the connections in the pod. +Unless interrupted,the loop runs until there are no more events left, +i.e. no searches are outstanding and no requested records have still +to be received. + +Event dispatching is done by means of callback functions, which can be +registered for each event. A registered callback is invoked whenever +a corresponding event occurs. A special callback can be nominated to +handle errors. + +=head1 METHODS + +=head2 new() + + $pod = new ZOOM::Pod($conn1, $conn2, $conn3); + $pod = new ZOOM::Pod("bagel.indexdata.com/gils", + "bagel.indexdata.com/marc"); + +Creates a new pod containing one or more connections. Each connection +may be specified either by an existing C object, +which I be asynchronous; or by a ZOOM target string, in which +case the pod module will make the connection object itself. + +Returns the new pod. + +=cut + +# Functionality to be added: +# +# If the constructor's first argument is a number, then it is +# taken as a limit on the number of connections to handle at any +# one time. In this case, the pod initially multiplexes between +# the first I connections, and brings further connections +# into the active subset whenever already-active connections are +# closed. + +sub new { + my $class = shift(); + my(@conn) = @_; + + die "$class with no connections" if @conn == 0; + foreach my $conn (@conn) { + if (!ref $conn) { + $conn = new ZOOM::Connection($conn, 0, async => 1); + # The $conn object is always made, even if no there's no + # server. Such errors are caught later, by the _check() + # call in wait(). + } + } + + return bless { + conn => \@conn, + rs => [], + callback => {}, + }, $class; +} + + +=head2 connections() + + @c = $pod->connections(); + +Returns a list of the connection objects in the pod. + +=cut + +sub connections { + my $this = shift(); + return @{ $this->{conn} } +} + + +=head2 option() + + $oldElemSet = $pod->option("elementSetName"); + $pod->option(elementSetName => "b"); + +Sets a specified option in all the connections in a pod. Returns the +old value that the option had in first of the connections in the pod: +be aware that this value was not necessarily shared by all the members +of the pod ... but that is true often enough to be useful. + +=cut + +sub option { + my $this = shift(); + my($key, $value) = @_; + + my $old = $this->{conn}->[0]->option($key); + foreach my $conn (@{ $this->{conn} }) { + $conn->option($key, $value); + } + + return $old; +} + +=head2 callback() + + $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search); + $pod->callback("exception", sub { print "never mind: $@\n"; return 0 } ); + +Registers a callback to be invoked by the pod when an event happens. +Callback functions are invoked by C (q.v.). + +When registering a callback, the first argument is an event-code - one +of those defined in the C enumeration - and the second is +a function reference, or equivalently an inline code-fragment. It is +acceptable to nominate the same function as the callback for multiple +events, by multiple invocations of C. + +When an event occurs during the execution of C, the relevant +callback function is called with four arguments: the connection that the +event happened on; the argument that was passed into C; +the result-set associated with the connection (if there is one); and the +event-type (so that a single function that handles events of multiple +types can switch on the code where necessary). The callback function +can handle the event as it wishes, finishing up by returning an +integer. If this is zero, then C continues as normal; if it +is anything else, then that value is immediately returned from +C. + +So a simple event-handler might look like this: + + sub got_event { + ($conn, $arg, $rs, $event) = @_; + print "event $event on connection ", $conn->option("host"), "\n"; + print "Found ", $rs->size(), " records\n" + if $event == ZOOM::Event::RECV_SEARCH; + return 0; + } + +In addition to the event-type callbacks discussed above, there is a +special callback, C<"exception">, which is invoked if an exception +occurs. This will nearly always be a ZOOM error, but this can be +tested using C<$exception-Eisa("ZOOM::Exception")>. This callback is +invoked with the same arguments as described above, except that +instead of the event-type, the fourth argument is a copy of the +exception, C<$@>. Exception-handling callbacks may of course re-throw +the exception using C. + +So a simple error-handler might look like this: + + sub got_error { + ($conn, $arg, $rs, $exception) = @_; + if ($exception->isa("ZOOM::Exception")) { + print "Caught error $exception - continuing"; + return 0; + } + die $exception; + } + +The C<$arg> argument could be anything at all - it is whatever the +application code passed into C. For example, it could be +a reference to a hash indexed by the host string of the connections to +yield some per-connection state information. +An application might use such information +to keep a record of which was the last record +retrieved from the associated connection. + +=cut + +sub callback { + my $this = shift(); + my($event, $sub) = @_; + + my $old = $this->{callback}->{$event}; + $this->{callback}->{$event} = $sub; + + return $old; +} + +=head2 remove_callbacks() + + $pod->remove_callbacks(); + +Removes all registed callbacks from the pod. This is useful when the +pod has completed one operation and is about to start the next. + +=cut + +sub remove_callbacks { + my $this = shift(); + $this->{callback} = {}; +} + +=head2 search_pqf() + + $pod->search_pqf("@attr 1=1003 wedel"); + +Submits the specified query to each of the connections in a pod, +delegating to the same-named method of the C class +and storing each result in a result-set object associated with the +connection that generated it. Returns no value: success or failure +must subsequently be detected by inspecting the events and exceptions +generated by Cing on the pod. + +B +An important simplifying assumption is that each connection can only +have one search active on it at a time: this allows the pod to +maintain the one-to-one mapping between connections and result-sets. +Submitting a new search on a connection before the old one has +completed will result in a total failure in the nature of causality, +and the spontaneous existence-failure of the universe. Try to avoid +doing this too often. + +=cut + +sub search_pqf { + my $this = shift(); + my($pqf) = @_; + + foreach my $i (0..@{ $this->{conn} }-1) { + my $conn = $this->{conn}->[$i]; + $this->{rs}->[$i] = $conn->search_pqf($pqf) + if !$conn->option("pod_omit"); + } +} + +=head2 wait() + + $err = $pod->wait(); + # or + $err = $pod->wait($arg); + die "$pod->wait() failed with error $err" if $err; + +Waits for events on the connections that make up the pod, usually +continuing until there are no more events left and then returning +zero. Whenever an event occurs, a callback function is dispatched as +described above; if an argument was passed to C, then that +same argument is also passed to each callback invocation. If +that function returns a non-zero value, then C terminates +immediately, whether or not any events remain, and returns that value. + +If an error occurs on one of the connection in the pod, then it is +normally thrown as a C. If, however, there is a +special C<"exception"> callback registered, then the exception object +is passed to this instead. As usual, the return value of the callback +indicates whether C should continue (return-value 0) or return +immediately (any other value). Exception-handling callbacks may of +course re-throw the exception. + +Connections that have the C option set are omitted from +consideration. This is useful if, for example, a connection that is +part of a pod is known to have encountered an unrecoverable error. + +=cut + +sub wait { + my $this = shift(); + my($arg) = @_; + + my $res = 0; + + while (1) { + my @conn; + my @idxmap; # maps indexes into conn to global indexes + foreach my $i (0 .. @{ $this->{conn} }-1) { + my $conn = $this->{conn}->[$i]; + if ($conn->option("pod_omit")) { + #ZOOM::Log::log("pod", "connection $i omitted (", + #$conn->option("host"), ")"); + } else { + push @conn, $conn; + push @idxmap, $i; + #ZOOM::Log::log("pod", "connection $i included (", + #$conn->option("host"), ")"); + } + } + + last if @conn == 0; + my $i0 = ZOOM::event(\@conn); + last if $i0 == 0; + my $i = 1+$idxmap[$i0-1]; + my $conn = $this->{conn}->[$i-1]; + die "connection-mapping screwup" if $conn ne $conn[$i0-1]; + + my $ev = $conn->last_event(); + my $evstr = ZOOM::event_str($ev); + ZOOM::Log::log("pod", "connection ", $i-1, ": event $ev ($evstr)"); + + eval { + $conn->_check(); + }; if ($@) { + my $sub = $this->{callback}->{exception}; + die $@ if !defined $sub; + $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $@); + last if $res != 0; + next; + } + + my $sub = $this->{callback}->{$ev}; + if (defined $sub) { + $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $ev); + last if $res != 0; + } else { + ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)"); + } + } + + return $res; +} + + +=head1 LOGGING + +This module generates logging messages using C, +which in turn relies on the YAZ logging facilities. It uses two +logging levels: + +=over 4 + +=item pod + +Logs all events. + +=item pod_unhandled + +Logs unhandled events, i.e. events of types for which no callback has +been registered. + +=back + +These logging levels can be turned on by setting the C +environment variable to C. + +=head1 SEE ALSO + +The underlying +C +module (part of the +C +distribution). + +=head1 AUTHOR + +Mike Taylor, Emike@indexdata.comE + +=head1 COPYRIGHT AND LICENCE + +Copyright (C) 2006 by Index Data. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.4 or, +at your option, any later version of Perl 5 you may have available. + +=cut + + +1; diff --git a/web/conf/apache2.0/irspy.conf b/web/conf/apache2.0/irspy.conf index 53720a3..6d7573f 100644 --- a/web/conf/apache2.0/irspy.conf +++ b/web/conf/apache2.0/irspy.conf @@ -12,7 +12,7 @@ ServerName irspy.indexdata.com - ServerAlias irspy2.indexdata.com irspy + #ServerAlias irspy2.indexdata.com irspy ErrorLog /var/log/apache2/irspy-error.log CustomLog /var/log/apache2/irspy-access.log combined diff --git a/web/htdocs/details/full.mc b/web/htdocs/details/full.mc index 546419b..4695a51 100644 --- a/web/htdocs/details/full.mc +++ b/web/htdocs/details/full.mc @@ -51,6 +51,7 @@ if ($n == 0) { [ "Record syntaxes" => \&calc_recsyn, $xc ], [ "Explain" => \&calc_explain, $xc ], [ "Multiple OPAC records" => \&calc_mor, $xc ], + [ "Piggyback searching" => \&calc_piggyback, $xc ], ); my $title = $xc->find("e:databaseInfo/e:title"); @@ -183,6 +184,7 @@ sub calc_boolean { sub calc_nrs { _calc_boolean(@_, 'i:status/i:named_resultset[@ok = "1"]') } sub calc_mor { _calc_boolean(@_, 'i:status/i:multiple_opac[@ok = "1"]') } +sub calc_piggyback { _calc_boolean(@_, 'i:status/i:piggyback[@ok = "1"]') } sub _calc_boolean { my($id, $xc, $xpath) = @_; diff --git a/xsl/irspy2zeerex.xsl b/xsl/irspy2zeerex.xsl index 6379a38..3926ad6 100644 --- a/xsl/irspy2zeerex.xsl +++ b/xsl/irspy2zeerex.xsl @@ -165,6 +165,11 @@ + + + + +