package Bio::Graphics::Browser2::RenderPanels;
use strict;
use warnings;

use GD 'gdTransparent','gdStyled';

use Bio::Graphics;
use Digest::MD5 'md5_hex';
use Carp 'croak','cluck';
use Bio::Graphics::Browser2::Render;
use Bio::Graphics::Browser2::CachedTrack;
use Bio::Graphics::Browser2::Util qw[shellwords url_label];
use Bio::Graphics::Browser2::Render::Slave::Status;
use IO::File;
use Time::HiRes 'sleep','time';
use Data::Dumper;
use POSIX 'WNOHANG','setsid';
use CGI qw(:standard param escape unescape);

use constant TRUE  => 1;
use constant DEBUG => 0;
use constant DEBUGGING_RECTANGLES => 0;  # outline the imagemap
use constant BENCHMARK => 0;

use constant DEFAULT_EMPTYTRACKS => 0;
use constant PAD_DETAIL_SIDES    => 10;
use constant RULER_INTERVALS     => 20;
use constant PAD_OVERVIEW_BOTTOM => 5;
use constant TRY_CACHING_CONFIG  => 1;
use constant MAX_PROCESSES       => 4;

# when we load, we set a global indicating the LWP::UserAgent is available
my $LPU_AVAILABLE;
my $STO_AVAILABLE;

sub new {
  my $class       = shift;
  my %options     = @_;
  my $segment       = $options{-segment};
  my $whole_segment = $options{-whole_segment};
  my $region_segment= $options{-region_segment};
  my $data_source   = $options{-source};
  my $page_settings = $options{-settings};
  my $language      = $options{-language};
  my $render        = $options{-render};

  my $self  = bless {},ref $class || $class;
  $self->segment($segment);
  $self->whole_segment($whole_segment);
  $self->region_segment($region_segment);
  $self->source($data_source);
  $self->settings($page_settings);
  $self->language($language);
  $self->render($render);

  return $self;
}

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

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

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

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

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

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

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

# NOTE: This is essentially the same as render_panels() in the 'stable' Browser.pm
# This renders the named tracks and returns the HTML needed to display them.
# Caching and distribution across multiple databases is implemented.
#
# input args:
#           {labels             => [array of track labels],
#            external_features  => [third party annotations (Bio::DasI objects)],
#            deferred           => generate in background
#           };
# output
# if deferred => false...
#      { label1 => html1, label2 => html2...} where HTML is the <div> for the named track
#
# if deferred => true
#      { label1 => CachedTrack1, label2 => CachedTrack2...}
#       where CachedTrack is a Bio::Graphics::Panel::CachedTrack object that will eventually
#       receive the data. Poll this object for its data.
#
sub request_panels {
  my $self    = shift;
  my $args    = shift;

  my $data_destinations = $self->make_requests($args);

  # sort the requests out into local and remote ones
  my ($local_labels,
      $remote_labels) = $self->sort_local_remote($data_destinations);

  warn "[$$] request_panels(): section = $args->{section}; local labels = @$local_labels, remote labels = @$remote_labels" if DEBUG;

  # If we don't call clone_databases early, then we can have
  # a race condition where the parent hits the DB before the child
  # NOTE: commented out because clone logic has changed - may need to reenable this
  # for postgresql databases
  # Bio::Graphics::Browser2::DataBase->clone_databases();

  my $do_local  = @$local_labels;
  my $do_remote = @$remote_labels;

  # In the case of a deferred request we fork.
  # Parent returns the list of requests.
  # Child processes the requests in the background.
  # If both local and remote requests are needed, then we
  # fork a second time and process them in parallel.
  if ($args->{deferred}) {

      # precache local databases into cache
      my $length = $self->segment->length;
      my $source = $self->source;
      for my $l (@$local_labels) {
	  my $db = eval { $source->open_database($l,$length)};
      }

      my $child = Bio::Graphics::Browser2::Render->fork();

      if ($child) {
	  return $data_destinations;
      }

      open STDIN, "</dev/null" or die "Couldn't reopen stdin";
      open STDOUT,">/dev/null" or die "Couldn't reopen stdout";
      POSIX::setsid()          or die "Couldn't start new session";

      if ( $do_local && $do_remote ) {
          if ( Bio::Graphics::Browser2::Render->fork() ) {
              $self->run_local_requests( $data_destinations,
					 $args,
					 $local_labels );
          }
          else {
              $self->run_remote_requests( $data_destinations, 
					  $args,
					  $remote_labels );
          }
      }
      elsif ($do_local) {
          $self->run_local_requests( $data_destinations, $args,$local_labels );
      }
      elsif ($do_remote) {
          $self->run_remote_requests( $data_destinations, $args,$remote_labels );
      }
      CORE::exit 0;
  }

  else { # not deferred
      $self->run_local_requests($data_destinations,$args,$local_labels);  
      $self->run_remote_requests($data_destinations,$args,$remote_labels);
      return $data_destinations;
  }
}

sub render_panels {
    my $self = shift;
    my $args = shift;
    delete $args->{deferred}; # deferred execution incompatible with this call
    my $requests = $self->request_panels($args);
    return $self->render_tracks($requests,$args);
}


# this method returns a hashref in which the keys are track labels
# and the values are hashrefs with the keys 'gd' and 'map'. The former
# is a GD object, and the latter is the raw map data.
# Raw map data is tab-delimited in the format
# <feature name><x1><y1><x2><y2><key1><value1><key2><value2>...
# use map_html() to make HTML out of the thing
sub render_track_images {
    my $self         = shift;
    my $args         = shift;

    delete $args->{deferred}; # deferred execution incompatible with this call
    my $requests = $self->request_panels($args);

    my %results;
    my %still_pending = map {$_=>1} keys %$requests;
    my $k     = 1.25;
    my $delay = 0.1;
    while (%still_pending) {
	for my $label (keys %$requests) {
	    my $data = $requests->{$label};
	    $data->cache_time(0) if $data->cache_time < 0;
	    next if $data->status eq 'PENDING';
	    next if $data->status eq 'EMPTY';
	    if ($data->status eq 'AVAILABLE') {
		my ($gd,$map)  = eval{($data->gd,$data->map)};
		$results{$label}{gd}  = $gd;
		$results{$label}{map} = $map;
	    }
	    delete $still_pending{$label};
	}
	sleep $delay if %still_pending;
	$delay *= $k; # sleep a little longer each time using an exponential backoff
    }
    return \%results;
}


# return a hashref in which the keys are labels and the values are
# CachedTrack objects that are ready to accept data.
sub make_requests {
    my $self   = shift;
    my $args   = shift;
    my $source = $self->source;
    my $settings=$self->settings;

    my $feature_files  = $args->{external_features};
    my $labels         = $args->{labels};

    warn "[$$] MAKE_REQUESTS, labels = ",join ',',@$labels if DEBUG;

    my $base        = $self->get_cache_base();
    my @panel_args  = $self->create_panel_args($args);
    my @cache_extra = @{ $args->{cache_extra} || [] };
    my %d;

    warn "panel_args = @panel_args, cache_extra=@cache_extra" if DEBUG;

    foreach my $label ( @{ $labels || [] } ) {

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

	my (@filter_args,@featurefile_args,@subtrack_args);

	my $format_option = $settings->{features}{$label}{options};

	my $filter     = $settings->{features}{$label}{filter};
	@filter_args   = %{$filter->{values}} if $filter->{values};
	@subtrack_args = @{$settings->{subtracks}{$label}} 
	                 if $settings->{subtracks}{$label};
	my $ff_error;

        # get config data from the feature files
	(my $track = $label) =~ s/:(overview|region|details?)$//;
	if ($feature_files && exists $feature_files->{$track}) {

	    # some broken logic here...
	    my $feature_file = $feature_files->{$track} || $feature_files->{$label};

	    unless (ref $feature_file) { # upload problem!
		my $cache_object = Bio::Graphics::Browser2::CachedTrack->new(
		    -cache_base => $base,
		    -panel_args => \@panel_args,
		    -track_args => \@track_args,
		    -extra_args => [ @cache_extra, 
				     @filter_args, 
				     @featurefile_args, 
				     @subtrack_args,
				     $format_option, 
				     $label ],
		    );
    
		my $msg = eval {$args->{remotes}->error($track)};
		$cache_object->flag_error($msg || "Could not fetch data for $track");
		$d{$track} = $cache_object;
		next;
	    }
	    
	    # broken logic here?
	    # next unless $label =~ /:$args->{section}$/;
	    @featurefile_args =  eval {
		$feature_file->isa('Bio::Das::Segment')||$feature_file->types, 
		$feature_file->mtime;
	    };
	}

	warn "[$$] creating CachedTrack for $label, nocache = $args->{nocache}" if DEBUG;
	my $cache_time =  $args->{nocache}    ? -1
	                : $settings->{cache}  ? $source->cache_time
                        : -1;

        my $cache_object = Bio::Graphics::Browser2::CachedTrack->new(
            -cache_base => $base,
            -panel_args => \@panel_args,
            -track_args => \@track_args,
            -extra_args => [ @cache_extra, 
			     @filter_args, 
			     @featurefile_args,  
			     @subtrack_args, 
			     $format_option, 
			     $label ],
	    -cache_time => $cache_time
        );
        $d{$label} = $cache_object;
    }

    return \%d;
}

sub use_renderfarm {
  my $self   = shift;
  return $self->{use_renderfarm} if exists $self->{use_renderfarm};

  #comment out to force remote rendering (kludge)
  $self->source->global_setting('renderfarm') or return;	

  $LPU_AVAILABLE = eval { require LWP::UserAgent; }           unless defined $LPU_AVAILABLE;
  $STO_AVAILABLE = eval { require Storable; 1; }              unless defined $STO_AVAILABLE;
  $Storable::Deparse = 1;

  $self->{use_renderfarm} = $LPU_AVAILABLE && $STO_AVAILABLE;
  return $self->{use_renderfarm} if $self->{use_renderfarm};
  warn "The renderfarm setting requires the LWP::UserAgent and Storable modules,
but one or both are missing. Reverting to local rendering.\n";
  return;
}

