[Bioperl-l] Re: [Bioperl-guts-l] bioperl-live/Bio/SeqFeature Annotated.pm, 1.16, 1.17

[Allen Day]

i'd like a warning issued if the range expands.  i see expansion as a 
convenience feature, and want to know when it happens because i don't 
generally expect it.

On Wed, 24 Nov 2004, Steffen Grossman wrote:

> Update of /home/repository/bioperl/bioperl-live/Bio/SeqFeature
> In directory pub.open-bio.org:/tmp/cvs-serv19535
> 
> Modified Files:
> 	Annotated.pm 
> Log Message:
> Added support for the 'EXPAND' option in 'add_SeqFeature'.
> 
> 
> Index: Annotated.pm
> ===================================================================
> RCS file: /home/repository/bioperl/bioperl-live/Bio/SeqFeature/Annotated.pm,v
> retrieving revision 1.16
> retrieving revision 1.17
> diff -C2 -d -r1.16 -r1.17
> *** Annotated.pm	24 Nov 2004 02:14:06 -0000	1.16
> --- Annotated.pm	24 Nov 2004 16:31:59 -0000	1.17
> ***************
> *** 604,617 ****
>   =head2 add_SeqFeature()
>   
> !  Usage   : $obj->add_SeqFeature($feat);
> !  Function: Returns : nothing
> !  Args    : A Bio::SeqFeatureI object.  Objects not implementing Bio::SeqFeatureI
> !            and those whose bounds are not within those of the called object are
> !            ignored with a warning.
>   
>   =cut
>   
>   sub add_SeqFeature {
> !   my ($self,$val) = @_;
>   
>     return undef unless $val;
> --- 604,625 ----
>   =head2 add_SeqFeature()
>   
> !  Usage   : $feat->add_SeqFeature($subfeat);
> !            $feat->add_SeqFeature($subfeat,'EXPAND')
> !  Function: adds a SeqFeature into the subSeqFeature array.
> !            with no 'EXPAND' qualifer, subfeat will be tested
> !            as to whether it lies inside the parent, and throw
> !            an exception if not.
> ! 
> !            If EXPAND is used, the parent''s start/end/strand will
> !            be adjusted so that it grows to accommodate the new
> !            subFeature
> !  Example :
> !  Returns : nothing
> !  Args    : a Bio::SeqFeatureI object
>   
>   =cut
>   
>   sub add_SeqFeature {
> !   my ($self,$val, $expand) = @_;
>   
>     return undef unless $val;
> ***************
> *** 619,626 ****
>     if ( !$val->isa('Bio::SeqFeatureI') ) {
>       $self->warn("$val does not implement Bio::SeqFeatureI, ignoring.");
>     }
>   
> !   if ( !$self->contains($val) ) {
> !     $self->warn("$val is not contained within parent feature, ignoring.");
>     }
>   
> --- 627,640 ----
>     if ( !$val->isa('Bio::SeqFeatureI') ) {
>       $self->warn("$val does not implement Bio::SeqFeatureI, ignoring.");
> +     return undef;
>     }
>   
> !   if($expand && ($expand eq 'EXPAND')) {
> !       $self->_expand_region($val);
> !   } else {
> !       if ( !$self->contains($val) ) {
> ! 	  $self->warn("$val is not contained within parent feature, and expansion is not valid, ignoring.");
> ! 	  return undef;
> !       }
>     }
>   
> ***************
> *** 734,737 ****
> --- 748,785 ----
>     my ($self) = @_;
>     return $self->{'targets'} ? @{ $self->{'targets'} } : ();
> + }
> + 
> + =head2 _expand_region
> + 
> +  Title   : _expand_region
> +  Usage   : $self->_expand_region($feature);
> +  Function: Expand the total region covered by this feature to
> +            accomodate for the given feature.
> + 
> +            May be called whenever any kind of subfeature is added to this
> +            feature. add_SeqFeature() already does this.
> +  Returns : 
> +  Args    : A Bio::SeqFeatureI implementing object.
> + 
> + 
> + =cut
> + 
> + sub _expand_region {
> +     my ($self, $feat) = @_;
> +     if(! $feat->isa('Bio::SeqFeatureI')) {
> +         $self->warn("$feat does not implement Bio::SeqFeatureI");
> +     }
> +     # if this doesn't have start/end set - forget it!
> +     if((! defined($self->start())) && (! defined $self->end())) {
> +         $self->start($feat->start());
> +         $self->end($feat->end());
> +         $self->strand($feat->strand) unless defined($self->strand());
> + #        $self->strand($feat->strand) unless $self->strand();
> +     } else {
> +         my $range = $self->union($feat);
> +         $self->start($range->start);
> +         $self->end($range->end);
> +         $self->strand($range->strand);
> +     }
>   }
>   
> 
> _______________________________________________
> Bioperl-guts-l mailing list
> Bioperl-guts-l at portal.open-bio.org
> http://portal.open-bio.org/mailman/listinfo/bioperl-guts-l
>