#!/usr/bin/perl -w

###################################################################
# Non-modperl users should change this variable if needed to point
# to the directory in which the configuration files are stored.
#
$CONF_DIR  = '/bio/argos/gmod/in01/conf/gbrowse.conf';
#
###################################################################
$VERSION   = 1.67;
$BIOGRAPHICS_VERSION   = 1.654;


use lib '/bio/argos/gmod/in01/lib';
# $Id: gbrowse.PLS,v 1.119.4.57.2.59.2.2 2007/03/01 23:00:42 lstein Exp $

use strict;
use Bio::Graphics;
use Bio::Graphics::Browser;
use Bio::Graphics::Browser::Util;
use Bio::Graphics::Browser::PluginSet;
use Bio::Graphics::Browser::UploadSet;
use Bio::Graphics::Browser::RemoteSet;
use Bio::Graphics::Browser::PageSettings;
use Digest::MD5 'md5_hex';
use File::Path 'mkpath';
use Text::Tabs;
use Text::Shellwords;
use File::Basename 'basename','dirname';
use File::Spec;
use Carp qw(:DEFAULT croak);
use CGI qw(:standard unescape escape escapeHTML center *table *dl *TR *td);
use CGI::Toggle;
use CGI::Cookie;
use vars qw($CONFIG $MAX_SEGMENT $DEFAULT_SEGMENT
	    $HEADER $HTML $UA $VERSION $BIOGRAPHICS_VERSION $CONF_DIR
	    %PLUGINS $PLUGINS $UPLOADED_SOURCES $REMOTE_SOURCES
	    $PRESETS $HAVE_SVG
	    %OBJECT_CLASSES %PLUGIN_NAME2LABEL );


# if you change the zoom/nav icons, you must change this as well.
use constant MAG_ICON_HEIGHT => 20;
use constant MAG_ICON_WIDTH  => 8;

# had-coded values for segment sizes
# many of these can be overridden by configuration file entries
use constant MAX_SEGMENT     => 1_000_000;
use constant MIN_SEG_SIZE         => 20;
use constant TINY_SEG_SIZE        => 2;
use constant EXPAND_SEG_SIZE      => 5000;
use constant TOO_MANY_SEGMENTS => 5_000;
use constant TOO_MANY_FEATURES => 100;
use constant TOO_MANY_REFS     => TOO_MANY_FEATURES;
use constant DEFAULT_SEGMENT => 100_000;
use constant DEFAULT_REGION_SIZE => 100_000_000;

use constant OVERVIEW_RATIO  => 0.9;
use constant ANNOTATION_EDIT_ROWS => 25;
use constant ANNOTATION_EDIT_COLS => 100;
use constant URL_FETCH_TIMEOUT    => 5;  # five seconds max!
use constant URL_FETCH_MAX_SIZE   => 1_000_000;  # don't accept any files larger than 1 Meg
use constant MAX_KEYWORD_RESULTS  => 1_000;     # max number of results from keyword search
use constant DEFAULT_RANGES       => q(100 500 1000 5000 10000 25000 100000 200000 400000);
use constant DEFAULT_FINE_ZOOM    => '10%';
use constant GBROWSE_HELP         => '/gbrowse';
use constant DEFAULT_PLUGINS      => 'FastaDumper RestrictionAnnotator SequenceDumper';
use constant CHECKBOX_COLUMNS     => 4;

# if true, turn on surrounding rectangles for debugging the image map
use constant DEBUG          => 0;
use constant DEBUG_EXTERNAL => 0;
use constant DEBUG_PLUGINS  => 0;

use constant GLOBAL_TIMEOUT => 60;  # 60 seconds to failure unless overridden in config

local $CGI::USE_PARAM_SEMICOLONS = 1;
$HAVE_SVG = eval {require GD::SVG; 1};

# IMPORTANT DATA STRUCTURES

# $SETTINGS (also called $page_settings): hash reference containing state information
# keys:
#   name      name of a landmark to search for (e.g. keyword search)
#   ref       sequence landmark reference ID (once found)
#   start     start of range relative to ref
#   stop      stop of range relative to ref
#   source    symbolic name of database/configuration to use
#   id        unique cookie-based ID for this user
#   plugin    last accessed plugin
#   ks        position of key (beneath or between)
#   tracks    array ref which has one element for each track on the
#               display.  The value of each element indicates what
#               track to display in that position using the configuration
#               key code.  For example: [HMM,BAB,GB]
#               means display the "HMM", "BAB" and "GB" features in that
#               order.  Uploaded feature data is named "UPLOAD",
#               External URL tracks are indicated using the URL of the data.
#   features    hash ref which has one element for each feature type.
#               Its values are hashrefs with subkeys {visible} and {options}.
#               A true value in {visible} indicates that the feature is active.
#               The values of {options} are integers with the following meaning:
#               0=auto, 1=force no bump, 2=force bump, 3=force label.
#   ins         Show instructions
#   head        Show header and footer
#   h_feat     Search term(s) for hiliting
#   h_region    Region to hilight
#   q           A search term passed in the URL -- there may be multiple ones
# $CONFIG
# This is a global Bio::Graphics::Browser object.  It contains information on
# all the configuration files for this browser and provides access to the various
# settings within the configuration file.

BEGIN {
    eval "use Apache";
    warn <<END if Apache::DBI->can('connect_on_init');
WARNING: APACHE::DBI DETECTED.
THIS WILL CAUSE THE GFF DUMP TO FAIL INTERMITTENTLY.
THIS SCRIPT DOES NOT BENEFIT FROM APACHE::DBI
END
;
};

$HEADER=0;
$HTML=0;

version_warning();

$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin';
$CONF_DIR  = conf_dir($CONF_DIR);  # conf_dir() is exported from Util.pm

## CONFIGURATION & INITIALIZATION ################################
# preliminaries -- read and/or refresh the configuration directory
$CONFIG = open_config($CONF_DIR);  # open_config() is exported from Util.pm

## PAGE SETTINGS #################################################
#
# Recover a hashref which contains page-specific settings
# (this involves reading a cookie or possibly a database record
# in some future implementation)

my ($page_settings,$session) = page_settings($CONFIG); # WARNING: this may cause a redirect and exit

my $source                   = $CONFIG->source;
my $cookie                   = CGI::Cookie->new(-name    => $CGI::Session::NAME,
						-value   => $session->id,
						-path    => url(-absolute=>1),
						-expires => $CONFIG->remember_source_time);

my $cookies;
if (param('reset')) {
  $session->session->delete() if $session;
  $cookies = reset_cookies($page_settings);
} else {
  $cookies = [$cookie];
}

### PLUGINS #################################################################
my @plugin_path = "$CONF_DIR/plugins";
unshift @plugin_path,shellwords($CONFIG->setting('plugin_path'))
  if $CONFIG->setting('plugin_path');

$PLUGINS = $PLUGINS{$source} ||= Bio::Graphics::Browser::PluginSet->new($CONFIG,$page_settings,@plugin_path);
$PLUGINS->configure(open_database(),$page_settings,$session);

my $plugin_type   = '';                          # avoid uninit variable warning
$plugin_type = $PLUGINS->plugin(param('plugin'))->type if param('plugin') && $PLUGINS->plugin(param('plugin'));
my $plugin_action = param('plugin_action') || '';
warn "plugin_action = $plugin_action" if DEBUG_PLUGINS;

# for activating the plugin by URL
if (param('plugin_do')) {
  $plugin_action = $CONFIG->tr(param('plugin_do')) || $CONFIG->tr('Go');
}

# For uploaded files
$UPLOADED_SOURCES = Bio::Graphics::Browser::UploadSet->new($CONFIG,$page_settings);
$REMOTE_SOURCES   = Bio::Graphics::Browser::RemoteSet->new($CONFIG,$page_settings);

## GETTING THE SEGMENT ######################################################
## but only if we have started a search! ##
my $is_search = is_search($page_settings);
my $features  = $is_search ? get_features($page_settings) : [];

if ($plugin_action eq $CONFIG->tr('Find') && param('plugin')) {
  do_plugin_find($page_settings,
		 param('plugin'),
		 $features) or ($plugin_action = 'Configure'); #reconfigure
}

elsif (!@$features && $page_settings->{name} && $is_search) {
  @$features = do_keyword_search($page_settings->{name});
  @$features = do_plugin_autofind($page_settings,$page_settings->{name})
    if !@$features;  # last resort
}

my $segments = features2segments($features);
my @segments = @$segments;

# tell the plugins which segments are in play
$PLUGINS->set_segments(\@segments);
$REMOTE_SOURCES->set_sources([param('eurl')]) if param('eurl');

###############################################################################################

# SETTINGS FOR UPLOADED FILES
my ($file_action) = grep {/^modify\./} param();
(my $file = $file_action) =~ s/^modify\.// if $file_action;


###############################################################################################
## DUMPS ######################################################################################
###############################################################################################
# Check to see whether one of the plugin dumpers was invoked.  We have to do this first
# before printing the header because the plugins are responsible for generating the header.
# NOTE THE EXIT 0 HERE IF THE DUMP IS SUCCESSFUL!
if ((@segments||param('plugin_config'))
     && $plugin_action eq $CONFIG->tr('Go') && $plugin_type eq 'dumper') {
  do_plugin_header(param('plugin'),$page_settings,$cookie);
  do_plugin_dump(param('plugin'),$segments[0],$page_settings) && exit 0
}

# The ImportFeatures plugin is a dumper plugin but does not require a segment.
# it will be invoked here if no segment is defined
elsif ($plugin_action eq $CONFIG->tr('Go') && $plugin_type eq 'dumper' &&
       $PLUGINS->plugin(param('plugin'))->verb eq ($CONFIG->tr('Import')||'Import') ) {

    do_plugin_header(param('plugin'),
		     $page_settings,
		     $cookie);
    do_plugin_dump(param('plugin'),
		   $segments[0],
		   $page_settings) && exit 0
}

###############################################################################################
## HANDLING FILE DOWNLOADS ######################################################################

# This gets called if the user wants to download his annotation data
if (my $to_download = (param($CONFIG->tr('Download_file')) ||
		       ($file_action && param($file_action) eq $CONFIG->tr('Download_file')) && $file)) {
  warn "FILE DOWNLOAD, download = $to_download" if DEBUG;
  print_header(-cookie       => $cookie,
	       -attachment   =>  $to_download,
	       -type         => 'application/octet-stream');
  print_uploaded_file_features($page_settings,$to_download);
  exit 0;
}

warn "TRACKS = @{$page_settings->{tracks}}" if DEBUG;

load_plugin_annotators($page_settings);
warn "ANNOTATOR TRACKS = @{$page_settings->{tracks}}" if DEBUG;

adjust_tracks($page_settings);
auto_open($page_settings,$features) if @$features;

warn "ADJUSTED TRACKS = @{$page_settings->{tracks}}" if DEBUG;

# NOTE: we may exit out on the next statement if the user wants to download a previously-
# uploaded file
handle_uploads($page_settings) || exit 0 unless $CONFIG->section_setting('upload_tracks') eq 'off';

## UPDATING THE PERSISTENT SETTINGS##############################################################

print_header(-cookie => $cookies,
	     -charset=>$CONFIG->tr('CHARSET'),
	    );

if (request_method eq 'HEAD') {exit 0}

my $description = $CONFIG->setting('description');
my $segment;

## STARTING THE PAGE ############################################################################
my $divisor = $CONFIG->setting(general=>'unit_divider') || 1;
my $title;
if ($divisor == 1) {
  $title = @segments == 1 ?
    "$description: ".$segments[0]->seq_id.":".$segments[0]->start.'..'.$segments[0]->end 
    : $description;
} else {
  if (@segments == 1) {
  my $seg_start = unit_label($segments[0]->start);
  my $seg_end   = unit_label($segments[0]->end);
  $title = "$description: ".$segments[0]->seq_id.":".$seg_start.'..'.$seg_end;
  } else {
  $title = $description;
  }
}

print_top($title,param('reset'));


## HANDLE TRACK SETTINGS   #######################################################
if ((param('set_options') || param($CONFIG->tr('Set_options')) || param('revert'))
       && !param($CONFIG->tr('Cancel'))
       && !param($CONFIG->tr('Redisplay'))) {
  set_track_options($page_settings);
}

## HANDLE HELP PAGE   #######################################################

elsif (param('help')) {
  help(param('help'),$CONFIG->setting('help')||GBROWSE_HELP,$page_settings);
}

## HANDLE PLUGIN ABOUT PAGE #####################################################
elsif ($plugin_action eq $CONFIG->tr('About')) {
  do_plugin_about(param('plugin'));
}

## HANDLE PLUGIN CONFIGURATION####################################################
elsif ($plugin_action eq $CONFIG->tr('Configure')) {
  do_plugin_configure(param('plugin'));
}

elsif ($plugin_action eq $CONFIG->tr('Go') && $plugin_type=~/^(finder|annotator|highlighter)$/i) {
  do_plugin_configure(param('plugin'));
}

## MAIN DISPLAY
else {
  my $header = $CONFIG->header;
  print $header || h1($description) if $page_settings->{head};
  main_display($segments,$features,$page_settings);
}

print_bottom($VERSION);

$session->flush or warn "Session error: ",$session->session->errstr;
exit 0;

#################################################################################
#--------------------------------- lots of subroutines --------------------------
#################################################################################

