|
0
|
1 # $Id: Species.pm,v 1.24 2002/12/05 13:46:30 heikki Exp $
|
|
|
2 #
|
|
|
3 # BioPerl module for Bio::Species
|
|
|
4 #
|
|
|
5 # Cared for by James Gilbert <jgrg@sanger.ac.uk>
|
|
|
6 #
|
|
|
7 # You may distribute this module under the same terms as perl itself
|
|
|
8
|
|
|
9 # POD documentation - main docs before the code
|
|
|
10
|
|
|
11 =head1 NAME
|
|
|
12
|
|
|
13 Bio::Species - Generic species object
|
|
|
14
|
|
|
15 =head1 SYNOPSIS
|
|
|
16
|
|
|
17 $species = Bio::Species->new(-classification => [@classification]);
|
|
|
18 # Can also pass classification
|
|
|
19 # array to new as below
|
|
|
20
|
|
|
21 $species->classification(qw( sapiens Homo Hominidae
|
|
|
22 Catarrhini Primates Eutheria
|
|
|
23 Mammalia Vertebrata Chordata
|
|
|
24 Metazoa Eukaryota ));
|
|
|
25
|
|
|
26 $genus = $species->genus();
|
|
|
27
|
|
|
28 $bi = $species->binomial(); # $bi is now "Homo sapiens"
|
|
|
29
|
|
|
30 # For storing common name
|
|
|
31 $species->common_name("human");
|
|
|
32
|
|
|
33 # For storing subspecies
|
|
|
34 $species->sub_species("accountant");
|
|
|
35
|
|
|
36 =head1 DESCRIPTION
|
|
|
37
|
|
|
38 Provides a very simple object for storing phylogenetic
|
|
|
39 information. The classification is stored in an array,
|
|
|
40 which is a list of nodes in a phylogenetic tree. Access to
|
|
|
41 getting and setting species and genus is provided, but not
|
|
|
42 to any of the other node types (eg: "phylum", "class",
|
|
|
43 "order", "family"). There's plenty of scope for making the
|
|
|
44 model more sophisticated, if this is ever needed.
|
|
|
45
|
|
|
46 A methods are also provided for storing common
|
|
|
47 names, and subspecies.
|
|
|
48
|
|
|
49 =head1 CONTACT
|
|
|
50
|
|
|
51 James Gilbert email B<jgrg@sanger.ac.uk>
|
|
|
52
|
|
|
53 =head1 APPENDIX
|
|
|
54
|
|
|
55 The rest of the documentation details each of the object
|
|
|
56 methods. Internal methods are usually preceded with a _
|
|
|
57
|
|
|
58 =cut
|
|
|
59
|
|
|
60
|
|
|
61 #' Let the code begin...
|
|
|
62
|
|
|
63
|
|
|
64 package Bio::Species;
|
|
|
65 use vars qw(@ISA);
|
|
|
66 use strict;
|
|
|
67
|
|
|
68 # Object preamble - inherits from Bio::Root::Object
|
|
|
69
|
|
|
70 use Bio::Root::Root;
|
|
|
71
|
|
|
72
|
|
|
73 @ISA = qw(Bio::Root::Root);
|
|
|
74
|
|
|
75 sub new {
|
|
|
76 my($class,@args) = @_;
|
|
|
77
|
|
|
78 my $self = $class->SUPER::new(@args);
|
|
|
79
|
|
|
80 $self->{'classification'} = [];
|
|
|
81 $self->{'common_name'} = undef;
|
|
|
82 my ($classification) = $self->_rearrange([qw(CLASSIFICATION)], @args);
|
|
|
83 if( defined $classification &&
|
|
|
84 (ref($classification) eq "ARRAY") ) {
|
|
|
85 $self->classification(@$classification);
|
|
|
86 }
|
|
|
87 return $self;
|
|
|
88 }
|
|
|
89
|
|
|
90 =head2 classification
|
|
|
91
|
|
|
92 Title : classification
|
|
|
93 Usage : $self->classification(@class_array);
|
|
|
94 @classification = $self->classification();
|
|
|
95 Function: Fills or returns the classification list in
|
|
|
96 the object. The array provided must be in
|
|
|
97 the order SPECIES, GENUS ---> KINGDOM.
|
|
|
98 Checks are made that species is in lower case,
|
|
|
99 and all other elements are in title case.
|
|
|
100 Example : $obj->classification(qw( sapiens Homo Hominidae
|
|
|
101 Catarrhini Primates Eutheria Mammalia Vertebrata
|
|
|
102 Chordata Metazoa Eukaryota));
|
|
|
103 Returns : Classification array
|
|
|
104 Args : Classification array
|
|
|
105 OR
|
|
|
106 A reference to the classification array. In the latter case
|
|
|
107 if there is a second argument and it evaluates to true,
|
|
|
108 names will not be validated.
|
|
|
109
|
|
|
110
|
|
|
111 =cut
|
|
|
112
|
|
|
113
|
|
|
114 sub classification {
|
|
|
115 my ($self,@args) = @_;
|
|
|
116
|
|
|
117 if (@args) {
|
|
|
118
|
|
|
119 my ($classif,$force);
|
|
|
120 if(ref($args[0])) {
|
|
|
121 $classif = shift(@args);
|
|
|
122 $force = shift(@args);
|
|
|
123 } else {
|
|
|
124 $classif = \@args;
|
|
|
125 }
|
|
|
126
|
|
|
127 # Check the names supplied in the classification string
|
|
|
128 # Species should be in lower case
|
|
|
129 if(! $force) {
|
|
|
130 $self->validate_species_name($classif->[0]);
|
|
|
131 # All other names must be in title case
|
|
|
132 foreach (@$classif) {
|
|
|
133 $self->validate_name( $_ );
|
|
|
134 }
|
|
|
135 }
|
|
|
136 # Store classification
|
|
|
137 $self->{'classification'} = $classif;
|
|
|
138 }
|
|
|
139 return @{$self->{'classification'}};
|
|
|
140 }
|
|
|
141
|
|
|
142 =head2 common_name
|
|
|
143
|
|
|
144 Title : common_name
|
|
|
145 Usage : $self->common_name( $common_name );
|
|
|
146 $common_name = $self->common_name();
|
|
|
147 Function: Get or set the common name of the species
|
|
|
148 Example : $self->common_name('human')
|
|
|
149 Returns : The common name in a string
|
|
|
150 Args : String, which is the common name (optional)
|
|
|
151
|
|
|
152 =cut
|
|
|
153
|
|
|
154 sub common_name{
|
|
|
155 my $self = shift;
|
|
|
156
|
|
|
157 return $self->{'common_name'} = shift if @_;
|
|
|
158 return $self->{'common_name'};
|
|
|
159 }
|
|
|
160
|
|
|
161 =head2 variant
|
|
|
162
|
|
|
163 Title : variant
|
|
|
164 Usage : $obj->variant($newval)
|
|
|
165 Function: Get/set variant information for this species object (strain,
|
|
|
166 isolate, etc).
|
|
|
167 Example :
|
|
|
168 Returns : value of variant (a scalar)
|
|
|
169 Args : new value (a scalar or undef, optional)
|
|
|
170
|
|
|
171
|
|
|
172 =cut
|
|
|
173
|
|
|
174 sub variant{
|
|
|
175 my $self = shift;
|
|
|
176
|
|
|
177 return $self->{'variant'} = shift if @_;
|
|
|
178 return $self->{'variant'};
|
|
|
179 }
|
|
|
180
|
|
|
181 =head2 organelle
|
|
|
182
|
|
|
183 Title : organelle
|
|
|
184 Usage : $self->organelle( $organelle );
|
|
|
185 $organelle = $self->organelle();
|
|
|
186 Function: Get or set the organelle name
|
|
|
187 Example : $self->organelle('Chloroplast')
|
|
|
188 Returns : The organelle name in a string
|
|
|
189 Args : String, which is the organelle name
|
|
|
190
|
|
|
191 =cut
|
|
|
192
|
|
|
193 sub organelle {
|
|
|
194 my($self, $name) = @_;
|
|
|
195
|
|
|
196 if ($name) {
|
|
|
197 $self->{'organelle'} = $name;
|
|
|
198 } else {
|
|
|
199 return $self->{'organelle'}
|
|
|
200 }
|
|
|
201 }
|
|
|
202
|
|
|
203 =head2 species
|
|
|
204
|
|
|
205 Title : species
|
|
|
206 Usage : $self->species( $species );
|
|
|
207 $species = $self->species();
|
|
|
208 Function: Get or set the scientific species name. The species
|
|
|
209 name must be in lower case.
|
|
|
210 Example : $self->species( 'sapiens' );
|
|
|
211 Returns : Scientific species name as string
|
|
|
212 Args : Scientific species name as string
|
|
|
213
|
|
|
214 =cut
|
|
|
215
|
|
|
216
|
|
|
217 sub species {
|
|
|
218 my($self, $species) = @_;
|
|
|
219
|
|
|
220 if ($species) {
|
|
|
221 $self->validate_species_name( $species );
|
|
|
222 $self->{'classification'}[0] = $species;
|
|
|
223 }
|
|
|
224 return $self->{'classification'}[0];
|
|
|
225 }
|
|
|
226
|
|
|
227 =head2 genus
|
|
|
228
|
|
|
229 Title : genus
|
|
|
230 Usage : $self->genus( $genus );
|
|
|
231 $genus = $self->genus();
|
|
|
232 Function: Get or set the scientific genus name. The genus
|
|
|
233 must be in title case.
|
|
|
234 Example : $self->genus( 'Homo' );
|
|
|
235 Returns : Scientific genus name as string
|
|
|
236 Args : Scientific genus name as string
|
|
|
237
|
|
|
238 =cut
|
|
|
239
|
|
|
240
|
|
|
241 sub genus {
|
|
|
242 my($self, $genus) = @_;
|
|
|
243
|
|
|
244 if ($genus) {
|
|
|
245 $self->validate_name( $genus );
|
|
|
246 $self->{'classification'}[1] = $genus;
|
|
|
247 }
|
|
|
248 return $self->{'classification'}[1];
|
|
|
249 }
|
|
|
250
|
|
|
251 =head2 sub_species
|
|
|
252
|
|
|
253 Title : sub_species
|
|
|
254 Usage : $obj->sub_species($newval)
|
|
|
255 Function:
|
|
|
256 Returns : value of sub_species
|
|
|
257 Args : newvalue (optional)
|
|
|
258
|
|
|
259
|
|
|
260 =cut
|
|
|
261
|
|
|
262 sub sub_species {
|
|
|
263 my( $self, $sub ) = @_;
|
|
|
264
|
|
|
265 if ($sub) {
|
|
|
266 $self->{'_sub_species'} = $sub;
|
|
|
267 }
|
|
|
268 return $self->{'_sub_species'};
|
|
|
269 }
|
|
|
270
|
|
|
271 =head2 binomial
|
|
|
272
|
|
|
273 Title : binomial
|
|
|
274 Usage : $binomial = $self->binomial();
|
|
|
275 $binomial = $self->binomial('FULL');
|
|
|
276 Function: Returns a string "Genus species", or "Genus species subspecies",
|
|
|
277 the first argument is 'FULL' (and the species has a subspecies).
|
|
|
278 Args : Optionally the string 'FULL' to get the full name including
|
|
|
279 the subspecies.
|
|
|
280
|
|
|
281 =cut
|
|
|
282
|
|
|
283
|
|
|
284 sub binomial {
|
|
|
285 my( $self, $full ) = @_;
|
|
|
286
|
|
|
287 my( $species, $genus ) = $self->classification();
|
|
|
288 unless( defined $species) {
|
|
|
289 $species = 'sp.';
|
|
|
290 $self->warn("classification was not set");
|
|
|
291 }
|
|
|
292 $genus = '' unless( defined $genus);
|
|
|
293 my $bi = "$genus $species";
|
|
|
294 if (defined($full) && ((uc $full) eq 'FULL')) {
|
|
|
295 my $ssp = $self->sub_species;
|
|
|
296 $bi .= " $ssp" if $ssp;
|
|
|
297 }
|
|
|
298 return $bi;
|
|
|
299 }
|
|
|
300
|
|
|
301 sub validate_species_name {
|
|
|
302 my( $self, $string ) = @_;
|
|
|
303
|
|
|
304 return 1 if $string eq "sp.";
|
|
|
305 return 1 if $string =~ /^[a-z][\w\s]+$/i;
|
|
|
306 $self->throw("Invalid species name '$string'");
|
|
|
307 }
|
|
|
308
|
|
|
309 sub validate_name {
|
|
|
310 return 1; # checking is disabled as there is really not much we can
|
|
|
311 # enforce HL 2002/10/03
|
|
|
312 # my( $self, $string ) = @_;
|
|
|
313
|
|
|
314 # return 1 if $string =~ /^[\w\s\-\,\.]+$/ or
|
|
|
315 # $self->throw("Invalid name '$string'");
|
|
|
316 }
|
|
|
317
|
|
|
318 =head2 ncbi_taxid
|
|
|
319
|
|
|
320 Title : ncbi_taxid
|
|
|
321 Usage : $obj->ncbi_taxid($newval)
|
|
|
322 Function: Get/set the NCBI Taxon ID
|
|
|
323 Returns : the NCBI Taxon ID as a string
|
|
|
324 Args : newvalue to set or undef to unset (optional)
|
|
|
325
|
|
|
326
|
|
|
327 =cut
|
|
|
328
|
|
|
329 sub ncbi_taxid {
|
|
|
330 my $self = shift;
|
|
|
331
|
|
|
332 return $self->{'_ncbi_taxid'} = shift if @_;
|
|
|
333 return $self->{'_ncbi_taxid'};
|
|
|
334 }
|
|
|
335
|
|
|
336 1;
|
|
|
337
|
|
|
338 __END__
|
