lib/ZOOM/Pod.pm

   1 # $Id: Pod.pm,v 1.5 2006-05-10 16:01:04 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 name
  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 I<###>
  49
  50 =head1 METHODS
  51
  52 =cut
  53
  54 sub new {
  55     my $class = shift();
  56     my(@conn) = @_;
  57
  58     die "$class with no connections" if @conn == 0;
  59     my @state; # Hashrefs with application state associated with connections
  60     foreach my $conn (@conn) {
  61         if (!ref $conn) {
  62             $conn = new ZOOM::Connection($conn, 0, async => 1);
  63             # The $conn object is always made, even if no there's no
  64             # server.  Such errors are caught later, by the _check()
  65             # call in wait().
  66         }
  67         push @state, {};
  68     }
  69
  70     return bless {
  71         conn => \@conn,
  72         state => \@state,
  73         rs => [],
  74         callback => {},
  75     }, $class;
  76 }
  77
  78 sub option {
  79     my $this = shift();
  80     my($key, $value) = @_;
  81
  82     foreach my $conn (@{ $this->{conn} }) {
  83         $conn->option($key, $value);
  84     }
  85 }
  86
  87 sub callback {
  88     my $this = shift();
  89     my($event, $sub) = @_;
  90
  91     my $old = $this->{callback}->{$event};
  92     $this->{callback}->{$event} = $sub
  93         if defined $sub;
  94
  95     return $old;
  96 }
  97
  98 sub search_pqf {
  99     my $this = shift();
 100     my($pqf) = @_;
 101
 102     foreach my $i (0..@{ $this->{conn} }-1) {
 103         $this->{rs}->[$i] = $this->{conn}->[$i]->search_pqf($pqf);
 104     }
 105 }
 106
 107 sub wait {
 108     my $this = shift();
 109     my $res = 0;
 110
 111     while ((my $i = ZOOM::event($this->{conn})) != 0) {
 112         my $conn = $this->{conn}->[$i-1];
 113         my $ev = $conn->last_event();
 114         my $evstr = ZOOM::event_str($ev);
 115         ZOOM::Log::log("pod", "connection ", $i-1, ": $evstr");
 116
 117         eval {
 118             $conn->_check();
 119         }; if ($@) {
 120             my $sub = $this->{callback}->{exception};
 121             die $@ if !defined $sub;
 122             $res = &$sub($conn, $this->{state}->[$i-1],
 123                          $this->{rs}->[$i-1], $@);
 124             last if $res != 0;
 125             next;
 126         }
 127
 128         my $sub = $this->{callback}->{$ev};
 129         if (defined $sub) {
 130             $res = &$sub($conn, $this->{state}->[$i-1],
 131                          $this->{rs}->[$i-1], $ev);
 132             last if $res != 0;
 133         } else {
 134             ZOOM::Log::log("pod_unhandled", "unhandled event $ev ($evstr)");
 135         }
 136     }
 137
 138     return $res;
 139 }
 140
 141
 142 =head1 SEE ALSO
 143
 144 The underlying
 145 C<ZOOM>
 146 module (part of the
 147 C<Net::Z3950::ZOOM>
 148 distribution).
 149
 150 =head1 AUTHOR
 151
 152 Mike Taylor, E<lt>mike@indexdata.comE<gt>
 153
 154 =head1 COPYRIGHT AND LICENCE
 155
 156 Copyright (C) 2006 by Index Data.
 157
 158 This library is free software; you can redistribute it and/or modify
 159 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 160 at your option, any later version of Perl 5 you may have available.
 161
 162 =cut
 163
 164
 165 1;