Merge from HEAD.

modules/Bio/EnsEMBL/Mapper.pm

@@ -78,39 +78,29 @@ use Bio::EnsEMBL::Utils::Exception qw(throw);
 =cut
 
 sub new {
-  my $class = shift;
-  my $from  = shift;
-  my $to    = shift;
-  my $from_cs = shift;
-  my $to_cs   = shift;
+  my ( $proto, $from, $to, $from_cs, $to_cs ) = @_;
 
-  my $self = {};
-  bless $self,$class;
-
-  if( !defined $to ) {
-    throw("Must supply from and to tags");
+  if ( !defined($to) || !defined($from) ) {
+    throw("Must supply 'to' and 'from' tags");
   }
 
-  $self->{"_pair_$from"} = {};
-  $self->{"_pair_$to"} = {};
-
-  $self->to($to);
-  $self->from($from);
-
-  $self->{'pair_count'} = 0;
-
-  $self->{'from_cs'} = $from_cs;
-  $self->{'to_cs'}   = $to_cs;
-
+  my $class = ref($proto) || $proto;
 
-# do sql to get any componente with muliple assemblys.
+  my $self = bless( { "_pair_$from" => {},
+                      "_pair_$to"   => {},
+                      'pair_count'  => 0,
+                      'to'          => $to,
+                      'from'        => $from,
+                      'to_cs'       => $to_cs,
+                      'from_cs'     => $from_cs
+                    },
+                    $class );
 
+  # do sql to get any componente with muliple assemblys.
 
   return $self;
 }
 
-
-
 =head2 flush
 
   Args       : none
@@ -858,22 +848,24 @@ sub list_pairs{
 
 =cut
 
-sub to{
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'to'} = $value;
-    }
-    return $self->{'to'};
+sub to {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'to'} = $value;
+  }
 
+  return $self->{'to'};
 }
 
-sub from{
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'from'} = $value;
-    }
-    return $self->{'from'};
+sub from {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'from'} = $value;
+  }
 
+  return $self->{'from'};
 }
 
 

modules/Bio/EnsEMBL/Mapper/Coordinate.pm

@@ -32,7 +32,7 @@ Post general queries to B<ensembl-dev@ebi.ac.uk>
 =cut
 
 package Bio::EnsEMBL::Mapper::Coordinate;
-use vars qw(@ISA);
+
 use strict;
 
 =head2 new
@@ -48,17 +48,20 @@ use strict;
   Status      Stable
 
 =cut
-  
- 
 
 sub new {
-  my($class, $id, $start, $end, $strand, $coord_system) = @_;
-
-  return bless { 'id' => $id,
-                 'start' => $start,
-                 'end'   => $end,
-                 'strand' => $strand,
-                 'coord_system' => $coord_system}, $class;
+  my ( $proto, $id, $start, $end, $strand, $coord_system ) = @_;
+
+  my $class = ref($proto) || $proto;
+
+  return
+    bless( { 'id'           => $id,
+             'start'        => $start,
+             'end'          => $end,
+             'strand'       => $strand,
+             'coord_system' => $coord_system
+           },
+           $class );
 }
 
 
@@ -74,9 +77,13 @@ sub new {
 
 =cut
 
-sub start{
-  my $self = shift;
-  $self->{'start'} = shift if(@_);
+sub start {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'start'} = $value;
+  }
+
   return $self->{'start'};
 }
 
@@ -93,13 +100,16 @@ sub start{
 
 =cut
 
-sub end{
-  my $self = shift;
-  $self->{'end'} = shift if(@_);
+sub end {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'end'} = $value;
+  }
+
   return $self->{'end'};
 }
 
-
 =head2 strand
 
   Arg  1      int $strand
@@ -112,13 +122,16 @@ sub end{
 
 =cut
 
-sub strand{
-  my $self = shift;
-  $self->{'strand'} = shift if(@_);
+sub strand {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'strand'} = $value;
+  }
+
   return $self->{'strand'};
 }
 
-
 =head2 id
 
   Arg  1      char|int $id
@@ -132,13 +145,16 @@ sub strand{
 
 =cut
 
-sub id{
-  my $self = shift;
-  $self->{'id'} = shift if(@_);
+sub id {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'id'} = $value;
+  }
+
   return $self->{'id'};
 }
 
-
 =head2 coord_system
 
   Arg  1      Bio::EnsEMBL::CoordSystem
@@ -151,8 +167,12 @@ sub id{
 =cut
 
 sub coord_system {
-  my $self = shift;
-  $self->{'coord_system'} = shift if(@_);
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'coord_system'} = $value;
+  }
+
   return $self->{'coord_system'};
 }
 
