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

View of /FigWebServices/protein.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.57 - (download) (annotate)
Wed Jan 12 21:50:10 2005 UTC (15 years, 2 months ago) by olson
Branch: MAIN
Changes since 1.56: +11 -2 lines
Fix up Sprout protein page template stuff

use FIG;

my $sproutAvail = eval {
    require SproutFIG;
    require PageBuilder;
};

if (!$sproutAvail)
{
    warn "Sprout library not available: $@\n";
}
else
{
    warn "Sprout libs found\n";
}

use FIGGenDB;
use FIGjs;

use HTML;
use Data::Dumper;

use strict;
use GenoGraphics;
use CGI;
my $cgi = new CGI;

use Carp 'cluck';

if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/protein_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/protein_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

my($fig_or_sprout);
if ($cgi->param('SPROUT'))
{
    $fig_or_sprout = new SproutFIG($FIG_Config::sproutDB, $FIG_Config::sproutData);
}
else
{
    $fig_or_sprout = new FIG;
}

my $html = [];

unshift @$html, "<TITLE>The SEED Protein Page</TITLE>\n";

my $prot = $cgi->param('prot');
if (! $prot)
{
    unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
    push(@$html,"<h1>Sorry, you need to specify a protein</h1>\n");
    &display_page($fig_or_sprout,$cgi,$html);
    exit;
}

if ($prot !~ /^fig\|/)
{
    my @poss = &by_alias($fig_or_sprout,$prot);

    if (@poss > 0)
    {
	$prot = $poss[0];
    }
    else
    {
	unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
	push(@$html,"<h1>Sorry, $prot appears not to have a FIG id at this point</h1>\n");
	&display_page($fig_or_sprout,$cgi,$html);
	exit;
    }
}


#
#  Allow previous and next actions in calls to the script -- GJO
#

my $adjust = $cgi->param('previous PEG') ? -1 : $cgi->param('next PEG') ? 1 : 0;
if ( $adjust ) {
    my ( $prefix, $protnum ) = $prot =~ /^(.*\.)(\d+)$/;
    if ( $prefix && $protnum ) {
        my $prot2 = $prefix . ($protnum + $adjust);
        if ( &translatable($fig_or_sprout, $prot2 ) ) {
            $prot = $prot2;
            $cgi->delete('prot');
            $cgi->param(-name => 'prot', -value => $prot);
        }
    }
    ( $adjust < 0 ) && $cgi->delete('previous PEG');
    ( $adjust > 0 ) && $cgi->delete('next PEG');
}

my $request = $cgi->param("request") || "";

