[ENSCORESW-293]. Support locations other than toplevel when giving a location

modules/Bio/EnsEMBL/DBSQL/SliceAdaptor.pm

@@ -463,6 +463,8 @@ sub fetch_by_region {
                 separated by C<..>, C<:> or C<->.
   Arg[2]      : boolean $no_warnings
                 Suppress warnings from this method
+  Arg[3]      : boolean $no_fuzz
+                Stop fuzzy matching of sequence regions from occuring
   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
@@ -471,15 +473,56 @@ sub fetch_by_region {
                 coordinate system. The code assumes that location formatting
                 is not perfect and will perform basic cleanup before parsing.
   Returntype  : Bio::EnsEMBL::Slice
-  Exceptions  : If $location is false otherwise see C<fetch_by_region()>
+  Exceptions  : If $location is false otherwise see C<fetch_by_location()>
+                or C<fetch_by_region()>
   Caller      : General
   Status      : Beta
 
 =cut
 
 sub fetch_by_toplevel_location {
-  my ($self, $location, $no_warnings) = @_;
+  my ($self, $location, $no_warnings, $no_fuzz) = @_;
+  return $self->fetch_by_location($location, 'toplevel', undef, $no_warnings, $no_fuzz);
+}
+
+=head2 fetch_by_location
+
+  Arg [1]     : string $location
+                Ensembl formatted location. Can be a format like 
+                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]      : String $coord_system_name
+                The coordinate system to retrieve
+  Arg[3]      : String $coord_system_version
+                Optional parameter. Version of the coordinate system to fetch
+  Arg[4]      : boolean $no_warnings
+                Suppress warnings from this method
+  Arg[5]      : boolean $no_fuzz
+                Stop fuzzy matching of sequence regions from occuring
+  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
+                coordinate system. The code assumes that location formatting
+                is not perfect and will perform basic cleanup before parsing.
+  Returntype  : Bio::EnsEMBL::Slice
+  Exceptions  : If $location or coordinate system is false otherwise 
+                see C<fetch_by_region()>
+  Caller      : General
+  Status      : Beta
+
+=cut
 
+sub fetch_by_location {
+  my ($self, $location, $coord_system_name, $coord_system_version, $no_warnings, $no_fuzz) = @_;
+  
+  throw "No coordinate system name specified" unless $coord_system_name;
+  
   my ($seq_region_name, $start, $end, $strand) = $self->parse_location_to_values($location, $no_warnings);
 
   if(! $seq_region_name) {
@@ -490,8 +533,7 @@ sub fetch_by_toplevel_location {
     throw "Cannot request a slice whose start is greater than its end. Start: $start. End: $end";
   }
   
-  my $coord_system_name = 'toplevel';
-  my $slice = $self->fetch_by_region($coord_system_name, $seq_region_name, $start, $end, $strand, undef, 0);
+  my $slice = $self->fetch_by_region($coord_system_name, $seq_region_name, $start, $end, $strand, $coord_system_version, $no_fuzz);
   return unless $slice;
   
   my $srl = $slice->seq_region_length();

modules/t/sliceAdaptor.t

@@ -482,6 +482,19 @@ dies_ok { $slice_adaptor->fetch_by_toplevel_location('1:1_000_000_000..100', 1);
 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');
 
+# Try without toplevel_location
+{
+  my $location = 'AL359765.6.1.13780:2-100';
+  
+  note "Testing $location by asking for seqlevel";
+  my $seqlevel_slice = $slice_adaptor->fetch_by_location($location, 'seqlevel');
+  test_slice($location, $seqlevel_slice, 'contig', 'AL359765.6.1.13780', 2, 100, 1);
+  
+  note "Testing $location by asking for contig";
+  my $contig_slice = $slice_adaptor->fetch_by_location($location, 'contig');
+  test_slice($location, $contig_slice, 'contig', 'AL359765.6.1.13780', 2, 100, 1);
+}
+
 {
   #Non standard name check
   my ($name, $start, $end, $strand) = $slice_adaptor->parse_location_to_values('GL21446.1');
@@ -493,13 +506,19 @@ ok(!defined $slice_adaptor->fetch_by_toplevel_location('1:-100--50', 1), 'Checki
 
 sub test_toplevel_location {
   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");
+  test_slice($location, $incoming_slice, $cs_name, $seq_region_name, $start, $end, $strand);
+  return;
+}
+
+sub test_slice {
+  my ($location, $incoming_slice, $cs_name, $seq_region_name, $start, $end, $strand) = @_;
+  $strand ||= 1;
+  my $def = ok(defined $incoming_slice, "We expect a defined Slice for $location");
   SKIP : {
     skip 'Incoming slice is undefined', 5 if ! $def;
     is($incoming_slice->coord_system_name(), $cs_name, "Checking coord system name for $location");
-    is($incoming_slice->seq_region_name(), $seq_region_name, 'Checking seq region name for $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");