sub main_display {
  my ($segments,$features,$page_settings) = @_;
  my ($segment,$whole_segment);

  # first of all, if there are no segments, then try a keyword search and store the results
  if (param() && (@$segments == 0) && (my $n = $page_settings->{name})) {
      error($CONFIG->tr('NOT_FOUND',escapeHTML($n)));
  }

  # if there's a single segment, then print a message and store the segment into a scalar
  elsif (@$segments == 1) {
    $segment = $segments->[0];

    $whole_segment = whole_segment($segment);

    # truncate the segment to fit within min and max segment boundaries
    resize(\$segment,$whole_segment);

    # $segment = truncated_segment($segment) if $segment->length < 4;
    my $divider = $CONFIG->setting(general=>'unit_divider') || 1;
    my $seg_start = $segment->start;
    my $seg_end   = $segment->end;
    if ($divider != 1 ) {
       $seg_start = unit_label($seg_start);
       $seg_end   = unit_label($seg_end);
    }

    print h2($CONFIG->tr('SHOWING_FROM_TO',
			 scalar unit_label($segment->length),
			 $segment->seq_id,
			 commas($seg_start),
			 commas($seg_end)));
  }

  # force flipping
  if ($segment && $segment->end < $segment->start) {
      $segment = $segment->factory->segment(-name  => $segment->seq_id,
					    -start => $segment->end,
					    -stop  => $segment->start,
					    -absolute => 1);
      $page_settings->{flip} = 1;
  }

  # print the top of the form, with navigation bar, etc
  my $msie_hack = CGI->user_agent =~ /MSIE/ && $CONFIG->setting('msie hack');
  my $src       = $CONFIG->source;
  my $action = $src ? url(-absolute=>1)."/$src/" : url(-absolute=>1);
  print $msie_hack ? startform(-name   => 'mainform',
			       -action => $action,
			       -method => 'GET')
                   : start_multipart_form(-name   => 'mainform',
					  -action => $action,
					  -method => 'POST');
  print navigation_table($segment,$page_settings);
  print html_frag('html2',$segment,$page_settings);

  # NOTE: we may exit out on the next statement if the user wants to download a previously-
  # uploaded file
  my $feature_files = load_external_sources($segments,$page_settings)
    unless $CONFIG->section_setting('upload_tracks') eq 'off';

  # if more than one segment, then list them all
  if (@$segments > 1) {
    multiple_choices($page_settings,$features);
    # empty sections
    # print toggle('Overview','');
    # print toggle('Region','')     if $page_settings->{region_size};
    # print toggle('Details','');
  }

  elsif ($segment) {
    # if a plugin passes us back a Feature, rather than a Segment, turn it into a segment
    # (this shouldn't happen - hah!)
    $segment = open_database()->segment($segment->seq_id,
				        $segment->start,$segment->end)
      unless $segment->can('features');

    print overview_panel($whole_segment,$segment,$page_settings,$feature_files);

    if ($page_settings->{region_size}) {
      my ($region_seg_start, $region_seg_end) = get_regionview_seg($page_settings,$segment->start, $segment->end,
								   $whole_segment->start,$whole_segment->end);
      my $region_segment = open_database()->segment(-name=>$segment->seq_id,
						    -start=>$region_seg_start,
						    -end=>$region_seg_end,
						    -absolute=>1);
      print region_panel($region_segment,$segment,$page_settings,$feature_files);
    }

    print detail_panel_with_timeout($segment,$page_settings,$feature_files);

    print table({-width=>'100%'},
		TR(td({-align=>'left'},
		      a({-href=>"?name=$page_settings->{name};h_feat=_clear_;h_region=_clear_"},
			font({-size=>-2},$CONFIG->tr('Clear_highlighting')))),
		   td({-align=>'right'},
		      b(submit(-name => $CONFIG->tr('Update'))))));

  } else {
    # empty overview,region & detail sections
    # print toggle('Overview','');
    # print toggle('Region','')   if $page_settings->{region_size};
    # print toggle('Details');
  }

  print html_frag('html3',$segment,$page_settings);
  print html_frag('html4',$segment,$page_settings);
  print hr();
  print tracks_table($page_settings,$feature_files);
  print html_frag('html5',$segment,$page_settings);
  print settings_table($page_settings);
  print html_frag('html6',$segment,$page_settings);
  print end_form();

  unless ($CONFIG->section_setting('upload_tracks') eq 'off') {
    print start_multipart_form(-name=>'externalform');
    print external_table($page_settings,$feature_files);
    print end_form();
  }


  # clean us up
  # clean us up
  foreach (values %$feature_files) {
    $_ && ref($_) && eval{$_->finished};
  }
}

sub overview_panel {
  my ($whole_segment,$segment,$page_settings,$feature_files) = @_;
  return '' if $CONFIG->section_setting('overview') eq 'hide';
  my $image = overview($whole_segment,$segment,$page_settings,$feature_files);
  return toggle($page_settings,
		'Overview',
		table({-border=>0,-width=>'100%'},
		      TR({-class=>'databody'},
			 td({-align=>'center'},$image)
			)
		     )
	       );
}

sub region_panel {
  my ($region_segment,$segment,$page_settings,$feature_files) = @_;
  return '' if $CONFIG->section_setting('region') eq 'hide';
  my $image = regionview($region_segment,$segment,$page_settings,$feature_files);
  return toggle($page_settings,
		'Region',
		table({-border=>0,-width=>'100%'},
		      TR({-class=>'databody'},
			 td({-align=>'center'},$image)
			)
		     )
	       );
}


sub detail_panel_with_timeout {
    my @args    = @_;
    my $timeout = $CONFIG->setting('request timeout') || GLOBAL_TIMEOUT;
    local $SIG{ALRM} = sub { die "timeout\n" };
    my $data = eval {
      alarm($timeout);
      detail_panel(@args);
    };
    alarm(0);
    if ($@ =~ /^timeout/) {
      return p(b(font({-size=>'+2'},$CONFIG->tr('TIMEOUT'))));
    } else {
      warn $@ if $@ && $@ !~ /^timeout/ ;
      return $data;
    }
}

sub detail_panel {
  my ($segment,$page_settings,$feature_files) = @_;
  return '' if $CONFIG->section_setting('details') eq 'hide';

  my ($img,$map);
  my $cell = '';

  if ($segment->length <= $MAX_SEGMENT) {

    $CONFIG->width($page_settings->{width});
    my @tracks_to_show = grep {$page_settings->{features}{$_}{visible} && !/:(overview|region)$/ }
                               @{$page_settings->{tracks}};

#    if ($page_settings->{sk} eq "sorted") {
#      my %label_keys = map {$_ => label2key($_)}  @tracks_to_show;
#      @tracks_to_show    = sort {lc $label_keys{$a} cmp lc $label_keys{$b}} @tracks_to_show;
#    }

    my %options = map {$_=>$page_settings->{features}{$_}{options}} @tracks_to_show;
    my %limit   = map {$_=>$page_settings->{features}{$_}{limit}}   @tracks_to_show;
    my $h_callback = make_hilite_callback($page_settings);
    my $postgrid   = make_postgrid_callback($page_settings);
    ($img,$map) = $CONFIG->render_html(segment       => $segment,
				       feature_files => $feature_files,
				       tracks        => \@tracks_to_show,
				       options       => \%options,
				       limit         => \%limit,
				       do_map        => 1,
				       do_centering_map => 1,
				       lang          => $CONFIG->language,
				       keystyle      => $page_settings->{ks}   || 'between',
				       flip          => $page_settings->{flip} || undef,
                                       postgrid      => $postgrid || $CONFIG->setting('postgrid') || '',
                                       background    => $CONFIG->setting('background') || '',
				       hilite_callback => $h_callback || undef,
				       -add_category_labels => $CONFIG->setting('show track categories') || undef,
				       -grid         => $page_settings->{grid} || 0,
				      );
    $cell .= $img;
  }

  else {
    $cell .= i($CONFIG->tr('TOO_BIG',scalar unit_label($MAX_SEGMENT),scalar unit_label($DEFAULT_SEGMENT)));
  }
  $cell .= "\n";
  my $error_msg = $CONFIG->error ? p({-style=>"color: red"},
				     "An error occurred while processing an uploaded or remote annotation file: ",
				     b($CONFIG->error) ) : '';
  my $table = table({-border=>0,-width=>'100%'},
		    TR({-class=>'databody'},
		       td({-align=>'center'},$cell)
		      ),
		    $error_msg ? (
				  TR({-class=>'databody'},
				     td($error_msg)
				    )
				  ) : (),
		   );
  $table .= "\n";
  $table .= $map if $map;
  $table .= join '',unique(hidden('ref')),unique(hidden('start')),unique(hidden('stop'));
  return div(toggle($page_settings,
		    'Details',
		    $table));
}

###############################################################################################

sub page_settings {
  my $config = shift;

  my $source = param('source') || param('src') || path_info();
  $source    =~ s!^/+!!;  # get rid of leading & trailing / from path_info()
  $source    =~ s!/+$!!;

  my @sources = sort $config->sources;
  my %sources = map {$_=>1} @sources;
  if ($source) {
    if ($sources{$source}) {
      $config->source($source);
    } else {
      error($CONFIG->tr('INVALID_SOURCE',$source));
    }
  }

  my $session       = Bio::Graphics::Browser::PageSettings->new($config,param('id'));
  $source         ||= $session->source;
  $source         ||= $sources[0];
  redirect_legacy_url($source); # may cause a redirect and exit!!!

  my $old_source    = $session->source($source);
  $config->source($source);

  # NOTE: bad form to set these globals here, but they are needed by adjust_settings();
  $MAX_SEGMENT     = $CONFIG->get_max_segment;
  $DEFAULT_SEGMENT = $CONFIG->get_default_segment;

  # do not change the page settings when the user is changing from one
  # database source to another
  my $page_settings = get_settings($session);
  adjust_settings($page_settings);  # unless $old_source and $old_source ne $source; # no longer needed?
  return ($page_settings,$session);
}

# read from cookie, if there is one
# if not, set  from defaults
sub get_settings {
  my $session   = shift;
  my $hash             = $session->page_settings;
  delete $hash->{flip}; # obnoxious for this to persist
  default_settings($hash) if param('reset') or !%$hash;
  $hash->{id}          = $session->id;
  $hash;
}

sub default_settings {
  my $settings = shift;
  warn "Setting default settings" if DEBUG;
  %$settings = ();
  @$settings{'name','ref','start','stop','flip','version'} = ('','','','','',100);
  $settings->{width}   = $CONFIG->setting('default width');
  $settings->{source}  = $CONFIG->source;
  $settings->{region_size}  = $CONFIG->setting('region segment');
  $settings->{v}       = $VERSION;
  $settings->{stp}     = 1;
  $settings->{ins}     = 1;
  $settings->{head}    = 1;
  $settings->{ks}      = 'between';
  $settings->{grid}    = 1;
  $settings->{sk}      = $CONFIG->setting("default varying") ? "unsorted" : "sorted";
  set_default_tracks($settings);
}

sub set_default_tracks {
  my $settings = shift;
  my @labels = $CONFIG->labels;

  $settings->{tracks}   = \@labels;
  warn "order = @labels" if DEBUG;
  foreach (@labels) {
    $settings->{features}{$_} = {visible=>0,options=>0,limit=>0};
  }
  foreach ($CONFIG->default_labels) {
    $settings->{features}{$_}{visible} = 1;
  }
}

# This is called to check that the list of feature types given
# in the configuration file are consistent with the features
# given in the user's cookie.  If not, the settings are adjusted
# as best we can. The attempt here is to allow
# the administrator to add new feature stanzas
# without invalidating users' old settings.
sub adjust_tracks {
  my $settings = shift;

  my %configured_labels = map {$_=>1} $CONFIG->labels;

  # tracks added to the config file recently that are not contained in
  # user's stored settings.
  foreach (grep {!$settings->{features}{$_}} keys %configured_labels) {
    $settings->{features}{$_}{visible} = 0;  # not visible
    $settings->{features}{$_}{options} = 0;  # automatic
    push @{$settings->{tracks}},$_;           # at the end
  }
  # Remove any feature types that are not mentioned in the
  # config file, excepting Uploaded and remote URL features.
  # This may happen if a stanza is removed from the config file.
  my %extra = map {$_=>1} grep {!/^(http|ftp|das|file|plugin):/
				    && !$configured_labels{$_}} keys %{$settings->{features}};
  my @extra_plugins = grep {!$PLUGIN_NAME2LABEL{$_}} grep {/^plugin:/} keys %{$settings->{features}};
  # remove extra from tracks && options
  if (%extra || @extra_plugins) {
    delete $settings->{features}{$_} foreach (keys %extra,@extra_plugins);
  }

  # make sure that tracks are completely consistent with options
  $settings->{tracks} = [grep {exists $settings->{features}{$_}} @{$settings->{tracks}}];
}

# auto-open any tracks that match the search term
sub auto_open {
  my ($settings,$features) = @_;
  my $tracks = $settings->{features};
  for my $feature (@$features) {
    my $desired_label = $CONFIG->feature2label($feature) or next;
    if (exists $tracks->{$desired_label}) {
      $tracks->{$desired_label}{visible} = 1;
      $settings->{h_feat} = {};
      $settings->{h_feat}{$feature->display_name} = 'yellow' unless param('h_feat') && param('h_feat') eq '_clear_';
    }
  }
}

sub reset_cookies {
  my @cookies;
  foreach my $c (CGI::cookie()) {
    push @cookies,CGI::Cookie->new(-name => $c,
				   -path => url(-path_info=>1,-absolute=>1),
				   -expires => '-1y'
				  );
    push @cookies,CGI::Cookie->new(-name=>'CGI__Toggle',
				   -path => '/',         # fix a bug introduced by transitional versions of software
				   -expires => '-1y');
  }
  return \@cookies;
}