sub drag_and_drop {
  my $self     = shift;
  my $override = shift;
  return if defined $override && !$override;
  my $source   = $self->source;
  return unless $source->global_setting('drag and drop'); # drag and drop turned off
  return if     $source->global_setting('postgrid');      # postgrid forces drag and drop off
  1;
}

# Returns the full HTML listing of all requested tracks.
sub render_tracks {
    my $self     = shift;
    my $requests = shift;
    my $args     = shift;
    my %result;
    
    for my $label ( keys %$requests ) {
        my $data   = $requests->{$label};
        my $gd     = eval{$data->gd} or next;
        my $map    = $data->map;
        my $titles = $data->titles;
        my $width  = $data->width;
        my $height = $data->height;
        my $url    = $self->source->generate_image($gd);

        # for debugging
        my $status = $data->status;

        $result{$label} = $self->wrap_rendered_track(
            label    => $label,
            area_map => $map,
            width    => $width,
            height   => $height,
            url      => $url,
	    titles   => $titles,
            status   => $status,
	    section  => $args->{section},
        );
    }
    
    return \%result;
 
}

# Returns the HMTL to show a track with controls, title, arrows, etc.
sub wrap_rendered_track {
    my $self   = shift;
    my %args   = @_;
    my $label  = $args{'label'};
    my $map    = $args{'area_map'};
    my $width  = $args{'width'};
    my $height = $args{'height'};
    my $url    = $args{'url'};
    my $titles = $args{'titles'};
  
    # track_type Used in register_track() javascript method
    my $track_type = $args{'track_type'} || 'standard';
    my $status = $args{'status'};    # for debugging

    my $buttons  = $self->source->globals->button_url;
    my $plus     = "$buttons/plus.png";
    my $minus    = "$buttons/minus.png";
    my $kill     = "$buttons/ex.png";
    my $share    = "$buttons/share.png";
    my $help     = "$buttons/query.png";
    my $download = "$buttons/download.png";
    my $configure= "$buttons/tools.png";
    my $menu 	 = "$buttons/menu.png";
    my $favicon  = "$buttons/fmini.png";
    my $favicon_2= "$buttons/fmini_2.png";
    my $add_or_remove = $self->language->translate('ADDED_TO') || 'Add track to favorites';
    
    my $settings = $self->settings;
    my $source   = $self->source;

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

    # commented out alt because it interferes with balloon tooltips is IE
    my $map_id = "${label}_map";

    # Work around bug in google chrome which is manifested by the <area> link information
    # on all EVEN reloads of the element by ajax calls. Weird.
    my $agent  = CGI->user_agent || '';
    $map_id   .= "_".int(rand(1000)) ;

    my $img = img(
        {   -src    => $url,
            -usemap => "#${map_id}",
            -width  => $width,
            -id     => "${label}_image",
            -height => $height,
            -border => 0,
            -name   => $label,
            -style  => $img_style
	    
        }
    );

    my $icon = $collapsed ? $plus : $minus;
    my $show_or_hide = $self->language->translate('SHOW_OR_HIDE_TRACK')
        || "Show or Hide";
    my $kill_this_track = $self->language->translate('KILL_THIS_TRACK')
	|| "Turn off this track.";
    my $share_this_track = $self->language->translate('SHARE_THIS_TRACK')
        || "Share this track";

    my $configure_this_track = '';
    $configure_this_track .= $self->language->translate('CONFIGURE_THIS_TRACK')
        || "Configure this track";

    my $download_this_track = '';
    $download_this_track .= $self->language->translate('DOWNLOAD_THIS_TRACK')
        || "<b>Download this track</b>";

    my $about_this_track = '';
    $about_this_track .= $self->language->translate('ABOUT_THIS_TRACK',$label)
        || "<b>About this track</b>";

    my $escaped_label = CGI::escape($label);

    # The inline config will go into a box 500px wide by 500px tall
    # scrollbars will appear if there is overflow. The box should shrink
    # to fit if the contents are smaller than 500 x 500
    my $config_click;
    if ( $label =~ /^plugin:/ ) {
        my $config_url = "url:?plugin=$escaped_label;plugin_do=Configure";
        $config_click
            = "GBox.showTooltip(event,'$config_url',true)";
    }

    elsif ( $label =~ /^file:/ ) {
	my $escaped_file = CGI::escape($label);
	$config_click    = qq[Controller.edit_upload('$escaped_file')];
    }

    else {
        my $config_url = "url:?action=configure_track;track=$escaped_label";
        $config_click
            = "GBox.showTooltip(event,'$config_url',true)";
    }

    my $help_url       = "url:?action=cite_track;track=$escaped_label";
    my $help_click     = "GBox.showTooltip(event,'$help_url',1)"; 

    

    my $download_click = "GBox.showTooltip(event,'url:?action=download_track_menu;track=$escaped_label;view_start='+TrackPan.get_start()+';view_stop='+TrackPan.get_stop(),true)" unless $label =~ /^(http|ftp)/;

    my $title;
    if ($label =~ /^file:/) {
	$title = $label;
    }
    elsif ($label =~ /^(http|ftp):/) {
	$title = url_label($label);

    }
    elsif ($label =~ /^plugin/) {
	$title = $self->render->plugin_name($label);
    }
    else {
	(my $l = $label) =~ s/:\w+$//;
	$title = $source->setting($l=>'key') || $label;
    }
    $title =~ s/:(overview|region|detail)$//;
    my $fav_click      =  "toggle_titlebar_stars('$label')";
   
    my $balloon_style = $source->global_setting('balloon style') || 'GBubble'; 
    my $favorite      = $settings->{favorites}{$label};
    my $starIcon      = $favorite ? $favicon_2 : $favicon;
    my $starclass     = $favorite ? "toolbarStar favorite" : "toolbarStar";
    (my $l = $label) =~ s/:(overview|detail|regionview)$//;
    my @images = (
        $fav_click ? img({   	-src         => $starIcon,
				-id          =>"barstar_${label}",
				-class       => $starclass,
				-style       => 'cursor:pointer',
				-onmousedown => $fav_click,
				$self->if_not_ipad(-onMouseOver => "$balloon_style.showTooltip(event,'$add_or_remove')"),
			    })
	              : '',
	img({   -src         => $icon, 
                -id          => "${label}_icon",
                -onClick     =>  "collapse('$label')",
                -style       => 'cursor:pointer',
		$self->if_not_ipad(-onMouseOver => "$balloon_style.showTooltip(event,'$show_or_hide')"),
            }
        ),

	img({   -src         => $kill,
                -id          => "${label}_kill",
		-onClick     => "ShowHideTrack('$label',false)",
                -style       => 'cursor:pointer',
                $self->if_not_ipad(-onMouseOver => "$balloon_style.showTooltip(event,'$kill_this_track')"),
            }
        ),
        img({   -src   => $share,
                -style => 'cursor:pointer',
		-onMousedown => "Controller.get_sharing(event,'url:?action=share_track;track=$escaped_label',true)",
                $self->if_not_ipad(-onMouseOver =>
                    "$balloon_style.showTooltip(event,'$share_this_track')"),
            }
        ),

        $config_click ? img({   -src         => $configure,
				-style       => 'cursor:pointer',
				-onmousedown => $config_click,
				$self->if_not_ipad(-onMouseOver => "$balloon_style.showTooltip(event,'$configure_this_track')"),
			    })
	              : '',
        $download_click ? img({   -src         => $download,
				  -style       => 'cursor:pointer',
				  -onmousedown => $download_click,
				  $self->if_not_ipad(-onMouseOver =>
						     "$balloon_style.showTooltip(event,'$download_this_track')"),
			      })
	                 : '',
        img({   -src         => $help,
                 -style       => 'cursor:pointer',
                 -onmousedown => $help_click,
                 -onMouseOver =>
             "$balloon_style.showTooltip(event,'$about_this_track')",
             }
        )
	); 

    my $ipad_collapse = $collapsed ? 'Expand':'Collapse';
    my $cancel_ipad = 'Turn off';
    my $share_ipad = 'Share'; 
    my $configure_ipad = 'Configure';
    my $download_ipad = 'Download';
    my $about_ipad = 'About track';

    my $bookmark = 'Favorite'; 
    my $menuicon = img ({-src => $menu, 
			 -style => 'padding-right:15px;',},),
   
    my $popmenu = div({-id =>"popmenu_${title}", -style => 'display:none'},
		      div({-class => 'ipadtitle', -id => "${label}_title",}, $title ),
		      div({-class => 'ipadcollapsed', 
			   -id    => "${label}_icon", 
			   -onClick =>  "collapse('$label')",
			  },
			  div({-class => 'linkbg', 
			       -onClick => "swap(this,'Collapse','Expand')", 
			       -id => "${label}_expandcollapse", },$ipad_collapse)),
		      div({-class => 'ipadcollapsed',
			   -id => "${label}_kill",
			   -onClick     => "ShowHideTrack('$label',false)",
			  }, div({-class => 'linkbg',},
				 $cancel_ipad)),
		      div({-class => 'ipadcollapsed',  
			   -onMousedown => "Controller.get_sharing(event,'url:?action=share_track;track=$escaped_label',true)",}, 
			  div({-class => 'linkbg',},$share_ipad)),
		      div({-class => 'ipadcollapsed',  -
			       onmousedown => $config_click,}, div({-class => 'linkbg',},$configure_ipad)),
		      div({-class => 'ipadcollapsed',  
			   -onmousedown => $fav_click,}, 
			  div({-class => 'linkbg', -onClick => "swap(this,'Favorite','Unfavorite')"},$bookmark)),
		      div({-class => 'ipadcollapsed',  
			   -onmousedown => $download_click,}, 
			  div({-class => 'linkbg',},$download_ipad)),
		      div({-class => 'ipadcollapsed', 
			   -style => 'width:200px',  
			   -onmousedown => $help_click,}, 
			  div({-class => 'linkbg', -style => 'position:relative; left:30px;',},$about_ipad)),
 		  );
    
    # modify the title if it is a track with subtracks
    $self->select_features_menu($label,\$title);
    
    my $titlebar = 
	span(
		{   -class => $collapsed ? 'titlebar_inactive' : 'titlebar',
		    -id => "${label}_title",
				},

 	    $self->if_not_ipad(@images,),
	    $self->if_ipad(span({-class => 'menuclick',  -onClick=> "GBox.showTooltip(event,'load:popmenu_${title}')"}, $menuicon,),),	
	    span({-class => 'drag_region',},$title),

	);

    my $show_titlebar
        = ( ( $source->setting( $label => 'key' ) || '' ) ne 'none' );
    my $is_scalebar = $label =~ /scale/i;
    my $is_detail   = $label !~ /overview|region/i;
    $show_titlebar &&= !$is_scalebar;

    my $map_html = $self->map_html($map,$map_id);

    # the padding is a little bit of empty track that is displayed only
    # when the track is collapsed. Otherwise the track labels get moved
    # to the center of the page!
    my $pad     = $self->render_image_pad(
	$args{section}||Bio::Graphics::Browser2::Render->get_section_from_label($label),
	);
    my $pad_url = $self->source->generate_image($pad);
    my $pad_img = img(
        {   -src    => $pad_url,
            -width  => $pad->width,
            -border => 0,
            -id     => "${label}_pad",
            -style  => $collapsed ? "display:inline" : "display:none",
        }
    );

    my $overlay_div = '';

    # Add arrows for panning to details scalebar panel
    if ($is_scalebar && $is_detail) {
	my $style    = 'opacity:0.35;position:absolute;border:none;cursor:pointer';
        my $pan_left   =  img({
	    -style   => $style . ';left:5px',
	    -class   => 'panleft',
	    -src     => "$buttons/panleft.png",
	    -onClick => "Controller.scroll('left',0.5)"
	});

	my $pan_right  = img({ 
	    -style   => $style . ';right:5px',
	    -class   => 'panright',
	    -src     => "$buttons/panright.png",
	    -onClick => "Controller.scroll('right',0.5)",
	});
	
	my $scale_div = div( { -id => "detail_scale_scale", -style => "position:absolute; top:12px", }, "" );

        $overlay_div = div( { -id => "${label}_overlay_div", -style => "position:absolute; top:0px; width:100%; left:0px", }, $pan_left . $pan_right . $scale_div);
    }

    my $inner_div = div( { -id => "${label}_inner_div" }, $img . $pad_img ); #Should probably improve this

    my $subtrack_labels = join '',map {
	my ($label,$left,$top) = @$_;
	div({-class=>'subtrack',-style=>"top:${top}px;left:20px;background-color:white"},$label);
    } @$titles;

    my $html = div({-class=>'centered_block',
		 -style=>"position:relative;overflow:hidden"
		},
         ($show_titlebar ? $titlebar : '' ) . $popmenu .  $subtrack_labels . $inner_div . $overlay_div ) . ( $map_html || '' );
    return $html;
}

