0
|
1 # $Id: soap.pm,v 1.5 2002/10/22 07:45:14 lapp Exp $
|
|
2 #
|
|
3 # BioPerl module Bio::DB::Biblio::soap.pm
|
|
4 #
|
|
5 # Cared for by Martin Senger <senger@ebi.ac.uk>
|
|
6 # For copyright and disclaimer see below.
|
|
7
|
|
8 # POD documentation - main docs before the code
|
|
9
|
|
10 =head1 NAME
|
|
11
|
|
12 Bio::DB::Biblio::soap - A SOAP-based access to a bibliographic query service
|
|
13
|
|
14 =head1 SYNOPSIS
|
|
15
|
|
16 Do not use this object directly, it is recommended to access it and use
|
|
17 it through the I<Bio::Biblio> module:
|
|
18
|
|
19 use Bio::Biblio;
|
|
20 my $biblio = new Bio::Biblio (-access => 'soap');
|
|
21
|
|
22 =head1 DESCRIPTION
|
|
23
|
|
24 This object contains the real implementation of a Bibliographic Query
|
|
25 Service as defined in L<Bio::DB::BiblioI> - using a SOAP protocol
|
|
26 to access a WebService (a remote server) that represents a
|
|
27 bibliographic repository.
|
|
28
|
|
29 =head1 FEEDBACK
|
|
30
|
|
31 =head2 Mailing Lists
|
|
32
|
|
33 User feedback is an integral part of the evolution of this and other
|
|
34 Bioperl modules. Send your comments and suggestions preferably to
|
|
35 the Bioperl mailing list. Your participation is much appreciated.
|
|
36
|
|
37 bioperl-l@bioperl.org - General discussion
|
|
38 http://bioperl.org/MailList.shtml - About the mailing lists
|
|
39
|
|
40 =head2 Reporting Bugs
|
|
41
|
|
42 Report bugs to the Bioperl bug tracking system to help us keep track
|
|
43 of the bugs and their resolution. Bug reports can be submitted via
|
|
44 email or the web:
|
|
45
|
|
46 bioperl-bugs@bioperl.org
|
|
47 http://bugzilla.bioperl.org/
|
|
48
|
|
49 =head1 AUTHOR
|
|
50
|
|
51 Martin Senger (senger@ebi.ac.uk)
|
|
52
|
|
53 =head1 COPYRIGHT
|
|
54
|
|
55 Copyright (c) 2002 European Bioinformatics Institute. All Rights Reserved.
|
|
56
|
|
57 This module is free software; you can redistribute it and/or modify
|
|
58 it under the same terms as Perl itself.
|
|
59
|
|
60 =head1 DISCLAIMER
|
|
61
|
|
62 This software is provided "as is" without warranty of any kind.
|
|
63
|
|
64 =head1 BUGS AND LIMITATIONS
|
|
65
|
|
66 =over
|
|
67
|
|
68 =item *
|
|
69
|
|
70 Methods returning a boolean value (I<has_next>, I<exists> and
|
|
71 I<contains>) can be used only with SOAP::Lite version 0.52 and newer
|
|
72 (probably due to a bug in the older SOAP::Lite).
|
|
73
|
|
74 =item *
|
|
75
|
|
76 It does not use WSDL. Coming soon...
|
|
77
|
|
78 =item *
|
|
79
|
|
80 There is an open question to discuss: should the service return
|
|
81 citations as type I<string> or rather as type I<base64>? What is
|
|
82 faster? What is better for keeping non-ASCII characters untouched? How
|
|
83 the decision would be influenced if the transparent compression
|
|
84 support is introduced?
|
|
85
|
|
86 =item *
|
|
87
|
|
88 More testing and debugging needed to ensure that returned citations
|
|
89 are properly transferred even if they contain foreign characters.
|
|
90
|
|
91 =back
|
|
92
|
|
93 =head1 APPENDIX
|
|
94
|
|
95 The main documentation details are to be found in
|
|
96 L<Bio::DB::BiblioI>.
|
|
97
|
|
98 Here is the rest of the object methods. Internal methods are preceded
|
|
99 with an underscore _.
|
|
100
|
|
101 =cut
|
|
102
|
|
103
|
|
104 # Let the code begin...
|
|
105
|
|
106
|
|
107 package Bio::DB::Biblio::soap;
|
|
108 use vars qw(@ISA $VERSION $Revision $DEFAULT_SERVICE $DEFAULT_NAMESPACE);
|
|
109 use strict;
|
|
110
|
|
111 use Bio::Biblio; # TBD: ?? WHY SHOULD I DO THIS ??
|
|
112 use SOAP::Lite
|
|
113 on_fault => sub {
|
|
114 my $soap = shift;
|
|
115 my $res = shift;
|
|
116 my $msg =
|
|
117 ref $res ? "--- SOAP FAULT ---\n" . $res->faultcode . " " . $res->faultstring
|
|
118 : "--- TRANSPORT ERROR ---\n" . $soap->transport->status;
|
|
119 Bio::DB::Biblio::soap->throw ( -text => $msg );
|
|
120 }
|
|
121 ;
|
|
122
|
|
123 @ISA = qw(Bio::Biblio);
|
|
124
|
|
125 BEGIN {
|
|
126 # set the version for version checking
|
|
127 $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d.%-02d", @r };
|
|
128 $Revision = q$Id: soap.pm,v 1.5 2002/10/22 07:45:14 lapp Exp $;
|
|
129
|
|
130 # where to go...
|
|
131 $DEFAULT_SERVICE = 'http://industry.ebi.ac.uk/soap/openBQS';
|
|
132
|
|
133 # ...and what to find there
|
|
134 $DEFAULT_NAMESPACE = 'http://industry.ebi.ac.uk/openBQS';
|
|
135 }
|
|
136
|
|
137 # -----------------------------------------------------------------------------
|
|
138
|
|
139 =head2 _initialize
|
|
140
|
|
141 Usage : my $obj = new Bio::Biblio (-access => 'soap' ...);
|
|
142 (_initialize is internally called from this constructor)
|
|
143 Returns : nothing interesting
|
|
144 Args : This module recognises and uses following arguments:
|
|
145
|
|
146 -namespace => 'urn'
|
|
147 The namespace used by the WebService that is being
|
|
148 accessed. It is a string which guarantees its world-wide
|
|
149 uniqueness - therefore it often has a style of a URL -
|
|
150 but it does not mean that such pseudo-URL really exists.
|
|
151
|
|
152 Default is 'http://industry.ebi.ac.uk/openBQS'
|
|
153 (which well corresponds with the default '-location' -
|
|
154 see module Bio::Biblio).
|
|
155
|
|
156 -destroy_on_exit => '0'
|
|
157 Default value is '1' which means that all Bio::Biblio
|
|
158 objects - when being finalised - will send a request
|
|
159 to the remote WebService to forget the query collections
|
|
160 they represent.
|
|
161
|
|
162 If you change it to '0' make sure that you know the
|
|
163 query collection identification - otherwise you will
|
|
164 not be able to re-established connection with it.
|
|
165 This can be done by calling method get_collection_id.
|
|
166
|
|
167 -collection_id => '...'
|
|
168 It defines what query collection will this object work
|
|
169 with. Use this argument when you know a collection ID
|
|
170 of an existing query collection and when you wish to
|
|
171 re-established connection with it.
|
|
172
|
|
173 By default, the collection IDs are set automatically
|
|
174 by the query methods - they return Bio::Biblio objects
|
|
175 already having a collection ID.
|
|
176
|
|
177 A missing or undefined collection ID means that the
|
|
178 object represents the whole bibliographic repository
|
|
179 (which again means that some methods, like get_all,
|
|
180 will be probably refused).
|
|
181
|
|
182 -soap => a SOAP::Lite object
|
|
183 Usually all Bio::Biblio objects share an instance of
|
|
184 the underlying SOAP::Lite module. But you are free
|
|
185 to have more - perhaps with different characteristics.
|
|
186
|
|
187 See the code for attributes of the default SOAP::Lite
|
|
188 object.
|
|
189
|
|
190 -httpproxy => 'http://server:port'
|
|
191 In addition to the 'location' parameter, you may need
|
|
192 to specify also a location/URL of a HTTP proxy server
|
|
193 (if your site requires one).
|
|
194
|
|
195 Additionally, the main module Bio::Biblio recognises
|
|
196 also:
|
|
197 -access => '...'
|
|
198 -location => '...'
|
|
199
|
|
200 It populates calling object with the given arguments, and then - for
|
|
201 some attributes and only if they are not yet populated - it assigns
|
|
202 some default values.
|
|
203
|
|
204 This is an actual new() method (except for the real object creation
|
|
205 and its blessing which is done in the parent class Bio::Root::Root in
|
|
206 method _create_object).
|
|
207
|
|
208 Note that this method is called always as an I<object> method (never as
|
|
209 a I<class> method) - and that the object who calls this method may
|
|
210 already be partly initiated (from Bio::Biblio::new method); so if you
|
|
211 need to do some tricks with the 'class invocation' you need to change
|
|
212 Bio::Biblio::new method, not this one.
|
|
213
|
|
214 =cut
|
|
215
|
|
216 sub _initialize {
|
|
217 my ($self, @args) = @_;
|
|
218
|
|
219 # make a hashtable from @args
|
|
220 my %param = @args;
|
|
221 @param { map { lc $_ } keys %param } = values %param; # lowercase keys
|
|
222
|
|
223 # copy all @args into this object (overwriting what may already be
|
|
224 # there) - changing '-key' into '_key'
|
|
225 my $new_key;
|
|
226 foreach my $key (keys %param) {
|
|
227 ($new_key = $key) =~ s/^-/_/;
|
|
228 $self->{ $new_key } = $param { $key };
|
|
229 }
|
|
230
|
|
231 # finally add default values for those keys who have default value
|
|
232 # and who are not yet in the object
|
|
233 $self->{'_location'} = $DEFAULT_SERVICE unless $self->{'_location'};
|
|
234 $self->{'_namespace'} = $DEFAULT_NAMESPACE unless $self->{'_namespace'};
|
|
235 $self->{'_destroy_on_exit'} = 1 unless defined $self->{'_destroy_on_exit'};
|
|
236 unless ($self->{'_soap'}) {
|
|
237 if (defined $self->{'_httpproxy'}) {
|
|
238 $self->{'_soap'} = SOAP::Lite
|
|
239 -> uri ($self->{'_namespace'})
|
|
240 -> proxy ($self->{'_location'},
|
|
241 proxy => ['http' => $self->{'_httpproxy'}]);
|
|
242 } else {
|
|
243 $self->{'_soap'} = SOAP::Lite
|
|
244 -> uri ($self->{'_namespace'})
|
|
245 -> proxy ($self->{'_location'});
|
|
246 }
|
|
247 }
|
|
248 }
|
|
249
|
|
250 # -----------------------------------------------------------------------------
|
|
251
|
|
252 #
|
|
253 # objects representing query collections are being destroyed if they
|
|
254 # have attribute '_destroy_on_exit' set to true - which is a default
|
|
255 # value
|
|
256 #
|
|
257 sub DESTROY {
|
|
258 my $self = shift;
|
|
259 my $soap = $self->{'_soap'};
|
|
260 my $destroy = $self->{'_destroy_on_exit'};
|
|
261 return unless $destroy;
|
|
262 my $collection_id = $self->{'_collection_id'};
|
|
263 return unless $collection_id;
|
|
264
|
|
265 # ignore all errors here
|
|
266 eval {
|
|
267 $soap->destroy (SOAP::Data->type (string => $collection_id));
|
|
268 }
|
|
269 }
|
|
270
|
|
271 #
|
|
272 # some methods must be called with an argument containing a collection
|
|
273 # ID; here we return a proper error message explaining it
|
|
274 #
|
|
275 sub _no_id_msg {
|
|
276 my $self = shift;
|
|
277 my $package = ref $self;
|
|
278 my $method = (caller(1))[3];
|
|
279 my $strip_method = $method;
|
|
280 $strip_method =~ s/^$package\:\://;
|
|
281
|
|
282 return <<"END_OF_MSG";
|
|
283 Method '$method' works only if its object has a query collection ID.
|
|
284 Perhaps you need to use:
|
|
285 \tnew Bio::Biblio (-collection_id => '1234567')->$strip_method;
|
|
286 or to obtain a collection ID indirectly from a query method:
|
|
287 \tnew Bio::Biblio->find ('keyword')->$strip_method;
|
|
288 END_OF_MSG
|
|
289 }
|
|
290
|
|
291 #
|
|
292 # some methods do not work with older SOAP::Lite version; here we
|
|
293 #return message explaining it
|
|
294 #
|
|
295 sub _old_version_msg {
|
|
296 my $self = shift;
|
|
297 my $method = (caller(1))[3];
|
|
298
|
|
299 return <<"END_OF_MSG";
|
|
300 Method '$method' works only with SOAP::Lite
|
|
301 version 0.52 and newer (the problem is with returning a boolean value from the server).
|
|
302 END_OF_MSG
|
|
303 }
|
|
304
|
|
305 #
|
|
306 # some controlled vocabulary methods needs two parameters; here we
|
|
307 # return message explaining it
|
|
308 #
|
|
309 sub _two_params_msg {
|
|
310 my $self = shift;
|
|
311 my $method = (caller(1))[3];
|
|
312
|
|
313 return <<"END_OF_MSG";
|
|
314 Method '$method' expects two parameters: vocabulary name and a value.
|
|
315 END_OF_MSG
|
|
316 }
|
|
317
|
|
318 #
|
|
319 # some controlled vocabulary methods needs a vocabulary name; here we
|
|
320 # return message explaining it
|
|
321 #
|
|
322 sub _missing_name_msg {
|
|
323 my $self = shift;
|
|
324 my $method = (caller(1))[3];
|
|
325
|
|
326 return <<"END_OF_MSG";
|
|
327 Method '$method' expects vocabulary name as parameter.
|
|
328 END_OF_MSG
|
|
329 }
|
|
330
|
|
331 #
|
|
332 # return a copy of a given array, with all its elements replaced
|
|
333 # with the SOAP-Data objects defining elements type as 'string'
|
|
334 #
|
|
335 sub _as_strings {
|
|
336 my ($ref_input_array) = @_;
|
|
337 my (@result) = map { SOAP::Data->new (type => 'string', value => $_) } @$ref_input_array;
|
|
338 return \@result;
|
|
339 }
|
|
340
|
|
341 # ---------------------------------------------------------------------
|
|
342 #
|
|
343 # Here are the methods implementing Bio::DB::BiblioI interface
|
|
344 # (documentation is in Bio::DB::BiblioI)
|
|
345 #
|
|
346 # ---------------------------------------------------------------------
|
|
347
|
|
348 sub get_collection_id {
|
|
349 my ($self) = @_;
|
|
350 $self->{'_collection_id'};
|
|
351 }
|
|
352
|
|
353 sub get_count {
|
|
354 my ($self) = @_;
|
|
355 my $soap = $self->{'_soap'};
|
|
356 my ($collection_id) = $self->{'_collection_id'};
|
|
357 if ($collection_id) {
|
|
358 $soap->getBibRefCount (SOAP::Data->type (string => $collection_id))->result;
|
|
359 } else {
|
|
360 $soap->getBibRefCount->result;
|
|
361 }
|
|
362 }
|
|
363
|
|
364 # try: 94033980
|
|
365 sub get_by_id {
|
|
366 my ($self, $citation_id) = @_;
|
|
367 $self->throw ("Citation ID is expected as a parameter of method 'get_by_id'.")
|
|
368 unless $citation_id;
|
|
369 my $soap = $self->{'_soap'};
|
|
370 $soap->getById (SOAP::Data->type (string => $citation_id))->result;
|
|
371 }
|
|
372
|
|
373 sub find {
|
|
374 my ($self, $keywords, $attrs) = @_;
|
|
375 my (@keywords, @attrs);
|
|
376
|
|
377 # $keywords can be a comma-delimited scalar or a reference to an array
|
|
378 if ($keywords) {
|
|
379 my $ref = ref $keywords;
|
|
380 @keywords = split (/,/, $keywords) unless $ref;
|
|
381 @keywords = @$keywords if $ref =~ /ARRAY/;
|
|
382 }
|
|
383 $self->throw ("No keywords given in 'find' method.\n")
|
|
384 unless (@keywords);
|
|
385
|
|
386 # ...and the same with $attrs
|
|
387 if ($attrs) {
|
|
388 my $ref = ref $attrs;
|
|
389 @attrs = split (/,/, $attrs) unless $ref;
|
|
390 @attrs = @$attrs if $ref =~ /ARRAY/;
|
|
391 }
|
|
392
|
|
393 my $soap = $self->{'_soap'};
|
|
394 my $collection_id = $self->{'_collection_id'};
|
|
395 my $new_id;
|
|
396 if ($collection_id) {
|
|
397 if (@attrs) {
|
|
398 $new_id = $soap->find (SOAP::Data->type (string => $collection_id),
|
|
399 &_as_strings (\@keywords),
|
|
400 &_as_strings (\@attrs))->result;
|
|
401 } else {
|
|
402 $new_id = $soap->find (SOAP::Data->type (string => $collection_id),
|
|
403 &_as_strings (\@keywords))->result;
|
|
404 }
|
|
405 } else {
|
|
406 if (@attrs) {
|
|
407 $new_id = $soap->find (&_as_strings (\@keywords),
|
|
408 &_as_strings (\@attrs))->result;
|
|
409
|
|
410
|
|
411 } else {
|
|
412 $new_id = $soap->find (&_as_strings (\@keywords))->result;
|
|
413 }
|
|
414 }
|
|
415
|
|
416 # clone itself but change the collection ID to a new one
|
|
417 return $self->new (-collection_id => $new_id,
|
|
418 -parent_collection_d => $collection_id);
|
|
419 }
|
|
420
|
|
421 sub get_all_ids {
|
|
422 my ($self) = @_;
|
|
423 my $soap = $self->{'_soap'};
|
|
424 my ($collection_id) = $self->{'_collection_id'};
|
|
425 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
426 $soap->getAllIDs (SOAP::Data->type (string => $collection_id))->result;
|
|
427 }
|
|
428
|
|
429 sub get_all {
|
|
430 my ($self) = @_;
|
|
431 my $soap = $self->{'_soap'};
|
|
432 my ($collection_id) = $self->{'_collection_id'};
|
|
433 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
434 $soap->getAllBibRefs (SOAP::Data->type (string => $collection_id))->result;
|
|
435 }
|
|
436
|
|
437 sub has_next {
|
|
438 my ($self) = @_;
|
|
439 my $soap = $self->{'_soap'};
|
|
440 my ($collection_id) = $self->{'_collection_id'};
|
|
441 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
442 $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION < 0.52;
|
|
443 $soap->hasNext (SOAP::Data->type (string => $collection_id))->result;
|
|
444 }
|
|
445
|
|
446 sub get_next {
|
|
447 my ($self) = @_;
|
|
448 my $soap = $self->{'_soap'};
|
|
449 my ($collection_id) = $self->{'_collection_id'};
|
|
450 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
451 my $ra = $soap->getNext (SOAP::Data->type (string => $collection_id))->result;
|
|
452 $self->{'_collection_id'} = shift @{ $ra };
|
|
453 shift @{ $ra };
|
|
454 }
|
|
455
|
|
456 sub get_more {
|
|
457 my ($self, $how_many) = @_;
|
|
458 my $soap = $self->{'_soap'};
|
|
459 my $collection_id = $self->{'_collection_id'};
|
|
460 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
461
|
|
462 unless (defined ($how_many) and $how_many =~ /^\d+$/) {
|
|
463 warn ("Method 'get_more' expects a numeric argument. Changing to 1.\n");
|
|
464 $how_many = 1;
|
|
465 }
|
|
466 unless ($how_many > 0) {
|
|
467 warn ("Method 'get_more' expects a positive argument. Changing to 1.\n");
|
|
468 $how_many = 1;
|
|
469 }
|
|
470
|
|
471 my $ra = $soap->getMore (SOAP::Data->type (string => $collection_id),
|
|
472 SOAP::Data->type (int => $how_many))->result;
|
|
473 $self->{'_collection_id'} = shift @{ $ra };
|
|
474 $ra;
|
|
475 }
|
|
476
|
|
477 sub reset_retrieval {
|
|
478 my ($self) = @_;
|
|
479 my $soap = $self->{'_soap'};
|
|
480 my ($collection_id) = $self->{'_collection_id'};
|
|
481 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
482 $self->{'_collection_id'} = $soap->resetRetrieval (SOAP::Data->type (string => $collection_id))->result;
|
|
483 }
|
|
484
|
|
485 sub exists {
|
|
486 my ($self) = @_;
|
|
487 my $soap = $self->{'_soap'};
|
|
488 my ($collection_id) = $self->{'_collection_id'};
|
|
489 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
490 $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION < 0.52;
|
|
491 $soap->exists (SOAP::Data->type (string => $collection_id))->result;
|
|
492 }
|
|
493
|
|
494 sub destroy {
|
|
495 my ($self) = @_;
|
|
496 my $soap = $self->{'_soap'};
|
|
497 my ($collection_id) = $self->{'_collection_id'};
|
|
498 $self->throw ($self->_no_id_msg) unless $collection_id;
|
|
499 $soap->destroy (SOAP::Data->type (string => $collection_id));
|
|
500 }
|
|
501
|
|
502 sub get_vocabulary_names {
|
|
503 my ($self) = @_;
|
|
504 my $soap = $self->{'_soap'};
|
|
505 $soap->getAllVocabularyNames->result;
|
|
506 }
|
|
507
|
|
508 sub contains {
|
|
509 my ($self, $vocabulary_name, $value) = @_;
|
|
510 my $soap = $self->{'_soap'};
|
|
511 $self->throw ($self->_old_version_msg) if $SOAP::Lite::VERSION < 0.52;
|
|
512 $self->throw ($self->_two_params_msg)
|
|
513 unless defined $vocabulary_name and defined $value;
|
|
514 $soap->contains (SOAP::Data->type (string => $vocabulary_name),
|
|
515 SOAP::Data->type (string => $value))->result;
|
|
516 }
|
|
517
|
|
518 sub get_entry_description {
|
|
519 my ($self, $vocabulary_name, $value) = @_;
|
|
520 my $soap = $self->{'_soap'};
|
|
521 $self->throw ($self->_two_params_msg)
|
|
522 unless defined $vocabulary_name and defined $value;
|
|
523 $soap->getEntryDescription (SOAP::Data->type (string => $vocabulary_name),
|
|
524 SOAP::Data->type (string => $value))->result;
|
|
525 }
|
|
526
|
|
527 sub get_all_values {
|
|
528 my ($self, $vocabulary_name) = @_;
|
|
529 my $soap = $self->{'_soap'};
|
|
530 $self->throw ($self->_missing_name_msg)
|
|
531 unless defined $vocabulary_name;
|
|
532 $soap->getAllValues (SOAP::Data->type (string => $vocabulary_name))->result;
|
|
533 }
|
|
534
|
|
535 sub get_all_entries {
|
|
536 my ($self, $vocabulary_name) = @_;
|
|
537 my $soap = $self->{'_soap'};
|
|
538 $self->throw ($self->_missing_name_msg)
|
|
539 unless defined $vocabulary_name;
|
|
540 $soap->getAllEntries (SOAP::Data->type (string => $vocabulary_name))->result;
|
|
541 }
|
|
542
|
|
543 =head2 VERSION and Revision
|
|
544
|
|
545 Usage : print $Bio::DB::Biblio::soap::VERSION;
|
|
546 print $Bio::DB::Biblio::soap::Revision;
|
|
547
|
|
548 =cut
|
|
549
|
|
550 =head2 Defaults
|
|
551
|
|
552 Usage : print $Bio::DB::Biblio::soap::DEFAULT_SERVICE;
|
|
553 print $Bio::DB::Biblio::soap::DEFAULT_NAMESPACE;
|
|
554
|
|
555 =cut
|
|
556
|
|
557 1;
|
|
558 __END__
|