← Back to branch summary

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

« back to all changes in this revision

Viewing changes to Bio/DB/Taxonomy.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.pm
1
 
# $Id: Taxonomy.pm,v 1.2 2003/05/15 18:05:42 jason Exp $
 
1
# $Id: Taxonomy.pm,v 1.11.4.2 2006/10/02 23:10:15 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::DB::Taxonomy
4
4
#
17
17
=head1 SYNOPSIS
18
18
 
19
19
  use Bio::DB::Taxonomy;
20
 
  my $db = new Bio::DB::Taxonomy(-source => 'entrez'); # use NCBI Entrez over HTTP
21
 
  my $taxaid = $db->get_taxonid('Homo sapiens');
 
20
  my $db = new Bio::DB::Taxonomy(-source => 'entrez');
 
21
  # use NCBI Entrez over HTTP
 
22
  my $taxonid = $db->get_taxonid('Homo sapiens');
 
23
 
 
24
  # get a taxon
 
25
  my $taxon = $db->get_taxon(-taxonid => $taxonid);
22
26
 
23
27
=head1 DESCRIPTION
24
28
 
32
36
Bioperl modules. Send your comments and suggestions preferably to
33
37
the Bioperl mailing list.  Your participation is much appreciated.
34
38
 
35
 
  bioperl-l@bioperl.org              - General discussion
36
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
39
  bioperl-l@bioperl.org                  - General discussion
 
40
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
37
41
 
38
42
=head2 Reporting Bugs
39
43
 
41
45
of the bugs and their resolution. Bug reports can be submitted via
42
46
the web:
43
47
 
44
 
  http://bugzilla.bioperl.org/
 
48
  http://bugzilla.open-bio.org/
45
49
 
46
50
=head1 AUTHOR - Jason Stajich
47
51
 
48
52
Email jason-at-bioperl.org
49
53
 
50
 
Describe contact details here
51
 
 
52
54
=head1 CONTRIBUTORS
53
55
 
54
 
Additional contributors names and emails here
 
56
Sendu Bala: bix@sendu.me.uk
55
57
 
56
58
=head1 APPENDIX
57
59
 
60
62
 
61
63
=cut
62
64
 
63
 
 
64
65
# Let the code begin...
65
66
 
66
 
 
67
67
package Bio::DB::Taxonomy;
68
 
use vars qw(@ISA $DefaultSource);
 
68
use vars qw($DefaultSource $TAXON_IIDS);
69
69
use strict;
70
70
 
71
 
use Bio::Root::HTTPget;
 
71
 
 
72
use base qw(Bio::Root::Root);
 
73
 
72
74
$DefaultSource = 'entrez';
73
 
 
74
 
@ISA = qw(Bio::Root::HTTPget);
 
75
$TAXON_IIDS = {};
75
76
 
76
77
=head2 new
77
78
 
78
79
 Title   : new
79
80
 Usage   : my $obj = new Bio::DB::Taxonomy(-source => 'entrez');
80
 
 Function: Builds a new Bio::DB::Taxonomy object 
 
81
 Function: Builds a new Bio::DB::Taxonomy object.
81
82
 Returns : an instance of Bio::DB::Taxonomy
82
 
 Args    : -source => which database source 'entrez' or 'localfile'
83
 
 
84
 
 
 
83
 Args    : -source => which database source 'entrez' or 'flatfile' or 'list'
85
84
 
86
85
=cut
87
86
 
96
95
      my %param = @args;
97
96
      @param{ map { lc $_ } keys %param } = values %param; # lowercase keys
98
97
      my $source = $param{'-source'} || $DefaultSource;
99
 
      
 
98
 
100
99
      $source = "\L$source";    # normalize capitalization to lower case
101
 
      
 
100
 
102
101
      # normalize capitalization
103
 
      return undef unless( $class->_load_tax_module($source) );
 
102
      return unless( $class->_load_tax_module($source) );
104
103
      return "Bio::DB::Taxonomy::$source"->new(@args);