if    ($request eq "use_protein_tool")       { &use_protein_tool($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "view_annotations")       { &view_annotations($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "view_all_annotations")   { &view_all_annotations($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "aa_sequence")            { &aa_sequence($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "dna_sequence")           { &dna_sequence($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "fast_assign")            { $html = &make_assignment($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "show_coupling_evidence") { &show_coupling_evidence($fig_or_sprout,$cgi,$html,$prot); }
elsif ($request eq "ec_to_maps")             { &show_ec_to_maps($fig_or_sprout,$cgi,$html); }
elsif ($request eq "link_to_map")            { &link_to_map($fig_or_sprout,$cgi,$html); }
elsif ($request eq "fusions")                { &show_fusions($fig_or_sprout,$cgi,$html,$prot); }
else                                         
{ 
    $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
}

&display_page($fig_or_sprout,$cgi,$html);
exit;

#==============================================================================
#  use_protein_tool
#==============================================================================

sub use_protein_tool {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;
    my($url,$method,@args,$line,$name,$val);

    my $seq = &get_translation($fig_or_sprout,$prot);
    if (! $seq)
    {
	unshift @$html, "<TITLE>The SEED: Protein Page</TITLE>\n";
	push(@$html,$cgi->h1("Sorry, $prot does not have a translation"));
	return;
    }
    my $protQ = quotemeta $prot;

    my $tool = $cgi->param('tool');
    $/ = "\n//\n";
    my @tools = grep { $_ =~ /^$tool\n/ } `cat $FIG_Config::global/LinksToTools`;
    if (@tools == 1)
    {
	chomp $tools[0];
	(undef,undef,$url,$method,@args) = split(/\n/,$tools[0]);
	my $args = [];
	foreach $line (@args)
	{
	    ($name,$val) = split(/\t/,$line);
	    $val =~ s/FIGID/$prot/;
	    $val =~ s/FIGSEQ/$seq/;
	    $val =~ s/\\n/\n/g;
	    push(@$args,[$name,$val]);
	}
	unshift @$html, "<TITLE>The SEED: Protein Tool</TITLE>\n";
	push(@$html,&HTML::get_html($url,$method,$args));
    }
}

#==============================================================================
#  make_assignment
#==============================================================================

sub make_assignment {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;
    my($userR);

    my $function = $cgi->param('func');
    my $user     = $cgi->param('user');

    if ($function && $user && $prot)
    {
	if ($user =~ /master:(.*)/)
	{
	    $userR = $1;
	    &assign_function($fig_or_sprout,$prot,"master",$function,"");
	    &add_annotation($fig_or_sprout,$prot,$userR,"Set master function to\n$function\n");
	}
	else
	{
	    &assign_function($fig_or_sprout,$prot,$user,$function,"");
	    &add_annotation($fig_or_sprout,$prot,$user,"Set function to\n$function\n");
	}
    }
    $cgi->delete("request");
    $cgi->delete("func");
    $html = &show_html_followed_by_initial($fig_or_sprout,$cgi,$html,$prot);
    return $html;
}

#==============================================================================
#  view_annotations
#==============================================================================

sub view_annotations {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
    my $col_hdrs = ["who","when","annotation"];
    my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } &feature_annotations($fig_or_sprout,$prot) ];
    if (@$tab > 0)
    {
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $prot"));
    }
    else
    {
	push(@$html,"<h1>No Annotations for $prot</h1>\n");
    }
}

sub view_all_annotations {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my($ann);

    unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
    if (&is_real_feature($fig_or_sprout,$peg))
    {
	my $col_hdrs = ["who","when","PEG","genome","annotation"];
	my @related  = &related_by_func_sim($fig_or_sprout,$peg,$cgi->param('user'));
	push(@related,$peg);

	my @annotations = &merged_related_annotations($fig_or_sprout,\@related);

	my $tab = [ map { $ann = $_; 
			  [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
			   &genus_species($fig_or_sprout,&genome_of($ann->[0])),
			   "<pre>" . $ann->[3] . "</pre>"
			   ] } @annotations];
	if (@$tab > 0)
	{
	    push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
	}
	else
	{
	    push(@$html,"<h1>No Annotations for $peg</h1>\n");
	}
    }
}

#==============================================================================
#  show_coupling_evidence
#==============================================================================

sub show_coupling_evidence {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my($pair,$peg1,$peg2,$link1,$link2);

    unshift @$html, "<TITLE>The SEED: Functional Coupling</TITLE>\n";
    my $user = $cgi->param('user');
    my $to   = $cgi->param('to');
    my @coup = grep { $_->[1] eq $to } &coupling_and_evidence($fig_or_sprout,$peg,5000,1.0e-10,4);

    if (@coup != 1) 
    {
	push(@$html,"<h1>Sorry, no evidence that $peg is coupled to $to</h1>\n");
    }
    else
    {
	my $col_hdrs = ["Peg1","Organism1","Function1","Peg2","Organism2","Function2"];
	my $tab = [];
	foreach $pair (@{$coup[0]->[2]})
	{
	    ($peg1,$peg2) = @$pair;
	    $link1 = &HTML::fid_link($cgi,$peg1);
	    $link2 = &HTML::fid_link($cgi,$peg2);
	    push( @$tab, [ $link1,
	                   &org_of($fig_or_sprout,$peg1),
	                   scalar &function_ofS($fig_or_sprout,$peg1,$user),
			   $link2,
			   &org_of($fig_or_sprout,$peg2),
			   scalar &function_ofS($fig_or_sprout,$peg2,$user)
			 ]
	        );
	}
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Evidence that $peg Is Coupled To $to"));
    }
}

#==============================================================================
#  psi_blast_prot_sequence
#==============================================================================

sub psi_blast_prot_sequence {
    my($fig_or_sprout,$cgi,$prot_id) = @_;
}

#==============================================================================
#  show_initial
#==============================================================================

sub show_initial {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    unshift @{$html->{general}}, "<TITLE>The SEED: Protein Page</TITLE>\n";

    my $gs = &org_of($fig_or_sprout,$prot);
    warn "got gs=$gs prot=$prot $fig_or_sprout\n";
    if ($prot =~ /^fig\|\d+\.\d+\.peg/)
    {
	if (! &is_real_feature($fig_or_sprout,$prot))
	{
	    push(@{$html->{general}},"<h1>Sorry, $prot is an unknown identifier</h1>\n");
	}
	else
	{
	    push(@{$html->{general}},"<h1>Protein $prot: $gs</h1>\n");
	    &translation_piece($fig_or_sprout,$cgi,$html->{translate_status});
	    &display_peg($fig_or_sprout,$cgi,$html,$prot);
	}
    }
    else
    {
#	&display_external($fig_or_sprout,$cgi,$html,$prot);
    }
}

#==============================================================================
#  display_peg
#==============================================================================

sub display_peg {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my $loc;

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

    my $half_sz = 5000;
    my $fc = $cgi->param('fc');
    my @fc_data;
    if ($fc)
    {
        # RAE Added the following lines so that you can define this in the URL
	# but the default behavior remains unchanged. I doubt anyone will ever
	# see this, but I use it sometimes to see what happens
	
	my ($bound,$sim_cutoff,$coupling_cutoff)=(5000, 1.0e-10, 4);
	if ($cgi->param('fcbound')) {$bound=$cgi->param('fcbound')}
	if ($cgi->param('fcsim')) {$sim_cutoff=$cgi->param('fcsim')}
	if ($cgi->param('fccoup')) {$coupling_cutoff=$cgi->param('fccoup')}
	
	@fc_data = &coupling_and_evidence($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff);
    }
    else
    {
	@fc_data = ();
    }

    if ($loc = &feature_locationS($fig_or_sprout,$peg))
    {
	my($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
	my $min = &max(0,&min($beg,$end) - $half_sz);
	my $max = &max($beg,$end) + $half_sz;
	warn "display_peg: min=$min max=$max beg=$beg end=$end\n";
	my($feat,$min,$max) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);

	my ($beg,$end,$genes) = &print_context($fig_or_sprout,$cgi,$html->{contig_context},$peg,$feat,$min,$max);
	&print_graphics_context($beg,$end,$genes,$html->{context_graphic});
    }

    &print_assignments($fig_or_sprout,$cgi,$html->{assgn_for_equiv_prots},$peg);
    &print_kv_pairs($fig_or_sprout,$cgi,$html->{kv_pairs},$peg);
    &print_subsys_connections($fig_or_sprout,$cgi,$html->{subsys_connections},$peg,$user);
    &print_links($fig_or_sprout,$cgi,$html->{links},$peg);

    push @{$html->{javascript}}, "\n", &FIGjs::toolTipScript();

    my $has_translation = &translatable($fig_or_sprout,$peg);
    &print_services($fig_or_sprout,$cgi,$html->{services},$peg,$has_translation,\@fc_data);
    &print_sims_block($fig_or_sprout,$cgi,$html->{similarities},$peg,$user,$has_translation);

    if ($has_translation)
    {
	&show_tools($fig_or_sprout,$cgi,$html->{tools},$peg);
    }
}

################# Table-Driven Show Tools  ############################

sub show_tools {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    $cgi->param(-name => "request",
		-value => "use_protein_tool");
    my $url = $cgi->self_url();

    if (open(TMP,"<$FIG_Config::global/LinksToTools"))
    {
	my $col_hdrs = ["Tool","Description"];
	my $tab = [];

	$/ = "\n//\n";
	while (defined($_ = <TMP>))
	{
	    my($tool,$desc) = split(/\n/,$_);
	    push(@$tab,["<a href=\"$url\&tool=$tool\">$tool</a>",$desc]);
	}
	close(TMP);
	$/ = "\n";
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Tools to Analyze Protein Sequences"));
    }
    $cgi->delete('request');
}

################# Functional Coupling  ############################

sub print_fc {
    my($fig_or_sprout,$cgi,$html,$peg,$fc_data) = @_;
    my($sc,$neigh);
    
    my $user  = $cgi->param('user');
    my @tab   = map { ($sc,$neigh) = @$_;
		      [&ev_link($cgi,$neigh,$sc),$neigh,scalar &function_ofS($fig_or_sprout,$neigh,$user)] 
		    } 
                    @$fc_data;
    if (@tab > 0)
    {
	push(@$html,"<hr>\n");
	my $col_hdrs = ["Score","Peg","Function"];
	push(@$html,&HTML::make_table($col_hdrs,\@tab,"Functional Coupling"));
    }
}

sub ev_link {
    my($cgi,$neigh,$sc) = @_;

    my $prot = $cgi->param('prot');
    my $link = $cgi->url() . "?request=show_coupling_evidence&prot=$prot&to=$neigh";
    return "<a href=$link>$sc</a>";
}

################# Assignments  ############################

sub trans_function_of {
    my($cgi,$fig_or_sprout,$peg,$user) = @_;

    if (wantarray())
    {
	my $x;
	my @funcs = &function_ofL($fig_or_sprout,$peg);
	if ($cgi->param('translate'))
	{
	    @funcs = map { $x = $_; $x->[1] = &translate_function($fig_or_sprout,$x->[1]); $x } @funcs;
	}
	return @funcs;
    }
    else
    {
	my $func = &function_ofS($fig_or_sprout,$peg,$user);
	if ($cgi->param('translate'))
	{
	    $func = &translate_function($fig_or_sprout,$func);
	}
	return $func;
    }
}

##########################  Routines that build pieces of HTML ######################


sub print_sims_block {
    my($fig_or_sprout,$cgi,$html,$peg,$user,$has_translation) = @_;

    my $sims = $cgi->param('sims');
    if ((! $sims) && $has_translation)
    {
	my $max_expand = $cgi->param('max_expand') ||  5;   
	my $maxN       = $cgi->param('maxN')       || 50;   #  Default 50, not 5 (GJO)
	my $maxP       = $cgi->param('maxP')       ||  1.0e-5;
	my $ex_raw     = $cgi->param('expand_raw') ||  0;   #  Default 0, not 1 (GJO)
	my $just_fig   = $cgi->param('just_fig')   ||  0;
	my $show_env   = $cgi->param('show_env')   ||  0;
	my $hide_alias = $cgi->param('hide_alias') ||  0;

	push( @$html, $cgi->start_form(-action => "protein.cgi#Similarities"));
	if ($cgi->param('translate'))
	{
	    push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
	}
	my $sprout = $cgi->param('SPROUT') ? 1 : "";

	push( @$html, $cgi->hidden(-name => 'prot', -value => $peg),
	              $cgi->hidden(-name => 'sims', -value => 1),
	              $cgi->hidden(-name => 'fid',  -value => $peg),
	              $cgi->hidden(-name => 'user', -value => $user),
	              $cgi->hidden(-name => 'SPROUT', -value => $sprout),
	              $cgi->submit('Similarities'),
	              " MaxN: ", $cgi->textfield(-name => 'maxN', -size =>  5, -value => $maxN, -override => 1),
	              " Max expand: ", $cgi->textfield(-name => 'max_expand', -size =>  5, -value => $max_expand, -override => 1),
	              " MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
	              " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
	              " Show Env. samples: ", $cgi->checkbox(-name => 'show_env', -value => 1, -checked => $show_env, -override => 1, -label => ""),
	              " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
	              $cgi->end_form
	    );
    }
    elsif ($sims)
    {
	&print_similarities($fig_or_sprout,$cgi,$html,$peg);
    }
}


sub print_services {
    my($fig_or_sprout,$cgi,$html,$peg,$has_translation,$fc_data) = @_;

    my $link1 = $cgi->self_url() . "&request=view_annotations";
    my $link2 = $cgi->self_url() . "&request=view_all_annotations";
    push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
	   
    push(@$html, "<br/>".&FIGGenDB::linkPEGGenDB($peg));
    push(@$html, "<br/>".&FIGGenDB::importOrganismGenDB($peg));

    my $link = $cgi->self_url() . "&request=aa_sequence";
    push(@$html,"<br><a href=$link>Protein Sequence</a>\n");

    $link = $cgi->self_url() . "&request=dna_sequence";
    push(@$html,"<br><a href=$link>DNA Sequence</a>\n");

    $link = $cgi->url();
    $link =~ s/protein.cgi/fid_checked.cgi/;
    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    my $user = $cgi->param('user');
    if (! $user) 
    { 
	$user = "";
    }
    else
    {
	$link = $link . "?SPROUT=$sprout&fid=$prot&user=$user&checked=$prot&assign/annotate=assign/annotate";
	push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
    }

    my $fc = $cgi->param('fc');
    if ((! $fc) && (&feature_locationS($fig_or_sprout,$peg)))
    {
	my $link = $cgi->self_url() . "&fc=1";
	push(@$html,"<br><a href=$link>To Get Detailed Functional Coupling Data</a>\n");
    }
    elsif ($fc)
    {
	&print_fc($fig_or_sprout,$cgi,$html,$peg,$fc_data);
    }

    my $link = $cgi->self_url() . "&request=fusions";
    push(@$html,"<br><a href=$link>To Get Fusion Data</a>\n");

    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    my $link = &cgi_url . "/homologs_in_clusters.cgi?SPROUT=$sprout&prot=$peg&user=$user\n";
    push(@$html,"<br><a href=$link>To Find Homologs in Clusters</a>\n");

    if ((! $cgi->param('compare_region')) && $has_translation)
    {
	my $link = $cgi->self_url() . "&compare_region=1";
	push(@$html,"<br><a href=$link>To Compare Region</a>\n");
    }
    elsif ($cgi->param('compare_region'))
    {
	&print_compared_regions($fig_or_sprout,$cgi,$html,$peg);
    }
}

sub print_assignments {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;
    my($who,$func,$ec,@ecs,@tmp,$id,$i,$master_func,$user_func,$x);

    my $user = $cgi->param('user');
    my @funcs    = map { [$peg,@$_] } &trans_function_of($cgi,$fig_or_sprout,$peg);

    for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne "master"); $i++) {}
    if ($i < @funcs)
    {
	$master_func = $funcs[$i]->[2];
    }
    else
    {
	$master_func = "";
    }

    for ($i=0; ($i < @funcs) && ($funcs[$i]->[1] ne $user); $i++) {}
    if ($i < @funcs)
    {
	$user_func = $funcs[$i]->[2];
    }
    else
    {
	$user_func = $master_func;
    }
    push(@$html,$cgi->h2("Current Assignment: $peg: $user_func"));
    my @maps_to  = grep { $_ ne $peg } map { $_->[0] } &mapped_prot_ids($fig_or_sprout,$peg);
    @funcs = ();
    foreach $id (@maps_to)
    {
	if (($id ne $peg) && (@tmp = &trans_function_of($cgi,$fig_or_sprout,$id)) && (@tmp > 0))
	{
	    push(@funcs, map { $x = $_; [$id,@$_] } @tmp);
	}
    }
    @funcs = map { ($_->[1] eq "master") ? [$_->[0],"",$_->[2]] : $_ } @funcs;
    push(@$html,"<hr>\n");

    if ((@funcs == 0) && (! $user_func))
    {
	push(@$html,$cgi->h1("No function has been assigned"));
    }

    my $tab = [ map { ($id,$who,$func) = @$_; [ &HTML::set_prot_links($cgi,$id),&org_of($fig_or_sprout,$id),$who,($user ? &assign_link($cgi,$func,$user_func) : ""), &set_map_links($fig_or_sprout,&genome_of($peg),$func)] } @funcs ];
    if (@$tab > 0)
    {
	my $col_hdrs = ["Id","Organism","Who","ASSIGN","Assignment"];
	my $title    = "Assignments for Essentially Identical Proteins";
        push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
    }
}
    
sub print_kv_pairs {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    my @attr = &feature_attributes($fig_or_sprout,$peg);
    if (@attr > 0)
    {
	my $tab = [];
	foreach $_ (@attr)
	{
	    my($tag,$val,$url) = @$_;
	    push(@$tab,[$tag,"<a href=\"$url\">$val</a>"]);
	}
	push(@$html,$cgi->br,$cgi->hr,&HTML::make_table(["Key","Value"],$tab,"Attributes"),$cgi->hr);
    }
}

sub print_subsys_connections {
    my($fig_or_sprout,$cgi,$html,$peg,$user) = @_;

    #
    # Show the subsystems in which this protein participates.
    #

    if (my @subsystems = &subsystems_for_peg($fig_or_sprout,$peg))
    {
	push(@$html,
	     $cgi->h2("Subsystems in which this peg is present"));

	my(@hdrs);
	my(@table);

	@hdrs = ("Subsystem", "Role");

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

	for my $ent (@subsystems)
	{
	    my($sub, $role) = @$ent;
	    my $url = $cgi->a({href => "subsys.cgi?SPROUT=$sprout&user=$user&ssa_name=$sub&request=show_ssa"}, $sub);
	    push(@table, [$url, $role]);
	}
	push(@$html, &HTML::make_table(\@hdrs, \@table));
    }
}

sub print_links {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    my @links = &peg_links($fig_or_sprout,$peg)
;
    if (@links > 0)
    {
	my $col_hdrs = [1,2,3,4,5];
	my $title    = "Links to Related Entries in Other Sites";
	my $tab = [];
	my ($n,$i);
	for ($i=0; ($i < @links); $i += 5)
	{
	    $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);
	    push(@$tab,[@links[$i..$n]]);
	}
        push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
    }

    if (! $cgi->param('SPROUT'))
    {
	my $url = &cgi_url . "/add_links.cgi?peg=$peg";
	push(@$html,"<a href=$url>To Add New Links to this Gene</a>\n");
    }
}



################# Similarities  ############################


sub print_similarities {
    my( $fig_or_sprout, $cgi, $html, $peg ) = @_;
    my( $maxN, $maxP, $expand_groups, $ex_checked );

    my $user = $cgi->param('user') || "";
    my $current_func = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);

    $maxN = defined( $cgi->param('maxN') ) ? $cgi->param('maxN') : 5;
    $maxP = defined( $cgi->param('maxP') ) ? $cgi->param('maxP') : 1.0e-5;
    $expand_groups = $cgi->param('expand_groups');
    $ex_checked = $expand_groups ? "checked" : "";

    my $max_expand = $cgi->param('max_expand') || 0;
    my $just_fig   = $cgi->param('just_fig')   || 0;
    my $show_env   = $cgi->param('show_env')   || 0;
    my $hide_alias = $cgi->param('hide_alias') || 0;

    push( @$html, $cgi->hr,
                  "<a name=Similarities>",
                  $cgi->h1('Similarities'),
                  "</a>\n"
        );

    #
    #  Instead of automatically doubling maxN, use the value of
    #  $cgi->param("more similarities") to drive increase in maxN and
    #  max_expand
    #
    if ( $cgi->param('more similarities') ) {
        $maxN       *= 2;
        $max_expand *= 2;
        $cgi->delete('more similarities');
    }

    my ( $prev, $next ) = ( 0, 0 );
    my ( $prefix, $protnum ) = $peg =~ /^(.*\.)(\d+)$/;
    if ( $prefix && $protnum ) {
        $prev = ( $protnum > 1 ) && &translatable($fig_or_sprout, $prefix . ($protnum-1) );
        $next =                     &translatable($fig_or_sprout, $prefix . ($protnum+1) );
    }

    push(@$html, $cgi->start_form(-action => "protein.cgi#Similarities"));

    if ($cgi->param('translate'))
    {
	push(@$html,$cgi->hidden(-name => 'translate', -value => 1));
    }

    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    push(@$html, $cgi->hidden(-name => 'prot', -value => $peg),
	         $cgi->hidden(-name => 'SPROUT', -value => $sprout),
	         $cgi->hidden(-name => 'sims', -value => 1),
	         $cgi->hidden(-name => 'fid',  -value => $peg),
	         $cgi->hidden(-name => 'user', -value => $user),
	         " MaxN: ", $cgi->textfield(-name => 'maxN', -size => 5, -value => $maxN, -override => 1),
	         " Max expand: ", $cgi->textfield(-name => 'max_expand', -size => 5, -value => $max_expand, -override => 1),
	         " MaxP: ", $cgi->textfield(-name => 'maxP', -size => 10, -value => $maxP),
	         " Just FIG Ids: ", $cgi->checkbox(-name => 'just_fig', -value => 1, -checked => $just_fig, -override => 1, -label => ""),
	         " Show Env. samples: ", $cgi->checkbox(-name => 'show_env', -value => 1, -checked => $show_env, -override => 1, -label => ""),
	         " Hide aliases: ", $cgi->checkbox(-name => 'hide_alias', -value => 1, -checked => $hide_alias, -override => 1, -label => ""),
	         $cgi->br,
	         $prev ? $cgi->submit('previous PEG') : (),
	         $cgi->submit('resubmit'),
	         $cgi->submit('more similarities'),
	         $next ? $cgi->submit('next PEG') : (),
	         $cgi->end_form
	 );

    push( @$html, $cgi->hr );

    my $select = $just_fig ? "fig" : "all";
    my @sims = &sims($fig_or_sprout, $peg, $maxN, $maxP, $select, $max_expand );

    if (@sims)
    {
	my @from = $cgi->radio_group(-name => 'from',
				     -nolabels => 1,
	                             -override => 1,
				     -values => ["",$peg,map { $_->id2 } @sims]);

	my $target = "window$$";
	my $sprout = $cgi->param('SPROUT') ? 1 : "";
	# RAE: added a name to the form so tha the javascript works
	push( @$html, $cgi->start_form( -method => 'post',
	                                -target => $target,
	                                -action => 'fid_checked.cgi',
					-name   => 'fid_checked'
	                              ),
	              $cgi->hidden(-name => 'SPROUT', -value => $sprout),
	              $cgi->hidden(-name => 'fid', -value => $peg),
	              $cgi->hidden(-name => 'user', -value => $user),
	              $cgi->br,
	              "For Selected (checked) sequences: ",
	                   $cgi->submit('align'),
	                   $cgi->submit('view annotations'),
	                   $cgi->submit('show regions')
	    );

	if ($user)
	{   my $help_url = "Html/help_for_assignments_and_rules.html";
	    push ( @$html, $cgi->br, $cgi->br,
		           "<a href=$help_url>Help on Assignments, Rules, and Checkboxes</a>",
		           $cgi->br, $cgi->br,
		           $cgi->submit('assign/annotate')
		 );

	    if ($cgi->param('translate'))
	    {
		push( @$html, $cgi->submit('add rules'),
		              $cgi->submit('check rules'),
		              $cgi->br
		    );
	    }
	}

	push( @$html, $cgi->br,
	              $cgi->checkbox( -name    => 'checked',
	                              -value   => $peg,
				      -override => 1,
	                              -checked => 1,
	                              -label   => ""
	                            )
	    );

	my $col_hdrs;
	my $color_help = "(<A href=\"Html/similarity_region_colors.html\">colors explained</A>)";
	if ($user && $cgi->param('translate'))
	{
	    push( @$html, " ASSIGN to/Translate from/SELECT current PEG", $cgi->br,
	                  "ASSIGN/annotate with form: ", shift @from, $cgi->br,
		          "ASSIGN from/Translate to current PEG: ", shift @from
		);
	    $col_hdrs = [ "ASSIGN to<hr>Translate from",
	                  $expand_groups ? "family" : (),
	                  $expand_groups ? "size" : (),
	                  "Similar sequence",
	                  "E-val<br>% iden",
	                  "region in<br>similar sequence<br>$color_help",
	                  "region in<br>$peg<br>$color_help",
	                  "ASSIGN from<hr>Translate to",
			  "In Sub",
	                  "Function",
	                  "Organism",
	                  ! $hide_alias ? "Aliases" : ()
	                ];
	}
	elsif ($user)
	{
	    push( @$html, " ASSIGN to/SELECT current PEG", $cgi->br,
	                  "ASSIGN/annotate with form: ", shift @from, $cgi->br,
		          "ASSIGN from current PEG: ", shift @from
		);
	    $col_hdrs = [ "ASSIGN to<hr>SELECT",
	                  $expand_groups ? "family" : (),
	                  $expand_groups ? "size" : (),
	                  "Similar sequence",
	                  "E-val<br>% iden",
	                  "region in<br>similar sequence<br>$color_help",
	                  "region in<br>$peg<br>$color_help",
	                  "ASSIGN from",
			  "In Sub",
	                  "Function",
	                  "Organism",
	                  ! $hide_alias ? "Aliases" : ()
	                ];
	}
	else
	{
	    push(@$html, " SELECT current PEG", $cgi->br );
	    $col_hdrs = [ "SELECT",
	                  $expand_groups ? "family" : (),
	                  $expand_groups ? "size" : (),
	                  "Similar sequence",
	                  "E-val<br>% iden",
	                  "region in<br>similar sequence<br>$color_help",
	                  "region in<br>$peg<br>$color_help",
			  "In Sub",
	                  "Function",
	                  "Organism",
	                  ! $hide_alias ? "Aliases" : ()
	                ];
	}

        # RAE Add the check all/uncheck all boxes.
        push (@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);
	

	#
	# Total rewrite of sim table code: cleaner program flow; omitting
	# empty columns; colorizing region-of-similarity cells -- GJO
	#
	# Start the similarity table with "Caption" and header row

	my $ncol = @$col_hdrs;
	push( @$html, "<TABLE border cols=$ncol>\n",
	              "\t<Caption><h2>Similarities</h2></Caption>\n",
	              "\t<TR>\n\t\t<TH>",
	              join( "</TH>\n\t\t<TH>", @$col_hdrs ),
	              "</TH>\n\t</TR>\n"
	    );

	#  Add the table data, row-by-row

	my $alia = ! $hide_alias;
	my $sim;
	foreach $sim ( @sims )
	{
	    my $id2  = $sim->id2;
	    if ((! $show_env) && ($id2 =~ /^fig\|99999/))
	    {
		shift @from;
		next;
	    }
	    my $cbox = &translatable($fig_or_sprout,$id2) ?
		       qq(<input type=checkbox name=checked value="$id2">) : "";

	    my( $family, $sz, $funcF, $fam_link );
	    if ($expand_groups && ($id2 =~ /^fig\|/) && ($family = &in_family($fig_or_sprout,$id2)))
	    {
		$sz       = &sz_family($fig_or_sprout,$family);
		$funcF    = html_enc( &family_function($fig_or_sprout,$family) );
		$fam_link = scalar &HTML::family_link( $family, $user );
	    }
	    else
	    {
		$family = $sz = $funcF = $fam_link = "";
	    }

	    my $id2_link = &HTML::set_prot_links($cgi,$id2);
	    chomp $id2_link;

	    my @in_sub  = &peg_to_subsystems($fig_or_sprout,$id2);
	    my $in_sub;
	    if (@in_sub > 0)
	    {
		$in_sub = @in_sub;
	    }
	    else
	    {
		$in_sub = "";
	    }

	    my $psc     = $sim->psc;
	    my $iden    = $sim->iden;
	    my $ln1     = $sim->ln1;
	    my $ln2     = $sim->ln2;
	    my $b1      = $sim->b1;
	    my $e1      = $sim->e1;
	    my $b2      = $sim->b2;
	    my $e2      = $sim->e2;
	    my $d1      = abs($e1 - $b1) + 1;
	    my $d2      = abs($e2 - $b2) + 1;
	    my $reg1    = "$b1-$e1 (<b>$d1/$ln1</b>)";
	    my $color1  = match_color( $b1, $e1, $ln1 );
	    my $reg2    = "$b2-$e2 (<b>$d2/$ln2</b>)";
	    my $color2  = match_color( $b2, $e2, $ln2 );
	    my $radio   = $user ? shift @from : undef;
            my $func2   = html_enc( scalar &trans_function_of( $cgi, $fig_or_sprout, $id2, $user ) );
	    ## RAE Added color3. This will color function tables that do not match the original
	    ## annotation. This makes is a lot easier to see what is different (e.g. caps/spaces, etc)
	    my $color3="#FFFFFF";
	    unless ($func2 eq $current_func) {$color3="#FFDEAD"}
	    
	    if ($funcF && $funcF ne $func2) { $func2 = "$funcF<br>$func2" }

	    #
	    # Colorize organisms:
	    #
	    # my $org     = html_enc( &org_of($fig_or_sprout, $id2 ) );
	    my ($org,$oc) = &org_and_color_of($fig_or_sprout, $id2 );
	    $org        = html_enc( $org );

	    my $aliases = $alia ? html_enc( join( ", ", &feature_aliasesL($fig_or_sprout,$id2) ) )
	                        : undef;

	    #  Okay, everything is calculated, let's "print" the row datum-by-datum:

	    push( @$html, "\t<TR>\n",
	                  #
	                  #  Colorize check box by Domain
	                  #
	                  "\t\t<TD Align=center Bgcolor=$oc>$cbox</TD>\n",
	                  $expand_groups ? "\t\t<TD>$fam_link</TD>/n" : (),
	                  $expand_groups ? "\t\t<TD>$sz</TD>\n" : (),
	                  "\t\t<TD Nowrap>$id2_link</TD>\n",
	                  "\t\t<TD Nowrap>$psc<br>$iden\%</TD>\n",
	                  "\t\t<TD Nowrap Bgcolor=$color2>$reg2</TD>\n",
	                  "\t\t<TD Nowrap Bgcolor=$color1>$reg1</TD>\n",
	                  $user ? "\t\t<TD Align=center>$radio</TD>\n" : (),
		          "\t\t<TD>$in_sub</TD>",
	                  "\t\t<TD Bgcolor=$color3>$func2</TD>\n",
	                  #
	                  #  Colorize organism by Domain
	                  #
	                  # "\t\t<TD>$org</TD>\n",
	                  "\t\t<TD Bgcolor=$oc>$org</TD>\n",
	                  $alia ? "\t\t<TD>$aliases</TD>\n" : (),
	                  "\t</TR>\n"
	        );
	}

	push( @$html, "</TABLE>\n" );
	push( @$html, $cgi->end_form );
    }
}

