#!/usr/local/bin/perl

package blastview;

use strict;
## Standard modules....
use HTML::Template;
use CGI qw(standard escape escapeHTML unescape header);
use Storable qw( nfreeze freeze thaw );
use Data::Dumper;     # Used forbug
use File::Temp qw( tempfile );
use Carp;
use Mail::Mailer;
use POSIX;
use GD;
use Digest::MD5;

## Ensembl modules.....
use Bio::EnsEMBL::VDrawableContainer;
use Bio::EnsEMBL::DrawableContainer;
#use EnsEMBL::Web::UserConfigAdaptor;
use EnsEMBL::Web::Container::HSPContainer;

use EnsEMBL::Web::RegObj;
use EnsEMBL::Web::SpeciesDefs;
use EnsEMBL::Web::DBSQL::DBConnection;
use Bio::Tools::Run::EnsemblSearchMulti;
use EnsEMBL::Web::BlastView::Meta;
use EnsEMBL::Web::BlastView::MetaDataBlast;

use EnsEMBL::Web::BlastView::Panel;
use EnsEMBL::Web::BlastView::PanelMain;
use EnsEMBL::Web::BlastView::PanelTop;
use EnsEMBL::Web::BlastView::PanelStatus;

use EnsEMBL::Web::Controller::Blast;
use EnsEMBL::Web::Document::Panel;
use EnsEMBL::Web::Document::Image;
use EnsEMBL::Web::TmpFile::Image;

use vars qw( $SPECIES_DEFS $META_DATA $CGI $BLAST $PAGE $TICKET $DBCONNECTION );
use vars qw( @JSCRIPT_EXTRA @ON_LOAD_EXTRA %CACHE_ON_LOAD_EXTRA); # Jscript 
use vars qw( %ERRORS ); # Errors per-stage

BEGIN {
  $META_DATA = EnsEMBL::Web::BlastView::MetaDataBlast->config || die( "Can't configure MetaData" );
  $SPECIES_DEFS = $EnsEMBL::Web::RegObj::ENSEMBL_WEB_REGISTRY->species_defs;
  $DBCONNECTION = EnsEMBL::Web::DBSQL::DBConnection->new( undef, $SPECIES_DEFS );
}

# Path to HTML templates (used by HTML::Template)
$ENV{HTML_TEMPLATE_ROOT} = $SPECIES_DEFS->ENSEMBL_SERVERROOT.'/modules/EnsEMBL/Web/BlastView';

# Package globals

#get site type for vega
my $sitetype= $SPECIES_DEFS->get_config( $SPECIES_DEFS->name(), 'ENSEMBL_SITETYPE' );

# If the sitetype is Archive, die nicely
# if ($sitetype eq 'Archive EnsEMBL') {
#   my $output = EnsEMBL::Web::Output::HTML->new();
#   $output->start;
#   $output->printHTML(qq(<h2>This page is not currently archived.</h2>));
#   $output->end;
#   exit;
# }         

our $VERBOSE = 0; # Debug setting
our $VIEW_SCRIPT = $ENV{ENSEMBL_SCRIPT};

MAIN:{
  if( is_script_suspended()){ # Check for manual suspend. See sub for details
    get_suspend_page(); return 1;
  }

  # Populate package globals for each request.
  @JSCRIPT_EXTRA = ();
  @ON_LOAD_EXTRA = ();
  %ERRORS        = ();

  # Create a new CGI object
  # TODO: Use EnsEMBL::Web::Input for CGI handling
  $CGI = CGI->new();
  
  unless( $CGI->param ) {
    my $tsp = $ENV{'ENSEMBL_SPECIES'} eq 'Multi' ? $SPECIES_DEFS->ENSEMBL_PRIMARY_SPECIES : $ENV{'ENSEMBL_SPECIES'};
    $CGI->param( 'species', $tsp );
  }

  # Create a new Controller object
  my $controller = new EnsEMBL::Web::Controller::Blast;
  my $page       = $controller->page;
  
  # Get BlastAdaptor object
  my $blast_adpt = fetch_blast_adaptor($controller);
  
  return 1 unless $blast_adpt;
  
  # Process name/value pairs from image submits
  process_image_submits();

  # Get the ticket from explicit ticket param, or the REQUEST_URI
  $TICKET = &fetch_explicit_ticket || '';

  # Check for new session, or explicit retrieve of session:
  if( $CGI->param('_new') || $CGI->param('_retrieve') || $CGI->param('_ticket') ){
#    warn( "CGI_PURGE" );
#    warn "...NEW" if $CGI->param('_new');
#    warn "...RET" if $CGI->param('_retrieve');
#    warn "...TIC" if $CGI->param('_ticket');

    eval{ retrieve_state() };
    if( $CGI->param('_new') ){ $TICKET = '' }
    # Reset UI by deleting all params from $CGI, except those listed below
    eval{ retrieve_state() };
    my @view_types = (); #qw( query subject genome contig stats );
    my @view_cols  = (); #qw( name start end orientation score evalue identity length );
    my @view_params;
    foreach my $ty( @view_types ){ 
      foreach my $co( @view_cols ){
        push @view_params, "view_${ty}_${co}";
      }
    }
    my %keep_params = map{ $_=>1 } ( qw( query species database database_dna database_peptide method sensitivity ), @view_params );
    if( $CGI->param('sensitivity') eq 'CUSTOM' ){ $CGI->Delete('sensitivity') }
    #warn join( ", ", keys %keep_params );
    foreach my $p( $CGI->param() ){
      if( $keep_params{$p} ){ $CGI->param( '_changed_$p', 1 ) and next }
      $CGI->Delete(-name=>$p);
    }
  }
  # Recover existing blast session
  if( $TICKET ){ $BLAST = &retrieve_blast( $blast_adpt ); }

  if( $BLAST ){
    # Retrieve CGI state
    eval{ retrieve_state() };
    if( $@ =~ /contained no data/ ){
      add_warning( 'setup','query',"Ticket $TICKET not found" ); 
      warn( "Ticket $TICKET not found: state" );
      $BLAST = '';
    }
    elsif( $@ ){ die $@ }
  }

  $BLAST = &create_blast( $blast_adpt ) unless $BLAST;
  $BLAST->verbose( $VERBOSE );
  
  $CGI->param( 'ticket', $TICKET );
  $blast_adpt->ticket( $TICKET );
  use Apache2::RequestUtil;
  my $r = Apache2::RequestUtil->request();
  $ENV{'ticket'} = $TICKET;
  $r->subprocess_env->{'ticket'} = $TICKET;
  if( $CGI->param('format') eq 'raw' ){
    &print_raw_format();
    return 1;
  }

  # More cgi param processing - after retrieving state
  process_stage();
  process_stage_extra();
  process_defaults();
  validate_params();

  # Print page
  if( @JSCRIPT_EXTRA ){
    map{ $page->javascript->add_script($_) } @JSCRIPT_EXTRA;
  }

  # Add javascript files to page header
  # Add javascript onload methods to body tag
  my ( $stage ) = grep{ $_->get_name eq $CGI->param('stage') } $META_DATA->get_stages;
  foreach( $stage->get_javascript_files ) {
    $page->javascript->add_source( $_ );
  }
  foreach( $stage->get_javascript_onload ) {
    $page->add_body_attr( 'onload', $_ );
  }
  $page->add_body_attr( 'onload', "LOADED = 1;"  );
  $page->stylesheet->add_sheet( 'all', '/blast/blastview.css' );
  $page->javascript->add_script( 'var LOADED = 0;' );
  #$page->javascript->add_source( '/js/zmenu_42.js' );


  $| = 1;

  if( my $disp_type = $CGI->param('_display') ){

    my @errs = ();
    my( $run, $hit, $hsp, $res );

    my $content = '';
    if( my $run_id = $CGI->param('run_id') ){
      my $run_token = $BLAST->workdir."/".$run_id;
      ( $run ) = $BLAST->runnables_like( -token=>$run_token );
      $run or push( @errs, "Result $run_id not found for ticket $TICKET" );
    }

    if( my $hsp_id = $CGI->param('hsp_id') ){
      my $sp = $ENV{'ENSEMBL_SPECIES'} eq 'Multi' ? $SPECIES_DEFS->ENSEMBL_PRIMARY_SPECIES : $ENV{'ENSEMBL_SPECIES'};
#      my $blast_adpt = $DBCONNECTION->get_databases_species($sp, 'blast')->{'blast'};
      my @args = ( $hsp_id, $blast_adpt );
      eval{ $hsp = Bio::Search::HSP::EnsemblHSP->retrieve( @args ) };
      $@ and warn( $@ );
      $hsp or push( @errs, "HSP $hsp_id not found for ticket $TICKET" );
    }
    
    if( my $hit_id = $CGI->param('hit_id') ){
      my $sp = $ENV{'ENSEMBL_SPECIES'} eq 'Multi' ? $SPECIES_DEFS->ENSEMBL_PRIMARY_SPECIES : $ENV{'ENSEMBL_SPECIES'};
#      my $blast_adpt = $DBCONNECTION->get_databases_species($sp, 'blast')->{'blast'};
      my @args = ( $hit_id, $blast_adpt );
      eval{ $hit = Bio::Search::Hit::EnsemblHit->retrieve( @args ) };
      $@ and warn( $@ );
      $hit or push( @errs, "Hit $hit_id not found for ticket $TICKET" );
    }

    if( $hsp && ! @errs ){
      $content = hsp_info_string( $run, $res, $hit, $hsp );
      $content .= "<P>";
      if( uc( $disp_type ) eq 'ALIGN' ){
        $content .= "<PRE><SMALL>". alignment_string( $hsp )."</PRE></SMALL>";
      } elsif( uc( $disp_type ) eq 'SEQUENCE' ){
        $content .= query_markup_string( $run, $hit, $hsp );
      } elsif( uc( $disp_type ) eq 'GSEQUENCE' ){
        $content .= genome_markup_string( $run, $hit, $hsp );
      }
      else{ push( @errs, "_display parameter $disp_type is invalid" ) }
    }
    
    if( @errs ){ $content .= join '', map { "<h3>$_</h3>" } @errs }
    &save_state;
    $page->content->add_panel( EnsEMBL::Web::Document::Panel->new( 'raw' => $content ) );
    $controller->render_page;

    $blast_adpt->dbc->disconnect_if_idle;
    return 1;
  }

  #----------------------------------------------------------------------
  # Whether to save the blast object
  # Whether to dispatch the blast object
  my $stage = lc( $CGI->param('stage') );

  if( $stage eq 'setup' or $stage eq 'configure' ){
    if( $BLAST->modified ){
      warn( "STORING BLAST: $TICKET [PID=$$ TIME=".(time()-1060600000)."]" );
      $BLAST->store;
    }
  }

  if( $stage eq 'results' or $stage eq 'display' ){

    # Initialise
    eval{ $blastview::BLAST->_initialise_runnables };
    if( $@ ){
      warn( $@ );
      add_warning( 'setup', 'method', 'Internal server error' );
      map{ $BLAST->remove_method($_->id) } $BLAST->methods;
      map{ $BLAST->remove_database( $_ ) } $BLAST->databases;
      map{ $BLAST->remove_seq( $_->id ) }  $BLAST->seqs;
    }
    my @run_list;
    foreach my $runnable( $BLAST->runnables ){
      if( $runnable->status eq 'PENDING' ){
        push @run_list, $runnable;
        $runnable->status( 'DISPATCHED' );
        # Can't run here - have to store first!
      }
    }
    # Store
warn $BLAST->token;
    if( $BLAST->modified || @run_list ){
      warn( "STORING BLAST: $TICKET [PID=$$ TIME=".(time()-1060600000)."]" );
      $BLAST->store;
    }
    # Run
    foreach my $runnable( @run_list ){
warn $runnable->token;
warn "\nRUNNING  $runnable";
      eval{ $runnable->run };
warn "\nRUN      $runnable $@";
      if( $@ ){ 
        add_warning( $CGI->param('stage'), 'method', "System failure" );
        warn( $@ );
      }
warn "HERE.... ",$runnable->status;
warn ref($runnable);
      $runnable->status eq 'COMPLETED' and $runnable->store;
warn "STORED....";
    }

    # See whether we skip RESULTS stage - only when the 'RUN' button pressed
    if( uc( $CGI->param("_stage_extra") ) eq 'RUN' ){
      my @runnables = ( grep{ $_->status eq 'COMPLETED' } 
                        $blastview::BLAST->runnables );
      if( scalar( @runnables == 1 ) ){
        my $result = $runnables[0]->result;
        if( $result->num_hits > 0 ){
          my $token = $runnables[0]->token;
          if( $token =~ /\/(\w+)$/ ){
            my @inits = ( $CGI->param('stage_initialised'), 'results');
            $CGI->param('stage','display');
            $CGI->param(-name=>'stage_initialised', -value=>\@inits);
            $CGI->param('run_id', $1 );
          }
        }
      }
    }
    # See whether the DISPLAY button was pressed for a previous result set
    if( @run_list and $stage eq 'display' ){
      $CGI->Delete('run_id');
      $CGI->Delete('hit_id');
      $CGI->Delete('hsp_id');
      &uninitialise_stage('display');
      &process_stage('results');
    }
  }

  #----------------------------------------------------------------------

  my $status_box  = get_status_panel(); # Run first: errors affect top panel

  my $current_state = save_state();

  my $top_panel   = get_top_panel();
  my $page_tmpl   = get_page_tmpl($controller->hub);

  get_onload();

  my $content = update_selection(
    $page_tmpl, 
    $top_panel, 
    $status_box, 
    $current_state
  );

  # Need to undef constants to ensure correct clean-up
  $CGI       = undef();
  $BLAST     = undef();
  $page->content->add_panel( EnsEMBL::Web::Document::Panel->new( 'raw' => $content ) );
  $controller->render_page;
} # MAIN



#----------------------------------------------------------------------
# Check whether page has been manually suspended
sub is_script_suspended{
  my $script = $ENV{ENSEMBL_SCRIPT};
  my $suspend_file = ( $SPECIES_DEFS->ENSEMBL_SERVERROOT.
                       '/perl/multi/'.
                       $script.'.suspend' );
  return -e $suspend_file;
}

#----------------------------------------------------------------------
# 

sub get_suspend_page {
  my $message    = shift;
  my $controller = new EnsEMBL::Web::Controller::Blast;

  $controller->page->content->add_panel(
    new EnsEMBL::Web::Document::Panel(
      caption => 'Blast is unavailable',
      content => "<p>Sorry, BlastView is unavailable at the moment due to essential maintenance work.</p><p>$message</p><p>Normal service will be resumed shortly</p>"
    )
  );
  
  $controller->render_page;
}

#----------------------------------------------------------------------
# Creates new BlastAdaptor object with web-specific error-handling
# TODO: Use methods in EnsEMBL::Web...
sub fetch_blast_adaptor {
  my $controller = shift;
  my $species    = $ENV{'ENSEMBL_SPECIES'} eq 'Multi' ? $SPECIES_DEFS->ENSEMBL_PRIMARY_SPECIES : $ENV{'ENSEMBL_SPECIES'};
  my $blast_adaptor;
  
  eval {
    $blast_adaptor = $DBCONNECTION->get_databases_species($species, 'blast')->{'blast'};
  };

  return $blast_adaptor if $blast_adaptor;

  # Still here? Something gone wrong!
  warn "Can not connect to blast database: $@";
  
  $controller->page->content->add_panel(
    new EnsEMBL::Web::Document::Panel(
      caption => 'Blast adaptor error',
      content => qq{
      <p>Unable to connect to the blast adaptor: error message is:</p>
      <pre>$@</pre>
    })
  );
  
  $controller->render_page;
}

#----------------------------------------------------------------------
# Fetches any ticket explicitly passed in:
# '_ticket' precides over 'ticket' which precides over URL ticket

sub fetch_explicit_ticket{
  if( $CGI->param('_retrieve') || $CGI->param('_ticket') ){    
    my $t = $CGI->param('_ticket') || $CGI->param('ticket');
    $t =~ s/\s//g;
    return $t
  }
  elsif( my $ticket = $CGI->param('ticket') ){ return $ticket }
  elsif( $ENV{REQUEST_URI} =~ /$VIEW_SCRIPT\/(\w+)/ ){ return $1 }
  return;
}

