← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/DB/Biblio/eutils.pm
 
1
# $Id: eutils.pm,v 1.11.4.1 2006/10/02 23:10:15 sendu Exp $
 
2
#
 
3
# BioPerl module Bio::DB::Biblio::eutils.pm
 
4
#
 
5
# Cared for by Allen Day <allenday@ucla.edu>
 
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::eutils - Access to PubMed's 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 => 'eutils');
 
21
  $biblio->db('PMC'); #optional, default is PubMed.
 
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>.
 
27
 
 
28
L<Bio::DB::BiblioI> is not implemented as documented in the interface,
 
29
particularly the find() method, which is not compatible with PubMed's
 
30
query language.
 
31
 
 
32
=head1 FEEDBACK
 
33
 
 
34
=head2 Mailing Lists
 
35
 
 
36
User feedback is an integral part of the evolution of this and other
 
37
Bioperl modules. Send your comments and suggestions preferably to
 
38
the Bioperl mailing list.  Your participation is much appreciated.
 
39
 
 
40
  bioperl-l@bioperl.org                  - General discussion
 
41
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 
42
 
 
43
=head2 Reporting Bugs
 
44
 
 
45
Report bugs to the Bioperl bug tracking system to help us keep track
 
46
of the bugs and their resolution. Bug reports can be submitted via
 
47
the web:
 
48
 
 
49
  http://bugzilla.open-bio.org/
 
50
 
 
51
=head1 AUTHOR
 
52
 
 
53
Allen Day E<lt>allenday@ucla.eduE<gt>
 
54
 
 
55
=head1 COPYRIGHT
 
56
 
 
57
Copyright (c) 2004 Allen Day, University of California, Los Angeles.
 
58
 
 
59
This module is free software; you can redistribute it and/or modify
 
60
it under the same terms as Perl itself.
 
61
 
 
62
=head1 DISCLAIMER
 
63
 
 
64
This software is provided "as is" without warranty of any kind.
 
65
 
 
66
=head1 BUGS AND LIMITATIONS
 
67
 
 
68
=over
 
69
 
 
70
=item *
 
71
 
 
72
More testing and debugging needed to ensure that returned citations
 
73
are properly transferred even if they contain foreign characters.
 
74
 
 
75
=item *
 
76
 
 
77
Maximum record count (MAX_RECORDS) returned currently hard coded to
 
78
100K.
 
79
 
 
80
=item *
 
81
 
 
82
Biblio retrieval methods should be more tightly integrated with
 
83
L<Bio::Biblio::Ref> and L<Bio::DB::MeSH>.
 
84
 
 
85
=back
 
86
 
 
87
=head1 SEE ALSO
 
88
 
 
89
 Pub Med Help:
 
90
 http://eutils.ncbi.nlm.nih.gov/entrez/query/static/help/pmhelp.html
 
91
 
 
92
 Entrez Utilities:
 
93
 http://eutils.ncbi.nlm.nih.gov/entrez/query/static/eutils_help.html
 
94
 
 
95
 Example code:
 
96
 examples/biblio/biblio-eutils-example.pl
 
97
 
 
98
=head1 APPENDIX
 
99
 
 
100
The main documentation details are to be found in
 
101
L<Bio::DB::BiblioI>.
 
102
 
 
103
Here is the rest of the object methods.  Interface methods first,
 
104
followed by internal methods.
 
105
 
 
106
=cut
 
107
 
 
108
# Let the code begin...
 
109
 
 
110
 
 
111
package Bio::DB::Biblio::eutils;
 
112
use vars qw($DEFAULT_URN);
 
113
use strict;
 
114
 
 
115
use LWP::Simple;
 
116
use XML::Twig;
 
117
use URI::Escape;
 
118
use base qw(Bio::Biblio Bio::DB::BiblioI);
 
119
 
 
120
our $EFETCH      = 'http://www.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi';
 
121
our $ESEARCH     = 'http://www.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi';
 
122
our $MAX_RECORDS = 100_000;
 
123
 
 
124
# -----------------------------------------------------------------------------
 
125
 
 
126
=head2 _initialize
 
