~ubuntu-branches/ubuntu/oneiric/bioperl/oneiric

« back to all changes in this revision

Viewing changes to Bio/DB/EUtilities.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2007-09-21 22:52:22 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20070921225222-tt20m2yy6ycuy2d8
Tags: 1.5.2.102-1
* Developer release.
* Upgraded source package to debhelper 5 and standards-version 3.7.2.
* Added libmodule-build-perl and libtest-harness-perl to
  build-depends-indep.
* Disabled automatic CRAN download.
* Using quilt instead of .diff.gz to manage modifications.
* Updated Recommends list for the binary package.
* Moved the "production-quality" scripts to /usr/bin/.
* New maintainer: Debian-Med packaging team mailing list.
* New uploaders: Charles Plessy and Steffen Moeller.
* Updated Depends, Recommends and Suggests.
* Imported in Debian-Med's SVN repository on Alioth.
* Executing the regression tests during package building.
* Moved the Homepage: field out from the package's description.
* Updated watch file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
# $Id: EUtilities.pm,v 1.24.4.3 2006/11/23 12:36:14 sendu Exp $
 
2
#
 
3
# BioPerl module for Bio::DB::EUtilities
 
4
#
 
5
# Cared for by Chris Fields <cjfields at uiuc dot edu>
 
6
#
 
7
# Copyright Chris Fields
 
8
#
 
9
# You may distribute this module under the same terms as perl itself
 
10
#
 
11
# POD documentation - main docs before the code
 
12
 
13
# Interfaces with new GenericWebDBI interface 
 
14
 
 
15
=head1 NAME
 
16
 
 
17
Bio::DB::EUtilities - interface for handling web queries and data
 
18
retrieval from Entrez Utilities at NCBI.
 
19
 
 
20
=head1 SYNOPSIS
 
21
 
 
22
use Bio::DB::EUtilities;
 
23
 
 
24
  my $esearch = Bio::DB::EUtilities->new(-eutil      => 'esearch',
 
25
                                         -db         => 'pubmed',
 
26
                                         -term       => 'hutP',
 
27
                                         -usehistory => 'y');
 
28
 
 
29
  $esearch->get_response; # parse the response, fetch a cookie
 
30
 
 
31
  my $elink = Bio::DB::EUtilities->new(-eutil        => 'elink',
 
32
                                       -db           => 'protein',
 
33
                                       -dbfrom       => 'pubmed',
 
34
                                       -cookie       => $esearch->next_cookie,
 
35
                                       -cmd          => 'neighbor_history');
 
36
 
 
37
  $elink->get_response; # parse the response, fetch the next cookie
 
38
 
 
39
  my $efetch = Bio::DB::EUtilities->new(-cookie       => $elink->next_cookie,
 
40
                                        -retmax       => 10,
 
41
                                        -rettype      => 'fasta');
 
42
 
 
43
  print $efetch->get_response->content;
 
44
 
 
45
=head1 DESCRIPTION
 
46
 
 
47
WARNING: Please do B<NOT> spam the Entrez web server with multiple requests.
 
48
NCBI offers Batch Entrez for this purpose, now accessible here via epost!
 
49
 
 
50
This is a test interface to the Entrez Utilities at NCBI.  The main purpose of this
 
51
is to enable access to all of the NCBI databases available through Entrez and
 
52
allow for more complex queries.  It is likely that the API for this module as
 
53
well as the documentation will change dramatically over time. So, novice users
 
54
and neophytes beware!
 
55
 
 
56
The experimental base class is L<Bio::DB::GenericWebDBI|Bio::DB::GenericWebDBI>,
 
57
which as the name implies enables access to any web database which will accept
 
58
parameters.  This was originally born from an idea to replace
 
59
WebDBSeqI/NCBIHelper with a more general web database accession tool so one
 
60
could access sequence information, taxonomy, SNP, PubMed, and so on.
 
61
However, this may ultimately prove to be better used as a replacement for
 
62
L<LWP::UserAgent|LWP::UserAgent> when ccessing NCBI-related web tools
 