@@ -167,7 +187,8 @@ sub coord_system {
 =cut
 
 sub length {
-  my $self = shift;
+  my ($self) = @_;
+
   return $self->{'end'} - $self->{'start'} + 1;
 }
 

modules/Bio/EnsEMBL/Mapper/Gap.pm

@@ -31,10 +31,8 @@ Post general queries to B<ensembl-dev@ebi.ac.uk>
 =cut
 
 package Bio::EnsEMBL::Mapper::Gap;
-use vars qw(@ISA);
-use strict;
-
 
+use strict;
 
 =head2 new
 
@@ -50,14 +48,13 @@ use strict;
 =cut
 
 sub new {
-  my($class,$start, $end) = @_;
+  my ( $proto, $start, $end ) = @_;
 
-  return bless { 'start' => $start,
-                 'end'   => $end }, $class;
+  my $class = ref($proto) || $proto;
 
+  return bless( { 'start' => $start, 'end' => $end }, $class );
 }
 
-
 =head2 start
 
   Arg [1]    : (optional) int $start
@@ -71,15 +68,15 @@ sub new {
 
 =cut
 
-sub start{
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'start'} = $value;
-    }
-    return $self->{'start'};
+sub start {
+  my ( $self, $value ) = @_;
 
-}
+  if ( defined($value) ) {
+    $self->{'start'} = $value;
+  }
 
+  return $self->{'start'};
+}
 
 =head2 end
 
@@ -94,14 +91,15 @@ sub start{
 
 =cut
 
-sub end{
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'end'} = $value;
-    }
-    return $self->{'end'};
-}
+sub end {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'end'} = $value;
+  }
 
+  return $self->{'end'};
+}
 
 =head2 length
 
@@ -116,10 +114,9 @@ sub end{
 =cut
 
 sub length {
-  my $self = shift;
+  my ($self) = @_;
+
   return $self->{'end'} - $self->{'start'} + 1;
 }
 
-
-
 1;

modules/Bio/EnsEMBL/Mapper/IndelCoordinate.pm

@@ -31,8 +31,10 @@ Post general queries to B<ensembl-dev@ebi.ac.uk>
 =cut
 
 package Bio::EnsEMBL::Mapper::IndelCoordinate;
+
 use Bio::EnsEMBL::Mapper::Gap;
 use Bio::EnsEMBL::Mapper::Coordinate;
+
 use vars qw(@ISA);
 use strict;
 
@@ -52,17 +54,20 @@ use strict;
 =cut
 
 sub new {
-  my($class,$gap, $coordinate) = @_;
-
-  return bless{ 'start' => $coordinate->start,
-		'end'   => $coordinate->end,
-		'strand'=> $coordinate->strand,
-		'id'    => $coordinate->id,
-		'coord_system' => $coordinate->coord_system,
-		'gap_start' => $gap->start,
-		'gap_end'   => $gap->end
-	          }, $class;
-  
+  my ( $proto, $gap, $coordinate ) = @_;
+
+  my $class = ref($proto) || $proto;
+
+  return
+    bless( { 'start'        => $coordinate->start(),
+             'end'          => $coordinate->end(),
+             'strand'       => $coordinate->strand(),
+             'id'           => $coordinate->id(),
+             'coord_system' => $coordinate->coord_system(),
+             'gap_start'    => $gap->start(),
+             'gap_end'      => $gap->end()
+           },
+           $class );
 }
 
 =head2 gap_start
@@ -76,13 +81,14 @@ sub new {
 
 =cut
 
-sub gap_start{
-    my ($self,$value) = @_;
-    if (defined $value){
-	$self->{'gap_start'} = $value
-    }
-    return $self->{'gap_start'};
+sub gap_start {
+  my ( $self, $value ) = @_;
 
+  if ( defined($value) ) {
+    $self->{'gap_start'} = $value;
+  }
+
+  return $self->{'gap_start'};
 }
 
 =head2 gap_end
@@ -96,12 +102,14 @@ sub gap_start{
 
 =cut
 
-sub gap_end{
-    my ($self, $value) = @_;
-    if (defined $value){
-	$self->{'gap_end'} = $value;
-    }
-    return $self->{'gap_end'};
+sub gap_end {
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'gap_end'} = $value;
+  }
+
+  return $self->{'gap_end'};
 }
 
 =head2 gap_length
@@ -115,8 +123,10 @@ sub gap_end{
 
 =cut
 
-sub gap_length{
-    my $self = shift;
-    return $self->{'gap_end'} - $self->{'gap_start'} + 1;
+sub gap_length {
+  my ($self) = @_;
+
+  return $self->{'gap_end'} - $self->{'gap_start'} + 1;
 }
+
 1;

modules/Bio/EnsEMBL/Mapper/IndelPair.pm

@@ -33,18 +33,21 @@ Post general queries to B<ensembl-dev@ebi.ac.uk>
 =cut
 
 package Bio::EnsEMBL::Mapper::IndelPair;
+
 use vars qw(@ISA);
 use strict;
 
 @ISA = qw(Bio::EnsEMBL::Mapper::Pair);
 
 sub new {
-    my $caller = shift;
-    my $class = ref($caller) || $caller;
+  my ($proto, @args) = @_;
+
+  my $class = ref($proto) || $proto;
+
+  my $self = $class->SUPER::new(@args);    # create the Pair object
+  $self->{'indel'} = 1;                    # and add the Indel flag
 
-    my $self = $class->SUPER::new(@_); #create the Pair object
-    $self->{'indel'} = 1; #and add the Indel flag
-    return $self;
+  return $self;
 }
 
 1;

modules/Bio/EnsEMBL/Mapper/Pair.pm

@@ -33,15 +33,17 @@ Post general queries to B<ensembl-dev@ebi.ac.uk>
 =cut
 
 package Bio::EnsEMBL::Mapper::Pair;
-use vars qw(@ISA);
+
 use strict;
 
 sub new {
-  my($class,$from,$to,$ori) = @_;
+  my ( $proto, $from, $to, $ori ) = @_;
 
-  return bless {'from' => $from, 'to' => $to, 'ori' => $ori}, $class;
-}
+  my $class = ref($proto) || $proto;
 
+  return
+    bless( { 'from' => $from, 'to' => $to, 'ori' => $ori }, $class );
+}
 
 =head2 from, to
 
@@ -57,23 +59,24 @@ sub new {
 =cut
 
 sub to {
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'to'} = $value;
-    }
-    return $self->{'to'};
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'to'} = $value;
+  }
 
+  return $self->{'to'};
 }
 
 sub from {
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'from'} = $value;
-    }
-    return $self->{'from'};
+  my ( $self, $value ) = @_;
 
