Commit c63c6d32 authored by Andy Yates's avatar Andy Yates
Browse files

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.
parent 09c04d62
......@@ -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
......
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();
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment