Add remove_callbacks()

[irspy-moved-to-github.git] / lib / ZOOM / Pod.pm

diff --git a/lib/ZOOM/Pod.pm b/lib/ZOOM/Pod.pm
index 1c292c8..3e2f9ce 100644 (file)
--- a/lib/ZOOM/Pod.pm
+++ b/lib/ZOOM/Pod.pm
@@ -1,4 +1,4 @@
-# $Id: Pod.pm,v 1.7 2006-05-11 15:51:36 mike Exp $
+# $Id: Pod.pm,v 1.21 2006-09-27 12:48:20 mike Exp $

 
 package ZOOM::Pod;
 
 
 package ZOOM::Pod;
 

@@ -8,7 +8,7 @@ use warnings;
 use ZOOM;
 
 BEGIN {
 use ZOOM;
 
 BEGIN {

-    # Just register the name
+    # Just register the names: this doesn't turn the levels on

     ZOOM::Log::mask_str("pod");
     ZOOM::Log::mask_str("pod_unhandled");
 }
     ZOOM::Log::mask_str("pod");
     ZOOM::Log::mask_str("pod_unhandled");
 }

@@ -72,7 +72,6 @@ handle errors.
  $pod = new ZOOM::Pod("bagel.indexdata.com/gils",
                       "bagel.indexdata.com/marc");
 
  $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<ZOOM::Connection> object,
 which I<must> be asynchronous; or by a ZOOM target string, in which
 Creates a new pod containing one or more connections.  Each connection
 may be specified either by an existing C<ZOOM::Connection> object,
 which I<must> be asynchronous; or by a ZOOM target string, in which