105
 
  } 
 
104
  }
106
105
}
107
106
 
108
107
# empty for now
109
108
sub _initialize { }
110
109
 
111
 
 
112
 
=head2 get_Taxonomy_Node
113
 
 
114
 
 Title   : get_Taxonomy_Node
115
 
 Usage   : my $species = $db->get_Taxonomy_Node(-taxonid => $taxaid)
116
 
 Function: Get a Bio::Taxonomy::Taxon object for a taxonid
117
 
 Returns : Bio::Taxonomy::Taxon object
118
 
 Args    : -taxonid => taxonomy id (to query by taxonid)
 
110
=head2 get_taxon
 
111
 
 
112
 Title   : get_taxon
 
113
 Usage   : my $taxon = $db->get_taxon(-taxonid => $taxonid)
 
114
 Function: Get a Bio::Taxon object from the database.
 
115
 Returns : Bio::Taxon object
 
116
 Args    : just a single value which is the database id, OR named args:
 
117
           -taxonid => taxonomy id (to query by taxonid)
119
118
            OR
120
 
           -name   => string (to query by a taxonomy name: common name, 
121
 
                              species, genus, etc)
122
 
 
123
 
 
124
 
=cut
125
 
 
126
 
sub get_Taxonomy_Node{
127
 
   my ($self) = @_;
128
 
 
129
 
    $self->throw_not_implemented();
130
 
}
131
 
 
132
 
 
133
 
=head2 get_taxonid
134
 
 
135
 
 Title   : get_taxonid
136
 
 Usage   : my $taxonid = $db->get_taxonid('Homo sapiens');
137
 
 Function: Searches for a taxonid (typically ncbi_taxon_id) 
138
 
           based on a query string 
139
 
 Returns : Integer ID
140
 
 Args    : String representing species/node name 
141
 
 
142
 
 
143
 
=cut
144
 
 
145
 
*get_taxaid = \&get_taxonid;
146
 
 
147
 
sub get_taxonid {
148
 
   my ($self) = @_;
149
 
 
150
 
    $self->throw_not_implemented();
 
119
           -name    => string (to query by a taxonomy name: common name, 
 
120
                               scientific name, etc)
 
121
 
 
122
=cut
 
123
 
 
124
sub get_taxon {
 
125
    shift->throw_not_implemented();
 
126
}
 
127
 
 
128
*get_Taxonomy_Node = \&get_taxon;
 
129
 
 
130
=head2 get_taxonids
 
131
 
 
132
 Title   : get_taxonids
 
133
 Usage   : my @taxonids = $db->get_taxonids('Homo sapiens');
 
134
 Function: Searches for a taxonid (typically ncbi_taxon_id) based on a query
 
135
           string. Note that multiple taxonids can match to the same supplied
 
136
           name.
 
137
 Returns : array of integer ids in list context, one of these in scalar context
 
138
 Args    : string representing taxon's name
 
139
 
 
140
=cut
 
141
 
 
142
sub get_taxonids {
 
143
    shift->throw_not_implemented();
 
144
}
 
145
 
 
146
*get_taxonid = \&get_taxonids;
 
147
*get_taxaid = \&get_taxonids;
 
148
 
 
149
=head2 ancestor
 
150
 
 
151
 Title   : ancestor
 
152
 Usage   : my $ancestor_taxon = $db->ancestor($taxon)
 
153
 Function: Retrieve the full ancestor taxon of a supplied Taxon from the
 
154
           database. 
 
155
 Returns : Bio::Taxon
 
156
 Args    : Bio::Taxon (that was retrieved from this database)
 
157
 
 
158
=cut
 
159
 
 
160
sub ancestor {
 
161
    shift->throw_not_implemented();
 
162
}
 
163
 
 
164
=head2 each_Descendent
 
165
 
 
166
 Title   : each_Descendent
 
167
 Usage   : my @taxa = $db->each_Descendent($taxon);
 
168
 Function: Get all the descendents of the supplied Taxon (but not their
 
169
           descendents, ie. not a recursive fetchall).
 
170
 Returns : Array of Bio::Taxon objects
 
171
 Args    : Bio::Taxon (that was retrieved from this database)
 
172
 
 
173
=cut
 
174
 
 
175
sub each_Descendent {
 
176
    shift->throw_not_implemented();
 
177
}
 
178
 
 
179
=head2 get_all_Descendents
 
180
 
 
181
 Title   : get_all_Descendents
 
182
 Usage   : my @taxa = $db->get_all_Descendents($taxon);
 
183
 Function: Like each_Descendent(), but do a recursive fetchall
 
184
 Returns : Array of Bio::Taxon objects
 
185
 Args    : Bio::Taxon (that was retrieved from this database)
 
186
 
 
187
=cut
 
188
 
 
189
sub get_all_Descendents {
 
190
    my ($self, $taxon) = @_;
 
191
    my @taxa;
 
192
    foreach my $desc_taxon ($self->each_Descendent($taxon)) {
 
193
      push @taxa, ($desc_taxon, $self->get_all_Descendents($desc_taxon));
 
194
    }
 
195
    return @taxa;
151
196
}
152
197
 
153
198
=head2 _load_tax_module
155
200
 Title   : _load_tax_module
156
201
 Usage   : *INTERNAL Bio::DB::Taxonomy stuff*
157
202
 Function: Loads up (like use) a module at run time on demand
158
 
 Example :
159
 
 Returns :
160
 
 Args    :
161
203
 
162
204
=cut
163
205
 
181
223
    return $ok;
182
224
}
183
225
 
 
226
=head2 _handle_internal_id
 
