diff variant_effect_predictor/Bio/Ontology/InterProTerm.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/Ontology/InterProTerm.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,644 @@
+# $Id: InterProTerm.pm,v 1.4.2.2 2003/03/25 12:32:16 heikki Exp $
+#
+# BioPerl module for Bio::Ontology::InterProTerm
+#
+# Cared for by Peter Dimitrov <[e-mail]>
+#
+# Copyright Peter Dimitrov
+# (c) Peter Dimitrov, [e-mail], 2002.
+# (c) GNF, Genomics Institute of the Novartis Research Foundation, 2002.
+#
+# You may distribute this module under the same terms as perl itself.
+# Refer to the Perl Artistic License (see the license accompanying this
+# software package, or see http://www.perl.com/language/misc/Artistic.html)
+# for the terms under which you may use, modify, and redistribute this module.
+#
+# THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+#
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+InterProTerm - Implementation of InterProI term interface
+
+=head1 SYNOPSIS
+
+  my $term = Bio::Ontology::InterProTerm->new( -interpro_id => "IPR000001",
+					       -name => "Kringle",
+					       -definition => "Kringles are autonomous structural domains ...",
+					       -ontology => "Domain"
+					     );
+  print $term->interpro_id(), "\n";
+  print $term->name(), "\n";
+  print $term->definition(), "\n";
+  print $term->is_obsolete(), "\n";
+  print $term->ontology->name(), "\n";
+
+=head1 DESCRIPTION
+
+This is a simple extension of L<Bio::Ontology::Term> for InterPro terms.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this and other
+Bioperl modules. Send your comments and suggestions preferably to
+the Bioperl mailing list.  Your participation is much appreciated.
+
+  [e-mail]              - General discussion
+  http://bioperl.org/MailList.shtml  - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+of the bugs and their resolution. Bug reports can be submitted via
+email or the web:
+
+  [e-mail]
+  http://bugzilla.bioperl.org/
+
+=head1 AUTHOR - Peter Dimitrov
+
+Email [e-mail]
+
+=head1 CONTRIBUTORS
+
+Additional contributors names and emails here
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods.
+Internal methods are usually preceded with a _
+
+=cut
+
+
+# Let the code begin...
+
+
+package Bio::Ontology::InterProTerm;
+use vars qw(@ISA);
+use strict;
+
+use Bio::Ontology::Term;
+use Bio::Annotation::Reference;
+
+use constant INTERPRO_ID_DEFAULT => "IPR000000";
+
+@ISA = qw( Bio::Ontology::Term );
+
+=head2 new
+
+ Title   : new
+ Usage   : $term = Bio::Ontology::InterProTerm->new( -interpro_id => "IPR000002",
+						     -name => "Cdc20/Fizzy",
+						     -definition => "The Cdc20/Fizzy region is almost always ...",
+						     -ontology => "Domain"
+						   );
+
+ Function: Creates a new Bio::Ontology::InterProTerm.
+ Example :
+ Returns : A new Bio::Ontology::InterProTerm object.
+ Args    :
+  -interpro_id => the InterPro ID of the term. Has the form IPRdddddd, where dddddd is a zero-padded six digit number
+  -name => the name of this InterPro term [scalar]
+  -definition => the definition/abstract of this InterPro term [scalar]
+  -ontology => ontology of InterPro terms [Bio::Ontology::OntologyI]
+  -comment => a comment [scalar]
+
+=cut
+
+sub new{
+  my ($class, @args) = @_;
+  my $self = $class->SUPER::new(@args);
+
+  my ( $interpro_id,
+       $short_name)
+      = $self->_rearrange( [qw( INTERPRO_ID
+				SHORT_NAME
+				)
+			    ], @args );
+
+  $interpro_id && $self->interpro_id( $interpro_id );
+  $short_name && $self->short_name( $short_name );
+
+  return $self;
+}
+
+=head2 init
+
+ Title   : init
+ Usage   : $term->init();
+ Function: Initializes this InterProTerm to all "" and empty lists.
+ Example :
+ Returns : 
+ Args    :
+
+
+=cut
+
+sub init{
+    my $self = shift;
+
+    # first call the inherited version to properly chain up the hierarchy
+    $self->SUPER::init(@_);
+
+    # then only initialize what we implement ourselves here
+    $self->interpro_id( INTERPRO_ID_DEFAULT );
+    $self->short_name("");
+
+}
+
+=head2 _check_interpro_id
+
+ Title   : _check_interpro_id
+ Usage   :
+ Function: Performs simple check in order to validate that its argument has the form IPRdddddd, where dddddd is a zero-padded six digit number.
+ Example :
+ Returns : Returns its argument if valid, otherwise throws exception.
+ Args    : String
+
+
+=cut
+
+sub _check_interpro_id{
+  my ($self, $value) = @_;
+
+  $self->throw( "InterPro ID ".$value." is incorrect\n" )
+    unless ( $value =~ /^IPR\d{6}$/ ||
+	     $value eq INTERPRO_ID_DEFAULT );
+
+  return $value;
+}
+
+=head2 interpro_id
+
+ Title   : interpro_id
+ Usage   : $obj->interpro_id($newval)
+ Function: Set/get for the interpro_id of this InterProTerm
+ Example : 
+ Returns : value of interpro_id (a scalar)
+ Args    : new value (a scalar, optional)
+
+
+=cut
+
+sub interpro_id{
+  my ($self, $value) = @_;
+
+  if( defined $value) {
+    $value = $self->_check_interpro_id($value);
+  }
+
+  return $self->identifier($value);
+}
+
+=head2 short_name
+
+ Title   : short_name
+ Usage   : $obj->short_name($newval)
+ Function: Set/get for the short name of this InterProTerm.
+ Example : 
+ Returns : value of short_name (a scalar)
+ Args    : new value (a scalar, optional)
+
+
+=cut
+
+sub short_name{
+  my ($self, $value) = @_;
+
+  if( defined $value) {
+    $self->{'short_name'} = $value ? $value : undef;
+  }
+
+  return $self->{'short_name'};
+}
+
+=head2 protein_count
+
+ Title   : protein_count
+ Usage   : $obj->protein_count($newval)
+ Function: Set/get for the protein count of this InterProTerm.
+ Example : 
+ Returns : value of protein_count (a scalar)
+ Args    : new value (a scalar, optional)
+
+
+=cut
+
+sub protein_count{
+  my ($self,$value) = @_;
+
+  if( defined $value) {
+    $self->{'protein_count'} = $value ? $value : undef;
+  }
+
+  return $self->{'protein_count'};
+}
+
+=head2 get_references
+
+ Title   : get_references
+ Usage   :
+ Function: Get the references for this InterPro term.
+ Example :
+ Returns : An array of L<Bio::Annotation::Reference> objects
+ Args    :
+
+
+=cut
+
+sub get_references{
+    my $self = shift;
+
+    return @{$self->{"_references"}} if exists($self->{"_references"});
+    return ();
+}
+
+=head2 add_reference
+
+ Title   : add_reference
+ Usage   :
+ Function: Add one or more references to this InterPro term.
+ Example :
+ Returns : 
+ Args    : One or more L<Bio::Annotation::Reference> objects.
+
+
+=cut
+
+sub add_reference{
+    my $self = shift;
+
+    $self->{"_references"} = [] unless exists($self->{"_references"});
+    push(@{$self->{"_references"}}, @_);
+}
+
+=head2 remove_references
+
+ Title   : remove_references
+ Usage   :
+ Function: Remove all references for this InterPro term.
+ Example :
+ Returns : The list of previous references as an array of
+           L<Bio::Annotation::Reference> objects.
+ Args    :
+
+
+=cut
+
+sub remove_references{
+    my $self = shift;
+
+    my @arr = $self->get_references();
+    $self->{"_references"} = [];
+    return @arr;
+}
+
+=head2 get_members
+
+ Title   : get_members
+ Usage   : @arr = get_members()
+ Function: Get the list of member(s) for this object.
+ Example :
+ Returns : An array of Bio::Annotation::DBLink objects
+ Args    :
+
+
+=cut
+
+sub get_members{
+    my $self = shift;
+
+    return @{$self->{'_members'}} if exists($self->{'_members'});
+    return ();
+}
+
+=head2 add_member
+
+ Title   : add_member
+ Usage   :
+ Function: Add one or more member(s) to this object.
+ Example :
+ Returns : 
+ Args    : One or more Bio::Annotation::DBLink objects.
+
+
+=cut
+
+sub add_member{
+    my $self = shift;
+
+    $self->{'_members'} = [] unless exists($self->{'_members'});
+    push(@{$self->{'_members'}}, @_);
+}
+
+=head2 remove_members
+
+ Title   : remove_members
+ Usage   :
+ Function: Remove all members for this class.
+ Example :
+ Returns : The list of previous members as an array of
+           Bio::Annotation::DBLink objects.
+ Args    :
+
+
+=cut
+
+sub remove_members{
+    my $self = shift;
+
+    my @arr = $self->get_members();
+    $self->{'_members'} = [];
+    return @arr;
+}
+
+=head2 get_examples
+
+ Title   : get_examples
+ Usage   : @arr = get_examples()
+ Function: Get the list of example(s) for this object.
+
+           This is an element of the InterPro xml schema.
+
+ Example :
+ Returns : An array of Bio::Annotation::DBLink objects
+ Args    :
+
+
+=cut
+
+sub get_examples{
+    my $self = shift;
+
+    return @{$self->{'_examples'}} if exists($self->{'_examples'});
+    return ();
+}
+
+=head2 add_example
+
+ Title   : add_example
+ Usage   :
+ Function: Add one or more example(s) to this object.
+
+           This is an element of the InterPro xml schema.
+
+ Example :
+ Returns : 
+ Args    : One or more Bio::Annotation::DBLink objects.
+
+
+=cut
+
+sub add_example{
+    my $self = shift;
+
+    $self->{'_examples'} = [] unless exists($self->{'_examples'});
+    push(@{$self->{'_examples'}}, @_);
+}
+
+=head2 remove_examples
+
+ Title   : remove_examples
+ Usage   :
+ Function: Remove all examples for this class.
+
+           This is an element of the InterPro xml schema.
+
+ Example :
+ Returns : The list of previous examples as an array of
+           Bio::Annotation::DBLink objects.
+ Args    :
+
+
+=cut
+
+sub remove_examples{
+    my $self = shift;
+
+    my @arr = $self->get_examples();
+    $self->{'_examples'} = [];
+    return @arr;
+}
+
+=head2 get_external_documents
+
+ Title   : get_external_documents
+ Usage   : @arr = get_external_documents()
+ Function: Get the list of external_document(s) for this object.
+
+           This is an element of the InterPro xml schema.
+
+ Example :
+ Returns : An array of Bio::Annotation::DBLink objects
+ Args    :
+
+
+=cut
+
+sub get_external_documents{
+    my $self = shift;
+
+    return @{$self->{'_external_documents'}} if exists($self->{'_external_documents'});
+    return ();
+}
+
+=head2 add_external_document
+
+ Title   : add_external_document
+ Usage   :
+ Function: Add one or more external_document(s) to this object.
+
+           This is an element of the InterPro xml schema.
+
+ Example :
+ Returns : 
+ Args    : One or more Bio::Annotation::DBLink objects.
+
+
+=cut
+
+sub add_external_document{
+    my $self = shift;
+
+    $self->{'_external_documents'} = [] unless exists($self->{'_external_documents'});
+    push(@{$self->{'_external_documents'}}, @_);
+}
+
+=head2 remove_external_documents
+
+ Title   : remove_external_documents
+ Usage   :
+ Function: Remove all external_documents for this class.
+
+           This is an element of the InterPro xml schema.
+
+ Example :
+ Returns : The list of previous external_documents as an array of
+           Bio::Annotation::DBLink objects.
+ Args    :
+
+
+=cut
+
+sub remove_external_documents{
+    my $self = shift;
+
+    my @arr = $self->get_external_documents();
+    $self->{'_external_documents'} = [];
+    return @arr;
+}
+
+=head2 class_list
+
+ Title   : class_list
+ Usage   : $obj->class_list($newval)
+ Function: Set/get for class list element of the InterPro xml schema
+ Example : 
+ Returns : reference to an array of Bio::Annotation::DBLink objects
+ Args    : reference to an array of Bio::Annotation::DBLink objects
+
+
+=cut
+
+sub class_list{
+  my ($self, $value) = @_;
+
+  if( defined $value) {
+    $self->{'class_list'} = $value;
+  }
+
+  return $self->{'class_list'};
+}
+
+=head2 to_string
+
+ Title   : to_string()
+ Usage   : print $term->to_string();
+ Function: to_string method for InterPro terms.
+ Returns : A string representation of this InterPro term.
+ Args    :
+
+=cut
+
+sub to_string {
+  my($self) = @_;
+  my $s = "";
+
+  $s .= "-- InterPro id:\n";
+  $s .= $self->interpro_id()."\n";
+  if (defined $self->name) {
+    $s .= "-- Name:\n";
+    $s .= $self->name()."\n";
+    $s .= "-- Definition:\n";
+    $s .= $self->definition()."\n";
+    $s .= "-- Category:\n";
+    if ( defined( $self->ontology() ) ) {
+      $s .= $self->ontology()->name()."\n";
+    } else {
+      $s .= "\n";
+    }
+    $s .= "-- Version:\n";
+    $s .= $self->version()."\n";
+    $s .= "-- Is obsolete:\n";
+    $s .= $self->is_obsolete()."\n";
+    $s .= "-- Comment:\n";
+    $s .= $self->comment()."\n"; 
+    if (defined $self->references) {
+      $s .= "-- References:\n";
+      foreach my $ref ( @{$self->references} ) {
+	$s .= $ref->authors."\n".$ref->title."\n".$ref->location."\n\n";
+      };
+      $s .= "\n";
+    }
+    if (defined $self->member_list) {
+      $s .= "-- Member List:\n";
+      foreach my $ref ( @{$self->member_list} ) {
+	$s .= $ref->database."\t".$ref->primary_id."\n";
+      };
+      $s .= "\n";
+    }
+    if (defined $self->external_doc_list) {
+      $s .= "-- External Document List:\n";
+      foreach my $ref ( @{$self->external_doc_list} ) {
+	$s .= $ref->database."\t".$ref->primary_id."\n";
+      };
+      $s .= "\n";
+    }
+    if (defined $self->examples) {
+      $s .= "-- Examples:\n";
+      foreach my $ref ( @{$self->examples} ) {
+	$s .= $ref->database."\t".$ref->primary_id."\t".$ref->comment."\n";
+      };
+      $s .= "\n";
+    }
+    if (defined $self->class_list) {
+      $s .= "-- Class List:\n";
+      foreach my $ref ( @{$self->class_list} ) {
+	$s .= $ref->primary_id."\n";
+      };
+      $s .= "\n";
+    }
+    if ($self->get_secondary_ids) {
+      $s .= "-- Secondary IDs:\n";
+      foreach my $ref ( $self->get_secondary_ids() ) {
+	$s .= $ref."\n";
+      };
+      $s .= "\n";
+    }
+  }
+  else {
+    $s .= "InterPro term not fully instantiated\n";
+  }
+  return $s;
+}
+
+=head1 Deprecated methods
+
+These are here for backwards compatibility.
+
+=cut
+
+=head2 secondary_ids
+
+ Title   : secondary_ids
+ Usage   : $obj->secondary_ids($newval)
+ Function: This is deprecated. Use get_secondary_ids() or 
+           add_secondary_id() instead.
+ Example : 
+ Returns : reference to an array of strings
+ Args    : reference to an array of strings
+
+
+=cut
+
+sub secondary_ids{
+    my $self = shift;
+    my @ids;
+
+    $self->warn("secondary_ids is deprecated. Use ".
+		"get_secondary_ids/add_secondary_id instead.");
+
+    # set mode?
+    if(@_) {
+	my $sids = shift;
+	if($sids) {
+	    $self->add_secondary_id(@$sids);
+	    @ids = @$sids; 
+	} else {
+	    # we interpret setting to undef as removing the array
+	    $self->remove_secondary_ids();
+	}
+    } else {
+	# no; get mode
+	@ids = $self->get_secondary_ids();
+    }
+    return \@ids;
+}
+
+1;