63
(Entrez Utilitites, or EUtilities).  Using the base class GenericWebDBI,
 
64
one could also build web interfaces to other databases to access anything
 
65
via CGI parameters.
 
66
 
 
67
Currently, you can access any database available through the NCBI interface:
 
68
 
 
69
  http://eutils.ncbi.nlm.nih.gov/
 
70
 
 
71
At this point, Bio::DB::EUtilities uses the EUtilities plugin modules somewhat
 
72
like Bio::SeqIO.  So, one would call the particular EUtility (epost, efetch,
 
73
and so forth) upon instantiating the object using a set of parameters:
 
74
 
 
75
  my $esearch = Bio::DB::EUtilities->new(-eutil      => 'esearch',
 
76
                                         -db         => 'pubmed',
 
77
                                         -term       => 'dihydroorotase',
 
78
                                         -usehistory => 'y');
 
79
 
 
80
The default EUtility (when C<eutil> is left out) is 'efetch'.  For specifics on
 
81
each EUtility, see their respective POD (**these are incomplete**) or
 
82
the NCBI Entrez Utilities page:
 
83
 
 
84
  http://eutils.ncbi.nlm.nih.gov/entrez/query/static/eutils_help.html
 
85
 
 
86
At this time, retrieving the response is accomplished by using the method
 
87
get_response (which also parses for cookies and other information, see below).
 
88
This method returns an HTTP::Response object.  The raw data is accessed by using
 
89
the object method C<content>, like so:
 
90
 
 
91
  my $efetch = Bio::DB::EUtilities->new(-cookie       => $elink->next_cookie,
 
92
                                        -retmax       => 10,
 
93
                                        -rettype      => 'fasta');
 
94
 
 
95
  print $efetch->get_response->content;
 
96
 
 
97
Based on this, if one wanted to retrieve sequences or other raw data
 
98
but was not interested in directly using Bio* objects (such as if
 
99
genome sequences were to be retrieved) one could do so by using the
 
100
proper EUtility object(s) and query(ies) and get the raw response back
 
101
from NCBI through 'efetch'.  
 
102
 
 
103
A great deal of the documentation here will likely end up in the form
 
104
of a HOWTO at some future point, focusing on getting data into Bioperl
 
105
objects.
 
106
 
 
107
=head2 Cookies
 
108
 
 
109
Some EUtilities (C<epost>, C<esearch>, or C<elink>) retain information on
 
110
the NCBI server under certain settings.  This information can be retrieved by
 
111
using a B<cookie>.  Here, the idea of the 'cookie' is similar to the
 
112
'cookie' set on a your computer when browsing the Web.  XML data returned
 
113
by these EUtilities, when applicable, is parsed for the cookie information
 
114
(the 'WebEnv' and 'query_key' tags to be specific)  The information along
 
115
with other identifying data, such as the calling eutility, description
 
116
of query, etc.) is stored as a
 
117
L<Bio::DB::EUtilities::Cookie|Bio::DB::EUtilities::Cookie> object
 
118
in an internal queue.  These can be retrieved one at a time by using
 
119
the next_cookie method or all at once in an array using get_all_cookies.
 
120
Each cookie can then be 'fed', one at a time, to another EUtility object,
 
121
thus enabling chained queries as demonstrated in the synopsis.
 
122
 
 
123
For more information, see the POD documentation for
 
124
L<Bio::DB::EUtilities::Cookie|Bio::DB::EUtilities::Cookie>.
 
125
 
 
126
=head1 TODO
 
127
 
 
128
Resetting internal parameters is planned so one could feasibly reuse
 
129
the objects once instantiated, such as if one were to use this as a
 
130
replacement for LWP::UserAgent when retrieving responses i.e. when
 
131
using many of the Bio::DB* NCBI-related modules.
 
132
 
 
133
File and filehandle support to be added.
 
134
 
 
135
Switch over XML parsing in most EUtilities to XML::SAX (currently
 
136
use XML::Simple)
 
137
 
 
138
Any feedback is welcome.
 
139
 
 
140
=head1 FEEDBACK
 