-}
+  if ( defined($value) ) {
+    $self->{'from'} = $value;
+  }
 
+  return $self->{'from'};
+}
 
 =head2 ori
 
@@ -89,11 +92,13 @@ sub from {
 =cut
 
 sub ori {
-   my ($self,$value) = @_;
-   if( defined $value) {
-      $self->{'ori'} = $value;
-    }
-    return $self->{'ori'};
+  my ( $self, $value ) = @_;
+
+  if ( defined($value) ) {
+    $self->{'ori'} = $value;
+  }
+
+  return $self->{'ori'};
 }
 
 1;

modules/Bio/EnsEMBL/Mapper/RangeRegistry.pm

@@ -78,20 +78,18 @@ use integer;
 =cut
 
 sub new {
-  my $caller = shift;
-  my $class = ref($caller) || $caller;
-  return bless {'registry' => {}}, $class;
-}
+  my ($proto) = @_;
+
+  my $class = ref($proto) || $proto;
 
+  return bless( { 'registry' => {} }, $class );
+}
 
 sub flush {
-  my $self = shift;
+  my ($self) = @_;
   $self->{'registry'} = {};
 }
 
-
-
-
 =head2 check_and_register
 
   Arg [1]    : string $id
@@ -134,134 +132,141 @@ my $START = 0;
 my $END   = 1;
 
 sub check_and_register {
-  my ($self, $id, $start, $end, $rstart,$rend) = @_;
+  my ( $self, $id, $start, $end, $rstart, $rend ) = @_;
 
-  $rstart = $start if(!defined($rstart));
-  $rend   = $end if(!defined($rend));
+  $rstart = $start if ( !defined($rstart) );
+  $rend   = $end   if ( !defined($rend) );
 
   #
   # Sanity checks
   #
-  if(!defined($id) || !defined($start) || !defined($end)) {
+  if ( !defined($id) || !defined($start) || !defined($end) ) {
     throw("ID, start, end arguments are required");
   }
 
-  if($start > $end) {
+  if ( $start > $end ) {
     throw("start argument must be less than end argument");
   }
 
-  if($rstart >$rend) {
-    throw("rend [$rstart] argument must be less than rend [$rend]  argument");
+  if ( $rstart > $rend ) {
+    throw(
+      "rend [$rstart] argument must be less than rend [$rend]  argument"
+    );
   }
 
-  if($rstart > $start) {
+  if ( $rstart > $start ) {
     throw("rstart must be less than or equal to start");
   }
 
-  if($rend < $end) {
+  if ( $rend < $end ) {
     throw("rend must be greater than or equal to end");
   }
 
-  my $reg  = $self->{'registry'};
+  my $reg = $self->{'registry'};
   my $list = $reg->{$id} ||= [];
 
   my @gap_pairs;
 
   my $len = scalar(@$list);
 
-  if($len == 0) {
-    #this is the first request for this id, return a gap pair for the
-    #entire range and register it as seen
-    $list->[0] = [$rstart,$rend];
-    return [[$rstart,$rend]];
+  if ( $len == 0 ) {
+    # this is the first request for this id, return a gap pair for the
+    # entire range and register it as seen
+    $list->[0] = [ $rstart, $rend ];
+    return [ [ $rstart, $rend ] ];
   }
 
   #####
-  #loop through the list of existing ranges recording any "gaps" where the
-  #existing range does not cover part of the requested range