#
#  Support functions for writing the similarities
#
#  This is a sufficient set of escaping for text in HTML:
#

sub html_enc { $_ = $_[0]; s/\&/&amp;/g; s/\>/&gt;/g; s/\</&lt;/g; $_ }

#
#  Make a background color that reflects the position and extent of a
#  matching region.
#
#      Left side is red; right side is blue.
#      Long match is white or pastel; short match is saturated color.
#

sub match_color {
    my ( $b, $e, $n ) = @_;
    my ( $l, $r ) = ( $e > $b ) ? ( $b, $e ) : ( $e, $b );
    # my $hue = 3/4 * 0.5*($l+$r)/$n - 1/24;
    my $hue = 5/6 * 0.5*($l+$r)/$n - 1/12;
    my $cov = ( $r - $l + 1 ) / $n;
    my $sat = 1 - 10 * $cov / 9;
    # my $br  = 0.8 + 0.2 * $cov;
    my $br  = 1;
    rgb2html( hsb2rgb( $hue, $sat, $br ) );
}

#
#  Convert HSB to RGB.  Hue is taken to be in range 0 - 1 (red to red);
#

sub hsb2rgb {
    my ( $h, $s, $br ) = @_;
    $h = 6 * ($h - floor($h));      # Hue is made cyclic modulo 1
    if ( $s  > 1 ) { $s  = 1 } elsif ( $s  < 0 ) { $s  = 0 }
    if ( $br > 1 ) { $br = 1 } elsif ( $br < 0 ) { $br = 0 }
    my ( $r, $g, $b ) = ( $h <= 3 ) ? ( ( $h <= 1 ) ? ( 1,      $h,     0      )
                                      : ( $h <= 2 ) ? ( 2 - $h, 1,      0      )
                                      :               ( 0,      1,      $h - 2 )
                                      )
                                    : ( ( $h <= 4 ) ? ( 0,      4 - $h, 1      )
                                      : ( $h <= 5 ) ? ( $h - 4, 0,      1      )
                                      :               ( 1,      0,      6 - $h )
                                      );
    ( ( $r * $s + 1 - $s ) * $br,
      ( $g * $s + 1 - $s ) * $br,
      ( $b * $s + 1 - $s ) * $br
    )
}

