Legacy::Graphics::Browser - Legacy::Graphics::Browser documentation

  my $browser = Legacy::Graphics::Browser->new();

    my $url_label = $browser->url_label($yucky_url);

  my $success = $browser->read_configuration('/path/to/gbrowse.conf');

  @sources = $browser->sources;

  1) stripping off the .conf extension.
  2) removing the pattern "^\d+\."

  $source = $browser->source;
  $source = $browser->source($new_source);

  $value = $browser->setting(general => 'stylesheet');
  $value = $browser->setting(gene => 'fgcolor');
  $value = $browser->setting('stylesheet');

 default features = Transcripts
                    Genes
	 	    Scaffolds

  $browser->setting('general'=>'default features');

 @defaults = shellwords($browser->setting('default features'));

  $value = $browser->setting(gene => 'fgcolor');

   $value = = $browser->plugin_setting("option_name");

  [MyPlugin:plugin]
  foo = bar

  @args = $browser->db_settings;

  $db = Bio::DB::GFF->new($browser->dbgff_settings);

  $root = $browser->gbrowse_root()

  $relative_path = $browser->relative_path('gbrowse.css');

  $relative_path = $browser->relative_path_setting('stylesheet');

  $version = $browser->version

  $description = $browser->description

 instructions
 search
 overview
 details
 tracks
 display
 add tracks

  @track_labels = $browser->labels

  @default_labels = $browser->default_labels

  @feature_types = $browser->label2type($label,$lowres);

  $label = $browser->type2label($type);

  $label = $browser->feature2label($feature [,$length]);

  $citation = $browser->citation($label)

  $width = $browser->width

  $header = $browser->header;

  $footer = $browser->footer;

  $config = $browser->config;

  $time = $browser->mtime()

  $path = $browser->path()

  $url = $browser->make_link($feature,$panel,$label)

  $panels = $browser->render_panels(%args);

  Argument            Value

  segment             A Bio::DB::GFF::Segment or
                      Legacy::Das::SegmentI object (required).

  tracks              An arrayref containing a series of track
                        labels to render (required).  The order of the labels
                        determines the order of the tracks.

  options             A hashref containing options to apply to
                        each track (optional).  Keys are the track labels
                        and the values are 0=auto, 1=force no bump,
                        2=force bump, 3=force label, 4=expanded bump.

  feature_files       A hashref containing a series of
                        Bio::Graphics::FeatureFile objects to be
                        rendered onto the display (optional).  The keys
                        are labels assigned to the 3d party
                        features.  These labels must appear in the
                        tracks arrayref in order for render_panels() to
                        determine the order in which to render them.

  do_map              This argument is a flag that controls whether or not
                        to generate the image map.  It defaults to false.

  do_centering_map    This argument is a flag that controls whether or not
                        to add elements to the image map so that the user can
                        center the image by clicking on the scale.  It defaults
                        to false, and has no effect unless do_map is also true.

  title               Add specified title to the top of the image.

  noscale             Suppress the scale

  flip                Flip coordinates left to right

  hilite_callback     Callback for performing hilighting

  image_and_map       This argument will cause render_panels to emulate 
                        the legacy method image_and_map() and return a 
                        GD::Image object and a 'boxes' array reference rather
                        than rendered html.  This argument applies only to composite
                        (non-draggable) panel images.  

  $results->{track_label} = {image=>$uri, map=>$map_data, width=>$w, height=>$h, file=>$img_path)

  ($url,$path) = $browser->generate_image($gd)

  $hashref = $browser->hits_on_overview($db,$hits,$options,$keyname);

  1) a set of array refs in the form [ref,start,stop,name], where
     name is optional.

  2) a Bio::DB::GFF::Feature object

  3) a Legacy::SeqFeatureI object.

  my $error = $browser->error(['new error']);

  @args = $self->create_panel_args($section,$args);

   keystyle
   title
   image_class
   postgrid
   background

  @args = $self->create_track_args($label,$args);

   ($start,$stop,$flip) = $self->segment_coordinates($segment,$flip)

  $cache_key = $self->create_cache_key(@args)

  ($image_uri,$map,$width,$height) = $self->get_cached_panel($cache_key)

   ($region_sizes,$region_labels,$region_default) = $config->region_sizes()

   1. list of valid region sizes (@$region_sizes)
   2. mapping of size to label   (%$region_labels)
   3. default size               ($region_default)

package Legacy::Graphics::Browser;
# $Id: Browser.pm,v 1.167.4.34.2.32.2.126 2009-09-03 17:08:10 lstein Exp $

# This is an old version of Bio::Graphics::Browser retained for gbrowse_syn
# It is on the path to deprecation

use strict;
use File::Basename 'basename';
use Bio::Graphics;
use Carp qw(carp croak cluck);
use CGI qw(img param escape unescape url div span image_button);
use CGI::Toggle 'toggle_section';
use Digest::MD5 'md5_hex';
use File::Path 'mkpath';
use IO::File;
use Legacy::Graphics::Browser::I18n;
use Legacy::Graphics::Browser::Util qw(modperl_request is_safari shellwords);
use Bio::Graphics::Browser2;

require Exporter;

use vars '$VERSION','@ISA','@EXPORT';
$VERSION = '1.17';

@ISA    = 'Exporter';
@EXPORT = ('commas','DEFAULT_OVERVIEW_BGCOLOR');

use constant DEFAULT_WIDTH => 800;
use constant DEFAULT_DB_ADAPTOR  => 'Bio::DB::GFF';
use constant DEFAULT_KEYSTYLE    => 'bottom';
use constant DEFAULT_EMPTYTRACKS => 'key';
use constant RULER_INTERVALS     => 20;  # fineness of the centering map on the ruler
use constant TOO_MANY_SEGMENTS   => 5_000;
use constant MAX_SEGMENT         => 1_000_000;
use constant DEFAULT_SEGMENT     => 100_000;
use constant DEFAULT_RANGES      => q(100 500 1000 5000 10000 25000 100000 200000 400000);
use constant MIN_OVERVIEW_PAD    => 25;
use constant PAD_OVERVIEW_BOTTOM => 5;
use constant PAD_DETAIL_SIDES    => 25;
use constant DEFAULT_OVERVIEW_BGCOLOR => 'wheat';

# amount of time to remember persistent settings
use constant REMEMBER_SOURCE_TIME   => '+12M';   # 12 months
use constant REMEMBER_SETTINGS_TIME => '+1M';    # 1 month

use constant DEBUG => 0;

if( $ENV{MOD_PERL} &&
    exists $ENV{MOD_PERL_API_VERSION} &&
    $ENV{MOD_PERL_API_VERSION} >= 2) {
    require Apache2::SubRequest;
    require Apache2::RequestUtil;
    require Apache2::ServerUtil;
}

sub new {
  my $class    = shift;
  my $self = bless { },ref($class) || $class;
  $self->{globals} = Bio::Graphics::Browser2->open_globals;
  $self;
}


# patch to access GB2-style global config
sub globals { shift->{globals} }

sub url_label {
  my ($self,$label) = @_;
  my $key;
  if ($label =~ /^http|^ftp/) {
    my $l = $label;
    $l =~ s!^\W+//!!;
    my (undef,$type) = $l =~ /\S+t(ype)?=([^;\&]+)/;
    $l =~ s/\?.+//;
    ($key) = grep /$_/, reverse split('/',$l);
    $key = "url:$key" if $key;
    $key .= ":$type"  if $type; 
  }
  return $key || $label;
}