#----------------------------------------------------------------------
# Creates SearchMulti object
sub create_blast{
  my $adaptor = shift;
  my $search_multi = Bio::Tools::Run::EnsemblSearchMulti->new();
  $adaptor && $search_multi->adaptor( $adaptor );
  $search_multi->verbose( $VERBOSE ); # Set to 1 for debug
  foreach my $env( qw( HTTP_X_FORWARDED_FOR REMOTE_ADDR ) ){
    # Log environment variables for tracing users
    if( $ENV{$env} ){ $search_multi->{"_$env"} = $ENV{$env} }
  }

  # Get the blast ticket
  my $token = $search_multi->token || 
    die( $search_multi->throw("New SearchMulti obj has no token!") );
  my @bits = split( '/', $token );
  $TICKET = pop @bits; 
  $VERBOSE && warn( "CREATING BLAST: $TICKET [PID=$$ TIME=".
                    (time()-1060600000)."]" );

  return $search_multi;
}

#----------------------------------------------------------------------
# Fetches the SearchMulti object. Added error handling.
sub retrieve_blast{
  $TICKET || return;
  my $blast_adaptor = shift || '';
  my $search_multi;
  $VERBOSE && warn( "RETRIEVING BLAST: $TICKET [PID=$$ TIME=".
                    (time()-1060600000)."]" );
  eval{
    $search_multi = Bio::Tools::Run::EnsemblSearchMulti->retrieve
      ( $TICKET, $blast_adaptor ? $blast_adaptor : () );
  };
  if( $search_multi ){
    # Check blast integrity
    eval{ $search_multi->runnables };
    $@ || return $search_multi; # Object OK
  }
  my $err = "Can not retrieve BlastView ticket $TICKET";
  my $msg = "$err: ". ( $@ || 'Unknown' );
  warn( $msg );
  log_blast_error( $TICKET, $msg );
  add_warning( 'setup','query', $err );
  return;
}

#----------------------------------------------------------------------
# CGI Parameter pre-processing routine. 
#   The image submit convention is: name_value.x = name -> value
sub process_image_submits{

  foreach( $CGI->param() ){
    if( $_ =~ /(\w+?)_([^.]+)\.x/o ){
      $CGI->param( -name=>$1, -value=>$2 );
      $CGI->Delete($_);
    }
    elsif( $_ =~ /\w+_\w+\.y/o ){ $CGI->Delete($_) }
  }
}

#----------------------------------------------------------------------
# Processes the stage: sets 'stage', 'stage_next' and 'stage_back' 
# Arg 1 - (optional) stage to set to.
#         Defaults to CGI stage, or default stage
sub process_stage{

  my $stage = ( shift || 
                $CGI->param('stage') || 
                $META_DATA->get_default_stage->get_name );

  # Stage can contain other data seperated by an '_'
  my $data;
  ($stage, $data) = split( '_', $stage, 2 );

  $CGI->param( -name =>'stage', -value=>$stage );
  if( $data ){ $CGI->param('_stage_extra', $data) }  

#  # initialise stage
#  my %seen;
#  my @init = grep{ $_ && ! $seen{$_} ++ } ( $CGI->param('stage_initialised'),
#                                            $CGI->param('_stage_parent') );
#  $CGI->param( -name=>"stage_initialised", -value=>\@init );

  # Assuming normal click-through, what stages have we seen?
  my @stages = $META_DATA->get_stages;
  my %seen;
  my %skipped;
  map{ $_ && ! $seen{$_} ++ } ( $CGI->param('stage_initialised'),
                                $CGI->param('_stage_parent') );
  foreach my $stg ( map{ $_->get_name } @stages ){
    if( $stg eq $stage ){ last }
    $seen{$stg} || $skipped{$stg} ++;
  }
  $CGI->param( -name=>"stage_initialised", -value=>[ keys %seen,
                                                     keys %skipped ] );
  $CGI->param( -name=>"_stage_skipped",    -value=>[ keys %skipped ] );

  # 'back' and 'next' stages
  my %stage_order;
  my $i = 0;
  map{ $stage_order{$_->get_name} = $i++ } @stages;
  my $this_stage_idx = $stage_order{$CGI->param( 'stage' )};
  my $back_stage = $this_stage_idx > 0        ? 
                   $stages[$this_stage_idx-1]->get_name : '';
  my $next_stage = $this_stage_idx < $#stages ? 
                   $stages[$this_stage_idx+1]->get_name :'';
  $CGI->param( -name=>'_stage_back', -value=>$back_stage );
  $CGI->param( -name=>'_stage_next', -value=>$next_stage );

  return 1;
}

#----------------------------------------------------------------------
sub process_stage_extra{
  $CGI->param('stage') eq 'display' || return;
  my $stage_extra = $CGI->param('_stage_extra') || return;

  my( $run, $hit, $hsp ) = split( '\+', $stage_extra, 3 );
  $CGI->param('run_id', $run );
  $CGI->param('hit_id', $hit );
  $CGI->param('hsp_id', $hsp );
  return;
}
#----------------------------------------------------------------------
#
sub process_defaults{

  foreach(  $CGI->param() ){
    $_ !~ /^default_/ && next;
    $CGI->param( "_$_", 1 );
    $CGI->delete( $_ );
  }
  
  # Generate list of stages to process - skipped stages and current stage
  # if not initialised;
  my $this_stage = $CGI->param('stage');
  my %todo_list = map{ $_, 1 } $CGI->param( '_stage_skipped' );
  $todo_list{$this_stage} ++ ;#if ! is_stage_initialised($this_stage);

  foreach my $stage_obj( $META_DATA->get_stages ){
    next if ! $todo_list{ $stage_obj->get_name };

    foreach my $block_obj( $stage_obj->get_blocks ){

      foreach my $form_obj( $block_obj->get_forms ){

        my %defaults = $form_obj->get_defaults();
        foreach my $param( keys %defaults ){
          # Don't use default if parameter is defined
          next if defined( $CGI->param( $param ) );
          $CGI->param( -name=>$param,  -value=>$defaults{$param} );
          $CGI->param( -name=>"_default_$param", -value=>1 );
        }
      }
    }
  }
}

#----------------------------------------------------------------------
# Generates a hidden input form for the serialised state.
#
sub save_state{
  my $state_id = $TICKET || die( "Not found: blast state ID" );
  my $tmp_file = $SPECIES_DEFS->ENSEMBL_TMP_DIR_BLAST ."/$state_id.state";
  open( TMP_STATE, ">$tmp_file" );
  print TMP_STATE serialise_state();
  close( TMP_STATE );
  return $state_id;
}

#----------------------------------------------------------------------
# Serialiser function
#  Saves the state of the current CGI object as a hash of name=>value_arrayref
#  pairs. Returns a stringified, URL-escaped representation of the hash to be 
#  used in an HTML form element.
#
sub serialise_state{
  my %args = @_;

  my $stage = $CGI->param('stage');
  $CGI->param( -name=>'stage_prev', -value=>$stage );
  my $hashref = {};

  # Loop for each parameter of the current CGI object
  foreach( $CGI->param() ){

    # Ignore params starting with '_'
    next if( $_ =~ /^_/ );

    # Force the param value into array context
    my @value = $CGI->param($_);

    # Update the datastructure with the value_arrayref
    $hashref->{ $_ } = \@value;
  }
  # Stringify the data structure
  my $string = nfreeze($hashref);
  # URL-escape the string
  return CGI->escape( $string );
}

#----------------------------------------------------------------------
# De-serialiser function. 
#  Recovers the state of the cgi object from the previous page (as stored
#  in the state file). Copies all params that do
#  not have a new value to the cgi object for this page.
sub retrieve_state{
  my $file     = $TICKET.".state";
  my $tmp_file = $SPECIES_DEFS->ENSEMBL_TMP_DIR_BLAST ."/$file";
  # Create new tmp file
  if( ! -f $tmp_file ){
    my $tmp_file2 = $SPECIES_DEFS->ENSEMBL_TMP_DIR_BLAST_OLD."/$file";
    warn "TRYING $tmp_file2";
    if( -f $tmp_file2 ) {
      $tmp_file = $tmp_file2;
      warn "USING IT!";
    } else { 
      my $fh = IO::File->new( ">$tmp_file" ) || die( "Could not create $tmp_file: $!" );
      close $fh;
    }
  }

  open( TMP_STATE, $tmp_file ) or die( "Could not open $tmp_file: $!" );
  my $state = <TMP_STATE>;
  close( TMP_STATE );

  if( ! length( $state ) ){ die( "State file $tmp_file contained no data" ) }

  $state = unescape( $state );

  # 'Thaw' the re-constructed string
  my $hashref = thaw( $state );

  # Update parent stage
  my $stage_parent = $hashref->{'stage'}->[0];
  $CGI->param( -name=>'_stage_parent', -value=>$stage_parent );
  #if( $args{-parent} eq 'none' ){ $stage_parent = undef() }

  # compile list of param names, either stored or in $CGI. 
  # Ignore names starting with '_'
  my %seen;
  my @names = grep{ 
    $_ !~ /^_/ && ! $seen{$_} ++ 
  } ( keys( %$hashref ), $CGI->param() );

  # Loop for each name
  foreach my $name( @names ){

    # Get the checkbox-off parameters. These start with '_DEF_'
    if( ! defined $CGI->param($name) ){
      my $pseudo = "_DEF_$name";
      if( defined $CGI->param( $pseudo ) ){
        $CGI->param(-name=>$name, -value=>[ $CGI->param( $pseudo ) ] );
      }
    }

    # Escape HTML: security implications!
    my @these = map{ escapeHTML($_) } $CGI->param($name);
    my @those = map{ escapeHTML($_) } @{$hashref->{$name}};
    my $this = join( '|', sort map{ $_ || '' } @these );
    my $that = join( '|', sort map{ $_ || '' } @those );

    # Determine whether the CGI object contains a new value
    if( defined( $CGI->param($name) ) && ( $this ne $that ) ){
      #warn( "CH_CGI: $name : TO $this : FROM $that" );
      set_changed($name)
    }

    # Determine whether a form has been deactivated
    #elsif( ! $CGI->param("_RETRIEVE" ) and 
        #   $stage_parent and 
        #   form_belongs_to_stage( -stage=>$stage_parent, -form=>$name ) and
        #   ( $this ne $that ) ){
      #warn( "CH_OTH: $name : TO $this : FROM $that\n" );
      #set_changed($name);
    #}

    # No new values - use old
    else{ 
      #warn( "RECOVER: $name : @those\n" );
      @these = @those 
    };

    # Update the CGI object with the 'stored' parameter
    $CGI->param( -name=>$name, -value=>\@these );

  }
  return 1;
}

#----------------------------------------------------------------------
# Looks through all params and validates them as required
sub validate_params{

  # Loop through each stage in order
  foreach my $stage_obj( $META_DATA->get_stages ){
    # Don't validate if stage not initialised
    if( ! is_stage_initialised( $stage_obj->get_name ) ){ next }
    # Loop through each block/form for this stage
    foreach my $block_obj( $stage_obj->get_blocks ){
      $block_obj->is_available || next;
      foreach my $form_obj( $block_obj->get_forms ){
        $form_obj->is_available || next;
        # Perform cgi_processing tests; available for both forms and 
        # form entries
        foreach my $obj( $form_obj, $form_obj->get_form_entries ){
          if( $obj->is_available ){
            if( my $err  = $obj->run_cgi_processing() ){
              add_warning( $stage_obj->get_name,
                           $form_obj->get_name,
                           $err );
            }
          }
        }

        # Perform validity test, but only when form is enabled
        if( scalar( $CGI->param( $form_obj->get_name ) ) ){
          foreach my $obj( $form_obj, $form_obj->get_form_entries ){
            if( my $err_str = $obj->detect_error() ){
              add_warning( $stage_obj->get_name,
                           $form_obj->get_name, 
                           $err_str );            
            }
          }
        }
      }
    }
  }
}

#----------------------------------------------------------------------
# Adds a warning flag associated with a form name to the CGI object.
# Requires the stage, form name, and the warning text.
sub add_warning{
  my $stage     = shift || die( "Warning needs a stage" );
  my $form_name = shift || die( "Warning needs a form"  );
  my $err_str   = shift;
  if( ! $err_str ){
    warn( "Warning needs some text" );
    $err_str = 'UNKNOWN ERROR';
  }

  $ERRORS{$stage} = 1;

  my $param_name = '_'.$form_name.'!!warning';
  my @warns = ( $CGI->param( $param_name ), $err_str );
  $CGI->param( -name => $param_name,
               -value=> \@warns );
  $CGI->param('stage',$stage);
}

#----------------------------------------------------------------------
# Flags a CGI param as changed on last submit
#
sub set_changed{
  my $param = shift || return;
#  warn( "CHANGED: $param" );
  my $prefix = '_changed_';
  $CGI->param( -name=>"$prefix$param", -value => 1 );
  return 1;
}