127
 
 
128
 Usage   : my $obj = new Bio::Biblio (-access => 'eutils' ...);
 
129
           (_initialize is internally called from this constructor)
 
130
 Returns : 1 on success
 
131
 Args    : none
 
132
 
 
133
This is an actual new() method (except for the real object creation
 
134
and its blessing which is done in the parent class Bio::Root::Root in
 
135
method _create_object).
 
136
 
 
137
Note that this method is called always as an I<object> method (never as
 
138
a I<class> method) - and that the object who calls this method may
 
139
already be partly initiated (from Bio::Biblio::new method); so if you
 
140
need to do some tricks with the 'class invocation' you need to change
 
141
Bio::Biblio::new method, not this one.
 
142
 
 
143
=cut
 
144
 
 
145
sub _initialize {
 
146
    my ($self, @args) = @_;
 
147
 
 
148
    #eutils doesn't need this code, but it doesn't hurt to leave it here... -ad
 
149
 
 
150
    # make a hashtable from @args
 
151
    my %param = @args;
 
152
    @param { map { lc $_ } keys %param } = values %param; # lowercase keys
 
153
 
 
154
    # copy all @args into this object (overwriting what may already be
 
155
    # there) - changing '-key' into '_key'
 
156
    my $new_key;
 
157
    foreach my $key (keys %param) {
 
158
        ($new_key = $key) =~ s/^-/_/;
 
159
        $self->{ $new_key } = $param { $key };
 
160
    }
 
161
 
 
162
 
 
163
    # set up internal data
 
164
    $self->twig(XML::Twig->new());
 
165
 
 
166
    # finally add default values for those keys who have default value
 
167
    # and who are not yet in the object
 
168
 
 
169
    #AOK
 
170
    return 1;
 
171
}
 
172
 
 
173
=head2 db
 
174
 
 
175
 Title   : db
 
176
 Usage   : $obj->db($newval)
 
177
 Function: specifies the database to search.  valid values are:
 
178
 
 
179
           pubmed, pmc, journals
 
180
 
 
181
           it is also possible to add the following, and i will do
 
182
           so on request:
 
183
 
 
184
           genome, nucleotide, protein, popset, snp, sequence, taxonomy
 
185
 
 
186
           pubmed is default.
 
187
 
 
188
 Returns : value of db (a scalar)
 
189
 Args    : on set, new value (a scalar or undef, optional)
 
190
 
 
191
 
 
192
=cut
 
193
 
 
194
sub db{
 
195
    my($self,$arg) = @_;
 
196
 
 
197
    if($arg){
 
198
      my %ok = map {$_=>1} qw(pubmed pmc journals);
 
199
      if($ok{lc($arg)}){
 
200
        $self->{'db'} = lc($arg);
 
201
      } else {
 
202
        $self->warn("invalid db $arg, keeping value as ".$self->{'db'} || 'pubmed');
 
203
      }
 
204
    }
 
205
    return $self->{'db'};
 
206
}
 
207
 
 
208
 
 
209
=head1 Methods implementing Bio::DB::BiblioI interface
 
210
 
 
211
=head2 get_collection_id
 
212
 
 
213
  Title   : get_collection_id
 
214
  Usage   : $id = $biblio->get_collection_id();
 
215
  Function: returns WebEnv value from ESearch
 
216
  Returns : ESearch WebEnv value as a string
 
217
  Args    : none
 
218
 
 
219
 
 
220
=cut
 
221
 
 
222
sub get_collection_id {
 
223
   return shift->collection_id();
 
224
}
 
225
 
 
226
sub get_count {
 
227
  return shift->count();
 
228
}
 
229
 
 
230
sub get_by_id {
 
231
  my $self = shift;
 
232
  my $id = shift;
 
233
  my $db = $self->db || 'pubmed';
 
234
  $self->throw("must provide valid ID, not undef") unless defined($id);
 
235
  my $xml = get($EFETCH.'?rettype=abstract&retmode=xml&db='.$db.'&id='.$id);
 
236
  return $xml;
 
237
}
 
238
 
 
239
=head2 reset_retrieval
 