sub if_not_ipad {
    my $self = shift;
    my @args = @_;
    my $agent = CGI->user_agent || '';
    my $probably_ipad = $agent =~ /Mobile.+Safari/i;
    return if $probably_ipad;
    return @args;
}

sub if_ipad {
    my $self = shift;
    my @args = @_;
    my $agent = CGI->user_agent || '';
    my $probably_ipad = $agent =~ /Mobile.+Safari/i;
    return  if !$probably_ipad;
    return @args;
}
# This routine is called to hand off the rendering to a remote renderer. 
# The remote processor does not have to have a copy of the config file installed;
# the entire DataSource object is sent to it in serialized form via
# POST. It returns a serialized hash consisting of the GD object and the imagemap.
#
# INPUT $renderers_hashref
#    $renderers_hashref->{$remote_url}{$track}
#
# RETURN NOTHING (data will be stored in track cache for later retrieval)
#
# POST outgoing arguments:
#    datasource => serialized Bio::Graphics::Browser2::DataSource
#    settings   => serialized state hash (from the session)
#    tracks     => serialized list of track names to render
#
# POST result: serialized      { label1 => {image,map,width,height,file,gd,boxes}... }
#
# reminder: segment can be found in the settings as $settings->{ref,start,stop,flip}
sub run_remote_requests {
  my $self      = shift;
  my ($requests,$args,$labels) = @_;

  warn "[$$] run_remote_requests on @$labels" if DEBUG;

  my @labels_to_generate = @$labels;
  return unless @labels_to_generate;

  eval { use HTTP::Request::Common; } unless HTTP::Request::Common->can('POST');

  my $source     = $self->source;
  my $settings   = $self->settings;
  my $lang       = $self->language;
  my %env        = map {$_=>$ENV{$_}}    grep /^(GBROWSE|HTTP)/,keys %ENV;
  my %args       = map {$_=>$args->{$_}} grep /^-/,keys %$args;									#/

  $args{$_}  = $args->{$_} foreach ('section','image_class','cache_extra');

  # serialize the data source and settings
  my $s_set	= Storable::nfreeze($settings);
  my $s_lang	= Storable::nfreeze($lang);
  my $s_env	= Storable::nfreeze(\%env);
  my $s_args    = Storable::nfreeze(\%args);
  my $s_mtime   = 0;

  my $frozen_source = Storable::nfreeze($source);
  my $s_dsn;

  if (TRY_CACHING_CONFIG) {
      $s_dsn   = undef;
      $s_mtime = $source->mtime;
  } else {
      $s_dsn = Storage::nfreeze($source);
  }

  # sort requests by their renderers
  my $slave_status = Bio::Graphics::Browser2::Render::Slave::Status->new(
      $source->globals->slave_status_path
      );

  my %renderers;
  for my $label (@labels_to_generate) {
      my $url     = $source->remote_renderer or next;
      my @urls    = shellwords($url);
      $url        = $slave_status->select(@urls);
      warn "label => $url (selected)" if DEBUG;
      unless ($url) {
	  # the status monitor indicates that there are no "up" servers for this
	  # track, so flag an error immediately and don't attempt to retrieve.
	  # after a suitable time interval has passed, we will try this server again
	  $requests->{$label}->flag_error('no slave servers are marked up');
      } else {
	  $renderers{$url}{$label}++;
      }
  }

  my $ua = LWP::UserAgent->new;
  my $timeout = $source->global_setting('slave_timeout') 
      || $source->global_setting('global_timeout') 
      || 30;
  $ua->timeout($timeout);

  for my $url (keys %renderers) {

      my $child   = Bio::Graphics::Browser2::Render->fork();
      next if $child;

      my $total_time = time();

      # THIS PART IS IN THE CHILD
      my @labels   = keys %{$renderers{$url}};
      my $s_track  = Storable::nfreeze(\@labels);

      foreach (@labels) {
	  $requests->{$_}->lock();   # flag that request is in process
      }
  
    FETCH: {
	my $request = POST ($url,
			    Content_Type => 'multipart/form-data',
			    Content => [
				operation  => 'render_tracks',
				panel_args => $s_args,
				tracks     => $s_track,
				settings   => $s_set,
				datasource => $s_dsn||'',
				data_name  => $source->name,
				data_mtime => $s_mtime,
				language   => $s_lang,
				env        => $s_env,
			    ]);

	my $time = time();
	my $response = $ua->request($request);
	my $elapsed = time() - $time;

	warn "$url=>@labels: ",$response->status_line," ($elapsed s)" if DEBUG;

	if ($response->is_success) {
	    my $contents = Storable::thaw($response->content);
	    for my $label (keys %$contents) {
		my $map = $contents->{$label}{map}        
		  or die "Expected a map from remote server, but got nothing!";
		my $titles = $contents->{$label}{titles}        
		  or die "Expected titles from remote server, but got nothing!";
		my $gd2 = $contents->{$label}{imagedata}  
		  or die "Expected imagedata from remote server, but got nothing!";
		$requests->{$label}->put_data($gd2,$map,$titles);
	    }
	    $slave_status->mark_up($url);
	}
	elsif ($response->status_line =~ /REQUEST DATASOURCE/) {
	    $s_dsn	= Storable::nfreeze($source);
	    $s_mtime    = 0;
	    redo FETCH;
	}
	else {
	    my $uri = $request->uri;
	    my $response_line = $response->status_line;
	    $slave_status->mark_down($url);
	  
	    # try to recover from a transient slave failure; this only works
	    # right if all of the tracks there are multiple equivalent slaves for the tracks
	    my %urls    = map {$_=>1} 
  	                    map {
				shellwords($source->remote_renderer)
			    } @labels;
	    my $alternate_url = $slave_status->select(keys %urls);
	    if ($alternate_url) {
		warn "retrying fetch of @labels with $alternate_url";
		$url = $alternate_url;
		redo FETCH;
	    }

	    $response_line =~ s/^\d+//;  # get rid of status code
	    $requests->{$_}->flag_error($response_line) foreach keys %{$renderers{$uri}};
	}
      }

      my  $elapsed = time() - $total_time;
      warn "[$$] total_time = $elapsed s" if DEBUG;

      CORE::exit(0);  # from CHILD
  }
}