#----------------------------------------------------------------------
#
=head2 form_belongs_to_stage

  Arg [1]   : hash
  Function  : Determined whether form was displayed in stage provided
  Returntype: boolean
  Exceptions: 
  Caller    : 
  Example   : if( form_belongs_to_stage(-form=>'my_form', -stage=>'my_stage')

=cut

sub form_belongs_to_stage{
  my %args = @_;
  if( ! $args{-stage} ){ die( "Need a stage name" ) };
  if( ! $args{-form}  ){ die( "Need a form name"  ) };

#  return 1 if $args{-form} eq 'stage';
#  return 0 if $args{-stage} eq 'output';

  # TODO: imporve efficiency of META 
  if( 
     grep{ $_->get_name eq $args{-form} }
     map { $_->get_forms  }
     map { $_->get_blocks }
     grep{ $_->get_name eq $args{-stage} }
     $META_DATA->get_stages
    ){ return 1 }
  if( 
     grep{ $_->get_cgi_name eq $args{-form} }
     map { $_->get_form_entries }
     map { $_->get_forms  }
     map { $_->get_blocks }
     grep{ $_->get_name eq $args{-stage} }
     $META_DATA->get_stages
    ){ return 1 }

  return 0;
}

#----------------------------------------------------------------------
#
sub get_status_panel{

  my $already_reset = 0; # Have we reset the stage at any point?
  my $error_found = 0;   # Have we found an error at any stage?
  my $change_count = 0;  # Have we changed the status count at any point?
  my $panel = EnsEMBL::Web::BlastView::PanelStatus->new( $CGI );

  $panel->add_panel_button({ LABEL => 'Summary',
                             NAME  => 'stage',
                             VALUE => $CGI->param( 'stage' ),
                             SRC   => gen_button_src('refresh', 'on') },

                            { HREF => '/Help/View?id=196', 
                              CLASS => 'modal_link',
                              SRC   => gen_button_src('help', 'on') }
                          );

##                           { HREF  => qq(javascript:void(window.open(\'http://mar2008.archive.ensembl.org/Homo_sapiens/helpview?se=1&kw=$VIEW_SCRIPT\',\'$VIEW_SCRIPT\',\'width=750,height=550,resizable,scrollbars\'));),
  ##                           SRC   => gen_button_src('help', 'on') }
    ##                      );

  $panel->add_panel_header({ LABEL => 'Summary' });


  # Loop da loops (each stage -> each form -> each from entry)
  foreach my $stage_obj( $META_DATA->get_stages ){

    my $stage = $stage_obj->get_name;
    #if( $stage ne 'setup' and $stage ne 'results' ){ next }

    $panel->add_block();
    $panel->add_block_header({ LABEL => $stage_obj->get_name });
    
    # Don't reset the stage any later than the CGI stage 
    if( $stage_obj->get_name eq $CGI->param('stage') ){ 
      $already_reset++ 
    }
    if( ! is_stage_initialised( $stage ) ){
      $panel->add_entry_footer({ LABEL => 'Not yet initialised' });
      next;
    }

    my $any   = 0; # Any filters set?
    my $warn  = 0; # Any warnings detected?

    #Compile form entry list
    my @form_objs = ( map{  $_->get_forms }
                      grep{ $_->get_available($CGI) }
                      $stage_obj->get_blocks );

    #if( $stage eq 'setup' ){
    foreach my $form( @form_objs ){

      # Is this form available?
      if( ! $form->get_available($CGI) ){ next }
      
      # Are there warnings registered for this form?
      if( is_warning( $form->get_name ) ){ $warn = 1 }
      
      # Are there CGI params for this form?
      my $value = $CGI->param( $form->get_name );
      defined( $value ) || next;
      
      # Loop for each form entries
      foreach my $entry( $form->get_form_entries ){
        
        # Is this entry available?
        if( ! $entry->get_available($CGI) ){ next }
        
        # Does entry have summary label?
        my $lbl = $entry->get_label_summary || next;

        # Are there CGI values for this entry?
        my @values = $CGI->param( $entry->get_cgi_name );
        defined( $values[0] ) || next;
        
        # Does the CGI value correspond to the entry value?
        if( $entry->get_value ){
          @values = grep{ $entry->get_value eq $_ } @values;
          $value  = $values[0] || next;
        }
        
        # Write summary info
        my $dpy = sprintf( $lbl, $value );
        $any = 1;
        $panel->add_entry_header({ LABEL => $dpy  })
      }
    }
    
    # Do we have any warnings at this stage?
    if( $warn ){
      
      # Display a warning
      $panel->add_warning({ LABEL => 'Errors detected!' });
      $error_found++; # Update the error flag
      
      # reset the stage to the first one for which warns detected
      if( ! $already_reset ){
        process_stage( $stage_obj->get_name );
        $already_reset++;    # Don't need to reset again
      }
      next;
    }
  }

  # BLAST
  #elsif( $stage eq 'results' ){
  #    #$BLAST->run;      
  #    my $tmpl = "%s %s quer%s Vs. <br> %s species";
  #    my $num_q = scalar( $BLAST->seqs );
  #    my @dbs = $BLAST->databases;
  #    my $num_s = scalar( @dbs );
  #    my $qt  = $CGI->param("query");
  #    $panel->add_entry_footer
#        ({ LABEL => sprintf( $tmpl, 
#                             $num_q, $qt, $num_q>1?'ies':'y', $num_s )});
#
#      foreach my $runnable( $BLAST->runnables() ){
#        my $lbl = ( $runnable->result->query_name.
#                    " vs ".
#                    $runnable->result->species. ": ".
#                    $runnable->status );
#        $panel->add_entry_header({ LABEL => $lbl })
#      }
#}
#}
  return $panel->output( );
}

#----------------------------------------------------------------------
# Returns the number of warnings stored in the CGI object associated 
# a form name.
sub is_warning{
  my $form_name = shift;
  my $param_name = '_'.$form_name.'!!warning';
  my @warns = $CGI->param( $param_name );
  return scalar( @warns );
}

#----------------------------------------------------------------------
# Uses EnsEMBL::Web::BlastView::PanelTop to generate a top panel.
sub get_top_panel{
  my $src_tmpl = join( '',
                       EnsEMBL::Web::BlastView::Panel::IMG_ROOT_ROVER,
                       '/',
                       '%s',
                       '-%s.gif' );

  my $top_panel = EnsEMBL::Web::BlastView::PanelTop->new($CGI);
  $top_panel->add_block();
  $top_panel->add_entry();

  my @stage_objs  = $META_DATA->get_stages;
  my @stage_names = map{ $_->get_name } @stage_objs;
  my @arrows;
  my %input_names;
  my %input_values;
  my %srcs;
  my $error = 0; # Grey out all stages after error

  for( my $i=0; $i<@stage_names; $i++ ){
    my $suffix;
    my $this_name = $stage_names[$i];
    my $next_name = $stage_names[$i+1];
    if( $this_name eq $CGI->param('stage') ){ 
      if( $ERRORS{$this_name} ){ $error ++ };
      $suffix = 'sel';
      $input_values{$this_name} = $this_name;
      $input_names{$this_name} = 'stage';
    }
    elsif( is_stage_initialised( $this_name ) and ! $error ){ 
      $suffix = 'on';
      $input_values{$this_name} = $this_name;
      $input_names{$this_name} = 'stage';
    }
    else{ $suffix = 'off' }
    $srcs{$this_name} = sprintf( $src_tmpl, 
                                 uc($this_name),
                                 $suffix );
    # Arrows:
    if( ( $this_name eq $CGI->param('stage')   ||
          is_stage_initialised( $this_name   ) ) &&
        ( $next_name eq $CGI->param('stage') ||
          is_stage_initialised( $next_name ) ) && $next_name ) {
      push @arrows, join( '/', 
                          EnsEMBL::Web::BlastView::Panel::IMG_ROOT_ROVER, 
                          'arrow-on.gif' );
    }
    elsif( $next_name ){
      push @arrows, join( '/', 
                          EnsEMBL::Web::BlastView::Panel::IMG_ROOT_ROVER, 
                          'arrow-off.gif' );
    }
  }

  # NEW and EXPORT buttons
  unshift @stage_names, 'new';
  unshift @arrows, EnsEMBL::Web::BlastView::Panel::IMG_BLANK;
  $input_names{new}  = '_new';
  $input_values{new} = 'new';
  $srcs{new} = sprintf( $src_tmpl, 
                        'new',
                        'on' );

  # Add the button row
  $top_panel->add_top_form({ -keys    => \@stage_names,
                             -divs    => \@arrows,
                             -names   => \%input_names,
                             -srcs    => \%srcs,
                             -vals    => \%input_values, });

  return $top_panel->output();
}

#----------------------------------------------------------------------
# 
sub get_page_tmpl {
  # Still here? need to build the main table and update the cache
  
  my $hub = shift;
  my $t = HTML::Template->new( filename => 'page.html.tmpl',
                               cache    => 0,
                               die_on_bad_params => 0,
                               case_sensitive => 1 );

  my( $main_box, $suffix_html ) = get_main_panel($hub);
  my %params;
  map{ $params{$_}="<TMPL_VAR $_>" } $t->query;
  $t->param(%params); 
  $t->param(
            MAIN_BOX      => $main_box,
            SUFFIX_HTML   => $suffix_html,
            BORDER_COLOR  => $EnsEMBL::Web::BlastView::Panel::BORDER_COLOR,
            MAIN_BG_COLOR => $EnsEMBL::Web::BlastView::Panel::MAIN_BG_COLOR,
            DARK_BG_COLOR => $EnsEMBL::Web::BlastView::Panel::DARK_BG_COLOR,
            VDARK_BG_COLOR=> $EnsEMBL::Web::BlastView::Panel::VDARK_BG_COLOR,
            IMG_BLANK     => EnsEMBL::Web::BlastView::Panel::IMG_BLANK,
           );

  my $output = $t->output();
  return $output;
}

#----------------------------------------------------------------------
# Generates HTML for main panel
sub get_main_panel {
  # --- MainPanel --
  
  my $hub        = shift;
  my $main_panel = EnsEMBL::Web::BlastView::PanelMain->new;
  my $panel_tmpl = '';

  # Get the current stage and stage object
  my $this_stage = $CGI->param( 'stage' );  
  my ($stage_obj) = 
    grep{ $_->get_name eq $this_stage } $META_DATA->get_stages;

  # Build the page description
  if( my $description = $stage_obj->get_page_header( 'title' ) ){
    $main_panel->add_panel_header({LABEL=>$description});
  }

  # Add the blocks/forms
  my @javascript_code = ();
  my @html_divs       = ();

  foreach my $block_obj( $stage_obj->get_blocks ){

    if( ! $block_obj->get_available() ){ next }

    my @forms = grep{ $_->get_available($CGI) } $block_obj->get_forms;

    # No forms? Abort block.
    if( ! scalar( @forms ) ){ next }

    $main_panel->add_block;
    my $label = $block_obj->get_label;
    $main_panel->add_block_header({ LABEL => $label }) if $label;

    foreach my $form_obj( @forms ){

      # Examine form for additional Java Script functions
      if( my $jscript = $form_obj->get_jscript ){
        push @javascript_code, $jscript;
      }
      # Examine form entries for html_div code
      my @entries = ( grep{ $_->get_available($CGI) } 
                      $form_obj->get_form_entries );

      # No entries? Abort form.
      if( ! scalar( @entries ) ){ next }

      #
      foreach my $entry_obj( @entries ){
        if( my $div = $entry_obj->get_html_div ){
          push @html_divs, $div;
        }
      }

      #
      my $sub  = 'gen_'.lc( $form_obj->get_type );
      if( ! $main_panel->can($sub) ){ 
        die( "No subroutine found for type '".$form_obj->get_type."'" )
      }
      my @entry_objs = grep{ $_->get_available($CGI) } $form_obj->get_form_entries;

      $main_panel->add_entry();      
      $main_panel->add_form
        ( $main_panel->$sub( @entry_objs ).
          $main_panel->gen_warn_placeholder($form_obj->get_name) );
      

    }
  }

  ##########
  # RESULTS
  if( $stage_obj->get_name eq 'results' ){

    my $dt = $CGI->param('database');
    my $database = $CGI->param("database_$dt");

    my $i = 0;
    foreach my $qseq( sort{ $a->display_id cmp $b->display_id } $BLAST->seqs ){
      $i++;
      my $display_id = $qseq->display_id();
      
      my $label_tmpl = "%s: %s (%s letters) Vs. %s";
      $main_panel->add_block();
      $main_panel->add_block_header({ LABEL => 
                                      sprintf( $label_tmpl,
                                               $i,
                                               $display_id,
                                               $qseq->length,
                                               $database ) });

      $main_panel->add_entry;

      my @runnables = $BLAST->runnables_like( -seq=>$display_id );
      foreach my $runnable( sort{ $a->result->database_name cmp 
                                  $b->result->database_name } @runnables ){
        my $status   = $runnable->status;
        my $status_label = '';
        my $failfile = $runnable->errorfile;
        if($status eq 'DISPATCHED'){ $status_label = "Job Queued" }
        if($status eq 'FAILED' ){
          $status_label = "System error; please <A href='/Multi/blastview'>resubmit</A> job. <BR>".
            "If problem persists, file a report using the help link above";
          my $token = $runnable->token;
          my $msg = "Blast job resulted in $failfile file:\n";
          open FAIL, $failfile;
          while( <FAIL> ){
            $msg .= $_;
          }
          close FAIL;
          log_blast_error( $token, $msg );
        }
        
        my $raw_link = '&nbsp';
        my $exp_link = '&nbsp';
        my $result   = $runnable->result;
        my $species  = $result->database_species;
        my $num_aligns = 0;
        #warn Dumper( $result );
        map{ $num_aligns += $_->num_hsps } $result->hits;
        my $num_hits = $result->num_hits;
        my ( $run_id ) = $runnable->token =~ /([^\/]+$)/;
        my $res_id   = $result->token;
        my $hits_txt = ( $status eq "COMPLETED" ? 
                         $num_aligns."&nbsp;alignments,&nbsp;".
                         $num_hits."&nbsp;hits" : '&nbsp' );

        my $run_token = $runnable->token =~ /(\w+)$/ ? $1 : '';
        if( -e $runnable->reportfile ){
          my $raw_href = ("/Multi/$VIEW_SCRIPT?".
                          join( ';',
                                'format=raw',
                                "ticket=$TICKET",
                                "runnable=$run_token",
                                "result=$res_id" ) );
          my $raw_targ = 'BLAST_RESULT_$TICKET';
          my $raw_link_tmpl = '<A href="%s" target="%s">[RawResult]</A>';
          $raw_link    = sprintf( $raw_link_tmpl, $raw_href, $raw_targ );
          if( $status ne "COMPLETED" and
              $status ne "FAILED" ){ $status_label = "Parsing results" }
        }

        if( $status eq "COMPLETED" ){
          if( $result->num_hits > 0 ){
            $status_label = gen_button( 'stage', "display_$run_id", 'view' );
#            $status = $main_panel->_gen_base_form#
#              ( -type =>'image',
#                -name =>'stage',
#                -value=>'display_'.$res_id,
#                -src  => gen_button_src('view', 'on' ) );
          }
          else{ $status_label = 'No Hits' }

          my $exp_href = ('/biomart/martview?'. 
                          join( ';',
                                "_blast_ticket=$TICKET",
                                "_blast_result=$res_id" ) );

#          my $exp_href_tmpl = ('/Multi/martview?'. 
#                               join( ';',
#                                     'stage=output',
#                                     'stage_initialised=start',
#                                     'stage_initialised=filter',
#                                     'species=%s',
#                                     'focus=%s',
#                                     'named_gene=1',
#                                     'named_gene_filter=%s',
#                                     'named_gene_list=%s' ) );


          my $exp_targ = 'BLAST_EXPORT_$TICKET';
          my $exp_link_tmpl = '<A href="%s" target="%s">[MartView]</A>';

          # Build mart export link
          my $db_type = $result->database_type();
          if( $db_type =~ /(CDNA)|(PEP)|(RNA)/oi and
              $db_type !~ /(ABINITIO)|(PREDICTION)/oi and 
              $result->num_hits > 0 ){

#            my $gene_list = ( join ',', 
#                              map{ $_->name =~ /([^:]+)$/ } 
#                              $result->hits );
#            my $gene_filter = ($result->database =~ /(CDNA)/ ?
#                             'FG_ens_translation_ID':'FG_ens_transcript_ID' );
#            my $exp_href = sprintf( $exp_href_tmpl,
#                                    $result->species,
#                                    'gene', 
#                                    $gene_filter, 
#                                    $gene_list )
            if( 1 || $SPECIES_DEFS->get_config( $species, "ENSEMBL_NO_MART" ) ){
              $exp_link = '';
            }
            else{
              $exp_link    = sprintf( $exp_link_tmpl, $exp_href, $exp_targ );
            }
          }
        }
        

        $main_panel->add_form( $main_panel->get_entry_result
                               ( $species,
                                 $hits_txt, 
                                 $raw_link.$exp_link,
                                 $status_label ) );

      }
    }
  }

  ##########
  # DISPLAY
  if( $stage_obj->get_name eq 'display' ){
    my $run_id = ( $CGI->param('run_id')    ||
                   return( "<P>Need a result ID!" ) );
    
    my $run_token = $BLAST->workdir."/".$run_id;
    my( $runnable )= $BLAST->runnables_like( -token=>$run_token );
    
    if( ! $runnable ){ return( "<P>Result $run_id not found!" ) }
    my $result = $runnable->result;

    # result info
    #my @run_tokens = map{ $_ =~ /([^\/]+)$/ } $BLAST->runnable_tokens;
    #my $run_token = $run_id; 
    #my %run_nav_info = page_navigation('run',[@run_tokens],$run_token);

    if( $runnable->status ne 'COMPLETED' ){
      #populate_navigation( $main_panel, \%run_nav_info );
      my $label = ( "Result of ".$result->query_name.
                    ' vs '.$result->database_name ." not completed!" );
      $main_panel->add_block();
      $main_panel->add_block_header({ LABEL => $label });
    }
    elsif( $result->num_hits < 1 ){
      #populate_navigation( $main_panel, \%run_nav_info );
      my $label = ( "No HSPs resulted from ". $result->query_name.
                    ' vs '.$result->database_name );
      $main_panel->add_block();
      $main_panel->add_block_header({ LABEL => $label });
    }

    else{
      # Initialise variable used to store sorted alignment [$hit,$hsp] 
      # from top NN scoring HSPs
      my $alignments = []; 

    TOPFORM:{
        # Form for top of DISPLAY page

        my $label = ("<b>Displaying ".
                     $result->query_name.' sequence alignments vs '.
                     $result->database_species." ".
                     $result->database_type .' database</b>');

        $main_panel->add_block();
        $main_panel->add_block_header({ LABEL => $label });

        # How many alignments are we interested in? Create text form;
        my $num_aligns = $CGI->param('view_numaligns') || 100;
        my $max_aligns  = 10000;
        my $tot_aligns = 0;
        map{ $tot_aligns += $_->num_hsps } $result->hits;
        if( $num_aligns > $max_aligns ){ $num_aligns = $max_aligns }
        $CGI->param(-name=>'view_numaligns',-value=>$num_aligns);
        if( $num_aligns > $tot_aligns ){ $num_aligns = $tot_aligns }
        my %numaligns_args = ( -type  => 'TEXT',
                               -name  => 'view_numaligns',
                               -size  => 4,
                               -maxlength=>4  );
        my $numaligns_form = $main_panel->_gen_base_form(%numaligns_args);

        # How are we sorting the alignments?
        my %sortopts = ( score=>"Raw Score",
                         percent_identity=>"% Identity",
                         length=>"Alignment Length",
                         evalue=>"E-value",
                         pvalue=>"P-value" );
        my $sortby = $CGI->param('view_sortby');
        if( ! $sortopts{$sortby} ){ $sortby = 'score' }
        $CGI->param(-name=>'view_sortby',-value=>$sortby);
        my @sortopts = map{[$_=>$sortopts{$_}]} sort keys %sortopts;
        my %sortby_args = ( -type  => 'SELECT',
                            -name  => 'view_sortby',
                            -options=>[@sortopts] );
        my $sortby_form = $main_panel->_gen_base_form(%sortby_args);

        $numaligns_form = ("Showing top $numaligns_form ".
                           "alignments of $tot_aligns, ".
                           "sorted by $sortby_form");

        # Create sorted alignment [$hit,$hsp] from top NN scoring HSPs
        foreach my $hit( $result->hits ){
          push @$alignments, map{ [$hit,$_] } $hit->hsps;
        }
        @$alignments = ( sort{ $b->[1]->$sortby <=> $a->[1]->$sortby } 
                         @$alignments )[0..$num_aligns-1];

        # 'Refresh' button
        my $refresh = gen_button( 'stage', 'display', 'refresh' );

        # Write out the form
        my $tmpl = qq(
<table width="100%%" cellpadding="0" cellspacing="0" border="0">
<tr>
 <td><b>%s</b></td>
 <td align="right">%s</td></tr></table>);
        my $label = sprintf( $tmpl, $numaligns_form, $refresh );
        $main_panel->add_entry_header({LABEL=>$label});
      }


    KARYO:{
        my $toggle = gen_button
          ( 'viewreskaryo',
            $CGI->param('viewreskaryo') ? 0 : 1,
            'toggle',
            $CGI->param('viewreskaryo') ? 'off':'on');

        my $label = (" Alignment Locations vs. Karyotype" );
        if( $CGI->param('viewreskaryo') ){ $label .= " (click arrow to hide)" }
        else                             { $label .= " (click arrow to view)" }
        $main_panel->add_block();
        $main_panel->add_block_header({ LABEL => $toggle.$label });
        if( $CGI->param('viewreskaryo') ){
          &populate_karyotype($hub, $main_panel, $runnable, $result, $alignments);
        }
      }

    GRAPHICAL_QUERY_ALIGNMENT_LOCATIONS:{
        my $toggleparam = 'viewresaligngraph';
          my $toggle = gen_button
          ( $toggleparam,
            $CGI->param($toggleparam) ? 0 : 1,
            'toggle',
            $CGI->param($toggleparam) ? 'off':'on');

        my $label = (' Alignment Locations vs. Query' );
        if( $CGI->param($toggleparam) ){ $label .= " (click arrow to hide)" }
        else                           { $label .= " (click arrow to view)" }
        $main_panel->add_block();
        $main_panel->add_block_header({ LABEL => $toggle.$label });
        if( $CGI->param($toggleparam) ){
          &draw_hsp_vs_query($hub, $main_panel, $runnable, $result, 
                              $alignments, );
        }
      }

    HIT_TABLE:{
        # populate Hit table
        my $toggleparam = 'viewressummary';
        my $toggle = gen_button
          ( $toggleparam,
            $CGI->param($toggleparam) ? 0 : 1,
            'toggle',
            $CGI->param($toggleparam) ? 'off':'on' );

        my $label = ( ' Alignment Summary' );        
        if( $CGI->param($toggleparam) ){ $label .= " (click arrow to hide)" }
        else                           { $label .= " (click arrow to view)" }

        $main_panel->add_block();
        $main_panel->add_block_header({LABEL=>$toggle.$label});
        if( $CGI->param($toggleparam) ){
          &populate_result_summary( $main_panel, $runnable, $result, 
                                    $alignments, )
        }
      }
    }
  }

  # Footer
  if( my $label = $stage_obj->get_page_footer('title') ){
    
    $main_panel->add_block();
    $main_panel->add_panel_header({ LABEL=>$label});
    
    my $paras_ref = $stage_obj->get_page_footer('text');
    foreach my $para ( @$paras_ref ){
      $main_panel->add_panel_text({ LABEL=>$para});
    }
  }

  # Last and next links
#  $main_panel->add_panel_image( {}, 
#                                \%last_meta, 
#                                \%next_meta );

  # What is the label for the currently selected form object?
  # TODO: imporve efficiency of META 
  my( $focus_label ) = map { $_->get_label }
                       grep{ $_->get_value eq $CGI->param('focus') }
                       map { $_->get_form_entries }
                       grep{ $_->get_name eq 'focus' }
                       map { $_->get_forms }
                       grep{ $_->get_name eq 'focus' } 
                       map { $_->get_blocks }
                       grep{ $_->get_name eq 'setup' } $META_DATA->get_stages;
  
  # Generate and return the output
  if( uc($CGI->param("stage" )) eq 'DISPLAY' ){
    return $main_panel->output_simple;
  }
    #warn( $main_panel->output() );
  my $suffix_html = join("\n", @javascript_code, @html_divs);
  return ( $main_panel->output( -align=>1 ),
           $suffix_html );

}

#----------------------------------------------------------------------
# Works out pagination through tokens.
# Generates next and back nav buttons
# Takes:   scalar level( 'run|hit|hsp'), 
#          array of all tokens, 
#          scalar current token
# Returns: Hash ( number=>number run|hit|hsp
#                 this_index  => current run|hit|hsp index
#                 this_token  => current run|hit|hsp token
#                 back_token  => last run|hit|hsp token
#                 next_token  => next run|hit|hsp token
#                 back_button => back button
#                 next_button => next button

sub page_navigation{
  my $type       = shift;
  my $tokens_ref = shift;
  my $this_token = shift;
  my $last_token;
  my $next_token;
  my @tokens = @$tokens_ref;
  my $num = @tokens;

  my %data = ( number=>$num, this_token=>$this_token );

  my $page = 0;
  for( my $i=0; $i<$num; $i++ ){
    my $token = $tokens[$i];
    if( $token eq $this_token ){
      $data{back_token} = $i>0        ? $tokens[$i-1] : undef();
      $data{next_token} = $i<($num-1) ? $tokens[$i+1] : undef();
      $data{this_index} = $i+1;
      last;
    }
  }

  my @back_args;
  my @next_args;
  if( $type eq 'run' ){ 
    $data{type_text} = 'Result';
    push @back_args, $data{back_token};
    push @next_args, $data{next_token};
  }
  else{
    push @back_args, $CGI->param('run_id');
    push @next_args, $CGI->param('run_id');
  }
  if( $type eq 'hit' ){
    $data{type_text} = 'Hit';
    push @back_args, $data{back_token};
    push @next_args, $data{next_token};    
  }
  elsif( $type eq 'hsp' ){
    $data{type_text} = 'HSP';
    push @back_args, $CGI->param('hit_id'), $data{back_token};
    push @next_args, $CGI->param('hit_id'), $data{next_token};        
  }

  $data{back_button} = gen_button( 'stage',
                                   'display_' . join('+',@back_args),
                                   'back2',
                                   $data{back_token} ? 'on' : 'off' );
  $data{next_button} = gen_button( 'stage',
                                   'display_' . join('+',@next_args),
                                   'next2',
                                   $data{next_token} ? 'on' : 'off' );

  return( %data );
}

#----------------------------------------------------------------------
#
sub gen_button{
  my $meta = gen_button_meta(@_);
  return EnsEMBL::Web::BlastView::Panel->_gen_base_form( %$meta )
}

#----------------------------------------------------------------------
#
sub gen_button_meta{
  my $name = shift;
  my $value = shift;
  my $img   = shift;
  my $status = shift || 'on';
  return { -type=>'IMAGE', -name=>$name, -value=>$value,
           -src=>gen_button_src( $img, $status ) };
}

#----------------------------------------------------------------------
#
sub gen_button_src{
  my $src_tmpl = join( '',
                       EnsEMBL::Web::BlastView::Panel::IMG_ROOT_ROVER,
                       '/',
                       '%s',
                       '-%s.gif' );
  return sprintf( $src_tmpl, $_[0], $_[1] );
}

#----------------------------------------------------------------------
# Tests whether a given stage has been viewed before for this user 'session'
# Flag is reset when the user clicks the 'new' button.
sub is_stage_initialised{
  my $stage = shift || $CGI->param('stage'); # Defaults to the current stage
  foreach( $CGI->param('stage_initialised') ){
    if( $stage eq $_ ){ return 1 }
  }
  return 0;
}
#----------------------------------------------------------------------
# Unsets the inilialised flag for a given stage
sub uninitialise_stage{
  my $stage = shift || $CGI->param('stage'); # Defaults to the current stage
  my %init_stages = map{$_,1} $CGI->param('stage_initialised');
  $init_stages{$stage} || return;
  delete( $init_stages{$stage} );
  $CGI->param(-name=>'stage_initialised',-value=>[keys  %init_stages]);
  return 1;
}
#----------------------------------------------------------------------
#
sub get_onload{

  # Still here? need to build the javascript onload stuff
  my @onload = (
                grep{ $_ }
                map { $_->get_jscript_onload( $CGI, $BLAST ) }
                grep{ $_->get_available($CGI) }
                map { $_->get_forms }
                grep{ $_->get_available($CGI) }
                map { $_->get_blocks } 
                grep{ $_->get_name eq $CGI->param('stage') }
                $META_DATA->get_stages 
               );

  push( @ON_LOAD_EXTRA, @onload );
  return 1;
}

#----------------------------------------------------------------------
#
sub update_selection{

  my $tmpl    = shift;
  my $top     = shift;
  my $status  = shift;
  my $state   = shift;

  # Create a template
  my $t = HTML::Template->new( scalarref => \$tmpl,
                               die_on_bad_params => 0,
                               case_sensitive => 1 );

  my %params = (
                TOP_BOX       => $top, 
                STATUS_BOX    => $status,
                SPECIES_URL   => $ENV{ENSEMBL_SPECIES},
                SCRIPT_NAME   => $VIEW_SCRIPT,
                MART_STATE_ID => $TICKET,
                EXPORT_STATUS => %ERRORS ? 'off' : 'on'
               );

  foreach my $p( $t->query() ){
    my( $name, $value, $action ) = split( '!!', $p );
    $action=$value if ! $action;
    $action = uc($action);
    if( $action eq 'SELECTED' or $action eq 'CHECKED'  ){
      if( grep{ uc($value) eq uc($_)} $CGI->param($name) ){
        $params{$p} = uc( $action );
      }
    }
    elsif( uc( $action  ) eq 'VALUE' ){
      #my @vals = grep{ $_ ne 'on' } $CGI->param($name);
      my @vals = $CGI->param($name);
      $params{$p} = shift( @vals );
    }
    elsif( uc( $action ) eq 'WARNING' && $CGI->param('_'.$p) ){
      my @warns;
      foreach( $CGI->param('_'.$p) ){
        push @warns, get_panel_warning( $_ );
      }
      $params{$p} = join '<BR>', @warns;
    }
  }
  $t->param( %params );
#  require Data::Dumper; warn(Data::Dumper->Dump([\%params]));
  return $t->output();

}

#----------------------------------------------------------------------
# Generates a karyotype image
sub populate_karyotype {
  my $hub        = shift;
  my $main_panel = shift;
  my $runnable   = shift;
  my $result     = shift;
  my $aligns     = shift;
#  my $sel_hit    = shift;
#  my $sel_hsp    = shift;

  my $sp = $result->database_species;
  my $chr_ref = $SPECIES_DEFS->get_config( $sp, 'ENSEMBL_CHROMOSOMES' );
  if( ref( $chr_ref ) ne 'ARRAY' or @{$chr_ref} < 1 ){
    $main_panel->add_entry();
    $main_panel->add_form( $main_panel->get_form_label
                           ( "Karyotype unavailable for $sp" ) );
    return;
  }

  my( $run_id ) = $runnable->token =~ /([^\/]+)$/;

  # Generate a list of golden Hits in reverse score order
#  my @hits = ( sort{ $b->raw_score <=> $a->raw_score }
#               grep{ $_->can( 'ensembl_slice' ) && $_->ensembl_slice } 
#               $result->hits );
#  if( ! @hits ){ return }

  # Generate a list of golden HSPs in reverse score order
  my $alignments = [];
  @$alignments = ( grep{ $_->[1]->can( 'genomic_hit' ) && $_->[1]->genomic_hit } @$aligns );
  if( ! @$alignments ){ return "No HSPs for result!" }

  my $TMP     = $SPECIES_DEFS->ENSEMBL_TMP_DIR_IMG;
  my $TMP_URL = $SPECIES_DEFS->ENSEMBL_TMP_URL_IMG;

  my %highlights      = ( 'style' => 'arrow'  );
  my %highlights2     = ( 'style' => 'outbox' );
    
  my $karyo_tmpl = qq(
<TABLE align="center" border="0" cellspacing="0" cellpadding="2">
 <TR valign="top">
  <TD nowrap align="center" colspan="2"
  ><IMG SRC="%s" BORDER="0" usemap="#karyo"></TD>
 </TR>
 <TR><TD colspan="2" height="5"><img src="/img/blank.gif" height="5" /></TD></TR>
 <TR>
  <TD  colspan="2" align="center">%s</TD>
 </TR>
</TABLE>
<MAP name="karyo">
%s</<MAP>);

  my $colours_tmpl = qq(
<table align="center" border="0" cellspacing="0" cellpadding="2"><tr>
<td><small>Key (%%ID): &nbsp; </small></td>
%s
</tr></table>);

  my $colour_row_tmpl = qq(
<td align="center" nowrap="nowrap" width="50" bgcolor="%s"
><b><font color="white"><small>&nbsp;%.0f&nbsp;-&nbsp;%.0f&nbsp;</small></b></font></td>);

  my $colour_row_spacer = qq(
<td width="8"><small>&nbsp;</small></td>);

  my $link_href_tmpl    = ("/Multi/$VIEW_SCRIPT?".
                           join( ';',
                                 "ticket=$TICKET",
                                 "run_id=$run_id",
                                 'hit_id=%s',
                                 'hsp_id=%s', 
                                 '_display=%s' ) );

  my $ctgview_href_tmpl = ('/%s/ZMenu/Location/View?'.
                           join( ';',
                                 'r=%s:%s-%s',
                                 'h=BLAST_NEW:%s!!%s' ) );

  # Determine colour bands for highlighting hits
  #my $max_score = $alignments->[0]->[1]->score;
  #my $min_score = $alignments->[@$alignments-1]->[1]->score;
  #my @colours = @$alignments > 1 ? ( 'blue', 'darkgreen', 'red' ) : ( 'red' );

  my @colours = qw( gold orange chocolate firebrick darkred );
  my @col_tds;
  for( my $i=0; $i<@colours; $i++ ){
    push( @col_tds,  sprintf( $colour_row_tmpl, $colours[$i], 
                              $i * 20, ($i+1) * 20 ) );
  }
  my $colour_key_str = sprintf( $colours_tmpl,
                                join( $colour_row_spacer, @col_tds ) );

  # Create per-hit glyphs
  my @glyphs;
  my $first=1;
  foreach( @$alignments ){
    my( $hit, $hsp ) = @{$_};
    my $gh        = $hsp->genomic_hit;
    my $chr       = $gh->seq_region_name;
    my $chr_start = $gh->seq_region_start;
    my $chr_end   = $gh->seq_region_end;
    my $caption   = "Alignment vs ". $hsp->hit->seq_id;
    my $score     = $hsp->score;
    my $pct_id    = $hsp->percent_identity;
    my $colour_id = int( ($pct_id-1)/20 );
    my $colour    = @colours[ $colour_id ];
    # Gen ctgview href
    my $ctgview_href = sprintf( $ctgview_href_tmpl, $sp,
                                $chr, $chr_start - 1000, $chr_end + 1000, 
                                $TICKET, $result->use_date );
    # Gen internal href
    my $link_href = sprintf( $link_href_tmpl,
                             $hit->token,
                             $hsp->token, '%s' );

    my $config = 
      { start => $chr_start,
        end   => $chr_end,
        score => $score,
        col   => $colour,
        href  => $ctgview_href,
        zmenu => 
        { caption => $caption,
          "00:Alignment..."        => '@'.sprintf($link_href,'ALIGN'),
          "01:Query Sequence..."   => '@'.sprintf($link_href,'SEQUENCE'),
          "02:Genomic Sequence..." => '@'.sprintf($link_href,'GSEQUENCE'),
          "03:ContigView..."       => '@'.$ctgview_href,
          "04:Raw Score: ". $hsp->score            => '',
          "05:PercentID: ". $hsp->percent_identity => '',
          "06:Length:    ". $hsp->length           => '', }
      };
    
    my $pv = $hsp->pvalue;
    if( defined( $pv ) ){ $config->{zmenu}->{"07:P-value: $pv"} = '' };
    my $ev = $hsp->evalue; 
    if( defined( $ev ) ){ $config->{zmenu}->{"08:E-value: $ev"} = '' };

    $highlights{$chr} ||= [];
    push( @{$highlights{$chr}}, $config );

    if( $first ){
      $first = 0;
      $highlights2{$chr} ||= [];
      push ( @{$highlights2{$chr}}, { start => $chr_start,
                                      end   => $chr_end,
                                      score => $score,
                                      col   => $colour } );
    }
  }

  my $db = $DBCONNECTION->get_DBAdaptor('core', $sp);

  my $ka = $db->get_KaryotypeBandAdaptor;
  my $sa = $db->get_SliceAdaptor;

  my $chrs_ref   = $SPECIES_DEFS->get_config( $sp, 'ENSEMBL_CHROMOSOMES' );
  my $chr_maxln  = $SPECIES_DEFS->get_config( $sp, 'MAX_CHR_LENGTH'      );
  my $site_type  = $SPECIES_DEFS->get_config( $sp, 'ENSEMBL_SITETYPE'    );
  my $web_config = $hub->get_imageconfig('Vkaryoblast');

  my $num_chrs = scalar( @$chrs_ref );
  $web_config->set_parameters({
    'rows'            => int( ($num_chrs-1)/18 ) + 1,
    'chromosomes'     => $chrs_ref,
    'all_chromosomes' => 'yes',
    'container_width' => $chr_maxln,
    'slice_number'    => '0|1'
  });
  my $karyo_dc = Bio::EnsEMBL::VDrawableContainer->new(
    { 'web_species' => $sp, ka=>$ka, sa=>$sa, 'chr' => 'ALL' }, $web_config, [ \%highlights, \%highlights2 ] 
  );
  

  my $fi = new EnsEMBL::Web::Document::Image( $SPECIES_DEFS );
     $fi->drawable_container = $karyo_dc;
     #$fi->{'img_map'} = 1;
     #$fi->{'border'}  = 1;

  my $image   = new EnsEMBL::Web::TmpFile::Image;
  my $content = $fi->drawable_container->render('png');
  $image->content($content);
  $image->save;


  $main_panel->add_entry();
  my $img_tag = $fi->render_image_tag($image);
  my $html = sprintf '
    <table align="center" border="0" cellspacing="0" cellpadding="2">
      <tr valign="top">
        <td nowrap align="center"><div class="drag_select js_panel" id="blast_karyo"
	  style="margin: 0px auto; border: solid 1px black; position: relative; width:%dpx">%s</div></td>
      </tr>
    </table>',
    $fi->{'width'},
    $img_tag.$fi->render_image_map($image);

  $main_panel->add_form( $main_panel->get_form_label( $html ) );
  return 1;
}

#----------------------------------------------------------------------
# Graphical representation of Hit coverage of HSP sequence
sub draw_hsp_vs_query{
  my $hub        = shift;
  my $main_panel = shift;
  my $runnable   = shift;
  my $result     = shift;
  my $aligns     = shift;

  my $bucket = EnsEMBL::Web::Container::HSPContainer->new($result, $aligns);
  my $web_config = $hub->get_imageconfig('hsp_query_plot');
  $web_config->set_parameter( 'container_width', $bucket->length );
  $web_config->set_parameter( 'image_width',     640 );

  my $hsp_dc = Bio::EnsEMBL::DrawableContainer->new( $bucket,$web_config);

  my $fi = new EnsEMBL::Web::Document::Image( $SPECIES_DEFS );
     $fi->drawable_container = $hsp_dc;

warn "... ",$bucket->length;

  my $image   = new EnsEMBL::Web::TmpFile::Image;
  my $content = $fi->drawable_container->render('png');
  $image->content($content);
  $image->save;


  $main_panel->add_entry();
  my $html = qq(<table align="center" border="0" cellspacing="0" cellpadding="2">
   <tr valign="top">
     <td nowrap align="center" colspan="2"
       >).$fi->render_image_tag($image).qq(</td></td></table>).$fi->render_image_map($image);
  $main_panel->add_form( $main_panel->get_form_label( $html ) );

  return 1;

#  my $sp = $result->database_species;
#  my $site_type= $SPECIES_DEFS->get_config( $sp, 'ENSEMBL_SITETYPE' );
#  my $uca  = EnsEMBL::Web::UserConfigAdaptor->new( $site_type );
#  my $uc   = $uca->getUserConfig('hsp_queryalign');
#
#  use Bio::EnsEMBL::DrawableContainer();
#  my $dc = Bio::EnsEMBL::DrawableContainer->new({},$uc);

}

#----------------------------------------------------------------------
#
sub populate_navigation{
  my $main_panel = shift;
  my @row_data   = @_;

  my $table_tmpl = qq(
<TABLE cellspacing=0 cellpadding=0 align='center'>%s
</TABLE> );

    my $row_tmpl = qq(
 <TR>
  <TD align='right'>%s</TD>
  <TD align='center'>&nbsp;%s</TD>
  <TD align='center'>&nbsp;%s</TD>
  <TD align='center'>&nbsp;of </TD>
  <TD align='center'>&nbsp;%s</TD>
  <TD align='left'  >&nbsp;%s</TD>
 </TR> );

  my $nav_table = '';
  foreach( @row_data ){
    my %data = %$_;
    $nav_table .= sprintf
      ( $row_tmpl, 
        $data{back_button}, 
        $data{type_text}, 
        $data{this_index}, 
        $data{number},
        $data{next_button} );
  }
  $nav_table = sprintf( $table_tmpl, $nav_table );
  $main_panel->add_block();
  $main_panel->add_block_header({LABEL=>$nav_table} );
  return 1;
}
#----------------------------------------------------------------------
#
sub populate_result_summary{
  my $main_panel = shift;
  my $runnable   = shift;
  my $result     = shift;
  my $alignments = shift;

  my $species   = $result->database_species;

  my( $run_id ) = $runnable->token =~ /([^\/]+)$/;
  my $result_id = $result->token;
  my $use_date  = $result->use_date;

 CONTROLLER:{

    my $TABLE = qq(
<TABLE cellspacing=0 cellpadding=0 border=0 width="100%%">%s
</TABLE> );
        my $ROW = qq(
 <TR>%s
 </TR> );
        my $CELL = qq(
  <TD>%s
  </TD> );

    my @label_cells = 
      ("<b><small>Select rows to include in table, and type of sort</small></b><br>".
       "<small>(Use the 'ctrl' key to select multiples)</small>",
       gen_button( 'stage', 'display', 'refresh' ) );

    my $label_row = join( '', map{sprintf( $CELL, $_ )} @label_cells );
    my $label_table = sprintf( $TABLE, sprintf( $ROW, $label_row ) ); 

    $main_panel->add_entry_header({LABEL=>$label_table});
    
    my @view_types = qw( query subject );
    my $species = $result->database_species;
    my $DBAdaptor = $DBCONNECTION->get_DBAdaptor('core', $species);
    my $CoordSystemAdaptor = $DBAdaptor->get_CoordSystemAdaptor;
    my $toplevel;
    foreach my $CoordSystem( @{$CoordSystemAdaptor->fetch_all} ){
      next if !($CoordSystem->is_default);
      my $name = $CoordSystem->name;
      if( $CoordSystem->rank == 1 ){ $toplevel = $name }
      push @view_types, $name;
    }

    my $html = '';
    my @cells = ();
    my @sort_opts = ();
    foreach my $view_type( @view_types ){
      my %args = ( -type=>'SELECT',
                   -name=>"view_$view_type",
                   -options=>[[''=>'_off_'],
                              [name=>'Name'],
                              [start=>'Start'],
                              [end=>'End'],
                              [orientation =>'Ori']],
                   -multiple=>1,
                   -size    =>3, );
      my $select = $main_panel->_gen_base_form(%args);
      my $label = ucfirst($view_type);
      push @cells, "<b><small>$label</small></b><BR>$select";
      push @sort_opts, ["${view_type}_asc"=>"&lt;$label"];
      push @sort_opts, ["${view_type}_dsc"=>"&gt;$label"];
    }

    my @stats_opts =( [score=>'Score'],
                      [evalue=>'E-val'],
                      [pvalue=>'P-val'],
                      [identity=>'%ID'],
                      [length  =>'Length'] );

    my %stats_args = ( -type=>'SELECT',
                       -name=>'view_stats',
                       -options=>[[''=>'_off_'],@stats_opts],
                       -multiple=>1,
                       -size    =>3, );
    my $stats_select = $main_panel->_gen_base_form(%stats_args);
    push @cells, "<b><small>Stats</small></b><BR>$stats_select";

    foreach my $s( @stats_opts ){
      push @sort_opts, [$s->[0]."_asc","&lt;$s->[1]"];
      push @sort_opts, [$s->[0]."_dsc","&gt;$s->[1]"];
    }

    my %sort_args = ( -type=>'SELECT',
                      -name=>'view_sort',
                      -options=>[@sort_opts],
                      -multiple=>0,
                      -size=>3 );
    my $sort_select = $main_panel->_gen_base_form(%sort_args);
    push @cells, "<b><small>Sort By</small></b><BR>$sort_select";

    my $row = join( '', map{sprintf( $CELL, $_ )} @cells );
    my $table = sprintf( $TABLE, sprintf( $ROW, $row ) ); 

    # Defaults
    if( ! is_stage_initialised('display') ){
      foreach my $type( @view_types ){
        my @defaults = ('');
        if( $type eq 'query' ){
          @defaults = qw( start end orientation );
        }
        elsif( $type eq 'subject' ){
          my $database = $CGI->param($CGI->param('database') eq 'dna' ?
                                     'database_dna' : 'database_peptide');
          if( $database =~ /^(CDNA)|(PEP)|(RNA)/io ){
            @defaults = qw( name start end orientation );
          }
        }
        elsif( $type eq $toplevel ){
          @defaults = qw( name start end orientation );
        }
        $CGI->param( -name=>"view_$type", 
                     -value=>[@defaults] );
      }
      if( $CGI->param('method') eq 'SSAHA' || $CGI->param('method') eq 'SSAHA2' ){
        $CGI->param( -name=>'view_stats',  
                     -value=>[ qw( score identity length ) ] );
      }
      else{
        $CGI->param( -name=>'view_stats', 
                     -value=>[ qw( score evalue identity length )] );
      }
      $CGI->param( -name=>'view_sort', 
                   -value=>'score_dsc' );
    }
    $main_panel->add_entry_header({LABEL=> $table } );
  }


  # Define templates
  my $ahref_t = ("/Multi/$VIEW_SCRIPT?".
                 join( ';',
                       "ticket=$TICKET",
                       "run_id=$run_id",
                       "result_id=$result_id",
                       'hit_id=%s',
                       'hsp_id=%s', 
                       '_display=%s' ) );

  my $chref_t = ("/$species/Location/View?".
                 join( ';',
                       'r=%s:%s-%s',
                       "h=BLAST_NEW:$TICKET!!$use_date" ) );

  my $sort_t  = qq(<A href="/Multi/$VIEW_SCRIPT?ticket=$TICKET&sort=%s" title="Sort Descending"><IMG src="/img/blastview/sort_descending.gif" border=0 height=11 width="1"1></A>);
  my $rsort_t = qq(<A href="/Multi/$VIEW_SCRIPT?ticket=$TICKET&sort=%s" title="Sort Ascending"><IMG src="/img/blastview/sort_ascending.gif" border=0 height=11 width="1"1></A>);

  my $link_t = qq(<A href="%s" target="%s$TICKET" title="%s">%s</A>);  
  my $alink_t = sprintf( $link_t, $ahref_t, "BV_A_", "Alignment",      "[A]" );
  my $slink_t = sprintf( $link_t, $ahref_t, "BV_A_", "Query Sequence", "[S]" );
  my $glink_t = sprintf( $link_t, $ahref_t, "BV_A_", "Genome Sequence","[G]" );
  my $clink_t = sprintf( $link_t, $chref_t, "BV_C_", "ContigView",     "[C]" );

  my $database = $result->database_type;
  my $db_name_link_t;
  my $display_location = 1; # Whether to display genomic location in table

  my $mapview_link_t = sprintf( $link_t, "/$species/mapview?chr=%s", 
                                "BV_N_", "mapview", "Chr:%s" );

  my $ctgview_link_t = sprintf
    ( $link_t, "/$species/Location/View?".
      join( ';', "r=%s",
            "h=BLAST_NEW:$TICKET!!$use_date"), 
      "BV_N_", "Location/View", "%s" );

  my $cytoview_link_t = sprintf
    ( $link_t, "/$species/Location/Overview?".
      join( ';', "r=%s",
            "highlights=BLAST_NEW:$TICKET!!$use_date"), 
      "BV_N_", "Location/Overview", "%s" );

  if( $database =~ /LATESTGP/i ){
    $db_name_link_t = $ctgview_link_t;
  }
  elsif( $database =~ /(CDNA)|(RNA)/i ){
    my $nhref_t = ("/$species/Transcript/Summary?".
                   join( ';',
                         'transcript=%s',
                         #"highlights=BLAST_NEW:$TICKET" 
                       ) );     
    $db_name_link_t = sprintf( $link_t, $nhref_t, "BV_N_", "TransView", "%s" );
  }
  elsif( $database =~ /PEP/i ){
    my $id_type = 'peptide';
    if(  $database =~ /(ABINITIO)|(PREDICTION)/io ){ $id_type = 'transcript' }
    my $nhref_t = ("/$species/Transcript/ProteinSummary?".
                   join( ';',
                         "$id_type=%s",
                         #"highlights=BLAST_NEW:$TICKET" 
                       ) );         
    $db_name_link_t = sprintf( $link_t, $nhref_t, "BV_N_", 
                               "ProtView", "%s" );
  }
  else{ $db_name_link_t = "%s" && warn( "Can't yet link id's for database '$database'!" ) }

  # End templates

  #--- CoordSystems ---
  # Get list of things we can map alignments to. TODO: move to function
  my @coord_systems;
  my $DBAdaptor = $DBCONNECTION->get_DBAdaptor('core', $species);
  my $CoordSystemAdaptor = $DBAdaptor->get_CoordSystemAdaptor;
  my( $toplevel, $seqlevel );
  foreach my $CoordSystem( @{$CoordSystemAdaptor->fetch_all} ){
    my $name = $CoordSystem->name;
    next if !($CoordSystem->is_default);
    if( $CoordSystem->rank == 1         ){ $toplevel = $name } #23.1 only
    if( $CoordSystem->is_sequence_level ){ $seqlevel = $name } #23.1 only
    push @coord_systems, $name;
  }

  #--- SORTING ---
  #my $sort = $CGI->param('sort') || "SCORE_DSC"; # Pre-23.1 format
  my $sort = $CGI->param('view_sort') || "evalue_dsc";
  my( $sort_by, $sort_dir ) = split( '_', $sort );
  my $spacer_column = ''; # We put in a spacer row when vals in this col change
  my $sorted = 0; # Whether we have found a valid sort
  foreach my $csname( @coord_systems ){
    next if $csname ne $sort_by;
    my $scode = sub{
      my( $up, $do ) = 
        ( $sort_dir eq 'asc' ? 
          ( $a->[1]->genomic_hit($csname)||'', $b->[1]->genomic_hit($csname)||'' ):
          ( $b->[1]->genomic_hit($csname)||'', $a->[1]->genomic_hit($csname)||'' ) );
      if( $up && $do ){
        return ( 3 * ($up->seq_region_name cmp $do->seq_region_name) +
                 1 * ($up->start           <=> $do->start ) )
      }
      if( $up ){ return -1 }
      if( $do ){ return 1  }
      return 0
    };
    @$alignments = sort{ &$scode } @$alignments;
    $spacer_column = $sort_by."_name";
    $sorted++;
    last
  }
  foreach my $stat qw( score evalue pvalue identity length ){
    last if $sorted;
    next if $stat ne $sort_by;
    my $method = $stat;
    if( $stat eq 'identity' ){ $method = 'percent_identity' }
    my $scode = sub{
      my( $up, $do ) = ( $sort_dir eq 'asc' ? 
                         ( $a->[1], $b->[1] ):
                         ( $b->[1], $a->[1] ) );
      return $up->$method <=> $do->$method;
    };
    @$alignments = sort{ &$scode } @$alignments;
    $sorted++;
    last;
  }
  foreach my $type qw( subject query ){
    last if $sorted;
    next if $type ne $sort_by;
    my $method = $type;
    if( $type eq 'subject' ){ $method = 'hit' }
    my $scode = sub{
      my( $up, $do ) = ( $sort_dir eq 'asc' ? 
                         ( $a->[1], $b->[1] ) : 
                         ( $b->[1], $a->[1] ) );
      return ( 3 * ( $up->$method->seq_id cmp $do->$method->seq_id ) +
               1 * ( $up->start           <=> $do->start ) )
    };
    @$alignments = sort{ &$scode } @$alignments;
    $spacer_column = $type."_name";
    $sorted++;
    last;
  }
  # End SORTING


  # Define HTML templates
  my $table_tmpl = qq(
<TABLE cellspacing=0 cellpadding=0>%s</TABLE>);
  my $row_tmpl = qq(
<TR>%s</TR>);
  my $spacer_cell = qq(
<TD height="5" width="5"><IMG src="/img/blank.gif" height="5" width="5" /></TD>);
  my $big_spacer_cell = qq(
<TD height="5" width="15"><IMG src="/img/blank.gif" height="5" width="15" /></TD>);
  my $vert_spacer_cell = qq(
<TD colspan="%s" height="5" width="1"><IMG src="/img/blank.gif" height="5" /></TD>);
  my $header_cell = qq(
<TD nowrap colspan="%s"><B><SMALL>%s</SMALL><B></TD> );
  my $header2_cell = qq(
<TD nowrap><I><SMALL>%s</SMALL><I></TD>);
  my $data_cell = qq(
<TD nowrap><SMALL>%s</SMALL></TD> );

  # Initialise 
  my @sections = ( ['Links','&nbsp'] );
  my @view_types = ( 'links' );
  my %view_labels = (orientation => 'Ori',
                     identity    => '%ID',
                     evalue      => 'E-val',
                     pvalue      => 'P-val' );

  # Loop for each table section
  # Have to combine both old (checkbox) and new (select) style parameters
  # to handle state smoothly during transfer period
  my @data_view_types = qw( query subject );
  #new style mappings from database
  my $sp = $result->database_species;
  my $DBAdaptor = $DBCONNECTION->get_DBAdaptor('core', $sp);
  my $CoordSystemAdaptor = $DBAdaptor->get_CoordSystemAdaptor;
  my( $toplevel, $seqlevel );
  my @coord_systems;
  foreach my $CoordSystem( @{$CoordSystemAdaptor->fetch_all} ){
      next if !($CoordSystem->is_default); 
    my $name = $CoordSystem->name;
    if( $CoordSystem->rank == 1         ){ $toplevel = $name } #map-old
    if( $CoordSystem->is_sequence_level ){ $seqlevel = $name } #map-old
    push @coord_systems, $name;
  }
  push @data_view_types, @coord_systems, 'stats';

  # Map old to new. TODO: remove after Ensembl 23.1 release
  my $oldstyle = 0;
  foreach my $type qw( query subject genome contig stats ){
    foreach my $col qw( name start end orientation 
                        score evalue identity length ){
      if( !  $CGI->param("view_${type}_${col}") or
          $CGI->param("view_${type}_${col}") == 0){ next }
      $CGI->param(-name=>"view_${type}_${col}",-value=>[]); # Out with the old
      my $_type = $type;
      if( $type eq 'genome' ){ $_type = $toplevel }
      if( $type eq 'contig' ){ $_type = $seqlevel }
      my @values = $CGI->param("view_${_type}");
      my %values = map{$_=>1} @values;
      if( $values{$col} ){ next } # Already have col
      push @values, $col;
      $CGI->param(-name=>"view_${type}", -value=>[@values]); # In with the new
      $oldstyle ++;
    }
  }
  if( $oldstyle ){ save_state() }

  my $flag = 0;
  # Decide which sections/columns user has requested
  foreach my $type ( @data_view_types ){
    my @cols = ();
    foreach my $col( $CGI->param("view_$type") ){
      $flag = 1;
      $col || next;
      my $label = $view_labels{$col} ? $view_labels{$col} : ucfirst( $col );
      push( @cols, $label );
      push( @view_types, "${type}_${col}" );
    }
    @cols || next;

    # Table header row
    my $section_label =  ucfirst($type);

    # Push on stack to use later
    push @sections, [ $section_label, @cols ];
  }
  if( $flag == 0 ) {
    foreach my $type ($data_view_types[1] ) {
      my @cols;
      foreach my $col (qw(name start end ori)) {
        push( @cols, ucfirst($col) );
        push( @view_types, "${type}_$col" );
      }
      push @sections, [ ucfirst($type), @cols ]
    }
  }
  # Construct callbacks used to populate each table data cell of a given type
  my %code;
  $code{links} = sub{
    my ( $hit, $hsp ) = @_;
    my $A_link = sprintf( $alink_t, $hit->token, $hsp->token, "ALIGN"    );
    $CGI->param('method') eq 'BLAT' ? my $S_link ="" : my $S_link = sprintf( $slink_t, $hit->token, $hsp->token, "SEQUENCE" );
    my $G_link = sprintf( $glink_t, $hit->token, $hsp->token, "GSEQUENCE" );

    my $gh = $hsp->genomic_hit;
#    my $ch = $hsp->contig_hit;
    my $context = 2000;
    my $C_link = ( $gh ? sprintf( $clink_t, $gh->seq_region_name, 
                                  $gh->start-$context,
                                  $gh->end  +$context, ) : '' );
#                   $ch ? sprintf( $clink_t, $ch->seq_region_name, 
#                                  $ch->start-$context,
#                                  $ch->end  +$context, ) : '' );
    return join( "&nbsp", $A_link, $S_link, $G_link, $C_link );
  };

  $code{query_name}        = sub{ $_[1]->query->seq_id };
  $code{query_orientation} = sub{ $_[1]->query->strand < 0 ? '-' : '+' };
  $code{query_start}       = sub{ $_[1]->query->start  };
  $code{query_end}         = sub{ $_[1]->query->end    };

  $code{subject_name} = sub{ my $name = $_[1]->hit->seq_id;
                              $name =~ s/^\w+://o;
                              sprintf( $db_name_link_t, $name, $name ) };

  $code{subject_orientation} = sub{ $_[1]->hit->strand < 0 ? '-' : '+' };
  $code{subject_start}     = sub{ $_[1]->hit->start  };
  $code{subject_end}       = sub{ $_[1]->hit->end    };


  # Used for mapview link
  my %chrs  = map{$_,1} @{$SPECIES_DEFS->ENSEMBL_CHROMOSOMES($species) || []};
  # Used to toggle between Location/View/Location/Overview
  my $gsize = 800000 * $SPECIES_DEFS->ENSEMBL_GENOME_SIZE($species) || 1;
  foreach my $csname( @coord_systems ){
    $code{$csname.'_name'} = sub{
      my $gh = $_[1]->genomic_hit($csname) || return 'No data';
      my $name =  $gh->seq_region_name || return '???';
      #warn( "=> $name $chrs{$name}" );
      if( $chrs{$name} ){ 
        return sprintf( $mapview_link_t, $name, $name ) 
      } elsif( $gh->seq_region_length > $gsize ){
        return sprintf( $cytoview_link_t, $name, $name );
      } else{
        return sprintf( $ctgview_link_t, $name, $name );
      }
    };
    $code{$csname.'_start'} = sub{
      my $gh = $_[1]->genomic_hit($csname) || return '';
      return $gh->start;
    };
    $code{$csname.'_end'} = sub{
      my $gh = $_[1]->genomic_hit($csname) || return '';
      return $gh->end;
    };
    $code{$csname.'_orientation'} = sub{
      my $gh = $_[1]->genomic_hit($csname) || return '';
      return $gh->strand < 0 ? '-' : '+';
    };
  }
  foreach my $stat qw( score evalue pvalue identity length ){
    my $method = $stat;
    if( $stat eq 'identity' ){ $method = 'percent_identity' }
    $code{"stats_".$stat} = sub{ my $val = $_[1]->$method;
                                 return defined $val ? $val : 'N/A' };
  }


  my @rows;
  push( @rows, 
        join( $big_spacer_cell, 
              ( map{ sprintf( $header_cell, 2*scalar(@$_)-3, $_->[0] ) } 
                @sections ) ) );
  push( @rows, 
        join( $spacer_cell,
              ( map{ sprintf( $header2_cell, $_ ) }
                map{ @{$_}[1..scalar( @$_ - 1 )] } @sections ) ) );
  
  my $spacer_row = sprintf( $vert_spacer_cell, scalar( @view_types ) );
  my $ruled_row  = '';
  
  push( @rows,$spacer_row );

  for( my $i=0; $i<@$alignments; $i++ ){
    my @cells = ();
    my $hit = $alignments->[$i]->[0] || next;
    my $hsp = $alignments->[$i]->[1];

    # Do we need a spacer before this row?
    if( $i>0 and $spacer_column and $code{$spacer_column} ){
      my $last = $alignments->[$i-1];
      if( ref($last) and
          $code{$spacer_column}->(@$last) ne 
          $code{$spacer_column}->($hit,$hsp) ){
        push @rows,$spacer_row;
      }
    }

#    if( $i>0 and $sort =~ /^GENO/ ){
#      my $last = $alignments->[$i-1];
#      if( ref($last) and
#          $code{genome_name}->(@$last) ne 
#          $code{genome_name}->($hit,$hsp) ){
#        push @rows,$spacer_row;
#      }
#    }
#    elsif( $i>0 and $sort =~ /^DBID/ ){
#      my $last = $alignments->[$i-1];
#      if( ref($last) and
#          $code{subject_name}->(@$last) ne 
#          $code{subject_name}->($hit,$hsp) ){
#        push @rows,$spacer_row;
#      }
#    }

    # Build an array of table data cells
    foreach my $type( @view_types ){
      if( ref( $code{$type} ) eq 'CODE' ){
        push @cells, $code{$type}->($hit,$hsp);
      }
      else{ push @cells, 'N/A' };
    }
    
    push( @rows, 
          join( $spacer_cell,
                ( map{ sprintf( $data_cell, $_ ) } @cells  ) ) );
  }

  my $table_html = sprintf( $table_tmpl, 
                            join('', 
                                 map{ sprintf( $row_tmpl, $_ ) }@rows ) );

  $main_panel->add_entry_header({LABEL=>$table_html});

}

#----------------------------------------------------------------------
#
sub populate_hit_summary{
  # Not currently used
  my $main_panel = shift;
  my $runnable   = shift;
  my $result     = shift;
  my $hit        = shift || die( "Need a hit!" );
  my $hsp        = shift;

  my( $run_id ) = $runnable->token =~ /([^\/]+)$/;
  my %link_args = ( ticket => $TICKET,
                    run_id => $run_id,
                    hit_id => $hit->token,
                    hsp_id => '');

 
  # Define templates
  my $link_tmpl = '<A href="/%s/%s?%s">%s</A>';

  my $i = 0;
  my $bold_hspid = $hsp ? $hsp->token : '';
  foreach my $hsp( $hit->hsps ){
    $i++;
    my $fmt_tmpl = '%s';
    my $hit_name = "HSP $i";
    my $chr_loc  = "Non-golden";
    if( my $gh = $hsp->genomic_hit ){
      $chr_loc = "Chr:".$gh->seq_region_name.".".$gh->start."-".$gh->end;
    }

    if( $bold_hspid eq $hsp->token ){
      $fmt_tmpl = '<B><SMALL>%s</SMALL></B>' 
    }

    else{ 
      $link_args{hsp_id} = $hsp->token;
      $hit_name = sprintf( $link_tmpl, 
                           $ENV{ENSEMBL_SPECIES},
                           $ENV{ENSEMBL_SCRIPT},
                           join( ';', ( map{$_."=".$link_args{$_}} 
                                    keys %link_args ) ),
                           $hit_name );
    }                           
    
    $main_panel->add_entry();
    $main_panel->add_form( $main_panel->get_entry_result
                           ( 
                            sprintf( $fmt_tmpl, $hit_name ), 
                            sprintf( $fmt_tmpl, $chr_loc  ),
                            '&nbsp;',
                            sprintf( $fmt_tmpl, "Score: " . $hsp->score ),
                           ) 
                         ); 
  }
}

#----------------------------------------------------------------------
#
sub hsp_info_string{
  my ( $run, $res, $hit, $hsp ) = @_;
  $hsp or die( "Cannot hsp_info_string without HSP object" );

  my $is_genomic = $hsp->genomic_hit ? 1 : 0;

  my( $m_id ) =( sort{ $b<=>$a } 
                      map{ length( $_ ) } 
                      ( $hsp->query->seq_id, 
                        $hsp->hit->seq_id, 
                        $is_genomic && $hsp->genomic_hit->seq_region_name ) );
  my( $m_fr ) =( sort{ $b<=>$a } 
                      map{ length( $_ ) } 
                      ( $hsp->query->start, 
                        $hsp->hit->start, 
                        $is_genomic && $hsp->genomic_hit->start ) );
  my( $m_ed ) = ( sort{ $b<=>$a } 
                      map{ length( $_ ) } 
                      ( $hsp->query->end, 
                        $hsp->hit->end, 
                        $is_genomic && $hsp->genomic_hit->end ) );

  # Define templates
  my $html_tmpl = qq(
<PRE><SMALL>Query location     : %-${m_id}.${m_id}s %${m_fr}d to %${m_ed}d (%s)
Database location  : %-${m_id}.${m_id}s %${m_fr}d to %${m_ed}d (%s)
Genomic location   : %-${m_id}.${m_id}s %${m_fr}d to %${m_ed}d (%s)

Alignment score    : %s
E-value            : %s
Alignment length   : %s
Percentage identity: %0.2f </PRE></SMALL>
);

  return sprintf( $html_tmpl,
                  $hsp->query->seq_id,
                  $hsp->query->start,
                  $hsp->query->end,
                  $hsp->query->strand < 0 ? '-' : '+',
                  $hsp->hit->seq_id,
                  $hsp->hit->start,
                  $hsp->hit->end,
                  $hsp->hit->strand < 0 ? '-' : '+',
                  $is_genomic ? $hsp->genomic_hit->seq_region_name : '',
                  $is_genomic ? $hsp->genomic_hit->start  : '',
                  $is_genomic ? $hsp->genomic_hit->end    : '',
                  $is_genomic ? $hsp->genomic_hit->strand < 0 ? '-' : '+' : '',
                  $hsp->score,
                  $hsp->evalue,
                  $hsp->length,
                  $hsp->percent_identity );
}

#----------------------------------------------------------------------
#
sub populate_hsp_alignment{
  my $main_panel = shift;
  my ( $run, $res, $hit, $hsp ) = @_;

  my $html_tmpl = qq(<PRE><SMALL>
%s </SMALL></PRE>);

  $main_panel->add_entry();
  $main_panel->add_form
    ( $main_panel->get_form_label
      ( sprintf( $html_tmpl,
                 alignment_string($hsp) ) ) );
}
#----------------------------------------------------------------------
#
sub alignment_string{
  my $hsp = shift;
  my $query = $hsp->query;
  my $sbjct = $hsp->hit;
   
  # Space to reserve for the numbering at the line start
  my $seq_cols = 60;
  my( $num_length ) = sort{ $b<=>$a } ( $query->start,
                                        $query->end,
                                        $sbjct->start,
                                        $sbjct->end );
  $num_length = length( $num_length );
   
  # Templates for the lines
  my $qtmpl = "Query: %${num_length}d %s %d\n";
  my $xtmpl = ( " " x ( $num_length + 8 ) ) .  "%s\n";
  my $htmpl = "Sbjct: %${num_length}d %s %d\n";
   
  # Divide the alignment strings onto lines
  my $rows = ( ( length($hsp->query_string) - 1 ) / $seq_cols ) + 1;
  my @qlines = unpack( "a$seq_cols" x $rows, $hsp->query_string );
  my @xlines = unpack( "a$seq_cols" x $rows, $hsp->homology_string );
  my @hlines = unpack( "a$seq_cols" x $rows, $hsp->hit_string );
   
  # Things needed for counting; DNA|peptide
  my $qmultiplier = ( ( $query->end - $query->start ) /
                      ( $sbjct->end - $sbjct->start ) );
  my $smultiplier;
  if( $qmultiplier < 0.5  ){ $qmultiplier = 1; $smultiplier=3 }
  elsif( $qmultiplier > 2 ){ $qmultiplier = 3; $smultiplier=1 }
  else                     { $qmultiplier = 1; $smultiplier=1 }
   
  # More counting things; strand
  my $qstrand = $query->strand < 0 ? -1 : 1;
  my $sstrand = $sbjct->strand < 0 ? -1 : 1;
  my( $qstart, $qryend ) = $query->strand < 0 ?
     ( $query->end, $query->start) : ( $query->start, $query->end );
  my( $hstart, $sbjend ) = $sbjct->strand < 0 ?
    ( $sbjct->end, $sbjct->start ) : ( $sbjct->start, $sbjct->end );
   
  # Generate text for each line-triplet
  my @lines;
  for( my $i=0; $i<@qlines; $i++ ){
   
    my $qseq = $qlines[$i];
    my $hseq = $hlines[$i];
    my $qgaps = $qseq =~ tr/-/-/; # Count gaps
    my $hgaps = $hseq =~ tr/-/-/; # Count gaps
    my $qend = $qstart +((($seq_cols-$qgaps)*$qmultiplier-1)*$qstrand); 
    my $hend = $hstart +((($seq_cols-$hgaps)*$smultiplier-1)*$sstrand );
    if( $i == @qlines - 1 ){
      $qend = $qryend;
      $hend = $sbjend;
    }
    my $line = '';
    $line .= sprintf( $qtmpl, $qstart, $qseq, $qend );
    $line .= sprintf( $xtmpl, $xlines[$i] );
    $line .= sprintf( $htmpl, $hstart, $hseq, $hend );
    push @lines, $line;
    $qstart = $qend + ( 1 * $qstrand );
    $hstart = $hend + ( 1 * $sstrand );
  }
   
  return join( "\n", @lines );
}
#----------------------------------------------------------------------
#
sub populate_query_markup{
  my $main_panel = shift;
  $main_panel->add_entry();
  my $html = query_markup_string( @_ );
  $main_panel->add_form( $main_panel->get_form_label( $html ) );
}


#----------------------------------------------------------------------
# Dumps the query seq
sub query_markup_string{
  my $run = shift ||return 'Need a Search obj';
  my $hit = shift;
  my $hsp = shift ||return 'Need a HSP obj';

  my $seq  = $run->seq();
  my @hsps = ( $hit ? $hit->hsps : $hsp );

  # Define some maps
  my %colour_map = (D=>'black',
                    M=>'darkblue',
                    S=>'darkred');

  my %cigar_map = ( 'DD' => 'D',
                    'DM' => 'M',
                    'MD' => 'M',
                    'MM' => 'M',
                    'SD' => 'S',
                    'SM' => 'S',
                    'SS' => 'S',
                    'DS' => 'S',
                    'MS' => 'S' );
  # End maps

  my $html;

  $html .= qq( 
<span style="font-family: 'Courier new', monospace; font-size:small; color:$colour_map{'S'}">THIS STYLE:</span> Matching bases for selected HSP<BR> );

  if( @hsps > 1 ){
    $html .= qq( 
<span style="font-family: 'Courier new', monospace; font-size:small; color:$colour_map{'M'}">THIS STYLE:</span></FONT> Matching bases for other HSPs in selected hit<BR> );
  }
  $html .= qq(
<PRE><span style="font-family: 'Courier new', monospace; font-size:small">);

  $html .= "&gt;".$seq->display_id."\n";
#  my $start = $hsp->query->start;
#  my $end   = $hsp->query->end;

  my $chars  = 60;
  my $length = $seq->length;
  my $hsp_id = $hsp ? $hsp->token : ''; 

  # Create string mask representing formats for the query sequence
  my $sel_hsp;
  my $strmask = 'D' x $length; # Initially unmatched
  foreach my $ihsp( @hsps ){
    my $start  = $ihsp->query->start - 1;
    my $end    = $ihsp->query->end;    
    my $lnth   = $end - $start;
    substr( $strmask, $start, $lnth ) = 'M' x $lnth; # Mask the matches
    if( ! $sel_hsp and $ihsp->token eq $hsp_id ){ $sel_hsp = $hsp }
  }
  if( my $ihsp = $sel_hsp ){
    my $start  = $ihsp->query->start - 1;
    my $end    = $ihsp->query->end;
    my $lnth   = $end - $start;
    substr( $strmask, $start, $lnth ) = 'S' x $lnth; # Mask the selected match
  }

  # Split the string mask into same-letter chunks, 
  # and create a cigar string from the chunks
  my $f = 0; # flip-flop
  my @hit_cigar = map{
    ($f=1-$f) ? [ length($_), substr($_,0,1) ] : ()
  } $strmask =~ /((.)\2*)/g;

  # Create the marked-up FASTA-like string from the sequence and cigar mask
  my $i = 0;
  while( $i < $length ){
    my $j = 0;
    while( $j < $chars ){
      my $cig = shift @hit_cigar || last;

      my( $n, $t ) = @$cig;
      if( ! $n ){ next }

      if( $n > $chars-$j ){
        unshift( @hit_cigar, [ $n-($chars-$j), $t ] ); 
        $n = $chars-$j;
      }
      $html .= qq(<span style="color:$colour_map{$t}">);
      $html .= $seq->subseq( $i+$j+1, $i+$j+$n);
      $html .= qq(</span>);
      $j += $n;
    }
    $html .= "\n";
    $i += $chars;
  }
  $html .= "</span></pre>\n";
  return $html;
}

#----------------------------------------------------------------------
# Dumps the genome markup string
sub genome_markup_string{
  my $run = shift                 || return 'Need a Search obj';
  my $hit = shift;
  my $hsp = shift                 || return 'Need a HSP obj';
  $hsp->can('genomic_hit')        || return "HSP cannot genomic_hit";
  my $feature = $hsp->genomic_hit || return "No genomic_hit";

  # Get database adaptor (can't be stored)
  my $sp = $run->result->database_species;
  my $db_adaptor = $DBCONNECTION->get_DBAdaptor('core', $sp);

  # List all coord systems, which are valid for this hsp
  my $csadaptor = $db_adaptor->get_CoordSystemAdaptor;
  my @coord_systems = map{$_->name} @{$csadaptor->fetch_all};
  @coord_systems = grep{ $hsp->genomic_hit($_) } @coord_systems;

  # What things can we mark up?
  my %databases = %{$SPECIES_DEFS->databases($sp)};
  my @exontype_options;
  my @snptype_options;
  if( $databases{DATABASE_CORE} ){
    if ($sitetype eq 'Vega') {
      push @exontype_options, [core=>'Vega exons'];
    } else {
      push @exontype_options, [ 'core' => 'Ensembl exons'], [ 'prediction' =>'Ab-initio exons'] ;
    }
  }
  push @exontype_options, ['vega'   =>'VEGA exons'    ] if $databases{DATABASE_VEGA};
  push @exontype_options, ['estgene'=>'EST-gene exons'] if $databases{DATABASE_OTHERFEATURES};
  push @exontype_options, ['off'=>'No exon markup'    ];

  # Options input form
  my $run_id = $CGI->param("run_id");
  my $hit_id = $CGI->param("hit_id");
  my $hsp_id = $CGI->param("hsp_id");

  my $flank5 = $CGI->param("display_flank5");
  if( ! defined( $flank5 ) ){ $flank5 = 300 }
  $CGI->param(-name=>'display_flank5',-value=>$flank5);
  my $flank5_form =  EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'TEXT', 
      -name=>'display_flank5',
      -size=>5, 
      -maxlength=>5 );

  my $flank3 = $CGI->param("display_flank3");
  if( ! defined( $flank3 ) ){ $flank3 = 300 }
  $CGI->param(-name=>'display_flank3',-value=>$flank3);
  my $flank3_form =  EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'TEXT', 
      -name=>'display_flank3',
      -size=>5, 
      -maxlength=>5 );

  # check we're using a coordinate system that is valid for this HSP
  # It's quite possible (due to CGI param freezing) that the CGI param
  # might not be valid for the current HSP, but was for the previous one
  # viewed.
  my $csystem = $CGI->param('display_csystem');
  $csystem = $coord_systems[0] unless $hsp->genomic_hit($csystem);

  $CGI->param(-name=>'display_csystem',-value=>$csystem);
  my $csystem_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_csystem',
      -options=>[map{[$_=>ucfirst($_)]} @coord_systems] );

  my $orientation = $CGI->param('display_orientation') || 'hsp';
  $CGI->param(-name=>'display_orientation',-value=>$orientation);
  my @ori_options = ( [fwd=>'Forward relative to coordinate system'],
                      [rev=>'Reverse relative to coordinate system'],
                      [hsp=>'Forward relative to selected alignment'], );
  my $orientation_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_orientation',
      -options=>[@ori_options] );

  my $alignmenttype = $CGI->param("display_alignmenttype") || 'all';
  $CGI->param(-name=>'display_alignmenttype', -value=>$alignmenttype);
  if( $alignmenttype eq 'off' ){ $alignmenttype = '' }
  my @alignmenttype_options = ( [all=>'All alignments'],
                                [sel=>'Selected alignment only'],
                                [off=>'No alignment markup'] );
  my $alignmenttype_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_alignmenttype',
      -options=>[@alignmenttype_options] );

  my $alignmentori = $CGI->param("display_alignmentori" ) || 'all';
  $CGI->param(-name=>'display_alignmentori', -value=>$alignmentori);
  if( $alignmentori eq 'off' ){ $alignmentori = '' }
  my @alignmentori_options = ( [fwd=>'Forward only'],
                               [rev=>'Reverse only'],
                               [all=>'Both orientations'], );
  my $alignmentori_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_alignmentori',
      -options=>[@alignmentori_options] );

  my $exontype = $CGI->param("display_exontype") || 'core';
  $CGI->param(-name=>'display_exontype', -value=>$exontype);
  if( $exontype eq 'off' ){ $exontype = '' }
  my $exontype_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_exontype',
      -options=>[@exontype_options] );

  my $exonori = $CGI->param("display_exonori" ) || 'all';
  $CGI->param(-name=>'display_exonori', -value=>$exonori);
  if( $exonori eq 'off' ){ $exonori = '' }
  my @exonori_options = ( [fwd=>'Forward only'],
                          [rev=>'Reverse only'],
                          [all=>'Both orientations'], );
  my $exonori_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_exonori',
      -options=>[@exonori_options] );


  my $snptype = '';
  my $snptype_form = '';
  if( @snptype_options > 1 ){
    $snptype = $CGI->param("display_snptype") || 'snp';
    $CGI->param(-name=>'display_snptype', -value=>$snptype);
    if( $snptype eq 'off' ){ $snptype = '' }
    $snptype_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
      ( -type=>'SELECT',
        -name=>'display_snptype',
        -options=>[@snptype_options] );
  }

  my $linenums = $CGI->param("display_linenums" ) || 'off';
  $CGI->param(-name=>'display_linenums', -value=>$linenums);
  if( $linenums eq 'off' ){ $linenums = '' }
  my @linenum_options = ( [seq=>'Relative to sequence'],
                          [gen=>'Relative to coordinate system'],
                          [off=>'No numbers']);
  my $linenums_form = EnsEMBL::Web::BlastView::Panel->_gen_base_form
    ( -type=>'SELECT',
      -name=>'display_linenums',
      -options=>[@linenum_options] );

  my $option_form = qq(
<form>
<input type="hidden" name="ticket" value=$TICKET>
<input type="hidden" name="_display" value="GSEQUENCE">
<input type="hidden" name="run_id" value="$run_id">
<input type="hidden" name="hit_id" value="$hit_id">
<input type="hidden" name="hsp_id" value="$hsp_id">
<table cellspacing=2 cellpadding=2 border=0>
 <tr>
  <td>5' Flanking sequence &nbsp;</td><td colspan='2'>$flank5_form (bp)</td>
 </tr>
 <tr>
  <td>3' Flanking sequence &nbsp;</td><td colspan='2'>$flank3_form (bp)</td>
 </tr>
 </tr>
  <td>Coordinate system &nbsp;</td><td colspan='2'>$csystem_form</td>
 </tr>
 </tr>
  <td>Orientation &nbsp;</td><td colspan='2'>$orientation_form</td>
 </tr>
 <tr>
  <td>Alignment markup &nbsp;</td><td colspan='2'>$alignmenttype_form$alignmentori_form</td>
 <tr>);

  if( $exontype_form ){ 
    $option_form .= qq(
 <tr>
  <td>Feature markup &nbsp;</td><td colspan='2'>$exontype_form$exonori_form</td>
 <tr> );
  }

  if( $snptype_form ){ 
    $option_form .= qq(
 <tr>
  <td>SNP markup &nbsp;</td><td colspan='2'>$snptype_form</td>
 <tr>);
  }

  $option_form .= qq(
  <td>Line numbering &nbsp;</td><td colspan='2'>$linenums_form</td>
 </tr>
</table>
<input type="submit" value="update">
</form>
);
  my $output_string = ''; 
  $output_string .= &update_selection( $option_form );

  # Define a formatting styles. These correspond to name/value pairs
  # in HTML style attributes
  my $style_tmpl = qq(<span style="%s" title="%s">%s</span>);
  my %styles = ( DEFAULT =>{},
                 blast_s =>{'color'           =>'darkred',
                            'font-weight'     =>'bold'},
                 blast   =>{'color'           =>'darkblue',
                            'font-weight'     =>'bold'},
                 exon    =>{'background-color'=>'blanchedalmond'},
                 snp     =>{'background-color'=>'#caff70'},
                 snpexon =>{'background-color'=>'#7fff00'} );

  # Print out a format key using the above styles
  my @keys = qw( blast_s blast exon snp snpexon);
  my %key_text = (blast_s=>'Location of selected alignment',
                  blast  =>'Location of other alignments',
                  exon   =>'Location of Exons',
                  snp    =>'Location of SNPs',
                  snpexon=>'Location of exonic SNPs');
  my $key_tmpl = qq(<span style="font-family: 'Courier new', monospace; font-size:small"> $style_tmpl</span> %s<br>);
  foreach my $key( @keys ){
    if( ! $alignmenttype ){
       next if $key eq 'blast_s';
       next if $key eq 'blast';
    }
    if( $alignmenttype eq 'sel' ){
      next if $key eq 'blast';
    }
    if( ! $snptype ){
      next if $key eq 'snp';
      next if $key eq 'snpexon';
    }
    if( ! $exontype ){
      next if $key eq 'exon';
      next if $key eq 'snpexon';
    }

    my %istyles = %{$styles{$key}};
    my $itext   = $key_text{$key} || 'Unknown';
    my $style = join( ';',map{"$_:$istyles{$_}"} keys %istyles );
    $output_string .= sprintf( $key_tmpl, $style, "", "THIS STYLE:", $itext );
  }

  # Get slice corresponding to top level and  selected coord system
  # Need to reinstate slice adaptor, as this is lost during storage
  my $sl_adaptor = $db_adaptor->get_SliceAdaptor;
  my $tlfeature  = $hsp->genomic_hit;
  my $feature    = $hsp->genomic_hit($csystem);
  my $tlslice    = $tlfeature->feature_Slice();
  my $slice      = $feature->feature_Slice();
  warn ">>> $slice <<<";
  $tlslice->adaptor( $sl_adaptor );
  $slice->adaptor( $sl_adaptor );
  eval { 
    my $T = $slice->get_seq_region_id;
  };
  if($@) {
    return "<p><b>Ill defined slice</b> - this slice does not belong to the current assembly - perhaps you are using an old blast ticket</p>";
  }
  # Apply orientation
  if( $orientation eq 'fwd' and $slice->strand < 0 ){
    $slice = $slice->invert;
    $tlslice = $tlslice->invert;
  } elsif( $orientation eq 'rev' and $slice->strand > 0 ){
    $slice = $slice->invert;
    $tlslice = $tlslice->invert;
  } elsif( $orientation eq 'hsp' and $feature->hstrand < 0 ) {
    $slice = $slice->invert;
    $tlslice = $tlslice->invert;
  }

  # Apply flanks
  $slice   = $slice->expand( $flank5, $flank3 );
  $tlslice = $tlslice->expand( $flank5, $flank3 );

  # Get slice variables here for efficiency
  my $sstrand = $slice->strand;
  my $sstart  = $slice->start;
  my $send    = $slice->end;
  my $slength = $slice->length;

  # Get all SearchFeatures for this slice from DB using BlastAdaptor
  my @alignments;
  if( $alignmenttype eq 'all' ){
    my $use_date = $hsp->use_date;
    my $bl_adaptor = &fetch_blast_adaptor;
    my @hsps = @{ $bl_adaptor->get_all_HSPs( "$TICKET!!$use_date", 
                                             $tlslice->seq_region_name, 
                                             $tlslice->start, 
                                             $tlslice->end ) };
    @alignments = map{$_->genomic_hit($csystem) || ()} @hsps;
  }
  elsif( $alignmenttype eq 'sel' ){
    @alignments = ( $feature );
  }
  #warn( "> ", $feature->seq_region_strand, " ",
  #      $feature->strand, " ", $feature->hstrand, " ", $slice->strand  );

  if( $alignmentori eq 'fwd' ){ # Only fwd strand alignments
    @alignments = grep{($_->strand * ($_->hstrand||1)) eq $slice->strand } @alignments
  } elsif(  $alignmentori eq 'rev' ){ # Only rev strand alignments
    @alignments = grep{($_->strand * ($_->hstrand||1)) ne $slice->strand } @alignments
  }

  # Get all exons for this slice
  my @exons = ();
  my @snps  = ();
  warn( "$sp - $exontype ", $slice->name );
  if( $exontype eq 'core'){
    @exons = @{$slice->get_all_Exons};
  } elsif( $exontype eq 'prediction' ){
    @exons = (
      grep{ $_->seq_region_start<=$send && $_->seq_region_end>=$sstart }
      map { @{$_->get_all_Exons } } @{$slice->get_all_PredictionTranscripts }
    );
  } elsif( $exontype eq 'vega'){
    my $db_adaptor = $DBCONNECTION->get_DBAdaptor('vega', $sp);
    $slice->adaptor->db->add_db_adaptor($exontype,$db_adaptor);
    @exons = (
      grep{ $_->seq_region_start<=$send && $_->seq_region_end>=$sstart }
      map{@{$_->get_all_Exons } } @{$slice->get_all_Genes('',$exontype) }
    );
  } elsif( $exontype eq 'estgene'){
    my $db_adaptor = $DBCONNECTION->get_DBAdaptor('est', $sp);
    $slice->adaptor->db->add_db_adaptor($exontype,$db_adaptor);
    @exons = (
      grep{ $_->seq_region_start<=$send && $_->seq_region_end>=$sstart }
      map{@{$_->get_all_Exons } } @{$slice->get_all_Genes('',$exontype) }
    );
  }

  if( $exonori eq 'fwd' ){ # Only fwd strand exons
    @exons = grep{$_->strand > 0} @exons
  } elsif( $exonori eq 'rev' ){ #Only rev strand exons
    @exons = grep{$_->strand < 0} @exons
  }

  # Sequence markup uses a 'variable-length bin' approach.
  # Each bin has a format.
  # Allows for feature overlaps - combined formats.
  # Bins start at feature starts, and 1 + feature ends.
  # Allow for cigar strings - these split alignments into 'mini-features'.
  # A feature can span multiple bins

  # Get a unique list of all possible bin starts
  my %all_locs = ( 1=>1, $slength+1=>1 );
  foreach my $feat( @exons , @alignments ){ # 
    my $cigar;
    if( $feat->can('cigar_string') ){ $cigar = $feat->cigar_string }
    $cigar ||= $feat->length . "M"; # Fake cigar; matches length of feat
    my $fstart  = $feat->seq_region_start - $sstart + 1;
    my $fstrand = $feat->seq_region_strand;
    if( $fstart > $slength+1 ){ $fstart = $slength+1 }
    $fstart > 0 ? $all_locs{$fstart} ++ : $all_locs{1} ++;
    my @segs = ( $cigar =~ /(\d*\D)/g ); # Split cigar into segments
    if( $fstrand < 1 ){ @segs = reverse( @segs ) } # if -ve ori, invert cigar
    foreach my $seg( @segs ){
      my $type = chop( $seg ); # Remove seg type - length remains
      next if( $type eq 'D' ); # Ignore deletes
      $fstart += $seg;
      if( $fstart > $slength+1 ){ $fstart = $slength+1 }
      $fstart > 0 ? $all_locs{$fstart} ++ : $all_locs{1} ++;
    }
  }
  foreach my $snp( @snps ){
    my $fstart = $snp->start;
    if( $sstrand < 0 ){ $fstart = $slength - $fstart + 1} # SNP strand bug
    $all_locs{$fstart} ++;
    $all_locs{$fstart+1} ++;
  }
  
  # Initialise bins; lengths and formats
  my @bin_locs = sort{ $a<=>$b } ( keys %all_locs );
  my %bin_idx; # A hash index of bin start locations vs pos in index
  my @bin_markup;
  for( my $i=0; $i<@bin_locs; $i++ ){
    my $bin_start  = $bin_locs[$i];
    my $bin_end    = $bin_locs[$i+1] || last;
    my $bin_length = $bin_end - $bin_start;
    #$bin_length || next;
    $bin_idx{$bin_start} = $i;
    $bin_markup[$i] = [ $bin_length, {} ]; # Init bin, and flag as empty
  }

  # Populate bins with exons
  my %estyles = %{$styles{exon}};
  foreach my $feat( @exons ){
    my $fstart = $feat->seq_region_start - $sstart + 1;
    my $fend   = $feat->seq_region_end - $sstart + 2;
    my $idx_start = $fstart > 0 ? $bin_idx{$fstart} : $bin_idx{1};
    my $idx_end   = ( $bin_idx{$fend} ? $bin_idx{$fend} : @bin_markup )-1;
    # Add styles + title to affected bins
    my $title = $feat->stable_id;
    foreach my $bin( @bin_markup[ $idx_start..$idx_end ] ){
      # Add styles to bins
      map{ $bin->[1]->{$_} = $estyles{$_} } keys %estyles;
      # Add stable ID to bin title
      $bin->[2] = join( ' : ', $bin->[2] || (), $title );
    }
    #map{ substr( $_->[1], 1, 1 ) = 'Y' } 
    #  @bin_markup[ $idx_start..$idx_end ] # Flag matched bins!
  }
  # Populate bins with snps
  my %snpstyles = %{$styles{snp}};
  my %snpexonstyles = %{$styles{snpexon}};
  foreach my $snp( @snps ){
    my $fstart = $snp->start;
    if( $sstrand < 0 ){ $fstart = $slength - $fstart + 1 } # SNP strand bug
    my $idx_start = $bin_idx{$fstart};
    my $bin = $bin_markup[$idx_start];
    my %usestyles = ( $bin->[1]->{'background-color'} ? 
                      %snpexonstyles : %snpstyles );
    map{ $bin->[1]->{$_} = $usestyles{$_} } keys %usestyles;
    my $allele = $snp->alleles;
    if( $snp->strand != $sstrand ){ 
      $allele = reverse( $allele );
      $allele =~ tr/ACGTacgt/TGCAtgca/;
    }
    $bin->[2] = $allele || '';
  }

  # Populate bins with blast align features
  foreach my $feat( @alignments ){
    my $fstart  = $feat->seq_region_start - $sstart + 1;
    my $fstrand = $feat->seq_region_strand;
    my @segs = ( $feat->cigar_string =~ /(\d*\D)/g ); # Segment cigar
    if( $fstrand < 1 ){ @segs = reverse( @segs ) } # if -ve ori, invert cigar
    foreach my $seg( @segs ){
      my $type = chop( $seg ); # Remove seg type - length remains
      next if( $type eq 'D' ); # Ignore deletes
      my $fend = $fstart + $seg;
      my $idx_start = $fstart > 0 ? $bin_idx{$fstart} : $bin_idx{1};
      my $idx_end   = ( $bin_idx{$fend} ? $bin_idx{$fend} : @bin_markup ) -1;
      $fstart += $seg;
      next if $type ne 'M'; # Only markup matches
      # Add styles to affected bins
      my %istyles = %{$styles{blast}};
      foreach my $bin( @bin_markup[ $idx_start..$idx_end ] ){
        map{ $bin->[1]->{$_} = $istyles{$_} } keys %istyles;
      }
      #map{ substr( $_->[1], 0, 1 ) = $type eq 'M' ? 'Y' : 'N' } 
      #  @bin_markup[ $idx_start..$idx_end ] # Flag matched bins!
    }
  }
  # Populate bins with selected blast align features
  if( @alignments ){
    foreach my $feat( $feature ){
      my $fstart  = $feat->seq_region_start - $sstart + 1;
      my $fstrand = $feat->seq_region_strand;
      my @segs = ( $feat->cigar_string =~ /(\d*\D)/g ); # Segment cigar
      if( $fstrand < 1 ){ @segs = reverse( @segs ) } # if -ve ori, invert cigar
      foreach my $seg( @segs ){
        my $type = chop( $seg ); # Remove seg type - length remains
        next if( $type eq 'D' ); # Ignore deletes
        my $fend = $fstart + $seg;
        my $idx_start = $fstart > 0 ? $bin_idx{$fstart} : $bin_idx{1};
        my $idx_end   = ( $bin_idx{$fend} ? $bin_idx{$fend} : @bin_markup ) -1;
        $fstart += $seg;
        next if $type ne 'M'; # Only markup matches
        # Add styles to affected bins
        my %istyles = %{$styles{blast_s}};
        foreach my $bin( @bin_markup[ $idx_start..$idx_end ] ){
          map{ $bin->[1]->{$_} = $istyles{$_} } keys %istyles;
        }
      }
    }
  }
  
  # If strand is -ve ori, invert bins
  if( $sstrand < 1 ){ @bin_markup = reverse( @bin_markup ) }

  # Turn the 'bin markup' style hashes into style templates 
  foreach my $bin( @bin_markup ){
    my %istyles = %{$bin->[1]};
    my $style = join( ';',map{"$_:$istyles{$_}"} keys %istyles );
    my $title = $bin->[2] || '';
    $bin->[1] = sprintf( $style_tmpl, $style, $title, '%s' );
  }

  # Create the marked-up FASTA-like string from the sequence and cigar mask
  my $seq    = $slice->seq;
  my $chars  = 60;
  my $length = length( $seq );

  my $markedup_seq = '';
  my $numlength = '';
  if( $linenums eq 'gen' ){ $numlength = length( $send ) }
  if( $linenums eq 'seq' ){ $numlength = length( $length ) }
  my $numtmpl   = "%${numlength}d ";
  my $i = 0;
  while( $i < $length ){

    if( $linenums ){ # Deal with line numbering
      my $num = $i + 1;
      if( $linenums eq 'gen' ){ 
        if( $sstrand > 0 ){ $num = $sstart + $num - 1 }
        else              { $num = $send   - $num + 1 }
      };
      $markedup_seq .= sprintf($numtmpl, $num ) 
    }

    my $j = 0;
    while( $j < $chars ){
      my $markup = shift @bin_markup|| last;
      my( $n, $tmpl ) = @$markup; # Length and template of markup
      if( ! $n ){ next }
      if( $n > $chars-$j ){ # Markup extends over line end. Adapt for next line
        unshift( @bin_markup, [ $n-($chars-$j), $tmpl ] ); 
        $n = $chars-$j;
      }
      $markedup_seq .= sprintf( $tmpl, substr( $seq, $i+$j, $n) );
      $j += $n;
    }
    #$markedup_seq .= "\n".substr( $seq, $i+1, $chars ); # DEBUG
    $i += $chars;
    if( $linenums ){
      my $incomplete = $chars-$j;
      $markedup_seq .= ' ' x $incomplete;
      my $num = $i - $incomplete;
      if( $linenums eq 'gen' ){ 
        if( $sstrand > 0 ){ $num = $sstart + $num - 1 }
        else              { $num = $send   - $num + 1 }
      };
      $markedup_seq .= " $num"; 
    };
    $markedup_seq .= "\n";
  }
  return sprintf( qq($output_string
<PRE><span style="font-family: 'Courier new', monospace, Courier; font-size=small">&gt;%s
%s</span></PRE>), $slice->name, $markedup_seq);
}