141
 
 
142
=head2 Mailing Lists
 
143
 
 
144
User feedback is an integral part of the 
 
145
evolution of this and other Bioperl modules. Send
 
146
your comments and suggestions preferably to one
 
147
of the Bioperl mailing lists. Your participation
 
148
is much appreciated.
 
149
 
 
150
  bioperl-l@lists.open-bio.org               - General discussion
 
151
  http://www.bioperl.org/wiki/Mailing_lists  - About the mailing lists
 
152
 
 
153
=head2 Reporting Bugs
 
154
 
 
155
Report bugs to the Bioperl bug tracking system to
 
156
help us keep track the bugs and their resolution.
 
157
Bug reports can be submitted via the web.
 
158
 
 
159
  http://bugzilla.open-bio.org/
 
160
 
 
161
=head1 AUTHOR 
 
162
 
 
163
Email cjfields at uiuc dot edu
 
164
 
 
165
=head1 APPENDIX
 
166
 
 
167
The rest of the documentation details each of the
 
168
object methods. Internal methods are usually
 
169
preceded with a _
 
170
 
 
171
=cut
 
172
 
 
173
# Let the code begin...
 
174
 
 
175
package Bio::DB::EUtilities;
 
176
use strict;
 
177
 
 
178
use vars qw($HOSTBASE %CGILOCATION $MAX_ENTRIES %DATABASE @PARAMS
 
179
            $DEFAULT_TOOL @COOKIE_PARAMS @METHODS);
 
180
use URI;
 
181
#use Data::Dumper;
 
182
 
 
183
use base qw(Bio::DB::GenericWebDBI);
 
184
 
 
185
our $DEFAULT_TOOL = 'bioperl';
 
186
    # default host base
 
187
our $HOSTBASE = 'http://eutils.ncbi.nlm.nih.gov';
 
188
    # map eutility to location
 
189
our %CGILOCATION = (
 
190
            'einfo'     => ['get'  => '/entrez/eutils/einfo.fcgi', 'xml'],
 
191
            'epost'     => ['post' => '/entrez/eutils/epost.fcgi', 'xml'],
 
192
            'efetch'    => ['get'  => '/entrez/eutils/efetch.fcgi', 'dbspec'],
 
193
            'esearch'   => ['get'  => '/entrez/eutils/esearch.fcgi', 'xml'],
 
194
            'esummary'  => ['get'  => '/entrez/eutils/esummary.fcgi', 'xml'],
 
195
            'elink'     => ['get'  => '/entrez/eutils/elink.fcgi', 'xml'],
 
196
            'egquery'   => ['get'  => '/entrez/eutils/egquery.fcgi', 'xml']
 
197
             );
 
198
    # map database to return mode
 
199
our %DATABASE = ('pubmed'           => 'xml',
 
200
                 'protein'          => 'text',
 
201
                 'nucleotide'       => 'text',
 
202
                 'nuccore'          => 'text',
 
203
                 'nucgss'           => 'text',
 
204
                 'nucest'           => 'text',
 
205
                 'structure'        => 'text',
 
206
                 'genome'           => 'text',
 
207
                 'books'            => 'xml',
 
208
                 'cancerchromosomes'=> 'xml',
 
209
                 'cdd'              => 'xml',
 
210
                 'domains'          => 'xml',
 
211
                 'gene'             => 'asn1',
 
212
                 'genomeprj'        => 'xml',
 
213
                 'gensat'           => 'xml',
 
214
                 'geo'              => 'xml',
 
215
                 'gds'              => 'xml',
 
216
                 'homologene'       => 'xml',
 
217
                 'journals'         => 'text',
 
218
                 'mesh'             => 'xml',
 
219
                 'ncbisearch'       => 'xml',
 
220
                 'nlmcatalog'       => 'xml',
 
221
                 'omia'             => 'xml',
 
222
                 'omim'             => 'xml',
 
223
                 'pmc'              => 'xml',
 
224
                 'popset'           => 'xml',
 
225
                 'probe'            => 'xml',
 
226
                 'pcassay'          => 'xml',
 
227
                 'pccompound'       => 'xml',
 
228
                 'pcsubstance'      => 'xml',
 
229
                 'snp'              => 'xml',
 
230
                 'taxonomy'         => 'xml',
 
231
                 'unigene'          => 'xml',
 
232
                 'unists'           => 'xml',
 
233
                 );
 