# This is called to change the values of the settings
sub adjust_settings {
  my $settings = shift;

  $settings->{grid} = 1 unless exists $settings->{grid};  # to upgrade from older settings

  if (param('width') || param('label')) { # just looking to see if the settings form was submitted
    my @selected = split_labels (param('label'));
    $settings->{features}{$_}{visible} = 0 foreach keys %{$settings->{features}};
    $settings->{features}{$_}{visible} = 1 foreach @selected;
    $settings->{flip}                  = param('flip');
    $settings->{grid}                  = param('grid');
  }

  if (my @selected = split_labels(param('enable'))) {
    $settings->{features}{$_}{visible} = 1 foreach @selected;
  }

  if (my @selected = split_labels(param('disable'))) {
    $settings->{features}{$_}{visible} = 0 foreach @selected;
  }

  $settings->{width}  = param('width')   if param('width');
  my $divider  = $CONFIG->setting('unit_divider') || 1;

  # Update coordinates.
  local $^W = 0;  # kill uninitialized variable warning
  $settings->{ref}   = param('ref');
  $settings->{start} = param('start') if defined param('start') && param('start') =~ /^[\d-]+/;
  $settings->{stop}  = param('stop')  if defined param('stop')  && param('stop')  =~ /^[\d-]+/;
  $settings->{stop}  = param('end')   if defined param('end')   && param('end')   =~ /^[\d-]+/;

  $settings->{version} ||= param('version') || '';

  if ( (request_method() eq 'GET' && param('ref'))
       ||
       (param('span') && $settings->{stop}-$settings->{start}+1 != param('span'))
       ||
       grep {/left|right|zoom|nav|regionview\.[xy]|overview\.[xy]/} param()
     )
    {
      zoomnav($settings);
      $settings->{name} = "$settings->{ref}:$settings->{start}..$settings->{stop}";
      param(name => $settings->{name});
    }

  foreach (qw(name source plugin stp ins head
	      ks sk version)) {
    $settings->{$_} = param($_) if defined param($_);
  }
  $settings->{name} =~ s/^\s+//; # strip leading
  $settings->{name} =~ s/\s+$//; # and trailing whitespace

  if (my @features = shellwords(param('h_feat'))) {
    $settings->{h_feat} = {};
    for my $hilight (@features) {
      last if $hilight eq '_clear_';
      my ($featname,$color) = split '@',$hilight;
      $settings->{h_feat}{$featname} = $color || 'yellow';
    }
  }

  if (my @regions = shellwords(param('h_region'))) {
    $settings->{h_region} = [];
    foreach (@regions) {
      last if $_ eq '_clear_';
      $_ = "$settings->{ref}:$_" unless /^[^:]+:-?\d/; # add reference if not there
      push @{$settings->{h_region}},$_;
    }
  }

  if ($CONFIG->setting('region segment')) {
    $settings->{region_size} = param('region_size') if defined param('region_size');
    $settings->{region_size} = $CONFIG->setting('region segment') unless defined $settings->{region_size};
  } else {
    delete $settings->{region_size};
  }

  if (my @external = param('eurl')) {
    my %external = map {$_=>1} @external;
    foreach (@external) {
      warn "eurl = $_" if DEBUG_EXTERNAL;
      next if exists $settings->{features}{$_};
      $settings->{features}{$_} = {visible=>1,options=>0,limit=>0};
      push @{$settings->{tracks}},$_;
    }
    # remove any URLs that aren't on the list
    foreach (keys %{$settings->{features}}) {
      next unless /^(http|ftp):/;
      delete $settings->{features}{$_} unless exists $external{$_};
    }
  }

  # the "q" request overrides name, ref, and h_feat
  if (my @q = param('q')) {
    delete $settings->{$_} foreach qw(name ref h_feat h_region);
    $settings->{q} = [map {split /[+-]/} @q];
  }

  if (param('revert')) {
    warn "resetting defaults..." if DEBUG;
    set_default_tracks($settings);
  }

  elsif (param('reset')) {
    %$settings = ();
    #    Delete_all();
    default_settings($settings);
  }

  elsif (param($CONFIG->tr('Adjust_Order')) && !param($CONFIG->tr('Cancel'))) {
    adjust_track_options($settings);
    adjust_track_order($settings);
  }

  # restore the visibility of the division sections
  # using transient cookies
  for my $div (grep {/^div_visible_/} CGI::cookie()) {
    my ($section)   = $div =~ /^div_visible_(\w+)/ or next;
    my $visibility  = CGI::cookie($div);
    $settings->{section_visible}{$section} = $visibility;
  }

}

# prints the zooming and navigation bar
sub navigation_table {
  my $segment = shift;
  my $settings = shift;
  my $buttonsDir    = $CONFIG->setting('buttons');
  my $table        = '';
  my $svg_link     = $HAVE_SVG? a({-href=>svg_link($settings),-target=>'_blank'},'['.$CONFIG->tr('SVG_LINK').']'):'';
  my $reset_link   = a({-href=>"?reset=1",-class=>'reset_button'},'['.$CONFIG->tr('RESET').']');
  my $help_link    =  a({-href=>general_help(),-target=>'help'},'['.$CONFIG->tr('Help').']');
  my $plugin_link  = plugin_links($PLUGINS);
  my $oligo        = $PLUGINS->plugin('OligoFinder') ? ', oligonucleotide (15 bp minimum)' : '';
  my $rand         =   substr(md5_hex(rand),0,5);

  $table .= table({-border=>0, -width=>'100%',-cellspacing=>0,-class=>'searchtitle'},
		  TR(
		     td({-align=>'left', -colspan=>2},
		     toggle($settings,
			    'Instructions',
			    br(),
			    $CONFIG->setting('search_instructions') ||
			    $CONFIG->tr('SEARCH_INSTRUCTIONS',$oligo),
			    $CONFIG->setting('navigation_instructions') ||
			    $CONFIG->tr('NAVIGATION_INSTRUCTIONS'),
			    br(),
			    p(show_examples())
			   )
		       ),
		    ),
		  TR(
		     th({-align=>'left', -colspan=>2,-class=>'linkmenu'},
			 $settings->{name} || $settings->{ref} ?
			 (
			  a({-href=>"?rand=$rand;head=".((!$settings->{head})||0)},
			    '['.$CONFIG->tr($settings->{head} ? 'HIDE_HEADER' : 'SHOW_HEADER').']'),
			  a({-href=>bookmark_link($settings)},'['.$CONFIG->tr('BOOKMARK').']'),
			  a({-href=>image_link($settings),-target=>'_blank'},'['.$CONFIG->tr('IMAGE_LINK').']'),
			  $plugin_link,
			  $svg_link,
			 ) : (),
			$help_link,
			$reset_link
		       ),
		     )
		 );

  my $searchbox = $CONFIG->setting('no search')
    ? '' : b($CONFIG->tr('Landmark')).':'.br.
           textfield(-name=>'name',-size=>25,-default=>$settings->{name}).
	   submit(-name=>$CONFIG->tr('Search'));
  my $plugin_menu = plugin_menu($settings,$PLUGINS);
  my $plugins     = $plugin_menu ? b($CONFIG->tr('Dumps')).':'.br.$plugin_menu : '';

  $table .= toggle($settings,
		   'Search',
		   table({-border=>0, -width=>'100%',-cellspacing=>0,-class=>'searchtitle'},
			 TR({-class=>'searchbody'},
			    td({-align=>'left', -colspan=>2},
			       html_frag('html1',$segment,$settings)||''
			      )
			   ),

			 TR({-class=>'searchbody'},
			    td({-align=>'left'},
			       $searchbox
			      ),
			    td({-colspan=>1,-align=>'left'},
			       $plugins
			      )
			   ),
			 TR({-class=>'searchbody',-style=>'padding-top: 5 px'},
			    td({-align=>'left'},source_menu($settings)),
			    td({-align=>'left'},
			       $segment ? (
					   (b($CONFIG->tr('Scroll').': '),slidertable($segment,$buttonsDir)),
					   b(
					     checkbox(-name=>'flip',
						      -checked=>$settings->{flip},-value=>1,
						      -label=>$CONFIG->tr('Flip'),-override=>1))
					  )
			       : '',
			      ),
			   ),
			)
		  );
  return $table;
}

# this generates the callback for highlighting "interesting" features
sub make_hilite_callback {
  my $settings = shift;
  my @hiliters = grep {$_->type eq 'highlighter'} $PLUGINS->plugins;
  return unless @hiliters or ($settings->{h_feat} && %{$settings->{h_feat}});
  return sub {
    my $feature = shift;
    my $color;

    # run through the set of hilite plugins and give each one
    # a chance to choose the highlighting for its feature
    foreach (@hiliters) {
      $color ||= $_->highlight($feature);
    }
    return $color if $color;

    # if we get here, we select the search term for highlighting
    return unless $feature->display_name;
    return $settings->{h_feat}{$feature->display_name};
  }
}

# this generates the callback for highlighting a region
sub make_postgrid_callback {
  my $settings = shift;
  my @h_regions;
  return unless ref $settings->{h_region};
  for my $r (@{$settings->{h_region}}) {
    my ($h_ref,$h_start,$h_end,$h_color) = $r =~ /^(.+):(\d+)\.\.(\d+)(?:@(\S+))?/ or next;
    next unless $h_ref eq $settings->{ref};
    push @h_regions,[$h_start,$h_end,$h_color||'lightgrey'];
  }
  @h_regions or return;

  return sub {
    my $gd     = shift;
    my $panel  = shift;
    my $left   = $panel->pad_left;
    my $top    = $panel->top;
    my $bottom = $panel->bottom;
    for my $r (@h_regions) {
      my ($h_start,$h_end,$h_color) = @$r;
      my ($start,$end) = $panel->location2pixel($h_start,$h_end);
      $gd->filledRectangle($left+$start,$top,$left+$end,$bottom,
			   $panel->translate_color($h_color));
    }
  }
}

# This generates the navigation bar with the arrows
sub slidertable {
  my ($segment,$buttonsDir) = @_;
  my $span      = $segment->length;
  my $half_title      = unit_label(int $span/2);
  my $full_title      = unit_label($span);
  my $half      = int $span/2;
  my $full      = $span;
  my $fine_zoom = get_zoomincrement();
  Delete($_) foreach qw(ref start stop);

  my @lines;
  push @lines,hidden(-name=>'start',-value=>$segment->start,-override=>1);
  push @lines,hidden(-name=>'stop', -value=>$segment->end,-override=>1);
  push @lines,hidden(-name=>'ref',  -value=>$segment->seq_id,-override=>1);
  push @lines,
    (image_button(-src=>"$buttonsDir/green_l2.gif",-name=>"left $full",
		  -title=>"left $full_title"),
     image_button(-src=>"$buttonsDir/green_l1.gif",-name=>"left $half",
		  -title=>"left $half_title"),
     '&nbsp;',
     image_button(-src=>"$buttonsDir/minus.gif",-name=>"zoom out $fine_zoom",
		  -title=>"zoom out $fine_zoom"),
     '&nbsp;',
     zoomBar($segment,$buttonsDir),
     '&nbsp;',
     image_button(-src=>"$buttonsDir/plus.gif",-name=>"zoom in $fine_zoom",
		  -title=>"zoom in $fine_zoom"),
     '&nbsp;',
     image_button(-src=>"$buttonsDir/green_r1.gif",-name=>"right $half",
		  -title=>"right $half_title"),
     image_button(-src=>"$buttonsDir/green_r2.gif",-name=>"right $full",
		  -title=>"right $full_title"),
    );

  my $str	= join('', @lines);
  return $str;
}

# this generates the popup zoom menu with the window sizes
sub zoomBar {
  my ($segment,$buttonsDir) = @_;
  my $show = $CONFIG->tr('Show');

  my %seen;
  my @ranges	= grep {!$seen{$_}++} sort {$b<=>$a} $segment->length,get_ranges();
  my %labels    = map {$_=>$show.' '.unit_label($_)} @ranges;
  return popup_menu(-class   => 'searchtitle',
	       -name    => 'span',
	       -values  => \@ranges,
	       -labels  => \%labels,
	       -default => $segment->length,
	       -force   => 1,
	       -onChange => 'document.mainform.submit()',
	      );
}

# convert bp into nice Mb/Kb units
sub unit_label {
  my $value = shift;
  my $unit     = $CONFIG->setting('units')        || 'bp';
  my $divider  = $CONFIG->setting('unit_divider') || 1;
  $value /= $divider;
  my $abs = abs($value);

  my $label;
  $label = $abs >= 1e9  ? sprintf("%.4g G%s",$value/1e9,$unit)
         : $abs >= 1e6  ? sprintf("%.4g M%s",$value/1e6,$unit)
         : $abs >= 1e3  ? sprintf("%.4g k%s",$value/1e3,$unit)
	 : $abs >= 1    ? sprintf("%.4g %s", $value,    $unit)
	 : $abs >= 1e-2 ? sprintf("%.4g c%s",$value*100,$unit)
	 : $abs >= 1e-3 ? sprintf("%.4g m%s",$value*1e3,$unit)
	 : $abs >= 1e-6 ? sprintf("%.4g u%s",$value*1e6,$unit)
	 : $abs >= 1e-9 ? sprintf("%.4g n%s",$value*1e9,$unit)
         : sprintf("%.4g p%s",$value*1e12,$unit);
  if (wantarray) {
    return split ' ',$label;
  } else {
    return $label;
  }
}

# convert Mb/Kb back into bp... or a ratio
sub unit_to_value {
  my $string = shift;
  my $sign           = $string =~ /out|left/ ? '-' : '+';
  my ($value,$units) = $string =~ /([\d.]+) ?(\S+)/;
  return unless defined $value;
  $value /= 100   if $units eq '%';  # percentage;
  $value *= 1000  if $units =~ /kb/i;
  $value *= 1e6   if $units =~ /mb/i;
  $value *= 1e9   if $units =~ /gb/i;
  return "$sign$value";
}

