← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/DB/Taxonomy/entrez.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/Taxonomy/entrez.pm
1
 
# $Id: entrez.pm,v 1.4 2003/05/15 18:05:42 jason Exp $
 
1
# $Id: entrez.pm,v 1.18.4.3 2006/11/08 17:25:54 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::DB::Taxonomy::entrez
4
4
#
23
23
 
24
24
  my $db = new Bio::DB::Taxonomy(-source => 'entrez');
25
25
 
26
 
  my $taxaid = $db->get_taxaid('Homo sapiens');
 
26
  my $taxonid = $db->get_taxonid('Homo sapiens');
 
27
  my $node   = $db->get_Taxonomy_Node(-taxonid => $taxonid);
 
28
 
 
29
  my $gi = 71836523;
 
30
  my $node = $db->get_Taxonomy_Node(-gi => $gi, -db => 'protein');
 
31
  print $node->binomial, "\n";
 
32
  my ($species,$genus,$family) =  $node->classification;
 
33
  print "family is $family\n";
 
34
 
 
35
  # Can also go up 4 levels
 
36
  my $p = $node;  
 
37
  for ( 1..4 ) { 
 
38
    $p = $db->get_Taxonomy_Node(-taxonid => $p->parent_id);
 
39
  }
 
40
  print $p->rank, " ", ($p->classification)[0], "\n";
 
41
 
 
42
  # could then classify a set of BLAST hits based on their GI numbers
 
43
  # into taxonomic categories.
 
44
 
 
45
 
 
46
It is not currently possibly to query a node for its children so we
 
47
cannot completely replace the advantage of the flatfile
 
48
Bio::DB::Taxonomy::flatfile module.
 
49
 
27
50
 
28
51
=head1 DESCRIPTION
29
52
 
37
60
Bioperl modules. Send your comments and suggestions preferably to
38
61
the Bioperl mailing list.  Your participation is much appreciated.
39
62
 
40
 
  bioperl-l@bioperl.org              - General discussion
41
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
63
  bioperl-l@bioperl.org                  - General discussion
 
64
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
42
65
 
43
66
=head2 Reporting Bugs
44
67
 
46
69
of the bugs and their resolution. Bug reports can be submitted via
47
70
the web:
48
71
 
49
 
  http://bugzilla.bioperl.org/
 
72
  http://bugzilla.open-bio.org/
50
73
 
51
74
=head1 AUTHOR - Jason Stajich
52
75
 
54
77
 
55
78
=head1 CONTRIBUTORS
56
79
 
57
 
Additional contributors names and emails here
 
80
Sendu Bala: bix@sendu.me.uk
58
81
 
59
82
=head1 APPENDIX
60
83
 
63
86
 
64
87
=cut
65
88
 
66
 
 
67
89
# Let the code begin...
68
90
 
69
 
 
70
91
package Bio::DB::Taxonomy::entrez;
71
 
use vars qw(@ISA $EntrezLocation $UrlParamSeparatorValue %EntrezParams
72
 
            $EntrezGet $EntrezSummary
73
 
            $XMLTWIG);
 
92
use vars qw($EntrezLocation $UrlParamSeparatorValue %EntrezParams
 
93
            $EntrezGet $EntrezSummary $EntrezFetch %SequenceParams
 
94
            $XMLTWIG $DATA_CACHE $RELATIONS);
74
95
use strict;
75
96
 
76
 
use Bio::DB::Taxonomy;
77
 
use Bio::Root::HTTPget;
78
 
use Bio::Species;
 
97
use Bio::Taxon;
79
98
 
