Support strands

modules/Bio/EnsEMBL/DBSQL/SliceAdaptor.pm

@@ -101,7 +101,7 @@ use Bio::EnsEMBL::CircularSlice;
 use Bio::EnsEMBL::Mapper;
 use Bio::EnsEMBL::LRGSlice;
 use Bio::EnsEMBL::Utils::Exception qw(throw deprecate warning stack_trace_dump);
-
+use Scalar::Util qw/looks_like_number/;
 
 @ISA = ('Bio::EnsEMBL::DBSQL::BaseAdaptor');
 
@@ -446,11 +446,16 @@ sub fetch_by_region {
 
   Arg [1]     : string $location
                 Ensembl formatted location. Can be a format like 
-                C<name:start-end>, C<name:start..end>, C<name:start> and
-                C<name>.
+                C<name:start-end>, C<name:start..end>, C<name:start:end>, 
+                C<name:start>, C<name>. We can also support strand 
+                specification as a +/- or 1/-1. 
+                
+                Location names must be separated by a C<:>. All others can be
+                separated by C<..>, C<:> or C<->.
   Arg[2]      : boolean $no_warnings
                 Suppress warnings from this method
   Example     : my $slice = $sa->fetch_by_toplevel_location('X:1-10000')
+                my $slice = $sa->fetch_by_toplevel_location('X:1-10000:-1')
   Description : Converts an Ensembl location/region into the sequence region
                 name, start and end and passes them onto C<fetch_by_region()>. 
                 The code assumes that the required slice is on the top level
@@ -469,10 +474,20 @@ sub fetch_by_toplevel_location {
 
   #cleanup any nomenclature like 1_000 or 1 000 or 1,000
   my $number_seps_regex = qr/\s+|,|_/;
+  my $separator = qr/(?:-|[.]{2}|\:)?/;
   my $number = qr/[0-9,_ E]+/xms;
+  my $strand = qr/[+-1]|-1/xms;
   
-  my $regex = qr/^(\w+) \s* :? \s* ($number)? (?:-|[.]{2})? ($number)?$/xms;
-  if(my ($seq_region_name, $start, $end) = $location =~ $regex) {
+  my $regex = qr/^(\w+) \s* :? \s* ($number)? $separator ($number)? $separator ($strand)? $/xms;
+
+  if(my ($seq_region_name, $start, $end, $strand) = $location =~ $regex) {
+    
+    if(defined $strand) {
+      if(!looks_like_number($strand)) {
+        $strand = ($strand eq '+') ? 1 : -1;
+      }
+    }
+    
     if(defined $start) {
       $start =~ s/$number_seps_regex//g; 
       if($start < 1) {
@@ -492,7 +507,7 @@ sub fetch_by_toplevel_location {
     }
     
     my $coord_system_name = 'toplevel';
-    my $slice = $self->fetch_by_region($coord_system_name, $seq_region_name, $start, $end, undef, undef, 0);
+    my $slice = $self->fetch_by_region($coord_system_name, $seq_region_name, $start, $end, $strand, undef, 0);
     return unless $slice;
     
     my $srl = $slice->seq_region_length();

modules/t/sliceAdaptor.t

@@ -468,6 +468,14 @@ test_toplevel_location('1: 100', 'chromosome', '1', 100, 246874334);
 test_toplevel_location('1:100..2_000_000_000', 'chromosome', '1', 100, 246874334);
 test_toplevel_location('1:100..2E9', 'chromosome', '1', 100, 246874334);
 
+#Try strands
+test_toplevel_location('1:1-1000:1', 'chromosome', '1', 1, 1000, 1);
+test_toplevel_location('1:1-1000:-1', 'chromosome', '1', 1, 1000, -1);
+test_toplevel_location('1:1-1000:+', 'chromosome', '1', 1, 1000, 1);
+test_toplevel_location('1:1-1000:-', 'chromosome', '1', 1, 1000, -1);
+test_toplevel_location('1:1-1000..1', 'chromosome', '1', 1, 1000, 1);
+test_toplevel_location('1:1-1000--1', 'chromosome', '1', 1, 1000, -1);
+
 dies_ok { $slice_adaptor->fetch_by_toplevel_location(); } 'Checking calling without a location fails';
 dies_ok { $slice_adaptor->fetch_by_toplevel_location('', 1); } 'Checking calling with a blank location fails';
 dies_ok { $slice_adaptor->fetch_by_toplevel_location('1:1_000_000_000..100', 1); } 'Checking calling with an excessive start throws an error';
@@ -475,7 +483,8 @@ ok(!defined $slice_adaptor->fetch_by_toplevel_location('wibble', 1), 'Checking w
 ok(!defined $slice_adaptor->fetch_by_toplevel_location('1:-100--50', 1), 'Checking with a bogus region with negative coords returns undef');
 
 sub test_toplevel_location {
-  my ($location, $cs_name, $seq_region_name, $start, $end) = @_;
+  my ($location, $cs_name, $seq_region_name, $start, $end, $strand) = @_;
+  $strand ||= 1;
   my $incoming_slice = $slice_adaptor->fetch_by_toplevel_location($location, 1);
   my $def = ok(defined $incoming_slice, "We expect a defined Slice for location: $location");
   SKIP : {
@@ -484,6 +493,7 @@ sub test_toplevel_location {
     is($incoming_slice->seq_region_name(), $seq_region_name, 'Checking seq region name for $location');
     is($incoming_slice->start(), $start, "Checking start for $location");
     is($incoming_slice->end(), $end, "Checking end for $location");
+    is($incoming_slice->strand(), $strand, "Checking strand for $location");
   }
   return;
 }