240
 
 
241
  Title   : reset_retrieval
 
242
  Usage   : $biblio->reset_retrieval();
 
243
  Function: reset cursor in id list, see cursor()
 
244
  Returns : 1
 
245
  Args    : none
 
246
 
 
247
 
 
248
=cut
 
249
 
 
250
sub reset_retrieval {
 
251
  shift->cursor(0);
 
252
  return 1;
 
253
}
 
254
 
 
255
=head2 get_next
 
256
 
 
257
  Title   : get_next
 
258
  Usage   : $xml = $biblio->get_next();
 
259
  Function: return next record as xml
 
260
  Returns : an xml string
 
261
  Args    : none
 
262
 
 
263
 
 
264
=cut
 
265
 
 
266
sub get_next {
 
267
  my $self = shift;
 
268
 
 
269
  return unless $self->has_next;
 
270
 
 
271
  my $xml = $self->get_by_id( @{ $self->ids }[$self->cursor] );
 
272
  $self->cursor( $self->cursor + 1 );
 
273
 
 
274
  return $xml;
 
275
}
 
276
 
 
277
=head2 get_more
 
278
 
 
279
  Title   : get_more
 
280
  Usage   : $xml = $biblio->get_more($more);
 
281
  Function: returns next $more records concatenated
 
282
  Returns : a string containing multiple xml documents
 
283
  Args    : an integer representing how many records to retrieve
 
284
 
 
285
 
 
286
=cut
 
287
 
 
288
sub get_more {
 
289
  my ($self,$more) = @_;
 
290
 
 
291
  my @return = ();
 
292
 
 
293
  for(1..$more){
 
294
    my $next = $self->get_next();
 
295
    last unless $next;
 
296
    push @return, $next;
 
297
  }
 
298
 
 
299
  return \@return;
 
300
}
 
301
 
 
302
=head2 has_next
 
303
 
 
304
  Title   : has_next
 
305
  Usage   : $has_next = $biblio->has_next();
 
306
  Function: check to see if there are more items to be retrieved
 
307
  Returns : 1 on true, undef on false
 
308
  Args    : none
 
309
 
 
310
 
 
311
=cut
 
312
 
 
313
sub has_next {
 
314
  my $self = shift;
 
315
  return ($self->cursor < $self->count) ? 1 : undef;
 
316
}
 
317
 
 
318
 
 
319
 
 
320
=head2 find
 
321
 
 
322
  Title   : find
 
323
  Usage   : $biblio = $biblio->find($pubmed_query_phrase);
 
324
  Function: perform a PubMed query using Entrez ESearch
 
325
  Returns : a reference to the object on which the method was called
 
326
  Args    : a PubMed query phrase.  See
 
327
            http://eutils.ncbi.nlm.nih.gov/entrez/query/static/help/pmhelp.html
 
328
            for help on how to construct a query.
 
329
 
 
330
=cut
 
331
 
 
332
sub find {
 
333
  my ($self,$query) = @_;
 
334
 
 
335
  $query = uri_escape($query);
 
336
 
 
337
  my $db = $self->db || 'pubmed';
 
338
 
 
339
  my $url = $ESEARCH."?usehistory=y&db=$db&retmax=$MAX_RECORDS&term=$query";
 
340
 
 
341
  my $xml = get($url) or $self->throw("couldn't retrieve results from $ESEARCH: $!");
 
342
 
 
343
  $self->twig->parse($xml);
 
344
 
 
345
  my @ids = map {$_->text} $self->twig->get_xpath('//IdList//Id');
 
346
  $self->ids(\@ids);
 
347
 
 
348
  ##
 
349
  #should we be using the ids, or the count tag?
 
350
  ##
 
351
  my($count_element)  = $self->twig->get_xpath('//Count');
 
352
  my $count = $count_element->text();
 
353
  $self->count(scalar(@ids));
 
354
 
 
355
  my($retmax_element) = $self->twig->get_xpath('//RetMax');
 
356
  my $retmax = $retmax_element->text();
 
357
 
 
358
  my($querykey_element) = $self->twig->get_xpath('//QueryKey');
 
359
  my $querykey = $querykey_element->text();
 
360
  $self->query_key($querykey);
 
361
 
 
362
  my($webenv_element) = $self->twig->get_xpath('//WebEnv');
 
363
  my $webenv = $webenv_element->text();
 
364
  $self->collection_id($webenv);
 
365
 
 
366
  #initialize/reset cursor
 
367
  $self->cursor(0);
 
368
 
 
369
  return $self;
 
370
}
 