#
#  Convert an RGB value to an HTML color string:
#

sub rgb2html {
    my ( $r, $g, $b ) = @_;
    if ( $r > 1 ) { $r = 1 } elsif ( $r < 0 ) { $r = 0 }
    if ( $g > 1 ) { $g = 1 } elsif ( $g < 0 ) { $g = 0 }
    if ( $b > 1 ) { $b = 1 } elsif ( $b < 0 ) { $b = 0 }
    sprintf("\"#%02x%02x%02x\"", int(255.999*$r), int(255.999*$g), int(255.999*$b) )
}

#
#  floor could be gotten from POSIX::, but why bother?
#

sub floor {
    my $x = $_[0];
    defined( $x ) || return undef;
    ( $x >= 0 ) || ( int($x) == $x ) ? int( $x ) : -1 - int( - $x )
}


################# Context on the Chromosome ############################

sub print_context {
    my($fig_or_sprout,$cgi,$html,$peg,$feat,$beg,$end) = @_;

    warn "print_context ", Dumper(@_[1..$#_]);
    if ($beg eq $end) { cluck "Have zero len"; }
    my($contig1,$beg1,$end1,$strand,$max_so_far,$gap,$comment,$fc,$aliases);
    my($why_related,$fid1,$sz,$color,$map,$gg,$n,$link,$in_neighborhood);


    my $user = $cgi->param('user');
    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    push(@$html,$cgi->start_form(-action => &cgi_url . "/chromosomal_clusters.cgi"),
	        $cgi->hidden(-name => 'SPROUT', -value => $sprout),
		$cgi->hidden(-name => "prot", -value => $peg),
		$cgi->hidden(-name => "uni", -value => 1),
	        $cgi->hidden(-name => "user", -value => $user));

    $why_related = "";
    my %in_cluster = map { $_ => 1 } &in_cluster_with($fig_or_sprout,$peg);

    my $col_hdrs = ["fid","starts","ends","size","","gap","req.<br>in<br>pin","fc","neigh","comment","aliases","Related"];
    my($tab) = [];
    my $genes = [];
    
    my $peg_function = &trans_function_of($cgi,$fig_or_sprout,$peg,$user);

    my($role,$role1,%related_roles);
    foreach $role (&roles_of_function($peg_function))
    {
	foreach $role1 (&neighborhood_of_role($fig_or_sprout,$role))
	{
	    $related_roles{$role1} = 1;
	}
    }

    foreach $fid1 (@$feat)
    {
	$fc = $in_cluster{$fid1} ? &pin_link($cgi,$fid1) : "";
	my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid1) );
	($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid1));;
	$strand = ($beg1 < $end1) ? "+" : "-";

        my $function = &function_ofS($fig_or_sprout,$fid1);
        my $uniprot;
        if ($aliases =~ /(uni[^,]+)/) {
             # print STDERR "$1\n";
             $uniprot = $1;
        }
        my $info  = join ('<br/>', "<b>PEG:</b> ".$fid1, "<b>Contig:</b> ".$contig1, "<b>Begin:</b> ".$beg1,  "<b>End:</b> ".$end1,$function ? "<b>Function:</b> ".$function : '', $uniprot ? "<b>Uniprot ID:</b> ".$uniprot : '');


	if     ($fid1 eq $peg)    { $color = "green" }
	elsif  ($fc)              { $color = "blue" }
	else                      { $color = "red" }

	if ($fid1 =~ /peg\.(\d+)$/)
	{
	    $n = $1;
	    $link = $cgi->url() . "?prot=$fid1&user=$user";
	}
	elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)
	{
	    $n = uc $1;
	    $link = "";
	}
	else
	{
	    $n ="";
	    $link = "";
	}
	    
	push(@$genes,[&min($beg1,$end1),&max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link,$info]);
	if ($max_so_far)
	{
	    $gap = (&min($beg1,$end1) - $max_so_far) - 1;
	}
	else
	{
	    $gap = "";
	}
	$max_so_far = &max($beg1,$end1);
	
	
	$in_neighborhood = "";
	if (&ftype($fid1) eq "peg")
	{
	    $comment = &trans_function_of($cgi,$fig_or_sprout,$fid1,$user);
	    foreach $role (&roles_of_function($comment))
	    {
		if ($related_roles{$role})
		{
		    $in_neighborhood = "*";
		}
	    }
	}
	else
	{
	    $comment = "";
	}
	$comment = &set_map_links($fig_or_sprout,&genome_of($fid1),$comment);
	if ($fid1 eq $peg)
	{
	    $comment = "\@bgcolor=\"#00FF00\":$comment";
	}
	$sz = abs($end1-$beg1)+1;

	my $must_have = (($fid1 eq $peg) || (! $fc)) ? "" : $cgi->checkbox(-name => 'must_have', 
                                                                           -value => $fid1, 
                                                                           -checked => 0, 
                                                                           -override => 1, 
                                                                           -label => "");

	push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,$gap,
		    $must_have,
		    $fc,$in_neighborhood,
                    $comment,&HTML::set_prot_links($cgi,$aliases),$why_related]);
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));
    push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);
    return ($beg,$end,$genes);
}