# This subroutine is invoked to draw the checkbox group underneath the main display.
# It creates a hyperlinked set of feature names.
sub tracks_table {
  my $settings = shift;
  my $additional_features = shift;


  # read category table information
  my %category_table_labels=%{category_table()};

  # set up the dumps line.
  my($ref,$start,$stop) = @{$settings}{qw(ref start stop)};
  my $source   = $CONFIG->source;
  my $self_url = "?help=citations";

  my @labels     = @{$settings->{tracks}};
  my %labels     = map {$_ => make_citation_link($_,$self_url) } @labels;
  my %label_keys = map {$_ => label2key($_)}                     @labels;
  my @defaults   = grep {$settings->{features}{$_}{visible}  }   @labels;

  # Sort the tracks into categories:
  # Overview tracks
  # Region tracks
  # Regular tracks (which may be further categorized by user)
  # Plugin tracks
  # External tracks
  my %track_groups;
  foreach (@labels) {
    my $category = categorize_track($_);
    push @{$track_groups{$category}},$_;
  }

  autoEscape(0);
  my @sections;

  my %exclude = map {$_=>1} map {$CONFIG->tr($_)} qw(OVERVIEW REGION ANALYSIS EXTERNAL);

  my @user_keys = grep {!$exclude{$_}} sort keys %track_groups;

  my $all_on  = $CONFIG->tr('ALL_ON');
  my $all_off = $CONFIG->tr('ALL_OFF');

  my %seenit;
  foreach my $category ($CONFIG->tr('OVERVIEW'),
			$CONFIG->tr('REGION'),
			$CONFIG->tr('ANALYSIS'),
			@user_keys,
			$CONFIG->section_setting('upload_tracks') eq 'off' ? () : ($CONFIG->tr('EXTERNAL')),
		       ) {
    next if $seenit{$category}++;
    my $table;
    my $id = "${category}_section";

    if ($category eq $CONFIG->tr('REGION') && !$CONFIG->setting('region segment')) {
     next;
    }
    elsif  (exists $track_groups{$category}) {
    my @track_labels = @{$track_groups{$category}};


    # stop the grid display elements being sorted since this destroys the order of the grid 
    if ( ! defined $category_table_labels{$category} ) { 
      @track_labels = sort {lc $label_keys{$a} cmp lc $label_keys{$b}} @track_labels
	if ($settings->{sk} eq "sorted");
    }

    my @disabled_list=();
    foreach my $l (@track_labels) {
      if ($CONFIG->setting($l=>'disabled')) {
	push(@disabled_list,$l);
	$labels{$l} = label2key($l);
      }
    }

    my @args = (-name       => 'label',
		-values     => \@track_labels,
		-labels     => \%labels,
		-defaults   => \@defaults,
		-onClick    => "gbTurnOff('$id')",
		-override   => 1);
    push @args,(-disabled=>\@disabled_list) if $CGI::VERSION >= 3.27;

    my @checkboxes = checkbox_group(@args);

    $table = tableize(\@checkboxes,$category);
    $table =~ s/<tr>/<tr class="searchtitle">/g;

    my $visible = exists $settings->{section_visible}{$id} ? $settings->{section_visible}{$id} : 1;

    my ($control,$section)=toggle_section({on=>$visible,nodiv=>1},
					  $id,
					  b(ucfirst $category),div({-style=>'padding-left:1em'},span({-id=>$id},$table)));
    $control .= '&nbsp;'.i({-class=>'nojs'},
			   checkbox(-id=>"${id}_a",-name=>"${id}_a",
				    -label=>$all_on,-onClick=>"gbCheck(this,1)"),
			   checkbox(-id=>"${id}_n",-name=>"${id}_n",
				    -label=>$all_off,-onClick=>"gbCheck(this,0)")
			  ).br()   if exists $track_groups{$category};
    push @sections,div($control.$section);
    $id++;
  }

    else {
      next;
    }

  }

  autoEscape(1);
  return toggle($settings,
		'Tracks',
		div({-class=>'searchbody',-style=>'padding-left:1em'},@sections),
		table({-width=>'100%',-class=>"searchbody"},
		      TR(td{-align=>'right'},
			 submit(-name => $CONFIG->tr('Set_options')),
			 b(submit(-name => $CONFIG->tr('Update'))
			  )
			)
		     ));
}