sub read_configuration {
  my $self        = shift;
  my $conf_dir    = shift;
  my $suffix      = shift || 'conf';

  $self->{conf} ||= {};

  croak("$conf_dir: not a directory") unless -d $conf_dir;
  opendir(D,$conf_dir) or croak "Couldn't open $conf_dir: $!";
  my @conf_files = map { "$conf_dir/$_" } grep {/\.$suffix$/} grep {!/^\.|^#|log4perl/} readdir(D);
  close D;

  # try to work around a bug in Apache/mod_perl which appears when
  # running under linux/glibc 2.2.1
  unless (@conf_files) {
    @conf_files = glob("$conf_dir/*.$suffix");
  }

  # get modification times
  my %mtimes     = map { $_ => (stat($_))[9] } @conf_files;

  for my $file (@conf_files) {
    my $basename = basename($file,".$suffix");
    next if $basename eq 'GBrowse';  # global settings -- used in main branch
    $basename =~ s/^\d+\.//;
    next if defined($self->{conf}{$basename}{mtime})
      && ($self->{conf}{$basename}{mtime} >= $mtimes{$file});
    my $config = Legacy::Graphics::BrowserConfig->new(-file => $file,
						   -safe => 1) or next;
    $self->{conf}{$basename}{data}  = $config;
    $self->{conf}{$basename}{mtime} = $mtimes{$file};
    $self->{conf}{$basename}{path}  = $file;
  }

 my $default_source;
  for my $basename (sort keys %{$self->{conf}}) {
    my $config = $self->{conf}{$basename}{data};
    $default_source  ||= $basename if $config->authorized('general');
  }


  $self->{source} = $default_source;
  $self->{width}  = DEFAULT_WIDTH;
  $self->{dir}    = $conf_dir;
  1;
}

sub dir {
  my $self = shift;
  my $d    = $self->{dir};
  $self->{dir} = shift if @_;
  $d;
}

sub sources {
  my $self = shift;
  my $conf        = $self->{conf} or return;
  my @sources = keys %$conf;

  # don't let unauthorized individuals see the source at all
  my @authorized = grep {exists $conf->{$_}{data} && $conf->{$_}{data}->authorized('general')} @sources;

  # alternative: sort by the config file name
  # return sort {$conf->{$a}{path} cmp $conf->{$b}{path}} @authorized;

  # alternative: sort by description
  return sort {lc $self->description($a) cmp lc $self->description($b)} @authorized;

  # alternative: sort by base name
  # return sort {$a cmp $b} @authorized;
}

# get/set current source
sub source {
  my $self = shift;
  my $d    = $self->{source};
  if (@_) {
    my $source = shift;
    unless ($self->{conf}{$source}) {
      carp("invalid source: $source");
      return;
    }
    unless ($self->{conf}{$source}{data}->authorized('general')) {
      carp ("Unauthorized source: $source");
      return;
    }
    $self->{source} = $source;
  }
  $d;
}

sub setting {
  my $self = shift;
  my @args = @_;
  if (@args == 1) {
    unshift @args,'general';
  } else {
    $args[0] = 'general'
      if !ref $args[0]
      && 
      $args[0] ne 'general' 
      && lc($args[0]) eq 'general';  # buglet
  }
  my $config = $self->config or return;
  $config->setting(@args);
}

# to return the list of configuration options
sub _setting {
    shift->config->_setting(@_);
}

sub fallback_setting {
  my $self = shift;
  my ($label,$option) = @_;
  for my $key ($label,'TRACK DEFAULTS','GENERAL') {
    my $value = $self->setting($key,$option);
    return $value if defined $value;
  }
  return;
}

sub plugin_setting {
  my $self           = shift;
  my $caller_package = caller();
  my ($last_name)    = $caller_package =~ /(\w+)$/;
  my $option_name    = "${last_name}:plugin";
  $self->setting($option_name => @_);
}

# get database adaptor name and arguments
sub db_settings {
  my $self = shift;

  my $adaptor = $self->setting('db_adaptor') || DEFAULT_DB_ADAPTOR;
  eval "require $adaptor; 1" or die $@;

  my $args    = $self->config->setting(general => 'db_args');
  my @argv = ref $args eq 'CODE'
        ? $args->()
	: Legacy::Graphics::Browser::Util::shellwords($args||'');

  # for compatibility with older versions of the browser, we'll hard-code some arguments
  if (my $adaptor = $self->setting('adaptor')) {
    push @argv,(-adaptor => $adaptor);
  }

  if (my $dsn = $self->setting('database')) {
    push @argv,(-dsn => $dsn);
  }

  if (my $fasta = $self->setting('fasta_files')) {
    push @argv,(-fasta=>$fasta);
  }

  if (my $user = $self->setting('user')) {
    push @argv,(-user=>$user);
  }

  if (my $pass = $self->setting('pass')) {
    push @argv,(-pass=>$pass);
  }

  if (defined (my $a = $self->setting('aggregators'))) {
    my @aggregators = Legacy::Graphics::Browser::Util::shellwords($a||'');
    push @argv,(-aggregator => \@aggregators);
  }

  ($adaptor,@argv);
}

sub gbrowse_root {
  my $self = shift;
  my $root = $self->globals->url_base || '/gbrowse2';
  $root    = "/$root" unless $root =~ /^\//;
  $root;
}

sub relative_path {
  my $self = shift;
  my $path = shift;
  return $path if $path =~ /^\//;             # already absolute
  return $path if $path =~ /^(?:http|ftp)+:/; # a URL
  my $root = $self->gbrowse_root;
  return "$root/$path";
}

sub relative_path_setting {
  my $self    = shift;
  my $setting = shift;
  my $path    = $self->setting('general' => $setting);
  return unless $path;
  return $self->relative_path($path);
}

sub version {
  my $self = shift;
  my $source = shift;
  my $c = $self->{conf}{$source}{data} or return;
  return $c->setting('general','version');
}

sub description {
  my $self = shift;
  my $source = shift;
  my $c = $self->{conf}{$source}{data} or return;
  return $c->setting('general','description');
}

sub remember_settings_time {
  my $self = shift;
  return $self->setting('remember settings time') || REMEMBER_SETTINGS_TIME;
}

sub remember_source_time {
  my $self = shift;
  return $self->setting('remember cookie time') || $self->setting('remember source time') || REMEMBER_SOURCE_TIME;
}

sub language {
  my $self = shift;
  my $d    = $self->{language};
  $self->{language} = shift if @_;
  $d;
}

sub tr {
  my $self = shift;
  my $lang = $self->language or return @_;
  $lang->tr(@_);
}

sub section_setting {
  my $self = shift;
  my $section = shift;
  my $config_setting = "\L$section\E section";
  my $s = $self->setting($config_setting);
  return 'open' unless defined $s;
  return $s;
}

sub labels {
  my $self  = shift;
  my $order = shift;
  my @labels = $self->config->labels;
  if ($order) { # custom order
    return @labels[@$order];
  } else {
    return @labels;
  }
}

sub default_labels {
  my $self = shift;
  $self->config->default_labels;
}

sub label2type {
  my $self = shift;
  $self->config->label2type(@_);
}

sub type2label {
  my $self = shift;
  $self->config->type2label(@_);
}

sub feature2label {
  my $self = shift;
  my ($feature,$length) = @_;
  return $self->config->feature2label($feature,$length);
}

sub citation {
  my $self = shift;
  my $label     = shift;
  my $language  = shift;
  my $config = $self->config;
  my $c;
  if ($language) {
    for my $l ($language->language) {
      $c ||= $config->setting($label=>"citation:$l");
      $c = &$c if ref $c eq 'CODE';
    }
  }
  $c ||= $config->setting($label=>'citation');
  $c = &$c if ref $c eq 'CODE';
  $c;
}

sub width {
  my $self = shift;
  my $d = $self->{width};
  $self->{width} = shift if @_;
  $d;
}

sub header {
  my $self = shift;
  my $header = $self->config->setting(general => 'header');
  if (ref $header eq 'CODE') {
    my $h = eval{$header->(@_)};
    $self->_callback_complain(general=>'header') if @_;
    return $h;
  }
  return $header;
}

sub footer {
  my $self = shift;
  my $footer = $self->config->setting(general => 'footer');
  if (ref $footer eq 'CODE') {
    my $f = eval {$footer->(@_)};
    $self->_callback_complain(general=>'footer') if @_;
    return $f;
  }
  return $footer;
}

sub config {
  my $self = shift;
  my $source = $self->source or return;
  $self->{conf}{$source}{data};
}

sub mtime {
  my $self = shift;
  my $source = $self->source;
  $self->{conf}{$source}{mtime};
}

sub path {
  my $self = shift;
  my $source = $self->source;
  $self->{conf}{$source}{path};
}

sub default_label_indexes {
  my $self = shift;
  $self->config->default_label_indexes;
}

sub make_link {
  my $self = shift;
  my ($feature,$panel,$label,$src) = @_;
  my @results = $self->config->make_link($feature,$panel,$label,$self->source);
  return wantarray ? @results : $results[0];
}

sub render_panels {
  my $self = shift;
  my $args = shift;

  my $segment         = $args->{segment};
  my $do_map          = $args->{do_map};
  my $drag_n_drop     = $self->drag_and_drop($args->{drag_n_drop});

  return unless $segment;

  $self->_load_aggregator_types($segment) if $do_map;
  my $panels = $self->generate_panels($args);

  return $drag_n_drop ? $self->render_draggable_tracks($args,$panels)
                      : $self->render_composite_track($args,$panels->{'__all__'});
}

sub drag_and_drop {
  my $self          = shift;
  my $override      = shift;
  return if defined $override && !$override;
  my $dnd           = $self->setting(general => 'drag and drop'); # explicit drag-and-drop setting
  $dnd              = 1 unless defined $dnd;
  my $pg            = $self->setting(general => 'postgrid');      # postgrid forces drag and drop off
  return $dnd && !$pg;
}

sub cache_time {
  my $self = shift;
  my $override = shift;
  return $override if defined $override;
  my $ct = $self->setting(general => 'cache time');
  return $ct if defined $ct;  # may return zero
  return 1; # 1 hour default
}

sub render_draggable_tracks {
  my $self = shift;
  my ($args,$panels) = @_;

  my $images   = $self->relative_path_setting('buttons');
  my $do_map   = $args->{do_map};
  my $tmpdir   = $args->{tmpdir};
  my $settings = $args->{settings};
  my $do_drag  = $args->{do_drag};
  my $button   = $args->{image_button};
  my $section  = $args->{section};
  $section    =~ s/^\?//;

  my $plus   = "$images/plus.png";
  my $minus  = "$images/minus.png";
  my $share  = "$images/share.png";
  my $help   = "$images/query.png";

  # get the pad image, which we use to fill up space between collapsed tracks
  my $pad_url  = $panels->{__pad__}{image};
  my ($pw,$ph) = @{$panels->{__pad__}}{'width','height'};


  my @result;
  for my $label ('__scale__',@{$args->{labels}}) {

    next unless $panels->{$label};
    my ($url,$img_map,$width,$height) = @{$panels->{$label}}{qw(image map width height)};

    # this complication is due to the fact that a plugin or uploaded file can be
    # in several sections at the same time
    my $element_id    = $label =~ /^(file|plugin):/ ? "${section}_${label}" : $label;

    my $collapsed     =  $settings->{track_collapsed}{$element_id};
    my $img_style     = $collapsed ? "display:none" : "display:inline";

    # The javascript functions for rubber-band selection
    # need this ID as a hook, please do not change it
    my $id = $label eq '__scale__' 
	? "${section}_image" 
	: "${element_id}_image";

    $img_style .= '; cursor:pointer' if $label eq '__scale__';

    my @map = $button 
	? () 
	: (-usemap=>"#${element_id}_map");
    my $img = img({-src=>$url,
		   -width => $width,
		   -id    => "$id",
		   -height=> $height,
		   -border=> 0,
		   -name  => "${section}_${label}",
		   -alt   => "${label} $section",
		   -style => $img_style,
		   @map,
		  });

    my $class     = $label eq '__scale__' ? 'scale' : 'track';
    my $icon      = $collapsed ? $plus : $minus;

    my $config_click;
    if ($label =~ /^plugin:/) {
	my $help_url = "url:?plugin=".CGI::escape($label).';plugin_do=Configure';
	$config_click = "balloon.showTooltip(event,'$help_url',1)";
    }

    elsif ($label =~ /^file:/) {
	my $url  = "?modify.${label}=".$self->tr('Edit');
	$config_click = "window.location='$url'";
    }

    else {
	my $help_url = "url:?configure_track=".CGI::escape($label);
	$help_url   .= ";rand=".rand(); # work around caching bugs... # if CGI->user_agent =~ /MSIE/;
	$config_click = "balloon.showTooltip(event,'$help_url',1)";
    }

    my $title;
    if ($label =~ /\w+:(.+)/ && $label !~ /:overview|:region/) {
      $title = $label =~ /^http|^ftp/ ? $self->url_label($label) : $1;
    }
    else {
      $title = $self->config->setting($label=>'key') || $label;
    }

    if ($self->setting(general=>'show track categories')) {
	my $cat = $self->config->setting($label=>'category');
	$title .= " ($cat)" if $cat;
    }
    my $show_or_hide     = $self->tr('SHOW_OR_HIDE_TRACK');
    my $share_this_track = $self->tr('SHARE_THIS_TRACK');
    my $citation         = $self->plain_citation($label,512);
    #$citation            =~ s/"/"/g;
    #$citation            =~ s/'/'/g;

    my $configure_this_track = $citation || '';
    $configure_this_track   .= '<br>' if $citation;
    $configure_this_track   .= $self->tr('CONFIGURE_THIS_TRACK');
    my $escaped_label        = CGI::escape($label);
	   
    my $titlebar    = $label eq '__scale__' || $label eq '__all__'
	? ''
	: span({-class=>$collapsed ? 'titlebar_inactive' : 'titlebar',-id=>"${element_id}_title"},
	       img({-src         =>$icon,
		    -id          => "${element_id}_icon",
		    -onMouseOver => "balloon.showTooltip(event,'$show_or_hide')",
		    -onClick     => "collapse('$element_id')",
		    -style       => 'cursor:pointer',
		   }),
	       img({-src         => $share,
		    -style       => 'cursor:pointer',
		    -onMouseOver => "balloon.showTooltip(event,'$share_this_track')",
		    -onMousedown => "balloon.showTooltip(event,'url:?share_track=$escaped_label')",
		   }),
	       $label !~ /^(http|ftp|das):/ 
	         ? img({-src         => $help,
			-style       => 'cursor:pointer',
			-onMouseOver => "balloon.showTooltip(event,'$configure_this_track')",
			-onmousedown => $config_click
		       })
	         : (),
	       span({-class=>'draghandle'},$title)
	);
    
    my $pad_img  = img({-src   => $pad_url,
			-width => $pw,
			-height=> $ph,
			-border=> 0,
			-id    => "${element_id}_pad",
			-style => $collapsed ? "display:inline" : "display:none",
		       });

    (my $munge_label = $label) =~ s/_/%5F/g;  # freakin' scriptaculous uses _ as a delimiter!!!
    $img_map = qq(<map name="${element_id}_map" id="${element_id}_map">$img_map</map>\n) if $img_map;

    push @result, (is_safari()
		   ?
		   "\n".div({-id=>"${section}_track_${munge_label}",-class=>$class},
			    $titlebar,
			    div({-align=>'center',
				 -style=>'margin-top: -18px; margin-bottom: 3px'},
				$img.$pad_img),
			    $img_map||'')
		   :
		   "\n".div({-id=>"${section}_track_${munge_label}",-class=>$class},
			    div({-align=>'center'},$titlebar.$img.$pad_img),
			    $img_map||'')
    );

  }

  return wantarray ? @result : join '',@result;
}

sub render_composite_track {
  my $self   = shift;
  my ($args,$panel) = @_;

  my $section = $args->{section} || '?detail';
  $section    =~ s/^\?//;
  my $button  = $args->{image_button};

  my ($width,$height,$url,$map,$gd,$boxes) = @{$panel}{qw/width height image map gd boxes/};

  # doesn't work
  my $css_map = $self->map_css($boxes,$section) if $section eq 'detail';

  if ($args->{image_and_map}) {
    return $gd, $boxes;
  }

  $map ||= '';
  my $map_name = param('hmap') || "${section}_map";

  # The javascript functions for rubber-band selection
  # need this ID as a hook, please DO NOT CHANGE THE IMAGE ID!
  my $id = $section eq 'detail' ? 'composite_track' : "${section}_image";
  $id = 'Overview Scale_image' if $id =~ /overview/i;

  my $img = $button
      ? image_button(-src   => $url,
		     -name  => $section,
		     -id    => $id
		    )
      : img({-src=>$url,
	     -usemap=>'#'.$map_name,
	     -width => $width,
	     -id    => $id,
	     -height=> $height,
	     -border=> 0,
	     -name  => $section,
	     -alt   => $section,
	     -style => 'position:relative'});


  my $html    = div({-align=>'center'},
		    $img,
		    $css_map,
		    qq(<map name="$map_name">$map</map>)
      );

  return $html;
}

sub generate_panels {
  my $self  = shift;
  my $args  = shift;

  my $segment       = $args->{segment};
  my ($seg_start,$seg_stop,$flip) = $self->segment_coordinates($segment,
							       $args->{flip});
  my $feature_files = $args->{feature_files} || {};
  my $labels        = $args->{labels} || $args->{tracks} || []; # legacy
  my $options       = $args->{options}       || {};

  my $limits        = $args->{limit}         || {};
  my $lang          = $args->{lang} || $self->language;
  my $suppress_scale= $args->{noscale};
  my $hilite_callback = $args->{hilite_callback};
  my $drag_n_drop   = $self->drag_and_drop($args->{drag_n_drop});
  my $do_map        = $args->{do_map};
  my $cache_extra   = $args->{cache_extra} || [];
  my $cache         = $args->{cache};
  my $settings      = $args->{settings};
  my $section       = $args->{section}     || '?detail';

  # hack to turn caching off in a one-shot fashion...
  $cache = 0 if param('redisplay');

  my @panel_args    = $self->create_panel_args($section,$args);

  $segment->factory->debug(1) if DEBUG;
  #$self->error('');

  my $conf     = $self->config;
  my $length   = $segment->length;

  #---------------------------------------------------------------------------------
  # Track and panel creation

  # we create two hashes:
  #        the %panels hash maps label names to panels
  #        the %tracks hash maps label names to tracks within the panels
  # in the case of no drag_n_drop, then %panels will contain a single key named "__scale__"
  my %panels;           # map label names to Bio::Graphics::Panel objects
  my %tracks;           # map label names to Legacy::Graphics::Track objects
  my %track_args;       # map label names to track-specificic arguments (for caching)
  my %seenit;           # used to avoid possible upstream error of putting track on list multiple times
  my %results;          # hash of {$label}{gd} and {$label}{map}
  my %cached;           # list of labels that have cached data on disk
  my %cache_key;        # list that maps labels to cache keys

  my $panel_key = $drag_n_drop ? '__scale__' : '__all__';

  # When running in monolithic mode, we need to be very careful about the cache key. This key
  # is the combination of the panel type, the panel args, and all the individual track args!
  my @cache_args          = ($section,$panel_key,@panel_args,
			     @$cache_extra,$do_map);
  if ($panel_key eq '__all__') {
    $track_args{$_} ||= [$self->create_track_args($_,$args)] foreach @$labels;
    push @cache_args,map {@$_} values %track_args;
  }

  $cache_key{$panel_key}  = $self->create_cache_key(@cache_args);
  $cached{$panel_key}     = $cache && $self->panel_is_cached($cache_key{$panel_key});

  unless ($cached{$panel_key}) {
    $panels{$panel_key}      = Bio::Graphics::Panel->new(@panel_args);

    $panels{$panel_key}->add_track($segment      => 'arrow',
				   -double       => 1,
				   -tick         => 2,
				   -label        => $args->{label_scale} ? $segment->seq_id : 0,
				   -units        => $conf->setting(general=>'units') || '',
				   -unit_divider => $conf->setting(general=>'unit_divider') || 1,
				  ) unless $suppress_scale;
  }

  # create another special track for padding to be used when we "collapse" a track, but only
  # if $drag_n_drop is false.
  if ($drag_n_drop) {
    $panel_key = '__pad__';
    my @cache_args           = ($section,$panel_key,@panel_args,
				@$cache_extra,$drag_n_drop);
    $cache_key{$panel_key}   = $self->create_cache_key(@cache_args);
    unless ($cached{$panel_key} =
	    $cache && $self->panel_is_cached($cache_key{$panel_key})
	   ) {
      $panels{$panel_key} = Bio::Graphics::Panel->new(@panel_args);
    }
  }

  # this will keep track of numbering of the tracks; only used when inserting
  # feature files into one big panel.
  my $trackno = $suppress_scale ? 0 : 1;
  my %feature_file_offsets;

  for my $label (@$labels) {

    # das tracks only go into details panel for now.
    next if $feature_files->{$label} && 
	$label =~ m!/das/! && 
	$section !~ /detail/; 

    next if $seenit{$label}++; # this shouldn't happen, but let's be paranoid

    # if "hide" is set to true, then skip panel
    next if $conf->semantic_setting($label=>'hide',$length);

    $track_args{$label} ||= [$self->create_track_args($label,$args)];

    # create a new panel if we are in drag_n_drop mode
    if ($drag_n_drop) {
      $panel_key = $label;

      # get config data from the feature files
      my @extra_args          = eval {
	$feature_files->{$label}->types,
        $feature_files->{$label}->mtime,
	} if $feature_files->{$label};

      my @args = (
		  @panel_args,
		  @{$track_args{$label}},
		  @extra_args,
		  @$cache_extra,
		  $drag_n_drop,
		  $options->{$label},
	          $label,
	  );

      $cache_key{$label}      = $self->create_cache_key(@args);
      next if $cached{$label} = $cache && $self->panel_is_cached($cache_key{$label});

      my @keystyle = (-key_style=>'between') 
	if $label =~ /^\w+:/ && $label !~ /:(overview|region)/;  # a plugin

      $panels{$panel_key}         = Bio::Graphics::Panel->new(@panel_args,@keystyle);
    }

    # case of a third-party feature or plugin, in which case we defer creation of a track
    # but record where we would place it
    elsif ($feature_files->{$label}) {
      $feature_file_offsets{$label} = $trackno;
      next;
    }

    $tracks{$label} = $panels{$panel_key}->add_track(@{$track_args{$label}})
      unless $cached{$panel_key} || $feature_files->{$label};
  }
  continue {
    $trackno++;
  }

  #---------------------------------------------------------------------------------
  # Add features to the database
  my @feature_types = map { $conf->label2type($_,$length) } grep {!$cached{$_}} @$labels;
  my %filters = map { my %conf =  $conf->style($_); 
		      $conf{'-filter'} ? ($_ => $conf{'-filter'})
			               : ()
		      } @$labels;
  $self->add_features_to_track(-types   => \@feature_types,
			       -tracks  => \%tracks,
			       -filters => \%filters,
			       -segment => $segment,
			       -options => $options,
			       -limits  => $limits,
			      ) if @feature_types;

  # ------------------------------------------------------------------------------------------
  # Add feature files, including remote annotations

  # Start by removing uploaded files mentioned in the list of labels, but
  # not in the feature_files list. This is a workaround for an upstream bug.
  for my $l (grep {/^(file|http|ftp):/} @$labels) {
    next if $feature_files->{$l};
    next unless $drag_n_drop;
    eval {$panels{$l}->finished};
    delete $panels{$l};
    delete $cached{$l};
  }

  my $featurefile_select = $args->{featurefile_select} 
                           || $self->feature_file_select($section);
  my $feature_file_extra_offset = 0;

  my %trackmap;

  for my $l (sort
	     { 
		 ($feature_file_offsets{$a}||1) <=> ($feature_file_offsets{$b}||1) 
	     } keys %$feature_files) {


    next if $cached{$l};
    my $file = $feature_files->{$l} or next;

    ref $file or next;
    $panel_key = $l if $drag_n_drop;

    next unless $panels{$panel_key};

    my $ff_offset = defined $feature_file_offsets{$l} ? $feature_file_offsets{$l} : 1;

    my $override_args  = $settings->{features}{$l}{override_settings} || {};
    my @override       = map {'-'.$_ => $override_args->{$_}} keys %$override_args;

    my ($nr_tracks_added,$tracks) =
      $self->add_feature_file(
			      file     => $file,
			      panel    => $panels{$panel_key},
			      position => $ff_offset + $feature_file_extra_offset,
			      options  => $options,
			      select   => $featurefile_select,
			      segment  => $segment,
	                      override_settings => \@override,
			     );

    do { eval {$panels{$panel_key}->finished};
	 delete $panels{$panel_key};
	 delete $cached{$panel_key};
       }
      if $drag_n_drop && $nr_tracks_added==0;  # suppress display of empty uploaded file tracks
    $trackmap{$_} = $file foreach @$tracks;

    $feature_file_extra_offset += $nr_tracks_added-1;
  }

  # map tracks (stringified track objects) to corresponding labels
  for my $label (keys %tracks) { $trackmap{$tracks{$label}} = $label }

  # uncached panels need to be generated and cached
  $args->{scale_map_type} ||= 'centering_map' unless $suppress_scale;
  (my $map_name = $section) =~ s/^\?//;

  for my $l (keys %panels) {
    my $gd    = $panels{$l}->gd;
    my $boxes = $panels{$l}->boxes;
    $self->debugging_rectangles($gd,$boxes) if DEBUG;
    my $map  = !$do_map          ? (undef,undef)
	     : $l eq '__pad__'   ? (undef,undef)
	     : $l eq '__scale__' ? $self->make_centering_map(shift @{$boxes},
							     $args->{flip},
							     $l,
							     $args->{scale_map_type}
							     )
	     : $l eq '__all__'   ? $self->make_map($boxes,
						   $panels{$l},
						   $map_name,
						   \%trackmap,
						   $args->{scale_map_type})
	     : $self->make_map($boxes,
			       $panels{$l},
			       $l,
			       \%trackmap,
			       0);
    my $key = $drag_n_drop ? $cache_key{$l} : $cache_key{'__all__'};
    $self->set_cached_panel($key,$gd,$map);
    eval {$panels{$l}->finished};
  }

  # cached panels need to be retrieved
  for my $l (keys %cached) {
    @{$results{$l}}{qw(image map width height file gd boxes)} = $self->get_cached_panel($cache_key{$l});
    # for apps that rely on the image_and_maps syntax, format the boxes
    $results{$l}{boxes} = $self->map_array($results{$l}{boxes});
  }

  return \%results;
}

sub add_features_to_track {
  my $self = shift;
  my %args = @_;

  my $segment         = $args{-segment} or die "programming error";
  my $feature_types   = $args{-types}   or die "programming error";
  my $tracks          = $args{-tracks}  or die "programming error";
  my $filters         = $args{-filters} or die "programming error";
  my $options         = $args{-options} or die "programming error";
  my $limits          = $args{-limits}  or die "programming error";

  my $max_labels      = $self->label_density;
  my $max_bump        = $self->bump_density;

  my $length  = $segment->length;
  my $conf    = $self->config;

  my (%groups,%feature_count,%group_pattern,%group_field);
  my $iterator = $segment->get_feature_stream(-type=>$feature_types);

  while (my $feature = $iterator->next_seq) {

    my @labels = $self->feature2label($feature,$length);

    for my $l (@labels) {

      my $track = $tracks->{$l}  or next;
      $filters->{$l}->($feature) or next if $filters->{$l};
      $feature_count{$l}++;


      # ------------------------------------------------------------------------------------------
      # GROUP CODE
      # Handle name-based groupings.
      unless (exists $group_pattern{$l}) {
	$group_pattern{$l} =  $conf->setting($l => 'group_pattern');
	$group_pattern{$l} =~ s!^/(.+)/$!$1! 
	                       if $group_pattern{$l}; # clean up regexp delimiters
	}

      # Handle generic grouping (needed for GFF3 database)
      $group_field{$l} = $conf->setting($l => 'group_on') unless exists $group_field{$l};
	
      if (my $pattern = $group_pattern{$l}) {
	my $name = $feature->name or next;
	(my $base = $name) =~ s/$pattern//i;
	$groups{$l}{$base} ||= Bio::Graphics::Feature->new(-type   => 'group');
	$groups{$l}{$base}->add_segment($feature);
	$feature_count{$l}--;
	next;
      }
	
      if (my $field = $group_field{$l}) {
	my $base = eval{$feature->$field};
	if (defined $base) {
	  $groups{$l}{$base} ||= $self->clone_feature($feature);
	  $groups{$l}{$base}->add_SeqFeature($feature);
	  $feature_count{$l}--;
	  next;
	}
      }

      $track->add_feature($feature);
    }
  }

  # ------------------------------------------------------------------------------------------
  # fixups

  # fix up %group features
  # the former creates composite features based on an arbitrary method call
  # the latter is traditional name-based grouping based on a common prefix/suffix

  for my $l (keys %groups) {
    my $track  = $tracks->{$l};
    my $g      = $groups{$l} or next;
    $track->add_feature($_) foreach values %$g;
    $feature_count{$l} += keys %$g;
  }

  # now reconfigure the tracks based on their counts
  for my $l (keys %$tracks) {
    next unless $feature_count{$l};

    $options->{$l} ||= 0;

    my $count = $feature_count{$l};
    $count    = $limits->{$l}
      if $limits->{$l} &&
	$limits->{$l} < $count;

    my $do_bump  = $self->do_bump($l,
				  $options->{$l},
				  $count,
				  $max_bump,
				  $length);

    my $do_label = $self->do_label($l,
				   $options->{$l},
				   $count,
				   $max_labels,
				   $length);

    my $do_description = $self->do_description($l,
					       $options->{$l},
					       $count,
					       $max_labels,
					       $length);

    $tracks->{$l}->configure(-bump  => $do_bump,
			     -label => $do_label,
			     -description => $do_description,
			      );
    $tracks->{$l}->configure(-connector  => 'none') if !$do_bump;
    $tracks->{$l}->configure(-bump_limit => $limits->{$l}) 
      if $limits->{$l} && $limits->{$l} > 0;
  }
}

sub add_feature_file {
  my $self = shift;
  my %args = @_;

  my $file    = $args{file}    or return;
  my $options = $args{options} or return;

  my $select  = $args{select}  or return;

  my $name = $file->name || '';
  $options->{$name}      ||= 0;

  my $override_settings = $args{override_settings};

  my ($nr_tracks_added,$panel,$tracklist) =
    eval {
      $file->render(
	  $args{panel},
	  $args{position},
	  $options->{$name},
	  $self->bump_density,
	  $self->label_density,
	  $select,
	  $args{segment},
	  $override_settings,
	  );
      };

  $self->error("error while rendering ",$args{file}->name,": $@") if $@;
  return ($nr_tracks_added,$tracklist);
}

# this returns a coderef that will indicate whether an added (external) feature is placed
# in the overview, region or detailed panel. If the section name begins with a "?", then
# if not otherwise stated, the feature will be placed in this section.
sub feature_file_select {
  my $self             = shift;
  my $required_section = shift;

  my $undef_defaults_to_true;
  if ($required_section =~ /^\?(.+)/) {
    $undef_defaults_to_true++;
    $required_section = $1;
  }

  return sub {
    my $file  = shift;
    my $type  = shift;
    my $section = $file->setting($type=>'section') || $file->setting(general=>'section');
    return $undef_defaults_to_true if !defined$section;
    return $section =~ /$required_section/;
  };
}

sub generate_image {
  my $self  = shift;
  my $image = shift;
  my ($extension,$data);

  if (!ref $image) { # possibly raw SVG data -- this is a workaround
    $extension = 'svg';
    $data      = $image;
  } else {
    $extension = $image->can('png') ? 'png' : 'gif';
    $data      = $image->can('png') ? $image->png : $image->gif;
  }

  my $signature = md5_hex($data);

  warn ((CGI::param('ref')||'')   . ':' .
	(CGI::param('start')||'') . '..'.
	(CGI::param('stop')||'')
	,
	" sig $signature\n") if DEBUG;

  # untaint signature for use in open
  $signature =~ /^([0-9A-Fa-f]+)$/g or return;
  $signature = $1;

  my ($uri,$path) = $self->tmpdir($self->source.'/img');
  my $url         = sprintf("%s/%s.%s",$uri,$signature,$extension);
  my $imagefile   = sprintf("%s/%s.%s",$path,$signature,$extension);
  open (F,">$imagefile") || die("Can't open image file $imagefile for writing: $!\n");
  binmode(F);
  print F $data;
  close F;
  return wantarray ? ($url,$imagefile) : $url;
}

sub tmpdir {
  my $self = shift;
  my $path = shift || '';

  # Original code; retain while testing new "callback_setting" method below
  #  my ($tmpuri,$tmpdir) = shellwords($self->setting('tmpimages'))
  #   or die "no tmpimages option defined, can't generate a picture";

  my ($tmpuri,$tmpdir) = Legacy::Graphics::Browser::Util::shellwords($self->callback_setting('tmpimages'))
    or die "no tmpimages option defined, can't generate a picture";

  $tmpuri  = $self->relative_path($tmpuri);
  $tmpuri .= "/$path" if $path;

  if ($ENV{MOD_PERL} ) {
    my $r          = modperl_request();
    my $subr       = $r->lookup_uri($tmpuri);
    $tmpdir        = $subr->filename;
    my $path_info  = $subr->path_info;
    $tmpdir       .= $path_info if $path_info;
  } elsif ($tmpdir) {
    $tmpdir .= "/$path" if $path;
  }
  else {
    $tmpdir = "$ENV{DOCUMENT_ROOT}/$tmpuri";
  }

  # we need to untaint tmpdir before calling mkpath()
  return unless $tmpdir =~ /^(.+)$/;
  $path = $1;

  mkpath($path,0,0777) unless -d $path;
  return ($tmpuri,$path);
}

# Check if a configuration setting is a coderef or simple variable
sub callback_setting {
    my $self = shift;
    my $val  = $self->setting(@_);
    return ref $val eq 'CODE' ? $val->() : $val;
}

sub make_map {
  my $self = shift;
  my ($boxes,$panel,$map_name,$trackmap,$first_box_is_scale) = @_;
  my @map = ($map_name);

  my $flip      = $panel->flip;
  my $tips      = $self->setting('balloon tips');
  my $use_titles_for_balloons = $self->setting('titles are balloons');

  my $did_map;

  local $^W = 0; # avoid uninit variable warnings due to poor coderefs

  if ($first_box_is_scale) {
    push @map, $self->make_centering_map(shift @$boxes,$flip,0,$first_box_is_scale);
  }

  foreach (@$boxes){
    next unless $_->[0]->can('primary_tag');

    my $label  = $_->[5] ? $trackmap->{$_->[5]} : '';

    my $href   = $self->make_href($_->[0],$panel,$label,$_->[5]);
    my $title  = unescape($self->make_title($_->[0],$panel,$label,$_->[5]));
    my $target = $self->config->make_link_target($_->[0],$panel,$label,$_->[5]);

    my ($mouseover,$mousedown,$style);
    if ($tips) {

      #retrieve the content of the balloon from configuration files
      # if it looks like a URL, we treat it as a URL.
      my ($balloon_ht,$balloonhover)     = 
	  $self->config->balloon_tip_setting('balloon hover',$label,
					     $_->[0],$panel,$_->[5]);

      my ($balloon_ct,$balloonclick)     = 
	  $self->config->balloon_tip_setting('balloon click',$label,
					     $_->[0],$panel,$_->[5]);

      # balloon_ht = type of balloon to use for hovering -- usually "balloon"
      # balloon_ct = type of balloon to use for clicking -- usually "balloon"
      my $sticky             = $self->setting($label,'balloon sticky');
      my $height             = $self->setting($label,'balloon height') || 300;
      my $width              = $self->setting($label,'balloon width')  || 0;
      my $hover_width        = $self->setting($label,'balloon hover width')  || $width;
      my $click_width        = $self->setting($label,'balloon click width')  || $width;

      if ($use_titles_for_balloons) {
	$balloonhover ||= $title;
	$balloonhover  =~ s/\'/\&\#39;/g;
	$balloonhover  =~ s/\"/\&\#34;/g;
      }

      $balloon_ht ||= 'balloon';
      $balloon_ct ||= 'balloon';

      if ($balloonhover) {
        my $iframe_width = $hover_width || "'+parseInt($balloon_ct.maxWidth)+'";
        my $stick = defined $sticky ? $sticky : 0;
        $mouseover = $balloonhover =~ /^(https?|ftp):/
            ? "$balloon_ht.showTooltip(event,'<iframe width=$iframe_width height=$height frameborder=0 " .
              "src=$balloonhover scrolling=no></iframe>',$stick)"
	      : "$balloon_ht.showTooltip(event,'$balloonhover',$stick,$hover_width)";
        undef $title;
      }
      if ($balloonclick) {
        my $iframe_width = $click_width || "'+parseInt($balloon_ct.maxWidth)+'";
        my $iframe_style = "style=padding-right:16px";
        $style = "cursor:pointer";
        $mousedown = $balloonclick =~ /^(http|ftp):/
            ? "$balloon_ct.showTooltip(event,'<iframe width=$iframe_width height=$height " .
              "frameborder=0 src=$balloonclick $iframe_style></iframe>')"
	      : "$balloon_ct.showTooltip(event,'$balloonclick',1,$click_width)";
        undef $href;
      }
    }

    my %attributes = (
		      title       => $title,
		      href        => $href,
		      target      => $target,
		      onmouseover => $mouseover,
		      onmousedown => $mousedown,
		      style       => $style
		      );

    my $ftype = $_->[0]->primary_tag || 'feature';
    my $fname = $_->[0]->display_name if $_->[0]->can('display_name');
    $fname  ||= $_->[0]->name if $_->[0]->can('name');
    $fname  ||= 'unnamed';
    $ftype = "$ftype:$fname";
    my $line = join("\t",$ftype,@{$_}[1..4]);
    for my $att (keys %attributes) {
      next unless defined $attributes{$att} && length $attributes{$att};
      $line .= "\t$att\t$attributes{$att}";
    }
    push @map, $line;
  }

  return \@map;

}

# this creates image map for rulers and scales, where clicking on the scale
# should center the image on the scale.
sub make_centering_map {
  my $self   = shift;
  my ($ruler,$flip,$label,$scale_map_type)  = @_;
  my @map = $label ? ($label) : ();

  my $title = $self->tr('Recenter');

  return if $ruler->[3]-$ruler->[1] == 0;

  my $length = $ruler->[0]->length;
  my $offset = $ruler->[0]->start;
  my $end    = $ruler->[0]->end;
  my $scale  = $length/($ruler->[3]-$ruler->[1]);
  my $pl     = $ruler->[-1]->panel->pad_left;

  my $ruler_intervals = RULER_INTERVALS;

  if ($scale_map_type eq 'interval_map' && $length/RULER_INTERVALS > $self->get_max_segment) {
    my $max = $self->get_max_segment/5;  # usually a safe guess
    $ruler_intervals = int($length/$max);
  }

  # divide into RULER_INTERVAL intervals
  my $portion = ($ruler->[3]-$ruler->[1])/$ruler_intervals;
  my $ref    = $ruler->[0]->seq_id;
  my $source = $self->source;

  for my $i (0..$ruler_intervals-1) {
    my $x1 = int($portion * $i+0.5);
    my $x2 = int($portion * ($i+1)+0.5);

    my ($start,$stop);
    if ($scale_map_type eq 'centering_map') {
      # put the middle of the sequence range into the middle of the picture
      my $middle = $flip ? $end - $scale * ($x1+$x2)/2 : $offset + $scale * ($x1+$x2)/2;
      $start  = int($middle - $length/2);
      $stop   = int($start  + $length - 1);
    }
    elsif ($scale_map_type eq 'interval_map') {
      # center on the interval
      $start = int($flip ? $end - $scale * $x1 : $offset + $scale * $x1);
      $stop  = int($start + $portion * $scale);
    }

    $x1 += $pl;
    $x2 += $pl;

    my $url = "?ref=$ref;start=$start;stop=$stop";
    $url .= ";flip=1" if $flip;
    
    push @map, join("\t",'ruler',$x1, $ruler->[2], $x2, $ruler->[4], 
		    href  => $url, title => $title||'', alt   => $title||'');
  }
  
  return $label ? \@map : @map;
}

sub make_href {
  my $self = shift;
  my ($feature,$panel,$label,$track)   = @_;
  return $self->make_link($feature,$panel,$label,$self->source,$track);
}

sub make_title {
  my $self             = shift;
  my ($feature,$panel,$label) = @_;
  return $feature->make_title if $feature->can('make_title');
  return $self->config->make_title($feature,$panel,$label);
}


###### attempted substitution; unfortunately runs slower than original!! #######

sub new_hits_on_overview {
  my $self = shift;
  my ($db,$hits,$page_settings,$keyname) = @_;


  my %overviews; # results are a hashref sorted by chromosome

  $keyname ||= 'Matches';

  my $class         = eval{$hits->[0]->factory->default_class} || 'Sequence';
  my ($padl,$padr)  = $self->overview_pad([grep { $page_settings->{$_}{visible}}
					   $self->config->overview_tracks],
					  'Matches');

  # sort hits out by reference and version
  my (%featurefiles);

  for my $hit (@$hits) {
    if (ref($hit) eq 'ARRAY') {
      my ($ref,$start,$stop,$name) = @$hit;
      $featurefiles{$ref} ||= Bio::Graphics::FeatureFile->new(-smart_features  => 1);
      $featurefiles{$ref}->add_feature(Bio::Graphics::Feature->new(-seq_id=>$ref,
								   -start=>$start,
								   -end=>$stop,
								   -name=>$name||'',
								   -type=>'hit',
								  )
				      );
    }
    elsif (UNIVERSAL::can($hit,'seq_id')) {
      my $name        = $hit->can('seq_name') ? $hit->seq_name : $hit->name;
      eval {$hit->absolute(1)};
      my $ref         = my $id = $hit->seq_id;
      my $version     = eval {$hit->isa('Legacy::SeqFeatureI') ? undef : $hit->version};
      $ref           .= " version $version" if defined $version;
      my($start,$end) = ($hit->start,$hit->end);
      $name           =~ s/\:\d+,\d+$//;  # remove coordinates if they're there
      $name           = substr($name,0,7).'...' if length $name > 10;
      $featurefiles{$ref} ||= Bio::Graphics::FeatureFile->new(-smart_features  => 1);
      my $f =Bio::Graphics::Feature->new(-seq_id=>$ref,
					 -start=>$start,
					 -end=>$end,
					 -name=>$name,
					 -type=>'hit',
					);
      $featurefiles{$ref}->add_feature($f);
    } elsif (UNIVERSAL::can($hit,'location')) {
      my $location                 = $hit->location;
      my ($ref,$start,$stop,$name) = ($location->seq_id,$location->start,
				      $location->end,$location->primary_tag);
      $featurefiles{$ref} ||= Bio::Graphics::FeatureFile->new(-smart_features  => 1);
      $featurefiles{$ref}->add_feature(Bio::Graphics::Feature->new(-seq_id=>$ref,
								   -start=>$start,
								   -end=>$stop,
								   -name=>$name||'',
								   -type=>'hit')
				      );
    }
  }

  # We now have a feature list. Create an overview for each unique ref
  my @refs = sort keys %featurefiles;

  my @tracks_to_show = grep {$page_settings->{features}{$_}{visible} && /:overview$/ }
    @{$page_settings->{tracks}};
  push @tracks_to_show,'my_data';

  for my $ref (@refs) {
    my ($name, $version) = split /\sversion\s/i, $ref;
    my $segment = ($db->segment(-class=>$class,-name=>$name,
				defined $version ? (-version => $version):()))[0] or next;

    my @cache_extra = (time);  # this will never cache
    my $count = scalar (my @h = $featurefiles{$ref}->features);
    $featurefiles{$ref}->add_type(hit => {
					  glyph  => 'diamond',
					  bgcolor=> 'red',
					  fgcolor=> 'red',
					  key    => $keyname,
					  fallback_to_rectangle => 1,
					  no_subparts    => 1,
					  bump      => $count <= $self->bump_density,
					  label     => $count <= $self->bump_density,  # deliberate
					  link   => sub {my $f = shift; 
							 return "?name=".$f->display_name}
					  }
				  );
    my $html = $self->render_panels({
				     section       => "overview_${ref}",
				     segment       => $segment,
				     labels        => \@tracks_to_show,
				     feature_files => {my_data => $featurefiles{$ref}},
				     drag_n_drop   => 0,
				     do_map        => 1,
				     scale_map_type=> 'interval_map',
				     keystyle      => 'left',
				     label_scale   => 1,
				     cache_extra   => \@cache_extra,
				     image_class   => 'GD',
				     featurefile_select => sub { 1 } ,
				     -grid         => 0,
				     -pad_left     => $padl,
				     -pad_right    => $padr,
				     -bgcolor      => $self->setting("overview bgcolor") || DEFAULT_OVERVIEW_BGCOLOR,
					 }
					);
    $overviews{$ref} = $html;
  }

  return \%overviews;
}

sub bump_density {
  my $self = shift;
  my $conf = $self->config;
  return $conf->setting(general=>'bump density')
      || $conf->setting('TRACK DEFAULTS' =>'bump density')
      || 50;
}

sub label_density {
  my $self = shift;
  my $conf = $self->config;
  return $conf->setting(general=>'label density')
      || $conf->setting('TRACK DEFAULTS' =>'label density')
      || 10;
}

sub do_bump {
  my $self = shift;
  my ($track_name,$option,$count,$max,$length) = @_;

  my $conf              = $self->config;
  my $maxb              = $conf->setting($track_name => 'bump density');
  $maxb                 = $max unless defined $maxb;

  my $maxed_out = $count <= $maxb;
  my $conf_bump = $conf->semantic_setting($track_name => 'bump',$length);
  $option ||= 0;
  return defined $conf_bump ? $conf_bump
      :  $option == 0 ? $maxed_out
      :  $option == 1 ? 0
      :  $option == 2 ? 1
      :  $option == 3 ? 1
      :  $option == 4 ? 2
      :  $option == 5 ? 2
      :  0;
}

sub do_label {
  my $self = shift;
  my ($track_name,$option,$count,$max_labels,$length) = @_;

  my $conf = $self->config;

  my $maxl              = $conf->setting($track_name => 'label density');
  $maxl                 = $max_labels unless defined $maxl;
  my $maxed_out         = $count <= $maxl;

  my $conf_label        = $conf->semantic_setting($track_name => 'label',$length);
  $conf_label           = 1 unless defined $conf_label;

  $option ||= 0;
  return  $option == 0 ? $maxed_out && $conf_label
        : $option == 3 ? $conf_label || 1
	: $option == 5 ? $conf_label || 1
        : 0;
}

sub do_description {
  my $self = shift;
  my ($track_name,$option,$count,$max_labels,$length) = @_;

  my $conf              = $self->config;

  my $maxl              = $conf->setting($track_name => 'label density');
  $maxl                 = $max_labels unless defined $maxl;
  my $maxed_out = $count <= $maxl;

  my $conf_description  = $conf->semantic_setting($track_name => 'description',$length);
  $conf_description     = 0 unless defined $conf_description;
  $option ||= 0;
  return  $option == 0 ? $maxed_out && $conf_description
        : $option == 3 ? $conf_description || 1
        : $option == 5 ? $conf_description || 1
        : 0;
}

# given a feature, return the segment (e.g. chromosome) that it is contained in.
sub whole_segment {
  my $self    = shift;
  my $segment = shift;
  my $factory = $segment->factory;

  # the segment class has been deprecated, but we still must support it
  my $class   = eval {$segment->seq_id->class} || eval{$factory->refclass};

  my ($whole_segment) = $factory->segment(-class=>$class,
					  -name=>$segment->seq_id);
  $whole_segment   ||= $segment;  # just paranoia
  $whole_segment;
}

# fetch a list of Segment objects given a name or range
# (this used to be in gbrowse executable itself)
sub name2segments {
  my $self = shift;
  my ($literal_name,$db,$toomany,$segments_have_priority,$dont_merge) = @_;

  $dont_merge = !$self->setting('merge searches') 
      if defined $self->setting('merge searches');

  $toomany ||= TOO_MANY_SEGMENTS;

  my $max_segment   = $self->get_max_segment;

  my $name = $literal_name;
  my (@segments,$class,$start,$stop);
  if ( ($name !~ /\.\./ and $name =~ /([\w._\/-]+):(-?[-e\d.]+),(-?[-e\d.]+)$/) or
      $name =~ /([\w._\/-]+):(-?[-e\d,.]+?)(?:-|\.\.)(-?[-e\d,.]+)$/) {
    $name  = $1;
    $start = $2;
    $stop  = $3;
    $start =~ s/,//g; # get rid of commas
    $stop  =~ s/,//g;
  }

  elsif ($name =~ /^(\w+):(.+)$/) {
    $class = $1;
    $name  = $2;
  }

  my $divisor = $self->config->setting(general=>'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 $refclass = $self->setting('reference class') || 'Sequence';

 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
    @segments  = $self->_feature_get($db,$name_to_try,$class_to_try,$start_to_try,$stop_to_try,
				     $segments_have_priority,$dont_merge);
    last SEARCHING if @segments;

    # 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 !~ /\*$/ 
				      and !$self->setting('disable wildcards');

    for my $n (@sloppy_names) {
      for my $c (@classes) {
	@segments = $self->_feature_get($db,$n,$c,$start_to_try,$stop_to_try,$segments_have_priority,$dont_merge);
	last SEARCHING if @segments;
      }
    }
  }

  return @segments;
}

sub _feature_get {
  my $self = shift;
  my ($db,$name,$class,$start,$stop,$segments_have_priority,$dont_merge,$f_id) = @_;

  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;
  push @argv,(-feature_id => $f_id) if defined $f_id;
  # This step is a hack to turn off relative addressing when getting absolute coordinates on the
  # reference molecule.
  push @argv,(-absolute=>1)     if $class eq $refclass;
  warn "\@argv = @argv" if DEBUG;

  my @segments;
  @segments    = $db->fetch($f_id) if defined $f_id 
      && $db->can('fetch');

  @segments    = $db->get_feature_by_primary_id($f_id) if !@segments 
      && defined $f_id 
      && $db->can('get_feature_by_primary_id');

  if (!@segments) {
      if ($segments_have_priority) {
	  @segments  = grep {$_->length} $db->segment(@argv);
	  @segments  = grep {$_->length} $db->get_feature_by_name(@argv) if !@segments;
      } else {
	  @segments  = grep {$_->length} $db->get_feature_by_name(@argv)  if !defined($start) && !defined($stop);
	  @segments  = grep {$_->length} $db->get_features_by_alias(@argv) if !@segments && !defined($start)
	      && !defined($stop)
	      && $db->can('get_features_by_alias');
	  @segments  = grep {$_->length} $db->segment(@argv)               if !@segments && $name !~ /[*?]/;
      }
  }

  # one last try for Bio::DB::GFF
  if (defined $f_id && defined $name && !@segments) {
    @segments  = grep {$_->length} $db->get_feature_by_name(@argv);
  }

  return unless @segments;

  # Deal with multiple hits.  Winnow down to just those that
  # were mentioned in the config file.
  my $types = $self->_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;
      } @segments;


  return @filtered if $dont_merge;

  # consolidate features that have same name and same reference sequence
  # and take the largest one.
  local $^W=0; # uninit variable warning - can't find it
  my %longest;
  foreach (@filtered) {
    my $n   = $_->display_name.$_->abs_ref.(eval{$_->version}||'').(eval{$_->class}||'');
    $longest{$n} = $_ if !defined($longest{$n}) || $_->length > $longest{$n}->length;
  }

  values %longest;
}

