Tweak.
[irspy-moved-to-github.git] / lib / ZOOM / Pod.pm
1 # $Id: Pod.pm,v 1.22 2006-10-06 11:33:07 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
115 =head2 connections()
116
117  @c = $pod->connections();
118
119 Returns a list of the connection objects in the pod.
120
121 =cut
122
123 sub connections {
124     my $this = shift();
125     return @{ $this->{conn} }
126 }
127
128
129 =head2 option()
130
131  $oldElemSet = $pod->option("elementSetName");
132  $pod->option(elementSetName => "b");
133
134 Sets a specified option in all the connections in a pod.  Returns the
135 old value that the option had in first of the connections in the pod:
136 be aware that this value was not necessarily shared by all the members
137 of the pod ... but that is true often enough to be useful.
138
139 =cut
140
141 sub option {
142     my $this = shift();
143     my($key, $value) = @_;
144
145     my $old = $this->{conn}->[0]->option($key);
146     foreach my $conn (@{ $this->{conn} }) {
147         $conn->option($key, $value);
148     }
149
150     return $old;
151 }
152
153 =head2 callback()
154
155  $pod->callback(ZOOM::Event::RECV_SEARCH, \&completed_search);
156  $pod->callback("exception", sub { print "never mind: $@\n"; return 0 } );
157
158 Registers a callback to be invoked by the pod when an event happens.
159 Callback functions are invoked by C<wait()> (q.v.).
160
161 When registering a callback, the first argument is an event-code - one
162 of those defined in the C<ZOOM::Event> enumeration - and the second is
163 a function reference, or equivalently an inline code-fragment.  It is
164 acceptable to nominate the same function as the callback for multiple
165 events, by multiple invocations of C<callback()>.
166
167 When an event occurs during the execution of C<wait()>, the relevant
168 callback function is called with four arguments: the connection that the
169 event happened on; the argument that was passed into C<wait()>;
170 the result-set associated with the connection (if there is one); and the
171 event-type (so that a single function that handles events of multiple
172 types can switch on the code where necessary).  The callback function
173 can handle the event as it wishes, finishing up by returning an
174 integer.  If this is zero, then C<wait()> continues as normal; if it
175 is anything else, then that value is immediately returned from
176 C<wait()>.
177
178 So a simple event-handler might look like this:
179
180  sub got_event {
181       ($conn, $arg, $rs, $event) = @_;
182       print "event $event on connection ", $conn->option("host"), "\n";
183       print "Found ", $rs->size(), " records\n"
184           if $event == ZOOM::Event::RECV_SEARCH;
185       return 0;
186  }
187
188 In addition to the event-type callbacks discussed above, there is a
189 special callback, C<"exception">, which is invoked if an exception
190 occurs.  This will nearly always be a ZOOM error, but this can be
191 tested using C<$exception-E<gt>isa("ZOOM::Exception")>.  This callback is
192 invoked with the same arguments as described above, except that
193 instead of the event-type, the fourth argument is a copy of the
194 exception, C<$@>.  Exception-handling callbacks may of course re-throw
195 the exception using C<die $exception>.
196
197 So a simple error-handler might look like this:
198
199  sub got_error {
200       ($conn, $arg, $rs, $exception) = @_;
201       if ($exception->isa("ZOOM::Exception")) {
202           print "Caught error $exception - continuing";
203           return 0;
204       }
205       die $exception;
206  }
207
208 The C<$arg> argument could be anything at all - it is whatever the
209 application code passed into C<wait()>.  For example, it could be
210 a reference to a hash indexed by the host string of the connections to
211 yield some per-connection state information.
212 An application might use such information
213 to keep a record of which was the last record
214 retrieved from the associated connection.
215
216 =cut
217
218 sub callback {
219     my $this = shift();
220     my($event, $sub) = @_;
221
222     my $old = $this->{callback}->{$event};
223     $this->{callback}->{$event} = $sub;
224
225     return $old;
226 }
227
228 =head2 remove_callbacks()
229
230  $pod->remove_callbacks();
231
232 Removes all registed callbacks from the pod.  This is useful when the
233 pod has completed one operation and is about to start the next.
234
235 =cut
236
237 sub remove_callbacks {
238     my $this = shift();
239     $this->{callback} = {};
240 }
241
242 =head2 search_pqf()
243
244  $pod->search_pqf("@attr 1=1003 wedel");
245
246 Submits the specified query to each of the connections in a pod,
247 delegating to the same-named method of the C<ZOOM::Connection> class
248 and storing each result in a result-set object associated with the
249 connection that generated it.  Returns no value: success or failure
250 must subsequently be detected by inspecting the events and exceptions
251 generated by C<wait()>ing on the pod.
252
253 B<WARNING!>
254 An important simplifying assumption is that each connection can only
255 have one search active on it at a time: this allows the pod to
256 maintain the one-to-one mapping between connections and result-sets.
257 Submitting a new search on a connection before the old one has
258 completed will result in a total failure in the nature of causality,
259 and the spontaneous existence-failure of the universe.  Try to avoid
260 doing this too often.
261
262 =cut
263
264 sub search_pqf {
265     my $this = shift();
266     my($pqf) = @_;
267
268     foreach my $i (0..@{ $this->{conn} }-1) {
269         my $conn = $this->{conn}->[$i];
270         $this->{rs}->[$i] = $conn->search_pqf($pqf)
271             if !$conn->option("pod_omit");
272     }
273 }
274
275 =head2 wait()
276
277  $err = $pod->wait();
278  # or
279  $err = $pod->wait($arg);
280  die "$pod->wait() failed with error $err" if $err;
281
282 Waits for events on the connections that make up the pod, usually
283 continuing until there are no more events left and then returning
284 zero.  Whenever an event occurs, a callback function is dispatched as
285 described above; if an argument was passed to C<wait()>, then that
286 same argument is also passed to each callback invocation.  If
287 that function returns a non-zero value, then C<wait()> terminates
288 immediately, whether or not any events remain, and returns that value.
289
290 If an error occurs on one of the connection in the pod, then it is
291 normally thrown as a C<ZOOM::Exception>.  If, however, there is a
292 special C<"exception"> callback registered, then the exception object
293 is passed to this instead.  As usual, the return value of the callback
294 indicates whether C<wait()> should continue (return-value 0) or return
295 immediately (any other value).  Exception-handling callbacks may of
296 course re-throw the exception.
297
298 Connections that have the C<pod_omit> option set are omitted from
299 consideration.  This is useful if, for example, a connection that is
300 part of a pod is known to have encountered an unrecoverable error.
301
302 =cut
303
304 sub wait {
305     my $this = shift();
306     my($arg) = @_;
307
308     my $res = 0;
309
310     while (1) {
311         my @conn;
312         my @idxmap; # maps indexes into conn to global indexes
313         foreach my $i (0 .. @{ $this->{conn} }-1) {
314             my $conn = $this->{conn}->[$i];
315             if ($conn->option("pod_omit")) {
316                 #ZOOM::Log::log("pod", "connection $i omitted (",
317                                #$conn->option("host"), ")");
318               } else {
319                   push @conn, $conn;
320                   push @idxmap, $i;
321                   #ZOOM::Log::log("pod", "connection $i included (",
322                                  #$conn->option("host"), ")");
323               }
324         }
325
326         last if @conn == 0;
327         my $i0 = ZOOM::event(\@conn);
328         last if $i0 == 0;
329         my $i = 1+$idxmap[$i0-1];
330         my $conn = $this->{conn}->[$i-1];
331         die "connection-mapping screwup" if $conn ne $conn[$i0-1];
332
333         my $ev = $conn->last_event();
334         my $evstr = ZOOM::event_str($ev);
335         ZOOM::Log::log("pod", "connection ", $i-1, ": event $ev ($evstr)");
336
337         eval {
338             $conn->_check();
339         }; if ($@) {
340             my $sub = $this->{callback}->{exception};
341             die $@ if !defined $sub;
342             $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $@);
343             last if $res != 0;
344             next;
345         }
346
347         my $sub = $this->{callback}->{$ev};
348         if (defined $sub) {
349             $res = &$sub($conn, $arg, $this->{rs}->[$i-1], $ev);
350             last if $res != 0;
351         } else {
352             ZOOM::Log::log("pod_unhandled", "connection ", $i-1, ": unhandled event $ev ($evstr)");
353         }
354     }
355
356     return $res;
357 }
358
359
360 =head1 LOGGING
361
362 This module generates logging messages using C<ZOOM::Log::log()>,
363 which in turn relies on the YAZ logging facilities.  It uses two
364 logging levels:
365
366 =over 4
367
368 =item pod
369
370 Logs all events.
371
372 =item pod_unhandled
373
374 Logs unhandled events, i.e. events of types for which no callback has
375 been registered.
376
377 =back
378
379 These logging levels can be turned on by setting the C<YAZ_LOG>
380 environment variable to C<pod,pod_unhandled>.
381
382 =head1 SEE ALSO
383
384 The underlying
385 C<ZOOM>
386 module (part of the
387 C<Net::Z3950::ZOOM>
388 distribution).
389
390 =head1 AUTHOR
391
392 Mike Taylor, E<lt>mike@indexdata.comE<gt>
393
394 =head1 COPYRIGHT AND LICENCE
395
396 Copyright (C) 2006 by Index Data.
397
398 This library is free software; you can redistribute it and/or modify
399 it under the same terms as Perl itself, either Perl version 5.8.4 or,
400 at your option, any later version of Perl 5 you may have available.
401
402 =cut
403
404
405 1;