sub print_graphics_context {
    my($beg,$end,$genes,$html) = @_;

    my $map = ["",$beg,$end,$genes];
    my $gg = [$map];
    push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
    return;
}

sub assign_link {
    my($cgi,$func,$existing_func) = @_;
    my($assign_url,$assign_link);

    if ($func && ((! $existing_func) || ($existing_func ne $func)))
    {
	$cgi->delete('request');
	$assign_url  = $cgi->self_url() . "&request=fast_assign&func=$func";  ## must encode
	$assign_link = "<a href=\"$assign_url\">&nbsp;<=&nbsp;</a>";
    }
    else
    {
	$assign_link = "";
    }
    return $assign_link;
}

sub pin_link {
    my($cgi,$peg) = @_;
    my $user = $cgi->param('user');
    $user = defined($user) ? $user : "";

    my $sprout = $cgi->param('SPROUT') ? 1 : "";
    my $cluster_url  = "chromosomal_clusters.cgi?prot=$peg&user=$user&uni=1&SPROUT=$sprout";
    my $cluster_link = "<a href=\"$cluster_url\">*</a>";
    return $cluster_link;
}

sub set_map_links {
    my($fig_or_sprout,$org,$func) = @_;

    if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)
    {
	my $before = $1;
	my $ec     = $2;
	my $after  = $3;
	return &set_map_links($fig_or_sprout,$org,$before) . &set_ec_to_maps($fig_or_sprout,$org,$ec) . &set_map_links($fig_or_sprout,$org,$after);
    }
    return $func;
}

