fixed semantic zooming bugs but regression tests are failing

GMOD · Jan 20, 2010 · 81130a1 · 81130a1
1 parent c5cf69c
commit 81130a1
Show file tree

Hide file tree

Showing 3 changed files with 64 additions and 46 deletions.
diff --git a/lib/Bio/Graphics/Browser2/DataSource.pm b/lib/Bio/Graphics/Browser2/DataSource.pm
@@ -663,23 +663,34 @@ sub db_settings {
   # if the track contains the "database" option, then it is a symbolic name
   # that indicates a [symbolic_name:database] section in this file or the globals
   # file.
-  my ($symbolic_db_name,$section);
+  my ($symbolic_db_name,$section,$basename,$length);
 
-  if ($track =~ /:database$/) {
-      $section = $symbolic_db_name = $track;
-  } elsif ($self->setting($track=>'db_adaptor')) {
-      $section = $track;
+  if ($track =~ /(.+):(\d+)$/) {
+      $basename = $1;
+      $length   = $2;
   } else {
-      $symbolic_db_name   = $self->setting($track => 'database');
+      $basename = $track;
+      $length   = 1;
+  }
+
+
+  if ($basename =~ /:database$/) {
+      $section = $symbolic_db_name = $basename;
+  } elsif ($self->semantic_setting($basename=>'db_adaptor',$length)) {
+      $section = $basename;
+  } else {
+      $symbolic_db_name  = $self->semantic_setting($basename => 'database', $length);
       $symbolic_db_name ||= $self->fallback_setting('TRACK DEFAULTS' => 'database');
-      $section          = $symbolic_db_name   ? "$symbolic_db_name:database"   : $track;
+      $section          = $symbolic_db_name   
+	                    ? "$symbolic_db_name:database" 
+                            : $basename;
   }
 
-  my $adaptor = $self->fallback_setting($section => 'db_adaptor')
+  my $adaptor = $self->semantic_fallback_setting($section => 'db_adaptor', $length)
       or die "Unknown database defined for $section";
   eval "require $adaptor; 1" or die $@;
 
-  my $args    = $self->fallback_setting($section => 'db_args');
+  my $args    = $self->semantic_fallback_setting($section => 'db_args', $length);
   my @argv    = ref $args eq 'CODE'
         ? $args->()
 	: shellwords($args||'');
@@ -693,7 +704,8 @@ sub db_settings {
       s/\$ROOT/Bio::Graphics::Browser2->url_base/ge;
   }
 
-  if (defined (my $a = $self->fallback_setting($section => 'aggregators'))) {
+  if (defined (my $a = 
+	       $self->fallback_setting($section => 'aggregators'))) {
     my @aggregators = shellwords($a||'');
     push @argv,(-aggregator => \@aggregators);
   }
@@ -726,7 +738,6 @@ sub open_database {
   $track  ||= 'general';
 
   my ($dbid,$adaptor,@argv) = $self->db_settings($track);
-  warn "track = $track, dbid = $dbid";
   my $db                    = Bio::Graphics::Browser2::DataBase->open_database($adaptor,@argv);
 
   # do a little extra stuff the first time we see a new database
@@ -744,6 +755,12 @@ sub open_database {
   return $db;
 }
 
+sub default_dbid {
+    my $self = shift;
+    return $self->db2id($self->open_database);
+}
+
+
 sub search_options {
     my $self = shift;
     my $dbid = shift;

diff --git a/lib/Bio/Graphics/Browser2/Region.pm b/lib/Bio/Graphics/Browser2/Region.pm
@@ -142,9 +142,11 @@ sub search_features {
       $args->{-search_term} = $state->{name};
   }
 
-  warn "SEARCHING FOR ",join ' ',%$args if DEBUG; 
+  warn "SEARCHING FOR ",join ' ',%$args," in $db" if DEBUG; 
 
   my $features = $self->search_db($args);
+
+  warn "FOUND @$features " if $features && DEBUG;
   $self->features($features);
   return $features;
 }

diff --git a/lib/Bio/Graphics/Browser2/RegionSearch.pm b/lib/Bio/Graphics/Browser2/RegionSearch.pm
@@ -9,7 +9,7 @@ use Bio::Graphics::Browser2::Util 'shellwords';
 use Bio::Graphics::Browser2::Render::Slave::Status;
 use LWP::UserAgent;
 use HTTP::Request::Common 'POST';
-use Carp 'cluck';
+use Carp 'cluck','croak';
 use Storable 'nfreeze','thaw';
 
 use constant DEBUG => 0;
@@ -125,7 +125,7 @@ sub init_databases {
 
     # slightly roundabout way to get the default dbid, but this allows you
     # to handle anonymous (unnamed) databases consistently.
-    my $default_dbid = $self->source->db2id($self->source->open_database);
+    my $default_dbid = $self->source->default_dbid;
 
     # try to spread the work out as much as possible among the remote renderers
     my %remotes;
@@ -141,15 +141,7 @@ sub init_databases {
 	}
 
 	if (!$can_remote || $dbs{$dbid}{options} =~ /(?<!-)autocomplete/) {
-	    my $db = $source->open_database($dbid);
-	    $self->{local_dbs}{$db} ||= 
-		Bio::Graphics::Browser2::Region->new(
-		    { source     => $source,
-		      state      => $self->state,
-		      db         => $db,
-		      searchopts => $dbs{$dbid}{options}
-		    }
-		);
+	    $self->{local_dbs}{$dbid}++;
 	}
     }
 }
@@ -300,33 +292,36 @@ sub search_features_locally {
     my $local_dbs = $self->local_dbs;
     return unless $local_dbs;
 
-    warn "dbs = ",join ' ',keys %{$local_dbs};
+    warn "local dbs = ",join ' ',keys %{$local_dbs} if DEBUG;
 
-    my @dbs = $state->{dbid} ? $self->source->open_database($state->{dbid}) 
-                             : keys %{$local_dbs};
+    my @dbids = $state->{dbid} ? $state->{dbid} 
+	                       : keys %{$local_dbs};
 
     # the default database is treated slightly differently - it is searched
     # first, and finding a hit in it short-circuits other hits
-    my $default_db = $self->source->open_database();
+    my $default_dbid = $self->source->default_dbid;
 
-    for my $db (@dbs) {
-	my $dbid = $self->source->db2id($db);
+    @dbids = sort {$a eq $default_dbid ? -1 
+                  :$b eq $default_dbid ? +1
+                  :0} @dbids;
+
+    warn "dbs = @dbids" if DEBUG;
+
+    for my $dbid (@dbids) {
 	warn "searching in ",$dbid if DEBUG;
-	# allow explicit db_id to override cached list of local dbs
-	my $region   = $local_dbs->{$db} || 
-	    Bio::Graphics::Browser2::Region->new(
-						{ source     => $self->source,
-						  state      => $self->state,
-						  db         => $db,
-						  searchopts => $self->source->search_options($dbid),
-						  }
-						); 
+	my $region   = Bio::Graphics::Browser2::Region->new(
+	    { source     => $self->source,
+	      state      => $self->state,
+	      db         => $self->source->open_database($dbid),
+	      searchopts => $self->source->search_options($dbid),
+	    }
+	    ); 
  	my $features = $region->search_features($args);
 	next unless $features && @$features;
-	$self->add_dbid_to_features($db,$features);
+	$self->add_dbid_to_features($dbid,$features);
 	push @found,@$features;
 
-	if ($db eq $default_db) {
+	if ($dbid eq $default_dbid) {
 	    warn "hit @found in the default database, so short-circuiting" if DEBUG;
 	    $self->{shortcircuit}++;
 	    last;
@@ -474,11 +469,11 @@ Add a gbrowse_dbid() method to each of the features in the list.
 =cut
 
 sub add_dbid_to_features {
-    my $self           = shift;
-    my ($db,$features) = @_;
+    my $self             = shift;
+    my ($dbid,$features) = @_;
     return unless $features;
     my $source = $self->source;
-    my $dbid   = $source->db2id($db);
+    cluck "$dbid is not a dbid" if ref $dbid;
     $source->add_dbid_to_feature($_,$dbid) foreach @$features;
 }
 
@@ -560,9 +555,13 @@ sub features_by_prefix {
     # only local databases for now
     my $local_dbs = $self->local_dbs;
     my (@f,$count);
-    for my $region (values %{$local_dbs}) {
-	next unless $region->searchopts->{autocomplete};
-	my $db = $region->db;
+    my $source = $self->source;
+    for my $dbid (keys %{$local_dbs}) {
+	my $options = 
+	    Bio::Graphics::Browser2::Region->parse_searchopts($source->search_options($dbid));
+	next unless $options && $options->{autocomplete};
+
+	my $db = $source->open_database($dbid);
 	eval {
 	    my $i = $db->get_seq_stream(-name=>"${match}*",
 					-aliases=>1);