# Sort requests into those to be performed locally
# and remotely. Returns two arrayrefs (\@local_labels,\@remote_labels)
# Our algorithm is very simple. It is a remote request if the "remote renderer"
# option is set, local otherwise. This means that a "remote renderer" of "localhost"
# will be treated as a remote renderer request.
sub sort_local_remote {
    my $self     = shift;
    my $requests = shift;

    warn "requests = ",join ' ',keys %$requests if DEBUG;

    my @uncached;
    if ($self->settings->{cache}){
        @uncached = grep {$requests->{$_}->needs_refresh} keys %$requests;
    }
    else{
        @uncached = keys %$requests;
    }

    my $source         = $self->source;
    my $use_renderfarm = $self->use_renderfarm;

    unless ($use_renderfarm) {
	return (\@uncached,[]);
    }

    my $url;
    my %is_remote = map { $_ => ( 
			      !/plugin:/ &&
			      !/file:/   &&
			      !/^(ftp|http|das):/ &&
			      !$source->is_usertrack($_) &&
			      !$source->is_remotetrack($_) &&
			      (($url = $source->remote_renderer||0) &&
			      ($url ne 'none') &&
			      ($url ne 'local')))
                        } @uncached;

    my @remote    = grep {$is_remote{$_} } @uncached;
    my @local     = grep {!$is_remote{$_}} @uncached;

    return (\@local,\@remote);
}

#moved from Render.pm
sub overview_ratio {
  my $self = shift;
  return 1.0;   # for now
}

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

  my $source = $self->source;

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

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

# Handle the rendering of all three types of scale bars
sub render_scale_bar {
    my $self    = shift;
    my %args    = @_;
    my $segment = $args{'segment'};
    my $state   = $args{'state'};
    my $section = $args{'section'} || 'detail';
    my $gd;

    # Temporary kludge until I can figure out a more
    # sane way of rendering overview with SVG...
    my $image_class = 'GD';
    eval "use $image_class";

    my $source = $self->source;

    my ( $wide_segment, $bgcolor, $pad_bottom, %add_track_extra_args, );

    if ( $section eq 'overview' ) {
        $wide_segment = $args{'whole_segment'} or return ( '', 0, 0 );
        %add_track_extra_args = (
            -bgcolor => $source->global_setting('overview bgcolor')
                || 'wheat',
            -pad_bottom => 0,
            -label      => $wide_segment->seq_id,
            -label_font => $image_class->gdMediumBoldFont,
        );
    }
    elsif ( $section eq 'region' ) {
        $wide_segment = $args{'region_segment'} or return ( '', 0, 0 );
        %add_track_extra_args = (
            -bgcolor => $source->global_setting('region bgcolor') || 'wheat',
            -pad_bottom => 0,
        );
    }
    else {
        $wide_segment         = $segment;
        %add_track_extra_args = (
            -bgcolor    => $source->global_setting('detail bgcolor') || 'wheat',
            -pad_top    => 18,
            -pad_bottom => 0,
            -label_font => $image_class->gdMediumBoldFont,
	    -label      => eval{$segment->seq_id.
				    ': '
				    .$self->source->unit_label($segment->length)
	    }||'', # intermittent bug here with undefined $segment
        );
    }

    my $flip = ( $section eq 'detail' and $state->{'flip'} ) ? 1 : 0;

    my @panel_args = $self->create_panel_args(
        {   section        => $section, 
            segment        => $wide_segment,
            flip           => $flip,
            %add_track_extra_args
        }
    );


    my $panel = Bio::Graphics::Panel->new( @panel_args, );

    my $width = ($section eq 'detail')? $self->render->get_detail_image_width($state) : $self->render->get_image_width($state);

    # no cached data, so do it ourselves
    unless ($gd) {
        my $units = $source->global_setting('units') || '';
        my $no_tick_units = $source->global_setting('no tick units');


        $panel->add_track(
             $wide_segment,
            -glyph          => 'arrow',
            -double         => 1,
            -tick           => 2,
            -units_in_label => $no_tick_units,
            -units          => $units,
            -unit_divider   => $source->unit_divider,
            %add_track_extra_args,
        );

        # add uploaded files that have the "(over|region)view" option set

        $gd = $panel->gd;
    }

    my ( $y1, $y2 ) = ( 0, ( $gd->getBounds )[1] );

    eval { $panel->finished }; # should quash memory leaks when used in conjunction with bioperl 1.4

    my $url    = $self->source->generate_image($gd);
    my $height = $y2 - $y1; # + 1;

    return ( $url, $height, $width, );
}

sub render_image_pad {
    my $self    = shift;
    my ($section,$segment) = @_;

    $segment ||= $section  eq 'overview'  ? $self->whole_segment
                 :$section eq 'region'    ? $self->region_segment
                 :$self->segment;

    my @panel_args  = $self->create_panel_args({
	section => $section,
	segment => $segment,
	}
	);
    my @track_args  = ();
    my @extra_args  = ($self->settings->{start},
		       $self->settings->{stop});
    my $cache = Bio::Graphics::Browser2::CachedTrack->new(
	-cache_base => $self->get_cache_base,
	-panel_args => \@panel_args,
	-track_args => \@track_args,
	-extra_args => \@extra_args,
        );
    unless ($cache->status eq 'AVAILABLE') {
	my $panel = Bio::Graphics::Panel->new(@panel_args);
	$cache->lock;
	my $gd = $panel->gd;
	$cache->put_data($gd,'',[]);
    }

    my $gd = $cache->gd;
    return $gd;
}

sub bump_density {
  my $self     = shift;
  my $conf = $self->source;
  my $bd = $conf->global_setting('bump density')
      || $conf->setting('TRACK DEFAULTS' =>'bump density')
      || 50;
  return int($bd * $self->details_mult);
}

sub label_density {
  my $self = shift;
  my $conf = $self->source;
  my $ld = $conf->global_setting('label density')
      || $conf->setting('TRACK DEFAULTS' =>'label density')
      || 10;
  return int($ld * $self->details_mult);
}

sub calculate_scale_size {
    my $self      = shift;
    my ($length,$width) = @_;

    # how long is 1/5 of the width?
    my $scale        = $length/$width;
    my $guesstimate  = $scale * ($width/5);

    # turn into multiples of 10
    my $exp  = 10 ** int log10($guesstimate);
    my $base = ($guesstimate/$exp);
    if    ($base < 1) { $base = 1 }
    elsif ($base < 2) { $base = 2 }
    elsif ($base < 5) { $base = 5 }
    else              { $base = 10};
    $guesstimate = $base * $exp;
    my $label    = $self->source->unit_label($guesstimate);

    return ($guesstimate, $label);
}

sub log10 { return eval {log(shift)/log(10)} || 0 }

# Deprecated. This method was used to add the scale to the detail scale track. This is now done in javascript.
sub make_scale_feature {
    my $self      = shift;
    my ($segment,$width) = @_;
    return unless $segment;

    my $length   = $segment->length / $self->details_mult;

    my ($guesstimate, $label) = $self->calculate_scale_size($length, $width);

    my $scale = $segment->length/$width;

    $label       .= ' '; # more attractive
    my $size     = $guesstimate/$scale;
    my $left     = ($width-$size)/2;
    my $start    = int (($segment->start + $segment->end)/2 - $guesstimate/2);
    my $end      = $start + $guesstimate - 1;

    return Bio::Graphics::Feature->new(-display_name => $label,
				       -start        => $start,
				       -end          => $end,
				       -seq_id       => $segment->seq_id);
}

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

  my $source = $self->source;

  my $flip = $panel->flip;
  my $tips = $source->global_setting('balloon tips') && $self->settings->{'show_tooltips'};
  my $use_titles_for_balloons = $source->global_setting('titles are balloons');

  my $did_map;

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

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

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

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

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

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

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

      my $sticky             = $source->setting($label,'balloon sticky');
      my $height             = $source->setting($label,'balloon height') || 300;

      if ($use_titles_for_balloons) {
	$balloonhover ||= $title;
      }

      $balloon_ht ||= $source->global_setting('balloon style') || 'GBubble';
      $balloon_ct ||= $balloon_ht;

      if ($balloonhover) {
        my $stick = defined $sticky ? $sticky : 0;
        $mouseover = $balloonhover =~ /^(https?|ftp):/
	    ? "$balloon_ht.showTooltip(event,'<iframe width='+$balloon_ct.maxWidth+' height=$height frameborder=0 " .
	      "src=$balloonhover></iframe>',$stick)"
	    : "$balloon_ht.showTooltip(event,'$balloonhover',$stick)";
	undef $title;
      }
      if ($balloonclick) {
	my $stick = defined $sticky ? $sticky : 1;
        $style = "cursor:pointer";
	$mousedown = $balloonclick =~ /^(http|ftp):/
	    ? "$balloon_ct.showTooltip(event,'<iframe width='+$balloon_ct.maxWidth+' height=$height " .
	      "frameborder=0 src=$balloonclick></iframe>',$stick,$balloon_ct.maxWidth)"
	    : "$balloon_ct.showTooltip(event,'$balloonclick',$stick)";
	undef $href;
	undef $target;
      }
    }

    # workarounds to accomodate observation that some browsers don't respect cursor:pointer styles in
    # <area> tags unless there is an href defined
    $href    ||=     'javascript:void(0)';

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

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

  return \@map;

}

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

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

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

  my $ruler_intervals = RULER_INTERVALS;

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

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

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

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

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

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

# this is the routine that actually does the work!!!!
# input
#    arg1: request hashref 
#                 {label => Bio::Graphics::Browser2::CachedTrack}
#    arg2: arguments hashref
#                  {
#                    external_features => [list of external features, plugins]
#                    noscale           => (get rid of this?)
#                    do_map            => (get rid of this?)
#                    cache_extra       => (get rid of this?)
#                    section           => (get rid of this?)
#                   }
#    arg3: labels arrayref (optional - uses keys %$request otherwise)
#
# output
#    { label1 => $track_cache_object,
#      label2 => $track_cache_object....
#    }

