[Bioperl-guts-l] bioperl-live/Bio/Location Atomic.pm,1.12,1.13

Jason Stajich jason at pub.open-bio.org
Thu Sep 8 15:55:10 EDT 2005


Update of /home/repository/bioperl/bioperl-live/Bio/Location
In directory pub.open-bio.org:/tmp/cvs-serv18067/Bio/Location

Modified Files:
	Atomic.pm 
Log Message:
move coordinate policy implementation to Location::Atomic and add flip_strand API


Index: Atomic.pm
===================================================================
RCS file: /home/repository/bioperl/bioperl-live/Bio/Location/Atomic.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Atomic.pm	26 Apr 2005 14:50:21 -0000	1.12
--- Atomic.pm	8 Sep 2005 19:55:08 -0000	1.13
***************
*** 63,74 ****
  
  package Bio::Location::Atomic;
! use vars qw(@ISA);
  use strict;
  
  use Bio::Root::Root;
  use Bio::LocationI;
  
  @ISA = qw(Bio::Root::Root Bio::LocationI);
  
  sub new { 
      my ($class, @args) = @_;
--- 63,79 ----
  
  package Bio::Location::Atomic;
! use vars qw(@ISA  $coord_policy);
  use strict;
  
  use Bio::Root::Root;
  use Bio::LocationI;
+ use Bio::Location::WidestCoordPolicy;
  
  @ISA = qw(Bio::Root::Root Bio::LocationI);
  
+ BEGIN {
+     $coord_policy = Bio::Location::WidestCoordPolicy->new();
+ }
+ 
  sub new { 
      my ($class, @args) = @_;
***************
*** 181,184 ****
--- 186,225 ----
  }
  
+ =head2 flip_strand
+ 
+   Title   : flip_strand
+   Usage   : $location->flip_strand();
+   Function: Flip-flop a strand to the opposite
+   Returns : None
+   Args    : None
+ 
+ =cut
+ 
+ 
+ sub flip_strand {
+     my $self= shift;
+     $self->strand($self->strand * -1);
+ }
+ 
+ 
+ =head2 seq_id
+ 
+   Title   : seq_id
+   Usage   : my $seqid = $location->seq_id();
+   Function: Get/Set seq_id that location refers to
+   Returns : seq_id (a string)
+   Args    : [optional] seq_id value to set
+ 
+ =cut
+ 
+ 
+ sub seq_id {
+     my ($self, $seqid) = @_;
+     if( defined $seqid ) {
+ 	$self->{'_seqid'} = $seqid;
+     }
+     return $self->{'_seqid'};
+ }
+ 
  =head2 length
  
***************
*** 386,389 ****
--- 427,482 ----
      return $str;
  }
+ 
+ 
+ =head2 coordinate_policy
+ 
+   Title   : coordinate_policy
+   Usage   : $policy = $location->coordinate_policy();
+             $location->coordinate_policy($mypolicy); # set may not be possible
+   Function: Get the coordinate computing policy employed by this object.
+ 
+             See L<Bio::Location::CoordinatePolicyI> for documentation
+             about the policy object and its use.
+ 
+             The interface *does not* require implementing classes to
+             accept setting of a different policy. The implementation
+             provided here does, however, allow to do so.
+ 
+             Implementors of this interface are expected to initialize
+             every new instance with a
+             L<Bio::Location::CoordinatePolicyI> object. The
+             implementation provided here will return a default policy
+             object if none has been set yet. To change this default
+             policy object call this method as a class method with an
+             appropriate argument. Note that in this case only
+             subsequently created Location objects will be affected.
+ 
+   Returns : A L<Bio::Location::CoordinatePolicyI> implementing object.
+   Args    : On set, a L<Bio::Location::CoordinatePolicyI> implementing object.
+ 
+ See L<Bio::Location::CoordinatePolicyI> for more information
+ 
+ 
+ =cut
+ 
+ sub coordinate_policy {
+     my ($self, $policy) = @_;
+ 
+     if(defined($policy)) {
+ 	if(! $policy->isa('Bio::Location::CoordinatePolicyI')) {
+ 	    $self->throw("Object of class ".ref($policy)." does not implement".
+ 			 " Bio::Location::CoordinatePolicyI");
+ 	}
+ 	if(ref($self)) {
+ 	    $self->{'_coordpolicy'} = $policy;
+ 	} else {
+ 	    # called as class method
+ 	    $coord_policy = $policy;
+ 	}
+     }
+     return (ref($self) && exists($self->{'_coordpolicy'}) ?
+ 	    $self->{'_coordpolicy'} : $coord_policy);
+ }
+ 
  
  # comments, not function added by jason 



More information about the Bioperl-guts-l mailing list