@@ -82,12 +81,20 @@ Returns the new pod.
 
 =cut
 
 
 =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<n> 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;
 sub new {
     my $class = shift();
     my(@conn) = @_;
 
     die "$class with no connections" if @conn == 0;

-    my @state; # Hashrefs with application state associated with connections

     foreach my $conn (@conn) {
        if (!ref $conn) {
            $conn = new ZOOM::Connection($conn, 0, async => 1);
     foreach my $conn (@conn) {
        if (!ref $conn) {
            $conn = new ZOOM::Connection($conn, 0, async => 1);

@@ -95,12 +102,10 @@ sub new {
            # server.  Such errors are caught later, by the _check()
            # call in wait(). 
        }
            # server.  Such errors are caught later, by the _check()
            # call in wait(). 
        }

-       push @state, {};

     }
 
     return bless {
        conn => \@conn,
     }
 
     return bless {
        conn => \@conn,

-       state => \@state,

        rs => [],
        callback => {},
     }, $class;
        rs => [],
        callback => {},
     }, $class;

@@ -145,9 +150,9 @@ acceptable to nominate the same function as the callback for multiple
 events, by multiple invocations of C<callback()>.
 
 When an event occurs during the execution of C<wait()>, the relevant
 events, by multiple invocations of C<callback()>.
 
 When an event occurs during the execution of C<wait()>, the relevant

-callback function is passed four arguments: the connection that the
-event happened on; a state hash-reference associated with the
-connection; the result-set associated with the connection; and the
+callback function is called with four arguments: the connection that the
+event happened on; the argument that was passed into C<wait()>;
+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
 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

@@ -155,10 +160,10 @@ integer.  If this is zero, then C<wait()> continues as normal; if it
 is anything else, then that value is immediately returned from
 C<wait()>.
 
 is anything else, then that value is immediately returned from
 C<wait()>.
 

-So a typical, simple, event-handler might look like this:
+So a simple event-handler might look like this:

 
  sub got_event {
 
  sub got_event {

-      ($conn, $state, $rs, $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;
       print "event $event on connection ", $conn->option("host"), "\n";
       print "Found ", $rs->size(), " records\n"
          if $event == ZOOM::Event::RECV_SEARCH;

@@ -168,24 +173,30 @@ So a typical, simple, event-handler might look like this:
 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
 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<ref($@) eq "ZOOM::Exception">.  This callback is
+tested using C<$exception-E<gt>isa("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
 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<die $@>.
+the exception using C<die $exception>.

 
 So a simple error-handler might look like this:
 
  sub got_error {
 
 So a simple error-handler might look like this:
 
  sub got_error {

-      ($conn, $state, $rs, $exception) = @_;
+      ($conn, $arg, $rs, $exception) = @_;

       if ($exception->isa("ZOOM::Exception")) {
       if ($exception->isa("ZOOM::Exception")) {

-          print "Caught error $exception -- continuing";
+          print "Caught error $exception - continuing";

           return 0;
       }
       die $exception;
  }
 
           return 0;
       }
       die $exception;
  }
 

-I<### state>
+The C<$arg> argument could be anything at all - it is whatever the
+application code passed into C<wait()>.  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
 
 
 =cut
 

@@ -194,20 +205,44 @@ sub callback {
     my($event, $sub) = @_;
 
     my $old = $this->{callback}->{$event};
     my($event, $sub) = @_;
 
     my $old = $this->{callback}->{$event};

-    $this->{callback}->{$event} = $sub
-       if defined $sub;
+    $this->{callback}->{$event} = $sub;

 
     return $old;
 }
 
 
     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()
 
 =head2 search_pqf()
 

-I<###>
+ $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<ZOOM::Connection> 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 C<wait()>ing on the pod.

 
 B<WARNING!>
 An important simplifying assumption is that each connection can only
 
 B<WARNING!>
 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 a one-to-one mapping between connections and result-sets.  
+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
 
 
 =cut
 

@@ -216,44 +251,90 @@ sub search_pqf {
     my($pqf) = @_;
 
     foreach my $i (0..@{ $this->{conn} }-1) {
     my($pqf) = @_;
 
     foreach my $i (0..@{ $this->{conn} }-1) {

-       $this->{rs}->[$i] = $this->{conn}->[$i]->search_pqf($pqf);
+       my $conn = $this->{conn}->[$i];
+       $this->{rs}->[$i] = $conn->search_pqf($pqf)
+           if !$conn->option("pod_omit");

     }
 }
 
 =head2 wait()
 
     }
 }
 
 =head2 wait()
 

-I<###>
+ $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<wait()>, then that
+same argument is also passed to each callback invocation.  If
+that function returns a non-zero value, then C<wait()> 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<ZOOM::Exception>.  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<wait()> 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<pod_omit> 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();
 
 =cut
 
 sub wait {
     my $this = shift();

+    my($arg) = @_;
+

     my $res = 0;
 
     my $res = 0;
 

-    while ((my $i = ZOOM::event($this->{conn})) != 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];
        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);
        my $ev = $conn->last_event();
        my $evstr = ZOOM::event_str($ev);

-       ZOOM::Log::log("pod", "connection ", $i-1, ": $evstr");
+       ZOOM::Log::log("pod", "connection ", $i-1, ": event $ev ($evstr)");

 
        eval {
            $conn->_check();
        }; if ($@) {
            my $sub = $this->{callback}->{exception};
            die $@ if !defined $sub;
 
        eval {
            $conn->_check();
        }; if ($@) {
            my $sub = $this->{callback}->{exception};
            die $@ if !defined $sub;

-           $res = &$sub($conn, $this->{state}->[$i-1],
-                        $this->{rs}->[$i-1], $@);
+           $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $@);

            last if $res != 0;
            next;
        }
 
        my $sub = $this->{callback}->{$ev};
        if (defined $sub) {
            last if $res != 0;
            next;
        }
 
        my $sub = $this->{callback}->{$ev};
        if (defined $sub) {

-           $res = &$sub($conn, $this->{state}->[$i-1],
-                        $this->{rs}->[$i-1], $ev);
+           $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $ev);

            last if $res != 0;
        } else {
            last if $res != 0;
        } else {

-           ZOOM::Log::log("pod_unhandled", "unhandled event $ev ($evstr)");
+           ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)");

        }
     }
 
        }
     }
 

@@ -261,6 +342,28 @@ sub wait {
 }
 
 
 }
 
 

+=head1 LOGGING
+
+This module generates logging messages using C<ZOOM::Log::log()>,
+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<YAZ_LOG>
+environment variable to C<pod,pod_unhandled>.
+

 =head1 SEE ALSO
 
 The underlying
 =head1 SEE ALSO
 
 The underlying