~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/DB/Biblio/soap.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

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