227
 
 
228
 Title   : _handle_internal_id
 
229
 Usage   : *INTERNAL Bio::DB::Taxonomy stuff*
 
230
 Function: Tries to ensure that when a taxon is requested from any database,
 
231
           the Taxon object returned will have the same internal id regardless
 
232
           of database.
 
233
 Args    : Bio::Taxon, and optionally true value to try and do the job using
 
234
           scientific name & rank if your ids aren't comparable to other dbs.
 
235
 
 
236
=cut
 
237
 
 
238
sub _handle_internal_id {
 
239
    my ($self, $taxon, $try_name) = @_;
 
240
    $self->throw("Must supply a Bio::Taxon") unless ref($taxon) && $taxon->isa('Bio::Taxon');
 
241
    my $taxid = $taxon->id || return;
 
242
    my $sci_name = $taxon->scientific_name || '';
 
243
    my $rank = $taxon->rank || 'no rank';
 
244
    
 
245
    if ($try_name && $sci_name && defined $TAXON_IIDS->{names}->{$sci_name}) {
 
246
        if (defined $TAXON_IIDS->{names}->{$sci_name}->{$rank}) {
 
247
            $TAXON_IIDS->{taxids}->{$taxid} = $TAXON_IIDS->{names}->{$sci_name}->{$rank};
 
248
        }
 
249
        elsif ($rank eq 'no rank') {
 
250
            # pick the internal id of one named rank taxa at random
 
251
            my ($iid) = values %{$TAXON_IIDS->{names}->{$sci_name}};
 
252
            $TAXON_IIDS->{taxids}->{$taxid} = $iid;
 
253
        }
 
254
    }
 
255
    
 
256
    if (defined $TAXON_IIDS->{taxids}->{$taxid}) {
 
257
        # a little dangerous to use this internal method of Bio::Tree::Node;
 
258
        # but it is how internal_id() is set
 
259
        $taxon->_creation_id($TAXON_IIDS->{taxids}->{$taxid});
 
260
    }
 
261
    else {
 
262
        $TAXON_IIDS->{taxids}->{$taxid} = $taxon->internal_id;
 
263
        $TAXON_IIDS->{names}->{$sci_name}->{$rank} = $taxon->internal_id if $sci_name;
 
264
    }
 
265
}
 
266
 
184
267
1;