sub get_ranges {
  my $self      = shift;
  my $divisor   = $self->setting('unit_divider') || 1;
  my $rangestr  = $self->setting('zoom levels');
  if (!$rangestr) {
    return split /\s+/,DEFAULT_RANGES;
  } elsif ($divisor == 1 ) {
    return split /\s+/,$rangestr;
  } else {
    return map {$_ * $divisor} split /\s+/,$rangestr;
  }
}

sub get_max_segment {
  my $self = shift;
  my $divisor   = $self->setting('unit_divider') || 1;
  my $max_seg   = $self->setting('max segment');
  if (!$max_seg) {
    return MAX_SEGMENT;
  } elsif ($divisor == 1 ) {
    return $max_seg
  } else {
    return $max_seg * $divisor;
  }
}

sub get_default_segment {
  my $self = shift;
  my $divisor   = $self->setting('unit_divider') || 1;
  my $def_seg   = $self->setting('default segment');
  if (!$def_seg) {
    return DEFAULT_SEGMENT;
  } elsif ($divisor == 1 ) {
    return $def_seg
  } else {
    return $def_seg * $divisor;
  }
}

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;
}

# Handle types that are hidden by aggregators so that
# features link correctly when they are subparts rather than
# the top-level part
sub _load_aggregator_types {
  my $self    = shift;
  my $segment = shift;
  return if $self->config->{_load_aggregator_types}++; # don't do it twice
  my $db          = eval {$segment->factory} or return;
  my @aggregators = eval {$db->aggregators } or return;
  for my $a (@aggregators) {
    my $method   = $a->method;
    my @subparts = ($a->part_names,$a->main_name);
    for my $track ($self->type2label($method)) {
      foreach (@subparts) {
	$self->config->{_type2label}{$_}{$track}++;
      }
    }
  }
}


