maint: restructure to use Dist::Zilla
[bioperl-live.git] / lib / Bio / Ontology / InterProTerm.pm
blob20e98fe265bdbf23d3863e5d76ea6d70b4975a5a
2 # BioPerl module for Bio::Ontology::InterProTerm
4 # Please direct questions and support issues to <bioperl-l@bioperl.org>
6 # Cared for by Peter Dimitrov <dimitrov@gnf.org>
8 # Copyright Peter Dimitrov
9 # (c) Peter Dimitrov, dimitrov@gnf.org, 2002.
10 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
12 # You may distribute this module under the same terms as perl itself.
13 # Refer to the Perl Artistic License (see the license accompanying this
14 # software package, or see http://www.perl.com/language/misc/Artistic.html)
15 # for the terms under which you may use, modify, and redistribute this module.
17 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
18 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
19 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
21 # POD documentation - main docs before the code
23 =head1 NAME
25 Bio::Ontology::InterProTerm - Implementation of InterProI term interface
27 =head1 SYNOPSIS
29 my $term = Bio::Ontology::InterProTerm->new(
30 -interpro_id => "IPR000001",
31 -name => "Kringle",
32 -definition => "Kringles are autonomous structural domains ...",
33 -ontology => "Domain"
35 print $term->interpro_id(), "\n";
36 print $term->name(), "\n";
37 print $term->definition(), "\n";
38 print $term->is_obsolete(), "\n";
39 print $term->ontology->name(), "\n";
41 =head1 DESCRIPTION
43 This is a simple extension of L<Bio::Ontology::Term> for InterPro terms.
45 =head1 FEEDBACK
47 =head2 Mailing Lists
49 User feedback is an integral part of the evolution of this and other
50 Bioperl modules. Send your comments and suggestions preferably to
51 the Bioperl mailing list. Your participation is much appreciated.
53 bioperl-l@bioperl.org - General discussion
54 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
56 =head2 Support
58 Please direct usage questions or support issues to the mailing list:
60 I<bioperl-l@bioperl.org>
62 rather than to the module maintainer directly. Many experienced and
63 reponsive experts will be able look at the problem and quickly
64 address it. Please include a thorough description of the problem
65 with code and data examples if at all possible.
67 =head2 Reporting Bugs
69 Report bugs to the Bioperl bug tracking system to help us keep track
70 of the bugs and their resolution. Bug reports can be submitted via
71 the web:
73 https://github.com/bioperl/bioperl-live/issues
75 =head1 AUTHOR - Peter Dimitrov
77 Email dimitrov@gnf.org
79 =head1 APPENDIX
81 The rest of the documentation details each of the object methods.
82 Internal methods are usually preceded with a _
84 =cut
87 # Let the code begin...
90 package Bio::Ontology::InterProTerm;
91 use strict;
93 use Bio::Annotation::Reference;
95 use constant INTERPRO_ID_DEFAULT => "IPR000000";
97 use base qw(Bio::Ontology::Term);
99 =head2 new
101 Title : new
102 Usage : $term = Bio::Ontology::InterProTerm->new( -interpro_id => "IPR000002",
103 -name => "Cdc20/Fizzy",
104 -definition => "The Cdc20/Fizzy region is almost always ...",
105 -ontology => "Domain"
108 Function: Creates a new Bio::Ontology::InterProTerm.
109 Example :
110 Returns : A new Bio::Ontology::InterProTerm object.
111 Args :
112 -interpro_id => the InterPro ID of the term. Has the form IPRdddddd, where dddddd is a zero-padded six digit number
113 -name => the name of this InterPro term [scalar]
114 -definition => the definition/abstract of this InterPro term [scalar]
115 -ontology => ontology of InterPro terms [Bio::Ontology::OntologyI]
116 -comment => a comment [scalar]
118 =cut
120 sub new{
121 my ($class, @args) = @_;
122 my $self = $class->SUPER::new(@args);
124 my ( $interpro_id,
125 $short_name)
126 = $self->_rearrange( [qw( INTERPRO_ID
127 SHORT_NAME
129 ], @args );
131 $interpro_id && $self->interpro_id( $interpro_id );
132 $short_name && $self->short_name( $short_name );
134 return $self;
137 =head2 init
139 Title : init
140 Usage : $term->init();
141 Function: Initializes this InterProTerm to all "" and empty lists.
142 Example :
143 Returns :
144 Args :
147 =cut
149 sub init{
150 my $self = shift;
152 # first call the inherited version to properly chain up the hierarchy
153 $self->SUPER::init(@_);
155 # then only initialize what we implement ourselves here
156 $self->interpro_id( INTERPRO_ID_DEFAULT );
157 $self->short_name("");
161 =head2 _check_interpro_id
163 Title : _check_interpro_id
164 Usage :
165 Function: Performs simple check in order to validate that its argument has the form IPRdddddd, where dddddd is a zero-padded six digit number.
166 Example :
167 Returns : Returns its argument if valid, otherwise throws exception.
168 Args : String
171 =cut
173 sub _check_interpro_id{
174 my ($self, $value) = @_;
176 $self->throw( "InterPro ID ".$value." is incorrect\n" )
177 unless ( $value =~ /^IPR\d{6}$/ ||
178 $value eq INTERPRO_ID_DEFAULT );
180 return $value;
183 =head2 interpro_id
185 Title : interpro_id
186 Usage : $obj->interpro_id($newval)
187 Function: Set/get for the interpro_id of this InterProTerm
188 Example :
189 Returns : value of interpro_id (a scalar)
190 Args : new value (a scalar, optional)
193 =cut
195 sub interpro_id{
196 my ($self, $value) = @_;
198 if( defined $value) {
199 $value = $self->_check_interpro_id($value);
200 return $self->identifier($value);
203 return $self->identifier();
206 =head2 short_name
208 Title : short_name
209 Usage : $obj->short_name($newval)
210 Function: Set/get for the short name of this InterProTerm.
211 Example :
212 Returns : value of short_name (a scalar)
213 Args : new value (a scalar, optional)
216 =cut
218 sub short_name{
219 my ($self, $value) = @_;
221 if( defined $value) {
222 $self->{'short_name'} = $value ? $value : undef;
225 return $self->{'short_name'};
228 =head2 protein_count
230 Title : protein_count
231 Usage : $obj->protein_count($newval)
232 Function: Set/get for the protein count of this InterProTerm.
233 Example :
234 Returns : value of protein_count (a scalar)
235 Args : new value (a scalar, optional)
238 =cut
240 sub protein_count{
241 my ($self,$value) = @_;
243 if( defined $value) {
244 $self->{'protein_count'} = $value ? $value : undef;
247 return $self->{'protein_count'};
250 =head2 get_references
252 Title : get_references
253 Usage :
254 Function: Get the references for this InterPro term.
255 Example :
256 Returns : An array of L<Bio::Annotation::Reference> objects
257 Args :
260 =cut
262 # Defined in parent class
264 #sub get_references{
265 # my $self = shift;
267 # return @{$self->{"_references"}} if exists($self->{"_references"});
268 # return ();
271 =head2 add_reference
273 Title : add_reference
274 Usage :
275 Function: Add one or more references to this InterPro term.
276 Example :
277 Returns :
278 Args : One or more L<Bio::Annotation::Reference> objects.
281 =cut
283 # Defined in parent class
285 #sub add_reference{
286 # my $self = shift;
288 # $self->{"_references"} = [] unless exists($self->{"_references"});
289 # push(@{$self->{"_references"}}, @_);
292 =head2 remove_references
294 Title : remove_references
295 Usage :
296 Function: Remove all references for this InterPro term.
297 Example :
298 Returns : The list of previous references as an array of
299 L<Bio::Annotation::Reference> objects.
300 Args :
303 =cut
305 # Defined in parent class
306 #sub remove_references{
307 # my $self = shift;
309 # my @arr = $self->get_references();
310 # $self->{"_references"} = [];
311 # return @arr;
314 =head2 get_members
316 Title : get_members
317 Usage : @arr = get_members()
318 Function: Get the list of member(s) for this object.
319 Example :
320 Returns : An array of Bio::Annotation::DBLink objects
321 Args :
324 =cut
326 sub get_members{
327 my $self = shift;
328 return $self->get_dbxrefs('member_list');
331 =head2 add_member
333 Title : add_member
334 Usage :
335 Function: Add one or more member(s) to this object.
336 Example :
337 Returns :
338 Args : One or more Bio::Annotation::DBLink objects.
341 =cut
343 sub add_member{
344 my $self = shift;
345 $self->add_dbxref(-dbxrefs => \@_, -context => 'member_list');
348 =head2 remove_members
350 Title : remove_members
351 Usage :
352 Function: Remove all members for this class.
353 Example :
354 Returns : The list of previous members as an array of
355 Bio::Annotation::DBLink objects.
356 Args :
359 =cut
361 sub remove_members{
362 my $self = shift;
363 return $self->remove_dbxrefs('member_list');
366 =head2 get_examples
368 Title : get_examples
369 Usage : @arr = get_examples()
370 Function: Get the list of example(s) for this object.
372 This is an element of the InterPro xml schema.
374 Example :
375 Returns : An array of Bio::Annotation::DBLink objects
376 Args :
379 =cut
381 sub get_examples{
382 my $self = shift;
383 return $self->get_dbxrefs('example_list');
386 =head2 add_example
388 Title : add_example
389 Usage :
390 Function: Add one or more example(s) to this object.
392 This is an element of the InterPro xml schema.
394 Example :
395 Returns :
396 Args : One or more Bio::Annotation::DBLink objects.
399 =cut
401 sub add_example{
402 my $self = shift;
403 return $self->add_dbxref(-dbxrefs => \@_, -context => 'example_list');
406 =head2 remove_examples
408 Title : remove_examples
409 Usage :
410 Function: Remove all examples for this class.
412 This is an element of the InterPro xml schema.
414 Example :
415 Returns : The list of previous examples as an array of
416 Bio::Annotation::DBLink objects.
417 Args :
420 =cut
422 sub remove_examples{
423 my $self = shift;
424 return $self->remove_dbxrefs('example_list');
427 =head2 get_external_documents
429 Title : get_external_documents
430 Usage : @arr = get_external_documents()
431 Function: Get the list of external_document(s) for this object.
433 This is an element of the InterPro xml schema.
435 Example :
436 Returns : An array of Bio::Annotation::DBLink objects
437 Args :
440 =cut
442 sub get_external_documents{
443 my $self = shift;
444 return $self->get_dbxrefs('external_doc_list');
447 =head2 add_external_document
449 Title : add_external_document
450 Usage :
451 Function: Add one or more external_document(s) to this object.
453 This is an element of the InterPro xml schema.
455 Example :
456 Returns :
457 Args : One or more Bio::Annotation::DBLink objects.
460 =cut
462 sub add_external_document{
463 my $self = shift;
464 return $self->add_dbxref(-dbxrefs => \@_, -context => 'external_doc_list');
467 =head2 remove_external_documents
469 Title : remove_external_documents
470 Usage :
471 Function: Remove all external_documents for this class.
473 This is an element of the InterPro xml schema.
475 Example :
476 Returns : The list of previous external_documents as an array of
477 Bio::Annotation::DBLink objects.
478 Args :
481 =cut
483 sub remove_external_documents{
484 my $self = shift;
485 return $self->remove_dbxrefs('external_doc_list');
488 =head2 class_list
490 Title : class_list
491 Usage : $obj->class_list($newval)
492 Function: Set/get for class list element of the InterPro xml schema
493 Example :
494 Returns : reference to an array of Bio::Annotation::DBLink objects
495 Args : reference to an array of Bio::Annotation::DBLink objects
497 =cut
499 # this is inconsistent with the above, but we work around it and hope nothing
500 # breaks
502 sub class_list{
503 my ($self, $value) = @_;
504 if( defined $value && ref $value eq 'ARRAY') {
505 if (!@$value) {
506 # passing an empty array ref is essentially same as remove_dbxrefs,
507 # so do that
508 $self->remove_dbxrefs('class_list');
509 } else {
510 $self->add_dbxref(-dbxrefs => $value, -context => 'class_list');
513 return [$self->get_dbxrefs('class_list')];
516 =head2 to_string
518 Title : to_string()
519 Usage : print $term->to_string();
520 Function: to_string method for InterPro terms.
521 Returns : A string representation of this InterPro term.
522 Args :
524 =cut
526 sub to_string {
527 my ($self) = @_;
528 my $s = "";
530 $s .= "-- InterPro id:\n";
531 $s .= $self->interpro_id() . "\n";
532 if ( defined $self->name ) {
533 $s .= "-- Name:\n";
534 $s .= $self->name() . "\n";
535 $s .= "-- Definition:\n";
536 $s .= ( $self->definition() || '' ) . "\n";
537 $s .= "-- Category:\n";
538 if ( defined( $self->ontology() ) ) {
539 $s .= $self->ontology()->name() . "\n";
541 else {
542 $s .= "\n";
544 $s .= "-- Version:\n";
545 $s .= ( $self->version() || '' ) . "\n";
546 $s .= "-- Is obsolete:\n";
547 $s .= $self->is_obsolete() . "\n";
548 $s .= "-- Comment:\n";
549 $s .= ( $self->comment() || '' ) . "\n";
550 if ( defined $self->get_references ) {
551 $s .= "-- References:\n";
552 foreach my $ref ( $self->get_references ) {
553 $s .=
554 $ref->authors . "\n"
555 . $ref->title . "\n"
556 . $ref->location . "\n\n";
558 $s .= "\n";
560 if ( defined $self->get_members ) {
561 $s .= "-- Member List:\n";
562 foreach my $ref ( $self->get_members ) {
563 $s .= $ref->database . "\t" . $ref->primary_id . "\n";
565 $s .= "\n";
567 if ( defined $self->get_external_documents ) {
568 $s .= "-- External Document List:\n";
569 foreach my $ref ( $self->get_external_documents ) {
570 $s .= $ref->database . "\t" . $ref->primary_id . "\n";
572 $s .= "\n";
574 if ( defined $self->get_examples ) {
575 $s .= "-- Examples:\n";
576 foreach my $ref ( $self->get_examples ) {
577 $s .= join( "\t",
578 map { $ref->$_ || '' } qw(database primary_id comment) )
579 . "\n";
581 $s .= "\n";
583 if ( defined $self->class_list ) {
584 $s .= "-- Class List:\n";
585 foreach my $ref ( @{ $self->class_list } ) {
586 $s .= $ref->primary_id . "\n";
588 $s .= "\n";
590 if ( $self->get_secondary_ids ) {
591 $s .= "-- Secondary IDs:\n";
592 foreach my $ref ( $self->get_secondary_ids() ) {
593 # TODO: getting undef here in some cases, needs to be checked
594 next unless defined ($ref);
595 $s .= $ref . "\n";
597 $s .= "\n";
600 else {
601 $s .= "InterPro term not fully instantiated\n";
603 return $s;
606 =head1 Deprecated methods
608 These are here for backwards compatibility.
610 =cut
612 =head2 secondary_ids
614 Title : secondary_ids
615 Usage : $obj->secondary_ids($newval)
616 Function: This is deprecated. Use get_secondary_ids() or
617 add_secondary_id() instead.
618 Example :
619 Returns : reference to an array of strings
620 Args : reference to an array of strings
623 =cut
625 sub secondary_ids{
626 my $self = shift;
627 my @ids;
629 $self->warn("secondary_ids is deprecated. Use ".
630 "get_secondary_ids/add_secondary_id instead.");
632 # set mode?
633 if(@_) {
634 my $sids = shift;
635 if($sids) {
636 $self->add_secondary_id(@$sids);
637 @ids = @$sids;
638 } else {
639 # we interpret setting to undef as removing the array
640 $self->remove_secondary_ids();
642 } else {
643 # no; get mode
644 @ids = $self->get_secondary_ids();
646 return \@ids;