234
 
 
235
    our @PARAMS = qw(rettype usehistory term field tool reldate mindate
 
236
            maxdate datetype retstart retmax sort seq_start seq_stop strand
 
237
            complexity report dbfrom cmd holding version linkname retmode);
 
238
    our @COOKIE_PARAMS = qw(db sort seq_start seq_stop strand complexity rettype
 
239
            retstart retmax cmd linkname retmode);
 
240
BEGIN {
 
241
    our @METHODS = qw(rettype usehistory term field tool reldate mindate
 
242
        maxdate datetype retstart retmax sort seq_start seq_stop strand
 
243
        complexity report dbfrom cmd holding version linkname);
 
244
    for my $method (@METHODS) {
 
245
        eval <<END;
 
246
sub $method {
 
247
    my \$self = shift;
 
248
    return \$self->{'_$method'} = shift if \@_;
 
249
    return \$self->{'_$method'};
 
250
}
 
251
END
 
252
    }
 
253
}
 
254
 
 
255
sub new {
 
256
    my($class,@args) = @_;
 
257
    if( $class =~ /Bio::DB::EUtilities::(\S+)/ ) {
 
258
        my ($self) = $class->SUPER::new(@args);
 
259
        $self->_initialize(@args);
 
260
        return $self;
 
261
    } else { 
 
262
        my %param = @args;
 
263
        @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
 
264
        my $eutil = $param{'-eutil'} || 'efetch';
 
265
        return unless ($class->_load_eutil_module($eutil));
 
266
        return "Bio::DB::EUtilities::$eutil"->new(@args);
 
267
    }
 
268
}
 
269
 
 
270
sub _initialize {
 
271
    my ($self, @args) = @_;
 
272
    my ( $tool, $ids, $retmode, $verbose, $cookie, $keep_cookies) =
 
273
      $self->_rearrange([qw(TOOL ID RETMODE VERBOSE COOKIE KEEP_COOKIES)],  @args);
 
274
        # hard code the base address
 
275
    $self->url_base_address($HOSTBASE);
 
276
    $tool ||= $DEFAULT_TOOL;
 
277
    $self->tool($tool);
 
278
    $ids            && $self->id($ids);
 
279
    $verbose        && $self->verbose($verbose);
 
280
    $retmode        && $self->retmode($retmode);
 
281
    $keep_cookies   && $self->keep_cookies($keep_cookies);
 
282
    if ($cookie && ref($cookie) =~ m{cookie}i) {
 
283
        $self->db($cookie->database) if !($self->db);
 
284
        $self->add_cookie($cookie);
 
285
    }
 
286
    $self->{'_cookieindex'} = 0;
 
287
    $self->{'_cookiecount'} = 0;
 
288
    $self->{'_authentication'} = [];
 
289
}
 
290
 
 
291
=head2 add_cookie
 
292
 
 
293
 Title   : cookie
 
294
 Usage   : $db->add_cookie($cookie)
 
295
 Function: adds an NCBI query cookie to the internal cookie queue
 
296
 Returns : none
 
297
 Args    : a Bio::DB::EUtilities::Cookie object
 
298
 
 
299
=cut
 
300
 
 
301
sub add_cookie {
 
302
    my $self = shift;
 
303
    if (@_) {
 
304
        my $cookie = shift;
 
305
        $self->throw("Expecting a Bio::DB::EUtilities::Cookie, got $cookie.")
 
306
          unless $cookie->isa("Bio::DB::EUtilities::Cookie");
 
307
        push @{$self->{'_cookie'}}, $cookie;
 
308
    }
 
309
    $self->{'_cookiecount'}++;
 
310
}
 
311
 
 
312
=head2 next_cookie
 
313
 
 
314
 Title   : next_cookie
 
