Change wait()/callback API to use a single udata argument

diff --git a/lib/ZOOM/Pod.pm b/lib/ZOOM/Pod.pm
index a59d3b1..23c714d 100644 (file)
--- a/lib/ZOOM/Pod.pm
+++ b/lib/ZOOM/Pod.pm
@@ -1,4 +1,4 @@
-# $Id: Pod.pm,v 1.12 2006-06-07 10:43:22 mike Exp $
+# $Id: Pod.pm,v 1.13 2006-06-21 14:31:24 mike Exp $

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

@@ -95,7 +95,6 @@ sub new {
     my(@conn) = @_;
 
     die "$class with no connections" if @conn == 0;
     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);

@@ -103,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;

@@ -154,8 +151,8 @@ events, by multiple invocations of C<callback()>.
 
 When an event occurs during the execution of C<wait()>, the relevant
 callback function is called with four arguments: the connection that the
 
 When an event occurs during the execution of C<wait()>, the relevant
 callback function is called with 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
+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

@@ -166,7 +163,7 @@ C<wait()>.
 So a simple event-handler might look like this:
 
  sub got_event {
 So a simple event-handler might look like this:
 
  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;

@@ -185,7 +182,7 @@ 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")) {
           print "Caught error $exception - continuing";
           return 0;
       if ($exception->isa("ZOOM::Exception")) {
           print "Caught error $exception - continuing";
           return 0;

@@ -193,13 +190,13 @@ So a simple error-handler might look like this:
       die $exception;
  }
 
       die $exception;
  }
 

-The C<$state> argument is a reference to an initially empty hash,
-which the application can use as it sees fit, to store its own
-connection-relation information.  For example, an application might
-use C<$state-E<gt>{last}> to keep a record of which was the last record
-retrieved from the associated connection.  The pod module itself does
-not use the state hash at all, and applications are also welcome to
-ignore it if they do not need it.
+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
 

@@ -248,12 +245,15 @@ sub search_pqf {
 =head2 wait()
 
  $err = $pod->wait();
 =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
  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
+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.
 
 that function returns a non-zero value, then C<wait()> terminates
 immediately, whether or not any events remain, and returns that value.
 

@@ -269,8 +269,9 @@ course re-throw the exception.
 
 sub wait {
     my $this = shift();
 
 sub wait {
     my $this = shift();

-    my $res = 0;
+    my($arg) = @_;

 
 

+    my $res = 0;

     while ((my $i = ZOOM::event($this->{conn})) != 0) {
        my $conn = $this->{conn}->[$i-1];
        my $ev = $conn->last_event();
     while ((my $i = ZOOM::event($this->{conn})) != 0) {
        my $conn = $this->{conn}->[$i-1];
        my $ev = $conn->last_event();

@@ -282,16 +283,14 @@ sub wait {
        }; if ($@) {
            my $sub = $this->{callback}->{exception};
            die $@ if !defined $sub;
        }; 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 {
            ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)");
            last if $res != 0;
        } else {
            ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)");

diff --git a/test-pod.pl b/test-pod.pl
index e37a98d..aea63d9 100644 (file)
--- a/test-pod.pl
+++ b/test-pod.pl
@@ -1,6 +1,6 @@
 #!/usr/bin/perl -w
 
 #!/usr/bin/perl -w
 

-# $Id: test-pod.pl,v 1.7 2006-05-10 15:55:19 mike Exp $
+# $Id: test-pod.pl,v 1.8 2006-06-21 14:31:23 mike Exp $

 #
 # Run like this:
 #      YAZ_LOG=pod perl -I lib test-pod.pl "bagel.indexdata.com/gils" "bagel.indexdata.com/marc"
 #
 # Run like this:
 #      YAZ_LOG=pod perl -I lib test-pod.pl "bagel.indexdata.com/gils" "bagel.indexdata.com/marc"

@@ -22,25 +22,30 @@ $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");
 $pod->callback(ZOOM::Event::RECV_RECORD, \&got_record);
 #$pod->callback(exception => \&exception_thrown);
 $pod->search_pqf("the");

-my $err = $pod->wait();
+my $err = $pod->wait({});

 die "$pod->wait() failed with error $err" if $err;
 
 sub completed_search {
 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);
+    my($conn, $arg, $rs, $event) = @_;
+
+    my $host = $conn->option("host");
+    print "$host : found ", $rs->size(), " records\n";
+    my %state = (next_to_show => 0, next_to_fetch => 0);
+    request_records($conn, $rs, \%state, 2);
+    $arg->{$host} = \%state;

     return 0;
 }
 
 sub got_record {
     return 0;
 }
 
 sub got_record {

-    my($conn, $state, $rs, $event) = @_;
+    my($conn, $arg, $rs, $event) = @_;
+
+    my $host = $conn->option("host");
+    my %state = $arg->{$host};

 
     {
        # Sanity-checking assertions.  These should be impossible
 
     {
        # Sanity-checking assertions.  These should be impossible

-       my $ns = $state->{next_to_show};
-       my $nf = $state->{next_to_fetch};
+       my $ns = $arg->{$host}->{next_to_show};
+       my $nf = $arg->{$host}->{next_to_fetch};

        if ($ns > $nf) {
            die "next_to_show > next_to_fetch ($ns > $nf)";
        } elsif ($ns == $nf) {
        if ($ns > $nf) {
            die "next_to_show > next_to_fetch ($ns > $nf)";
        } elsif ($ns == $nf) {

@@ -48,17 +53,17 @@ sub got_record {
        }
     }
 
        }
     }
 

-    my $i = $state->{next_to_show}++;
+    my $i = $arg->{$host}->{next_to_show}++;

     my $rec = $rs->record($i);
     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;
+    print "$host: record $i is ", render_record($rec), "\n";
+    request_records($conn, $rs, $arg->{$host}, 3)
+       if $i == $arg->{$host}->{next_to_fetch}-1;

 
     return 0;
 }
 
 sub exception_thrown {
 
     return 0;
 }
 
 sub exception_thrown {

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

     print "Uh-oh!  $exception\n";
     return 0;
 }
     print "Uh-oh!  $exception\n";
     return 0;
 }