# utility called by hits_on_overview
sub _hits_to_html {
  my $self = shift;
  my ($ref,$gd,$boxes) = @_;
  my ($name, $version) = split /\sversion\s/i, $ref;
  my $source   = $self->source;
  my $self_url = '';   #url(-relative=>1);
  # $self_url   .= "?source=$source";

  my $signature = md5_hex(rand().rand()); # just a big random number
  my ($width,$height) = $gd->getBounds;
  my $url       = $self->generate_image($gd,$signature);
  my $img       = img({-src=>$url,
		       -align=>'middle',
		       -usemap=>"#$ref",
		       -width => $width,
		       -height => $height,
		       -border=>0});
  my $html = "\n";
  $html   .= $img;
  $html   .= qq(<br /><map name="$ref" alt="imagemap" />\n);

  # use the scale as a centering mechanism
  my $ruler   = shift @$boxes;
  return unless $ruler->[0];  # don't know why....


  my $length  = $ruler->[0]->length/RULER_INTERVALS;
  $width   = ($ruler->[3]-$ruler->[1])/RULER_INTERVALS;
  for my $i (0..RULER_INTERVALS-1) {
    my $x = $ruler->[1] + $i * $width;
    my $y = $x + $width;
    my $start = int($length * $i);
    my $stop  = int($start + $length);
    my $href      = $self_url . "?ref=$name;start=$start;stop=$stop";
    $href        .= ";version=$version" if defined $version;
    $html .= qq(<area shape="rect" coords="$x,$ruler->[2],$y,$ruler->[4]" href="$href" alt="ruler" />\n);
  }

  foreach (@$boxes){
    my ($start,$stop) = ($_->[0]->start,$_->[0]->end);
    my $href      = $self_url . "?ref=$name;start=$start;stop=$stop";
    $href        .= ";version=$version" if defined $version;
    $html .= qq(<area shape="rect" coords="$_->[1],$_->[2],$_->[3],$_->[4]" href="$href" alt="ruler" />\n);
  }
  $html .= "</map>\n";
  $html;
}

