From 3a24ac2ed1c679e1427704e59f23c36dec506fdd Mon Sep 17 00:00:00 2001
From: Lincoln Stein <lincoln.stein@gmail.com>
Date: Wed, 14 Feb 2007 23:54:39 +0000
Subject: [PATCH] more progress on the inside side of Render; passes all
 regression tests; work on Render::HTML needs to start

---
 cgi-bin/gbrowse_img.PLS                   |   4 +-
 conf/plugins/TestFinder.pm                |  18 +
 lib/Bio/Graphics/Browser/Plugin.pm        |  26 +-
 libnew/Bio/Graphics/Browser.pm            |   6 +-
 libnew/Bio/Graphics/Browser/DataSource.pm |  12 +
 libnew/Bio/Graphics/Browser/Render.pm     | 391 ++++++++++++++++++++--
 libnew/Bio/Graphics/Browser/Session.pm    |   2 +-
 t/02.rearchitecture.t                     |   8 +-
 t/03.render.t                             | 133 +++++++-
 t/testdata/conf/GBrowse.conf              |   4 +-
 t/testdata/conf/volvox_final.conf         |   2 +-
 t/testdata/data/volvox/volvox.gff         |  60 ++++
 12 files changed, 595 insertions(+), 71 deletions(-)
 create mode 100644 conf/plugins/TestFinder.pm

diff --git a/cgi-bin/gbrowse_img.PLS b/cgi-bin/gbrowse_img.PLS
index 95bcf64dd..a4ce7c264 100644
--- a/cgi-bin/gbrowse_img.PLS
+++ b/cgi-bin/gbrowse_img.PLS
@@ -45,7 +45,7 @@ print OUT "use lib '$OPTIONS{LIB}';\n" if defined $OPTIONS{LIB};
 # In the following, perl variables are not expanded during extraction.
 
 print OUT <<'!NO!SUBS!';