371
 
 
372
 
 
373
=head2 get_all_ids
 
374
 
 
375
  Title   : get_all_ids
 
376
  Usage   : @ids = $biblio->get_all_ids();
 
377
  Function: return a list of PubMed ids resulting from call to find()
 
378
  Returns : a list of PubMed ids, or an empty list
 
379
  Args    : none
 
380
 
 
381
 
 
382
=cut
 
383
 
 
384
sub get_all_ids {
 
385
  my $self = shift;
 
386
  return $self->ids() if $self->ids();
 
387
  return ();
 
388
}
 
389
 
 
390
=head2 get_all
 
391
 
 
392
  Title   : get_all
 
393
  Usage   : $xml = $biblio->get_all();
 
394
  Function: retrieve all records from query
 
395
  Returns : return a large concatenated string of PubMed xml documents
 
396
  Args    : none
 
397
 
 
398
 
 
399
=cut
 
400
 
 
401
sub get_all {
 
402
  my ($self) = shift;
 
403
 
 
404
  my $db = $self->db || 'pubmed';
 
405
 
 
406
  my $xml = get($EFETCH.'?rettype=abstract&retmode=xml&db=pubmed&query_key='.
 
407
                $self->query_key.'&WebEnv='.$self->collection_id.
 
408
                '&retstart=1&retmax='.$MAX_RECORDS
 
409
               );
 
410
 
 
411
  return $xml;
 
412
}
 
413
 
 
414
=head2 exists
 
415
 
 
416
  Title   : exists
 
417
  Usage   : do not use
 
418
  Function: no-op.  this is here only for interface compatibility
 
419
  Returns : undef
 
420
  Args    : none
 
421
 
 
422
 
 
423
=cut
 
424
 
 
425
sub exists {
 
426
  return;
 
427
 
 
428
}
 
429
 
 
430
=head2 destroy
 
431
 
 
432
  Title   : destroy
 
433
  Usage   : do not use
 
434
  Function: no-op.  this is here only for interface compatibility
 
435
  Returns : undef
 
436
  Args    : none
 
437
 
 
438
 
 
439
=cut
 
440
 
 
441
sub destroy {
 
442
  return;
 
443
 
 
444
}
 
445
 
 
446
=head2 get_vocabulary_names
 
447
 
 
448
  Title   : get_vocabulary_names
 
449
  Usage   : do not use
 
450
  Function: no-op.  this is here only for interface compatibility
 
451
  Returns : empty arrayref
 
452
  Args    : none
 
453
 
 
454
 
 
455
=cut
 
456
 
 
457
sub get_vocabulary_names {
 
458
  return [];
 
459
}
 
460
 
 
461
=head2 contains
 
462
 
 
463
  Title   : contains
 
464
  Usage   : do not use
 
465
  Function: no-op.  this is here only for interface compatibility
 
466
  Returns : undef
 
467
  Args    : none
 
468
 
 
469
 
 
470
=cut
 
471
 
 
472
sub contains {
 
473
  return;
 
474
}
 
475
 
 
476
=head2 get_entry_description
 
477
 
 
478
  Title   : get_entry_description
 
479
  Usage   : do not use
 
480
  Function: no-op.  this is here only for interface compatibility
 
481
  Returns : undef
 
482
  Args    : none
 
483
 
 
484
 
 
485
=cut
 
486
 
 
487
sub get_entry_description {
 
488
  return;
 
489
}
 
490
 
 
491
=head2 get_all_values
 
492
 
 
493
  Title   : get_all_values
 
494
  Usage   : do not use
 
495
  Function: no-op.  this is here only for interface compatibility
 
496
  Returns : undef
 
497
  Args    : none
 