sub run_local_requests {
    my $self     = shift;
    my $requests = shift;  # a hash of labels => Bio::Graphics::Browser2::CachedTrack objects
    my $args     = shift;
    my $labels   = shift;

    my $time     = time();

    warn "[$$] run_local_requests on @$labels" if DEBUG;

    $labels    ||= [keys %$requests];

    my $noscale        = $args->{noscale};
    my $do_map         = $args->{do_map};
    my $cache_extra    = $args->{cache_extra} || [];
    my $section        = $args->{section}     || 'detail';
    my $nocache        = $args->{nocache};

    my $settings       = $self->settings;
    my $segment        = $self->segment;
    my $length         = $segment->length;

    my $source         = $self->source;
    my $lang           = $self->language;

    my $base           = $self->get_cache_base;

    my $feature_files  = $args->{external_features};

    # FIXME: this has to be set somewhere
    my $hilite_callback= undef;

    $segment->factory->debug(1) if DEBUG;

    #---------------------------------------------------------------------------------
    # Track and panel creation
    
    my %seenit;           # avoid error of putting track on list multiple times
    my %results;          # hash of {$label}{gd} and {$label}{map}
    my %feature_file_offsets;

    my @labels_to_generate = @$labels;
    my @ordinary_tracks    = grep {!$feature_files->{$_}} @labels_to_generate;
    my @feature_tracks     = grep {$feature_files->{$_} } @labels_to_generate;

    # create all the feature filters for each track
    my $filters = $self->generate_filters($settings,$source,\@labels_to_generate);

    my (%children,%reaped);

    local $SIG{CHLD} = sub {
	while ((my $pid = waitpid(-1, WNOHANG)) > 0) {
	    warn "[$$] reaped child $pid" if DEBUG;
	    $reaped{$pid}++;
	    delete $children{$pid} if $children{$pid};
	}
    };

    my $max_processes = $self->source->global_setting('max_render_processes')
	|| MAX_PROCESSES;

    for my $label (@labels_to_generate) {

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

	# don't let there be more than this many processes 
	# running simultaneously
	while ((my $c = keys %children) >= $max_processes) {
	    warn "[$$] too many processes ($c), sleeping" if DEBUG;
	    sleep 1;
	}

	my $child = Bio::Graphics::Browser2::Render->fork();
	croak "Can't fork: $!" unless defined $child;
	if ($child) {
	    warn "Launched rendering process $child for $label" if DEBUG;
	    $children{$child}++ unless $reaped{$child}; # in case child was reaped before it was sown
	    next;
	}

	(my $base = $label) =~ s/:(overview|region|details?)$//;
	warn "label=$label, base=$base, file=$feature_files->{$base}" if DEBUG;

	my $multiple_tracks = $base =~ /^(http|ftp|file|das|plugin):/ 
	    || $source->code_setting($base=>'remote feature');

        my @keystyle = ( -key_style    => 'between',
	    )
            if $multiple_tracks;

	my $key = $source->setting( $base => 'key' ) || '' ;
	my @nopad = ();
        my $panel_args = $requests->{$label}->panel_args;

	
        my $panel
            = Bio::Graphics::Panel->new( @$panel_args, @keystyle, @nopad );

        my %trackmap;

	my $timeout         = $source->global_setting('global_timeout');
	
	my $oldaction;
	my $time = time();
	eval {
	    local $SIG{ALRM}    = sub { warn "alarm clock"; die "timeout" };
	    alarm($timeout);

	    $requests->{$label}->lock();
	    my ($gd,$map,$titles);

	    if (my $hide = $source->semantic_setting($label=>'hide',$self->segment_length)) {
		$gd     = $self->render_hidden_track($hide,$args);
		$map    = [];
		$titles = [];
	    }

	    else {

		if ( exists $feature_files->{$base} ) {
		    my $file = $feature_files->{$base};

		    # Add feature files, including remote annotations
		    my $featurefile_select = $args->{featurefile_select}
		    || $self->feature_file_select($section);
			
		    if ( ref $file and $panel ) {
			$self->add_feature_file(
			    file     => $file,
			    panel    => $panel,
			    position => $feature_file_offsets{$label} || 0,
			    options  => {},
			    select   => $featurefile_select,
				);
			%trackmap = map { $_ => $file } @{ $panel->{tracks} || [] };
		    }
		}
		else {
		    my $track_args = $requests->{$label}->track_args;
		    my $track      = $panel->add_track(@$track_args);

		    warn "track_setup($label): ",time()-$time," seconds " if BENCHMARK;

		    # == populate the tracks with feature data ==
		    $self->add_features_to_track(
			-labels    => [ $label, ],
			-tracks    => { $label => $track },
			-filters   => $filters,
			-segment   => $segment,
			-fsettings => $settings->{features},
			);

		    warn "add_features($label): ",time()-$time," seconds " if BENCHMARK;

		    %trackmap = ($track=>$label);
		}

		# == generate the images and maps in background==
		$gd     = $panel->gd;
		warn "render gd($label): ",time()-$time," seconds " if BENCHMARK;

		$titles = $panel->key_boxes;
		foreach (@$titles) {splice (@$_,-1)}  # don't want to store all track config data to cache!
		$self->debugging_rectangles($gd,scalar $panel->boxes)
		    if DEBUGGING_RECTANGLES;
		warn "render titles($label): ",time()-$time," seconds " if BENCHMARK;

		my $boxes = $panel->boxes;
		warn "boxes($label): ",time()-$time," seconds " if BENCHMARK;

		$map = $self->make_map( $boxes,
					$panel, $label,
					\%trackmap, 0 );
		warn "make_map($label): ",time()-$time," seconds " if BENCHMARK;
	    }

	    $requests->{$label}->put_data($gd, $map, $titles );
	    alarm(0);
	};
	alarm(0);

	my $elapsed = time()-$time;
	warn "render($label): $elapsed seconds ", ($@ ? "(error)" : "(ok)") if BENCHMARK;
	
	if ($@) {
	    warn "RenderPanels error: $@";
	    if ($@ =~ /timeout/) {
		$requests->{$label}->flag_error('Timeout; Try turning off tracks or looking at a smaller region.');
	    } else {
		$requests->{$label}->flag_error($@);
	    }
	}
	CORE::exit 0; # in child;
    }
    warn "waiting for children" if DEBUG;
    sleep while %children;
    warn "done waiting" if DEBUG;
    my $elapsed = time() - $time;
    warn "[$$] run_local_requests (@$labels): $elapsed seconds" if DEBUG;

    # make sure requests are populated
    # the "1" argument turns off expiration checking
    $requests->{$_}->get_data(1) foreach keys %$requests;  
}

sub render_hidden_track {
    my $self    = shift;
    my ($message,$args) = @_;
    $message    = 'Track not shown at this magnification' if $message eq '1';
    my $gd     = $self->render_image_pad($args->{section});
    my $font   = GD->gdMediumBoldFont;
    my $len    = $font->width * length($message);
    my ($wid)  = $gd->getBounds;
    my $black  = $gd->colorClosest(0,0,0);
    $gd->string(GD->gdMediumBoldFont,($wid-$len)/2,0,$message,$black);
    return $gd;
}

sub select_features_menu {
    my $self     = shift;
    my $label    = shift;
    my $titleref = shift;
    my $stt      = $self->subtrack_manager($label) or return;
    my ($selected,$total) = $stt->counts;
    my $escaped_label = CGI::escape($label);
    my $subtrack_over  = "GBubble.showTooltip(event,'url:?action=show_subtracks;track=$escaped_label',false)";
    my $subtrack_click = "GBox.showTooltip(event,'url:?action=select_subtracks;track=$escaped_label',true)";

    # modify the title to show that some subtracks are hidden
    $$titleref .= " ".span({-class       =>'clickable',
			   -onMouseOver  => "GBubble.showTooltip(event,'" . $self->language->translate('CLICK_MODIFY_SUBTRACK_SEL') . "')",
			   -onClick      => $subtrack_click
			  },
			  $self->language->translate('SHOWING_SUBTRACKS',$selected,$total));						#;
    
}

sub generate_filters {
    my $self     = shift;
    my ($settings,$source,$label_list) = @_;
    my %filters;
    for my $l (@$label_list) {
	my %conf =  $source->style($l);

	if (my $filter = $conf{'-filter'}) {
	    $filters{$l} = $filter;
	}

	else {
	    $filters{$l} = $self->subtrack_select_filter($settings,$l);
	}
    }
    return \%filters;
}

