File Coverage

blib/lib/Net/Z3950/UDDI.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package Net::Z3950::UDDI;
2              
3 1     1   41964 use 5.008;
  1         3  
  1         39  
4 1     1   5 use strict;
  1         3  
  1         33  
5 1     1   5 use warnings;
  1         25  
  1         95  
6              
7             our $VERSION = '0.04';
8              
9 1     1   22372 use ZOOM; # Used only for ZOOM::Exception and related constants
  0            
  0            
10             use Data::Dumper;
11             $Data::Dumper::Indent = 1;
12              
13             use Net::Z3950::SimpleServer;
14             use Net::Z3950::OID; # Provided by the SimpleServer package
15             use Net::Z3950::UDDI::Config;
16             use Net::Z3950::UDDI::Session;
17              
18              
19             =head1 NAME
20              
21             Net::Z3950::UDDI - Perl extension for querying UDDI services using Z39.50
22              
23             =head1 SYNOPSIS
24              
25             use Net::Z3950::UDDI;
26             $handle = new Net::Z3950::UDDI($configFile);
27             $handle->launch_server("myAppName", @yazOptions);
28              
29             =head1 DESCRIPTION
30              
31             This library provides all the guts of the Z39.50-to-UDDI gateway,
32             C (which is supplied along with it). In the same package
33             comes an underlying library, C, which supports a
34             subset of UDDI but supports it really well, reliably, and with good
35             error-reporting -- unlike, to pick the module-name out of the thin
36             air, C for example. Also included in the package are the
37             swarm of auxiliary modules which C and
38             C use, and C, a simple command-line
39             test-harness to exercise the UDDI::HalfDecent library.
40              
41             The gateway provides a server that understands not only ANSI/NISO
42             Z39.50 (aka. ISO 23950), but also the related web-service protocols
43             SRU (in both its GET and POST forms) and SRW (SRU over SOAP).
44              
45             The API of the C module itself is trivial: the
46             synopsis above captures it in its entirely, and is essentially the
47             whole of the code of the C script. I'll document it anyway,
48             but the important stuff is elsewhere (see below).
49              
50             =head1 METHODS
51              
52             =head2 new()
53              
54             $handle = new Net::Z3950::UDDI($configFile);
55              
56             Creates and returns a new Z39.50-to-UDDI gateway object, configured by
57             the file named as C<$configFile>.
58              
59             =cut
60              
61             sub new {
62             my $class = shift();
63             my($configFile) = @_;
64              
65             my $this = bless {
66             configFile => $configFile,
67             config => undef,
68             }, $class;
69              
70             $this->_maybe_load_config(1);
71             foreach my $db (sort keys %{ $this->{config}->{contents}->{databases} }) {
72             warn "Found database: $db\n";
73             }
74              
75             $this->{server} = new Net::Z3950::SimpleServer(
76             GHANDLE => $this,
77             INIT => \&_init_handler,
78             SEARCH => \&_search_handler,
79             FETCH => \&_fetch_handler,
80             );
81              
82             return $this;
83             }
84              
85              
86             # Used only as read-only data for the configuration compiler
87             our %_const = (
88             package => __PACKAGE__,
89             version => $VERSION,
90             );
91              
92             sub _maybe_load_config {
93             my $this = shift();
94              
95             my $configFile = $this->{configFile};
96             my $config = $this->{config};
97             my @s = stat($configFile) or die "can't stat '$configFile': $!";
98             my $mtime = $s[9];
99              
100             if (!defined $config || $mtime > $config->timestamp()) {
101             warn "configuation file '$configFile' changed: reloading\n"
102             if defined $config;
103             $this->{config} = new Net::Z3950::UDDI::Config($this, $configFile,
104             \%_const)
105             or die "can't compile configuration '$configFile'";
106             }
107             }
108              
109              
110             =head2 launch_server()
111              
112             $handle->launch_server($label, @yazOptions);
113              
114             Launches the gateway C<$handle>, using the C<$label> string in logging
115             output and running in accordance with the specified YAZ options. The
116             implications of this are discussed in the C documentation.
117              
118             =cut
119              
120             sub launch_server {
121             my $this = shift();
122             my($label, @argv) = @_;
123              
124             return $this->{server}->launch_server($label, @argv);
125             }
126              
127              
128             sub _init_handler { _eval_wrapper(\&_real_init_handler, @_) }
129             sub _search_handler { _eval_wrapper(\&_real_search_handler, @_) }
130             sub _fetch_handler { _eval_wrapper(\&_real_fetch_handler, @_) }
131              
132              
133             # This can be used by the _real_*_handler() callbacks to signal
134             # exceptions that will be caught by _eval_wrapper() and translated
135             # into BIB-1 diagnostics for the client
136             #
137             sub _throw {
138             my $this = shift();
139             if (!ref $this) {
140             # Called as a function rather than a method: reinstate argument
141             unshift @_, $this;
142             }
143              
144             my($code, $addinfo, $diagset) = @_;
145             $diagset ||= "Bib-1";
146             die new ZOOM::Exception($code, undef, $addinfo, $diagset);
147             }
148              
149              
150             sub _eval_wrapper {
151             my $coderef = shift();
152             my $args = shift();
153             my $warn = $ENV{EXCEPTION_DEBUG} || 0;
154              
155             $args->{GHANDLE}->_maybe_load_config();
156              
157             eval {
158             &$coderef($args, @_);
159             }; if (ref $@ && $@->isa('ZOOM::Exception')) {
160             warn "ZOOM error $@" if $warn > 1;
161             if ($@->diagset() eq 'Bib-1') {
162             warn "Bib-1 ZOOM error" if $warn > 0;
163             $args->{ERR_CODE} = $@->code();
164             $args->{ERR_STR} = $@->addinfo();
165             } elsif ($@->diagset() eq 'info:srw/diagnostic/1') {
166             warn "SRU ZOOM error" if $warn > 0;
167             $args->{ERR_CODE} =
168             Net::Z3950::SimpleServer::yaz_diag_srw_to_bib1($@->code());
169             $args->{ERR_STR} = $@->addinfo();
170             } elsif ($@->diagset() eq 'ZOOM' &&
171             $@->code() eq ZOOM::Error::CONNECT) {
172             # Special case for when the host is down
173             warn "Special case: host unavailable" if $warn > 0;
174             $args->{ERR_CODE} = 109;
175             $args->{ERR_STR} = $@->addinfo();
176             } else {
177             warn "Non-Bib-1, non-SRU ZOOM error" if $warn > 0;
178             $args->{ERR_CODE} = 100;
179             $args->{ERR_STR} = $@->message() || $@->addinfo();
180             }
181             } elsif ($@) {
182             # Non-ZOOM exceptions may be generated by the Perl
183             # interpreter, for example if we try to call a method that
184             # does not exist in the relevant class. These should be
185             # considered fatal and not reported to the client.
186             die $@;
187             }
188             }
189              
190              
191             sub _real_init_handler {
192             my($args) = @_;
193             my $gh = $args->{GHANDLE};
194              
195             die "GHANDLE not defined: is your SimpleServer too old? (Need 1.06)"
196             if !defined $gh;
197              
198             $args->{HANDLE} = new Net::Z3950::UDDI::Session($gh,
199             $args->{USER},
200             $args->{PASS});
201              
202             my $zc = $gh->{config}->{contents}->{zparams};
203             $args->{IMP_ID} = $zc->{"implementation-id"} ||
204             81;
205             $args->{IMP_NAME} = $zc->{"implementation-name"} ||
206             "z2uddi Z39.50-to-UDDI Gateway";
207             $args->{IMP_VER} = $zc->{"implementation-version"} ||
208             $Net::Z3950::UDDI::VERSION;
209             }
210              
211              
212             sub _real_search_handler {
213             my($args) = @_;
214             my $gh = $args->{GHANDLE};
215             my $session = $args->{HANDLE};
216              
217             # Too many databases
218             _throw(111) if @{ $args->{DATABASES}} > 1;
219             my $dbname = $args->{DATABASES}->[0];
220             my $rs = $session->search($dbname, $gh->{config},
221             $args->{SETNAME}, $args->{RPN});
222             $args->{HITS} = $rs->count();
223             }
224              
225              
226             sub _real_fetch_handler {
227             my($args) = @_;
228             my $gh = $args->{GHANDLE};
229             my $session = $args->{HANDLE};
230              
231             my $setname = $args->{SETNAME};
232             my $rs = $session->resultset_by_name($setname)
233             or _throw(30, $setname);
234              
235             my $offset1 = $args->{OFFSET};
236             my $xml = $rs->record_as_xml($offset1-1)
237             or _throw(13, $offset1);
238              
239             $args->{REQ_FORM} eq Net::Z3950::OID::xml
240             or _throw(238, "xml");
241              
242             $args->{RECORD} = $xml;
243             }
244              
245              
246             =head1 SEE ALSO
247              
248             =head2 Documentation Roadmap
249              
250             Apart from the C module itself, there are many other
251             components that go to make up the package that provides the
252             Z39.50-to-UDDI gateway. Each is documented separately, but here is a
253             basic overview.
254              
255             C is the gateway program, and consists only of a trival
256             invocation of the C library. That in turn uses four
257             worker classes:
258             C
259             parses the configuration file,
260             C
261             represents a front-end session which may reference several databases
262             and result-sets,
263             C
264             represents a connection to a back-end database
265             and
266             C
267             represents a set of records that result from a search.
268             The C documentation also describes the configuration file format.
269              
270             Both the database and result-set classes are virtual: they are
271             not instantiated directly, but only as subclasses specific to
272             particular back-ends such as UDDI and SOAP, using modules such as
273             C
274             and
275             C.
276             (These backend-specific modules are not individually documented.)
277              
278             UDDI access is provided by a stand-alone module C,
279             which may be useful in other applications. This in turn uses two
280             worker classes,
281             C
282             and
283             C.
284             Others may follow as its UDDI capabilities are extended and
285             generalised. The program C provides a simple command-line
286             interface to the UDDI library.
287              
288             =head2 Prerequsites
289              
290             Apart from the modules included in the C
291             distribution, the following software is also required.
292              
293             =over 4
294              
295             =item *
296              
297             The C module provides a Perl API to the YAZ
298             GFS (Generic Frontend Server) which provides server-side Z39.50, SRU
299             and SRW protocol capabilities.
300              
301             =item *
302              
303             Index Data's fine YAZ toolkit provides the underlying GFS itself.
304             http://indexdata.com/yaz/
305              
306             =item *
307              
308             The C module implements the exceptions used by
309             C.
310              
311             =item *
312              
313             The C module provides the C class
314             used within the gateway: C-based exceptions are
315             translated into ZOOM exceptions as required. Note that ZOOM is used
316             I for C, and not for any of its other
317             facilities: specifically, the gateway does not act as a Z39.50, SRU or
318             SRW client.
319              
320             =item *
321              
322             The C module provides the parser for the gateway's configuration
323             file. (Its error-messages are not very good: it might be possible to
324             improve matters by using C or C instead.)
325              
326             =item *
327              
328             C provides the much-needed C
329             function to quote funny characters such as less-than and greater-than
330             for insertion into XML. It took me I to find a standard
331             library, available, as Debian package, that provided this simple but
332             indispensible function.
333              
334             =item *
335              
336             The C module (Lib-WWW-Perl) is used to send and receive HTTP
337             requests and responses for the C library.
338              
339             =item *
340              
341             C is used to parse the XML-formatted UDDI responses. In
342             order to use XPath on the parsed documents, it's necessary to have
343             C: this is included in C from
344             version 1.61 onwards, but will need to be downloaded and installed
345             separately if your LibXML is older than that.
346              
347             =item *
348              
349             The C module, which provides horrible, unreliable,
350             impossible-to-debug SOAP client facilities that may be used to enable
351             invocation of arbitrary SOAP services that, if you're very lucky,
352             might work, or at least produce a comprehensible diagnostic. The
353             distribution includes most of the code to run a
354             Z39.50 gateway to arbitrary SOAP services, but since it relies on the
355             notoriously unreliable C as the back-end, this facility is
356             not as useful or robust as one might wish (and certainly not solid
357             enough to build the UDDI support on, as I had hoped).
358              
359             =back
360              
361             =head1 AUTHOR
362              
363             Mike Taylor Emike@miketaylor.org.ukE
364              
365             I gratefully acknowledge the funding provided by the United States
366             Geological Survey (USGS) to create this software, and the sterling
367             efforts of Eliot Christian to forge the commercial arrangements.
368              
369             =head1 COPYRIGHT AND LICENSE
370              
371             Copyright (C) 2007 by Mike Taylor.
372              
373             This library is distributed under the terms of GNU General Public
374             License, version 2. A copy of the license is included in the file
375             "GPL-2" in this distribution.
376              
377             =cut
378              
379             1;