toplevel location code can now deal with excessively large regions and shrinks...

toplevel location code can now deal with excessively large regions and shrinks them down to size if possible or rejects them.

modules/Bio/EnsEMBL/DBSQL/SliceAdaptor.pm

@@ -442,6 +442,8 @@ sub fetch_by_region {
                 Ensembl formatted location. Can be a format like 
                 C<name:start-end>, C<name:start..end>, C<name:start> and
                 C<name>.
+  Arg[2]      : boolean $no_warnings
+                Suppress warnings from this method
   Example     : my $slice = $sa->fetch_by_toplevel_location('X:1-10000')
   Description : Converts an Ensembl location/region into the sequence region
                 name, start and end and passes them onto C<fetch_by_region()>. 
@@ -456,13 +458,38 @@ sub fetch_by_region {
 =cut
 
 sub fetch_by_toplevel_location {
-  my ($self, $location) = @_;
+  my ($self, $location, $no_warnings) = @_;
   throw 'You must specify a location' if ! $location;
-  my $regex = qr/^(\w+) :? (\d+)? (?:-|[.]{2})? (\d+)?/xms;
-  $location =~ s/\s+|,//g;
-  my ($seq_region_name, $start, $end) = $location =~ $regex;
-  my $coord_system_name = 'toplevel';
-  return $self->fetch_by_region($coord_system_name, $seq_region_name, $start, $end, undef, undef, 0);
+  
+  my $regex = qr/^(\w+) :? (\d+)? (?:-|[.]{2})? (\d+)?$/xms;
+  $location =~ s/\s+|,|_//g; #cleanup any nomenclature like 1_000 or 1 000 or 1,000
+  
+  if(my ($seq_region_name, $start, $end) = $location =~ $regex) {
+    if(defined $start && $start < 1) {
+      warning "Start was less than 1 (${start}) which is not allowed. Resetting to 1"  if ! $no_warnings;
+      $start = 1;
+    }
+    if(defined $end && $end < 1) {
+      throw "Cannot request negative or 0 end indexes through this interface. Given $end but expected something greater than 0";
+    }
+    
+    my $coord_system_name = 'toplevel';
+    my $slice = $self->fetch_by_region($coord_system_name, $seq_region_name, $start, $end, undef, undef, 0);
+    return unless $slice;
+    
+    my $srl = $slice->seq_region_length();
+    my $name = $slice->seq_region_name();
+    if(defined $start && $start > $srl) {
+      throw "Cannot request a slice whose start ($start) is greater than $srl for $name.";
+    }
+    if(defined $end && $end > $srl) {
+      warning "Requested end ($end) is greater than $srl for $name. Resetting to $srl" if ! $no_warnings;
+      $slice->{end} = $srl;
+    }
+    
+    return $slice;
+  }
+  return;
 }
 
 =head2 fetch_by_region_unique

modules/t/sliceAdaptor.t

 use strict;
 use warnings;
 
-use Test::More tests => 159;
+use Test::More;
 
 use Bio::EnsEMBL::Test::MultiTestDB;
 use Bio::EnsEMBL::DBSQL::SliceAdaptor;
@@ -465,14 +465,17 @@ test_toplevel_location('1: 1-1 000 000', 'chromosome', '1', 1, 1000000);
 test_toplevel_location('1: 1', 'chromosome', '1', 1, 246874334);
 test_toplevel_location('1: -10', 'chromosome', '1', 1, 10);
 test_toplevel_location('1: 100', 'chromosome', '1', 100, 246874334);
+test_toplevel_location('1:100..2_000_000_000', 'chromosome', '1', 100, 246874334);
 
 dies_ok { $slice_adaptor->fetch_by_toplevel_location(); } 'Checking calling without a location fails';
-dies_ok { $slice_adaptor->fetch_by_toplevel_location(''); } 'Checking calling with a blank location fails';
-ok(!defined $slice_adaptor->fetch_by_toplevel_location('wibble'), 'Checking with a bogus region returns undef');
+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';
+ok(!defined $slice_adaptor->fetch_by_toplevel_location('wibble', 1), 'Checking with a bogus region returns undef');
+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 $incoming_slice = $slice_adaptor->fetch_by_toplevel_location($location);
+  my $incoming_slice = $slice_adaptor->fetch_by_toplevel_location($location, 1);
   my $def = ok(defined $incoming_slice, "Slice is defined for $location");
   SKIP : {
     skip 'Incoming slice is undefined', 5 if ! $def;
@@ -501,3 +504,5 @@ sub print_features {
     debug("  $start-$end($strand)");
   }
 }
+
+done_testing();