sub subtrack_select_filter {
    my $self     = shift;
    my ($settings,$label) = @_;

    # new method via SubtrackTable:
    my $stt = $self->subtrack_manager($label) or return;
    return $stt->filter_feature_sub;
}

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

  my $labels          = $args{-labels}    or die "programming error";
  my $segment         = $args{-segment}   or die "programming error";
  my $tracks          = $args{-tracks}    or die "programming error";
  my $filters         = $args{-filters}   or die "programming error";
  my $fsettings       = $args{-fsettings} or die "programming error";

  warn "[$$] add_features_to_track @{$args{-labels}}" if DEBUG;

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

  my $length  = $segment->length;
  my $source  = $self->source;

  # sort tracks by the database they come from
  my (%db2label,%db2db);
  for my $label (@$labels) {
    my $db = eval { $source->open_database($label,$length)};
    unless ($db) { warn "Couldn't open database for $label: $@"; next; }
    $db2label{$db}{$label}++;
    $db2db{$db}  =  $db;  # cache database object
  }

  my (%iterators,%iterator2dbid,%is_summary);
  for my $db (keys %db2db) {
      my @labels           = keys %{$db2label{$db}};

      my (@full_types,@summary_types);
      for my $l (@labels) {
	  my @types = $source->label2type($l,$length) or next;
	  if ($source->show_summary($l,$self->vis_length,$self->settings)) {
	      $is_summary{$l}++;
	      push @summary_types,@types;
	  } else {
	      push @full_types,@types;
	  }
      }
      
      warn "[$$] RenderPanels->get_iterator(@full_types)"  if DEBUG;
      warn "[$$] RenderPanels->get_summary_iterator(@summary_types)" if DEBUG;
      if (@summary_types && 
	  (my $iterator = $self->get_summary_iterator($db2db{$db},$segment,\@summary_types))) {
	  $iterators{$iterator}     = $iterator;
	  $iterator2dbid{$iterator} = $source->db2id($db);
      }

      if (@full_types && (my $iterator = $self->get_iterator($db2db{$db},$segment,\@full_types))) {
	  $iterators{$iterator}     = $iterator;
	  $iterator2dbid{$iterator} = $source->db2id($db);
      }
  }

  my (%groups,%feature_count,%group_pattern,%group_field);

  # The effect of this loop is to fetch a feature from each iterator in turn
  # using a queueing scheme. This allows streaming iterators to parallelize a
  # bit. This may not be worth the effort.
  my (%feature2dbid,%classes,%max_features,%limit_hit,%has_subtracks);

  while (keys %iterators) {
    for my $iterator (values %iterators) {

      my $feature;

      unless ($feature = $iterator->next_seq) {
	delete $iterators{$iterator};
	next;
      }

      $source->add_dbid_to_feature($feature,$iterator2dbid{$iterator});
      my @labels = $source->feature2label($feature,$length);

      warn "[$$] $iterator->next_seq() returns $feature, will assign to @labels" if DEBUG;

      for my $l (@labels) {

          $l =~ s/:\d+//;  # get rid of semantic zooming tag

	  my $track = $tracks->{$l}  or next;
	  
	  my $stt        = $self->subtrack_manager($l);
	  my $is_summary = $is_summary{$l};

	  $filters->{$l}->($feature) or next if $filters->{$l} && !$is_summary;
	  $feature_count{$l}++;

	  # -----------------------------------------------------------------------------
	  # GROUP CODE
	  # Handle name-based groupings.
	  unless (exists $group_pattern{$l}) {
	      $group_pattern{$l} =  $source->semantic_setting($l => 'group_pattern',$length);
	      $group_pattern{$l} =~ s!^/(.+)/$!$1! 
		  if $group_pattern{$l}; # clean up regexp delimiters
	  }
	  
	  # Handle generic grouping (needed for GFF3 database)
 	  $group_field{$l} = $source->semantic_setting($l => 'group_on',$length) 
	      unless exists $group_field{$l};
	  
	  if (my $pattern = $group_pattern{$l}) {
	      my $name = $feature->name or next;
	      (my $base = $name) =~ s/$pattern//i;
	      $groups{$l}{$base}  ||= Bio::Graphics::Feature->new(-type   => 'group',
								  -name   => $feature->display_name,
								  -strand => $feature->strand,
		  );
	      $groups{$l}{$base}->add_segment($feature);
	      next;
	  }
	
	  if (my $field = $group_field{$l}) {
	      my $base = eval{$feature->$field};
	      if (defined $base) {
		  $groups{$l}{$base} ||= Bio::Graphics::Feature->new(-name   => $feature->display_name,
								     -start  => $feature->start,
								     -end    => $feature->end,
								     -strand => $feature->strand,
								     -type   => $feature->primary_tag);
		  $groups{$l}{$base}->add_SeqFeature($feature);
		  next;
	      }
	  }

	  if (!$is_summary && $stt && (defined (my $id = $stt->feature_to_id_sub->($feature)))) {
	      $groups{$l}{$id} ||= Bio::Graphics::Feature->new(-type       => 'group',
							       -primary_id => $id,
							       -name       => $stt->id2label($id),
							       -start      => $segment->start,
							       -end        => $segment->end,
							       -seq_id     => $segment->seq_id,
		  );
	      $has_subtracks{$l}++;

	      if ($source->setting($l=>'subtrack single plot')) {
	          $tracks->{$l}->configure(
	                 -scale     => 'none',
	                 -no_grid   => 1,
	          );
	      }

	      $groups{$l}{$id}->add_segment($feature);
	      next;
	  }

	  $track->add_feature($feature);
      }
    }
  }
  warn "[$$] RenderPanels finished iteration fetch" if DEBUG;

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

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

  for my $l (keys %groups) {
    my $track  = $tracks->{$l};
    my $g      = $groups{$l} or next;

    # add empty subtracks if needed
    if ($has_subtracks{$l} && !$source->semantic_setting($l => 'hide empty subtracks',$length)) {
	my $stt   = $self->subtrack_manager($l);
	my @ids   = $stt->selected_ids;
	$g->{$_} ||= Bio::Graphics::Feature->new(-type   => 'group',
						 -primary_id     => $_,
						 -name   => $stt->id2label($_),
						 -start  => $segment->start,
						 -end    => $segment->end,
						 -seq_id => $segment->seq_id) 
	    foreach @ids
    }

    if ($source->setting($l=>'subtrack single plot')) {
        my $tempFeature = Bio::Graphics::Feature->new(-type       => 'group',
                                                      -start      => $segment->start,
                                                      -end        => $segment->end,
                                                      -seq_id     => $segment->seq_id,
                      );
        my $tempSubFeature = Bio::Graphics::Feature->new(-type       => 'scale',
                                                         -scale      => 'three',
                                                         -name       => 'scales',
                                                         -start      => $segment->start,
                                                         -end        => $segment->end,
                                                         -seq_id     => $segment->seq_id,
                      );
        $tempFeature->add_segment(($tempSubFeature));
        $track->add_feature($tempFeature);
        
        foreach (values %$g) {
            my $f = $_;
            my @colours = ( qw(aqua black blue fuchsia gray green lime maroon navy olive purple red silver teal yellow) );
            my @subFeatures = $f->get_SeqFeatures;
            my $subf = $subFeatures[0];
            if ($subf) {
                my $feature_colour = $colours[rand @colours];
                $subf->{attributes}{'bgcolor'} = $feature_colour;
                $subf->{attributes}{'labelcolor'} = $feature_colour;
            }
            $track->add_feature($f);
        }
    } else {
        $track->add_feature($_) foreach values %$g;
    }

    $feature_count{$l} += keys %$g;

  }

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

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

    my $count    = $feature_count{$l};
    my $limit    = $fsettings->{$l}{limit};
    $count       = $limit if defined($limit) && $limit > 0 && $limit < $count;
    my $pack_options  = $fsettings->{$l}{options};

    my $do_bump  = $self->do_bump($l,
				  $pack_options,
				  $count,
				  $max_bump,
				  $length);

    my $do_label = $self->do_label($l,
				   $pack_options,
				   $count,
				   $max_labels,
				   $length);

    my $do_description = $self->do_description($l,
					       $pack_options,
					       $count,
					       $max_labels,
					       $length);

    $tracks->{$l}->configure(-bump        => ($has_subtracks{$l} && ($source->setting($l=>'subtrack single plot'))) ? 0 : $do_bump,
			     -label       => $do_label,
			     -description => $do_description,
			      );
    $tracks->{$l}->configure(-connector  => 'none') if !$do_bump;
    $tracks->{$l}->configure(-bump_limit    => $limit)
      if $limit && $limit > 0;

    if (eval{$tracks->{$l}->features_clipped}) { # may not be present in older Bio::Graphics
	my $max   = $tracks->{$l}->feature_limit;
	my $count = $tracks->{$l}->feature_count;
	$tracks->{$l}->panel->key_style('between');
	$tracks->{$l}->configure(-key => $self->language->translate('FEATURES_CLIPPED',$max,$count));
    }
  }

}

sub get_iterator {
  my $self = shift;
  my ($db,$segment,$feature_types,$max) = @_;

  # The Bio::DB::SeqFeature::Store database supports correct
  # semantics for directly retrieving features that overlap
  # a range. All the others require you to get a segment first
  # and then to query the segment! This is a problem, because it
  # means that the reference sequence (e.g. the chromosome) is
  # repeated in each database, even if it isn't the primary one :-(
  if ($db->can('get_seq_stream')) {
      my @args = (-type   => $feature_types,
		  -seq_id => $segment->seq_id,
		  -start  => $segment->start,
		  -end    => $segment->end,
		  -max_features => $max,  # some adaptors allow this
	  );
      return $db->get_seq_stream(@args);
  }

  my $db_segment;
  if (eval{$segment->factory||'' eq $db}) {
      $db_segment   = $segment;
  } else {
      ($db_segment) = $db->segment($segment->seq_id,$segment->start,$segment->end);
  }

  unless ($db_segment) {
    warn "Couldn't get segment $segment from database $db; id=",
       $self->source->db2id($db);
    return;
  }

  return $db_segment->get_seq_stream(-type=>$feature_types);
}

sub get_summary_iterator {
  my $self = shift;
  my ($db,$segment,$feature_types) = @_;

  my @args = (-type   => $feature_types,
	      -seq_id => $segment->seq_id,
	      -start  => $segment->start,
	      -end    => $segment->end,
	      -bins   => $self->get_detail_width_no_pad,
	      -iterator=>1,
      );
  return $db->feature_summary(@args);
}


=head2 add_feature_file

Internal use: render a feature file into a panel

=cut

sub add_feature_file {
  my $self = shift;
  my %args = @_;
  
  my $file    = $args{file}    or return;
  my $options = $args{options} or return;
  my $select  = $args{select}  or return;

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

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

  warn "error while rendering ",$args{file}->name,": $@" if $@;
}