sub set_ec_to_maps {
    my($fig_or_sprout,$org,$ec) = @_;

    my @maps = &ec_to_maps($fig_or_sprout,$ec);
    if (@maps > 0)
    {
	$cgi->delete('request');
	my $url  = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";
	my $link = "<a href=\"$url\">$ec</a>";
	return $link;
    }
    return $ec;
}

sub show_ec_to_maps {
    my($fig_or_sprout,$cgi,$html,$ec) = @_;

    my $ec = $cgi->param('ec');
    if (! $ec)
    {
	push(@$html,$cgi->h1("Missing EC number"));
	return;
    }

    my @maps = &ec_to_maps($fig_or_sprout,$ec);
    if (@maps > 0)
    {
	my $col_hdrs = ["map","metabolic topic"];
	my $map;
	my $tab      = [map { $map = $_; [&map_link($cgi,$map),&map_name($fig_or_sprout,$map)] } @maps];
	push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . &ec_name($fig_or_sprout,$ec)));
    }
}

sub map_link {
    my($cgi,$map) = @_;

    $cgi->delete('request');
    my $url  = $cgi->self_url() . "&request=link_to_map&map=$map";
    my $link = "<a href=\"$url\">$map</a>";
    return $link;
}

sub link_to_map {
    my($fig_or_sprout,$cgi,$html) = @_;

    my $map = $cgi->param('map');
    if (! $map)
    {
	push(@$html,$cgi->h1("Missing Map"));
	return;
    }

    my $org = $cgi->param('org');
    if (! $org)
    {
	push(@$html,$cgi->h1("Missing Org Parameter"));
	return;
    }
    my$user = $cgi->param('user');
    $user = $user ? $user : "";

    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$org";
    my @out = `./show_kegg_map.cgi`;
    &HTML::trim_output(\@out);
    push(@$html,@out);
}
	    