315
 Usage   : $cookie = $db->next_cookie
 
316
 Function: return a cookie from the internal cookie queue
 
317
 Returns : a Bio::DB::EUtilities::Cookie object
 
318
 Args    : none
 
319
 
 
320
=cut
 
321
 
 
322
sub next_cookie {
 
323
    my $self = shift;
 
324
    my $index = $self->_next_cookie_index;
 
325
    if ($self->{'_cookie'}) {
 
326
        return $self->{'_cookie'}->[$index];
 
327
    } else {
 
328
        $self->warn("No cookies left in the jar!");
 
329
    }
 
330
}
 
331
 
 
332
=head2 reset_cookies
 
333
 
 
334
 Title   : reset_cookies
 
335
 Usage   : $db->reset_cookies
 
336
 Function: resets (empties) the internal cookie queue
 
337
 Returns : none
 
338
 Args    : none
 
339
 
 
340
=cut
 
341
 
 
342
sub reset_cookies {
 
343
    my $self = shift;
 
344
    $self->{'_cookie'} = [];
 
345
    $self->{'_cookieindex'} = 0;
 
346
    $self->{'_cookiecount'} = 0;
 
347
}
 
348
 
 
349
=head2 get_all_cookies
 
350
 
 
351
 Title   : get_all_cookies
 
352
 Usage   : @cookies = $db->get_all_cookies
 
353
 Function: retrieves all cookies from the internal cookie queue; this leaves
 
354
           the cookies in the queue intact 
 
355
 Returns : array of cookies (if wantarray) of first cookie
 
356
 Args    : none
 
357
 
 
358
=cut
 
359
 
 
360
sub get_all_cookies {
 
361
    my $self = shift;
 
362
    return @{ $self->{'_cookie'} } if $self->{'_cookie'} && wantarray;
 
363
    return $self->{'_cookie'}->[0] if $self->{'_cookie'} 
 
364
}
 
365
 
 
366
=head2 get_cookie_count
 
367
 
 
368
 Title   : get_cookie_count
 
369
 Usage   : $ct = $db->get_cookie_count
 
370
 Function: returns # cookies in internal queue
 
371
 Returns : integer 
 
372
 Args    : none
 
373
 
 
374
=cut
 
375
 
 
376
sub get_cookie_count {
 
377
    my $self = shift;
 
378
    return $self->{'_cookiecount'};
 
379
}
 
380
 
 
381
=head2 rewind_cookies
 
382
 
 
383
 Title   : rewind_cookies
 
384
 Usage   : $elink->rewind_cookies;
 
385
 Function: resets cookie index to 0 (starts over)
 
386
 Returns : None
 
387
 Args    : None
 
388
 
 
389
=cut
 
390
 
 
391
sub rewind_cookies {
 
392
    my $self = shift;
 
393
    $self->{'_cookieindex'} = 0;
 
394
}
 
395
 
 
396
 
 
397
=head2 keep_cookies
 
398
 
 
399
 Title   : keep_cookies
 
400
 Usage   : $db->keep_cookie(1)
 
401
 Function: Flag to retain the internal cookie queue;
 
402
           this is normally emptied upon using get_response
 
403
 Returns : none
 
404
 Args    : Boolean - value that evaluates to TRUE or FALSE
 
405
 
 
406
=cut
 
407
 
 
408
sub keep_cookies {
 
409
    my $self = shift;
 
410
    return $self->{'_keep_cookies'} = shift if @_;
 
411
    return $self->{'_keep_cookies'};
 
412
}
 
413
 
 
414
=head2 parse_response
 
415
 
 
416
 Title   : parse_response
 
417
 Usage   : $db->_parse_response($content)
 
418
 Function: parse out response for cookies and other goodies
 
419
 Returns : empty
 
420
 Args    : none
 
421
 Throws  : Not implemented (implemented in plugin classes)
 
422
 
 
423
=cut
 
424
 
 
425
sub parse_response {
 
426
  my $self = shift;
 
427
  $self->throw_not_implemented;
 
428
}
 
429
 
 
430
=head2 get_response
 
