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