sub aa_sequence {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;
    my($seq,$func,$i);

    unshift @$html, "<TITLE>The SEED: Protein Sequence</TITLE>\n";
    if ($seq = &get_translation($fig_or_sprout,$prot))
    {
	$func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
	push(@$html,$cgi->pre,">$prot $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);
    }
    else
    {
	push(@$html,$cgi->h1("No translation available for $prot"));
    }
}

sub dna_sequence {
    my($fig_or_sprout,$cgi,$html,$fid) = @_;
    my($seq,$func,$i);

    unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
    if ($seq = &dna_seq($fig_or_sprout,&genome_of($fid),&feature_locationS($fig_or_sprout,$fid)))
    {
	$func = &function_ofS($fig_or_sprout,$prot,$cgi->param('user'));
	push(@$html,$cgi->pre,">$fid $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);
    }
    else
    {
	push(@$html,$cgi->h1("No DNA sequence available for $fid"));
    }
}
	             
sub show_fusions {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

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

    $ENV{"REQUEST_METHOD"} = "GET";
    $ENV{"QUERY_STRING"} = "peg=$prot&user=$user&SPROUT=$sprout";
    my @out = `./fusions.cgi`;
    print join("",@out);
    exit;
}

###########################################################################
sub print_compared_regions {
    my($fig_or_sprout,$cgi,$html,$peg) = @_;

    my $sz_region = $cgi->param('sz_region');
    $sz_region = $sz_region ? $sz_region : 16000;

    my $num_close = $cgi->param('num_close');
    $num_close = $num_close ? $num_close : 5;

    my @closest_pegs = &closest_pegs($fig_or_sprout,$peg,$num_close);

    if (@closest_pegs > 0)
    {
	if (&possibly_truncated($fig_or_sprout,$peg))
	{
	    push(@closest_pegs,&possible_extensions($peg,\@closest_pegs));
	}
	@closest_pegs = &sort_fids_by_taxonomy($fig_or_sprout,@closest_pegs);
	unshift(@closest_pegs,$peg);
	my @all_pegs = ();
	my $gg = &build_maps($fig_or_sprout,\@closest_pegs,\@all_pegs,$sz_region);
#warn Dumper($gg);
	my $color_sets = &cluster_genes(\@all_pegs,$peg);
	&set_colors_text_and_links($gg,\@all_pegs,$color_sets);
	################################### add commentary capability

	my @parm_reset_form = ($cgi->hr);
	push(@parm_reset_form,$cgi->start_form(-action => &cgi_url . "/protein.cgi" ));
        my $param;
	foreach $param ($cgi->param())
	{
	    next if (($param eq "sz_region") || ($param eq "num_close"));
	    push(@parm_reset_form,$cgi->hidden(-name => $param, -value => $cgi->param($param)));
	}
	push(@parm_reset_form,
                   "size region: ",
	           $cgi->textfield(-name => 'sz_region', -size =>  10, -value => $sz_region, -override => 1),
	           "&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; ",
	           "Number close genomes: ",
	           $cgi->textfield(-name => 'num_close', -size => 4, -value => $num_close, -override => 1),
	           $cgi->br,
	           $cgi->submit('Reset Parameters')
	     );
	push(@parm_reset_form,$cgi->end_form);
	push(@$html,@parm_reset_form);
####
	my @commentary_form = ();
	my $ctarget = "window$$";
	my $user = $cgi->param('user');
	my $sprout = $cgi->param('SPROUT') ? 1 : "";

	push(@commentary_form,$cgi->start_form(-target => $ctarget,
					       -action => &cgi_url . "/chromosomal_clusters.cgi"
					       ));
	
	push(@commentary_form,$cgi->hidden(-name => 'SPROUT', -value => $sprout),
                              $cgi->hidden(-name => "request", -value => "show_commentary"));
	push(@commentary_form,$cgi->hidden(-name => "prot", -value => $peg));
	push(@commentary_form,$cgi->hidden(-name => "uni", -value => 1));
	push(@commentary_form,$cgi->hidden(-name => "user", -value => $user));

	my($gene,$n,%how_many,$val,@vals,$x);
	my($i,$map);
	@vals = ();
	for ($i=(@$gg - 1); ($i >= 0); $i--)
	{
	    my @vals1 = ();
	    $map = $gg->[$i];
	    my $found = 0;
	    my $got_red = 0;
	    undef %how_many;
	    foreach $gene (@{$map->[3]})
	    {
		if (($x = $gene->[3]) ne "grey")
		{
		    $n = $gene->[4];
		    if ($n == 1) { $got_red = 1 }
		    $how_many{$n}++;
		    $gene->[5] =~ /(fig\|\d+\.\d+\.peg\.\d+)/;
		    $val = join("@",($n,$i,$1,$map->[0],$how_many{$n}));
		    push(@vals1,$val);
		    $found++;
		}
	    }
	    
	    if (! $got_red)
	    {
		splice(@$gg,$i,1);
	    }
	    else
	    {
		push(@vals,@vals1);
	    }
	}

	if (@$gg == 0)
	{
	    push(@$html,$cgi->h1("Sorry, no pins worked out"));
	}
	else
	{
	    push(@commentary_form,$cgi->hidden(-name => "show", -value => [@vals]));
	    push(@commentary_form,$cgi->submit('commentary'));
	    push(@commentary_form,$cgi->end_form());
	    push(@$html,@commentary_form);
	}
        ################################################################end commentary
	push(@$html,@{ &GenoGraphics::render($gg,700,4,0,2) });
	push @$html, &FIGGenDB::linkClusterGenDB($peg);
    }
}

sub closest_pegs {
    my($fig_or_sprout,$peg,$n) = @_;
    my($id2,$d,$peg2,$i);

    my @closest = map { $id2 = $_->id2; ($id2 =~ /^fig\|/) ? $id2 : () } &sims($fig_or_sprout,$peg,5,1.0e-20,"all");

    if (@closest > $n) { $#closest = $n-1 }
    my %closest = map { $_ => 1 } @closest;
    my @pinned_to = grep { $_ ne $peg} &in_pch_pin_with($fig_or_sprout,$peg);
    my $g1 = &genome_of($peg);
    @pinned_to = 
	map {$_->[1] }
	sort { $a->[0] <=> $b->[0] }
	map { $peg2 = $_; $d = &crude_estimate_of_distance($fig_or_sprout,$g1,&genome_of($peg2)); [$d,$peg2] }
	@pinned_to;

    for ($i=0; ($i < @pinned_to) && ($i < $n); $i++)
    {
	$closest{$pinned_to[$i]} = 1;
    }
    return return keys(%closest);
}

sub build_maps {
    my($fig_or_sprout,$pinned_pegs,$all_pegs,$sz_region) = @_;
    my($gg,$loc,$contig,$beg,$end,$mid,$min,$max,$genes,$feat,$fid);
    my($contig1,$beg1,$end1,$map,$peg);

    $gg = [];
    foreach $peg (@$pinned_pegs)
    {
	$loc = &feature_locationS($fig_or_sprout,$peg);
	($contig,$beg,$end) = &boundaries_of($fig_or_sprout,$loc);
	if ($contig && $beg && $end)
	{
	    $mid = int(($beg + $end) / 2);
	    $min = int($mid - ($sz_region / 2));
	    $max = int($mid + ($sz_region / 2));
	    $genes = [];
	    ($feat,undef,undef) = &genes_in_region($fig_or_sprout,&genome_of($peg),$contig,$min,$max);
	    foreach $fid (@$feat)
	    {
		($contig1,$beg1,$end1) = &boundaries_of($fig_or_sprout,&feature_locationS($fig_or_sprout,$fid));
		$beg1 = &in_bounds($min,$max,$beg1);
		$end1 = &in_bounds($min,$max,$end1);
		my $aliases = join( ', ', &feature_aliasesL($fig_or_sprout,$fid) );
		my $function = &function_ofS($fig_or_sprout,$fid);
        	my $uniprot;
        	if ($aliases =~ /(uni[^,]+)/) {
             	    $uniprot = $1;
        	}
        	my $info  = join ('<br/>', "<b>PEG:</b> ".$fid, "<b>Contig:</b> ".$contig1, "<b>Begin:</b> ".$beg1,  "<b>End:</b> ".$end1,$function ? "<b>Function:</b> ".$function : '', $uniprot ? "<b>Uniprot ID:</b> ".$uniprot : '');

		my $sprout = $cgi->param('SPROUT') ? 1 : "";
		my $fmg = join ('<br/>', "<a href=\&quot;protein.cgi?SPROUT=$sprout&compare_region=1\&prot=$fid\&user=\&quot>show</a>",
					"<a onClick=\&quot;setValue('bound1', '$fid'); return false;\&quot;>set bound 1</a>",
					"<a onClick=\&quot;setValue('bound2', '$fid'); return false;\&quot;>set bound 2</a>",
					"<a onClick=\&quot;setValue('candidates', '$fid'); return false;\&quot;>set candidate</a>");

		push(@$genes,[&min($beg1,$end1),
			      &max($beg1,$end1),
			      ($beg1 < $end1) ? "rightArrow" : "leftArrow",
			      "grey",
			      "",
			      $fid, 
			      $info, $fmg]);

		if ($fid =~ /peg/)
		{
		    push(@$all_pegs,$fid);
		}
	    }
	    $map = [&abbrev(&org_of($fig_or_sprout,$peg)),0,$max+1-$min,
		    ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)];
	    push(@$gg,$map);
	}
    }
    &GenoGraphics::disambiguate_maps($gg);
    return $gg;
}

sub in {
    my($x,$xL) = @_;
    my($i);

    for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
    return ($i < @$xL);
}

sub in_bounds {
    my($min,$max,$x) = @_;

    if     ($x < $min)     { return $min }
    elsif  ($x > $max)     { return $max }
    else                   { return $x   }
}

sub decr_coords {
    my($genes,$min) = @_;
    my($gene);

    foreach $gene (@$genes)
    {
	$gene->[0] -= $min;
	$gene->[1] -= $min;
    }
    return $genes;
}

sub flip_map {
    my($genes,$min,$max) = @_;
    my($gene);
    
    foreach $gene (@$genes)
    {
	($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
	$gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
    }
    return $genes;
}

sub cluster_genes {
    my($all_pegs,$peg) = @_;
    my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);

    my @color_sets = ();

    $conn = &get_connections_by_similarity($all_pegs);
    for ($i=0; ($i < @$all_pegs); $i++)
    {
	if ($all_pegs->[$i] eq $peg) { $pegI = $i }
	if (! $seen{$i})
	{
	    $cluster = [$i];
	    $seen{$i} = 1;
	    for ($j=0; ($j < @$cluster); $j++)
	    {
		$x = $conn->{$cluster->[$j]};
		foreach $k (@$x)
		{
		    if (! $seen{$k})
		    {
			push(@$cluster,$k);
			$seen{$k} = 1;
		    }
		}
	    }

	    if ((@$cluster > 1) || ($cluster->[0] eq $pegI))
	    {
		push(@color_sets,$cluster);
	    }
	}
    }
    for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
    $red_set = $color_sets[$i];
    splice(@color_sets,$i,1);
    @color_sets = sort { @$b <=> @$a } @color_sets;
    unshift(@color_sets,$red_set);

    my $color_sets = {};
    for ($i=0; ($i < @color_sets); $i++)
    {
	foreach $x (@{$color_sets[$i]})
	{
	    $color_sets->{$all_pegs->[$x]} = $i;
	}
    }
    return $color_sets;
}

sub get_connections_by_similarity {
    my($all_pegs) = @_;
    my($i,$j,$tmp,$peg,%pos_of);
    my($sim,%conn,$x,$y);

    for ($i=0; ($i < @$all_pegs); $i++)
    {
	$tmp = &maps_to_id($fig_or_sprout,$all_pegs->[$i]);
	push(@{$pos_of{$tmp}},$i);             # map the representative in nr to subscript in all_pegs
	if ($tmp ne $all_pegs->[$i])
	{
	    push(@{$pos_of{$all_pegs->[$i]}},$i);
	}
    }

    foreach $y (keys(%pos_of))
    {
	$x = $pos_of{$y};
	for ($i=0; ($i < @$x); $i++)
	{
	    for ($j=$i+1; ($j < @$x); $j++)
	    {
		push(@{$conn{$x->[$i]}},$x->[$j]);
		push(@{$conn{$x->[$j]}},$x->[$i]);
	    }
	}
    }

    for ($i=0; ($i < @$all_pegs); $i++)
    {
	foreach $sim (&sims($fig_or_sprout,$all_pegs->[$i],500,1.0e-5,"raw"))
	{
	    if (defined($x = $pos_of{$sim->id2}))
	    {
		foreach $y (@$x)
		{
		    push(@{$conn{$i}},$y);
		}
	    }
	}
    }
    return \%conn;
}

sub set_colors_text_and_links {
    my($gg,$all_pegs,$color_sets) = @_;
    my($map,$gene,$peg,$color);

    foreach $map (@$gg)
    {
	foreach $gene (@{$map->[3]})
	{
	    $peg = $gene->[5];
	    if (defined($color = $color_sets->{$peg}))
	    {
		$gene->[3] = ($color == 0) ? "red" : "color$color";
		$gene->[4] = $color + 1;
	    }
	    $gene->[5] = &peg_url($cgi,$peg);
	}
    }
}

sub peg_url {
    my($cgi,$peg) = @_;

    my $prot = $cgi->param('prot');
    $cgi->delete('prot');
    my $url  = $cgi->self_url() . "&prot=$peg&compare_region=1";
    $cgi->delete('prot');
    $cgi->param(-name => 'prot', -value => $prot);

    return $url;
}    

sub possible_extensions {
    my($peg,$closest_pegs) = @_;
    my($g,$sim,$id2,$peg1,%poss);

    $g = &genome_of($peg);

    foreach $peg1 (@$closest_pegs)
    {
	if ($g ne &genome_of($peg1))
	{
	    foreach $sim (&sims($fig_or_sprout,$peg1,500,1.0e-5,"all"))
	    {
		$id2 = $sim->id2;
		if (($id2 ne $peg) && ($id2 =~ /^fig\|$g\./) && &possibly_truncated($fig_or_sprout,$id2))
		{
		    $poss{$id2} = 1;
		}
	    }
	}
    }
    return keys(%poss);
}

sub display_page {
    my($fig_or_sprout,$cgi,$html) = @_;

    if (ref($html) eq "ARRAY")
    {
	&HTML::show_page($cgi,$html);
    }
    else
    {
	warn Dumper($html);
	if ($cgi->param('SPROUT'))
	{
	    print "Content-Type: text/html\n";
	    print "\n";
	    my $templ = "$FIG_Config::fig/CGI/Html/Protein_tmpl.html";
	    my $page = new PageBuilder($templ, $html);
	    print $page->Build($templ, $html);
	    $page->Finish();
#	    &HTML::BuildPage($html);
	}
	else
	{
	    my $gathered = [];
	
	    my $section;
	    foreach $section (qw( javascript 
				  general 
				  translate_status 
				  contig_context 
				  context_graphic
				  subsys_connections 
				  assgn_for_equiv_prots
				  links 
				  services 
				  kv_pairs 
				  compare_region 
				  similarities 
				  tools
				  )
			      )
	    {
		if (@{$html->{$section}} > 0)
		{
		    push(@$gathered,@{$html->{$section}});
		    push(@$gathered,$cgi->hr);
		}
	    }
	    pop @$gathered;
	    &HTML::show_page($cgi,$gathered);
	}
    }
}

sub show_html_followed_by_initial {
    my($fig_or_sprout,$cgi,$html,$prot) = @_;

    my %html = ( general               => [],
		 contig_context        => [],
		 context_graphic       => [],
		 subsys_connections    => [],
		 links                 => [],
		 services              => [],
		 translate_status      => [],
		 tools                 => [],
		 kv_pairs              => [],
		 similarities          => [],
		 assgn_for_equiv_prots => [],
		 javascript            => [],
		 compare_region        => []
	       );

    push(@{$html{general}},@$html);
    $html = \%html;
    &show_initial($fig_or_sprout,$cgi,$html,$prot); 
    return $html;
}

sub translation_piece {
    my($fig_or_sprout,$cgi,$html) = @_;

    my $msg;
    my $url = $cgi->self_url();
    if ($cgi->param('translate')) {
	$url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;
	$msg = "Turn Off Function Translation";
    }
    else
    {
	$url .= ";translate=1";
	$msg = "Translate Function Assignments";
    }
    push(@$html, "<a href=\"$url\">$msg</a><br>\n");
}


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

sub by_alias {
    my($fig_or_sprout,$prot) = @_;
    return $fig_or_sprout->by_alias($prot);
}

sub org_of {
    my($fig_or_sprout,$prot) = @_;

    return $fig_or_sprout->org_of($prot);
}

sub is_real_feature {
    my($fig_or_sprout,$prot) = @_;

    return $fig_or_sprout->is_real_feature($prot);
}

sub coupling_and_evidence {
    my($fig_or_sprout,$peg,$bound,$sim_cutoff,$coupling_cutoff) = @_;

    return $fig_or_sprout->coupling_and_evidence($peg,$bound,$sim_cutoff,$coupling_cutoff,"keep");
}

sub feature_locationS {
    my($fig_or_sprout,$peg) = @_;

    return scalar $fig_or_sprout->feature_location($peg);
}

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

    return $fig_or_sprout->boundaries_of($loc);
}


sub in_cluster_with {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->in_cluster_with($peg);
}

sub neighborhood_of_role {
    my($fig_or_sprout,$role) = @_;

    return $fig_or_sprout->neighborhood_of_role($role);
}

sub feature_aliasesL {
    my($fig_or_sprout,$fid) = @_;

    my @tmp = $fig_or_sprout->feature_aliases($fid);
    return @tmp;
}

sub feature_aliasesS {
    my($fig_or_sprout,$fid) = @_;

    return scalar $fig_or_sprout->feature_aliases($fid);
}

sub function_ofL {
    my($fig_or_sprout,$peg) = @_;

    my @tmp = $fig_or_sprout->function_of($peg);
    return @tmp;
}

sub function_ofS {
    my($fig_or_sprout,$peg) = @_;

    return scalar $fig_or_sprout->function_of($peg);
}

sub mapped_prot_ids {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->mapped_prot_ids($peg);
}

sub peg_links {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->peg_links($peg);
}

sub get_translation {
    my($fig_or_sprout,$prot) = @_;

    return $fig_or_sprout->get_translation($prot);
}

sub assign_function {
    my($fig_or_sprout,$prot,$who,$function) = @_;

    $fig_or_sprout->assign_function($prot,$who,$function,"");
}

sub add_annotation {
    my($fig_or_sprout,$prot,$user,$annotation) = @_;

    $fig_or_sprout->add_annotation($prot,$user,$annotation);
}

sub feature_annotations {
    my($fig_or_sprout,$prot) = @_;

    return $fig_or_sprout->feature_annotations($prot);
}

sub related_by_func_sim {
    my($fig_or_sprout,$peg,$user) = @_;

    return $fig_or_sprout->related_by_func_sim($peg,$user);
}

sub merged_related_annotations {
    my($fig_or_sprout,$related) = @_;

    return $fig_or_sprout->merged_related_annotations($related);
}

sub genus_species {
    my($fig_or_sprout,$genome) = @_;

    return $fig_or_sprout->genus_species($genome);
}

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

    return $fig_or_sprout->genes_in_region($genome,$contig,$min,$max);
}