431
 
 
432
 Title   : get_response
 
433
 Usage   : $db->get_response($content)
 
434
 Function: main method to submit request and retrieves a response
 
435
 Returns : HTTP::Response object
 
436
 Args    : None
 
437
 
 
438
=cut
 
439
 
 
440
sub get_response {
 
441
    my $self = shift;
 
442
    $self->_sleep; # institute delay policy
 
443
    my $request = $self->_submit_request;
 
444
        if ($self->authentication) {
 
445
        $request->proxy_authorization_basic($self->authentication)
 
446
    }
 
447
    if (!$request->is_success) {
 
448
        $self->throw(ref($self)." Request Error:".$request->as_string);
 
449
    }
 
450
    $self->reset_cookies if !($self->keep_cookies);
 
451
    $self->parse_response($request);  # grab cookies and what not
 
452
    return $request;
 
453
}
 
454
 
 
455
# not implemented yet
 
456
#=head2 reset_parameters
 
457
#
 
458
# Title   : reset_parameters
 
459
# Usage   : $db->reset_parameters(@args);
 
460
# Function: resets the parameters for a EUtility with args (in @args)
 
461
# Returns : none
 
462
# Args    : array of arguments (arg1 => value, arg2 => value)
 
463
#
 
464
#=cut
 
465
 
 
466
#sub reset_parameters {
 
467
#    my $self = shift;
 
468
#    my @args = @_;
 
469
#    $self->reset_cookies; # no baggage allowed
 
470
#    if ($self->can('next_linkset')) {
 
471
#        $self->reset_linksets;
 
472
#    }
 
473
#    # resetting the EUtility will not occur even if added as a parameter;
 
474
#    $self->_initialize(@args); 
 
475
#}
 
476
 
 
477
=head2 get_ids
 
478
 
 
479
 Title   : get_ids
 
480
 Usage   : $count = $elink->get_ids($db); # array ref of specific db ids
 
481
           @ids   = $esearch->get_ids(); # array
 
482
           $ids   = $esearch->get_ids(); # array ref
 
483
 Function: returns an array or array ref of unique IDs.
 
484
 Returns : array or array ref of ids 
 
485
 Args    : Optional : database string if elink used (required arg if searching
 
486
           multiple databases for related IDs)
 
487
           Currently implemented only for elink object with single linksets
 
488
 
 
489
=cut
 
