diff variant_effect_predictor/Bio/SeqFeature/PositionProxy.pm @ 0:2bc9b66ada89 draft default tip

Uploaded
author mahtabm
date Thu, 11 Apr 2013 06:29:17 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/SeqFeature/PositionProxy.pm	Thu Apr 11 06:29:17 2013 -0400
@@ -0,0 +1,449 @@
+# $Id: PositionProxy.pm,v 1.4 2002/10/22 07:38:41 lapp Exp $
+#
+# BioPerl module for Bio::SeqFeature::PositionProxy
+#
+# Cared for by Ewan Birney <birney@ebi.ac.uk>
+#
+# Copyright Ewan Birney
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::SeqFeature::PositionProxy - handle features when truncation/revcom sequences span a feature
+
+=head1 SYNOPSIS
+
+   $proxy = new Bio::SeqFeature::PositionProxy ( -loc => $loc,
+                                                 -parent => $basefeature);
+
+   $seq->add_SeqFeature($feat);
+
+
+
+=head1 DESCRIPTION
+
+PositionProxy is a Proxy Sequence Feature to handle truncation
+and revcomp without duplicating all the data within the sequence features.
+It holds a new location for a sequence feature and the original feature
+it came from to provide the additional annotation information.
+
+=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 one
+of the Bioperl mailing lists.  Your participation is much appreciated.
+
+  bioperl-l@bioperl.org          - General discussion
+  http://bio.perl.org/MailList.html             - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+the bugs and their resolution.  Bug reports can be submitted via email
+or the web:
+
+  bioperl-bugs@bio.perl.org
+  http://bugzilla.bioperl.org/
+
+=head1 AUTHOR - Ewan Birney
+
+Ewan Birney E<lt>birney@sanger.ac.ukE<gt>
+
+=head1 DEVELOPERS
+
+This class has been written with an eye out of inheritence. The fields
+the actual object hash are:
+
+   _gsf_tag_hash  = reference to a hash for the tags
+   _gsf_sub_array = reference to an array for sub arrays
+   _gsf_start     = scalar of the start point
+   _gsf_end       = scalar of the end point
+   _gsf_strand    = scalar of the strand
+
+=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::SeqFeature::PositionProxy;
+use vars qw(@ISA);
+use strict;
+
+use Bio::Root::Root;
+use Bio::SeqFeatureI;
+use Bio::Tools::GFF;
+
+
+@ISA = qw(Bio::Root::Root Bio::SeqFeatureI);
+
+sub new {
+    my ($caller, @args) = @_;
+    my $self = $caller->SUPER::new(@args);
+
+    my ($feature,$location) = $self->_rearrange([qw(PARENT LOC)],@args);
+
+    if( !defined $feature || !ref $feature || !$feature->isa('Bio::SeqFeatureI') ) {
+      $self->throw("Must have a parent feature, not a [$feature]");
+    }
+
+    if( $feature->isa("Bio::SeqFeature::PositionProxy") ) {
+      $feature = $feature->parent();
+    }
+
+    if( !defined $location || !ref $location || !$location->isa('Bio::LocationI') ) {
+      $self->throw("Must have a location, not a [$location]");
+    }
+
+
+    return $self;
+}
+
+
+=head2 location
+
+ Title   : location
+ Usage   : my $location = $seqfeature->location()
+ Function: returns a location object suitable for identifying location 
+	   of feature on sequence or parent feature  
+ Returns : Bio::LocationI object
+ Args    : none
+
+
+=cut
+
+sub location {
+    my($self, $value ) = @_;  
+
+    if (defined($value)) {
+        unless (ref($value) and $value->isa('Bio::LocationI')) {
+	    $self->throw("object $value pretends to be a location but ".
+			 "does not implement Bio::LocationI");
+        }
+        $self->{'_location'} = $value;
+    }
+    elsif (! $self->{'_location'}) {
+        # guarantees a real location object is returned every time
+        $self->{'_location'} = Bio::Location::Simple->new();
+    }
+    return $self->{'_location'};
+}
+
+
+=head2 parent
+
+ Title   : parent
+ Usage   : my $sf = $proxy->parent()
+ Function: returns the seqfeature parent of this proxy
+ Returns : Bio::SeqFeatureI object
+ Args    : none
+
+
+=cut
+
+sub parent {
+    my($self, $value ) = @_;  
+
+    if (defined($value)) {
+        unless (ref($value) and $value->isa('Bio::SeqFeatureI')) {
+	    $self->throw("object $value pretends to be a location but ".
+			 "does not implement Bio::SeqFeatureI");
+        }
+        $self->{'_parent'} = $value;
+    }
+
+    return $self->{'_parent'};
+}
+
+
+
+=head2 start
+
+ Title   : start
+ Usage   : $start = $feat->start
+           $feat->start(20)
+ Function: Get
+ Returns : integer
+ Args    : none
+
+
+=cut
+
+sub start {
+   my ($self,$value) = @_;
+   return $self->location->start($value);
+}
+
+=head2 end
+
+ Title   : end
+ Usage   : $end = $feat->end
+           $feat->end($end)
+ Function: get
+ Returns : integer
+ Args    : none
+
+
+=cut
+
+sub end {
+   my ($self,$value) = @_;
+   return $self->location->end($value);
+}
+
+=head2 length
+
+ Title   : length
+ Usage   :
+ Function:
+ Example :
+ Returns :
+ Args    :
+
+
+=cut
+
+sub length {
+   my ($self) = @_;
+   return $self->end - $self->start() + 1;
+}
+
+=head2 strand
+
+ Title   : strand
+ Usage   : $strand = $feat->strand()
+           $feat->strand($strand)
+ Function: get/set on strand information, being 1,-1 or 0
+ Returns : -1,1 or 0
+ Args    : none
+
+
+=cut
+
+sub strand {
+   my ($self,$value) = @_;
+   return $self->location->strand($value);
+}
+
+
+=head2 attach_seq
+
+ Title   : attach_seq
+ Usage   : $sf->attach_seq($seq)
+ Function: Attaches a Bio::Seq object to this feature. This
+           Bio::Seq object is for the *entire* sequence: ie
+           from 1 to 10000
+ Example :
+ Returns : TRUE on success
+ Args    :
+
+
+=cut
+
+sub attach_seq {
+   my ($self, $seq) = @_;
+
+   if ( !defined $seq || !ref $seq || ! $seq->isa("Bio::PrimarySeqI") ) {
+       $self->throw("Must attach Bio::PrimarySeqI objects to SeqFeatures");
+   }
+
+   $self->{'_gsf_seq'} = $seq;
+
+   # attach to sub features if they want it
+
+   foreach my $sf ( $self->sub_SeqFeature() ) {
+       if ( $sf->can("attach_seq") ) {
+	   $sf->attach_seq($seq);
+       }
+   }
+   return 1;
+}
+
+=head2 seq
+
+ Title   : seq
+ Usage   : $tseq = $sf->seq()
+ Function: returns the truncated sequence (if there) for this
+ Example :
+ Returns : sub seq on attached sequence bounded by start & end
+ Args    : none
+
+
+=cut
+
+sub seq {
+   my ($self, $arg) = @_;
+
+   if ( defined $arg ) {
+       $self->throw("Calling SeqFeature::PositionProxy->seq with an argument. You probably want attach_seq");
+   }
+
+   if ( ! exists $self->{'_gsf_seq'} ) {
+       return undef;
+   }
+
+   # assumming our seq object is sensible, it should not have to yank
+   # the entire sequence out here.
+
+   my $seq = $self->{'_gsf_seq'}->trunc($self->start(), $self->end());
+
+
+   if ( $self->strand == -1 ) {
+       $seq = $seq->revcom;
+   }
+
+   return $seq;
+}
+
+=head2 entire_seq
+
+ Title   : entire_seq
+ Usage   : $whole_seq = $sf->entire_seq()
+ Function: gives the entire sequence that this seqfeature is attached to
+ Example :
+ Returns :
+ Args    :
+
+
+=cut
+
+sub entire_seq {
+   my ($self) = @_;
+
+   return undef unless exists($self->{'_gsf_seq'});
+   return $self->{'_gsf_seq'};
+}
+
+
+=head2 seqname
+
+ Title   : seqname
+ Usage   : $obj->seq_id($newval)
+ Function: There are many cases when you make a feature that you
+           do know the sequence name, but do not know its actual
+           sequence. This is an attribute such that you can store
+           the seqname.
+
+           This attribute should *not* be used in GFF dumping, as
+           that should come from the collection in which the seq
+           feature was found.
+ Returns : value of seqname
+ Args    : newvalue (optional)
+
+
+=cut
+
+sub seqname {
+    my ($obj,$value) = @_;
+    if ( defined $value ) {
+	$obj->{'_gsf_seqname'} = $value;
+    }
+    return $obj->{'_gsf_seqname'};
+}
+
+
+
+=head2 Proxies
+
+These functions chain back to the parent for all non sequence related stuff.
+
+
+=cut
+
+=head2 primary_tag
+
+ Title   : primary_tag
+ Usage   : $tag = $feat->primary_tag()
+ Function: Returns the primary tag for a feature,
+           eg 'exon'
+ Returns : a string 
+ Args    : none
+
+
+=cut
+
+sub primary_tag{
+   my ($self,@args) = @_;
+
+   return $self->parent->primary_tag();
+}
+
+=head2 source_tag
+
+ Title   : source_tag
+ Usage   : $tag = $feat->source_tag()
+ Function: Returns the source tag for a feature,
+           eg, 'genscan' 
+ Returns : a string 
+ Args    : none
+
+
+=cut
+
+sub source_tag{
+   my ($self) = @_;
+
+   return $self->parent->source_tag();
+}
+
+
+=head2 has_tag
+
+ Title   : has_tag
+ Usage   : $tag_exists = $self->has_tag('some_tag')
+ Function: 
+ Returns : TRUE if the specified tag exists, and FALSE otherwise
+ Args    :
+
+
+=cut
+
+sub has_tag{
+   my ($self,$tag) = @_;
+
+   return $self->parent->has_tag($tag);
+}
+
+=head2 each_tag_value
+
+ Title   : each_tag_value
+ Usage   : @values = $self->each_tag_value('some_tag')
+ Function: 
+ Returns : An array comprising the values of the specified tag.
+ Args    :
+
+
+=cut
+
+sub each_tag_value {
+   my ($self,$tag) = @_;
+
+   return $self->parent->each_tag_value($tag);
+}
+
+=head2 all_tags
+
+ Title   : all_tags
+ Usage   : @tags = $feat->all_tags()
+ Function: gives all tags for this feature
+ Returns : an array of strings
+ Args    : none
+
+
+=cut
+
+sub all_tags{
+   my ($self) = @_;
+
+   return $self->parent->all_tags();
+}