=head2 create_panel_args()

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

Return arguments need to create a Bio::Graphics::Panel.
$section is one of 'detail','overview', or 'region'
$args is a hashref that contains the keys:

   keystyle
   title
   image_class
   postgrid
   background

=cut

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

  my $segment        = $args->{segment}        || $self->segment;
  my ($seg_start,$seg_stop,$flip) = $self->segment_coordinates($segment,
							       $args->{flip});

  my $image_class = $args->{image_class} || 'GD';
  eval "use $image_class" unless "${image_class}::Image"->can('new');

  my $settings = $self->settings;
  my $source   = $self->source;

  my $section  = $args->{section} || 'detail';

  my $postgrid = '';
  my $detail_start = $settings->{start};
  my $detail_stop  = $settings->{stop};
  my $h_region_str     = '';

  if (1 && ($section eq 'overview' or $section eq 'region')){
    $postgrid  = hilite_regions_closure(
	            [$detail_start,
		     $detail_stop,
		     $self->loaded_segment_fill(),
		     $self->loaded_segment_outline()
		    ]);
  }
  elsif ($section eq 'detail'){
    $postgrid = make_postgrid_callback($settings);
    $h_region_str = join(':', @{$settings->{h_region}||[]}); 
  }

  my $keystyle = 'none';

  my @pass_thru_args = map {/^-/ ? ($_=>$args->{$_}) : ()} keys %$args;
  my @argv = (
	      -grid         => $section eq 'detail' ? $settings->{'grid'} : 0,
              -seqid        => $segment->seq_id,
	      -start        => $seg_start,
	      -end          => $seg_stop,
	      -stop         => $seg_stop,  #backward compatibility with old bioperl
	      -key_color    => $source->global_setting('key bgcolor')      || 'moccasin',
	      -bgcolor      => $source->global_setting("$section bgcolor") || 'wheat',
              -width        => $section eq 'detail'? $self->get_detail_width_no_pad : $settings->{width},
	      -key_style    => $keystyle,
              -suppress_key => 1,
	      -empty_tracks => $source->global_setting('empty_tracks')    || DEFAULT_EMPTYTRACKS,
	      -pad_top      => $image_class->gdMediumBoldFont->height+2,
              -pad_bottom   => 3,
	      -image_class  => $image_class,
	      -postgrid     => $postgrid,
	      -background   => $args->{background} || '',
	      -truecolor    => $source->global_setting('truecolor') || 0,
	      -map_fonts_to_truetype    => $source->global_setting('truetype') || 0,
	      -extend_grid  => 1,
              -gridcolor    => $source->global_setting('grid color') || 'lightcyan',
              -gridmajorcolor    => $source->global_setting('grid major color') || 'cyan',
	      @pass_thru_args,   # position is important here to allow user to override settings
	     );

  push @argv, -flip => 1 if $flip;
  my $p  = $self->image_padding;
  my $pl = $source->global_setting('pad_left');
  my $pr = $source->global_setting('pad_right');
  $pl    = $p unless defined $pl;
  $pr    = $p unless defined $pr;

  push @argv,(-pad_left =>$pl, -pad_right=>$pr) if $p;

  return @argv;
}

sub image_padding {
  my $self   = shift;
  my $source = $self->source;
  return defined $source->global_setting('image_padding') 
      ? $source->global_setting('image_padding')
      : PAD_DETAIL_SIDES;
}

=head2 segment_coordinates()

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

Method to correct for rare case in which start and stop are flipped.

=cut

sub segment_coordinates {
  my $self    = shift;
  my $segment = shift;
  my $flip    = shift;

  return unless $segment;

  # Create the tracks that we will need
  my ($seg_start,$seg_stop ) = ($segment->start,$segment->end);
  if ($seg_stop < $seg_start) {
    ($seg_start,$seg_stop)     = ($seg_stop,$seg_start);
    $flip = 1;
  }
  return ($seg_start,$seg_stop,$flip);
}

=head2 create_track_args()

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

Return arguments need to create a Bio::Graphics::Track.
$label is a config file stanza label for the track.

=cut

sub create_track_args {
  my $self = shift;
  my ($label,$args) = @_;

  my $segment         = $self->segment;
  my $length          = $segment->length;
  my $source          = $self->source;
  my $lang            = $self->language;

  my $is_summary      = $source->show_summary($label,$self->vis_length,$self->settings);
  
  my $state            = $self->settings;

  my $semantic_override = Bio::Graphics::Browser2::Render->find_override_region(
      $state->{features}{$label}{semantic_override},
      $length/$self->details_mult);
  my $override  = $is_summary           ? $state->{features}{$label}{summary_override}
                   : $semantic_override ? $state->{features}{$label}{semantic_override}{$semantic_override}
                   : {};

  my @override        = map {'-'.$_ => $override->{$_}} keys %$override;

  push @override,(-feature_limit => $override->{limit}) if $override->{limit};
  push @override,(-record_label_positions => 0) unless $args->{section} && $args->{section} eq 'detail';

  if ($is_summary) {
      unshift @override,(
	  -glyph     => 'wiggle_density',
	  -height    => 15,
	  -min_score => 0,
	  -autoscale => 'local',
      );
      push @override, $source->i18n_style("$label:summary",$lang) if $source->Bio::Graphics::FeatureFile::setting("$label:summary");
  }
  my $hilite_callback = $args->{hilite_callback};

  my @default_args = (-glyph => 'generic');
  push @default_args,(-key   => $label)        unless $label =~ /^\w+:/;
  push @default_args,(-hilite => $hilite_callback) if $hilite_callback;

  if ($self->subtrack_manager($label)) {
      push @default_args,(-connector   => '');
      my $left_label = 
	  $source->semantic_setting($label=>'label_position',$length)||'' eq 'left';

      $left_label++ 
	  if $source->semantic_setting($label=>'label_transcripts',$length);

      my $group_label = $source->semantic_setting($label=>'glyph',$length) !~ /xyplot|wiggle|density|whisker/;

      push @default_args,(
	  -group_label          => $group_label||0,
	  -group_label_position => $left_label ? 'top' : 'left',
	  -group_subtracks      => $source->setting($label=>'subtrack single plot') ? 0 : 1,
      );
  }

  if (my $stt = $self->subtrack_manager($label)) {
      my $sub = $stt->sort_feature_sub;
      push @default_args,(-sort_order => $sub);
  }

  my @args;
  if ($source->semantic_setting($label=>'global feature',$length)) {
      eval { # honor the database indicated in the track config
	  my $db    = $self->source->open_database($label,$length);
	  my $class = eval {$segment->seq_id->class} || eval{$db->refclass};
	  ($segment)= $db->segment(-name  => $segment->seq_id,
				   -start => $segment->start,
				   -end   => $segment->end,
				   -class => $class);
      };
      warn $@ if $@;
      @args = ($segment,
	       @default_args,
	       $source->default_style,
	       $source->i18n_style($label,$lang),
	       @override,
	  );
  } else {
    @args = (@default_args,
	     $source->default_style,
	     $source->i18n_style($label,$lang,$length),
	     @override,
	    );
  }
  return @args;
}

sub vis_length {
    my $self = shift;
    my $segment = $self->segment;
    my $length  = $segment->length;
    return $length/$self->details_mult;
}

sub subtrack_manager {
    my $self = shift;
    my $label = shift;
    return $self->{_stt}{$label} if exists $self->{_stt}{$label};
    return $self->{_stt}{$label} = undef
	if $self->source->show_summary($label,$self->vis_length,$self->settings);
    return $self->{_stt}{$label} = Bio::Graphics::Browser2::Render->create_subtrack_manager($label,
											    $self->source,
											    $self->settings);
}

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

sub get_cache_base {
    my $self = shift;
    my $path = $self->source->globals->cache_dir($self->source->name);
    return $path;
}

# Returns the HTML image map from the cached image map data.
sub map_html {
  my $self = shift;
  my $map  = shift;
  my $id   = shift;

  my @data = @$map;

  my $name = shift @data or return '';
  $id    ||= "${name}_map";

  my $html  = qq(\n<map name="$id" id="$id">\n);
  for (@data) {
    my (undef,$x1,$y1,$x2,$y2,%atts) = split "\t";
    $x1 or next;
    my $coords = join(',',$x1,$y1,$x2,$y2);
    $html .= qq(<area shape="rect" coords="$coords" );
    for my $att (keys %atts) {
      $html .= qq($att="$atts{$att}" );
    }
    $html .= qq(/>\n);
  }
  $html .= qq(</map>\n);
  return $html;
}

# this returns a coderef that will indicate whether an added (external) feature is placed
# in the overview, region or detailed panel. It is necessary to avoid one section's features
# from being placed in another section's track.
sub feature_file_select {
  my $self             = shift;
  my $required_section = shift;

  my $undef_defaults_to_true;
  if ($required_section =~ /detail/) {
    $undef_defaults_to_true++;
  }

  return sub {
      my $file    = shift;
      my $type    = shift;

      my $section = $file->setting($type=>'section')
	            || $file->setting(general=>'section');
      my ($modifier) = $type =~ /:(overview|region}detail)$/;
      $section     ||= $modifier;

      return $undef_defaults_to_true
	  if !defined $section;

      return $section  =~ /$required_section/;
  };
}

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

  my $source              = $self->source;
  my $maxb              = $source->code_setting($track_name => 'bump density');
  $maxb                 = $max unless defined $maxb;

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

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

  my $source              = $self->source;

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

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

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

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

  my $source              = $self->source;

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

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