490
 
 
491
sub get_ids {
 
492
    my $self = shift;
 
493
    my $user_db = shift if @_;
 
494
    if ($self->can('get_all_linksets')) {
 
495
        my $querydb = $self->db;
 
496
        if (!$user_db && ($querydb eq 'all' || $querydb =~ m{,}) ) {
 
497
            $self->throw(q(Multiple databases searched; must use a specific ).
 
498
                         q(database as an argument.) );
 
499
        }
 
500
        
 
501
        my $count = $self->get_linkset_count;
 
502
        if ($count == 0) {
 
503
            $self->throw( q(No linksets!) );
 
504
        }
 
505
        elsif ($count == 1) {
 
506
            my ($linkset) = $self->get_all_linksets;
 
507
            my ($db) = $user_db ? $user_db : $linkset->get_all_linkdbs;
 
508
            $self->_add_db_ids( scalar( $linkset->get_LinkIds_by_db($db) ) );
 
509
        }
 
510
        else {
 
511
            $self->throw( q(Multiple linkset objects present; can't use get_ids.).
 
512
                 qq(\nUse get_all_linksets/get_databases/get_LinkIds_by_db ).
 
513
                 qq(\n$count total linksets ));
 
514
        }
 
515
    }
 
516
    if ($self->{'_db_ids'}) {
 
517
        return @{$self->{'_db_ids'}} if wantarray;
 
518
        return $self->{'_db_ids'};
 
519
    }
 
520
}
 
521
 
 
522
# carried over from NCBIHelper/WebDBSeqI
 
523
 
 
524
=head2 delay_policy
 
525
 
 
526
  Title   : delay_policy
 
527
  Usage   : $secs = $self->delay_policy
 
528
  Function: return number of seconds to delay between calls to remote db
 
529
  Returns : number of seconds to delay
 
530
  Args    : none
 
531
 
 
532
  NOTE: NCBI requests a delay of 3 seconds between requests.  This method
 
533
        implements that policy.
 
534
 
 
535
=cut
 
536
 
 
537
sub delay_policy {
 
538
  my $self = shift;
 
539
  return 3;
 
540
}
 
541
 
 
542
=head2 get_entrezdbs
 
543
 
 
544
  Title   : get_entrezdbs
 
545
  Usage   : @dbs = $self->get_entrezdbs;
 
546
  Function: return list of all Entrez databases; convenience method
 
547
  Returns : array or array ref (based on wantarray) of databases 
 
548
  Args    : none
 
549
 
 
550
=cut
 
551
 
 
552
sub get_entrezdbs {
 
553
    my $self = shift;
 
554
    my $info = Bio::DB::EUtilities->new(-eutil => 'einfo');
 
555
    $info->get_response;
 
556
    # copy list, not ref of list (so einfo obj doesn't stick around)
 
557
    my @databases = $info->einfo_dbs;
 
558
    return @databases;
 
559
}
 
560
 
 
561
=head1 Private methods
 
562
 
 
563
=cut
 
564
 
 
565
#=head2 _add_db_ids
 
566
#
 
567
# Title   : _add_db_ids
 
568
# Usage   : $self->add_db_ids($db, $ids);
 
569
# Function: sets internal hash of databases with reference to array of IDs
 
570
# Returns : none
 
571
# Args    : String (name of database) and ref to array of ID's 
 
572
#
 
573
#=cut
 
574
 
 
575
# used by esearch and elink, hence here
 
576
 
 
577
sub _add_db_ids {
 
578
    my ($self, $ids) = @_;
 
579
    $self->throw ("IDs must be an ARRAY reference") unless ref($ids) =~ m{ARRAY}i;
 
580
    my @ids = @{ $ids}; # deep copy
 
581
    $self->{'_db_ids'} = \@ids; 
 
582
}
 
583
 
 
584
=head2 _eutil
 
585
 
 
586
 Title   : _eutil
 
587
 Usage   : $db->_eutil;
 
588
 Function: sets eutil 
 
589
 Returns : eutil
 
590
 Args    : eutil
 
591
 
 
592
=cut
 
593
 
 
594
sub _eutil   {
 
595
    my $self = shift;
 
596
    return $self->{'_eutil'} = shift if @_;
 
597
    return $self->{'_eutil'};
 
598
}
 
599
 
 
600
# _submit_request
 
601
 
 
602
 #Title   : _submit_request
 
603
 #Usage   : my $url = $self->_submit_request
 
604
 #Function: builds request object based on set parameters
 
605
 #Returns : HTTP::Request
 
606
 #Args    : None
 
607
 
 
608
#
 
609
# as the name implies....
 
610
 
 
611
sub _submit_request {
 
612
    my $self = shift;
 
613
    my %params = $self->_get_params;
 
614
    my $eutil = $self->_eutil;
 
615
    if ($self->id) {
 
616
        # this is in case multiple id groups are present
 
617
        if ($self->can('multi_id') && $self->multi_id) {
 
618
            # multiple id groups if groups are together in an array reference
 
619
            # ids and arrays are flattened into individual groups
 
620
            for my $id_group (@{ $self->id }) {
 
621
                if (ref($id_group) eq 'ARRAY') {
 
622
                    push @{ $params{'id'} }, (join q(,), @{ $id_group });
 
623
                }
 
624
                elsif (!ref($id_group)) {
 
625
                    push @{ $params{'id'} }, $id_group;
 
626
                }
 
627
                else {
 
628
                    $self->throw("Unknown ID type: $id_group");
 
629
                }
 
630
            }
 
631
        }
 
632
        else {
 
633
            my @ids = @{ $self->id };
 
634
            $params{'id'} = join ',', @ids;
 
635
        }
 
636
    }
 
637
    my $url = URI->new($HOSTBASE . $CGILOCATION{$eutil}[1]);
 
638
    $url->query_form(%params);
 
639
    $self->debug("The web address:\n".$url->as_string."\n");
 
640
    if ($CGILOCATION{$eutil}[0] eq 'post') {    # epost request
 
641
        return $self->post($url);
 
642
    } else {                                    # all other requests
 
643
        return $self->get($url);
 
644
    }
 
645
}
 
646
 
 
647
# _get_params
 
648
 
 
649
# Title   : _get_params
 
650
# Usage   : my $url = $self->_get_params
 
651
# Function: builds parameter list for web request
 
652
# Returns : hash of parameter-value paris
 
653
# Args    : None
 
654
 
 
655
# these get sorted out in a hash originally but end up in an array to
 
656
# deal with multiple id parameters (hash values would kill that)
 
657
 
 
658
sub _get_params {
 
659
    my $self = shift;
 
660
    my $cookie = $self->get_all_cookies ? $self->get_all_cookies : 0;
 
661
    my @final;  # final parameter list; this changes dep. on presence of cookie
 
662
    my $eutil = $self->_eutil;
 
663
    my %params;
 
664
    @final =  ($cookie && $cookie->isa("Bio::DB::EUtilities::Cookie")) ?
 
665
              @COOKIE_PARAMS : @PARAMS;
 
666
              
 
667
    # build parameter hash based on final parameter list
 
668
    for my $method (@final) {
 
669
        if ($self->$method) {
 
670
            $params{$method} = $self->$method;
 
671
        }
 
672
    }
 
673
    
 
674
    if ($cookie) {
 
675
        my ($webenv, $qkey) = @{$cookie->cookie};
 
676
        $self->debug("WebEnv:$webenv\tQKey:$qkey\n");
 
677
        ($params{'WebEnv'}, $params{'query_key'}) = ($webenv, $qkey);
 
678
        $params{'dbfrom'} = $cookie->database if $eutil eq 'elink';
 
679
    }
 
680
    
 
681
    my $db = $self->db;
 
682
    
 
683
    # elink cannot set the db from a cookie (it is actually dbfrom)
 
684
    $params{'db'} = $db                                   ? $db               : 
 
685
                    ($cookie && $eutil ne 'elink') ? $cookie->database :
 
686
                    'nucleotide';
 
687
    # einfo db exception (db is optional)
 
688
    if (!$db && ($eutil eq 'einfo' || $eutil eq 'egquery')) {
 
689
        delete $params{'db'};
 
690
    }
 
691
    unless (exists $params{'retmode'}) { # set by user
 
692
        my $format = $CGILOCATION{ $eutil }[2];  # set by eutil 
 
693
        if ($format eq 'dbspec') {  # database-specific
 
694
            $format = $DATABASE{$params{'db'}} ?
 
695
                      $DATABASE{$params{'db'}} : 'xml'; # have xml as a fallback
 
696
        }
 
697
        $params{'retmode'} = $format;
 
698
    }
 
699
    $self->debug("Param: $_\tValue: $params{$_}\n") for keys %params;
 
700
    return %params;
 
701
}
 
702
 
 
703
# enable dynamic loading of proper module at run time
 
704
 
 
705
sub _load_eutil_module {
 
706
  my ($self,$eutil) = @_;
 
707
  my $module = "Bio::DB::EUtilities::" . $eutil;
 
708
  my $ok;
 
709
  
 
710
  eval {
 
711
      $ok = $self->_load_module($module);
 
712
  };
 
713
  if ( $@ ) {
 
714
      print STDERR <<END;
 
715
$self: $eutil cannot be found
 
716
Exception $@
 
717
For more information about the EUtilities system please see the EUtilities docs.
 
718
This includes ways of checking for formats at compile time, not run time
 
719
END
 
720
  ;
 
721
  }
 
722
  return $ok;
 
723
}
 
724
 
 
725
sub _next_cookie_index {
 
726
    my $self = shift;
 
727
    return $self->{'_cookieindex'}++;
 
728
}
 
729
 
 
730
1;
 
731
__END__