File Coverage

Bio/Ontology/Term.pm
Criterion Covered Total %
statement 154 216 71.3
branch 70 104 67.3
condition 3 22 13.6
subroutine 30 45 66.6
pod 33 36 91.6
total 290 423 68.5


line stmt bran cond sub pod time code
1             #
2             # BioPerl module for Bio::Ontology::Term
3             #
4             # Please direct questions and support issues to
5             #
6             # Cared for by Christian M. Zmasek or
7             #
8             # (c) Christian M. Zmasek, czmasek-at-burnham.org, 2002.
9             # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
10             #
11             # You may distribute this module under the same terms as perl itself.
12             # Refer to the Perl Artistic License (see the license accompanying this
13             # software package, or see http://www.perl.com/language/misc/Artistic.html)
14             # for the terms under which you may use, modify, and redistribute this module.
15             #
16             # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
17             # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
18             # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
19             #
20             # You may distribute this module under the same terms as perl itself
21              
22             # POD documentation - main docs before the code
23              
24             =head1 NAME
25              
26             Bio::Ontology::Term - implementation of the interface for ontology terms
27              
28             =head1 SYNOPSIS
29              
30             #get Bio::Ontology::TermI somehow.
31              
32             print $term->identifier(), "\n";
33             print $term->name(), "\n";
34             print $term->definition(), "\n";
35             print $term->is_obsolete(), "\n";
36             print $term->comment(), "\n";
37              
38             foreach my $synonym ( $term->each_synonym() ) {
39             print $synonym, "\n";
40             }
41              
42             =head1 DESCRIPTION
43              
44             This is a simple implementation for ontology terms providing basic
45             methods (it provides no functionality related to graphs). It
46             implements the L interface.
47              
48             This class also implements L and
49             L.
50              
51             =head1 FEEDBACK
52              
53             =head2 Mailing Lists
54              
55             User feedback is an integral part of the evolution of this and other
56             Bioperl modules. Send your comments and suggestions preferably to one
57             of the Bioperl mailing lists. Your participation is much appreciated.
58              
59             bioperl-l@bioperl.org - General discussion
60             http://bioperl.org/wiki/Mailing_lists - About the mailing lists
61              
62             =head2 Support
63              
64             Please direct usage questions or support issues to the mailing list:
65              
66             I
67              
68             rather than to the module maintainer directly. Many experienced and
69             reponsive experts will be able look at the problem and quickly
70             address it. Please include a thorough description of the problem
71             with code and data examples if at all possible.
72              
73             =head2 Reporting Bugs
74              
75             Report bugs to the Bioperl bug tracking system to help us keep track
76             the bugs and their resolution. Bug reports can be submitted via the web:
77              
78             https://github.com/bioperl/bioperl-live/issues
79              
80             =head1 AUTHOR
81              
82             Christian M. Zmasek
83              
84             Email: czmasek-at-burnham.org or cmzmasek@yahoo.com
85              
86             WWW: http://monochrome-effect.net/
87              
88             Address:
89              
90             Genomics Institute of the Novartis Research Foundation
91             10675 John Jay Hopkins Drive
92             San Diego, CA 92121
93              
94             =head1 APPENDIX
95              
96             The rest of the documentation details each of the object
97             methods.
98              
99             =cut
100              
101              
102             # Let the code begin...
103              
104             package Bio::Ontology::Term;
105 10     10   4369 use strict;
  10         13  
  10         256  
106 10     10   3356 use Bio::Ontology::Ontology;
  10         62  
  10         249  
107 10     10   2903 use Bio::Ontology::OntologyStore;
  10         17  
  10         225  
108 10     10   2221 use Bio::Annotation::DBLink;
  10         16  
  10         230  
109 10     10   42 use Data::Dumper;
  10         12  
  10         441  
110              
111 10     10   36 use constant TRUE => 1;
  10         12  
  10         589  
112 10     10   36 use constant FALSE => 0;
  10         13  
  10         373  
113              
114 10     10   30 use base qw(Bio::Root::Root Bio::Ontology::TermI Bio::IdentifiableI Bio::DescribableI);
  10         10  
  10         3423  