498
 
 
499
 
 
500
=cut
 
501
 
 
502
sub get_all_values {
 
503
  return;
 
504
}
 
505
 
 
506
=head2 get_all_entries
 
507
 
 
508
  Title   : get_all_entries
 
509
  Usage   : do not use
 
510
  Function: no-op.  this is here only for interface compatibility
 
511
  Returns : undef
 
512
  Args    : none
 
513
 
 
514
 
 
515
=cut
 
516
 
 
517
sub get_all_entries {
 
518
  return;
 
519
}
 
520
 
 
521
=head1 Internal methods unrelated to Bio::DB::BiblioI
 
522
 
 
523
=head2 cursor
 
524
 
 
525
  Title   : cursor
 
526
  Usage   : $obj->cursor($newval)
 
527
  Function: holds position in reference collection
 
528
  Returns : value of cursor (a scalar)
 
529
  Args    : on set, new value (a scalar or undef, optional)
 
530
 
 
531
 
 
532
=cut
 
533
 
 
534
sub cursor {
 
535
  my $self = shift;
 
536
  my $arg  = shift;
 
537
 
 
538
  return $self->{'cursor'} = $arg if defined($arg);
 
539
  return $self->{'cursor'};
 
540
}
 
541
 
 
542
=head2 twig
 
543
 
 
544
  Title   : twig
 
545
  Usage   : $obj->twig($newval)
 
546
  Function: holds an XML::Twig instance.
 
547
  Returns : value of twig (a scalar)
 
548
  Args    : on set, new value (a scalar or undef, optional)
 
549
 
 
550
 
 
551
=cut
 
552
 
 
553
sub twig {
 
554
  my $self = shift;
 
555
 
 
556
  return $self->{'twig'} = shift if @_;
 
557
  return $self->{'twig'};
 
558
}
 
559
 
 
560
=head2 ids
 
561
 
 
562
  Title   : ids
 
563
  Usage   : $obj->ids($newval)
 
564
  Function: store pubmed ids resulting from find() query
 
565
  Returns : value of ids (a scalar)
 
566
  Args    : on set, new value (a scalar or undef, optional)
 
567
 
 
568
 
 
569
=cut
 
570
 
 
571
sub ids {
 
572
  my $self = shift;
 
573
 
 
574
  return $self->{'ids'} = shift if @_;
 
575
  return $self->{'ids'};
 
576
}
 
577
 
 
578
=head2 collection_id
 
579
 
 
580
  Title   : collection_id
 
581
  Usage   : $obj->collection_id($newval)
 
582
  Function:
 
583
  Returns : value of collection_id (a scalar)
 
584
  Args    : on set, new value (a scalar or undef, optional)
 
585
 
 
586
 
 
587
=cut
 
588
 
 
589
sub collection_id {
 
590
  my $self = shift;
 
591
 
 
592
  return $self->{'collection_id'} = shift if @_;
 
593
  return $self->{'collection_id'};
 
594
}
 
595
 
 
596
=head2 count
 
597
 
 
598
  Title   : count
 
599
  Usage   : $obj->count($newval)
 
600
  Function:
 
601
  Returns : value of count (a scalar)
 
602
  Args    : on set, new value (a scalar or undef, optional)
 
603
 
 
604
 
 
605
=cut
 
606
 
 
607
sub count {
 
608
  my $self = shift;
 
609
 
 
610
  return $self->{'count'} = shift if @_;
 
611
  return $self->{'count'};
 
612
}
 
613
 
 
614
=head2 query_key
 
615
 
 
616
  Title   : query_key
 
617
  Usage   : $obj->query_key($newval)
 
618
  Function: holds query_key from ESearch document
 
619
  Returns : value of query_key (a scalar)
 
620
  Args    : on set, new value (a scalar or undef, optional)
 
621
 
 
622
 
 
623
=cut
 
624
 
 
625
sub query_key {
 
626
  my $self = shift;
 
627
 
 
628
  return $self->{'query_key'} = shift if @_;
 
629
  return $self->{'query_key'};
 
630
}
 
631
 
 
632
 
 
633
1;