# override make_link to allow for code references
sub make_link {
  my $self     = shift;
  my ($feature,$panel,$label,$track)  = @_;
  my $label_fix = $label;

  if (ref $label && $label->{name}){ 
    $label_fix = $label->{name};
    if ($label_fix =~/^(plugin)\:/){$label_fix = join(":",($',$1));}
  }

  my $data_source = $self->source;
  my $ds_name     = $data_source->name;

  my $link     = $data_source->code_setting($label_fix,'link');

  if (! defined $link) {
  if ($feature->can('url')) {
    my $link = $feature->url;
    return $link if defined $link;
  }
  return $label->make_link($feature)
      if $label
      && $label =~ /^[a-zA-Z_]/
      && $label->isa('Bio::Graphics::FeatureFile');
  }


  $panel ||= 'Bio::Graphics::Panel';
  $label ||= $data_source->feature2label($feature);
  $label ||= 'general';

  # most specific -- a configuration line

  # less specific - a smart feature
  $link        = $feature->make_link if $feature->can('make_link') && !defined $link;

  # general defaults
  $link        = $data_source->code_setting('TRACK DEFAULTS'=>'link') unless defined $link;
  $link        = $data_source->code_setting(general=>'link')          unless defined $link;
  $link        = $data_source->globals->setting(general=>'link')      unless defined $link;

  return unless $link;

  if (ref($link) eq 'CODE') {
    my $val = eval {$link->($feature,$panel,$track)};
    $data_source->_callback_complain($label=>'link') if $@;
    return $val;
  }
  elsif (!$link || $link eq 'AUTO') {
    my $n     = $feature->display_name || '';
    my $c     = $feature->seq_id       || '';
    my $name  = CGI::escape("$n");  # workaround CGI.pm bug
    my $class = eval {CGI::escape($feature->class)}||'';
    my $ref   = CGI::escape("$c");  # workaround again
    my $start = CGI::escape($feature->start);
    my $end   = CGI::escape($feature->end);
    my $src   = CGI::escape(eval{$feature->source} || '');
    my $url   = CGI->request_uri || '../..';
    my $id    = eval {CGI::escape($feature->primary_id)};
    my $dbid  = eval {$feature->gbrowse_dbid} || ($data_source->db_settings($label))[0];
    $dbid     = CGI::escape($dbid);
    $url      =~ s/\?.+//;
    $url      =~ s! /gbrowse[^/]* / [^/]+ /? [^/]*  $!!x;
    $url      .= "/gbrowse_details/$ds_name?ref=$ref;start=$start;end=$end";
    $url      .= ";name=$name"     if defined $name;
    $url      .= ";class=$class"   if defined $class;
    $url      .= ";feature_id=$id" if defined $id;
    $url      .= ";db_id=$dbid"    if defined $dbid;
    return $url;
  }
  return $data_source->link_pattern($link,$feature,$panel);
}

# make the title for an object on a clickable imagemap
sub make_title {
  my $self = shift;
  my ($feature,$panel,$label,$track) = @_;
  local $^W = 0;  # tired of uninitialized variable warnings
  my $source = $self->source;

  my $length = eval {$self->segment->length} || 0;

  my ($title,$key) = ('','');

 TRY: {
    if ($label && eval { $label->isa('Bio::Graphics::FeatureFile') }) {
      $key = $label->name;
      $title = $label->make_title($feature) or last TRY;
      return $title;
    }

    else {
      $label     ||= $source->feature2label($feature) or last TRY;
      $key       ||= $source->setting($label,'key') || $label;
      $key         =~ s/s$//;
      $key         = "source = ".$feature->segment->dsn if $feature->isa('Bio::Das::Feature');  # for DAS sources

      my $length   = $self->segment_length($label);

      my $link     = $source->semantic_fallback_setting($label,'title',$length);
      if (defined $link && ref($link) eq 'CODE') {
	$title       = eval {$link->($feature,$panel,$track)};
	$source->_callback_complain($label=>'title') if $@;
	return $title if defined $title;
      }
      return $source->link_pattern($link,$feature) if defined $link && $link ne 'AUTO';
    }
  }

  # otherwise, try it ourselves
  $title = eval {
    if ($feature->can('target') && (my $target = $feature->target)) {
      join (' ',
	    "$key:",
	    $feature->seq_id.':'.
	    $feature->start."..".$feature->end,
	    $feature->target->seq_id.':'.
	    $feature->target->start."..".$feature->target->end);
    } else {
      my ($start,$end) = ($feature->start,$feature->end);
      ($start,$end)    = ($end,$start) if $feature->strand < 0;
      my $name         = $feature->can('info') 
	                 ? $feature->info
			 : $feature->display_name;
      my $result;
      $result .= "$key "  if defined $key;
      $result .= "$name " if defined $name;
      $result .= '['.$feature->seq_id.":" if defined $feature->seq_id;
      $result .= $feature->start      if defined $feature->start;
      $result .= '..' . $feature->end if defined $feature->end;
      $result .= ']' if defined $feature->seq_id;
      $result;
    }
  };
  warn $@ if $@;

  return $title;
}

sub segment_length {
    my $self    = shift;
    my $label   = shift;
    my $section = $label 
	           ? Bio::Graphics::Browser2::Render->get_section_from_label($label) 
		   : 'detail';
    return eval {$section eq 'detail'   ? $self->segment->length
	        :$section eq 'region'   ? $self->region_segment->length
		:$section eq 'overview' ? $self->whole_segment->length
		: 0} || 0;
}

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

  if ($feature->isa('Bio::Das::Feature')) { # new window
    my $dsn = $feature->segment->dsn;
    $dsn =~ s/^.+\///;
    return $dsn;
  }

  $label    ||= $source->feature2label($feature) or return;
  my $link_target = $source->code_setting($label,'link_target')
    || $source->code_setting('TRACK DEFAULTS' => 'link_target')
    || $source->globals->code_setting(general => 'link_target')
    || '_blank';
  $link_target = eval {$link_target->($feature,$panel,$track)} if ref($link_target) eq 'CODE';
  $source->_callback_complain($label=>'link_target') if $@;
  return $link_target;
}

sub balloon_tip_setting {
  my $self = shift;
  my ($option,$label,$feature,$panel,$track) = @_;
  my $length = $self->segment_length($label);
  $option ||= 'balloon tip';
  my $source = $self->source;
  my $value  = $source->semantic_setting($label=>$option,$length||0);
  $value     = $source->code_setting('TRACK DEFAULTS' => $option) unless defined $value;
  $value     = $source->code_setting('general' => $option)        unless defined $value;

  return unless $value;
  my $val;
  my $balloon_type = $source->global_setting('balloon style') || 'GBubble';

  if (ref($value) eq 'CODE') {
    $val = eval {$value->($feature,$panel,$track)};
    $source->_callback_complain($label=>$option) if $@;
  } else {
    $val = $source->link_pattern($value,$feature,$panel);
  }

  if ($val=~ /^\s*\[([\w\s]+)\]\s+(.+)/s) {
    $balloon_type = $1;
    $val          = $2;
  }
  # escape quotes
  $val =~ s/'/\\'/g;
  $val =~ s/"/&quot;/g;

  return ($balloon_type,$val);
}

# this generates the callback for highlighting a region
sub make_postgrid_callback {
    my $settings = shift;
    return unless ref $settings->{h_region};

    my @h_regions = map {
        my ( $h_ref, $h_start, $h_end, $h_color )
            = /^(.+):(\d+)\.\.(\d+)(?:@(\S+))?/;
        defined($h_ref)
            && $h_ref eq $settings->{ref}
            ? [ $h_start, $h_end, $h_color || 'lightgrey' ]
            : ()
    } @{ $settings->{h_region} };

    return unless @h_regions;
    return hilite_regions_closure(@h_regions);
}

# this subroutine generates a Bio::Graphics::Panel callback closure 
# suitable for hilighting a region of a panel.
# The args are a list of [start,end,bgcolor,fgcolor]
sub hilite_regions_closure {
    my @h_regions = @_;

    return sub {
        my $gd     = shift;
        my $panel  = shift;
        my $left   = $panel->pad_left;
        my $top    = $panel->top;
        my $bottom = $panel->bottom+$panel->pad_bottom;
        for my $r (@h_regions) {
            my ( $h_start, $h_end, $bgcolor, $fgcolor ) = @$r;
            my ( $start, $end ) = $panel->location2pixel( $h_start, $h_end );
            if ( $end - $start <= 1 ) {
                $end++;
                $start--;
            }    # so that we always see something
                 # assuming top is 0 so as to ignore top padding
            $gd->filledRectangle(
                $left + $start,
                0, $left + $end,
                $bottom, $panel->translate_color($bgcolor)
            ) if $bgcolor && $bgcolor ne 'none';

            # outline can only be the left and right sides
            # -- otherwise it looks funny.
            if ( $fgcolor && $fgcolor ne 'none' ) {
                my $c = $panel->translate_color($fgcolor);
                $gd->setStyle($c,$c,gdTransparent,gdTransparent);#,gdTransparent,gdTransparent,gdTransparent);
                $gd->line( $left + $start, 0, $left + $start, $bottom, gdStyled );
                $gd->line( $left + $end,   0, $left + $end,   $bottom, gdStyled );
            }
        }

    };
}

sub loaded_segment_fill {
    my $self = shift;
    return $self->source->global_setting('loaded segment fill') || 'none';
}

sub loaded_segment_outline {
    my $self = shift;
    return $self->source->global_setting('loaded segment outline') || 'gray';
}

sub details_mult { 
    my $self = shift;
    my $render = $self->render;
    return $render->details_mult if $render;

    # workaround for Slave processes, which have no render object
    return $self->source->details_multiplier($self->settings);
}

sub get_detail_width_no_pad {
    my $self = shift;
    my $settings = $self->settings;
    return int($settings->{width} * $self->details_mult);
}

1;