80
99
eval {
81
100
    require XML::Twig;
84
103
if( $@ ) {
85
104
    $XMLTWIG = 0;
86
105
}
87
 
@ISA = qw(Bio::DB::Taxonomy Bio::Root::HTTPget);
 
106
 
 
107
use base qw(Bio::WebAgent Bio::DB::Taxonomy);
88
108
 
89
109
$EntrezLocation = 'http://www.ncbi.nih.gov/entrez/eutils/';
90
110
$EntrezGet      = 'esearch.fcgi';
 
111
$EntrezFetch    = 'efetch.fcgi';
91
112
$EntrezSummary  = 'esummary.fcgi';
92
113
 
93
 
%EntrezParams = ( 'db' => 'taxonomy');
 
114
$DATA_CACHE = {};
 
115
$RELATIONS  = {};
 
116
 
 
117
%EntrezParams = ( 'db'     => 'taxonomy', 
 
118
                  'report' => 'xml',
 
119
                  'retmode'=> 'xml',
 
120
                  'tool'   => 'Bioperl');
 
121
 
 
122
%SequenceParams = ( 'db'      => 'nucleotide', # or protein
 
123
                            'retmode' => 'xml',
 
124
                            'tool'    => 'Bioperl');
 
125
 
94
126
$UrlParamSeparatorValue = '&';
95
127
 
96
128
=head2 new
105
137
 
106
138
=cut
107
139
 
 
140
sub new {
 
141
        my ($class, @args) = @_;
 
142
        
 
143
        # need to initialise Bio::WebAgent...
 
144
        my ($self) = $class->SUPER::new(@args);
 
145
        
 
146
        # ... as well as our normal Bio::DB::Taxonomy selves:
 
147
        $self->_initialize(@args);
 
148
        return $self;
 
149
}
 
150
 
108
151
sub _initialize {
109
152
  my($self) = shift;
110
 
  if( ! $XMLTWIG ) {
111
 
      $self->throw("Need to have installed XML::Twig");
112
 
  }
113
153
 
114
154
  $self->SUPER::_initialize(@_);
115
155
 
116
156
  my ($location,$params) = $self->_rearrange([qw(LOCATION PARAMS)],@_);
117
157
 
118
 
  $self->entrez_url($location || $EntrezLocation );
119
158
  if( $params ) {
120
159
      if( ref($params) !~ /HASH/i ) {
121
160
          $self->warn("Must have provided a valid HASHref for -params");
128
167
  $self->entrez_url($location || $EntrezLocation );
129
168
}
130
169
 
131
 
 
132
 
=head2 get_Taxonomy_Node
133
 
 
134
 
 Title   : get_Taxonomy_Node
135
 
 Usage   : my $species = $db->get_Taxonomy_Node(-taxonid => $taxonid)
136
 
 Function: Get a Bio::Taxonomy::Taxon object
137
 
 Returns : Bio::Taxonomy::Taxon object(s) [more than one
138
 
 Args    : -taxonid => taxonomy id (to query by taxonid)
139
 
            OR
140
 
           -name   => string (to query by a taxonomy name: common name,
141
 
                              species, genus, etc)
142
 
           or just a single value which is the taxid.
143
 
 
144
 
=cut
145
 
 
146
 
sub get_Taxonomy_Node{
147
 
   my ($self) = shift;
148
 
   my %p = $self->entrez_params;
149
 
   my $taxonid;
150
 
   if( @_ > 1 ) {
151
 
       my %params = @_;
152
 
       if( $params{'-taxonid'} ) {
153
 
           $taxonid = $params{'-taxonid'};
154
 
       } elsif( $params{'-name'} ) {
155
 
           my @taxaids = $self->get_taxonid($params{'-name'});
156
 
           if( @taxaids > 1 ) { 
157
 
               $self->warn("Got > 1 taxid for ".$params{'-name'}. " only using the first one");
158
 
               $taxonid = shift @taxaids;
159
 
           }
160
 
       } else { 
161
 
           $self->warn("Need to have provided either a -taxonid or -name value to get_Taxonomy_Node");
162
 
       } 
163
 
   } else { 
164
 
       $taxonid= shift;
165
 
   }
166
 
   $p{'id'}      = $taxonid;
167
 
 
168
 
   my $params = join($UrlParamSeparatorValue, map { "$_=".$p{$_} } keys %p);
169
 
   my $url = sprintf("%s%s?%s",$self->entrez_url,$EntrezSummary,$params);
170
 
   $self->debug("url is $url\n")  if( $self->verbose > 0);
171
 
   my $response;
172
 
   eval {
173
 
       $response = $self->get($url);
174
 
   };
175
 
   if( $@ ) {
176
 
       $self->warn("Can't query website: $@");
177
 
       return;
178
 
   }
179
 
   my $twig = new XML::Twig;
180
 
   $self->debug( "resp is $response\n") if( $self->verbose > 0);
181
 
   $twig->parse($response);
182
 
   my $root = $twig->root;
183
 
   my $list = $root->first_child('DocSum');
184
 
   if( ! $list ) { 
185
 
       $self->warn("Could not find any value for $taxonid");
186
 
       return undef;
187
 
   }
188
 
   my ($id) = map { $_->text } $list->children('Id');
189
 
 
190
 
   my (%item) = map {  $_->{'att'}->{'Name'} => $_->text } $list->children('Item');
191
 
 
192
 
   if( $item{'RANK'} eq 'species') {
193
 
       my $node = new Bio::Species(-ncbi_taxid     => $id,
194
 
                                   -common_name    => $item{'CommonName'},
195
 
                                   -division       => $item{'Division'});
196
 
       my ($genus,$species,$subspecies) = split(' ',$item{'ScientificName'},3);
197
 
       $node->genus($species);
198
 
       $node->species($species);
199
 
       return $node;
200
 
   } else {
201
 
       $self->warn(sprintf("can't create a species object for %s (%s) because it isn't a species but is a '%s' instead",$item{'ScientificName'},$item{'CommonName'}, $item{'RANK'}));
202
 
   }
203
 
   \%item;
204
 
}
205
 
 
206
 
 
207
 
=head2 get_taxonid
208
 
 
209
 
 Title   : get_taxonid
210
 
 Usage   : my $taxonid = $db->get_taxonid('Homo sapiens');
211
 
 Function: Searches for a taxonid (typically ncbi_taxon_id)
212
 
           based on a query string
213
 
 Returns : Integer ID
214
 
 Args    : Array of Strings representing species/node name
215
 
 
216
 
 
217
 
=cut
218
 
 
219
 
sub get_taxonid {
220
 
   my ($self,$query) = @_;
221
 
   my %p = $self->entrez_params;
222
 
   $query        =~ s/\s/\+/g;
223
 
   $p{'term'}      = $query;
224
 
   my $params = join($UrlParamSeparatorValue, map { "$_=".$p{$_} } keys %p);
225
 
   my $url = sprintf("%s%s?%s",$self->entrez_url,$EntrezGet,$params);
226
 
   my $response;
227
 
   eval {
228
 
       $response = $self->get($url);
229
 
   };
230
 
   if( $@ ) {
231
 
       $self->warn("Can't query website: $@");
232
 
       return;
233
 
   }
234
 
   $self->debug( "response is $response\n") if( $self->verbose > 0);
235
 
 
236
 
   my $twig = new XML::Twig;
237
 
   $twig->parse($response);
238
 
   my $root = $twig->root;
239
 
   my $list = $root->first_child('IdList');
240
 
   my @data = map { $_->text } $list->children('Id');
241
 
   ( wantarray ) ? @data : shift @data;
242
 
}
243
 
 
244
 
 
 
170
=head2 get_taxon
 
171
 
 
172
 Title   : get_taxon
 
173
 Usage   : my $taxon = $db->get_taxon(-taxonid => $taxonid)
 
174
 Function: Get a Bio::Taxon object from the database.
 
175
 Returns : Bio::Taxon object
 
176
 Args    : just a single value which is the database id, OR named args:
 
177
           -taxonid => taxonomy id (to query by taxonid)
 
178
            OR
 
179
           -name    => string (to query by a taxonomy name: common name, 
 
180
                               scientific name, etc)
 
181
            OR
 
182
           To retrieve a taxonomy node for a GI number provide the -gi option
 
183
           with the gi number and -db with either 'nucleotide' or 'protein' to
 
184
           define the db.
 
185
            AND optionally,
 
186
           -full    => 1 (to force retrieval of full information - sometimes
 
187
                          minimal information about your taxon may have been
 
188
                          cached, which is normally used to save database
 
189
                          accesses)
 
190
 
 
191
=cut
 
192
 
 
193
sub get_taxon {
 
194
    my $self = shift;
 
195
    if (! $XMLTWIG) {
 
196
        $self->throw("Need to have installed XML::Twig");
 
197
    }
 
198
    
 
199
    my %p = $self->entrez_params;
 
200
    
 
201
    # convert input request to one or more ids
 
202
    my (@taxonids, $taxonid, $want_full);
 
203
    if (@_ > 1) {
 
204
        my %params = @_;
 
205
        if ($params{'-taxonid'}) {
 
206
            $taxonid = $params{'-taxonid'};
 
207
        }
 
208
        elsif ($params{'-gi'}) {
 
209
            my $db = $params{'-db'};
 
210
            # we're going to do all the work here and then redirect
 
211
            # the call based on the TaxId
 
212
            my %p = %SequenceParams;
 
213
            my %items;
 
214
            if( ref($params{'-gi'}) =~ /ARRAY/i ) {            
 
215
                $p{'id'} = join(',', @{$params{'-gi'}});
 
216
            } else { 
 
217
                $p{'id'} = $params{'-gi'}; 
 
218
            }
 
219
            $p{'db'} = $db if defined $db;
 
220
            my $params = join($UrlParamSeparatorValue, map { "$_=".$p{$_} } keys %p);
 
221
            my $url = sprintf("%s%s?%s",$self->entrez_url,$EntrezSummary,$params);
 
222
            $self->debug("url is $url\n");
 
223
            
 
224
            my @ids;
 
225
            if (exists $DATA_CACHE->{gi_to_ids}->{$url}) {
 
226
                @ids = @{$DATA_CACHE->{gi_to_ids}->{$url}};
 
227
            }
 
228
            else {
 
229
                my $response = $self->get($url);
 
230
                                if ($response->is_success) {
 
231
                                        $response = $response->content;
 
232
                                }
 
233
                                else {
 
234
                                        $self->throw("Can't query website: ".$response->status_line);
 
235
                                }
 
236
                                
 
237
                $self->debug("resp is $response\n");
 
238
                my $twig = XML::Twig->new;
 
239
                $twig->parse($response);
 
240
                my $root = $twig->root;
 
241
                
 
242
                for my $topnode ( $root->children('DocSum') ) {
 
243
                    for my $child ( $topnode->children('Item') ) {
 
244
                        if( uc($child->{att}->{'Name'}) eq 'TAXID' ) {
 
245
                            push @ids, $child->text;
 
246
                        }
 
247
                    }
 
248
                }
 
249
                
 
250
                $DATA_CACHE->{gi_to_ids}->{$url} = \@ids;
 
251
            }
 
252
            
 
253
            return $self->get_taxon(-taxonid => \@ids);
 
254
        }
 
255
        elsif ($params{'-name'}) {
 
256
            @taxonids = $self->get_taxonid($params{'-name'});
 
257
        }
 
258
        else { 
 
259
            $self->warn("Need to have provided either a -taxonid or -name value to get_taxon");
 
260
        }
 
261
        
 
262
        if ($params{'-full'}) {
 
263
            $want_full = 1;
 
264
        }
 
265
    }
 
266
    else {
 
267
        $taxonid = shift;
 
268
    }
 
269
    
 
270
    if (ref($taxonid) =~ /ARRAY/i ) {
 
271
        @taxonids = @{$taxonid};
 
272
    }
 
273
    else {
 
274
        push(@taxonids, $taxonid) if $taxonid;
 
275
    }
 
276
    
 
277
    # return answer(s) from the cache if possible
 
278
    my @results;
 
279
    my @uncached;
 
280
    foreach my $taxonid (@taxonids) {
 
281
        $taxonid || $self->throw("In taxonids list one was undef! '@taxonids'\n");
 
282
        if (defined $DATA_CACHE->{full_info}->{$taxonid}) {
 
283
            push(@results, $self->_make_taxon($DATA_CACHE->{full_info}->{$taxonid}));
 
284
        }
 
285
        elsif (! $want_full && defined $DATA_CACHE->{minimal_info}->{$taxonid}) {
 
286
            push(@results, $self->_make_taxon($DATA_CACHE->{minimal_info}->{$taxonid}));
 
287
        }
 
288
        else {
 
289
            push(@uncached, $taxonid);
 
290
        }
 
291
    }
 
292
    
 
293
    if (@uncached > 0) {
 
294
        $taxonid = join(',', @uncached);
 
295
        
 
296
        $p{'id'}      = $taxonid;
 
297
        $self->debug("id is $taxonid\n");
 
298
        my $params = join($UrlParamSeparatorValue, map { "$_=".$p{$_} } keys %p);
 
299
        
 
300
        my $url = sprintf("%s%s?%s",$self->entrez_url,$EntrezFetch,$params);
 
301
        $self->debug("url is $url\n");
 
302
        my $response = $self->get($url);
 
303
                if ($response->is_success) {
 
304
                        $response = $response->content;
 
305
                }
 
306
                else {
 
307
                        $self->throw("Can't query website: ".$response->status_line);
 
308
                }
 
309
        $self->debug("resp is $response\n");
 
310
        
 
311
        my $twig = XML::Twig->new;
 
312
        $twig->parse($response);
 
313
        
 
314
        my $root = $twig->root;
 
315
        for my $taxon ( $root->children('Taxon') ) {
 
316
            my $taxid = $taxon->first_child_text('TaxId');
 
317
            $self->throw("Got a result with no TaxId!") unless $taxid;
 
318
            
 
319
            my $data = {};
 
320
            if (exists $DATA_CACHE->{minimal_info}->{$taxid}) {
 
321
                $data = $DATA_CACHE->{minimal_info}->{$taxid};
 
322
            }
 
323
            
 
324
            $data->{id} = $taxid;
 
325
            $data->{rank} = $taxon->first_child_text('Rank');
 
326
            
 
327
            my $other_names = $taxon->first_child('OtherNames');
 
328
            my @other_names = $other_names->children_text() if $other_names;
 
329
            my $sci_name = $taxon->first_child_text('ScientificName');
 
330
            my $orig_sci_name = $sci_name;
 
331
            $sci_name =~ s/ \(class\)$//;
 
332
            push(@other_names, $orig_sci_name) if $orig_sci_name ne $sci_name;
 
333
            $data->{scientific_name} = $sci_name;
 
334
            $data->{common_names} = \@other_names;
 
335
            
 
336
            $data->{division} = $taxon->first_child_text('Division');
 
337
            $data->{genetic_code} = $taxon->first_child('GeneticCode')->first_child_text('GCId');
 
338
            $data->{mitochondrial_genetic_code} = $taxon->first_child('MitoGeneticCode')->first_child_text('MGCId');
 
339
            $data->{create_date} = $taxon->first_child_text('CreateDate');
 
340
            $data->{update_date} = $taxon->first_child_text('UpdateDate');
 
341
            $data->{pub_date} = $taxon->first_child_text('PubDate');
 
342
            
 
343
            # since we have some information about all the ancestors of our
 
344
            # requested node, we may as well cache data for the ancestors to
 
345
            # reduce the number of accesses to website in future
 
346
            my $lineage_ex = $taxon->first_child('LineageEx');
 
347
            my ($ancestor, $lineage_data, @taxa);
 
348
            foreach my $lineage_taxon ($lineage_ex->children) {
 
349
                my $lineage_taxid = $lineage_taxon->first_child_text('TaxId');
 
350
                
 
351
                if (exists $DATA_CACHE->{minimal_info}->{$lineage_taxid} || exists $DATA_CACHE->{full_info}->{$lineage_taxid}) {
 
352
                    $lineage_data = $DATA_CACHE->{minimal_info}->{$lineage_taxid} || $DATA_CACHE->{full_info}->{$lineage_taxid};
 
353
                    next;
 
354
                }
 
355
                else {
 
356
                    $lineage_data = {};
 
357
                }
 
358
                
 
359
                $lineage_data->{id} = $lineage_taxid;
 
360
                $lineage_data->{scientific_name} = $lineage_taxon->first_child_text('ScientificName');
 
361
                $lineage_data->{rank} = $lineage_taxon->first_child_text('Rank');
 
362
                
 
363
                $RELATIONS->{ancestors}->{$lineage_taxid} = $ancestor->{id} if $ancestor;
 
364
                
 
365
                $DATA_CACHE->{minimal_info}->{$lineage_taxid} = $lineage_data;
 
366
            } continue { $ancestor = $lineage_data; unshift(@taxa, $lineage_data); }
 
367
            
 
368
            $RELATIONS->{ancestors}->{$taxid} = $ancestor->{id} if $ancestor;
 
369
            
 
370
            # go through the lineage in reverse so we can remember the children
 
371
            my $child = $data;
 
372
            foreach my $lineage_data (@taxa) {
 
373
                $RELATIONS->{children}->{$lineage_data->{id}}->{$child->{id}} = 1;
 
374
            } continue { $child = $lineage_data; }
 
375
            
 
376
            delete $DATA_CACHE->{minimal_info}->{$taxid};
 
377
            $DATA_CACHE->{full_info}->{$taxid} = $data;
 
378
            push(@results, $self->_make_taxon($data));
 
379
        }
 
380
    }
 
381
    
 
382
    wantarray() ? @results : shift @results;
 
383
}
 
384
 
 
385
*get_Taxonomy_Node = \&get_taxon;
 
386
 
 
387
=head2 get_taxonids
 
388
 
 
389
 Title   : get_taxonids
 
390
 Usage   : my $taxonid = $db->get_taxonids('Homo sapiens');
 
391
 Function: Searches for a taxonid (typically ncbi_taxon_id) based on a query
 
392
           string. Note that multiple taxonids can match to the same supplied
 
393
           name.
 
394
 Returns : array of integer ids in list context, one of these in scalar context
 
395
 Args    : string representing taxon's name
 
396
 
 
397
=cut
 
398
 
 
399
sub get_taxonids {
 
400
    my ($self,$query) = @_;
 
401
    my %p = $self->entrez_params;
 
402
    
 
403
    # queries don't work correctly with special characters, so get rid of them.
 
404
    if ($query =~ /<.+>/) {
 
405
        # queries with <something> will fail, so workaround by removing, doing
 
406
        # the query, getting multiple taxonids, then picking the one id that
 
407
        # has a parent node with a scientific_name() or common_names()
 
408
        # case-insensitive matching to the word(s) within <>
 
409
        $query =~ s/ <(.+?)>//;
 
410
        my $desired_parent_name = lc($1);
 
411
        
 
412
        ID: foreach my $start_id ($self->get_taxonids($query)) {
 
413
            my $node = $self->get_taxon($start_id) || next ID;
 
414
            
 
415
            # walk up the parents until we hit a node with a named rank
 
416
            while (1) {
 
417
                my $parent_node = $self->ancestor($node) || next ID;
 
418
                my $parent_sci_name = $parent_node->scientific_name || next ID;
 
419
                my @parent_common_names = $parent_node->common_names;
 
420
                
 
421
                foreach my $name ($parent_sci_name, @parent_common_names) {
 
422
                    if (lc($name) eq $desired_parent_name) {
 
423
                        return wantarray() ? ($start_id) : $start_id;
 
424
                    }
 
425
                }
 
426
                
 
427
                my $parent_rank = $parent_node->rank || 'no rank';
 
428
                if ($parent_rank ne 'no rank') {
 
429
                    last;
 
430
                }
 
431
                else {
 
432
                    $node = $parent_node;
 
433
                }
 
434
            }
 
435
        }
 
436
        return;
 
437
    }
 
438
    $query =~ s/[\"\(\)]//g; # not an exhaustive list; these are just the ones I know cause problems
 
439
    $query =~ s/\s/+/g;
 
440
    
 
441
    my @data;
 
442
    if (defined $DATA_CACHE->{name_to_id}->{$query}) {
 
443
        @data = @{$DATA_CACHE->{name_to_id}->{$query}};
 
444
    }
 
445
    else {
 
446
        $p{'term'} = $query;
 
447
        my $params = join($UrlParamSeparatorValue, map { "$_=".$p{$_} } keys %p);
 
448
        my $url = sprintf("%s%s?%s",$self->entrez_url,$EntrezGet,$params);
 
449
        my $response = $self->get($url);
 
450
                if ($response->is_success) {
 
451
                        $response = $response->content;
 
452
                }
 
453
                else {
 
454
                        $self->throw("Can't query website: ".$response->status_line);
 
455
                }
 
456
        $self->debug("response is $response\n");
 
457
        my $twig = XML::Twig->new;
 
458
        $twig->parse($response);
 
459
        my $root = $twig->root;
 
460
        my $list = $root->first_child('IdList');
 
461
        @data = map { $_->text } $list->children('Id');
 
462
        
 
463
        $DATA_CACHE->{name_to_id}->{$query} = [@data];
 
464
    }
 
465
    
 
466
    wantarray() ? @data : shift @data;
 
467
}
 
468
 
 
469
*get_taxonid = \&get_taxonids;
 
470
 
 
471
=head2 ancestor
 
472
 
 
473
 Title   : ancestor
 
474
 Usage   : my $ancestor_taxon = $db->ancestor($taxon)
 
475
 Function: Retrieve the ancestor taxon of a supplied Taxon from the database.
 
476
 
 
477
           Note that unless the ancestor has previously been directly
 
478
           requested with get_taxon(), the returned Taxon object will only have
 
479
           a minimal amount of information.
 
480
 
 
481
 Returns : Bio::Taxon
 
482
 Args    : Bio::Taxon (that was retrieved from this database)
 
483
 
 
484
=cut
 
485
 
 
486
sub ancestor {
 
487
    my ($self, $taxon) = @_;
 
488
    $self->throw("Must supply a Bio::Taxon") unless ref($taxon) && $taxon->isa('Bio::Taxon');
 
489
    $self->throw("The supplied Taxon must belong to this database") unless $taxon->db_handle && $taxon->db_handle eq $self;
 
490
    my $id = $taxon->id || $self->throw("The supplied Taxon is missing its id!");
 
491
    
 
492
    my $ancestor_id = $RELATIONS->{ancestors}->{$id} || return;
 
493
    return $self->_make_taxon($DATA_CACHE->{full_info}->{$ancestor_id} || $DATA_CACHE->{minimal_info}->{$ancestor_id});
 
494
}
 
495
 
 
496
=head2 each_Descendent
 
497
 
 
498
 Title   : each_Descendent
 
499
 Usage   : my @taxa = $db->each_Descendent($taxon);
 
500
 Function: Get all the descendents of the supplied Taxon (but not their
 
501
           descendents, ie. not a recursive fetchall).
 
502
 
 
503
           Note that this implementation is unable to return a taxon that
 
504
           hasn't previously been directly fetched with get_taxon(), or wasn't
 
505
           an ancestor of such a fetch.
 
506
 
 
507
 Returns : Array of Bio::Taxon objects
 
508
 Args    : Bio::Taxon (that was retrieved from this database)
 
509
 
 
510
=cut
 
511
 
 
512
sub each_Descendent {
 
513
    my ($self, $taxon) = @_;
 
514
    $self->throw("Must supply a Bio::Taxon") unless ref($taxon) && $taxon->isa('Bio::Taxon');
 
515
    $self->throw("The supplied Taxon must belong to this database") unless $taxon->db_handle && $taxon->db_handle eq $self;
 
516
    my $id = $taxon->id || $self->throw("The supplied Taxon is missing its id!");
 
517
    
 
518
    my @children_ids = keys %{$RELATIONS->{children}->{$id} || {}};
 
519
    my @children;
 
520
    foreach my $child_id (@children_ids) {
 
521
        push(@children, $self->_make_taxon($DATA_CACHE->{full_info}->{$child_id} || $DATA_CACHE->{minimal_info}->{$child_id}));
 
522
    }
 
523
    
 
524
    return @children;
 
525
}
245
526
 
246
527
=head2 Some Get/Setter methods
247
528
 
255
536
 Returns : value of entrez url (a scalar)
256
537
 Args    : on set, new value (a scalar or undef, optional)
257
538
 
258
 
 
259
539
=cut
260
540
 
261
541
sub entrez_url{
273
553
 Returns : value of entrez_params (a hashref)
274
554
 Args    : on set, new value Hashref
275
555
 
276
 
 
277
556
=cut
278
557
 
279
558
sub entrez_params{
299
578
 Returns : string
300
579
 Args    : protocol ('http' or 'ftp'), default 'http'
301
580
 
302
 
 
303
581
=head2 proxy
304
582
 
305
583
 Title   : proxy
312
590
           $username : username (if proxy requires authentication)
313
591
           $password : password (if proxy requires authentication)
314
592
 
315
 
 
316
593
=head2 authentication
317
594
 
318
595
 Title   : authentication
321
598
 Returns : Array of user/pass
322
599
 Args    : Array or user/pass
323
600
 
324
 
 
325
601
=cut
326
602
 
 
603
# make a Taxon object from data hash ref
 
604
sub _make_taxon {
 
605
    my ($self, $data) = @_;
 
606
    
 
607
    my $taxon = new Bio::Taxon();
 
608
    
 
609
    my $taxid;
 
610
    while (my ($method, $value) = each %{$data}) {
 
611
        if ($method eq 'id') {
 
612
            $method = 'ncbi_taxid'; # since this is a real ncbi taxid, explicitly set it as one
 
613
            $taxid = $value;
 
614
        }
 
615
        $taxon->$method(ref($value) eq 'ARRAY' ? @{$value} : $value);
 
616
    }
 
617
    
 
618
    # we can't use -dbh or the db_handle() method ourselves or we'll go
 
619
    # infinite on the merge attempt
 
620
    $taxon->{'db_handle'} = $self;
 
621
    
 
622
    $self->_handle_internal_id($taxon);
 
623
    
 
624
    return $taxon;
 
625
}
 
626
 
327
627
1;