115              
116             =head2 new
117              
118             Title : new
119             Usage : $term = Bio::Ontology::Term->new(
120             -identifier => "16847",
121             -name => "1-aminocyclopropane-1-carboxylate synthase",
122             -definition => "Catalysis of ...",
123             -is_obsolete => 0,
124             -comment => "" );
125             Function: Creates a new Bio::Ontology::Term.
126             Returns : A new Bio::Ontology::Term object.
127             Args : -identifier => the identifier of this term [scalar]
128             -name => the name of this term [scalar]
129             -definition => the definition of this term [scalar]
130             -ontology => the ontology this term lives in
131             (a Bio::Ontology::OntologyI object)
132             -version => version information [scalar]
133             -is_obsolete => the obsoleteness of this term [0 or 1]
134             -comment => a comment [scalar]
135             -dblinks => Bio::Annotation::DBLink objects
136             [reference to array]
137             -references => Bio::Annotation::Reference objects
138             [reference to array]
139              
140             See L, L,
141             L.
142              
143             =cut
144              
145             sub new {
146              
147 2555     2555 1 2993 my( $class,@args ) = @_;
148              
149 2555         4449 my $self = $class->SUPER::new( @args );
150 2555         8457 my ( $identifier, $name, $definition, $category, $ont, $version,
151             $is_obsolete, $comment, $dblinks, $dbxrefs, $references)
152             = $self->_rearrange( [
153             qw(IDENTIFIER NAME DEFINITION CATEGORY ONTOLOGY VERSION IS_OBSOLETE
154             COMMENT DBLINKS DBXREFS REFERENCES) ], @args );
155              
156 2555         6732 $self->init();
157              
158 2555 100       3567 defined($identifier) && $self->identifier( $identifier );
159 2555 100       3186 defined($name) && $self->name( $name );
160 2555 100       2988 defined($definition) && $self->definition( $definition );
161 2555 50       2741 defined($category) && $self->category( $category );
162 2555 100       3352 defined($ont) && $self->ontology( $ont );
163 2555 100       2886 defined($version) && $self->version( $version );
164 2555 100       3015 defined($is_obsolete) && $self->is_obsolete( $is_obsolete );
165 2555 100       2765 defined($comment) && $self->comment( $comment );
166 2555 100       2892 defined($dbxrefs) && $self->add_dbxref(-dbxrefs => $dbxrefs);
167             # deprecated methods, allow to pass on to get the dep. notification
168 2555 50       3309 ref($dblinks) && $self->add_dblink(@$dblinks);
169 2555 100       2900 ref($references) && $self->add_reference(@$references);
170              
171 2555         4605 return $self;
172             } # new
173              
174              
175              
176             sub init {
177              
178 2557     2557 0 1964 my $self = shift;
179              
180 2557         3283 $self->identifier(undef);
181 2557         3536 $self->name(undef);
182 2557         3497 $self->comment(undef);
183 2557         3053 $self->definition(undef);
184 2557         3167 $self->ontology(undef);
185 2557         3166 $self->is_obsolete(0);
186 2557         3056 $self->remove_synonyms();
187 2557         3451 $self->remove_dbxrefs();
188 2557         3100 $self->remove_references;
189 2557         3511 $self->remove_secondary_ids();
190              
191             } # init
192              
193              
194              
195             =head2 identifier
196              
197             Title : identifier
198             Usage : $term->identifier( "GO:0003947" );
199             or
200             print $term->identifier();
201             Function: Set/get for the identifier of this Term.
202             Returns : The identifier [scalar].
203             Args : The identifier [scalar] (optional).
204              
205             =cut
206              
207             sub identifier {
208 15097     15097 1 14463 my $self = shift;
209              
210 15097 100       22989 return $self->{'identifier'} = shift if @_;
211 10038         14695 return $self->{'identifier'};
212             } # identifier
213              
214              
215             =head2 name
216              
217             Title : name
218             Usage : $term->name( "N-acetylgalactosaminyltransferase" );
219             or
220             print $term->name();
221             Function: Set/get for the name of this Term.
222             Returns : The name [scalar].
223             Args : The name [scalar] (optional).
224              
225             =cut
226              
227             sub name {
228 15756     15756 1 18378 my $self = shift;
229              
230 15756 100       21981 return $self->{'name'} = shift if @_;
231 11875         19678 return $self->{'name'};
232             } # name
233              
234              
235             =head2 definition
236              
237             Title : definition
238             Usage : $term->definition( "Catalysis of ..." );
239             or
240             print $term->definition();
241             Function: Set/get for the definition of this Term.
242             Returns : The definition [scalar].
243             Args : The definition [scalar] (optional).
244              
245             =cut
246              
247             sub definition {
248 3212     3212 1 2392 my $self = shift;
249              
250 3212 100       5373 return $self->{'definition'} = shift if @_;
251 62         99 return $self->{'definition'};
252             } # definition
253              
254              
255             =head2 ontology
256              
257             Title : ontology
258             Usage : $ont = $term->ontology();
259             or
260             $term->ontology( $ont );
261             Function: Get the ontology this term is in.
262              
263             Note that with the ontology in hand you can query for all
264             related terms etc.
265              
266             Returns : The ontology of this Term as a Bio::Ontology::OntologyI
267             implementing object.
268             Args : On set, the ontology of this Term as a Bio::Ontology::OntologyI
269             implementing object or a string representing its name.
270              
271             See L.
272              
273             =cut
274              
275             sub ontology {
276 7922     7922 1 5180 my $self = shift;
277 7922         5059 my $ont;
278              
279 7922 100       9349 if(@_) {
280 4267         3249 $ont = shift;
281 4267 100       6117 if($ont) {
282 1710 100       2624 $ont = Bio::Ontology::Ontology->new(-name => $ont) if ! ref($ont);
283 1710 50       4076 if(! $ont->isa("Bio::Ontology::OntologyI")) {
284 0         0 $self->throw(ref($ont)." does not implement ".
285             "Bio::Ontology::OntologyI. Bummer.");
286             }
287             }
288 4267         5806 return $self->{"_ontology"} = $ont;
289             }
290 3655         6623 return $self->{"_ontology"};
291             } # ontology
292              
293             =head2 version
294              
295             Title : version
296             Usage : $term->version( "1.00" );
297             or
298             print $term->version();
299             Function: Set/get for version information.
300             Returns : The version [scalar].
301             Args : The version [scalar] (optional).
302              
303             =cut
304              
305             sub version {
306 9     9 1 13 my $self = shift;
307              
308 9 100       25 return $self->{'version'} = shift if @_;
309 5         17 return $self->{'version'};
310             } # version
311              
312             =head2 is_obsolete
313              
314             Title : is_obsolete
315             Usage : $term->is_obsolete( 1 );
316             or
317             if ( $term->is_obsolete() )
318             Function: Set/get for the obsoleteness of this Term.
319             Returns : the obsoleteness [0 or 1].
320             Args : the obsoleteness [0 or 1] (optional).
321              
322             =cut
323              
324             sub is_obsolete{
325 2648     2648 1 2187 my $self = shift;
326              
327 2648 100       4889 return $self->{'is_obsolete'} = shift if @_;
328 67         132 return $self->{'is_obsolete'};
329             } # is_obsolete
330              
331              
332             =head2 comment
333              
334             Title : comment
335             Usage : $term->comment( "Consider the term ..." );
336             or
337             print $term->comment();
338             Function: Set/get for an arbitrary comment about this Term.
339             Returns : A comment.
340             Args : A comment (optional).
341              
342             =cut
343              
344             sub comment{
345 2672     2672 1 1905 my $self = shift;
346              
347 2672 100       4259 return $self->{'comment'} = shift if @_;
348 57         88 return $self->{'comment'};
349             } # comment
350              
351             =head2 get_synonyms
352              
353             Title : get_synonyms
354             Usage : @aliases = $term->get_synonyms;
355             Function: Returns a list of aliases of this Term.
356             Returns : A list of aliases [array of [scalar]].
357             Args :
358              
359             =cut
360              
361             sub get_synonyms {
362 4589     4589 1 4469 my $self = shift;
363              
364 4589 100       6356 return @{ $self->{ "_synonyms" } } if exists($self->{ "_synonyms" });
  2034         3136  
365 2555         3024 return ();
366             } # get_synonyms
367              
368              
369             =head2 add_synonym
370              
371             Title : add_synonym
372             Usage : $term->add_synonym( @asynonyms );
373             or
374             $term->add_synonym( $synonym );
375             Function: Pushes one or more synonyms into the list of synonyms.
376             Returns :
377             Args : One synonym [scalar] or a list of synonyms [array of [scalar]].
378              
379             =cut
380              
381             sub add_synonym {
382 519     519 1 556 my ( $self, @values ) = @_;
383              
384 519 100       780 return unless( @values );
385              
386             # avoid duplicates
387 326         442 foreach my $syn (@values) {
388 339 100       218 next if grep { $_ eq $syn; } @{$self->{ "_synonyms" }};
  94         202  
  339         657  
389 337         259 push( @{ $self->{ "_synonyms" } }, $syn );
  337         1149  
390             }
391              
392             } # add_synonym
393              
394              
395             =head2 remove_synonyms
396              
397             Title : remove_synonyms()
398             Usage : $term->remove_synonyms();
399             Function: Deletes (and returns) the synonyms of this Term.
400             Returns : A list of synonyms [array of [scalar]].
401             Args :
402              
403             =cut
404              
405             sub remove_synonyms {
406 2561     2561 1 4290 my ( $self ) = @_;
407              
408 2561         3233 my @a = $self->get_synonyms();
409 2561         5242 $self->{ "_synonyms" } = [];
410 2561         3275 return @a;
411              
412             } # remove_synonyms
413              
414             =head2 get_dblinks
415              
416             Title : get_dblinks()
417             Usage : @ds = $term->get_dblinks();
418             Function: Returns a list of each dblinks of this GO term.
419             Returns : A list of dblinks [array of [scalars]].
420             Args : A scalar indicating the context (optional).
421             If omitted, all dblinks will be returned.
422             Note : deprecated method due to past use of mixed data types; use
423             get_dbxrefs() instead, which handles both strings and DBLink
424             instances
425              
426             =cut
427              
428             sub get_dblinks {
429 0     0 1 0 my ($self, $context) = @_;
430 0         0 $self->deprecated("Use of get_dblinks is deprecated. Note that prior use\n".
431             "of this method could return either simple scalar values\n".
432             "or Bio::Annotation::DBLink instances; only \n".
433             "Bio::Annotation::DBLink is now supported.\n ".
434             "Use get_dbxrefs() instead");
435 0         0 $self->get_dbxrefs($context);
436             } # get_dblinks
437              
438             =head2 get_dbxrefs
439              
440             Title : get_dbxrefs()
441             Usage : @ds = $term->get_dbxrefs();
442             Function: Returns a list of each link for this term.
443              
444             If an implementor of this interface permits modification of
445             this array property, the class should define at least
446             methods add_dbxref() and remove_dbxrefs(), with obvious
447             functionality.
448              
449             Returns : A list of L instances
450             Args : [optional] string which specifies context (default : returns all dbxrefs)
451              
452             =cut
453              
454             sub get_dbxrefs {
455 2568     2568 1 2049 my ($self, $context) = shift;
456 2568         1755 my @dbxrefs;
457 2568 50       3323 if (defined($context)) {
458 0 0       0 if (exists($self->{_dblinks}->{$context})) {
459 0         0 @dbxrefs = @{$self->{_dblinks}->{$context}};
  0         0  
460             }
461             } else {
462 2568         1809 @dbxrefs = map { @$_ } values %{$self->{_dblinks}} ;
  8         21  
  2568         5648  
463             }
464 2568         2811 return @dbxrefs;
465             } # get_dbxrefs
466              
467             =head2 get_dblink_context
468              
469             Title : get_dblink_context
470             Usage : @context = $term->get_dblink_context;
471             Function: Return all context existing in Term
472             Returns : a list of scalar
473             Args : [none]
474             Note : deprecated method due to past use of mixed data types; use
475             get_dbxref_context() instead
476              
477             =cut
478              
479             sub get_dblink_context {
480 0     0 1 0 my $self=shift;
481 0         0 $self->deprecated("Use of get_dblink_context() is deprecated; use get_dbxref_context() instead");
482 0         0 return $self->get_dbxref_context(@_);
483             }
484              
485             =head2 get_dbxref_context
486              
487             Title : get_dbxref_context
488             Usage : @context = $term->get_dbxref_context;
489             Function: Return all context strings existing in Term
490             Returns : a list of scalars
491             Args : [none]
492              
493             =cut
494              
495             sub get_dbxref_context {
496 0     0 1 0 my $self=shift;
497 0         0 return keys %{$self->{_dblinks}};
  0         0  
498             }
499              
500             =head2 add_dblink
501              
502             Title : add_dblink
503             Usage : $term->add_dblink( @dbls );
504             or
505             $term->add_dblink( $dbl );
506             Function: Pushes one or more dblinks onto the list of dblinks.
507             Returns :
508             Args : One or more L instances
509             Note : deprecated method due to past use of mixed data types; use
510             add_dbxref() instead, which handles both strings and
511             DBLink instances
512              
513             =cut
514              
515             sub add_dblink {
516 0     0 1 0 my $self = shift;
517 0         0 $self->deprecated("Use of simple strings and add_dblink() is deprecated; use\n".
518             "Bio::Annotation::DBLink instances and add_dbxref() instead");
519             # here we're assuming the data is in a simple DB:ID format
520 0         0 my @dbxrefs;
521 0         0 for my $string (@_) {
522 0         0 my ($db, $id) = split(':',$string);
523 0         0 push @dbxrefs, Bio::Annotation::DBLink->new(-database => $db, -primary_id => $id);
524             }
525 0         0 return $self->add_dbxref(-dbxrefs => \@dbxrefs, -context => '_default');
526             } # add_dblink
527              
528             =head2 add_dbxref
529              
530             Title : add_dbxref
531             Usage : $term->add_dbxref( @dbls );
532             or
533             $term->add_dbxref( $dbl );
534             Function: Pushes one or more dblinks onto the list of dblinks.
535             Returns :
536             Args : -dbxrefs : array ref of Bio::Annotation::DBLink instances
537             -context : string designating the context for the DBLink
538             (default : '_default' - contextless)
539              
540             =cut
541              
542             sub add_dbxref {
543 809     809 1 571 my $self = shift;
544 809         1730 my ($links, $context) = $self->_rearrange([qw(DBXREFS CONTEXT)],@_);
545 809 50       1532 return unless defined $links;
546 809   50     1872 $context ||= '_default';
547 809 50       1549 $self->throw("DBLinks must be passed as an array reference") if ref $links ne 'ARRAY';
548 809         599 foreach my $dbxref (@{$links}) {
  809         1382  
549 503 50 33     2126 $self->throw("$dbxref is not a DBLink") unless ref $dbxref &&
550             $dbxref->isa('Bio::Annotation::DBLink');
551 503 50       634 $self->throw("'all' is a reserved word for context.") if $context eq 'all';
552 503 100       870 if (! exists($self->{_dblinks}->{$context})) {
553 494         857 $self->{_dblinks}->{$context} = [];
554             }
555 503 50       1216 my $linktext = ref $dbxref ? $dbxref->display_text : $dbxref;
556 503 50       542 if (grep {$_->display_text eq $linktext}
  9         16  
557 503         1105 @{$self->{_dblinks}->{$context}})
558             {
559 0         0 $self->warn("DBLink exists in the dblink of $context");
560             }
561 503         474 push @{$self->{_dblinks}->{$context}}, $dbxref;
  503         2520  
562             }
563             } # add_dbxref
564              
565             # alias, for consistency
566             *add_dbxrefs = \&add_dbxref;
567              
568             =head2 has_dblink
569              
570             Title : has_dblink
571             Usage : $term->has_dblink($dblink);
572             Function: Checks if a DBXref is already existing in the OBOterm object
573             Return : TRUE/FALSE
574             Args : [arg1] A DBxref identifier
575             Note : deprecated method due to past use of mixed data types; use
576             has_dbxref() instead, which handles both strings and
577             DBLink instances
578              
579             =cut
580              
581             sub has_dblink {
582 0     0 1 0 my ( $self, $value ) = @_;
583 0         0 $self->deprecated("use of has_dblink() is deprecated; use has_dbxref() instead");
584 0         0 return $self->has_dbxref($value);
585             }
586              
587             =head2 has_dbxref
588              
589             Title : has_dbxref
590             Usage : $term->has_dbxref($dbxref);
591             Function: Checks if a dbxref string is already existing in the OBOterm object
592             Return : TRUE/FALSE
593             Args : [arg1] A DBxref identifier (string).
594             Bio::Annotation::DBLink::display_text() is used for comparison
595             against the string.
596              
597             =cut
598              
599             sub has_dbxref {
600 0     0 1 0 my ( $self, $value ) = @_;
601 0 0       0 return unless defined $value;
602 0         0 my $context = "_default";
603 0 0       0 $self->throw("'all' is a reserved word for context.") if $context eq 'all';
604 0   0     0 $context ||= '_default';
605 0 0 0     0 if ( ( $self->{_dblinks}->{$context} ) &&
606 0         0 grep { $_->display_text eq $value }
607 0         0 @{ $self->{_dblinks}->{$context} } )
608             {
609 0         0 return TRUE;
610             }
611             else {
612 0         0 return FALSE;
613             }
614             }
615              
616             =head2 add_dblink_context
617              
618             Title : add_dblink_context
619             Usage : $term->add_dblink_context($db, $context);
620             Function: add a dblink with its context
621             Return : [none]
622             Args : [arg1] a Bio::Annotation::DBLink instance
623             [arg2] a string for context; if omitted, the
624             default/context-less one will be used.
625             Note : deprecated method due to past use of mixed data types; use
626             add_dbxref() instead
627              
628             =cut
629              
630             sub add_dblink_context {
631 0     0 1 0 my ($self, $value, $context) = @_;
632 0         0 $self->deprecated("Use of simple strings and add_dblink_context() is deprecated; use\n
633             Bio::Annotation::DBLink instances and add_dbxref() instead");
634 0         0 return $self->add_dbxref([$value],$context);
635             }
636              
637             =head2 remove_dblinks
638              
639             Title : remove_dblinks()
640             Usage : $term->remove_dblinks();
641             Function: Deletes (and returns) the definition references of this GO term.
642             Returns : A list of definition references [array of [scalars]].
643             Args : Context. If omitted or equal to 'all', all dblinks
644             will be removed.
645             Note : deprecated method due to past use of mixed data types; use
646             remove_dblinks() instead, which handles both strings and
647             DBLink instances
648              
649             =cut
650              
651             sub remove_dblinks {
652 0     0 1 0 my ($self, $context) = @_;
653 0         0 $self->deprecated("use of remove_dblinks() is deprecated; use remove_dbxrefs() instead");
654 0         0 return $self->remove_dbxrefs(@_);
655             } # remove_dblinks
656              
657             =head2 remove_dbxrefs
658              
659             Title : remove_dbxrefs()
660             Usage : $term->remove_dbxrefs();
661             Function: Deletes (and returns) the definition references of this GO term.
662             Returns : A list of definition references [array of [scalars]].
663             Args : Context. If omitted or equal to 'all', all dblinks
664             will be removed.
665              
666             =cut
667              
668             sub remove_dbxrefs {
669 2559     2559 1 2057 my ($self, $context) = @_;
670 2559 50 33     3907 $context = undef if $context && ($context eq "all");
671 2559         3206 my @old = $self->get_dbxrefs($context);
672 2559 50       2847 if (defined($context)) {
673 0         0 $self->{_dblinks}->{$context}=[];
674             } else {
675 2559         2855 $self->{_dblinks} = {};
676             }
677 2559         3375 return @old;
678             } # remove_dbxrefs
679              
680             =head2 get_references
681              
682             Title : get_references
683             Usage : @references = $self->get_references
684             Fuctnion: Returns a list of references
685             Return : A list of objects
686             Args : [none]
687              
688             =cut
689              
690             sub get_references {
691 2558     2558 1 1930 my $self=shift;
692 2558 100       3385 return @{$self->{_references}} if exists $self->{_references};
  3         7  
693 2555         2375 return ();
694             }
695              
696             =head2 add_reference
697              
698             Title : add_reference
699             Usage : $self->add_reference($reference);
700             $self->add_reference($reference1, $reference2);
701             Fuctnion: Add one or more references
702             Returns : [none]
703              
704             =cut
705              
706             sub add_reference {
707 1     1 1 2 my ($self, @values) =@_;
708 1 50       2 return unless @values;
709             # avoid duplicates and undefs
710 0         0 foreach my $reference (@values){
711 0 0 0     0 $self->throw("Passed data not an Bio::Annotation::Reference") unless ref $reference &&
712             $reference->isa('Bio::AnnotationI');
713 0 0       0 next unless defined $reference;
714 0 0       0 next if grep{$_ eq $reference} @{$self->{_references}};
  0         0  
  0         0  
715 0         0 push @{$self->{_references}}, $reference;
  0         0  
716             }
717             }
718              
719             =head2 remove_references
720              
721             Title : remove_references
722             Usage : $self->remove_references;
723             Function: Deletes (and returns) all references
724             Returns : A list of references
725             Args : [none]
726              
727             =cut
728              
729             sub remove_references {
730 2557     2557 1 1886 my $self=shift;
731 2557         2847 my @references=$self->get_references;
732 2557         3036 $self->{_references}=[];
733 2557         2219 return @references;
734             }
735              
736             =head2 get_secondary_ids
737              
738             Title : get_secondary_ids
739             Usage : @ids = $term->get_secondary_ids();
740             Function: Returns a list of secondary identifiers of this Term.
741              
742             Secondary identifiers mostly originate from merging terms,
743             or possibly also from splitting terms.
744              
745             Returns : A list of secondary identifiers [array of [scalar]]
746             Args :
747              
748             =cut
749              
750             sub get_secondary_ids {
751 2567     2567 1 1903 my $self = shift;
752              
753 2567 100       3604 return @{$self->{"_secondary_ids"}} if exists($self->{"_secondary_ids"});
  12         34  
754 2555         2188 return ();
755             } # get_secondary_ids
756              
757              
758             =head2 add_secondary_id
759              
760             Title : add_secondary_id
761             Usage : $term->add_secondary_id( @ids );
762             or
763             $term->add_secondary_id( $id );
764             Function: Adds one or more secondary identifiers to this term.
765             Returns :
766             Args : One or more secondary identifiers [scalars]
767              
768             =cut
769              
770             sub add_secondary_id {
771 231     231 1 192 my $self = shift;
772              
773 231 100       411 return unless @_;
774              
775             # avoid duplicates
776 10         15 foreach my $id (@_) {
777 12 50       14 next if grep { !$_ or $_ eq $id; } @{$self->{ "_secondary_ids" }};
  8 100       34  
  12         28  
778 11         9 push( @{ $self->{ "_secondary_ids" } }, $id );
  11         36  
779             }
780              
781             } # add_secondary_id
782              
783              
784             =head2 remove_secondary_ids
785              
786             Title : remove_secondary_ids
787             Usage : $term->remove_secondary_ids();
788             Function: Deletes (and returns) the secondary identifiers of this Term.
789             Returns : The previous list of secondary identifiers [array of [scalars]]
790             Args :
791              
792             =cut
793              
794             sub remove_secondary_ids {
795 2559     2559 1 2049 my $self = shift;
796              
797 2559         3125 my @a = $self->get_secondary_ids();
798 2559         2707 $self->{ "_secondary_ids" } = [];
799 2559         2312 return @a;
800              
801             } # remove_secondary_ids
802              
803              
804             # Title :_is_true_or_false
805             # Function: Checks whether the argument is TRUE or FALSE.
806             # Returns :
807             # Args : The value to be checked.
808             sub _is_true_or_false {
809 0     0   0 my ( $self, $value ) = @_;
810 0 0 0     0 unless ( $value !~ /\D/ && ( $value == TRUE || $value == FALSE ) ) {
      0        
811 0         0 $self->throw( "Found [" . $value
812             . "] where " . TRUE . " or " . FALSE . " expected" );
813             }
814             } # _is_true_or_false
815              
816             =head1 Methods implementing L and L
817              
818             =cut
819              
820             =head2 object_id
821              
822             Title : object_id
823             Usage : $string = $obj->object_id()
824             Function: a string which represents the stable primary identifier
825             in this namespace of this object.
826              
827             This is a synonym for identifier().
828              
829             Returns : A scalar
830              
831             =cut
832              
833             sub object_id {
834 0     0 1 0 return shift->identifier(@_);
835             }
836              
837             =head2 authority
838              
839             Title : authority
840             Usage : $authority = $obj->authority()
841             Function: a string which represents the organisation which
842             granted the namespace, written as the DNS name for
843             organisation (eg, wormbase.org)
844              
845             This forwards to ontology()->authority(). Note that you
846             cannot set the authority before having set the ontology or
847             the namespace (which will set the ontology).
848              
849             Returns : A scalar
850             Args : on set, the new value (a scalar)
851              
852             =cut
853              
854             sub authority {
855 0     0 1 0 my $self = shift;
856 0         0 my $ont = $self->ontology();
857              
858 0 0       0 return $ont->authority(@_) if $ont;
859 0 0       0 $self->throw("cannot manipulate authority prior to ".
860             "setting the namespace or ontology") if @_;
861 0         0 return;
862             }
863              
864              
865             =head2 namespace
866              
867             Title : namespace
868             Usage : $string = $obj->namespace()
869             Function: A string representing the name space this identifier
870             is valid in, often the database name or the name
871             describing the collection.
872              
873             This forwards to ontology() (set mode) and
874             ontology()->name() (get mode). I.e., setting the namespace
875             will set the ontology to one matching that name in the
876             ontology store, or to one newly created.
877              
878             Returns : A scalar
879             Args : on set, the new value (a scalar)
880              
881             =cut
882              
883             sub namespace {
884 1901     1901 1 1609 my $self = shift;
885              
886 1901 100       2330 $self->ontology(@_) if(@_);
887 1901         1979 my $ont = $self->ontology();
888 1901 100       4402 return defined($ont) ? $ont->name() : undef;
889             }
890              
891             =head2 display_name
892              
893             Title : display_name
894             Usage : $string = $obj->display_name()
895             Function: A string which is what should be displayed to the user.
896              
897             The definition in Bio::DescribableI states that the
898             string should not contain spaces. As this is not very
899             sensible for ontology terms, we relax this here. The
900             implementation just forwards to name().
901              
902             Returns : A scalar
903             Args : on set, the new value (a scalar)
904              
905             =cut
906              
907             sub display_name {
908 0     0 1   return shift->name(@_);
909             }
910              
911              
912             =head2 description
913              
914             Title : description
915             Usage : $string = $obj->description()
916             Function: A text string suitable for displaying to the user a
917             description. This string is likely to have spaces, but
918             should not have any newlines or formatting - just plain
919             text.
920              
921             This forwards to definition(). The caveat is that the text
922             will often be longer for ontology term definitions than the
923             255 characters stated in the definition in
924             Bio::DescribableI.
925              
926             Returns : A scalar
927             Args : on set, the new value (a scalar)
928              
929             =cut
930              
931             sub description {
932 0     0 1   return shift->definition(@_);
933             }
934              
935             #################################################################
936             # aliases or forwards to maintain backward compatibility
937             #################################################################
938              
939             =head1 Deprecated methods
940              
941             Used for looking up the methods that supercedes them.
942              
943             =cut
944              
945 0     0 0   sub each_dblink {shift->throw("use of each_dblink() is deprecated; use get_dbxrefs() instead")}
946 0     0 0   sub add_dblinks {shift->throw("use of add_dblinks() is deprecated; use add_dbxref() instead")}
947             *each_synonym = \&get_synonyms;
948             *add_synonyms = \&add_synonym;
949              
950             1;