# I know there must be a more elegant way to insert commas into a long number...
sub commas {
  my $i = shift;
  return $i if $i=~ /\D/;
  $i = reverse $i;
  $i =~ s/(\d{3})/$1,/g;
  chop $i if $i=~/,$/;
  $i = reverse $i;
  $i;
}

sub merge {
  my $self = shift;
  my ($db,$features,$max_range) = @_;
  $max_range ||= 100_000;

  my (%segs,@merged_segs);
  push @{$segs{$_->seq_id}},$_ foreach @$features;
  foreach (keys %segs) {
    push @merged_segs,_low_merge($db,$segs{$_},$max_range);
  }
  return @merged_segs;
}

sub _low_merge {
  my ($db,$features,$max_range) = @_;

  my ($previous_start,$previous_stop,$statistical_cutoff,@spans);

  my @features = sort {$a->low<=>$b->low} @$features;

  # run through the segments, and find the mean and stdev gap length
  # need at least 10 features before this becomes reliable
  if (@features >= 10) {
    my ($total,$gap_length,@gaps);
    for (my $i=0; $i<@$features-1; $i++) {
      my $gap = $features[$i+1]->low - $features[$i]->high;
      $total++;
      $gap_length += $gap;
      push @gaps,$gap;
    }
    my $mean = $gap_length/$total;
    my $variance;
    $variance += ($_-$mean)**2 foreach @gaps;
    my $stdev = sqrt($variance/$total);
    $statistical_cutoff = $stdev * 2;
  } else {
    $statistical_cutoff = $max_range;
  }

  my $ref = $features[0]->seq_id;

  for my $f (@features) {
    my $start = $f->low;
    my $stop  = $f->high;

    if (defined($previous_stop) &&
	( $start-$previous_stop >= $max_range ||
	  $previous_stop-$previous_start >= $max_range ||
	  $start-$previous_stop >= $statistical_cutoff)) {
      push @spans,$db->segment($ref,$previous_start,$previous_stop);
      $previous_start = $start;
      $previous_stop  = $stop;
    }

    else {
      $previous_start = $start unless defined $previous_start;
      $previous_stop  = $stop;
    }

  }
  my $class = eval { $features[0]->factory->refclass };
  my @args  = (-name=>$ref,-start=>$previous_start,-end=>$previous_stop);
  push @args,(-class=>$class) if defined $class;
  push @spans,$db ? $db->segment(@args)
                  : Bio::Graphics::Feature->new(-start=>$previous_start,-end=>$previous_stop,-ref=>$ref);
  return @spans;
}