#----------------------------------------------------------------------
# Dumps a plain text blast file
sub print_raw_format{
  print "Content-type: text/plain\n\n";

#  my $res_id = $CGI->param('result') || ( print "Need a result ID\n" and return );
#  my( $runnable ) = $BLAST->runnables_like( -result_token=>$res_id );
  my $run_token = $CGI->param('runnable') || ( print "Need a runnable token\n" and return );
  my($part1,$part2) = $BLAST->token =~ /^(.{6})(.*)$/;
  my $path = $SPECIES_DEFS->ENSEMBL_TMP_DIR_BLAST."/$part1/$part2/$run_token";
  warn ">>>> $path"; 
  my( $runnable ) = $BLAST->runnables_like( -token => $path );

  unless( $runnable ){
    print "No blast result for ticket $TICKET, ID $run_token\n";
    return;
  }

  -e $runnable->reportfile or
    print "Runnable not yet completed. No results available\n" and return;

  print $runnable->report();
  return 1;
}

#----------------------------------------------------------------------
sub log_blast_error{
  my $token = shift || 'UNKNOWN';
  my $msg   = shift || 'Unknown error';
  $msg = "*** BLAST ERROR: $token ***\n".$msg;
  warn( $msg );
  my $logfile = $SPECIES_DEFS->ENSEMBL_SERVERROOT."/logs/blast_error.log";
  open LOG, ">>$logfile";
  print LOG $msg;
  close LOG;
  warn( $msg );
  return 1;
}

use Bio::EnsEMBL::Registry;
Bio::EnsEMBL::Registry->disconnect_all;

1;
