[Bio] / FigWebServices / index.cgi Repository:
ViewVC logotype

View of /FigWebServices/index.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.69 - (download) (annotate)
Fri Apr 15 18:13:18 2005 UTC (14 years, 11 months ago) by golsen
Branch: MAIN
Changes since 1.68: +8 -7 lines
New subsystems code is now the official code.

### start

use FIG;

use strict;

use FIGjs        qw( toolTipScript );
use GenoGraphics qw( render );
use IPC::Open2   qw( open2 );

use POSIX;
use HTML;

use CGI;
my $cgi = new CGI;

my $fig;
eval {
    $fig = new FIG;
};

if ($@ ne "")
{
    my $err = $@;

    my(@html);

    push(@html, $cgi->p("Error connecting to SEED database."));
    if ($err =~ /Could not connect to DBI:.*could not connect to server/)
    {
	push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
    }
    else
    {
	push(@html, $cgi->pre($err));
    }
    &HTML::show_page($cgi, \@html, 1);
    exit;
}

my($map,@orgs,$user,$map,$org,$made_by,$from_func,$to_func);

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/index_parms`));
    $cgi = $VAR1;
#   print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
	if (open(TMP,">/tmp/index_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

$ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};

my $html = [];


my($pattern,$seq_pat,$tool,$ids,$subsearch);
my $user = $cgi->param('user');
if (! $user) { $user = "" }

if ($cgi->param('Search for Genes Matching an Occurrence Profile or Common to a Set of Organisms'))
{
    unshift @$html, "<TITLE>The SEED: Phylogenetic Signatures</TITLE>\n";
    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "user=$user";
    my @out = `./sigs.cgi`;
    print @out;
    exit;
}
#-----------------------------------------------------------------------
#  Statistics for a single organism
#-----------------------------------------------------------------------
elsif ($cgi->param('statistics'))
{
    @orgs = $cgi->param('korgs');
    @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
    if (@orgs != 1)
    {
	push(@$html,$cgi->h1('Please select a single organism to get statistcs'));
    }
    else
    {
	$ENV{"REQUEST_METHOD"} = "GET";
	$ENV{"QUERY_STRING"} = "user=$user&genome=$orgs[0]";
	my @out = `./genome_statistics.cgi`;
	print @out;
	exit;
    }
}
#-----------------------------------------------------------------------
#  Locate PEGs in Subsystems
#-----------------------------------------------------------------------
elsif ($cgi->param('Find PEGs') && ($subsearch = $cgi->param('subsearch')))
{
    my $genome = $cgi->param('genome');
    my (@pegs,$peg);

    my @poss = $fig->by_alias($subsearch);
    if (@poss > 0)    { $subsearch = $poss[0] }

    if ($subsearch =~ /(fig\|\d+\.\d+\.peg\.\d+)/)
    {
#	handle searching for homologs that occur in subsystems
	$peg = $1;
	@pegs = ($peg);
	push(@pegs,map { $_->id2 } $fig->sims( $peg, 500, 1.0e-10, "fig"));
	if ($genome) 
	{
	    my $genomeQ = quotemeta $genome;
	    @pegs = grep { $_ =~ /^fig\|$genomeQ/ } @pegs;
	}
    }
    else
    {
#	handle searching for PEGs with functional role in subsystems
	@pegs = $fig->seqs_with_role($subsearch,"master",$genome);
    }
    
    print $cgi->header;
    if (@pegs == 0)
    {
	print $cgi->h1("Sorry, could not even find PEGs to check");
    }
    else
    {
	my(@pairs,$pair,@sub);
	@pairs = map { $peg = $_; 
		      @sub = $fig->peg_to_subsystems($peg);
		      map { [$peg,$_] } @sub } @pegs;
	if (@pairs == 0)
	{
	    print $cgi->h1("Sorry, could not map any PEGs to subsystems");
	}
	else
	{
	    my($uni,$uni_func);
	    my $col_hdrs = ["PEG","Genome","Function","UniProt","UniProt Function","Subsystem"];
	    my $tab = [ map { $pair = $_; $uni = $fig->to_alias($pair->[0],"uni");
			      ($uni,$uni_func) = $uni ? (&HTML::uni_link($cgi,$uni),scalar $fig->function_of($uni)) : ("","");
			      [&HTML::fid_link($cgi,$pair->[0]),
			       $fig->org_of($pair->[0]),
			       scalar $fig->function_of($pair->[0]),
			       $uni,$uni_func,
			       &HTML::sub_link($cgi,$pair->[1])] } @pairs];
	    print &HTML::make_table($col_hdrs,$tab,"PEGs that Occur in Subsystems");
	}
    }
    exit;
}
#-----------------------------------------------------------------------
#  Align Sequences
#-----------------------------------------------------------------------
elsif ($cgi->param('Align Sequences'))
{
    my $seqs = $cgi->param('seqids');
    $seqs =~ s/^\s+//;
    $seqs =~ s/\s+$//;
    my @seq_ids = split(/[ \t,;]+/,$seqs);
    if (@seq_ids < 2)
    {
	print $cgi->header;
	print $cgi->h1("Sorry, you need to specify at least two sequence IDs");
    }
    else
    {
	$ENV{"REQUEST_METHOD"} = "GET";
	$_ = join('&checked=',@seq_ids);
	$ENV{"QUERY_STRING"} = "user=$user&align=1&checked=" . $_;
	my @out = `./fid_checked.cgi`;
	print join("",@out);
    }
    exit;
}
#-----------------------------------------------------------------------
#  Search (text) || Find Genes in Org that Might Play the Role
#-----------------------------------------------------------------------
elsif ( ( $pattern = $cgi->param('pattern') )
     && ( $cgi->param('Search')
       || $cgi->param('Search genome selected below')
       || $cgi->param('Search Selected Organisms')
       || $cgi->param('Find Genes in Org that Might Play the Role')
        )
      )
{
    #  Remove leading and trailing spaces from pattern -- GJO:
    $pattern =~ s/^\s+//;
    $pattern =~ s/\s+$//;
    if ($cgi->param('Find Genes in Org that Might Play the Role') &&
	(@orgs = $cgi->param('korgs')) && (@orgs == 1))
    {
	unshift @$html, "<TITLE>The SEED: Genes in that Might Play Specific Role</TITLE>\n";
	@orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
	$ENV{"REQUEST_METHOD"} = "GET";
	$ENV{"QUERY_STRING"} = "user=$user&request=find_in_org&role=$pattern&org=$orgs[0]";
	my @out = `./pom.cgi`;
	print join("",@out);
	exit;
    }
    else
    {
	unshift @$html, "<TITLE>The SEED: Search Results</TITLE>\n";
	&show_indexed_objects($fig, $cgi, $html, $pattern);
    }
}
#-----------------------------------------------------------------------
#  Metabolic Overview
#-----------------------------------------------------------------------
elsif (($map = $cgi->param('kmap')) && $cgi->param('Metabolic Overview'))
{
    if ($map =~ /\(([^)]*)\)$/)
    {
	$map = $1;
    }
    else
    {
	# ??? Gary ???
    }

    #$map =~ s/^.*\((MAP\d+)\).*$/$1/;
    @orgs = $cgi->param('korgs');
    @orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
    $ENV{"REQUEST_METHOD"} = "GET";
    if (@orgs > 0)
    {
	$ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$orgs[0]";
    }
    else
    {
	$ENV{"QUERY_STRING"} = "user=$user&map=$map";
    }

    unshift @$html, "<TITLE>The SEED: Metabolic Overview</TITLE>\n";
    my @out = `./show_map.cgi`;
    &HTML::trim_output(\@out);
    push( @$html, "<br>\n", @out );
}

#-----------------------------------------------------------------------
#  Search for Matches (sequence or pattern)
#-----------------------------------------------------------------------
elsif (($seq_pat = $cgi->param('seq_pat')) && 
       ($tool = $cgi->param('Tool')) &&
       $cgi->param('Search for Matches'))
{
    @orgs = $cgi->param('korgs');
    if (@orgs > 0)
    {
	@orgs = map { $_ =~ /\((\d+\.\d+)\)/; $1 } @orgs;
    }
    else
    {
	@orgs = ("");
    }

    if ($tool =~ /blast/)
    {
	unshift @$html, "<TITLE>The SEED: BLAST Search Results</TITLE>\n";
	&run_blast($fig,$cgi,$html,$orgs[0],$tool,$seq_pat);
    }
    elsif ($tool =~ /Protein scan_for_matches/)
    {
	unshift @$html, "<TITLE>The SEED: Protein Pattern Match Results</TITLE>\n";
	&run_prot_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
    }
    elsif ($tool =~ /DNA scan_for_matches/)
    {
	unshift @$html, "<TITLE>The SEED: Nucleotide Pattern Match Results</TITLE>\n";
	&run_dna_scan_for_matches($fig,$cgi,$html,$orgs[0],$seq_pat);
    }
}
elsif (($made_by = $cgi->param('made_by')) && $cgi->param('Extract Assignments'))
{
    &export_assignments($fig,$cgi,$html,$made_by);
}
elsif ($cgi->param('Generate Assignments via Translation') &&
       ($from_func = $cgi->param('from_func')) &&
       ($to_func = $cgi->param('to_func')))
{
    &translate_assignments($fig,$cgi,$html,$from_func,$to_func);
}
elsif ($cgi->param('Extract Matched Sequences') && ($ids = $cgi->param('ids')))
{
    my @ids = split(/,/,$ids);
    my($list_to,$i);
    if ($list_to = $cgi->param('list_to'))
    {
	for ($i=0; ($i < @ids) && ($ids[$i] ne $list_to); $i++) {}
	if ($i < @ids)
	{
	    $#ids = $i;
	}
    }

    my($id,$seq,$i,$func);
    push(@$html,$cgi->pre);

    foreach $id (@ids)
    {
	if ($seq = $fig->get_translation($id))
	{
	    $func = $fig->function_of($id);
	    push(@$html,">$id $func\n");
	    for ($i=0; ($i < length($seq)); $i += 60)
	    {
		if ($i > (length($seq) - 60))
		{
		    push(@$html,substr($seq,$i) . "\n");
		}
		else
		{
		    push(@$html,substr($seq,$i,60) . "\n");
		}
	    }
	}
    }
    push(@$html,$cgi->end_pre);
}

#-----------------------------------------------------------------------
#  Initial search page
#-----------------------------------------------------------------------
else
{
    unshift @$html, "<TITLE>The SEED: Entry Page</TITLE>\n";
    &show_initial($fig,$cgi,$html);
}
&HTML::show_page($cgi,$html,1);
exit;


#==============================================================================
#  Initial page (alias search)
#==============================================================================

sub show_initial {
    my($fig,$cgi,$html) = @_;
    my($map,$name,$olrg,$gs);

    my( $a, $b, $e, $v, $env ) = $fig->genome_counts;
    push(@$html,$cgi->h2("Contains $a archaeal, $b bacterial, $e eukaryal, $v viral and $env environmental genomes"));
    my( $a, $b, $e ) = $fig->genome_counts("complete");
    push(@$html,$cgi->h2("Of these, $a archaeal, $b bacterial and $e eukaryal genomes are more-or-less complete"),$cgi->hr);

    push(@$html,
	 $cgi->h2('Work on Subsystems'),

#	 $cgi->start_form(-action => "ssa2.cgi"),
#	 "Enter user: ",
#	 $cgi->textfield(-name => "user", -size => 20),
#	 $cgi->submit('Work on Subsystems'),
#	 $cgi->end_form,

#	 $cgi->h2('Work on Subsystems Using New, Experimental Code'),
	 "This is the <i>new</i> subsystems code, and is now officially released.",
	 $cgi->start_form(-action => "subsys.cgi"),
	 "Enter user: ",
	 $cgi->textfield(-name => "user", -size => 20),
	 $cgi->submit('Work on Subsystems'),
	 $cgi->end_form,
	 $cgi->hr,
	);

    push(@$html,
	        $cgi->start_form(-action => "index.cgi"),
	        $cgi->h2('Searching for Genes or Functional Roles Using Text'),
	        "<table><tr>",
                "<td>Search Pattern: </td><td>",
	        $cgi->textfield(-name => "pattern", -size => 65),
	        "</td></tr><tr>",
	        "<td>User ID:</td><td>",
	        $cgi->textfield(-name => "user", -size => 20),
	        " [optional] ",
                "&nbsp; &nbsp; Max Genes: ",
	        $cgi->textfield(-name => "maxpeg",  -size => 6, -value => 100),
                "&nbsp; &nbsp; Max Roles: ",
	        $cgi->textfield(-name => "maxrole", -size => 6, -value => 100),
	        "</td></td></table>",
	        $cgi->submit('Search'),
	        $cgi->submit('Search genome selected below'),
	        $cgi->reset('Clear'),
	        $cgi->hr);

    my @display = ( 'All', 'Archaea', 'Bacteria', 'Eucarya', 'Viruses', 'Environmental samples' );

    #
    #  Canonical names must match the keywords used in the DBMS.  They are
    #  defined in compute_genome_counts.pl
    #
    my %canonical = (
        'All'                   =>  undef,
        'Archaea'               => 'Archaea',
        'Bacteria'              => 'Bacteria',
        'Eucarya'               => 'Eukaryota',
        'Viruses'               => 'Virus',
        'Environmental samples' => 'Environmental Sample'
        );

    my $req_dom = $cgi->param( 'domain' ) || 'All';
    my @domains = $cgi->radio_group( -name     => 'domain',
                                     -default  => $req_dom,
                                     -override => 1,
                                     -values   => [ @display ]
                                   );

    my $n_domain = 0;
    my %dom_num = map { ( $_, $n_domain++ ) } @display;
    my $req_dom_num = $dom_num{ $req_dom } || 0;

    #
    #  Viruses and Environmental samples must have completeness = All (that is
    #  how they are in the database).  Otherwise, default is Only "complete".
    #
    my $req_comp = ( $req_dom_num > $dom_num{ 'Eucarya' } ) ? 'All'
                 : $cgi->param( 'complete' ) || 'Only "complete"';
    my @complete = $cgi->radio_group( -name     => 'complete',
                                      -default  => $req_comp,
                                      -override => 1,
                                      -values   => [ 'All', 'Only "complete"' ]
                        );
    #
    #  Use $fig->genomes( complete, restricted, domain ) to get org list:
    #
    my $complete = ( $req_comp =~ /^all$/i ) ? undef : "complete";
    
    my @orgs = sort map { $org = $_; my $gs = $fig->genus_species($org); my $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" }
               $fig->genomes( $complete, undef, $canonical{ $req_dom } );

    my $n_genomes = @orgs;

    push( @$html, $cgi->h2('If You Need to Pick a Genome for Options Below'),
                  "<TABLE>\n",
                  "   <TR>\n",
                  "      <TD>",
	          $cgi->scrolling_list( -name   => 'korgs',
                                        -values => [ @orgs ],
                                        -size   => 10,
                                      ), $cgi->br,
                  "$n_genomes genomes shown ",
                  $cgi->submit( 'Update List' ), $cgi->reset, $cgi->br,
	          "Show some ", $cgi->submit('statistics')," of the selected genome",
                  "      </TD>",
                  "      <TD>",
                  join( "<br>", "<b>Domain(s) to show:</b>", @domains), "<br>\n",
                  join( "<br>", "<b>Completeness?</b>", @complete), "\n",
                  "</TD>",
                  "   </TR>\n",
                  "</TABLE>\n",
                  $cgi->hr
        );

    push( @$html, $cgi->h2('Finding Candidates for a Functional Role'),
	        "Make sure that you type the functional role you want to search for in the Search Pattern above",
	        $cgi->br,
	        $cgi->submit('Find Genes in Org that Might Play the Role'),
	        $cgi->hr);

    my @maps = sort map { $map = $_; $name = $fig->map_name($map); "$name ($map)" } $fig->all_maps;

    push( @$html, $cgi->h2('Metabolic Overviews and Subsystem Maps (via KEGG & SEED) - Choose Map'),
	        $cgi->submit('Metabolic Overview'),
	        $cgi->br,
	        $cgi->br,
	        $cgi->scrolling_list(-name => 'kmap',
                                     -values => [@maps],
				     -size => 10
                                    ),
	        $cgi->hr);

    push( @$html, $cgi->h2('Searching DNA or Protein Sequences (in a selected organism)'),
	        "<TABLE>\n",
	        "    <TR>\n",
	        "        <TD>Sequence/Pattern: </TD>",
	        "        <TD Colspan=3>", $cgi->textarea(-name => 'seq_pat', -rows => 10, -cols => 70), "</TD>\n",
	        "    </TR>\n",
	        "    <TR>\n",
	        "        <TD>Search Program: </TD>",
	        "        <TD>", $cgi->popup_menu(-name => 'Tool', -values => ['blastp', 'blastx', 'blastn', 'tblastn', 'blastp against complete genomes', 'Protein scan_for_matches', 'DNA scan_for_matches'], -default => 'blastp'), " </TD>",
	        "        <TD> Program Options:</TD>",
	        "        <TD>", $cgi->textfield( -name => "blast_options", -size => 27 ), "</TD>",
	        "    </TR>\n",
	        "</TABLE>\n",
	        $cgi->submit('Search for Matches'),
	        $cgi->hr);

    #
    # Make assignment export tbl.
    #

    my @atbl;
    push(@atbl, [ "Extract assignments made by ",
		  $cgi->textfield(-name => "made_by", -size => 25) . " (do not prefix with <b>master:</b>)" ]);
    push(@atbl, [ "Save as user: ",
	          $cgi->textfield(-name => "save_user", -size => 25) . " (do not prefix with <b>master:</b>)" ] );
    push(@atbl, [ "After date (MM/DD/YYYY) ",
		  $cgi->textfield(-name => "after_date", -size => 15)]);

    push(@$html, 
	 $cgi->h2('Exporting Assignments'),
	 &HTML::make_table(undef, \@atbl, '', border => 0),
	        $cgi->checkbox(-label => 'Tab-delimited Spreadsheet', -name => 'tabs', -value => 1),
		$cgi->br,
	        $cgi->checkbox(-label => 'Save Assignments', -name => 'save_assignments', -value => 1),
	        $cgi->br,
	        $cgi->submit('Extract Assignments'),
	        $cgi->br, $cgi->br, $cgi->br,
	        "Alternatively, you can generate a set of assignments as translations of existing assignments.  ",
	        "To do so, you need to make sure that you fill in the <b>Save as user</b> field just above.  You ",
	        "should use something like <b>RossO</b> (leave out the <b>master:</b>).  When you look at the assignments (and decide which ",
	        "to actually install), they will be made available under that name (but, when you access them, ",
	        "you will normally be using something like <b>master:RossO</b>)",
	        $cgi->br,$cgi->br,
		"From: ",
	        $cgi->textarea(-name => 'from_func', -rows => 4, -cols => 100),
	        $cgi->br,$cgi->br,
		"To:&nbsp;&nbsp;&nbsp;&nbsp; ",$cgi->textfield(-name => "to_func", -size => 100), 
	        $cgi->br,
		$cgi->a({class=>"help", target=>"help", href=>"/FIG/Html/seedtips.html#replace_names"}, "Help with generate assignments via translation"),
	        $cgi->submit('Generate Assignments via Translation'),
	        $cgi->hr,
	        $cgi->h2('Searching for Interesting Genes'),
	        $cgi->submit('Search for Genes Matching an Occurrence Profile or Common to a Set of Organisms'),
                $cgi->end_form
	 );

    push(@$html,
	        $cgi->hr,
	        $cgi->h2('Process Saved Assignments Sets'),
	        $cgi->start_form(-action => "assignments.cgi"),
	        "Here you should include the <b>master:</b>.  Thus use something like <b>master:RossO</b>",$cgi->br,
	        $cgi->br,
	        "Enter user: ",
	        $cgi->textfield(-name => "user", -size => 20),
	        $cgi->submit('Process Assignment Sets'),
                $cgi->end_form
	 );

    push(@$html,
	        $cgi->hr,
	        $cgi->h2('Align Sequences'),
	        $cgi->start_form(-action => "index.cgi"),
	        "Enter user: ",
	        $cgi->textfield(-name => "user", -size => 20), $cgi->br,
	        $cgi->submit('Align Sequences'),": ",
	        $cgi->textfield(-name => "seqids", -size => 100),
                $cgi->end_form
	 );

    push(@$html,
	        $cgi->hr,
	        $cgi->h2('Locate PEGs in Subsystems'),
	        "If you wish to locate PEGs in subsystems, you have two approaches supported.  You can
give a FIG id, and you will get a list of all homologs in the designated genome that occur in subsystems.
Alternatively, you can specify a functional role, and all PEGs in the genome that match that role will be shown.",
	        $cgi->start_form(-action => "index.cgi"),
	        "Enter user: ",
	        $cgi->textfield(-name => "user", -size => 20), $cgi->br,
	        $cgi->br,"Genome: ",$cgi->textfield(-name => "genome", -size => 15),$cgi->br,
	        "Search: ",$cgi->textfield(-name => "subsearch", -size => 100),$cgi->br,
	        $cgi->submit('Find PEGs'),": ",
                $cgi->end_form
	 );
}


#==============================================================================
#  Indexed objects (text search)
#==============================================================================

sub show_indexed_objects {
    my($fig, $cgi, $html, $pattern) = @_;
    my($msg, $i);

    if ($pattern =~ /^\s*(fig\|\d+\.\d+\.peg\.\d+)\s*$/)
    {
	my $peg = $1;
	my $user = $cgi->param('user');
	$user = $user ? $user : "";
	$ENV{'REQUEST_METHOD'} = "GET";
	$ENV{"QUERY_STRING"} = "prot=$peg\&user=$user";
	$ENV{"REQUEST_URI"} =~ s/index.cgi/protein.cgi/;
	my @prot_out = `./protein.cgi`;
	print @prot_out;
	exit;
    }

    push( @$html, $cgi->br );
    my( $peg_index_data, $role_index_data ) = $fig->search_index($pattern);
    my $maxpeg  = defined( $cgi->param("maxpeg")  ) ? $cgi->param("maxpeg")  : 100;
    my $maxrole = defined( $cgi->param("maxrole") ) ? $cgi->param("maxrole") : 100;

    # RAE added lines to allow searching within a single organism
    # if ($cgi->param('korgs'))
    # {
    #  $cgi->param('korgs') =~ /\((\d+\.*\d*)\)/;
    #  $org=$1; # this should be undef if korgs is not defined

    #  push (@$html, $cgi->br, "Matches found in ",$cgi->param('korgs'), $cgi->p);
    #  my @clean_data; my @clean_index;
    #  while (@$peg_index_data)
    #  {
    #   my ($data, $index)=(shift @$peg_index_data, shift @$role_index_data);
    #   next unless (${$data}[0] =~ /^fig\|$org\.peg/);
    #   push @clean_data, $data;
    #   push @clean_index, $index;
    #  }

    #  @$peg_index_data=@clean_data;
    #  @$role_index_data=@clean_index;
    # }
    ## End of added lines

    # RAE version with separate submit buttons and more than one org in korg
    # this is used by organisms.cgi for group specific searches
    if ( $cgi->param('korgs') && $cgi->param('Search Selected Organisms') 
       )
    {
      my @temp;
      foreach my $org ($cgi->param('korgs')) 
      {
         push @temp, grep { $_->[0] =~ /^fig\|$org/ } @$peg_index_data;
      }
      @$peg_index_data = @temp;
    }

    # GJO version with separate submit buttons

    if ( $cgi->param('korgs') && $cgi->param('korgs') =~ /\((\d+\.*\d*)\)/
                              && $cgi->param('Search genome selected below')
       )
    {
	my $org = $1;
	push @$html, $cgi->br, "Matches found in ",$cgi->param('korgs'), $cgi->p;
	@$peg_index_data = grep { $_->[0] =~ /^fig\|$org\.peg/ } @$peg_index_data;
    }

    if ( ( $maxpeg > 0 ) && @$peg_index_data )
    {
	# RAE: Added javascript buttons see below. Only two things are needed.
	# The form must have a name parameter, and the one line of code for the
	# buttons. Everything else is automatic

	push( @$html, $cgi->start_form( -method => 'post',
	                                -target => "window$$",
	                                -action => 'fid_checked.cgi',
	                                -name   => 'found_pegs'
	                              ),
	              $cgi->hidden(-name => 'user', -value => $user),
	              "For Selected (checked) sequences: ",
	              $cgi->submit('get sequences'),
	              $cgi->submit('view annotations'),
	              $cgi->submit('assign/annotate'),
	              $cgi->param('SPROUT') ? () : $cgi->submit('view similarities'),
	              $cgi->br, $cgi->br
	    );

        # RAE Add the check all/uncheck all boxes.
        push (@$html, $cgi->br, &HTML::java_buttons("found_pegs", "checked"), $cgi->br);
	
	my $n = @$peg_index_data;
	if ($n > $maxpeg)
	{
	    $msg = "Showing first $maxpeg out of $n protein genes";
	    $#{$peg_index_data} = $maxpeg-1;
	}
	else
	{
	    $msg = "Showing $n PEGs";
	}

	my $col_hdrs = ["Sel","PEG","Organism","Aliases","Function","Who"];
	my $tab = [ map { format_peg_entry( $fig, $cgi, $_ ) } @$peg_index_data ];
	push( @$html, &HTML::make_table($col_hdrs,$tab,$msg),
	              $cgi->br,
	              "For SELECTed (checked) sequences: ",
	              $cgi->submit('get sequences'),
	              $cgi->submit('view annotations'),
	              $cgi->submit('assign/annotate'),
	              $cgi->param('SPROUT') ? () : $cgi->submit('view similarities'),
	              $cgi->br,
	              $cgi->end_form
	    );
    }
    elsif ( $maxpeg > 0 )
    {
	push @$html, $cgi->h3('No matching protein genes');
    }

    if ( ( $maxrole > 0 ) && @$role_index_data )
    {
	my $n = @$role_index_data;
	if ($n > $maxrole)
	{
	    $msg = "Showing first $maxrole out of $n Roles";
	    $#{$role_index_data} = $maxrole - 1;
	}
	else
	{
	    $msg = "Showing $n Roles";
	}

	if ( $maxpeg > 0 ) { push( @$html, $cgi->hr ) }
	my $col_hdrs = ["Role"];
	my $tab = [ map { &format_role_entry($fig,$cgi,$_) } @$role_index_data ];
	push( @$html, &HTML::make_table($col_hdrs,$tab,$msg) );
    }
    elsif ( $maxrole > 0 )
    {
	push @$html, $cgi->h3('No matching roles');
    }
}


sub format_peg_entry {
    my( $fig, $cgi, $entry ) = @_;
    my($i,$function,$who);

    my($peg,$gs,$aliases,@funcs) = @$entry;

    $gs =~ s/\s+\d+$//;   # Org name comes with taxon_id appended (why?) -- GJO

    @funcs = map { $_ =~ s/^function:\s*//; $_ } @funcs;

    if ($aliases)
    {
	$aliases =~ s/^aliases://;
    }
    else
    {
	$aliases = "";
    }

    my $user = $cgi->param('user');
    $user = $user ? $user : "";

    if ($user)
    {
	for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#$user/); $i++) {}
	if ($i < @funcs)
	{
	    ($function,$who) = split(/\#/,$funcs[$i]);
	}
    }

    if (! $function)
    {
	for ($i=0; ($i < @funcs) && ($funcs[$i] !~ /\#master/); $i++) {}
	if ($i < @funcs)
	{
	    ($function,$who) = split(/\#/,$funcs[$i]);
	}
    }

    if ((! $function) && (@funcs > 0))
    {
	($function,$who) = split(/\#/,$funcs[0]);
    }
    my $box = "<input type=checkbox name=checked value=\"$peg\">";
    return [ $box, &HTML::fid_link($cgi,$peg), $gs, $aliases, $function, $who ];
}

sub format_role_entry {
    my($fig,$cgi,$entry) = @_;

    return [&HTML::role_link($cgi,$entry)];
}

sub run_prot_scan_for_matches {
    my($fig,$cgi,$html,$org,$pat) = @_;
    my($string,$peg,$beg,$end,$user,$col_hdrs,$tab,$i);

    my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
    open(PAT,">$tmp_pat")
	|| die "could not open $tmp_pat";
    $pat =~ s/[\s\012\015]+/ /g;
    print PAT "$pat\n";
    close(PAT);
    my @out = `$FIG_Config::ext_bin/scan_for_matches -p $tmp_pat < $FIG_Config::organisms/$org/Features/peg/fasta`;
    if (@out < 1)
    {
	push(@$html,$cgi->h1("Sorry, no hits"));
    }
    else
    {
	if (@out > 2000)
	{
	    push(@$html,$cgi->h1("truncating to the first 1000 hits"));
	    $#out = 1999;
	}

	push(@$html,$cgi->pre);
	$user = $cgi->param('user');
	$col_hdrs = ["peg","begin","end","string","function of peg"];
	for ($i=0; ($i < @out); $i += 2)
	{
	    if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
	    {
		$peg = $1;
		$beg = $2;
		$end = $3;
		$string = $out[$i+1];
		chomp $string;
		push( @$tab, [ &HTML::fid_link($cgi,$peg,1),
		               $beg,
		               $end,
		               $string,
		               scalar $fig->function_of( $peg, $user )
		             ]
		    );
	    }
	}
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
	push(@$html,$cgi->end_pre);
    }
    unlink($tmp_pat);
}

#==============================================================================
#  Scan for matches
#==============================================================================

sub run_dna_scan_for_matches {
    my($fig,$cgi,$html,$org,$pat) = @_;
    my($string,$contig,$beg,$end,$col_hdrs,$tab,$i);

    my $tmp_pat = "$FIG_Config::temp/tmp$$.pat";
    open(PAT,">$tmp_pat")
	|| die "could not open $tmp_pat";
    $pat =~ s/[\s\012\015]+/ /g;
    print PAT "$pat\n";
    close(PAT);
    my @out = `cat $FIG_Config::organisms/$org/contigs | $FIG_Config::ext_bin/scan_for_matches -c $tmp_pat`;
    if (@out < 1)
    {
	push(@$html,$cgi->h1("Sorry, no hits"));
    }
    else
    {
	if (@out > 2000)
	{
	    push(@$html,$cgi->h1("truncating to the first 1000 hits"));
	    $#out = 1999;
	}

	push(@$html,$cgi->pre);
	$col_hdrs = ["contig","begin","end","string"];
	for ($i=0; ($i < @out); $i += 2)
	{
	    if ($out[$i] =~ /^>([^:]+):\[(\d+),(\d+)\]/)
	    {
		$contig = $1;
		$beg = $2;
		$end = $3;
		$string = $out[$i+1];
		chomp $string;
		push(@$tab,[$contig,$beg,$end,$string]);
	    }
	}
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Matches"));
	push(@$html,$cgi->end_pre);
    }
    unlink($tmp_pat);
}

#==============================================================================
#  BLAST search
#==============================================================================

sub run_blast {
    my( $fig, $cgi, $html, $org, $tool, $seq ) = @_;
    my( $query, @out );

    my $tmp_seq = "$FIG_Config::temp/run_blast_tmp$$.seq";

    #--------------------------------------------------------------------------
    #  Is the request for an id?  Get the sequence
    #--------------------------------------------------------------------------
    if ($seq =~ /^\s*([a-zA-Z]{2,4}\|\S+)/)
    {
	# Replaced $id with $query so that output inherits label -- GJO
	$query = $1;
	$seq = "";
	if (($tool eq "blastp") || ($tool eq "tblastn"))
	{
	    $seq = $fig->get_translation($query);
	}
	elsif ($query =~ /^fig/)
	{
	    my @locs;
	    if ((@locs = $fig->feature_location($query)) && (@locs > 0))
	    {
		$seq = $fig->dna_seq($fig->genome_of($query),@locs);
	    }
	}
	if (! $seq)
	{
	    push(@$html,$cgi->h1("Sorry, could not get sequence for $query"));
	    return;
	}
    }

    #--------------------------------------------------------------------------
    #  Is it a fasta format?  Get the query name
    #--------------------------------------------------------------------------

    elsif ( $seq =~ s/^>\s*(\S+[^\n\012\015]*)// )  #  more flexible match -- GJO
    {
	$query = $1;
    }

    #--------------------------------------------------------------------------
    #  Take it as plain text
    #--------------------------------------------------------------------------

    else
    {
	$query = "query";
    }

    #
    #  The rest is taken as the sequence
    #

    $seq =~ s/\s+//g;
    open( SEQ, ">$tmp_seq" ) || die "run_blast could not open $tmp_seq";
    print SEQ ">$query\n$seq\n";
    close( SEQ );

    if (! $ENV{"BLASTMAT"}) { $ENV{"BLASTMAT"} = "$FIG_Config::blastmat" }
    my $blast_opt = $cgi->param( 'blast_options' );
    my $blastall = "$FIG_Config::ext_bin/blastall";

    if ( $tool eq "blastp" )
    {
	my $db = "$FIG_Config::organisms/$org/Features/peg/fasta";
	&verify_db( $db, "p" );
	@out = map { &HTML::set_prot_links($cgi,$_) } `$blastall -i $tmp_seq -d $db -p blastp $blast_opt`;
    }

    elsif ( $tool eq "blastx" )
    {
	my $db = "$FIG_Config::organisms/$org/Features/peg/fasta";
	&verify_db( $db, "p" );
	@out = map { &HTML::set_prot_links($cgi,$_) } `$blastall -i $tmp_seq -d $db -p blastx $blast_opt`;
    }

    elsif ( $tool eq "blastn" )
    {
	my $db = "$FIG_Config::organisms/$org/contigs";
	&verify_db( $db, "n" );                               ### fix to get all contigs
	@out = `$blastall -i $tmp_seq -d $db -p blastn -r 1 -q -1 $blast_opt`;
	push @$html, blast_graphics( $fig, $cgi, $org, \@out, $tool );
    }

    elsif ( $tool eq "tblastn" )
    {
	my $db = "$FIG_Config::organisms/$org/contigs";
	&verify_db( $db, "n" );                               ### fix to get all contigs
	@out = `$blastall -i $tmp_seq -d $db -p tblastn $blast_opt`;
	push @$html, blast_graphics( $fig, $cgi, $org, \@out, $tool );
    }

    elsif ( $tool eq 'blastp against complete genomes' )     ### this tool gets nonstandard treatment: RAO
    {
	&blast_complete($fig,$cgi,$html,$tmp_seq,$blastall);
	unlink($tmp_seq);
	return;
    }

    if (@out < 1)          #  This is really a bigger problem than no hits (GJO)
    {
	push(@$html,$cgi->h1("Sorry, no hits"));
    }
    else
    {
	push(@$html,$cgi->pre);
	push(@$html,@out);
	push(@$html,$cgi->end_pre);
    }
    unlink( $tmp_seq );
}


sub blast_complete {
    my($fig,$cgi,$html,$seq_file,$blastall) = @_;
    my($genome,@sims);
    
    @sims = ();
    foreach $genome ($fig->genomes("complete"))
    {
	my $db = "$FIG_Config::organisms/$genome/Features/peg/fasta";
	next if (! -s $db);

	&verify_db($db,"p");
	my $sim;
	push(@sims,map { chop; 
			$sim = [split(/\t/,$_)]; 
			$sim->[10] = ($sim->[10] =~ /^e-/) ? "1.0" . $sim->[10] : $sim->[10]; 
		        $sim } 
	          `$blastall -i $seq_file -d $db -m 8 -FF -e 1.0e-5 -p blastp`);
    }
    @sims = sort { $a->[10] <=> $b->[10] } @sims;
    &format_sims($fig,$cgi,$html,\@sims);
}


#------------------------------------------------------------------------------
#  Graphically display searches against contigs
#
#  use FIGjs        qw( toolTipScript );
#  use GenoGraphics qw( render );
#  use IPC::Open2   qw( open2 );
#------------------------------------------------------------------------------
#  Fields produced by rationalize_blast:
#
#  0    1      2    3    4        5       6       7      8      9   10  11   12   13  14  15
# HSP  score  exp  p_n  p_val  n_match  n_ident  n_sim  n_gap  dir  q1  q2  q_sq  s1  s2  s_sq
#------------------------------------------------------------------------------

sub blast_graphics {
    my ( $fig_or_sprout, $cgi, $genome, $out, $tool ) = @_;

    my $e_min = 0.1;
    my $gg = [];
    my @html = ();;

    # Run rationalize_blast:

    my( $pid, $rd, $wr );
    if ( $pid = open2( $rd, $wr, "rationalize_blast" ) )
    {
	my $outlen = 0;
	foreach ( @$out ) { $outlen += length( $_ ) }

	$wr->write( join( "", @$out ), $outlen );
	close( $wr );

	my ( $qid, $qdef, $qlen, $contig, $sdef, $slen );
	my @rational = <$rd>;
	foreach ( map { chomp; $_ } @rational )
	{
    	    if    ( /^Query=/ ) { ( undef, $qid,    undef, $qlen ) = split /\t/ }
    	    elsif ( /^>/ )      { ( undef, $contig, undef, $slen ) = split /\t/ }
    	    elsif ( /^HSP/ && $qid && $qlen && $contig && $slen )
	    {
		my @hsp = split /\t/;
		next if $hsp[2] > $e_min;
		my ( $e_val, $q1, $q2, $s1, $s2 ) = @hsp[ 2, 10, 11, 13, 14 ];
		my ( $genes, $min, $max ) = hsp_context( $fig_or_sprout, $cgi, $genome,
		                                         $e_val, 100 * $hsp[6] / $hsp[5],
		                                         $qid,    $q1, $q2, $qlen,
		                                         $contig, $s1, $s2, $slen
		                                       );
		push @$gg, [ substr( $contig, 0, 18 ), $min, $max, $genes ];
	    }
	}
	close( $rd );

	# $gene  = [ $beg, $end, $shape, $color, $text, $url, $pop-up, $alt_action, $pop-up_title ];
	# $genes = [ $gene, $gene, ... ];
	# $map   = [ $label, $min_coord, $max_coord, $genes ];
	# $gg    = [ $map, $map, ... ];
	# render( $gg, $width, $obj_half_heigth, $save, $img_index_number )

	if ( @$gg )
	{
	    # print STDERR Dumper( $gg );
	    my $gs = $fig_or_sprout->genus_species( $genome );
	    my $space = "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;";
	    my $legend = "<TABLE>\n"
	               . "    <TR>\n"
	               . "        <TD>Q = Query sequence$space</TD>\n"
	               . "        <TD Bgcolor='#FF0000'>$space</TD><TD>Frame 1 translation$space</TD>\n"
	               . "        <TD Bgcolor='#00FF00'>$space</TD><TD>Frame 2 translation$space</TD>\n"
	               . "        <TD Bgcolor='#0000FF'>$space</TD><TD>Frame 3 translation$space</TD>\n"
	               . "        <TD Bgcolor='#808080'>$space</TD><TD>Untranslated sequence</TD>\n"
	               . "    </TR>\n"
	               . "</TABLE><P />";

	    push @html, "\n", FIGjs::toolTipScript(), "\n",
	                $cgi->h2( "Results of $tool search of contigs from $gs\n"),
	                $legend,
	                @{ GenoGraphics::render( $gg, 600, 4, 0, 1 ) },
	                $cgi->hr, "\n";
	}

	waitpid $pid, 0;
    }

    return @html;
}


sub hsp_context {
    my( $fig_or_sprout, $cgi, $genome, $e_val, $pct_id,
        $qid,    $q1, $q2, $qlen,
	$contig, $s1, $s2, $slen ) = @_;
    my $half_sz = 5000;

    my( $from, $to, $features, $fid, $beg, $end );
    my( $link, $lbl, $isprot, $function, $uniprot, $info, $prot_query );

    my $user   = $cgi->param( 'user' ) || "";
    my $sprout = $cgi->param( 'SPROUT' ) ? '&SPROUT=1' : '';

    my @genes  = ();

    #  Based on the match position of the query, select the context region:

    ( $from, $to ) = ( $s1 <= $s2 ) ? ( $s1 - $half_sz, $s2 + $half_sz )
                                    : ( $s2 - $half_sz, $s1 + $half_sz );
    $from = 1      if ( $from < 1 );
    $to   = $slen  if ( $to > $slen );

    #  Get the genes in the region, and adjust the ends to include whole genes:

    ( $features, $from, $to ) = genes_in_region( $fig_or_sprout, $cgi, $genome, $contig, $from, $to );


    #  Add the other features:

    foreach $fid ( @$features )
    {
	my $contig1;
	( $contig1, $beg, $end ) = boundaries_of( $fig_or_sprout, feature_locationS( $fig_or_sprout, $fid ) );
	next if $contig1 ne $contig;

	$link = "";
	if ( ( $lbl ) = $fid =~ /peg\.(\d+)$/ ) {
	    ( $link = $cgi->url() ) =~ s/index\.cgi/protein.cgi/;
	    $link .= "?prot=$fid&user=$user$sprout";
	    $isprot = 1;
	} elsif ( ( $lbl ) = $fid =~ /\.([a-z]+)\.\d+$/ ) {
	    $lbl = uc $lbl;
	    $isprot = 0;
	} else {
	    $lbl = "";
	    $isprot = 0;
	}

	$function = function_ofS( $fig_or_sprout, $fid );

	$uniprot = join ", ", grep { /^uni\|/ } feature_aliasesL( $fig_or_sprout, $fid);

	$info = join( '<br />', "<b>Feature:</b> $fid",
	                        "<b>Contig:</b> $contig",
	                        "<b>Begin:</b> $beg",
	                        "<b>End:</b> $end",
	                        $function ? "<b>Function:</b> $function" : '',
	                        $uniprot ? "<b>Uniprot ID:</b> $uniprot" : ''
	            );

	push @genes, [ feature_graphic( $beg, $end, $isprot ),
	               $lbl, $link, $info,
	               $isprot ? () : ( undef, "Feature information" )
	             ];
    }

    #  Draw the query.  The subject coordinates are always DNA.  If the query
    #  is protein, it is about 3 times shorter than the matching contig DNA.
    #  Splitting the difference, if 1.7 times the query length is still less
    #  than the subject length, we will call it a protein query (and reading
    #  frame in the contig coordinates has meaning).  If it is nucleotides,
    #  there is no defined frame.

    $info = join( '<br />', $qid ne 'query ' ? "<b>Query:</b> $qid" : (),
                            "<b>Length:</b> $qlen",
                            "<b>E-value:</b> $e_val",
                            "<b>% identity:</b> " . sprintf( "%.1f", $pct_id ),
                            "<b>Region of similarity:</b> $q1 &#150; $q2"
                );
    $prot_query = ( 1.7 * abs( $q2 - $q1 ) < abs( $s2 - $s1 ) ) ? 1 : 0;

    push @genes, [ feature_graphic( $s1, $s2, $prot_query ),
                   'Q', undef, $info, undef, 'Query and match information'
                 ];

    return \@genes, $from, $to;
}


sub feature_graphic {
    my ( $beg, $end, $isprot ) = @_;
    my ( $min, $max, $symb, $color );

    ( $min, $max, $symb ) = ( $beg <= $end ) ? ( $beg, $end, "rightArrow" )
                                             : ( $end, $beg, "leftArrow" );

    #  Color proteins by translation frame

    $color = $isprot ? qw( blue red green )[ $beg % 3 ] : 'grey';

    ( $min, $max, $symb, $color );
}


sub genes_in_region {
    my( $fig_or_sprout, $cgi, $genome, $contig, $min, $max ) = @_;

    if ( $cgi->param( 'SPROUT' ) )
    {
	my( $x, $feature_id );
	my( $feat, $min, $max ) = $fig_or_sprout->genes_in_region( $genome, $contig, $min, $max );
	my @tmp = sort { ($a->[1] cmp $b->[1]) or
	                 (($a->[2]+$a->[3]) <=> ($b->[2]+$b->[3]))
	               }
	          map  { $feature_id = $_;
	                 $x = feature_locationS( $fig_or_sprout, $feature_id );
	                 $x ? [ $feature_id, boundaries_of( $fig_or_sprout, $x )]  : ()
	               }
	          @$feat;
	return ( [map { $_->[0] } @tmp ], $min, $max );
    }
    else
    {
	return $fig_or_sprout->genes_in_region( $genome, $contig, $min, $max );
    }
}


sub feature_locationS {
    my ( $fig_or_sprout, $peg ) = @_;
    scalar $fig_or_sprout->feature_location( $peg );
}


sub boundaries_of {
    my( $fig_or_sprout, $loc ) = @_;
    $fig_or_sprout->boundaries_of( $loc );
}


sub function_ofS {
    my( $fig_or_sprout, $peg, $user ) = @_;
    scalar $fig_or_sprout->function_of( $peg, $user );
}


sub feature_aliasesL {
    my( $fig_or_sprout, $fid ) = @_;
    my @tmp = $fig_or_sprout->feature_aliases( $fid );
    @tmp
}


sub format_sims {
    my($fig,$cgi,$html,$sims) = @_;
    my($col_hdrs,$table,@ids,$ids,$sim,%seen);

    $col_hdrs = [ "Select up to here",
		  "Similar sequence",
		  "E-val",
		  "Function",
		  "Organism",
	          "Aliases"
		];

    $table = [];
    @ids = ();
    if (@$sims > 1000) { $#{$sims} = 999 }
    foreach $sim (@$sims)
    {
	if (! $seen{$sim->[1]})
	{
	    push(@$table,[$cgi->checkbox(-name => 'list_to', -value => $sim->[1], -override => 1, -checked => 0, -label => ""),
			  &HTML::fid_link($cgi,$sim->[1]),
			  $sim->[10],
			  scalar $fig->function_of($sim->[1]),
                          $fig->genus_species(&FIG::genome_of($sim->[1])),
			  scalar $fig->feature_aliases($sim->[1])
			  ]);
	    push(@ids,$sim->[1]);
	}
    }
    $ids = join(",",@ids);
    my $target = "window$$";
    push(@$html, $cgi->start_form( -method => 'post',
				    -target => $target,
				    -action => 'index.cgi'
	                          ),
	         $cgi->hidden(-name => 'ids', -value => $ids),
	         &HTML::make_table($col_hdrs,$table,"Best Hits"),
	         $cgi->submit('Extract Matched Sequences'),
	 $cgi->end_form);
}

sub verify_db {
    my($db,$type) = @_;

    if ($type =~ /^p/i)
    {
	if ((! -s "$db.psq") || (-M "$db.psq" > -M $db))
	{
	    system "$FIG_Config::ext_bin/formatdb -p T -i $db";
	}
    }
    else
    {
	if ((! -s "$db.nsq") || (-M "$db.nsq" > -M $db))
	{
	    system "$FIG_Config::ext_bin/formatdb -p F -i $db";
	}
    }
}	

sub export_assignments {
    my($fig,$cgi,$html,$who) = @_;
    my($genome,$x);

    my @genomes = map { $_ =~ /\((\d+\.\d+)\)/; $1 } $cgi->param('korgs');

    if (@genomes == 0)
    {
	@genomes = $fig->genomes;
    }
    
    my @assignments = $fig->assignments_made(\@genomes,$who,$cgi->param('after_date'));
    if (@assignments == 0)
    {
	push(@$html,$cgi->h1("Sorry, no assignments where made by $who"));
    }
    else
    {
	my $col_hdrs = ["FIG id", "External ID", "Genus/Species","Assignment"];
	my $tab = [];
	my($x,$peg,$func);
	foreach $x (@assignments)
	{
	    ( $peg, $func ) = @$x;
	    push( @$tab,[ HTML::set_prot_links( $cgi, $peg ),
	                  HTML::set_prot_links( $cgi, ext_id( $fig, $peg ) ),
	                  $fig->genus_species($fig->genome_of($peg)),
	                  $func
	                ] );
	}
	
	if ($cgi->param('save_assignments'))
	{
	    my $user = $cgi->param('save_user');
	    if ($user)
	    {
		&FIG::verify_dir("$FIG_Config::data/Assignments/$user");
		my $file = &FIG::epoch_to_readable(time) . ":$who:exported_from_local_SEED";
		if (open(TMP,">$FIG_Config::data/Assignments/$user/$file"))
		{
		    print TMP join("",map { join("\t",@$_) . "\n" } map { [$_->[0],$_->[3]] } @$tab);
		    close(TMP);
		}
		push(@$html,$cgi->h1("Saved Assignment Set $file"));
	    }
	    else
	    {
		push(@$html,$cgi->h1("You need to specify a user to save an assignment set"));
	    }
	}

	if ($cgi->param('tabs'))
	{
	    print $cgi->header;
	    print "<pre>\n";
	    print join("",map { join("\t",@$_) . "\n" } @$tab);
	    print "</pre>\n";
	    exit;
	}
	else
	{
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"Assignments Made by $who"));
	}
    }
}

sub ext_id {
    my($fig,$peg) = @_;

    my @mapped = grep { $_ !~ /^fig/ } map { $_->[0] } $fig->mapped_prot_ids($peg);
    if (@mapped == 0)
    {
	return $peg;
    }

    my @tmp = ();
    if ((@tmp = grep { $_ =~ /^sp/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^pir/ }  @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^gi/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^tr/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^tn/ }   @mapped) && (@tmp > 0))  { return $tmp[0] }
    if ((@tmp = grep { $_ =~ /^kegg/ } @mapped) && (@tmp > 0))  { return $tmp[0] }
    
    return $peg;
}

sub translate_assignments {
    my($fig,$cgi,$html,$from_func,$to_func) = @_;

    my @funcs = grep { $_ =~ /^\S.*\S$/ } split(/[\012\015]+/,$from_func);

    my $user = $cgi->param('save_user');
    if ($user)
    {
	&FIG::verify_dir("$FIG_Config::data/Assignments/$user");
	my $file = &FIG::epoch_to_readable(time) . ":$user:translation";
	if (open(TMP,">$FIG_Config::data/Assignments/$user/$file"))
	{
	    my($peg,$func);

	    foreach $from_func (@funcs)
	    {
		my $from_funcQ = quotemeta $from_func;

		foreach $peg ($fig->seqs_with_role($from_func))
		{
		    if ($peg =~ /^fig\|/)
		    {
			$func = $fig->function_of($peg);
			if ($func eq $from_func)
			{
			    print TMP "$peg\t$to_func\n";
			}
			elsif (($func =~ /^$from_funcQ\s+\/\s+(\S.*\S)\s*$/) || ($func =~ /^$from_funcQ\s*;\s+(\S.*\S)\s*$/))
			{
			    print TMP "$peg\t$to_func / $1\n";
			}
			elsif (($func =~ /^\s*(\S.*\S)\s+\/\s+$from_funcQ\s*$/) || ($func =~ /^\s*(\S.*\S)\s*;\s+$from_funcQ\s*$/))
			{
			    print TMP "$peg\t$1 / $to_func\n";
			}
		    }
		}
	    }
	    close(TMP);
	}
	push(@$html,$cgi->h1("Saved Assignment Set $file"));
    }
    else
    {
	push(@$html,$cgi->h1("You need to specify a user to save an assignment set"));
    }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3