sub overview_pad {
  my $self   = shift;
  my $tracks = shift;

  if ($self->drag_and_drop) { # not relevant when drag and drop is active
    my $padding = $self->image_padding;
    return ($padding,$padding);
  }

  $tracks ||= [$self->config->overview_tracks];
  my $max = 0;
  foreach (@$tracks) {
    my $key = $self->setting($_=>'key');
    next unless defined $key;
    $max = length $key if length $key > $max;
  }
  foreach (@_) {  #extra
    $max = length if length > $max;
  }

  # Tremendous kludge!  Not able to generate overview maps in GD yet
  # This needs to be cleaned...
  my $image_class = 'GD';
  eval "use $image_class";
  return (MIN_OVERVIEW_PAD,MIN_OVERVIEW_PAD) unless $max;
  return ($max * $image_class->gdMediumBoldFont->width + 3,MIN_OVERVIEW_PAD);
}

sub true { 1 }

sub debugging_rectangles {
  my $self = shift;
  my ($image,$boxes) = @_;
  my $red = $image->colorClosest(255,0,0);
  foreach (@$boxes) {
    my @rect = @{$_}[1,2,3,4];
    $image->rectangle(@{$_}[1,2,3,4],$red);
  }
}

# Returns the language code, but only if we have a translate table for it.
sub language_code {
  my $self = shift;
  my $lang = $self->language;
  my $table= $lang->tr_table($lang->language);
  return unless %$table;
  return $lang->language;
}