sub categorize_track {
  my $label = shift;
  return $CONFIG->tr('OVERVIEW') if $label =~ /:overview$/;
  return $CONFIG->tr('REGION')   if $label =~ /:region$/;
  return $CONFIG->tr('EXTERNAL') if $label =~ /^(http|ftp|file):/;
  return $CONFIG->tr('ANALYSIS') if $label =~ /^plugin:/;

  my $category;
  for my $l ($CONFIG->language->language) {
    $category      ||= $CONFIG->setting($label=>"category:$l");
  }
  $category        ||= $CONFIG->setting($label => 'category');
  $category        ||= '';  # prevent uninit variable warnings
  $category         =~ s/^["']//;  # get rid of leading quotes
  $category         =~ s/["']$//;  # get rid of trailing quotes
  return $category ||= $CONFIG->tr('GENERAL');
}


sub settings_table {
  my $settings = shift;

  my @widths = split /\s+/,$CONFIG->setting('image widths');
  @widths = (640,800,1024) unless @widths;
  my @key_positions   = qw(between bottom);
  push @key_positions,qw(left right) if Bio::Graphics::Panel->can('auto_pad');

  my $feature_highlights = $settings->{h_feat}   ?
    join ' ',map { "$_\@$settings->{h_feat}{$_}"   } keys %{$settings->{h_feat}} : '';

  my $region_highlights  = $settings->{h_region} ?
    join ' ',@{$settings->{h_region}} : '';

  my $content =
    table({-class=>'searchbody',-border=>0,-width=>'100%'},
	  TR(
	     td(
		b($CONFIG->tr('Image_width')),br,
		radio_group( -name=>'width',
			     -values=>\@widths,
			     -default=>$settings->{width},
			     -override=>1,
			   ),
	       ),
	     $CONFIG->setting('region segment') ?
	     (
	      td(b($CONFIG->tr('Region_size')),br,
		 textfield(-name=>'region_size',
			   -default=>$settings->{region_size},
			   -override=>1,
			   -size=>20),
		)
	     ) : (),
	     td(
		b($CONFIG->tr('KEY_POSITION')),br,
		radio_group( -name=>'ks',
			     -values=>\@key_positions,
			     -labels=>{between=>$CONFIG->tr('BETWEEN'),
				       bottom =>$CONFIG->tr('BENEATH'),
				       left   =>$CONFIG->tr('LEFT'),
				       right  =>$CONFIG->tr('RIGHT'),
				      },
			     -default=>$settings->{ks},
			     -override=>1
			   ),
	       ),
             td(
                b($CONFIG->tr("TRACK_NAMES")),br,
                radio_group( -name=>"sk",
                             -values=>["sorted","unsorted"],
                             -labels=>{sorted   =>$CONFIG->tr("ALPHABETIC"),
                                       unsorted =>$CONFIG->tr("VARYING")},
                             -default=>$settings->{sk},
                             -override=>1
                           ),
               ),
	    ),
	  TR(
	     td(
		span({-title=>$CONFIG->tr('FEATURES_TO_HIGHLIGHT_HINT')},
		     b(
		       $CONFIG->tr('FEATURES_TO_HIGHLIGHT')
		      ),br,
		     textfield(-name  => 'h_feat',
			       -value => $feature_highlights,
			       -size  => 50,
			       -override=>1,
			      ),
		    ),
	       ),
	     td(
		span({-title=>$CONFIG->tr('REGIONS_TO_HIGHLIGHT_HINT')},
		     b(
		       $CONFIG->tr('REGIONS_TO_HIGHLIGHT')
		      ),br,
		     textfield(-name=>'h_region',
			       -value=>$region_highlights,
			       -size=>50,
			       -override=>1,
			      ),
		    ),
	       ),
	     td(
		b(
		  checkbox(-name=>'grid',
			   -label=>$CONFIG->tr('SHOW_GRID'),
			   -override=>1,
			   -checked=>$settings->{grid}||0)
		 )
	       ),
	    ),
	  TR(td({-colspan=>4,
		 -align=>'right'},
		b(submit(-name => $CONFIG->tr('Update')))))
	 );
  return toggle($settings,
		'Display_settings',$content);
}

sub annotation_help {
  return "?help=annotation";
}

sub general_help {
  return "?help=general";
}

sub external_table {
  my ($settings,$feature_files) = @_;
  my $upload_table = upload_table($settings,$feature_files);
  my $das_table    = das_table($settings,$feature_files);
  toggle($settings,
	 'Upload_tracks',
	 table({-width=>'100%',-class=>'searchbody'},
	       TR(td($upload_table,$das_table))));
}

sub upload_table {
  my $settings      = shift;
  my $feature_files = shift;

  # start the table.
  my $cTable = start_table({-border=>0,-width=>'100%'})
    . TR(
	 th({-class=>'uploadtitle', -colspan=>4, -align=>'left'},
	    $CONFIG->tr('Upload_title').':',
	    a({-href=>annotation_help(),-target=>'help'},'['.$CONFIG->tr('HELP').']'))
	);

  # now add existing files
  for my $file ($UPLOADED_SOURCES->files) {
    (my $name = $file) =~ s/^file://;
    $name = escape($name);
    my $download = escape($CONFIG->tr('Download_file'));
    my $link = a({-href=>"?$download=$file"},"[$name]");
    my @info =  get_uploaded_file_info($settings->{features}{$file}{visible}
				       && $feature_files->{$file});
    $cTable .=  TR({-class=>'uploadbody'},
		   th($link),
		   td({-colspan=>3},
		      submit(-name=>"modify.$file",-value=>$CONFIG->tr('Edit')).'&nbsp;'.
		      submit(-name=>"modify.$file",-value=>$CONFIG->tr('Download_file')).'&nbsp;'.
		      submit(-name=>"modify.$file",-value=>$CONFIG->tr('Delete'))));
    $cTable .= TR({-class=>'uploadbody'},td('&nbsp;'),td({-colspan=>3},@info));
  }

  # end the table.
  $cTable .= TR({-class=>'uploadbody'},
		th({-align=>'right'},$CONFIG->tr('Upload_File')),
		td({-colspan=>3},
		   filefield(-size=>40,-name=>'upload_annotations'),
		   '&nbsp;',
		   submit(-name=>$CONFIG->tr('Upload')),
		   '&nbsp;',
		   submit(-name=>'new_upload',-value=>$CONFIG->tr('New')),
		  )
	       );
  $cTable .= end_table;
  $cTable;
}

# URLs for external annotations
sub das_table {
  my $settings      = shift;
  my $feature_files = shift;
  my (@rows,$count);

  my ($preset_labels,$preset_urls) = get_external_presets($settings);  # (arrayref,arrayref)
  my $presets = '&nbsp;';
  if ($preset_labels && @$preset_labels) {  # defined AND non-empty
    my %presets;
    @presets{@$preset_urls} = @$preset_labels;
    unshift @$preset_urls,'';
    $presets{''} = $CONFIG->tr('PRESETS');
    $presets = popup_menu(-name   => 'eurl',
			  -values => $preset_urls,
			  -labels => \%presets,
			  -override => 1,
			  -default  => '',
			  -onChange => 'document.externalform.submit()'
			 );
  }

  local $^W = 0;
  if (defined $settings->{ref}) {
    my $segment = "$settings->{ref}:$settings->{start},$settings->{stop}";
    for my $url ($REMOTE_SOURCES->sources) {

      (my $f = $url) =~ s!(http:.+/das/\w+)(?:\?(.+))?$!$1/features?segment=$segment;$2!;
      warn "url = $url" if DEBUG_EXTERNAL;
      next unless $url =~ /^(ftp|http):/ && $feature_files->{$url};
      warn "external_table(): url = $url" if DEBUG;
      push @rows,th({-align=>'right',-valign=>'TOP'},"URL",++$count).
	td(textfield(-name=>'eurl',-size=>50,-value=>$url,-override=>1),br,
	   a({-href=>$f,-target=>'help'},'['.$CONFIG->tr('Download').']'),
	   get_uploaded_file_info($settings->{features}{$url}{visible} && $feature_files->{$url})
	  );
    }
    push @rows,th({-align=>'right'},
		  $CONFIG->tr('Remote_url')).
		    td(textfield(-name=>'eurl',-size=>40,-value=>'',-override=>1),
		       $presets);
  }

  return table({-border=>0,-width=>'100%'},
	       TR(
		  th({-class=>'uploadtitle',-align=>'left',-colspan=>2},
		     $CONFIG->tr('Remote_title').':',
		     a({-href=>annotation_help().'#remote',-target=>'help'},'['.$CONFIG->tr('Help').']'))),
	       TR({-class=>'uploadbody'},\@rows),
	       TR({-class=>'uploadbody'},
		  th('&nbsp;'),
		  th({-align=>'left'},submit($CONFIG->tr('Update_urls'))))
	      );
}

sub get_external_presets {
  my $settings = shift;
  my $presets  = $CONFIG->setting('remote sources') or return;
  my @presets  = shellwords($presets||'');
  my (@labels,@urls);
  while (@presets) {
    my ($label,$url) = splice(@presets,0,2);
    next unless $url && $url =~ /^(http|ftp)/;
    push @labels,$label;
    push @urls,$url;
  }
  return unless @labels;
  return (\@labels,\@urls) if wantarray;
  my %presets;
  @presets{@urls} = @labels;
  return \%presets;
}

# computes the new values for start and stop when the user made use of the zooming bar or navigation bar
sub zoomnav {
  my $settings = shift;
  return unless $settings->{ref};
  my $start = $settings->{start};
  my $stop  = $settings->{stop};
  my $span  = $stop - $start + 1;
  my $divisor = $CONFIG->setting(general=>'unit_divider') || 1;

  warn "before adjusting, start = $start, stop = $stop, span=$span" if DEBUG;

  my $flip  = $settings->{flip} ? -1 : 1;

  # get zoom parameters
  my $selected_span  = param('span');
  my ($zoom)         = grep {/^zoom (out|in) \S+/} param();
  my ($nav)          = grep {/^(left|right) \S+/}  param();
  my $overview_x     = param('overview.x');
  my $regionview_x     = param('regionview.x');
  my $regionview_size  = $settings->{region_size};
  my $seg_min          = param('seg_min');
  my $seg_max          = param('seg_max');
  my $segment_length   = $seg_max - $seg_min + 1 if defined $seg_min && defined $seg_max;

  my $zoomlevel = unit_to_value($1) if $zoom && $zoom =~ /((?:out|in) .+)\.[xy]/;
  my $navlevel  = unit_to_value($1) if $nav  && $nav  =~ /((?:left|right) .+)/;

  if (defined $zoomlevel) {
    warn "zoom = $zoom, zoomlevel = $zoomlevel" if DEBUG;
    my $center	    = int($span / 2) + $start;
    my $range	    = int($span * (1-$zoomlevel)/2);
    $range          = 1 if $range < 1;
    ($start, $stop) = ($center - $range , $center + $range - 1);
  }

  elsif (defined $navlevel){
    $start += $flip * $navlevel;
    $stop  += $flip * $navlevel;
  }

  elsif (defined $overview_x && defined $segment_length) {
    my @overview_tracks = grep {$settings->{features}{$_}{visible}} 
         $CONFIG->config->overview_tracks;
    my ($padl,$padr) = $CONFIG->overview_pad(\@overview_tracks);

    my $overview_width = ($settings->{width} * OVERVIEW_RATIO);

    # adjust for padding in pre 1.6 versions of bioperl
    $overview_width -= ($padl+$padr) unless Bio::Graphics::Panel->can('auto_pad');
    my $click_position = $seg_min + $segment_length * ($overview_x-$padl)/$overview_width;

    $span = $DEFAULT_SEGMENT if $span > $MAX_SEGMENT;
    $start = int($click_position - $span/2);
    $stop  = $start + $span - 1;
  }

  elsif (defined $regionview_x) {
    my $whole_start = param('seg_min');
    my $whole_stop  = param('seg_max');
    my ($regionview_start, $regionview_end) = get_regionview_seg($settings,$start, $stop, $whole_start, $whole_stop);
    my @regionview_tracks = grep {$settings->{features}{$_}{visible}} 
      $CONFIG->config->regionview_tracks;
    my ($padl,$padr) = $CONFIG->overview_pad(\@regionview_tracks);

    my $regionview_width = ($settings->{width} * OVERVIEW_RATIO);

    # adjust for padding in pre 1.6 versions of bioperl
    $regionview_width -= ($padl+$padr) unless Bio::Graphics::Panel->can('auto_pad');
    my $click_position = $regionview_size  * ($regionview_x-$padl)/$regionview_width;

    $span = $DEFAULT_SEGMENT if $span > $MAX_SEGMENT;
    $start = int($click_position - $span/2 + $regionview_start);
    $stop  = $start + $span - 1;
  }

  elsif ($selected_span) {
    warn "selected_span = $selected_span" if DEBUG;
    my $center	    = int(($span / 2)) + $start;
    my $range	    = int(($selected_span)/2);
    $start          = $center - $range;
    $stop           = $start + $selected_span - 1;
  }

  warn "after adjusting for navlevel, start = $start, stop = $stop, span=$span" if DEBUG;

  # to prevent from going off left end
  if (defined $seg_min && $start < $seg_min) {
    warn "adjusting left because $start < $seg_min" if DEBUG;
    ($start,$stop) = ($seg_min,$seg_min+$stop-$start);
  }

  # to prevent from going off right end
  if (defined $seg_max && $stop > $seg_max) {
    warn "adjusting right because $stop > $seg_max" if DEBUG;
    ($start,$stop) = ($seg_max-($stop-$start),$seg_max);
  }

  # to prevent divide-by-zero errors when zoomed down to a region < 2 bp
  # $stop  = $start + ($span > 4 ? $span - 1 : 4) if $stop <= $start+2;

  warn "start = $start, stop = $stop\n" if DEBUG;

  $settings->{start} = $start/$divisor;
  $settings->{stop}  = $stop/$divisor;
}

# The get_features() call fetches the genome segments specified in the
# current settings.  It is really just a front end to lookup_segments()
# which does the real work.  The main work in get_segments() is to
# identify any segments that are below MIN_SEG_SIZE in length, and to
# re-center on a window MIN_SEG_SIZE wide.  This prevents the browser
# from getting brain damaged when fetching 1bp features like SNPs.
sub get_features {
  my $settings = shift;

  my $db = open_database();
  unless ($db) {
    fatal_error("ERROR: Unable to open database",$CONFIG->setting('description'),pre($@));
  }

  eval {$db->biosql->version($settings->{version})};

  # if no name is specified but there is a "initial landmark" defined in the
  # config file, then we default to that.
  $settings->{name} ||= $CONFIG->setting('initial landmark')
    if defined $CONFIG->setting('initial landmark') && !defined $settings->{q};

  my @features = lookup_features_from_db($db,$settings);

  # sort of hacky way to force keyword search on wildcards
  if (defined $settings->{name} && $settings->{name} =~ /[*?]/) {
    my $searchterm = $settings->{name};
    push @features,do_keyword_search($searchterm) if length $searchterm > 0;
  }

  # h'mmm.  Couldn't find the feature.  See if it is in an uploaded file.
  @features    = lookup_features_from_external_sources($settings,$settings->{name},undef)
    unless @features;

  return \@features;
}



sub features2segments {
  my $features = shift;
  my $refclass = $CONFIG->setting('reference class') || 'Sequence';
  my $db = open_database();
  my @segments = 
    map {
      my $version = eval {$_->isa('Bio::SeqFeatureI') ? undef : $_->version};
      $db->segment(-class => $refclass,
		   -name  => $_->ref,
		   -start => $_->start,
		   -stop  => $_->end,
		   -absolute => 1,
		   defined $version ? (-version => $version) : ())} @$features;
  warn "segments = @segments\n" if DEBUG;

  # Filter out redundant segments; this can happen when the same basic feature is
  # present under several names, such as "genes" and "frameworks"
  my %seenit;
  my $version = eval {$_->isa('Bio::SeqFeatureI') ? undef : $_->version};
  $version ||= 0;
  @segments = grep {!$seenit{$_->seq_id,$_->start,$_->end,$version}++} @segments;

  \@segments;
}


# sort of un-perlish -- we pass a reference to the handle that holds the segment
sub resize {
  my $segment_ref   = shift;
  my $whole_segment = shift;
  my $s = $$segment_ref;
  my $divider       = $CONFIG->setting('unit_divider') || 1;
  my $min_seg_size  = $CONFIG->setting('min segment')  || MIN_SEG_SIZE/$divider;


  my ($new_start,$new_stop,$fix) = ($s->start,$s->end,0);
  if ($s->length < $min_seg_size) {
    my $resize = $min_seg_size;
    my $middle = int(($s->start + $s->end)/2);
    $new_start = $middle - int($resize/2);
    $new_stop  = $middle + int($resize/2);
    $fix++;
  }
  if ($s->start < $whole_segment->start) {
    $new_start  = $whole_segment->start;
    $fix++;
  } elsif ($s->start > $whole_segment->end) {
    $new_start  = $whole_segment->end - $min_seg_size;
    $fix++;
  }
  if ($s->end   > $whole_segment->end) {
    $new_stop   = $whole_segment->end;
    $fix++;
  } elsif ($s->end < $whole_segment->start) {
    $new_stop   = $whole_segment->start+$min_seg_size;
    $fix++;
  }
  # error($CONFIG->tr('Small_interval',$resize)); # error message
  return unless $fix;

  $new_start = $whole_segment->start if $new_start < $whole_segment->start;
  $new_stop  = $whole_segment->end   if $new_stop  > $whole_segment->end;

  my $new_seg = $s->factory->segment(-name  => $s->seq_id,
				     -start => $new_start,
				     -end   => $new_stop,
				     -absolute => 1
				    );
  $$segment_ref = $new_seg;
}

# interesting heuristic way of fetching sequence segments based on educated guesses
sub lookup_features_from_db {
  my ($db,$settings) = @_;

  my @segments;

  warn "name = $settings->{name}, ref = $settings->{ref}, start = $settings->{start}, stop = $settings->{stop}, version = $settings->{version}" if DEBUG;

  my $divisor = $CONFIG->setting(general=>'unit_divider')     || 1;
  my $padding = $CONFIG->setting(general=>'landmark_padding') || 0;

  if (my $name = $settings->{name}) {
    @segments = $CONFIG->name2segments($name,$db,TOO_MANY_SEGMENTS);
  }

  elsif ((my $names = $settings->{q}) && ref $settings->{q}) {
    warn "q = $names" if DEBUG;
    my $max = TOO_MANY_SEGMENTS/@$names;
    @segments = map {$CONFIG->name2segments($_,$db,$max)} @$names;
  }

  elsif (my $ref = $settings->{ref}) {
    my @argv = (-name  => $ref);
    push @argv,(-start => $settings->{start}* $divisor) if defined $settings->{start};
    push @argv,(-end   => $settings->{stop} * $divisor)  if defined $settings->{stop};
    warn "looking up @argv" if DEBUG;
    @segments = $db->segment(@argv);
  }

   # expand by a bit if padding is requested
   # THIS CURRENTLY ISN'T WORKING PROPERLY
   if (@segments == 1 && $padding > 0 && !$settings->{name}) {
     $segments[0] = $segments[0]->subseq(-$padding,$segments[0]->length+$padding);
   }

  # some segments are not going to support the absolute() method
  # if they come out of BioPerl
  eval {$_->absolute(1)} foreach @segments;

  return unless @segments;

  # Filter out redundant segments; this can happen when the same basic feature is
  # present under several names, such as "genes" and "frameworks"
  my %seenit;
  my $version = eval {$_->isa('Bio::SeqFeatureI') ? undef : $_->version};
  $version ||= 0;
  @segments = grep {!$seenit{$_->seq_id,$_->start,$_->end,$version}++} @segments;
  return @segments if @segments > 1;

  # this prevents any confusion over (ref,start,stop) and (name) addressing.
  $settings->{ref}   = $segments[0]->seq_id;
  $settings->{start} = $segments[0]->start/$divisor;
  $settings->{stop}  = $segments[0]->end/$divisor;

  return $segments[0];
}

# Find features named in external sources.
# Currently this only works with uploaded files, but it should
# be extended to work with DAS files too.
sub lookup_features_from_external_sources {
  my ($settings,$searchterm) = @_;

  my @uploaded_files = map {$UPLOADED_SOURCES->feature_file($_)}
    grep {$settings->{features}{$_}{visible}}
      $UPLOADED_SOURCES->files;
  for my $file (@uploaded_files) {
    next unless $file->can('get_feature_by_name');
    my @features = $file->get_feature_by_name($searchterm);
    return @features if @features;
  }

  # No exact match.  Try inexact match.
  my $max_keywords = $CONFIG->setting('keyword search max')|| MAX_KEYWORD_RESULTS;

  for my $file (@uploaded_files) {
    next unless $file->can('search_notes');
    my @matches = $file->search_notes($searchterm,$max_keywords);
    return map {
      my ($feature,$description,$score) = @$_;
      Bio::Graphics::Feature->new(-name => $feature->display_name,
				  -type => $description,
				  -score => $score,
				  -ref   => $feature->ref,
				  -start => $feature->start,
				  -end   => $feature->end)
      } @matches if @matches;
  }

  return;
}

################ perform keyword search ###############
sub do_keyword_search {
  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 = open_database();
  my $max_keywords = $CONFIG->setting('keyword search max')
		    || MAX_KEYWORD_RESULTS;
  my @matches;
  if ($db->can('search_attributes')) {
    my @attribute_names = shellwords ($CONFIG->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  => eval{$name->class}||undef,
					      -type   => $description,
					      -score  => $score,
					      -ref    => $seg->abs_ref,
					      -start  => $seg->abs_start,
					      -end    => $seg->abs_end,
					      -factory=> $db);
  }
  return @results;
}

################ format keyword search ###################
sub multiple_choices {
  my ($settings,$results) = @_;

  my $db   = open_database();
  my $name = $settings->{name};
  my $regexp = join '|',($name =~ /(\w+)/g);

  # sort into bins by reference and version
  my %refs;
  foreach (@$results) {
    my $version = eval {$_->isa('Bio::SeqFeatureI') ? undef : $_->version};
    my $ref = $_->seq_id;
    $ref .= " version $version" if defined $version;    
    push @{$refs{$ref}},$_;
  }

  $CONFIG->width($settings->{width}*OVERVIEW_RATIO);
  my $overviews = $CONFIG->hits_on_overview($db,$results,$settings->{features});
  my $count = @$results;

  print start_table();
  print TR({-class=>'datatitle'},
	   th({-colspan=>4},
	      $CONFIG->tr('Hit_count',$count)));
  print TR({-class=>'datatitle'},
	   th({-colspan=>4},
	      $CONFIG->tr('Possible_truncation',MAX_KEYWORD_RESULTS)))
    if $count >= MAX_KEYWORD_RESULTS;

  local $^W = 0;  # get rid of non-numeric warnings coming out of by_score_and_position
  for my $ref(sort keys %refs) {
    my ($id) = split /\s/, $ref; 
    my @results = @{$refs{$ref}};
    print TR(th({-class=>'databody',-colspan=>4,-align=>'center'},$CONFIG->tr('Matches_on_ref',$ref),br,
		$overviews->{$ref}));

    my $padding = $CONFIG->setting(general=>'landmark_padding') || 0;
    my $units    = $CONFIG->setting(general=>'units') || $CONFIG->tr('bp');
    my $divisor  = $CONFIG->setting(general=>'unit_divider') || 1;

    for my $r (sort by_score_and_position @results) {
      my $version = eval {$r->isa('Bio::SeqFeatureI') ? undef : $r->version};
      my $name        = eval {$r->name}  || $r->primary_tag;

      my $class       = eval {$r->class} || $CONFIG->tr('Sequence');
      my $score       = eval {$r->score} || $CONFIG->tr('NOT_APPLICABLE');
      my ($start,$stop) = ($r->start,$r->end);
      my $padstart = $start - $padding;
      my $padstop  = $stop  + $padding;
      my $description = escapeHTML(eval{join ' ',$r->attributes('Note')}
				   ||eval{$r->method}||eval{$r->source_tag}||$r->{ref});
      if (my @aliases = grep {$_ ne ''} eval{$r->attributes('Alias')}) {
	$description .= escapeHTML(" [@aliases]");
      }
      my $n           = escape("$name");
      my $c           = escape($class);
      $description =~ s/($regexp)/<b class="keyword">$1<\/b>/ig;
      $description =~ s/(\S{60})/$1 /g;  # wrap way long lines

      my $objref     = $class ? "?name=$c:$n" : "?name=$n";
      my $posref     = "?ref=$id;start=$padstart;stop=$padstop;version=$version";
      my $position = format_segment($r);
      my $length   = unit_label($stop-$start+1);
      print TR({-class=>'databody',-valign=>'TOP'},
	       th({-align=>'right'},ref($name) ? a({-href=>$objref},$name):tt($name)),
	       td($description),
	       td(a({-href=>$posref},$position . " ($length)")),
	       td($CONFIG->tr('SCORE',$score)));
    }
  }
  print end_table;

}

sub by_score_and_position {
  my $result = eval{$b->score <=> $a->score};
  return $result unless $result == 0;

  return $a->seq_id cmp $b->seq_id
    ||
      $a->start<=>$b->start
	||
	  $a->end<=>$b->end;
}

sub format_segment {
  my $s = shift or return $CONFIG->tr('Not_applicable');
  my $ref = $s->seq_id;
  my ($start,$s_units) = unit_label($s->start);
  my ($end,$e_units)   = unit_label($s->end);
  $start  = commas($start);
  $end    = commas($end);
  my $pos = $s_units eq $e_units ? "$start..$end $s_units" : "$start $s_units..$end $e_units";
  return "<b>$ref</b>:$pos";
}

sub whole_segment {
  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;
}

sub overview {
  my ($whole_segment,$segment,$settings,$feature_files) = @_;
  return unless $segment;
  $CONFIG->width($settings->{width}*OVERVIEW_RATIO);


  my ($image,$length) = $CONFIG->overview($whole_segment,$segment,$settings->{features},$feature_files) or return;
  my ($width,$height) = $image->getBounds;
  my $url             = $CONFIG->generate_image($image);
  return image_button(-name=>'overview',
		      -src=>$url,
		      -align=>'middle')
    .hidden(-name=>'seg_min',-value=>$whole_segment->start,-override=>1)
    .hidden(-name=>'seg_max',-value=>$whole_segment->end,-override=>1);
}

sub regionview {
  my ($region_segment,$segment,$settings,$feature_files) = @_;
  return unless $region_segment;

  my ($image,$length) = $CONFIG->regionview($region_segment,$segment,$settings->{features},$feature_files) or return;
  my ($width,$height) = $image->getBounds;
  my $url             = $CONFIG->generate_image($image);
  return image_button(-name=>'regionview',
 		      -src=>$url,
 		      -align=>'middle');
}


sub get_ranges {
  return $CONFIG->get_ranges;
}

sub get_zoomincrement {
  my $zoom      = $CONFIG->setting('fine zoom')  || DEFAULT_FINE_ZOOM;
  $zoom;
}

sub segment2link {
  my ($segment,$label) = @_;

  my $source = $CONFIG->source;
  return  a({-href=>"?name=$segment"},$segment) unless ref $segment;

  my ($start,$stop) = ($segment->start,$segment->end);
  my $ref = $segment->seq_id;
  my $bp = $stop - $start;
  my $s  = commas($start) || '';
  my $e  = commas($stop)  || '';
  $label ||= "$ref:$s..$e";
  return a({-href=>"?ref=$ref;start=$start;stop=$stop"},$label);
}


sub show_examples {
  my $examples = $CONFIG->setting('examples') or return;;
  my @examples = shellwords($examples);
  return unless @examples;
  my $source = $CONFIG->source;
  my @urls = map { a({-href=>"?name=".escape($_)},$_) } @examples;
  return b($CONFIG->tr('Examples')).': '.join(', ',@urls).". ";
}

########## upload stuff ########
## HANDLING FILE UPLOADS ######################################################################
sub handle_uploads {
  my $page_settings = shift;

  my ($file_action)         = grep {/^modify\./} param();
  (my $file = $file_action) =~ s/^modify\.// if $file_action;

  # This gets called if the user wants to download his annotation data
  if (my $to_download = (param($CONFIG->tr('Download_file')) ||
			 ($file_action && param($file_action) eq $CONFIG->tr('Download_file')) && $file)) {
    warn "FILE DOWNLOAD, download = $to_download" if DEBUG;
    print_header(-attachment   =>  $to_download,
		 -type         => 'application/octet-stream');
    print_uploaded_file_features($page_settings,$to_download);
    return 0;  # this will cause an exit from the script
  }

  if (param('Upload') && (my $f = param('upload_annotations'))) {
    $UPLOADED_SOURCES->upload_file($f);
  }

  elsif (param('new_upload')) {
    $file = $UPLOADED_SOURCES->new_file();
    $UPLOADED_SOURCES->open_file($file,">");# empty, truncated file
    $file_action = "modify.$file";
    param(-name=>"modify.$file",-value=>$CONFIG->tr('Edit'));
  }

  elsif (defined(my $data = param('a_data'))) {
    handle_edit($page_settings,$data);
  }

  elsif (my @data = (param('auto'),param('add'),param('a'))) {
    my @styles = (param('style'),param('s'));
    handle_quickie($page_settings,\@data,\@styles);
  }

  if ($file_action && param($file_action) eq 'Delete File') {
    $UPLOADED_SOURCES->clear_file($file);
  }

  if ($file_action && param($file_action) eq $CONFIG->tr('Edit')) {
    edit_uploaded_file($page_settings,$file);
    return 0;   # this will cause it to exit
  }

  1;
}

sub handle_edit {
  my ($settings,$data) = @_;
  my $file = param('edited file') or return;
  my @lines = unexpand(split /\r?\n|\r\n?/,$data);
  $data = join "\n",@lines;
  $data .= "\n";
  $UPLOADED_SOURCES->new_file($file);  # register it
  my $fh = $UPLOADED_SOURCES->open_file($file,'>') or return;
  print $fh $data;
  close $fh;
}

sub handle_quickie {
  my ($settings,$data,$styles) = @_;
  return unless $data;

  # format of quickie data is reference+type+name+start..end,start..end,start..end
  my @features;
  foreach my $d (@$data) {
    my ($reference,$type,$name,@segments) = parse_feature_str($d);
    push @features, Bio::Graphics::Feature->new(
  					    -ref      => $reference||'',
  					    -type     => $type||'',
  					    -name     => $name||'',
  					    -segments => \@segments,
  					    );
   }
  write_auto($settings,\@features,$styles);
}

sub write_auto {
  my ($settings,$features,$styles) = @_;
  return unless @$features;

  my $basename = 'my_data';
  $UPLOADED_SOURCES->clear_file("file:${basename}");  # in case it's already there
  my $file = $UPLOADED_SOURCES->new_file($basename);

  my %seenit;

  warn "opening $file...\n" if DEBUG;
  my $out = $UPLOADED_SOURCES->open_file($file,">>") or return;
  warn "writing $file...\n" if DEBUG;

  $styles ||= [];
  for my $style (@$styles) {
    my ($type,@options) = shellwords($style);
    print $out "[$type]\n";
    print $out join "\n",@options;
    print $out "\n";
  }

  for my $f (@$features) {
    my $reference = $f->can('seq_id') ? $f->seq_id : $f->seq_id;
    my $type      = $f->primary_tag;
    my $name      = $f->seqname;
    my $position  = $f->sub_SeqFeature ? join (',',map {$_->start.'..'.$_->end} $f->sub_SeqFeature)
                                       : $f->start.'..'.$f->end;
    $name .= "($seenit{$name})" if $seenit{$name}++;
    print $out "\nreference=$reference\n";
    print $out join ("\t",qq("$type"),qq("$name"),$position),"\n";
  }
  close $out;
}

sub load_external_sources {
  my ($segments,$page_settings) = @_;

  return {} unless $segments;

  if (ref $segments ne 'ARRAY') {
    $segments = [open_database()->segment($segments)];
  }
  elsif ($segments) {
    return if @$segments > 1;
  }

  my $segment = $segments->[0] if $segments;

  # $f will hold a feature file hash in which keys are human-readable names of
  # feature files and values are FeatureFile objects.
  my $f       = {};
  if ($segment && $segment->length <= $MAX_SEGMENT) {
    my $rel2abs      = coordinate_mapper($segment,1);
    my $rel2abs_slow = coordinate_mapper($segment,0);
    for my $featureset ($PLUGINS,$UPLOADED_SOURCES,$REMOTE_SOURCES) {
      $featureset->annotate($segment,$f,$rel2abs,$rel2abs_slow);
    }
  }
  return $f;
}

sub line_end {
   my $agent  = CGI->user_agent();
   return "\r"   if $agent =~ /Mac/;
   return "\r\n" if $agent =~ /Win/;
   return "\n";
}

sub load_plugin_annotators {
  my ($settings) = @_;

  my %default_plugin = map {$_=>1} map {s/^plugin:// && $_} 
    grep {/^plugin:/} $CONFIG->default_labels;

  my %listed = map {$_=>1} @{$settings->{tracks}}; # are we already on the list?

  for my $p ($PLUGINS->plugins) {
    next unless $p->type eq 'annotator';
    my $name = $p->name;
    $name = "plugin:$name";
    ($PLUGIN_NAME2LABEL{$name}) = ref($p) =~ /(\w+)$/;
    $settings->{features}{$name} ||= {visible=>$default_plugin{$p}||0,options=>0,limit=>0};
    push @{$settings->{tracks}},$name unless $listed{$name};
  }

}

sub print_uploaded_file_features {
  my ($settings,$file) = @_;
  my $line_end = line_end();
  if (my $fh = $UPLOADED_SOURCES->open_file($file)) {
    while (<$fh>) {
      chomp;
      print $_,$line_end;
    }
  }
}

sub get_uploaded_file_info {
  my $feature_file = shift or return i("Display off");
  warn "get_uploaded_file_info(): feature_file = $feature_file" if DEBUG;

  my $modified = localtime($feature_file->mtime);
  my @refs      = sort($feature_file->features)
    unless $feature_file->name =~ m!/das/!;

  my $db        = open_database();

  my ($landmarks,@landmarks,@links);

  if (@refs > TOO_MANY_REFS) {
    $landmarks = b($CONFIG->tr('Too_many_landmarks',scalar @refs));
  } else {
    @links = map {segment2link($_,$_->display_name)} @refs;
    $landmarks = tableize(\@links);
  }
  warn "get_uploaded_file_info(): modified = $modified, landmarks = $landmarks" if DEBUG;
  return i($CONFIG->tr('File_info',$modified,$landmarks||''));
}

sub edit_uploaded_file {
  my ($settings,$file) = @_;
  warn "edit_uploaded_file(): file = $file" if DEBUG;
  print_top("Editing $file");
  print start_form();
  my $data;
  my $fh = $UPLOADED_SOURCES->open_file($file) or return;
  $data = join '',expand(<$fh>);
  print table({-width=>'100%'},
	      TR({-class=>'searchbody'},
		 td($CONFIG->tr('Edit_instructions')),
		),
	      TR({-class=>'searchbody'},
		 td(
		    a({-href=>"?help=annotation#format",-target=>'help'},
		      b('['.$CONFIG->tr('Help_format').']'))
		   ),
		),
	      TR({-class=>'searchtitle'},
		 th($CONFIG->tr('Edit_title'))),
	      TR({-class=>'searchbody'},
		 td({-align=>'center'},
		    pre(
			textarea(-name    => 'a_data',
				 -value   => $data,
				 -rows    => ANNOTATION_EDIT_ROWS,
				 -cols    => ANNOTATION_EDIT_COLS,
				 -wrap    => 'off',
				 -style   => "white-space : pre"
				))
		   )
		),
	      TR({-class=>'searchtitle'},
		 th(reset($CONFIG->tr('Undo')).'&nbsp;'.
		    submit('Cancel').'&nbsp;'.
		    b(submit('Submit Changes...'))))
	     );
  print hidden(-name=>'edited file',-value=>$file);
  print end_form();
  print_bottom($VERSION);
}


sub coordinate_mapper {
  my $current_segment = shift;
  my $optimize        = shift;

  my $db              = open_database();

  my ($ref,$start,$stop) = ($current_segment->seq_id,
			    $current_segment->start,$current_segment->end);
  my %segments;

  my $closure = sub {
    my ($refname,@ranges) = @_;

    # hack for timing tests - this disables coordinate remapping
    # and shows what would happen if user uploaded everything in abs
    # coordinates.
    if (0)  {  # turn on for timing tests
      return unless $refname eq $ref;
      my @in_range = grep {$_->[0] <= $stop && $_->[1] >= $start} @ranges;
      return unless @in_range;
      return ($refname,@in_range);
    }

    unless (exists $segments{$refname}) {
      my @segments = sort {$a->length<=>$b->length}   # get the longest one
	map {
	  eval{$_->absolute(0)}; $_  # so that rel2abs works properly later
	}
	  $CONFIG->name2segments($refname,$db,TOO_MANY_SEGMENTS,1);
      $segments{$refname} = $segments[0];
      return unless @segments;
    }

    my $mapper   = $segments{$refname} || return;
    my $absref   = $mapper->abs_ref;
    my $cur_ref  = eval {$current_segment->abs_ref}
       || eval{$current_segment->ref};  # account for api changes in Bio::SeqI
    return unless $absref eq $cur_ref;

    my @abs_segs;
    if ($absref eq $refname) {  # doesn't need remapping
      @abs_segs = @ranges;
    } else {
      @abs_segs = map {[$mapper->rel2abs($_->[0],$_->[1])]} @ranges;
    }

    # this inhibits mapping outside the displayed region
    if ($optimize) {
      my $in_window;
      foreach (@abs_segs) {
	next unless defined $_->[0] && defined $_->[1];
	$in_window ||= $_->[0] <= $stop && $_->[1] >= $start;
      }
      return $in_window ? ($absref,@abs_segs) : ();
    } else {
      return ($absref,@abs_segs);
    }
  };
  return $closure;
}

sub bookmark_link {
  my $settings = shift;
  my $q = new CGI('');
  my @keys = qw(start stop ref width version flip);
  foreach (@keys) {
    $q->param(-name=>$_,-value=>$settings->{$_});
  }

  # handle selected features slightly differently
  my @selected = grep {$settings->{features}{$_}{visible} && !/^(file|ftp|http):/} @{$settings->{tracks}};
  $q->param(-name=>'label',-value=>join('-',@selected));

  # handle external urls
  my @url = grep {/^(ftp|http):/} @{$settings->{tracks}};
  $q->param(-name=>'eurl',-value=>\@url);
  $q->param(-name=>'h_region',-value=>$settings->{h_region}) if $settings->{h_region};
  my @h_feat= map {"$_\@$settings->{h_feat}{$_}"} keys %{$settings->{h_feat}};
  $q->param(-name=>'h_feat',-value=>\@h_feat) if @h_feat;
  $q->param(-name=>'id',-value=>$settings->{id});
  $q->param(-name=>'grid',-value=>$settings->{grid});

  return "?".$q->query_string();
}

sub image_link {
  my $settings = shift;
  # rand() is a workaround to avoid image caching on browser side
  my $rand     = rand(); 
  return "?help=link_image;flip=".($settings->{flip}||0).";cache=$rand";
}

sub svg_link {
  my $settings = shift;
  # rand() is a workaround to avoid image caching on browser side
  my $rand     = rand(); 
  return "?help=svg_image;flip=".($settings->{flip}||0).";cache=$rand"; 
}

# reorder @labels based on settings in the 'track.XXX' parameters
sub adjust_track_order {
  my $settings = shift;

  my @labels  = @{$settings->{tracks}};
  warn "adjust_track_order(): labels = @labels" if DEBUG;

  my %seen_it_already;
  foreach (grep {/^track\./} param()) {
    warn "$_ =>",param($_) if DEBUG;
    next unless /^track\.(\d+)/;
    my $track = $1;
    my $label   = param($_);
    next unless length $label > 0;
    next if $seen_it_already{$label}++;
    warn "$label => track $track" if DEBUG;

    # figure out where features currently are
    my $i = 0;
    my %order = map {$_=>$i++} @labels;

    # remove feature from wherever it is now
    my $current_position = $order{$label};
    warn "current position of $label = $current_position" if DEBUG;
    splice(@labels,$current_position,1);

    warn "new position of $label = $track" if DEBUG;
    # insert feature into desired position
    splice(@labels,$track,0,$label);
  }
  $settings->{tracks} = \@labels;
}

sub adjust_track_options {
  my $settings = shift;
  foreach (grep {/^option\./} param()) {
    my ($track)   = /(\d+)/;
    my $feature   = $settings->{tracks}[$track];
    my $option    = param($_);
    $settings->{features}{$feature}{options} = $option;
  }
  foreach (grep {/^limit\./} param()) {
    my ($track)   = /(\d+)/;
    my $feature   = $settings->{tracks}[$track];
    my $option    = param($_);
    $settings->{features}{$feature}{limit} = $option;
  }
  foreach (@{$settings->{tracks}}) {
    $settings->{features}{$_}{visible} = 0;
  }

  foreach (param('track.label')) {
    $settings->{features}{$_}{visible} = 1;
  }
}

# this controls the "adjust track options" screen
sub set_track_options {
  my $settings = shift;

  my @labels =  @{$settings->{tracks}};

  my %keys            = map {$_ => $CONFIG->setting($_=>'key') || $_} @labels;
  my @sorted_labels   = ('',sort {lc $keys{$a} cmp lc $keys{$b}} @labels);

  my $oc = $CONFIG->setting('overview bgcolor') || DEFAULT_OVERVIEW_BGCOLOR();

  my @rows;
  for (my $track = 0; $track < @labels; $track++) {
    my $label = $labels[$track];
    push @rows,
      th({-align=>'left',-class=>'searchtitle'},$CONFIG->tr("Track"),$track+1).
      th({-align=>'left',-class=>'searchbody'},$label=~/:overview$/  ? div({-style=>"background: $oc"},
									   "$keys{$label}<sup>*</sup>")
	                                     : $label=~/:region$/? div({-style=>"background: $oc"},
									   "$keys{$label}<sup>**</sup>")
	                                     : $keys{$label}).
      td({-align=>'center',-class=>'searchbody'},
	     checkbox(-name     => 'track.label',
		      -value    => $label,
		      -override => 1,
		      -checked  => $settings->{features}{$label}{visible},
		      -label => '')
	    ).
      td({-align=>'center',-class=>'searchbody'},
	     popup_menu( -name     => "option.$track",
			 -values   => [0..3],
			 -override => 1,
			 -default  => $settings->{features}{$label}{options},
			 -labels   => {0=> $CONFIG->tr('Auto'),
                                       1=> $CONFIG->tr('Compact'),
                                       2=> $CONFIG->tr('Expand'),
				       3=> $CONFIG->tr('Expand_Label'),
				      })
	   ).
	td({-align=>'center',-class=>'searchbody'},
	   popup_menu(-name    => "limit.$track",
		      -values  => [0,5,10,25,100],
		      -labels  => {0=>$CONFIG->tr('No_limit')},
		      -override => 1,
		      -default => $settings->{features}{$label}{limit})
	    ).
	td({-align=>'center',-class=>'searchbody'},
	   popup_menu(-name    => "track.$track",
		      -values  => \@sorted_labels,
		      -labels  => \%keys,
		      -override => 1,
		      -onChange => 'document.settings.submit()',
		      -default => '')
	    );
  }
  my $controls = TR({-class=>'searchtitle'},
		    td({-colspan=>3,-align=>'center'},
		       reset($CONFIG->tr('Undo')).'&nbsp;'.
		       submit(-name=>'revert', -label=>$CONFIG->tr('Revert')).'&nbsp;'.
		       submit(-name=>'refresh',-label=>$CONFIG->tr('Refresh')).'&nbsp;'
		      ),
		    td({-align=>'center',-colspan=>3},
		       submit  (-name=>$CONFIG->tr('Cancel'),   -value=>$CONFIG->tr('Cancel_Return')).'&nbsp;'.
		       b(submit(-name=>$CONFIG->tr('Redisplay'),-value=>$CONFIG->tr('Accept_Return')))
		      ));

  print h1({-align=>'center'},$CONFIG->tr('Settings',$CONFIG->setting('description')));
  print start_form(-name=>'settings');
  print table({-width=>'100%',-border=>0},
	      $controls,
	      TR({-class=>'searchtitle'},
		 th({-colspan=>6},$CONFIG->tr('Options_title'))),
	      TR({-class=>'searchbody'},
		 td({-colspan=>6},
		    $CONFIG->tr('Settings_instructions')
		   ),
		),
	      TR({-class=>'searchtitle'},
		 th($CONFIG->tr('Track')),
		 th($CONFIG->tr('Track Type')),
		 th($CONFIG->tr('Show')),
		 th($CONFIG->tr('Format')),
		 th($CONFIG->tr('Limit')),
		 th($CONFIG->tr('Change_Order')),
		),
	      TR(\@rows),
	      $controls,
	      hidden(-name=>$CONFIG->tr('Set_options'), -value=>1,-override=>1),
	      hidden(-name=>$CONFIG->tr('Adjust_order'),-value=>1,-override=>1),
	     );
  print $CONFIG->tr('EXTERNAL_TRACKS'),
    br,
      div({-style=>"background: $oc"},
	  $CONFIG->tr('OVERVIEW_TRACKS')
	 ),
    br,
      div({-style=>"background: $oc"},
	  $CONFIG->tr('REGION_TRACKS')
	 );
  print end_form();
}

sub help {
  my ($help_type,$conf_dir,$settings) = @_;

  my $ref = referer();
  my $do_close = join('',
		      start_form(-action=>$ref),
		      button(-onClick=>'window.close()',-label=>$CONFIG->tr('Close_Window')),
		      end_form());
  print div({-align=>'right'},$do_close);
  if ($help_type eq 'citations') {
    build_citation_page($settings);
  }

  elsif ($help_type eq 'link_image') {
    build_link_image_page($settings);
  } elsif ($help_type eq 'svg_image') {
    build_svg_image_page($settings);
  }

  else {
    my @components = File::Spec->splitdir($help_type);
    my $updir      = File::Spec->updir;
    # don't let evil people get into root directory
    my $evil       = grep { /^$updir$/o } @components;
    return         if $evil;
    build_help_page("$conf_dir/${help_type}_help.html");
  }
  print div({-align=>'right'},$do_close);
}


sub make_citation {
  my $config  = shift;
  my $feature = shift;
  my $citation = eval {$config->citation($feature,$CONFIG->language)};
  if (ref $citation && ref $citation eq 'CODE') {
    $citation = $citation->();
  }
  # BUG: here's where we should remove "bad" HTML, but we don't!
  # should remove active content and other nasties
  (my $link     = $feature) =~ tr/ /-/;
  my $text      = label2key($feature);
  return join ('',
	       dt(a({-name=>$link},b($text))),
	       dd($citation||$CONFIG->tr('NO_CITATION')),
	       p());
}

# build a citation page
sub build_citation_page {
  my $settings = shift;

  my @features = $CONFIG->labels;
  my $external_features = load_external_sources(undef,$settings);
  $external_features ||= {};

  my (@citations);
  print h2($CONFIG->tr('Track_descriptions'));

  # build native features
  print h3($CONFIG->tr('Built_in'));
  for my $feature (@features) {
    push @citations,make_citation($CONFIG,$feature);
  }

  print blockquote(dl(@citations));

  # build external features
  if (%$external_features) {
    print hr,h3($CONFIG->tr('External'));
    for my $file (keys %$external_features) {
      my @citations = ();
      my $f = escape($file);
      my $name   = $file;
      my $is_url = $name =~ m!^(http|ftp)://!;
      my $download = escape($CONFIG->tr('Download_data'));
      my $link   = $is_url  ? $name  : "?$download=1;file=$f";
      my $anchor = $name;
      $anchor =~ tr/ /-/;

      unless (ref $external_features->{$file}) {
	print h3(a{-name=>$anchor,-href=>$link},$name);
	print blockquote($CONFIG->tr('Activate'));
	next;
      }

      my $obj = eval{$external_features->{$file}->factory} || $external_features->{$file};

      $link =~ s!(/das/[^/?]+)!$1/types! 
	if $obj->isa('Bio::Das');

      print h4(a{-name=>$anchor,-href=>$link},$name);
      for my $feature ($obj->types) {
	push @citations,make_citation($external_features->{$file},$feature);
      }
      print blockquote(dl(@citations));
    }
    print p($CONFIG->tr('No_external')) unless @citations;
  }

}

sub build_help_page {
  my $helpfile = shift or return;
  my $file = url2file($helpfile) or return;
  my $root = $CONFIG->setting('help') || GBROWSE_HELP;
  my $url  = url(-abs=>1,-path=>1);
  open(F,$file) or return;
  while (<F>) { # fix up relative addressing of images
    s/\$GBROWSE\b/$url/g
     or
    s/(href|src)=\"([^\"\#\$]+)\"/$1=\"$root\/$2\"/g;
    s/<!--\s*\#include-classes\s*-->/object_classes_for_help()/e;
    print;
  }
  close F;
}

sub build_link_image_page {
  _build_image_page(@_,'IMAGE_DESCRIPTION');
}
sub build_svg_image_page {
  _build_image_page(@_,'SVG_DESCRIPTION','GD::SVG');
}

sub _build_image_page {
  my $settings = shift;
  my $help     = shift;
  my $format   = shift;

  my $source = $CONFIG->source;
  my $id     = $settings->{id};
  my $flip   = $settings->{flip} || param('flip') || 0;
  my $keystyle = $settings->{ks};
  my $grid     = $settings->{grid} || 0;
  my $url = url(-base=>1);
  $url   .= url(-absolute=>1);
  $url    = dirname($url) . "/gbrowse_img/".escape($source);
  my $tracks = $settings->{tracks};
  my $width  = $CONFIG->width;
  my $name   = $settings->{name} || "$settings->{ref}:$settings->{start}..$settings->{stop}";
  my $type    = join '+',map{escape($_)} map {/\s/?qq("$_"):$_} grep {$settings->{features}{$_}{visible}} @$tracks;
  my $options = join '+',map { join '+', escape($_),$settings->{features}{$_}{options}
			     } map {/\s/?"$_":$_}
			       grep {
				 $settings->{features}{$_}{options}
			       } @$tracks;
  my $img_url = "$url/?name=$name;type=$type;width=$width;id=$id";
  $img_url   .= ";flip=$flip"         if $flip;
  $img_url   .= ";options=$options"   if $options;
  $img_url   .= ";format=$format"     if $format;
  $img_url   .= ";keystyle=$keystyle" if $keystyle;
  $img_url   .= ";grid=$grid";
  add_hilites($settings,\$img_url);
  print $CONFIG->tr($help,$img_url,$img_url);
}

sub add_hilites {
  my $settings = shift;
  my $img_url  = shift;

  # add feature hilighting
  if ($settings->{h_feat} && ref $settings->{h_feat} eq 'HASH') {
    for my $h (keys %{$settings->{h_feat}}) {
      $$img_url .= ";h_feat=$h\@$settings->{h_feat}{$h}";
    }
  }
  # add region hilighting
  if ($settings->{h_region} && ref $settings->{h_region} eq 'ARRAY') {
    for my $h (@{$settings->{h_region}}) {
      $$img_url .= ";h_region=$h";
    }
  }

}


# get list of object types for help pages
sub object_classes_for_help {
  return $OBJECT_CLASSES{$CONFIG->source} if exists $OBJECT_CLASSES{$CONFIG->source};
  my $db = open_database();
  my @classes = eval {$db->classes};
  return $OBJECT_CLASSES{$CONFIG->source} = '' unless @classes;
  return $OBJECT_CLASSES{$CONFIG->source} = ul(li(\@classes));
}

# Create a link to a citation.  It will point to an external URL if the
# citation looks like a URL (starts with http: or ftp:).  It will be
# self-referential otherwise.

# The persistent problem here is that the regular features are cited on a
# feature-by-feature basis, while the uploaded/external ones are cited as
# a group.  This makes for ugly logic branches.
sub make_citation_link {
  my ($label,$self_url)   = @_;
  my ($link,$key);
  if ($label =~ /^plugin:/) {
    $key = $label || '';
    $key =~ s/^plugin://;
    my $about = escape($CONFIG->tr('About')) || '';
    my $plugin = $PLUGIN_NAME2LABEL{$label} ? ";plugin=$PLUGIN_NAME2LABEL{$label}" : '';
    $link = "?plugin_action=${about}${plugin}";
  }

  elsif ($label =~ /^file:/){
    $key  = label2key($label);
    $link = "?Download%20File=$key";
  }

  else {
    $key = label2key($label);
    (my $anchor  = $label) =~ tr/ /-/;
    $link = $self_url.'#'.escapeHTML($anchor);
  }

  my $overview_color = $CONFIG->setting('overview bgcolor') || DEFAULT_OVERVIEW_BGCOLOR();
  my @args = (-href=>$link,-target=>'citation');
  push @args,-style=>'Font-style: italic' if $label =~ /^(http|ftp|file):/;
  # push @args,-style=>"background: $overview_color" if $label =~ /:overview$/;
  return a({@args},$key);
}

sub label2key {
  my $label = shift;
  my $key;
  $PRESETS ||= get_external_presets || {};
  for my $l ($CONFIG->language->language) {
    $key     ||= $CONFIG->setting($label=>"key:$l");
  }
  $key     ||= $CONFIG->setting($label => 'key');
  $key     ||= $PRESETS->{$key} if defined $key;
  $key     ||= $label;
  # $key     .= '*' if $label =~ /:overview$/;
  $key;
}

### PLUGINS ###################################################################################
###############################################################################################

sub plugin_menu {
  my ($settings,$plugins) = @_;

  my $labels = $plugins->menu_labels;

  my @plugins = sort {$labels->{$a} cmp $labels->{$b}} keys %$labels;
  return unless @plugins;
  return join('',
	      popup_menu(-name=>'plugin',
			 -values=>\@plugins,
			 -labels=> $labels,
			 -default => $settings->{plugin},
			),'&nbsp;',
	      # submit(-name=>'plugin_action',-value=>$CONFIG->tr('About')),'&nbsp;',
	      submit(-name=>'plugin_action',-value=>$CONFIG->tr('Configure')),'&nbsp;',
	      b(submit(-name=>'plugin_action',-value=>$CONFIG->tr('Go')))
	      );
}

# for the subset of plugins that are named in the 'quicklink plugins' option, create
# quick links for them.
sub plugin_links {
  my $plugins = shift;
  my @plugins = shellwords($CONFIG->setting('quicklink plugins')) or return '';
  my @result;
  for my $p (@plugins) {
    my $plugin = $plugins->plugin($p) or next;
    my $name   = $plugin->name;
    my $action = "?plugin=$p;plugin_do=".$CONFIG->tr('Go');
    push @result,a({-href=>$action},"[$name]");
  }
  return join ' ',@result;
}

sub source_menu {
  my $settings = shift;
  my @sources      = $CONFIG->sources;
  my $show_sources = $CONFIG->setting('show sources');
  $show_sources    = 1 unless defined $show_sources;   # default to true
  my $sources = $show_sources && @sources > 1;
  return b($CONFIG->tr('DATA_SOURCE')).br.
    ( $sources ?
      popup_menu(-name   => 'source',
		 -values => \@sources,
		 -labels => { map {$_ => ($CONFIG->description($_)||'')} $CONFIG->sources},
		 -default => $CONFIG->source,
		 -onChange => 'document.mainform.submit()',
		)
	: $CONFIG->description($CONFIG->source)
      );
}

sub do_plugin_header {
  my $plugin        = shift;
  my $page_settings = shift;
  my $cookie        = shift;
  my ($mime_type,$attachment)     = $PLUGINS->plugin($plugin)->mime_type;
  print_header(-cookie => $cookie,
	       -type=>$mime_type,
	       $attachment ? (-attachment=>$attachment) : (),
	      );
}

sub do_plugin_dump {
  my $plugin   = shift;
  my $segment  = shift;
  my $settings = shift;
  my $p        = $PLUGINS->plugin($plugin) or return;
  my @additional_feature_sets;
  if ($segment && $settings && $segment->length <= $MAX_SEGMENT) {
     my $feature_files = load_external_sources($segment,$settings);
     @additional_feature_sets = values %{$feature_files};
  }
  $p->dump($segment,@additional_feature_sets);
  return 1;
}

sub do_plugin_about {
  my $plugin = shift;
  my $p = $PLUGINS->plugin($plugin) or return;
  my $type  = ( split ( /::/, ref($p) ) )[-1];
  my $labels = $PLUGINS->menu_labels;
  print h1($CONFIG->tr('About_plugin',$labels->{$type}));
  print $p->description;
  print start_form(),submit(-name=>$CONFIG->tr('Back_to_Browser'),
			    -onClick=>'window.close()')
    ,hidden('plugin'),end_form();
}

sub do_plugin_find {
  my ($settings,$plugin,$features,$search_string) = @_;

  # to simplify life, this subroutine takes either the plugin name
  # or a plugin reference.
  my $p = ref $plugin ? $plugin : $PLUGINS->plugin($plugin);
  $p or return;

  my $plugin_name = $p->name;

  my $results = $p->can('auto_find') && defined $search_string
              ? $p->auto_find($search_string) 
              : $p->find($features);
  return unless $results;  # reconfigure message
  return unless @$results;

  @$features = @$results;
  $settings->{name} = defined($search_string) ? $CONFIG->tr('Plugin_search_1',$search_string,$plugin_name)
                                              : $CONFIG->tr('Plugin_search_2',$plugin_name);
  # remember the search
  write_auto($settings,$results);
  1; # return a true result to indicate that we don't need further configuration
}

sub do_plugin_configure {
  my $plugin   = shift;
  my $p = $PLUGINS->plugin($plugin) or return;
  my $type = $p->type;
  my @action_labels = ($CONFIG->tr('Cancel'),$CONFIG->tr('Configure_plugin'));
  push @action_labels,$CONFIG->tr('Find') if $type eq 'finder';
  push @action_labels,$CONFIG->tr('Go')   if ($type eq 'dumper' or $type eq 'filter');
  my @buttons = map {submit(-name=>'plugin_action',-value=>$_)} @action_labels;

  print h1($p->type eq 'finder' ? $CONFIG->tr('Find') : $CONFIG->tr('Configure'),$p->name);
  my $config_html = $p->configure_form;

  print start_multipart_form(),
    $config_html ? (
		    $config_html,p(),
		    join ('&nbsp;',
			  @buttons[0..@buttons-2],
			  b($buttons[-1]),
			  ),
		    # This is an insurance policy in case user hits return in text field
		    # in which case the plugin_action is not going to be defined
		    hidden(-name=>'plugin_action',-value=>$action_labels[-1],-override=>1),
		   )
                 : ( p($CONFIG->tr('Boring_plugin')),
		     b(submit($CONFIG->tr('Back_to_Browser')))
		   ),
     hidden(-name=>'plugin_config',-value=>1,-override=>1),
     hidden('plugin'),
     end_form();
}

# invoke any finder plugins that define the auto_find() method
sub do_plugin_autofind {
  my ($settings,$searchterm) = @_;
  my $segments = [];

  for my $p ($PLUGINS->plugins) {
    next unless $p->type eq 'finder' && $p->can('auto_find');
    do_plugin_find($settings,$p,$segments,$searchterm);
    last if @$segments;
  }
  return @$segments;
}

sub toggle {
  my $page_settings = shift;
  my $title         = shift;
  my @body           = @_;

  my $id    = "\L${title}_panel\E";
  my $label = $CONFIG->tr($title)                 or return '';
  my $state = $CONFIG->section_setting($title)    or return '';
  return '' if $state eq 'off';
  my $visible = exists $page_settings->{section_visible}{$id} ? $page_settings->{section_visible}{$id} : $state eq 'open';

  return toggle_section({on=>$visible},
			$id,
			b($label),
			@body);
}

sub tableize {
  my $array = shift;
  my $category = shift;
  return unless @$array;

  my $columns = CHECKBOX_COLUMNS;
  my $rows    = int( @$array/$columns + 0.99 );

  my @column_labels=();
  my @row_labels=();

  # gets the data for the defined 'category table(s)'
  my %categorytable=%{category_table()};

  # checks if this is about to rendered and if it is set the correct row/columns lengths
  if ( defined $categorytable{$category} ) {
    @column_labels=@{$categorytable{$category}{row_labels}};
    @row_labels=@{$categorytable{$category}{col_labels}};
    $rows    =$#row_labels+1;
    $columns =$#column_labels+1;
  }

  my $cwidth = 100/$columns . '%';

  my $html = start_table({-border=>0,-width=>'100%'});
  if (@column_labels) {
    $html.="<tr><td></td>";
    for (my $column=0;$column<$columns;$column++) {
      $html .= "<td><b>$column_labels[$column]</b></td>";
    }
    $html.="</tr>";
  }

  for (my $row=0;$row<$rows;$row++) {
    # do table headers
    $html .= "<tr>";
    $html .= "<td><b>$row_labels[$row]</b></td>" if @row_labels;
    for (my $column=0;$column<$columns;$column++) {
      $html .= td({-width=>$cwidth},$array->[$column*$rows + $row] || '&nbsp;');
    }
    $html .= "</tr>\n";
  }
  $html .= end_table;
}

sub get_regionview_seg {
  my ($settings,$detail_start, $detail_end, $whole_start, $whole_end) = @_;
  my $regionview_length = $settings->{region_size};
  if ($detail_end - $detail_start + 1 > $regionview_length) { # region can't be smaller than detail
    $regionview_length = $detail_end - $detail_start + 1;
  }
  my $midpoint = ($detail_end + $detail_start) / 2;
  my $regionview_start = int($midpoint - $regionview_length/2 + 1);
  my $regionview_end = int($midpoint + $regionview_length/2);
  if ($regionview_start < $whole_start) {
    $regionview_start = 1;
    $regionview_end   = $regionview_length;
  }
  if ($regionview_end > $whole_end) {
    $regionview_start = $whole_end - $regionview_length + 1;
    $regionview_end   = $whole_end;
  }
  return ($regionview_start, $regionview_end);
}

sub unique {
  my @list = shift;
  my %seenit;
  return grep {defined $_ && !$seenit{$_}++} @list;
}

sub split_labels {
   map {/^(http|ftp|das)/ ? $_ : split /[+-]/} @_;
}

sub is_search {
  my $page_settings = shift;
  return 1 if param();
  return 1 if     $CONFIG->setting('initial landmark') && !$page_settings->{name};
  return 1 unless $CONFIG->setting('no autosearch');
  return undef;
}

sub category_table {
  my $tabledata  = $CONFIG->setting('general'=>'category tables');
  my @tabledata  = shellwords($tabledata||'');
  my %categorytable=();
  while (@tabledata) {
     my $category=shift(@tabledata);
     my $rows=shift(@tabledata);
     my @rows=split(/\s+/,$rows);
     my $cols=shift(@tabledata);
     my @cols=split(/\s+/,$cols);
     $categorytable{$category}{row_labels}=\@rows;
     $categorytable{$category}{col_labels}=\@cols;
  }
   
  return (\%categorytable); 
}

sub version_warning {
  return if Bio::Graphics::Panel->can('api_version') &&
	  Bio::Graphics::Panel->api_version >= $BIOGRAPHICS_VERSION;

    warn <<END;
GBROWSE VERSION MISMATCH:
GBrowse version $VERSION requires a compatible version of the Bio::Graphics library.
You should either install BioPerl (the CVS live version) or reinstall GBrowse,
which will patch Bio::Graphics to the latest version.
END
}