-# $Id: gbrowse_img.PLS,v 1.30 2005-12-09 22:19:09 mwz444 Exp $
+# $Id: gbrowse_img.PLS,v 1.31 2007-02-14 23:54:39 lstein Exp $
 
 use strict;
 use CGI qw(param redirect header start_html end_html
@@ -269,7 +269,7 @@ elsif ($image_class =~ /SVG/) {
   } else {
     print_cached (
 		  $newpagecache,
-		  header('image/svg-xml'),
+		  header('image/svg+xml'),
 		  $img->svg
 		 );
   }
diff --git a/conf/plugins/TestFinder.pm b/conf/plugins/TestFinder.pm
new file mode 100644
index 000000000..831f69c18
--- /dev/null
+++ b/conf/plugins/TestFinder.pm
@@ -0,0 +1,18 @@
+package Bio::Graphics::Browser::Plugin::TestFinder;
+
+use strict;
+use warnings;
+use base 'Bio::Graphics::Browser::Plugin';
+
+sub name { 'TypeFinder'}
+
+# return all objects of type 'motif'
+sub find {
+  my $self     = shift;
+  my $db       = $self->database;
+  my $query    = $self->page_settings->{name} or return;
+  my @features = $db->features(-type=>$query);
+  return \@features;
+}
+
+1;
diff --git a/lib/Bio/Graphics/Browser/Plugin.pm b/lib/Bio/Graphics/Browser/Plugin.pm
index 7f4a47f22..1b26061d5 100644
--- a/lib/Bio/Graphics/Browser/Plugin.pm
+++ b/lib/Bio/Graphics/Browser/Plugin.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Browser::Plugin;
-# $Id: Plugin.pm,v 1.14 2006-08-21 15:36:32 sheldon_mckay Exp $
+# $Id: Plugin.pm,v 1.15 2007-02-14 23:54:39 lstein Exp $
 # base class for plugins for the Generic Genome Browser
 
 =head1 NAME
@@ -382,21 +382,18 @@ described in this section.
 
 =over 4
 
-=item $features = $self->find($segment);
+=item $features = $self->find();
 
-The find() method will be passed a Bio::Das::SegmentI segment object,
-as described earlier for the dump() method.  Your code should search
-the segment for features of interest, and return an arrayref of
-Bio::SeqFeatureI objects (see L<Bio::SeqFeatureI>).  These synthetic
-feature objects should indicate the position, name and type of the
-features found.
+The find() method is called to search for features of interest. It
+should return an arrayref of Bio::SeqFeatureI objects (see
+L<Bio::SeqFeatureI>).  These synthetic feature objects should indicate
+the position, name and type of the features found.
 
-Depending on the type of find you are performing, you might search the
-preexisting features on the segment for matches, or create your own
-features from scratch in the way that the annotator plugins do.  You
-may choose to ignore the passed segment and perform the search on the
-entire database, which you can obtain using the database() method
-call.
+Depending on the type of find you are performing, you might search for
+preexisting features on the currently named segment for matches, or
+create your own features from scratch in the way that the annotator
+plugins do.  In most cases you'll do the search on the entire
+database, which you can obtain using the database() method call.
 
 To create features from scratch I suggest you use either
 Bio::Graphics::Feature, or Bio::SeqFeature::Generic to generate the
@@ -412,7 +409,6 @@ case, a gene ontology term:
 
   sub find {
      my $self = shift;
-     my $segment  = shift;  # we ignore this!
      my $config   = $self->configuration;
      my $query    = $config->{query} or return undef;  # PROMPT FOR INPUT
      my $database = $self->database;
diff --git a/libnew/Bio/Graphics/Browser.pm b/libnew/Bio/Graphics/Browser.pm
index aac31827d..7285a175a 100644
--- a/libnew/Bio/Graphics/Browser.pm
+++ b/libnew/Bio/Graphics/Browser.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Browser;
-# $Id: Browser.pm,v 1.3 2007-01-05 22:34:04 lstein Exp $
+# $Id: Browser.pm,v 1.4 2007-02-14 23:54:39 lstein Exp $
 # Globals and utilities for GBrowse and friends
 
 use strict;
@@ -137,7 +137,7 @@ sub url_fetch_max_size     { shift->setting(general=>'url_fetch_max_size')     }
 sub session_driver         { shift->setting(general=>'session driver') || 'driver:file;serializer:default' }
 sub session_args    {
   my $self = shift;
-  my %args = shellwords($self->setting(general=>'session_args'));
+  my %args = shellwords($self->setting(general=>'session args'));
   return \%args if %args;
   my ($url,$path) = $self->tmpdir('sessions');
   return {Directory=>$path};
@@ -204,7 +204,7 @@ sub update_data_source {
 }
 
 ## methods for dealing with the session
-sub new_session {
+sub session {
   my $self = shift;
   my $id   = shift;
   return Bio::Graphics::Browser::Session->new($self->session_driver,
diff --git a/libnew/Bio/Graphics/Browser/DataSource.pm b/libnew/Bio/Graphics/Browser/DataSource.pm
index 32908879b..8c5ac2c5d 100644
--- a/libnew/Bio/Graphics/Browser/DataSource.pm
+++ b/libnew/Bio/Graphics/Browser/DataSource.pm
@@ -367,4 +367,16 @@ sub make_link {
   croak "Do not call make_link() on the DataSource. Call it on the Render object";
 }
 
+# this is an aggregator-aware way of retrieving all the named types
+sub _all_types {
+  my $self  = shift;
+  my $db    = shift;
+  return $self->{_all_types} if exists $self->{_all_types}; # memoize
+  my %types = map {$_=>1} (
+			   (map {$_->get_method}        eval {$db->aggregators}),
+			   (map {$self->label2type($_)} $self->labels)
+			   );
+  return $self->{_all_types} = \%types;
+}
+
 1;
diff --git a/libnew/Bio/Graphics/Browser/Render.pm b/libnew/Bio/Graphics/Browser/Render.pm
index d7bef32dc..7db17d3ce 100644
--- a/libnew/Bio/Graphics/Browser/Render.pm
+++ b/libnew/Bio/Graphics/Browser/Render.pm
@@ -6,8 +6,8 @@ use Bio::Graphics::Browser::I18n;
 use Bio::Graphics::Browser::PluginSet;
 use Bio::Graphics::Browser::UploadSet;
 use Bio::Graphics::Browser::RemoteSet;
-use Text::ParseWords 'shellwords';
-use CGI qw(param request_method);
+use Text::ParseWords ();
+use CGI qw(param request_method header url);
 use Carp 'croak';
 
 use constant VERSION => 2.0;
@@ -86,7 +86,7 @@ sub segments {
       $self->{segments} = \@_;
     }
   }
-  return @$d;
+  return wantarray ? @$d : $d;
 }
 
 sub plugins {
@@ -104,12 +104,50 @@ sub plugins {
 ###################################################################################
 sub run {
   my $self = shift;
-  $self->update_state();
+  my $fh   = shift || \*STDOUT;
+  my $old_fh = select($fh);
+
   $self->init_database();
   $self->init_plugins();
   $self->init_remote_sources();
-  $self->render();
+  $self->update_state();
+  my $features = $self->fetch_features;
+  $self->render($features);
   $self->clean_up();
+  select($old_fh);
+}
+
+sub render {
+  my $self           = shift;
+  my $features       = shift;
+
+  # NOTE: these handle_* methods will return true
+  # if they want us to exit before printing the header
+  $self->handle_plugins()   && return;
+  $self->handle_downloads() && return;
+  $self->handle_uploads()   && return;
+
+  $self->render_header();
+  $self->render_body($features);
+}
+
+sub render_header {
+  my $self    = shift;
+  my $session = $self->session;
+  my $cookie = CGI::Cookie->new(-name => $CGI::Session::NAME,
+				-value => $session->id,
+				-path   => url(-absolute=>1),
+				-expires => $self->globals->remember_settings_time
+				);
+  print header(-cookie  => $cookie,
+	       -charset => $self->tr('CHARSET')
+	      );
+}
+
+sub render_body {
+  my $self     = shift;
+  my $features = shift;
+  print "rendering ",scalar @$features," features";
 }
 
 sub init_database {
@@ -138,10 +176,11 @@ sub init_database {
   $DB{$key};
 }
 
+# ========================= plugins =======================
 sub init_plugins {
   my $self        = shift;
   my $source      = $self->data_source->name;
-  my @plugin_path = shellwords($self->data_source->globals->plugin_path);
+  my @plugin_path = $self->shellwords($self->data_source->globals->plugin_path);
 
   my $plugins = $PLUGINS{$source} 
     ||= Bio::Graphics::Browser::PluginSet->new($self->data_source,$self->state,@plugin_path);
@@ -151,6 +190,51 @@ sub init_plugins {
   $plugins;
 }
 
+# for activating plugins
+sub plugin_action {
+  my $self = shift;
+  my $action;
+
+  # the logic of this is obscure to me, but seems to have to do with activating plugins
+  # via the URL versus via fill-out forms, which may go through a translation.
+  if (param('plugin_do')) {
+    $action = $self->tr(param('plugin_do')) || $self->tr('Go');
+  }
+  $action ||= param('plugin_action');
+  return $action;
+}
+
+sub current_plugin {
+  my $self = shift;
+  my $plugin_name = param('plugin') or return;
+  $self->plugins->plugin($plugin_name);
+}
+
+sub plugin_find {
+  my $self = shift;
+  my ($plugin,$search_string) = @_;
+
+  my $settings = $self->state;
+  my $plugin_name = $plugin->name;
+  my $results = $plugin->can('auto_find') && defined $search_string
+              ? $plugin->auto_find($search_string)
+              : $plugin->find();
+  return unless $results;
+  return unless @$results;
+
+  $settings->{name} = defined($search_string) ? $self->tr('Plugin_search_1',$search_string,$plugin_name)
+                                              : $self->tr('Plugin_search_2',$plugin_name);
+  $self->write_auto($results);
+  return $results;
+}
+
+sub handle_plugins {
+  my $self = shift;
+  warn "handle_plugins() not implemented\n";
+  return;
+}
+
+#======================== remote sources ====================
 sub init_remote_sources {
   my $self = shift;
   my $uploaded_sources = Bio::Graphics::Browser::UploadSet->new($self->data_source,$self->state);
@@ -160,11 +244,6 @@ sub init_remote_sources {
   $uploaded_sources && $remote_sources;
 }
 
-sub render {
-  my $self = shift;
-  croak 'Please call render() for a subclass of Bio::Graphics::Browser::Render';
-}
-
 sub clean_up {
   my $self = shift;
 }
@@ -175,6 +254,26 @@ sub fatal_error {
   croak 'Please call fatal_error() for a subclass of Bio::Graphics::Browser::Render';
 }
 
+sub write_auto {
+  my $self = shift;
+  my $result_set = shift;
+  warn "write_auto() not implemented\n";
+}
+
+sub handle_downloads {
+  my $self = shift;
+  warn "handle_downloads() not implemented\n";
+  # return 1 to exit
+  return;
+}
+
+sub handle_uploads {
+  my $self = shift;
+  warn "handle_uploads() not implemented\n";
+  # return 1 to exit
+  return;
+}
+
 
 ###################################################################################
 #
@@ -182,11 +281,15 @@ sub fatal_error {
 #
 ###################################################################################
 
+sub globals {
+  my $self = shift;
+  $self->data_source->globals;
+}
+
 # the setting method either calls the DATA_SOURCE's global_setting or setting(), depending
 # on the number of arguments used.
 sub setting {
   my $self = shift;
-
   my $data_source = $self->data_source;
 
   if (@_ == 1) {
@@ -208,7 +311,7 @@ sub db_settings {
   my $args    = $self->setting('db_args');
   my @argv = ref $args eq 'CODE'
         ? $args->()
-	: shellwords($args||'');
+	: $self->shellwords($args||'');
 
   # for compatibility with older versions of the browser, we'll hard-code some arguments
   if (my $adaptor = $self->setting('adaptor')) {
@@ -232,7 +335,7 @@ sub db_settings {
   }
 
   if (defined (my $a = $self->setting('aggregators'))) {
-    my @aggregators = shellwords($a||'');
+    my @aggregators = $self->shellwords($a||'');
     push @argv,(-aggregator => \@aggregators);
   }
 
@@ -250,7 +353,6 @@ sub update_state {
   my $state = $self->state;
   $self->default_state if !%$state or param('reset');
   $self->update_state_from_cgi;
-  $self->fetch_segments();
 }
 
 sub default_state {
@@ -307,6 +409,8 @@ sub update_state_from_cgi {
   $self->update_region($state);
   $self->update_external_annotations($state);
   $self->update_section_visibility($state);
+  $self->update_external_sources();
+  $self->update_plugins();
 }
 
 sub update_options {
@@ -435,6 +539,9 @@ sub update_coordinates {
     $state->{name} = "$state->{ref}:$state->{start}..$state->{stop}";
     param(name => $state->{name});
   }
+  elsif (param('name')) {
+    $state->{name} = param('name');
+  }
 
   return $position_updated;
 }
@@ -529,7 +636,7 @@ sub update_region {
   my $self  = shift;
   my $state = shift || $self->state;
 
-  if (my @features = shellwords(param('h_feat'))) {
+  if (my @features = $self->shellwords(param('h_feat'))) {
     $state->{h_feat} = {};
     for my $hilight (@features) {
       last if $hilight eq '_clear_';
@@ -538,7 +645,7 @@ sub update_region {
     }
   }
 
-  if (my @regions = shellwords(param('h_region'))) {
+  if (my @regions = $self->shellwords(param('h_region'))) {
     $state->{h_region} = [];
     foreach (@regions) {
       last if $_ eq '_clear_';
@@ -587,12 +694,225 @@ sub update_section_visibility {
   }
 }
 
+sub update_external_sources {
+  my $self = shift;
+  $self->remote_sources->set_sources([param('eurl')]) if param('eurl');
+}
+
+sub update_plugins {
+  my $self = shift;
+  $self->plugins->configure($self->db,$self->state,$self->session);
+}
+
+# fetch_segments() actually should be deprecated, but it is stuck here
+# because it is convenient for the regression tests
 sub fetch_segments {
+  my $self = shift;
+  my $features = $self->fetch_features;
+  my $segments = $self->features2segments($features);
+  $self->plugins->set_segments($segments) if $self->plugins;
+  $self->segments($segments);
+}
+
+sub features2segments {
+  my $self     = shift;
+  my $features = shift;
+  my $refclass = $self->setting('reference class');
+  my $db       = $self->db;
+  my @segments = map {
+    my $version = $_->isa('Bio::SeqFeatureI') ? undef : $_->version;
+    $db->segment(-class => $refclass,
+		 -name  => $_->ref,
+		 -start => $_->start,
+		 -stop  => $_->end,
+		 -absolute => 1,
+		 defined $version ? (-version => $version) : ())} @$features;
+  return \@segments;
+}
+
+sub fetch_features {
   my $self  = shift;
   my $db    = $self->db;
   my $state = $self->state;
 
-  # do something
+  # avoid doing anything if no parameters and no autosearch set
+  return if $self->setting('no autosearch') && !param();
+
+  return unless defined $state->{name};
+  my $features;
+
+  # run any "find" plugins
+  my $plugin_action  = $self->plugin_action || '';
+  my $current_plugin = $self->current_plugin;
+  if ($current_plugin && $plugin_action eq $self->tr('Find') || $plugin_action eq 'Find') {
+    $features = $self->plugin_find($current_plugin,$state->{name});
+  }
+  else {
+    $features = $self->search_db($state->{name});
+  }
+  return $features;
+}
+
+sub search_db {
+  my $self = shift;
+  my $name = shift;
+
+  my $db    = $self->db;
+
+  my ($ref,$start,$stop,$class) = $self->parse_feature_name($name);
+
+  my $features = $self->lookup_features($ref,$start,$stop,$class,$name);
+  return $features;
+}
+
+sub lookup_features {
+  my $self  = shift;
+  my ($name,$start,$stop,$class,$literal_name) = @_;
+  my $refclass = $self->setting('reference class') || 'Sequence';
+
+  my $db     = $self->db;
+  my $divisor = $self->setting('unit_divider') || 1;
+  $start *= $divisor if defined $start;
+  $stop  *= $divisor if defined $stop;
+
+  # automatic classes to try
+  my @classes = $class ? ($class) : (split /\s+/,$self->setting('automatic classes')||'');
+
+  my $features;
+
+ SEARCHING:
+  for my $n ([$name,$class,$start,$stop],[$literal_name,$refclass,undef,undef]) {
+
+    my ($name_to_try,$class_to_try,$start_to_try,$stop_to_try) = @$n;
+
+    # first try the non-heuristic search
+    $features  = $self->_feature_get($db,$name_to_try,$class_to_try,$start_to_try,$stop_to_try);
+    last SEARCHING if @$features;
+
+    # heuristic fetch. Try various abbreviations and wildcards
+    my @sloppy_names = $name_to_try;
+    if ($name_to_try =~ /^([\dIVXA-F]+)$/) {
+      my $id = $1;
+      foreach (qw(CHROMOSOME_ Chr chr)) {
+	my $n = "${_}${id}";
+	push @sloppy_names,$n;
+      }
+    }
+
+    # try to remove the chr CHROMOSOME_I
+    if ($name_to_try =~ /^(chromosome_?|chr)/i) {
+      (my $chr = $name_to_try) =~ s/^(chromosome_?|chr)//i;
+      push @sloppy_names,$chr;
+    }
+
+    # try the wildcard  version, but only if the name is of significant length
+    # IMPORTANT CHANGE: we used to put stars at the beginning and end, but this killed performance!
+    push @sloppy_names,"$name_to_try*" if length $name_to_try > 3 and $name_to_try !~ /\*$/;
+
+    for my $n (@sloppy_names) {
+      for my $c (@classes) {
+	$features = $self->_feature_get($db,$n,$c,$start_to_try,$stop_to_try);
+	last SEARCHING if @$features;
+      }
+    }
+
+  }
+
+  unless (@$features) {
+    # if we get here, try the keyword search
+    $features = $self->_feature_keyword_search($literal_name);
+  }
+
+  return $features;
+}
+
+sub _feature_get {
+  my $self = shift;
+  my ($db,$name,$class,$start,$stop) = @_;
+
+  my $refclass = $self->setting('reference class') || 'Sequence';
+  $class ||= $refclass;
+
+  my @argv = (-name  => $name);
+  push @argv,(-class => $class) if defined $class;
+  push @argv,(-start => $start) if defined $start;
+  push @argv,(-end   => $stop)  if defined $stop;
+
+  my @features;
+  @features  = grep {$_->length} $db->get_feature_by_name(@argv)   if !defined($start) && !defined($stop);
+  @features  = grep {$_->length} $db->get_features_by_alias(@argv) if !@features &&
+    !defined($start) &&
+      !defined($stop) &&
+	$db->can('get_features_by_alias');
+
+  @features  = grep {$_->length} $db->segment(@argv)               if !@features && $name !~ /[*?]/;
+  return [] unless @features;
+
+  # Deal with multiple hits.  Winnow down to just those that
+  # were mentioned in the config file.
+  my $types = $self->data_source->_all_types($db);
+  my @filtered = grep {
+    my $type    = $_->type;
+    my $method  = eval {$_->method} || '';
+    my $fclass  = eval {$_->class}  || '';
+    $type eq 'Segment'      # ugly stuff accomodates loss of "class" concept in GFF3
+      || $type eq 'region'
+	|| $types->{$type}
+	  || $types->{$method}
+	    || !$fclass
+	      || $fclass eq $refclass
+		|| $fclass eq $class;
+  } @features;
+
+  # consolidate features that have same name and same reference sequence
+  # and take the largest one.
+  my %longest;
+  foreach (@filtered) {
+    my $n = $_->display_name.$_->abs_ref.(eval{$_->version}||'').(eval{$_->class}||'');
+    $longest{$n} = $_ if !defined($longest{$n}) || $_->length > $longest{$n}->length;
+  }
+
+  return [values %longest];
+}
+
+sub _feature_keyword_search {
+  my $self       = shift;
+  my $searchterm = shift;
+
+  # if they wanted something specific, don't give them non-specific results.
+  return if $searchterm =~ /^[\w._-]+:/;
+
+  # Need to untaint the searchterm.  We are very lenient about
+  # what is accepted here because we wil be quote-metaing it later.
+  $searchterm =~ /([\w .,~!@\#$%^&*()-+=<>?\/]+)/;
+  $searchterm = $1;
+
+  my $db = $self->db;
+  my $max_keywords = $self->setting('max keyword results');
+  my @matches;
+  if ($db->can('search_attributes')) {
+    my @attribute_names = $self->shellwords ($self->setting('search attributes'));
+    @attribute_names = ('Note') unless @attribute_names;
+    @matches = $db->search_attributes($searchterm,\@attribute_names,$max_keywords);
+  } elsif ($db->can('search_notes')) {
+    @matches = $db->search_notes($searchterm,$max_keywords);
+  }
+
+  my @results;
+  for my $r (@matches) {
+    my ($name,$description,$score) = @$r;
+    my ($seg) = $db->segment($name) or next;
+    push @results,Bio::Graphics::Feature->new(-name   => $name,
+					      -class  => $name->class,
+					      -type   => $description,
+					      -score  => $score,
+					      -ref    => $seg->abs_ref,
+					      -start  => $seg->abs_start,
+					      -end    => $seg->abs_end,
+					      -factory=> $db);
+
+  }
+  return \@results;
 }
 
 ##################################################################3
@@ -601,7 +921,7 @@ sub fetch_segments {
 #
 ##################################################################3
 
-sub overview_ration {
+sub overview_ratio {
   my $self = shift;
   return 1.0;   # for now
 }
@@ -818,15 +1138,9 @@ sub i18n_style {
   %lang_options;
 }
 
-sub tra {
-  my $self = shift;
-  my $lang = $self->language or return @_;
-  $lang->tr(@_);
-}
-
-####################################333
+####################################
 # Unit conversion
-####################################333
+####################################
 # convert bp into nice Mb/Kb units
 sub unit_label {
   my $self = shift;
@@ -920,8 +1234,31 @@ sub parse_feature_name {
     $class = $1;
     $ref   = $2;
   }
+
+  else {
+    $ref = $name;
+  }
   return ($ref,$start,$stop,$class);
 }
 
+sub split_labels {
+  my $self = shift;
+  map {/^(http|ftp|das)/ ? $_ : split /[+-]/} @_;
+}
+
+sub shellwords {
+  my $self = shift;
+  return unless @_;
+  return Text::ParseWords::shellwords(@_);
+}
+
+
+########## note: "sub tr()" makes emacs' syntax coloring croak, so place this function at end
+sub tr {
+  my $self = shift;
+  my $lang = $self->language or return @_;
+  $lang->tr(@_);
+}
+
 1;
 
diff --git a/libnew/Bio/Graphics/Browser/Session.pm b/libnew/Bio/Graphics/Browser/Session.pm
index 16c6b8c7a..d9e0da262 100644
--- a/libnew/Bio/Graphics/Browser/Session.pm
+++ b/libnew/Bio/Graphics/Browser/Session.pm
@@ -18,7 +18,7 @@ sub new {
 
 sub flush {
   my $self = shift;
-  $self->{session}->flush or warn "session error: ",$self->{session}->errstr;
+  $self->{session}->flush;
 }
 
 sub id {
diff --git a/t/02.rearchitecture.t b/t/02.rearchitecture.t
index 600b8b69b..05566ef4d 100644
--- a/t/02.rearchitecture.t
+++ b/t/02.rearchitecture.t
@@ -9,6 +9,7 @@ use Module::Build;
 use Bio::Root::IO;
 use File::Path 'rmtree';
 use FindBin '$Bin';
+use File::Spec;
 
 use constant TEST_COUNT => 100;
 use constant CONF_FILE  => "$Bin/testdata/conf/GBrowse.conf";
@@ -28,7 +29,6 @@ BEGIN {
 chdir $Bin;
 use lib "$Bin/../libnew";
 use Bio::Graphics::Browser;
-use Bio::Graphics::Browser::Render;
 
 my $globals = Bio::Graphics::Browser->new(CONF_FILE);
 ok($globals);
@@ -38,7 +38,7 @@ ok($globals->config_base,'./testdata/conf');
 ok($globals->htdocs_base,'./testdata/htdocs/gbrowse');
 ok($globals->url_base,'/gbrowse');
 
-ok($globals->plugin_path,'./testdata/conf/plugins');
+ok($globals->plugin_path,'./testdata/conf/../../../conf/plugins');
 ok($globals->language_path,'./testdata/conf/languages');
 ok($globals->templates_path,'./testdata/conf/templates');
 ok($globals->moby_path,'./testdata/conf/MobyServices');
@@ -128,8 +128,8 @@ ok($source->html1,'This is inherited');
 ok($source->html2,'This is overridden');
 
 # Do semantic settings work?
-ok($source->setting(general => 'plugins'),'Aligner RestrictionAnnotator ProteinDumper');
-ok($source->setting('plugins'),'Aligner RestrictionAnnotator ProteinDumper');
+ok($source->setting(general => 'plugins'),'Aligner RestrictionAnnotator ProteinDumper TestFinder');
+ok($source->setting('plugins'),'Aligner RestrictionAnnotator ProteinDumper TestFinder');
 ok($source->semantic_setting(Alignments=>'glyph'),'segments_new');
 ok($source->semantic_setting(Alignments=>'glyph',30000),'box');
 ok($source->type2label('match',0),'Alignments');
diff --git a/t/03.render.t b/t/03.render.t
index 65c5f0dd5..96d79134d 100644
--- a/t/03.render.t
+++ b/t/03.render.t
@@ -31,6 +31,8 @@ END {
   rmtree '/tmp/gbrowse_testing';
 }
 
+%ENV = ();
+
 chdir $Bin;
 use lib "$Bin/../libnew";
 use Bio::Graphics::Browser;
@@ -39,10 +41,10 @@ use Bio::Graphics::Browser::Render;
 my $globals = Bio::Graphics::Browser->new(CONF_FILE);
 ok($globals);
 
-ok(my $session     = $globals->new_session());
+ok(my $session     = $globals->session());
 ok(my $id = $session->id);
 undef $session;
-ok($session  = $globals->new_session($id));
+ok($session  = $globals->session($id));
 ok($id,$session->id);
 
 my $source      = $globals->create_data_source($session->source);
@@ -51,6 +53,8 @@ ok($source);
 my $render      = Bio::Graphics::Browser::Render->new($source,$session);
 ok($render);
 
+ok($render->globals,$globals);
+
 # test the make_{link,title,target} functionality my $feature =
 my $feature = Bio::Graphics::Feature->new(-name=>'fred',
 					  -source=>'est',-method=>'match',
@@ -64,12 +68,12 @@ ok($render->make_link($feature),"http://localhost/cgi-bin/gbrowse_details/volvox
 
 ############### testing language features #############
 ok(($render->language->language)[0],'posix');
-ok($render->tra('IMAGE_LINK','Link to Image'));
+ok($render->tr('IMAGE_LINK','Link to Image'));
 
 $ENV{'HTTP_ACCEPT_LANGUAGE'} = 'fr';
 $render      = Bio::Graphics::Browser::Render->new($source,$session);
 ok(($render->language->language)[0],'fr');
-ok($render->tra('IMAGE_LINK','Lien vers une image de cet affichage'));
+ok($render->tr('IMAGE_LINK','Lien vers une image de cet affichage'));
 
 ############### testing initialization code #############
 ok(!$render->db);
@@ -77,12 +81,12 @@ ok(my $db = $render->init_database);
 ok($render->db,$db);
 ok($db,$render->db); # should return same thing each time
 ok(ref($db),'Bio::DB::GFF::Adaptor::memory');
-ok(scalar $db->features,16);
+ok(scalar $db->features,36);
 
 ok($render->init_plugins);
 ok(my $plugins = $render->plugins);
 my @plugins = $plugins->plugins;
-ok(scalar @plugins,3);
+ok(scalar @plugins,4);
 
 ok($render->init_remote_sources);
 ok(!$render->uploaded_sources->files);
@@ -102,16 +106,16 @@ ok($render->state->{grid},0);
 undef $session;
 undef $render;
 
-$session = $globals->new_session($id);
+$session = $globals->session($id);
 ok($session->id,$id);
 $render  = Bio::Graphics::Browser::Render->new($source,$session);
 ok($render->state->{width},1024);
 
-# test navigation - first we pretend that we are setting position to I:1..1000
-$CGI::Q = new CGI('ref=I;start=1;end=1000');
+# test navigation - first we pretend that we are setting position to ctgA:1..1000
+$CGI::Q = new CGI('ref=ctgA;start=1;end=1000');
 $render->update_coordinates;
-ok($render->state->{name},'I:1..1000');
-ok($render->state->{ref},'I');
+ok($render->state->{name},'ctgA:1..1000');
+ok($render->state->{ref},'ctgA');
 ok($render->state->{start},1);
 ok($render->state->{stop},1000);
 
@@ -122,24 +126,121 @@ $render->state->{seg_max} = 5000;
 # now we pretend that we've pressed the right button
 $CGI::Q = new CGI('right+500.x=yes');
 $render->update_coordinates;
-ok($render->state->{name},'I:501..1500');
+ok($render->state->{name},'ctgA:501..1500');
 
 # pretend we want to zoom in 50%
 $CGI::Q = new CGI('zoom+in+50%.x=yes');
 $render->update_coordinates;
-ok($render->state->{name},'I:751..1250');
+ok($render->state->{name},'ctgA:751..1250');
 
 # pretend that we've selected the popup menu to go to 100 bp
 $CGI::Q = new CGI('span=100');
 $render->update_coordinates;
-ok($render->state->{name},'I:951..1050');
+ok($render->state->{name},'ctgA:951..1050');
 
 # Do we clip properly? If I scroll right 5000 bp, then we should stick at 4901..5000
 $CGI::Q = new CGI('right+5000+bp.x=yes');
 $render->update_coordinates;
-ok($render->state->{name},'I:4901..5000');
+ok($render->state->{name},'ctgA:4901..5000');
 
+# Try to fetch the segment.
+ok($render->init_database);
+ok($render->init_plugins);
+$render->fetch_segments;
+my $s = $render->segments;
+ok($s && @$s);
+
+my $skipit = !($s && @$s) ? "segments() failed entirely, so can't check results" : 0;
+skip($skipit,scalar @$s,1);
+skip($skipit,eval{$s->[0]->seq_id},'ctgA');
+skip($skipit,eval{$s->[0]->start},4901);
+skip($skipit,eval{$s->[0]->end},5000);
+
+# now pretend we're fetching whole contig
+$CGI::Q = new CGI('name=ctgA');
+$render->update_coordinates;
+ok($render->state->{name},'ctgA');
+$render->fetch_segments;
+$s = $render->segments;
+ok($s && @$s);
+$skipit = !($s && @$s) ? "segments() failed entirely, so can't check results" : 0;
+skip($skipit,scalar @$s,1);
+skip($skipit,eval{$s->[0]->seq_id},'ctgA');
+skip($skipit,eval{$s->[0]->start},1);
+skip($skipit,eval{$s->[0]->end},50000);
+
+# try fetching a feature by name
+$CGI::Q = new CGI('name=My_feature:f13');
+$render->update_coordinates;
+ok($render->state->{name},'My_feature:f13');
+$render->fetch_segments;
+$s = $render->segments;
+ok($s && @$s);
+$skipit = !($s && @$s) ? "segments() failed entirely, so can't check results" : 0;
+skip($skipit,scalar @$s,1);
+skip($skipit,eval{$s->[0]->seq_id},'ctgA');
+skip($skipit,eval{$s->[0]->start},19157);
+skip($skipit,eval{$s->[0]->end},22915);
+
+# try automatic class munging
+$CGI::Q = new CGI('name=f13');
+$render->update_coordinates;
+$render->fetch_segments;
+ok($s = $render->segments);
+$skipit = !($s && @$s) ? "segments() failed entirely, so can't check results" : 0;
+skip($skipit,scalar @$s,1);
+skip($skipit,eval{$s->[0]->seq_id},'ctgA');
+skip($skipit,eval{$s->[0]->start},19157);
+skip($skipit,eval{$s->[0]->end},22915);
+
+# try fetching something that shouldn't match
+$CGI::Q = new CGI('name=Foo:f13');
+$render->update_coordinates;
+$render->fetch_segments;
+ok($s = $render->segments);
+ok(@$s,0,"Searching for Foo:f13 should have returned 0 results");
+
+# try fetching something that  matches more than once twice
+# m02 is interesting because there are three entries, two of which are on the same
+# chromosome. Using somewhat dubious logic, we keep the longest of the two.
+$CGI::Q = new CGI('name=Motif:m02');
+$render->update_coordinates;
+$render->fetch_segments;
+ok($s = $render->segments);
+ok(scalar @$s,2,"Motif:m02 should have matched exactly twice, but didn't");
 
-exit 0;
+# try the * match
+$CGI::Q = new CGI('name=Motif:m0*');
+$render->update_coordinates;
+$render->fetch_segments;
+ok($s = $render->segments);
+ok(scalar @$s,6,"Motif:m0* should have matched exactly 6 times, but didn't");
+
+# try keyword search
+$CGI::Q = new CGI('name=kinase');
+$render->update_coordinates;
+$render->fetch_segments;
+ok($s = $render->segments);
+ok(scalar @$s,4,"'kinase' should have matched 4 times, but didn't");
+
+# Exercise the plugin "find" interface.
+# The "TestFinder" plugin treats the name as a feature type and returns all instances
+$CGI::Q = new CGI('name=motif;plugin_action=Find;plugin=TestFinder');
+$render->update_coordinates;
+$render->fetch_segments;
+ok($s = $render->segments);
+ok(scalar @$s,11);
 
+# now try the run() call, using an IO::String to collect what was printed
+my $data;
+my $io = IO::String->new($data);
+$CGI::Q = new CGI('name=kinase');
 
+# start with a fresh renderer!
+$render      = Bio::Graphics::Browser::Render->new($source,$session);
+$render->run($io);
+ok($data =~ /Set-Cookie/);
+ok($data =~ /rendering 4 features/);
+
+
+exit 0;
diff --git a/t/testdata/conf/GBrowse.conf b/t/testdata/conf/GBrowse.conf
index 898a185d4..2c303afb9 100644
--- a/t/testdata/conf/GBrowse.conf
+++ b/t/testdata/conf/GBrowse.conf
@@ -22,7 +22,7 @@ moby_path      = MobyServices
 
 # session settings
 session driver = driver:file;serializer:default
-session args   = 
+session args   = Directory /tmp/gbrowse_testing/sessions
 
 # Debug settings
 debug                  = 0
@@ -54,7 +54,7 @@ head =
 header =
 
 # At the footer
-footer = <hr /><pre>$Id: GBrowse.conf,v 1.3 2007-01-05 22:34:05 lstein Exp $</pre>
+footer = <hr /><pre>$Id: GBrowse.conf,v 1.4 2007-02-14 23:54:39 lstein Exp $</pre>
 
 # Various places where you can insert your own HTML -- see configuration docs
 html1 = This is inherited
diff --git a/t/testdata/conf/volvox_final.conf b/t/testdata/conf/volvox_final.conf
index 4ced68900..96ce56d39 100644
--- a/t/testdata/conf/volvox_final.conf
+++ b/t/testdata/conf/volvox_final.conf
@@ -11,7 +11,7 @@ aggregators = match
 	      tprofile{tlevel}
 	      qtl{signal/peak}
 
-plugins = Aligner RestrictionAnnotator ProteinDumper
+plugins = Aligner RestrictionAnnotator ProteinDumper TestFinder
 
 # the extra left padding makes it easier to see the mRNA labels,
 # which are printed on the left by the new "gene" glyph
diff --git a/t/testdata/data/volvox/volvox.gff b/t/testdata/data/volvox/volvox.gff
index 05a1f216b..24afcd984 100644
--- a/t/testdata/data/volvox/volvox.gff
+++ b/t/testdata/data/volvox/volvox.gff
@@ -15,3 +15,63 @@ ctgA	example	my_feature	37242	38653	.	+	.	My_feature f04
 ctgA	example	my_feature	44705	47713	.	-	.	My_feature f01
 ctgA	example	my_feature	46990	48410	.	-	.	My_feature f11
 ctgA	example	my_feature	49758	50000	.	-	.	My_feature f12
+ctgA	example	motif	11911	15561	.	+	.	Motif m11 ; Note "kinase"
+ctgA	example	motif	13801	14007	.	-	.	Motif m05 ; Note "helix loop helix"
+ctgA	example	motif	14731	17239	.	-	.	Motif m14 ; Note "kinase"
+ctgA	example	motif	15396	16159	.	+	.	Motif m03 ; Note "zinc finger"
+ctgA	example	motif	17023	17675	.	+	.	Motif m08 ; Note "7-transmembrane"
+ctgA	example	motif	17667	17690	.	+	.	Motif m13 ; Note "DEAD box"
+ctgA	example	motif	18048	18552	.	-	.	Motif m07 ; Note "7-transmembrane"
+ctgA	example	motif	21748	25612	.	+	.	Motif m12 ; Note "kinase"
+ctgA	example	motif	28332	30033	.	-	.	Motif m02 ; Note "HOX"
+ctgA	example	motif	28338	30038	.	-	.	Motif m02 ; Note "HOX paralog"
+ctgB	example	motif	28338	30038	.	-	.	Motif m02 ; Note "HOX duplicate"
+ctgA	example	match	31785	32359	.	+	.	Match seg01
+ctgA	example	HSP	31785	31939	.	+	.	Match seg01
+ctgA	example	HSP	32329	32359	.	+	.	Match seg01
+ctgA	example	match	26122	34466	.	+	.	Match seg02
+ctgA	example	HSP	26122	26126	.	+	.	Match seg02
+ctgA	example	HSP	26497	26869	.	+	.	Match seg02
+ctgA	example	HSP	27201	27325	.	+	.	Match seg02
+ctgA	example	HSP	27372	27433	.	+	.	Match seg02
+ctgA	example	HSP	27565	27565	.	+	.	Match seg02
+ctgA	example	HSP	27813	28091	.	+	.	Match seg02
+ctgA	example	HSP	28093	28201	.	+	.	Match seg02
+ctgA	example	HSP	28329	28377	.	+	.	Match seg02
+ctgA	example	HSP	28829	29194	.	+	.	Match seg02
+ctgA	example	HSP	29517	29702	.	+	.	Match seg02
+ctgA	example	HSP	29713	30061	.	+	.	Match seg02
+ctgA	example	HSP	30329	30774	.	+	.	Match seg02
+ctgA	example	HSP	30808	31306	.	+	.	Match seg02
+ctgA	example	HSP	31516	31729	.	+	.	Match seg02
+ctgA	example	HSP	31753	32154	.	+	.	Match seg02
+ctgA	example	HSP	32595	32696	.	+	.	Match seg02
+ctgA	example	HSP	32892	32901	.	+	.	Match seg02
+ctgA	example	HSP	33127	33388	.	+	.	Match seg02
+ctgA	example	HSP	33439	33443	.	+	.	Match seg02
+ctgA	example	HSP	33759	34209	.	+	.	Match seg02
+ctgA	example	HSP	34401	34466	.	+	.	Match seg02
+ctgA	example	gene	1050	9000	.	+	.	Gene EDEN ; Note "protein kinase"
+
+ctgA	example	mRNA	1050	9000	.	+	.	mRNA EDEN.1 ; Gene EDEN
+ctgA	example	5'-UTR	1050	1200	.	+	.	mRNA EDEN.1
+ctgA	example	CDS	1201	1500	.	+	0	mRNA EDEN.1
+ctgA	example	CDS	3000	3902	.	+	0	mRNA EDEN.1
+ctgA	example	CDS	5000	5500	.	+	0	mRNA EDEN.1
+ctgA	example	CDS	7000	7608	.	+	0	mRNA EDEN.1
+ctgA	example	3'-UTR	7609	9000	.	+	.	mRNA EDEN.1
+
+ctgA	example	mRNA	1050	9000	.	+	.	mRNA EDEN.2 ; Gene EDEN
+ctgA	example	5'-UTR	1050	1200	.	+	.	mRNA EDEN.2
+ctgA	example	CDS	1201	1500	.	+	0	mRNA EDEN.2
+ctgA	example	CDS	5000	5500	.	+	0	mRNA EDEN.2
+ctgA	example	CDS	7000	7608	.	+	0	mRNA EDEN.2
+ctgA	example	3'-UTR	7609	9000	.	+	.	mRNA EDEN.2
+
+ctgA	example	mRNA	1300	9000	.	+	.	mRNA EDEN.3 ; Gene EDEN
+ctgA	example	5'-UTR	1300	1500	.	+	.	mRNA EDEN.3
+ctgA	example	5'-UTR	3000	3300	.	+	.	mRNA EDEN.3
+ctgA	example	CDS	3301	3902	.	+	0	mRNA EDEN.3
+ctgA	example	CDS	5000	5500	.	+	1	mRNA EDEN.3
+ctgA	example	CDS	7000	7600	.	+	1	mRNA EDEN.3
+ctgA	example	3'-UTR	7601	9000	.	+	.	mRNA EDEN.3