sub translate_function {
    my($fig_or_sprout,$func) = @_;

    return $fig_or_sprout->translate_function($func);
}

sub feature_attributes {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->feature_attributes($peg);
}

sub subsystems_for_peg {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->subsystems_for_peg($peg);
}

sub sims {
    my($fig_or_sprout,$peg,$max,$cutoff,$select,$expand) = @_;

    return $fig_or_sprout->sims($peg,$max,$cutoff,$select,$expand);
}

sub in_family {
    my($fig_or_sprout,$id) = @_;

    return $fig_or_sprout->in_family($id);
}

sub sz_family {
    my($fig_or_sprout,$family) = @_;

    return $fig_or_sprout->sz_family($family);
}

sub peg_to_subsystems {
    my($fig_or_sprout,$id) = @_;

    return $fig_or_sprout->peg_to_subsystems($id);
}

sub org_and_color_of {
    my($fig_or_sprout,$id) = @_;

    return $fig_or_sprout->org_and_color_of($id);
}

sub ec_to_maps {
    my($fig_or_sprout,$ec) = @_;

    return $fig_or_sprout->ec_to_maps($ec);
}

sub map_name {
    my($fig_or_sprout,$map) = @_;

    return $fig_or_sprout->map_name($map);
}

sub ec_name {
    my($fig_or_sprout,$ec) = @_;
    
    return $fig_or_sprout->ec_name($ec);
}

sub dna_seq {
    my($fig_or_sprout,$genome,$loc) = @_;

    return $fig_or_sprout->dna_seq($genome,$loc);
}

sub possibly_truncated {
    my($fig_or_sprout,$id) = @_;

    return $fig_or_sprout->possibly_truncated($id);
}

sub sort_fids_by_taxonomy {
    my($fig_or_sprout,@fids) = @_;

    return $fig_or_sprout->sort_fids_by_taxonomy(@fids);
}

sub in_pch_pin_with {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->in_pch_pin_with($peg);
}

sub crude_estimate_of_distance {
    my($fig_or_sprout,$genome1,$genome2) = @_;

    return $fig_or_sprout->crude_estimate_of_distance($genome1,$genome2);
}

sub maps_to_id {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->maps_to_id($peg);
}

sub translatable {
    my($fig_or_sprout,$peg) = @_;

    return $fig_or_sprout->translatable($peg);
}

sub cgi_url {
    return &FIG::plug_url($FIG_Config::cgi_url);
}



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

sub genome_of {
    my $prot_id = (@_ == 1) ? $_[0] : $_[1];    

    if ($prot_id =~ /^fig\|(\d+\.\d+)/) { return $1; }
    return undef;
}

sub min {
    my(@x) = @_;
    my($min,$i);

    (@x > 0) || return undef;
    $min = $x[0];
    for ($i=1; ($i < @x); $i++)
    {
	$min = ($min > $x[$i]) ? $x[$i] : $min;
    }
    return $min;
}

sub max {
    my(@x) = @_;
    my($max,$i);

    (@x > 0) || return undef;
    $max = $x[0];
    for ($i=1; ($i < @x); $i++)
    {
	$max = ($max < $x[$i]) ? $x[$i] : $max;
    }
    return $max;
}


sub roles_of_function {
    my $func = (@_ == 1) ? $_[0] : $_[1];    

    return (split(/\s*[\/;]\s+/,$func),($func =~ /\d+\.\d+\.\d+\.\d+/g));
}

sub ftype {
    my($feature_id) = @_;

    if ($feature_id =~ /^fig\|\d+\.\d+\.([^\.]+)/)
    {
	return $1;
    }
    return undef;
}

sub abbrev {
    my($genome_name) = @_;

    return &FIG::abbrev($genome_name);
}


MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3