callback() now removes a callback if called with an undefined argument.
[irspy-moved-to-github.git] / lib / ZOOM / Pod.pm
1 # $Id: Pod.pm,v 1.20 2006-09-27 12:40:44 mike Exp $
2
3 package ZOOM::Pod;
4
5 use strict;
6 use warnings;
7
8 use ZOOM;
9
10 BEGIN {
11     # Just register the names: this doesn't turn the levels on
12     ZOOM::Log::mask_str("pod");
13     ZOOM::Log::mask_str("pod_unhandled");
14 }
15
16 =head1 NAME
17
18 ZOOM::Pod - Perl extension for handling pods of concurrent ZOOM connections
19
20 =head1 SYNOPSIS
21
22  use ZOOM::Pod;
23
24  $pod = new ZOOM::Pod("bagel.indexdata.com/gils",
25                       "bagel.indexdata.com/marc");
26  $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search);
27  $pod->callback(ZOOM::Event::RECV_RECORD, \&got_record);
28  $pod->search_pqf("the");
29  $err = $pod->wait();
30  die "$pod->wait() failed with error $err" if $err;
31
32  sub completed_search {
33      ($conn, undef, $rs) = @_;
34      print $conn->option("host"), ": found ", $rs->size(), " records\n";
35      $rs->records(0, 1, 0); # Queues a request for the record
36      return 0;
37  }
38
39  sub got_record {
40      ($conn, undef, $rs) = @_;
41      $rec = $rs->record(0);
42      print $conn->option("host"), ": got $rec = '", $rec->render(), "'\n";
43      return 0;
44  }
45
46 =head1 DESCRIPTION
47
48 C<ZOOM:Pod> provides an API that simplifies asynchronous programming
49 using ZOOM.  A pod is a collection of asynchronous connections that
50 are run simultaneously to achieve broadcast searching and retrieval.
51 When a pod is created, a set of connections (or target-strings to
52 connect to) are specified.  Thereafter, they are treated as a unit,
53 and methods for searching, option-setting, etc. that are invoked on
54 the pod are delegated to each of its members.
55
56 The key method on a pod is C<wait()>, which enters a loop accepting
57 and dispatching events occurring on any of the connections in the pod.
58 Unless interrupted,the loop runs until there are no more events left,
59 i.e. no searches are outstanding and no requested records have still
60 to be received.
61
62 Event dispatching is done by means of callback functions, which can be
63 registered for each event.  A registered callback is invoked whenever
64 a corresponding event occurs.  A special callback can be nominated to
65 handle errors.
66
67 =head1 METHODS
68
69 =head2 new()
70
71  $pod = new ZOOM::Pod($conn1, $conn2, $conn3);
72  $pod = new ZOOM::Pod("bagel.indexdata.com/gils",
73                       "bagel.indexdata.com/marc");
74
75 Creates a new pod containing one or more connections.  Each connection
76 may be specified either by an existing C<ZOOM::Connection> object,
77 which I<must> be asynchronous; or by a ZOOM target string, in which
78 case the pod module will make the connection object itself.
79
80 Returns the new pod.
81
82 =cut
83
84 # Functionality to be added:
85 #
86 #       If the constructor's first argument is a number, then it is
87 #       taken as a limit on the number of connections to handle at any
88 #       one time.  In this case, the pod initially multiplexes between
89 #       the first I<n> connections, and brings further connections
90 #       into the active subset whenever already-active connections are
91 #       closed.
92
93 sub new {
94     my $class = shift();
95     my(@conn) = @_;
96
97     die "$class with no connections" if @conn == 0;
98     foreach my $conn (@conn) {
99         if (!ref $conn) {
100             $conn = new ZOOM::Connection($conn, 0, async => 1);
101             # The $conn object is always made, even if no there's no
102             # server.  Such errors are caught later, by the _check()
103             # call in wait(). 
104         }
105     }
106
107     return bless {
108         conn => \@conn,
109         rs => [],
110         callback => {},
111     }, $class;
112 }
113
114 =head2 option()
115
116  $oldElemSet = $pod->option("elementSetName");
117  $pod->option(elementSetName => "b");
118
119 Sets a specified option in all the connections in a pod.  Returns the
120 old value that the option had in first of the connections in the pod:
121 be aware that this value was not necessarily shared by all the members
122 of the pod ... but that is true often enough to be useful.
123
124 =cut
125
126 sub option {
127     my $this = shift();
128     my($key, $value) = @_;
129
130     my $old = $this->{conn}->[0]->option($key);
131     foreach my $conn (@{ $this->{conn} }) {
132         $conn->option($key, $value);
133     }
134
135     return $old;
136 }
137
138 =head2 callback()
139
140  $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search);
141  $pod->callback("exception", sub { print "never mind: $@\n"; return 0 } );
142
143 Registers a callback to be invoked by the pod when an event happens.
144 Callback functions are invoked by C<wait()> (q.v.).
145
146 When registering a callback, the first argument is an event-code - one
147 of those defined in the C<ZOOM::Event> enumeration - and the second is
148 a function reference, or equivalently an inline code-fragment.  It is
149 acceptable to nominate the same function as the callback for multiple
150 events, by multiple invocations of C<callback()>.
151
152 When an event occurs during the execution of C<wait()>, the relevant
153 callback function is called with four arguments: the connection that the
154 event happened on; the argument that was passed into C<wait()>;
155 the result-set associated with the connection (if there is one); and the
156 event-type (so that a single function that handles events of multiple
157 types can switch on the code where necessary).  The callback function
158 can handle the event as it wishes, finishing up by returning an
159 integer.  If this is zero, then C<wait()> continues as normal; if it
160 is anything else, then that value is immediately returned from
161 C<wait()>.
162
163 So a simple event-handler might look like this:
164
165  sub got_event {
166       ($conn, $arg, $rs, $event) = @_;
167       print "event $event on connection ", $conn->option("host"), "\n";
168       print "Found ", $rs->size(), " records\n"
169           if $event == ZOOM::Event::RECV_SEARCH;
170       return 0;
171  }
172
173 In addition to the event-type callbacks discussed above, there is a
174 special callback, C<"exception">, which is invoked if an exception
175 occurs.  This will nearly always be a ZOOM error, but this can be
176 tested using C<$exception-E<gt>isa("ZOOM::Exception")>.  This callback is
177 invoked with the same arguments as described above, except that
178 instead of the event-type, the fourth argument is a copy of the
179 exception, C<$@>.  Exception-handling callbacks may of course re-throw
180 the exception using C<die $exception>.
181
182 So a simple error-handler might look like this:
183
184  sub got_error {
185       ($conn, $arg, $rs, $exception) = @_;
186       if ($exception->isa("ZOOM::Exception")) {
187           print "Caught error $exception - continuing";
188           return 0;
189       }
190       die $exception;
191  }
192
193 The C<$arg> argument could be anything at all - it is whatever the
194 application code passed into C<wait()>.  For example, it could be
195 a reference to a hash indexed by the host string of the connections to
196 yield some per-connection state information.
197 An application might use such information
198 to keep a record of which was the last record
199 retrieved from the associated connection.
200
201 =cut
202
203 sub callback {
204     my $this = shift();
205     my($event, $sub) = @_;
206
207     my $old = $this->{callback}->{$event};
208     $this->{callback}->{$event} = $sub;
209
210     return $old;
211 }
212
213 =head2 search_pqf()
214
215  $pod->search_pqf("@attr 1=1003 wedel");
216
217 Submits the specified query to each of the connections in a pod,
218 delegating to the same-named method of the C<ZOOM::Connection> class
219 and storing each result in a result-set object associated with the
220 connection that generated it.  Returns no value: success or failure
221 must subsequently be detected by inspecting the events and exceptions
222 generated by C<wait()>ing on the pod.
223
224 B<WARNING!>
225 An important simplifying assumption is that each connection can only
226 have one search active on it at a time: this allows the pod to
227 maintain the one-to-one mapping between connections and result-sets.
228 Submitting a new search on a connection before the old one has
229 completed will result in a total failure in the nature of causality,
230 and the spontaneous existence-failure of the universe.  Try to avoid
231 doing this too often.
232
233 =cut
234
235 sub search_pqf {
236     my $this = shift();
237     my($pqf) = @_;
238
239     foreach my $i (0..@{ $this->{conn} }-1) {
240         my $conn = $this->{conn}->[$i];
241         $this->{rs}->[$i] = $conn->search_pqf($pqf)
242             if !$conn->option("pod_omit");
243     }
244 }
245
246 =head2 wait()
247
248  $err = $pod->wait();
249  # or
250  $err = $pod->wait($arg);
251  die "$pod->wait() failed with error $err" if $err;
252
253 Waits for events on the connections that make up the pod, usually
254 continuing until there are no more events left and then returning
255 zero.  Whenever an event occurs, a callback function is dispatched as
256 described above; if an argument was passed to C<wait()>, then that
257 same argument is also passed to each callback invocation.  If
258 that function returns a non-zero value, then C<wait()> terminates
259 immediately, whether or not any events remain, and returns that value.
260
261 If an error occurs on one of the connection in the pod, then it is
262 normally thrown as a C<ZOOM::Exception>.  If, however, there is a
263 special C<"exception"> callback registered, then the exception object
264 is passed to this instead.  As usual, the return value of the callback
265 indicates whether C<wait()> should continue (return-value 0) or return
266 immediately (any other value).  Exception-handling callbacks may of
267 course re-throw the exception.
268
269 Connections that have the C<pod_omit> option set are omitted from
270 consideration.  This is useful if, for example, a connection that is
271 part of a pod is known to have encountered an unrecoverable error.
272
273 =cut
274
275 sub wait {
276     my $this = shift();
277     my($arg) = @_;
278
279     my $res = 0;
280
281     while (1) {
282         my @conn;
283         my @idxmap; # maps indexes into conn to global indexes
284         foreach my $i (0 .. @{ $this->{conn} }-1) {
285             my $conn = $this->{conn}->[$i];
286             if ($conn->option("pod_omit")) {
287                 #ZOOM::Log::log("pod", "connection $i omitted (",
288                                #$conn->option("host"), ")");
289               } else {
290                   push @conn, $conn;
291                   push @idxmap, $i;
292                   #ZOOM::Log::log("pod", "connection $i included (",
293                                  #$conn->option("host"), ")");
294               }
295         }
296
297         last if @conn == 0;
298         my $i0 = ZOOM::event(\@conn);
299         last if $i0 == 0;
300         my $i = 1+$idxmap[$i0-1];
301         my $conn = $this->{conn}->[$i-1];
302         die "connection-mapping screwup" if $conn ne $conn[$i0-1];
303
304         my $ev = $conn->last_event();
305         my $evstr = ZOOM::event_str($ev);
306         ZOOM::Log::log("pod", "connection ", $i-1, ": event $ev ($evstr)");
307
308         eval {
309             $conn->_check();
310         }; if ($@) {
311             my $sub = $this->{callback}->{exception};
312             die $@ if !defined $sub;
313             $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $@);
314             last if $res != 0;
315             next;
316         }
317
318         my $sub = $this->{callback}->{$ev};
319         if (defined $sub) {
320             $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $ev);
321             last if $res != 0;
322         } else {
323             ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)");
324         }
325     }
326
327     return $res;
328 }
329
330
331 =head1 LOGGING
332
333 This module generates logging messages using C<ZOOM::Log::log()>,
334 which in turn relies on the YAZ logging facilities.  It uses two
335 logging levels:
336
337 =over 4
338
339 =item pod
340
341 Logs all events.
342
343 =item pod_unhandled
344
345 Logs unhandled events, i.e. events of types for which no callback has
346 been registered.
347
348 =back
349
350 These logging levels can be turned on by setting the C<YAZ_LOG>
351 environment variable to C<pod,pod_unhandled>.
352
353 =head1 SEE ALSO
354
355 The underlying
356 C<ZOOM>
357 module (part of the
358 C<Net::Z3950::ZOOM>
359 distribution).
360
361 =head1 AUTHOR
362
363 Mike Taylor, E<lt>mike@indexdata.comE<gt>
364
365 =head1 COPYRIGHT AND LICENCE
366
367 Copyright (C) 2006 by Index Data.
368
369 This library is free software; you can redistribute it and/or modify
370 it under the same terms as Perl itself, either Perl version 5.8.4 or,
371 at your option, any later version of Perl 5 you may have available.
372
373 =cut
374
375
376 1;