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

View of /FigWebServices/ssa2.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.50 - (download) (annotate)
Mon Dec 5 19:12:12 2005 UTC (13 years, 11 months ago) by olson
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, rast_rel_2014_0912, rast_rel_2008_06_18, myrast_rel40, rast_rel_2008_06_16, mgrast_dev_05262011, rast_rel_2008_12_18, mgrast_dev_04082011, rast_rel_2008_07_21, rast_rel_2010_0928, rast_2008_0924, mgrast_version_3_2, mgrast_dev_12152011, rast_rel_2008_04_23, mgrast_dev_06072011, rast_rel_2008_09_30, rast_rel_2009_0925, rast_rel_2010_0526, rast_rel_2014_0729, mgrast_dev_02212011, rast_rel_2010_1206, caBIG-05Apr06-00, mgrast_release_3_0, mgrast_dev_03252011, rast_rel_2010_0118, mgrast_rel_2008_0924, mgrast_rel_2008_1110_v2, rast_rel_2009_02_05, rast_rel_2011_0119, mgrast_rel_2008_0625, mgrast_release_3_0_4, mgrast_release_3_0_2, mgrast_release_3_0_3, mgrast_release_3_0_1, mgrast_dev_03312011, mgrast_release_3_1_2, mgrast_release_3_1_1, mgrast_release_3_1_0, mgrast_dev_04132011, rast_rel_2008_10_09, mgrast_dev_04012011, rast_release_2008_09_29, mgrast_rel_2008_0806, mgrast_rel_2008_0923, mgrast_rel_2008_0919, rast_rel_2009_07_09, rast_rel_2010_0827, mgrast_rel_2008_1110, myrast_33, rast_rel_2011_0928, rast_rel_2008_09_29, mgrast_rel_2008_0917, rast_rel_2008_10_29, mgrast_dev_04052011, mgrast_dev_02222011, caBIG-13Feb06-00, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07, HEAD
Changes since 1.49: +17 -0 lines
add license words

# -*- perl -*-
#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#


use FIG;

my $fig = new FIG;
 
use HTML;
use strict;
use tree_utilities;

use CGI;
my $cgi = new CGI;

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

my $request = $cgi->param("request");
if ($request && ($request eq "show_tree"))
{
    print $cgi->header;
    &show_tree;
    exit;
}

# RAE: Added a title to the page
my $html = ["<title>The SEED: Subsytems Analysis</title>\n"];

my $user = $cgi->param('user');
if ((! $user) || ($user !~ /^master:\S+/))
{
    push(@$html,$cgi->h1("Sorry, you need to specify a master user to modify subsystem annotations"));
}
elsif ($cgi->param("export_align_input"))
{
    print $cgi->header;
    print "exporting alignment input\n";
    exit;
}
elsif ($cgi->param("extend_with_billogix"))
{
    #
    # Start bg task to extend the subsystem.
    #

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

    my $sub = $fig->get_subsystem($ssa);
    my $mode = "regular";

    TEST:
    {
	if ($sub)
	{
	    #
	    # See if there's already an extend job running.
	    #
	    
	    my $curpid = $sub->get_current_extend_pid();
	    if ($curpid)
	    {
		warn "Found current pid $curpid\n";
		my $j = $fig->get_job($curpid);
		warn "job is $j\n";
		warn "running is ", $j->running(), "\n" if $j;
		if ($j && $j->running())
		{
		    push(@$html, "Subsystem extension is already running as job number $curpid. <br>",
			 "Click <a href=\"seed_ctl.cgi\">here</a> to see currently running jobs and their status");
		    last;
		}
	    }
	    
	    my $pid = $fig->run_in_background(sub {
		$sub->extend_with_billogix($user);
	    });
	    
	    push(@$html,
		 "Subsystem extension started as background job number $pid <br>\n",
		 "Click <a href=\"seed_ctl.cgi\">here</a> to see currently running jobs and their status");
	    
	    $sub->set_current_extend_pid($pid);
	}
	else
	{
	    push(@$html, "Subsystem '$ssa' could not be loaded");
	}
    }
    &HTML::show_page($cgi, $html);

    exit;
    
}


elsif ($cgi->param("extend_NMPDR_with_billogix"))
{
    #
    # Start bg task to extend the subsystem.
    #

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

    my $sub = $fig->get_subsystem($ssa);
    my $mode = "NMPDR";

    TEST:
    {
	if ($sub)
	{
	    #
	    # See if there's already an extend job running.
	    #
	    
	    my $curpid = $sub->get_current_extend_pid();
	    if ($curpid)
	    {
		warn "Found current pid $curpid\n";
		my $j = $fig->get_job($curpid);
		warn "job is $j\n";
		warn "running is ", $j->running(), "\n" if $j;
		if ($j && $j->running())
		{
		    push(@$html, "Subsystem extension is already running as job number $curpid. <br>",
			 "Click <a href=\"seed_ctl.cgi\">here</a> to see currently running jobs and their status");
		    last;
		}
	    }
	    
	    my $pid = $fig->run_in_background(sub {
	    my	$genomes = ['159288.1','159289.1','93061.1','196620.1','158878.1','158879.1','243277.1','223926.1','216895.1','196600.1','169963.1','265669.1','192222.1','160490.1','1314.1','198466.1','186103.1','193567.1','216600.1','171101.1','170187.1'];
		$sub->extend_with_billogix($user,$genomes);
	    });
	    
	    push(@$html,
		 "Subsystem extension started as background job number $pid <br>\n",
		 "Click <a href=\"seed_ctl.cgi\">here</a> to see currently running jobs and their status");
	    
	    $sub->set_current_extend_pid($pid);
	}
	else
	{
	    push(@$html, "Subsystem '$ssa' could not be loaded");
	}
    }
    &HTML::show_page($cgi, $html);

    exit;
    
}


elsif ($cgi->param("extend_CYANOS_with_billogix"))
{
    #
    # Start bg task to extend the subsystem.
    #
    warn "using cyanos version";
    my $ssa = $cgi->param('ssa_name');
    my $user = $cgi->param('user');

    my $sub = $fig->get_subsystem($ssa);
    my $mode = "CYANOS";

    TEST:
    {
	if ($sub)
	{
	    #
	    # See if there's already an extend job running.
	    #
	    
	    my $curpid = $sub->get_current_extend_pid();
	    if ($curpid)
	    {
		warn "Found current pid $curpid\n";
		my $j = $fig->get_job($curpid);
		warn "job is $j\n";
		warn "running is ", $j->running(), "\n" if $j;
		if ($j && $j->running())
		{
		    push(@$html, "Subsystem extension is already running as job number $curpid. <br>",
			 "Click <a href=\"seed_ctl.cgi\">here</a> to see currently running jobs and their status");
		    last;
		}
	    }
	    
	    my $pid = $fig->run_in_background(sub {
		my $genomes = ['1140.1','84588.1','1148.1','167540.1','74547.1','167539.1','59919.1','240292.1','3702.1','251221.1','165597.1','63737.1','103690.1','39947.1','197221.1','203124.1'];
		$sub->extend_with_billogix($user,$genomes);
	    });
	    
	    push(@$html,
		 "Subsystem extension started as background job number $pid <br>\n",
		 "Click <a href=\"seed_ctl.cgi\">here</a> to see currently running jobs and their status");
	    
	    $sub->set_current_extend_pid($pid);
	}
	else
	{
	    push(@$html, "Subsystem '$ssa' could not be loaded");
	}
    }
    &HTML::show_page($cgi, $html);

    exit;
    
}



else
{
    $request = defined($request) ? $request : "";

    if    ($request eq "reset")
    {
	&reset_ssa($fig,$cgi,$html);
    }
    elsif    ($request eq "reset_to")
    {
	&reset_ssa_to($fig,$cgi,$html);
	&show_ssa($fig,$cgi,$html);
    }
    elsif    ($request eq "make_exchangable")
    {
	&make_exchangable($fig,$cgi,$html);
	&show_initial($fig,$cgi,$html);
    }
    elsif    ($request eq "make_unexchangable")
    {
	&make_unexchangable($fig,$cgi,$html);
	&show_initial($fig,$cgi,$html);
    }
    elsif    ($request eq "show_ssa")
    {
	&show_ssa($fig,$cgi,$html);
    }
    elsif ($request eq "show_ssa_noload")
    {
	&show_ssa_noload($fig,$cgi,$html);
    }
    #
    # Note that this is a little different; I added another submit button
    # to the delete_or_export_ssa form, so have to distinguish between them
    # here based on $cgi->param('delete_export') - the original button,
    # or $cgi->param('publish') - the new one.
    #
    elsif ($request eq "delete_or_export_ssa" and
	   defined($cgi->param('delete_export')))
    {
	my($ssa,$exported);
	$exported = 0;
	foreach $ssa ($cgi->param('export'))
	{
	    if (! $exported)
	    {
		print $cgi->header;
		print "<pre>\n";
	    }
	    &export($fig,$cgi,$ssa);
	    $exported = 1;
	}

	foreach $ssa ($cgi->param('export_assignments'))
	{
	    &export_assignments($fig,$cgi,$ssa);
	}

	foreach $ssa ($cgi->param('delete'))
	{
	    my $sub = $fig->get_subsystem($ssa);
	    $sub->delete_indices();
	    
	    my $cmd = "rm -rf '$FIG_Config::data/Subsystems/$ssa'";
	    my $rc = system $cmd;
	}

	if (! $exported)
	{
	    &show_initial($fig,$cgi,$html);
	}
	else
	{
	    print "</pre>\n";
	    exit;
	}
    }
    elsif ($request eq "delete_or_export_ssa" and
	   defined($cgi->param('publish')))
    {
	my($ssa,$exported);
	my($ch) = $fig->get_clearinghouse();

	print $cgi->header;

	if (!defined($ch))
	{
	    print "cannot publish: clearinghouse not available\n";
	    exit;
	}
	
	foreach $ssa ($cgi->param('publish_to_clearinghouse'))
	{
	    print "<h2>Publishing $ssa to clearinghouse...</h2>\n";
	    $| = 1;
	    print "<pre>\n";
	    my $res = $fig->publish_subsystem_to_clearinghouse($ssa);
	    print "</pre>\n";
	    if ($res)
	    {
		print "Published <i>$ssa </i> to clearinghouse<br>\n";
	    }
	    else
	    {
		print "<b>Failed</b> to publish <i>$ssa</i> to clearinghouse<br>\n";
	    }
	}
	exit;
    }
    elsif (($request eq "new_ssa") && ($cgi->param('copy_from1')) && (! $cgi->param('cols_to_take1')))
    {
	my $user = $cgi->param('user');
	my $name = $cgi->param('ssa_name');
	my $copy_from1 = $cgi->param('copy_from1');
	my $copy_from2 = $cgi->param('copy_from2');
        my(@roles1,@roles2);

	push(@$html,$cgi->start_form(-action => "ssa2.cgi",
				     -method => 'post'),
	            $cgi->hidden(-name => 'copy_from1', -value => $copy_from1, -override => 1),
	            $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	            $cgi->hidden(-name => 'ssa_name', -value => $name, -override => 1),
	            $cgi->hidden(-name => 'request', -value => 'new_ssa', -override => 1)
	     );

	@roles1 = $fig->subsystem_to_roles($copy_from1);
	if (@roles1 > 0)
	{
	    push(@$html,$cgi->h1("select columns to be taken from $copy_from1"),
		        $cgi->scrolling_list(-name => 'cols_to_take1',
					     -values => ['all',@roles1],
					     -size => 10,
					     -multiple => 1
					     ),
		        $cgi->hr
	     );
	}

	if ($copy_from2)
	{
	    @roles2 = $fig->subsystem_to_roles($copy_from2);
	    if (@roles2 > 0)
	    {
		push(@$html,$cgi->hidden(-name => 'copy_from2', -value => $copy_from2, -override => 1));
		push(@$html,$cgi->h1("select columns to be taken from $copy_from2"),
		            $cgi->scrolling_list(-name => 'cols_to_take2',
						 -values => ['all',@roles2],
						 -size => 10,
						 -multiple => 1
						 ),
		            $cgi->hr
		     );
	    }
	}
	push(@$html,$cgi->submit('build new subsystem'),
	            $cgi->end_form
	     );
    }
    elsif ($request eq "new_ssa")
    {
	&new_ssa($fig,$cgi,$html);
    }
    else
    {
	&show_initial($fig,$cgi,$html);
    }
}

&HTML::show_page($cgi,$html);
exit;


#=============================================================================
#  Just subroutines below here
#=============================================================================

sub show_initial {
    my($fig,$cgi,$html) = @_;
    my($set,$when,$comment);

    my $user = $cgi->param('user');
    my @ssa = &existing_subsystem_annotations;

    if (@ssa > 0)
    {
	&format_ssa_table($cgi,$html,$user,\@ssa);
    }

    my $target = "window$$";
    push(@$html, $cgi->h1('To Start or Copy a Subsystem'),
                 $cgi->start_form(-action => "ssa2.cgi",
				  -target => $target,
				  -method => 'post'),
	         $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	         $cgi->hidden(-name => 'request', -value => 'new_ssa', -override => 1),
	         "Name of New Subsystem: ",
	         $cgi->textfield(-name => "ssa_name", -size => 50),
	         $cgi->hidden(-name => 'can_alter', -value => 1, -override => 1),
	         $cgi->br,

	         "Copy from (leave blank to start from scratch): ",
	         $cgi->textfield(-name => "copy_from1", -size => 50),
	         $cgi->br,

	         "Copy from (leave blank to start from scratch): ",
	         $cgi->textfield(-name => "copy_from2", -size => 50),
	         $cgi->br,

	         $cgi->submit('start new subsystem'),
	         $cgi->end_form,
	         "<br>You can start a subsystem from scratch, in which case you should leave these two \"copy from\"
fields blank.  If you wish to just copy a subsystem (in order to become the owner so that you can modify it),
just fill in one of the \"copy from\" fields with the name of the subsystem you wish to copy.  If you wish to
extract a a subset of the columns to build a smaller spreadsheet (which could later be merged with another one),
fill in the name of the subsystem.  You will be prompted for the columns that you wish to extract (choose <i>all</i> to
just copy all of the columns).  Finally, if you wish to build a new spreadsheet by including columns from two existing
spreadsheets (including a complete merger), fill in the names of both the existing \"copy from\" subsystems"
	 );
}		  

sub new_ssa {
    my($fig,$cgi,$html) = @_;

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

    if  (! $user)
    {
	push(@$html,$cgi->h1('You need to specify a user before starting a new subsystem annotation'));
	return;
    }

    if  (! $name)
    {
	push(@$html,$cgi->h1('You need to specify a subsystem name'));
	return;
    }

    my $ssa  = $name;
    $ssa =~ s/[ \/]/_/g;
    &FIG::verify_dir("$FIG_Config::data/Subsystems");

    if (-d "$FIG_Config::data/Subsystems/$ssa")
    {
	push(@$html,$cgi->h1("You need to specify a new subsystem name; $ssa already is being used"));
	return;
    }
    mkdir("$FIG_Config::data/Subsystems/$ssa",0777)
	|| die "could not make $FIG_Config::data/Subsystems/$ssa";
    chmod(0777,"$FIG_Config::data/Subsystems/$ssa");

    open(LOG,">$FIG_Config::data/Subsystems/$ssa/curation.log")
	|| die "could not open $FIG_Config::data/Subsystems/$ssa/curation.log";
    my $time = time;
    print LOG "$time\t$user\tstarted\n";
    close(LOG);
    chmod(0777,"$FIG_Config::data/Subsystems/$ssa");

    my $copy_from1 = $cgi->param('copy_from1');
    $copy_from1 =~ s/[ \/]/_/g;
    my $copy_from2 = $cgi->param('copy_from2');
    $copy_from2 =~ s/[ \/]/_/g;
    my @cols_to_take1 = $cgi->param('cols_to_take1');
    my @cols_to_take2 = $cgi->param('cols_to_take2');
    my @subsys = ([],[],{});   # ([[Abbrev1,Role1],[Abbrev2,Role2],...],[Genome1,Genome2,...],PegHash)
                               # PegHash keys are of the form "$genome\t$role"
    if ($copy_from1 && (@cols_to_take1 > 0))
    {
	&add_to_subsys($fig,$copy_from1,\@cols_to_take1,\@subsys);
    }

    if ($copy_from2 && (@cols_to_take2 > 0))
    {
	&add_to_subsys($fig,$copy_from2,\@cols_to_take2,\@subsys);
    }
    if ((@{$subsys[0]} > 0) && (@{$subsys[1]} > 0))
    {
	# the following is a little ugly.  In order to merge PEGs from two tables,
	# subsys[2]->{$key} was made a hash keyed on peg IDs with values of 1.  The
	# write_subsystem_spreadsheet routine expects a list of peg IDs instead.  The
	# conversion is straightforward, but a bit opaque.
	foreach $_ (keys(%{$subsys[2]}))
	{
	    $subsys[2]->{$_} = [keys(%{$subsys[2]->{$_}})];
	}
	$fig->write_subsystem_spreadsheet($ssa,$subsys[0],$subsys[1],$subsys[2]);

	if ($copy_from1 && (-s "$FIG_Config::data/Subsystems/$copy_from1/notes"))
	{
	    &FIG::run("cat \"$FIG_Config::data/Subsystems/$copy_from1/notes\" >> \"$FIG_Config::data/Subsystems/$ssa/notes\"");
	    chmod(0777,"$FIG_Config::data/Subsystems/$ssa/notes");
	}

	if ($copy_from2 && (-s "$FIG_Config::data/Subsystems/$copy_from2/notes"))
	{
	    &FIG::run("cat \"$FIG_Config::data/Subsystems/$copy_from2/notes\" >> \"$FIG_Config::data/Subsystems/$ssa/notes\"");
	    chmod(0777,"$FIG_Config::data/Subsystems/$ssa/notes");
	}
    }
    $cgi->param(-name => "can_alter",
		-value => 1);
    &show_ssa($fig,$cgi,$html);
}

sub add_to_subsys {
    my($fig,$from,$cols,$subsys) = @_;
    my($genomes,@genomes,$role,$genome,$peg);
    my($roles,%to_add,@to_add);

    (undef,undef,undef,$roles) = $fig->subsystem_info($from);
    my $all = grep { $_ eq "all" } @$cols;

    if (! $all)
    {
	%to_add = map { $_ => 1 } @$cols;
	@to_add = grep { $to_add{$_->[1]} } @$roles; # list of [Abbrev,Role] now
    }
    else
    {
	@to_add = @$roles;
    }
    &add_cols($subsys,\@to_add);
    $genomes = $fig->subsystem_genomes($from);
    @genomes = map { $_->[0] } @$genomes;
    &add_genomes($subsys,\@genomes);

    foreach $role (map { $_->[1] } @to_add)
    {
	foreach $genome (@genomes)
	{
	    foreach $peg ($fig->pegs_in_subsystem_cell($from,$genome,$role))
	    {
		$subsys->[2]->{"$genome\t$role"}->{$peg} = 1;
	    }
	}
    }
}

sub add_cols {
    my($subsys,$roles) = @_;
    my($genome,$i,$role);

    foreach $role (@$roles)
    {
	for ($i=0; ($i < @{$subsys->[0]}) && ($role->[1] ne $subsys->[0]->[$i]->[1]); $i++) {}
	if ($i == @{$subsys->[0]})
	{
	    for ($i=0; ($i < @{$subsys->[0]}) && ($subsys->[0]->[$i]->[0] ne $role->[0]); $i++) {}
	    if ($i < @{$subsys->[0]})
	    {
		$role->[0] .= "*";  # needed to disambiguate abbreviations
	    }
	    push(@{$subsys->[0]},$role);
	}
    }
}

sub add_genomes {
    my($subsys,$genomes) = @_;
    my($genome,$i);

    foreach $genome (@$genomes)
    {
	for ($i=0; ($i < @{$subsys->[1]}) && ($genome ne $subsys->[1]->[$i]); $i++) {}
	if ($i == @{$subsys->[1]})
	{
	    push(@{$subsys->[1]},$genome);
	}
    }
}

sub show_ssa {
    my($fig,$cgi,$html) = @_;

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

    if  (! $user)
    {
	push(@$html,$cgi->h1('You need to specify a user to work on a subsystem annotation'));
	return;
    }

    if  (! $ssa)
    {
	push(@$html,$cgi->h1('You need to specify a subsystem'));
	return;
    }

    my $name  = $ssa;
    $name =~ s/_/ /g;
    $ssa  =~ s/[ \/]/_/g;

    if  (open(SSA,"<$FIG_Config::data/Subsystems/$ssa/spreadsheet"))
    {
	$/ = "//\n";
	my($i,$role,%pos,$subset,$adj_subset,$genome,$row,$abbrev);
	if (defined($_ = <SSA>) && $_)
	{
	    $_ =~ s/\n?\/\/\n//s;
	    $i = 1;
	    foreach $role (split(/\n/,$_))
	    {
		if ($role =~ /^(.*)\t(.*)$/)
		{
		    $role = $2;
		    $abbrev = $1;
		}
		else
		{
		    $abbrev = "";
		}
		$cgi->param(-name => "posR$i", -value => $i);
		$cgi->param(-name => "role$i", -value => $role);
		$cgi->param(-name => "abbrev$i", -value => $abbrev);
		$pos{$role} = $i;
		$i++;
	    }

	    if (defined($_ = <SSA>) && $_)
	    {
		$_ =~ s/\n?\/\/\n//s;
		my($subsetsC,$subsetsR) = split(/\n\n/,$_);
		$i = 1;
		my @subsetsC = split(/\n/,$subsetsC);
		my $active_subsetC = (@subsetsC > 0) ? pop @subsetsC : "All";
		$cgi->param(-name => 'active_subsetC', -value => $active_subsetC);
		foreach $subset (@subsetsC)
		{
		    my($nameCS,@subset_members) = split(/\s+/,$subset);
		    $cgi->param(-name => "nameCS$i", -value => $nameCS);
		    $adj_subset = join(" ",map { $pos{$_} ? $pos{$_} : $_ } @subset_members);
		    $cgi->param(-name => "subsetC$i", -value => $adj_subset);
		    $i++;
		}

		my $active_subsetR = ($subsetsR && ($subsetsR =~ /^(\S[^\n]+\S)/)) ? $1 : "All";
		$cgi->param(-name => 'active_subsetR', -value => $active_subsetR);
		$/ = "\n";
		$i = 1;
	        my(%seen);
		while (defined($_ = <SSA>))
		{
		    chop;
		    my($entry,$checked);
		    my @row = split(/\t/,$_);
	            next if (($seen{$row[0]}) || ($row[0] =~ /^99999/));
	            $seen{$row[0]} = 1;

		    if (@row > 0)
		    {
			$genome = shift @row;
			$cgi->param(-name => "genome$i", -value => $genome);
			$checked = shift @row;
			$cgi->param(-name => "vcode$i", -value => $checked);
		    }
		    else
		    {
			$cgi->param(-name => "vcode$i", -value => 0);
		    }
		    
		    my $j = 1;
		    foreach $entry (@row)
		    {
			$cgi->param(-name => "row$i.$j", -value => $entry);
			$j++;
		    }
		    $i++;
		}
	    }
	    close(SSA);
	}
       
	if (-s "$FIG_Config::data/Subsystems/$ssa/notes")
	{
	    my $notes = &FIG::file_read("$FIG_Config::data/Subsystems/$ssa/notes");
	    if (! $notes)
	    {
		confess "BAD notes";
	    }
	    $cgi->param(-name => 'notes', -value => $notes);
	}
    }
    else
    {
	&format_empty_ssa("$FIG_Config::data/Subsystems/$ssa/spreadsheet");
    }
    &show_ssa_noload($fig,$cgi,$html);
}
	
sub format_empty_ssa {
    my($file) = @_;

    open(SSA,">$file") || die "aborted";
    print SSA "//\nAll\n\n";
    &print_default_genome_set(\*SSA);
    print SSA "//\n";
    close(SSA);
}
    
sub print_default_genome_set {
    my($fh) = @_;

    print $fh &default_genome_set, "\n";
}

sub default_genome_set { 
    return "All";
}

sub show_ssa_noload {
    my($fig,$cgi,$html) = @_;
    my($col);

    my $user = $cgi->param('user');
    my $ssa  = $cgi->param('ssa_name');
    my $can_alter = $cgi->param('can_alter');
    if  (! $user)
    {
	push(@$html,$cgi->h1('You need to specify a user to work on a subsystem annotation'));
	return;
    }

    if  (! $ssa)
    {
	push(@$html,$cgi->h1('You need to specify a subsystem'));
	return;
    }

    my $name  = $ssa;
    
    my $sub_sys = $fig->get_subsystem($name);
    my @genomes_in_sub_sys = $sub_sys->get_genomes();
    my $n = @genomes_in_sub_sys;
    
    $name =~ s/_/ /g;
    $ssa =~ s/[ \/]/_/g;

    push(@$html, $cgi->h1("Subsystem: $name"),
	         $cgi->h1("# of Genomes present: $n"),
                 $cgi->start_form(-action => "ssa2.cgi",
				  -method => 'post'),
	         $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	         $cgi->hidden(-name => 'request', -value => 'show_ssa_noload', -override => 1),
	         $cgi->hidden(-name => 'can_alter', -value => $can_alter, -override => 1),
	         $cgi->hidden(-name => 'ssa_name', -value => $name, -override => 1),
	         $cgi->br,
	 );

    my($roles,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR,$genomes,$rows) = &write_spreadsheet_from_input_parameters($fig,$cgi,$html,$ssa,$user);

    &format_roles($fig,$cgi,$html,$roles,$genomes,$rows);
    &format_subsets($fig,$cgi,$html,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    &format_rows($fig,$cgi,$html,$roles,$genomes,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);

    if ($can_alter)
    {
	&format_extend_with($fig,$cgi,$html,$genomes,$roles);
	push(@$html,$cgi->checkbox(-name => 'precise_fill', -value => 1, -checked => 0, -override => 1,-label => 'fill'),$cgi->br);
	push(@$html,$cgi->br);
	push(@$html,$cgi->submit('update spreadsheet'),$cgi->br);
    }
    
    if ($can_alter)
    {
	#my $genome_list = ['1140.1','84588.1','1148.1','167540.1','74547.1','167539.1','59919.1','240292.1','3702.1','251221.1','165597.1','63737.1','103690.1','39947.1','197221.1','203124.1'];
	&format_extend_with_CYANOS($fig,$cgi,$html,$genomes,$roles);
	push(@$html,$cgi->checkbox(-name => 'precise_fill', -value => 1, -checked => 0, -override => 1,-label => 'fill'),$cgi->br);
	push(@$html,$cgi->br);
	push(@$html,$cgi->submit('update spreadsheet'),$cgi->br);
    }

    if ($can_alter)
    {
	
	#my $genome_list = ['159288.1','159289.1','93061.1','196620.1','158878.1','158879.1','243277.1','223926.1','216895.1','196600.1','169963.1','265669.1','192222.1','160490.1','1314.1','198466.1','186103.1','193567.1','216600.1','171101.1','170187.1'];
	&format_extend_with_NMPDR($fig,$cgi,$html,$genomes,$roles);
	push(@$html,$cgi->checkbox(-name => 'precise_fill', -value => 1, -checked => 0, -override => 1,-label => 'fill'),$cgi->br);
	push(@$html,$cgi->br);
	push(@$html,$cgi->submit('update spreadsheet'),$cgi->br);
    }
    
    else
    {
	push(@$html,$cgi->br);
	push(@$html,$cgi->submit('show spreadsheet'),$cgi->br);

    }
    
    push(@$html, $cgi->a({href => "ss_export.cgi?user=$user&ssa_name=$ssa"},
			 "Export subsystem data"),
	 $cgi->br);
			
    my $expand   = $cgi->param('ignore_alt');
    push(@$html,$cgi->checkbox(-name => 'ignore_alt', -value => 1, -checked => $expand, -override => 1,-label => 'ignore alternatives'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_clusters', -value => 1, -checked => 0, -override => 1,-label => 'show clusters'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_missing', -value => 1, -checked => 0, -override => 1,-label => 'show missing'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_missing_including_matches', -value => 1, -checked => 0, -override => 1,-label => 'show missing with matches'),
	        "&nbsp; &nbsp; [To restrict to a single genome: ",
                $cgi->textfield(-name => "just_genome", -size => 15),"]",
	        $cgi->br
        );
    push(@$html,$cgi->checkbox(-name => 'refill', -value => 1, -checked => 0, -override => 1,-label => 'refill spreadsheet from scratch'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_dups', -value => 1, -checked => 0, -override => 1,-label => 'show duplicates'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'check_problems', -value => 1, -checked => 0, -override => 1,-label => 'show PEGs in roles that do not match precisely'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_excluded', -value => 1, -checked => 0, -override => 1,-label => 'show PEGs that have roles, but not in spreadsheet'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'add_solid', -value => 1, -checked => 0, -override => 1,-label => 'Add Genomes with Solid Hits'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_coupled_fast', -value => 1, -checked => 0, -override => 1,-label => 'show coupled PEGs fast [depends on existing pins/clusters]'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'show_coupled', -value => 1, -checked => 0, -override => 1,-label => 'show coupled PEGs[figure 2 minutes per PEG in spreadsheet]'),$cgi->br);
    push(@$html,$cgi->br,"Align column: ",
	        $cgi->textfield(-name => "col_to_align", -size => 7),
	        $cgi->checkbox(-name => "show_align_input",  -checked => 0,
			       -label => "show input to alignment tool"),
	        $cgi->br,"Include homologs that pass the following threshhold: ",
	        $cgi->textfield(-name => "include_homo", -size => 10)," (leave blank to see just column)",
	        " Max homologous seqs: ",$cgi->textfield(-name => "max_homo", -value => 100, -size => 6),
	     );

    if ($can_alter)
    {
	push(@$html,
	     $cgi->p,
	     $cgi->submit(-value => "Start automated subsystem extension",
			     -name => "extend_with_billogix"),
	     $cgi->br);
    }
    push(@$html, $cgi->hr);
    
    if ($can_alter)
    {
	push(@$html,
	     $cgi->p,
	     $cgi->submit(-value => "Start automated subsystem extension for Phototrophs",
			     -name => "extend_CYANOS_with_billogix"),
	     $cgi->br);
    }
    push(@$html, $cgi->hr);
    
    
    if ($can_alter)
    {
	push(@$html,
	     $cgi->p,
	     $cgi->submit(-value => "Start automated subsystem extension for NMPDR",
			     -name => "extend_NMPDR_with_billogix"),
	     $cgi->br);
    }
    push(@$html, $cgi->hr);
     

    if ($cgi->param('show_missing'))
    {
	&format_missing($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    }

    if ($cgi->param('show_missing_including_matches'))
    {
	#
	# Need to end the form that was started above; hope that doesn't cause problems.
	#
	push(@$html, $cgi->end_form);
	
	&format_missing_including_matches($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    }

    if ($cgi->param('show_dups'))
    {
	&format_dups($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    }

    if ($cgi->param('show_excluded'))
    {
	&format_excluded($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    }

    if ($cgi->param('show_coupled'))
    {
	&format_coupled($fig,$cgi,$html,$genomes,$roles,$rows,"careful",$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    }
    elsif ($cgi->param('show_coupled_fast'))
    {
	&format_coupled($fig,$cgi,$html,$genomes,$roles,$rows,"fast",$subsetsC,$active_subsetC,$subsetsR,$active_subsetR);
    }

    if ($col = $cgi->param('col_to_align'))
    {
	&align_column($fig,$cgi,$html,$col,$roles,$genomes,$rows,$subsetsR,$active_subsetR);
    }

    my $notes = $cgi->param('notes');;
    if ((-s "$FIG_Config::data/Subsystems/$ssa/notes") && (! $notes))
    {
	$notes = &FIG::file_read("$FIG_Config::data/Subsystems/$ssa/notes");
	if (! $notes)
	{
	    confess "BAD notes";
	}
    }
    push(@$html,$cgi->hr,"NOTES:\n",$cgi->br,$cgi->textarea(-name => 'notes', -rows => 40, -cols => 100, -value => $notes));
}


#-----------------------------------------------------------------------------
#  Selection list of complete genomes not in spreadsheet:
#-----------------------------------------------------------------------------

sub format_extend_with {
    my ( $fig, $cgi, $html, $genomes, $roles ) = @_;

    my %genomes = map { $_ => 1 } @$genomes;

    my @orgs = map { [ $_ , &ext_genus_species( $fig, $_ ), scalar $fig->all_contigs( $_ ) ] } 
               grep { ! $genomes{ $_ } } 
               $fig->genomes( "complete", undef );

    my $pick_order = $cgi->param('pick_order') || 'Alphabetic';
    if ( $pick_order eq "Phylogenetic" )
    {
	@orgs = sort { $a->[3] cmp $b->[3] }
	        map  { push @$_, $fig->taxonomy_of( $_->[0] ); $_ }
	        @orgs;
    }
    elsif ( $pick_order eq "Genome ID" )
    {
	@orgs = sort { $a->[3]->[0] <=> $b->[3]->[0] || $a->[3]->[1] <=> $b->[3]->[1] }
	        map  { push @$_, [ split /\./ ]; $_ }
	        @orgs;
    }
    else
    {
	$pick_order = 'Alphabetic';
	@orgs = sort { $a->[1] cmp $b->[1] } @orgs;
    }

    @orgs = map { "$_->[1] ($_->[0]) [$_->[2] contigs]" } @orgs;

    my @order_opt = $cgi->radio_group( -name     => 'pick_order',
                                       -values   => [ 'Alphabetic', 'Phylogenetic', 'Genome ID' ],
                                       -default  => $pick_order,
                                       -override => 1
                                     );

    push( @$html, $cgi->h1('Pick Organisms to Extend with'), "\n",
                  "<TABLE>\n",
                  "  <TR>\n",
                  "    <TD>",
                  $cgi->scrolling_list( -name     => 'korgs',
                                        -values   => [ @orgs ],
                                        -size     => 10,
                                        -multiple => 1
                                      ),
                  "    </TD>\n",
                  "    <TD>", join( "<BR>\n", "Order of selection list:", @order_opt ), 
                  "    </TD>\n",
                  "  </TR>\n",
                  "</TABLE>\n",
                  $cgi->hr
         );
}


sub format_extend_with_CYANOS {
    my($fig,$cgi,$html,$genomes,$roles) = @_;
    my($org,$gs, $gc); 
    my @genome_list = ('1140.1','84588.1','1148.1','167540.1','74547.1','167539.1','59919.1','240292.1','3702.1','251221.1','165597.1','63737.1','103690.1','39947.1','197221.1','203124.1');
    #my %genomes = map { $_ => 1 } @genome_list;
    my %genomes = map { $_ => 1 } @$genomes;
    my @orgs = sort map { $org = $_; $gs = &ext_genus_species($fig,$org); $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" }  grep { ! $genomes{$_} } 
	                @genome_list;
    
        push(@$html,
	            $cgi->h1('Pick Phototrophic Genomes to Extend with'),
	            $cgi->scrolling_list(-name => 'korgs',
					 -values => [@orgs],
					 -size => 10,
					 -multiple => 1
					 ),
	            $cgi->hr
	     );
}

sub format_extend_with_NMPDR {
    my($fig,$cgi,$html,$genomes,$roles) = @_;
    my($org,$gs, $gc);
    my @genome_list = ('159288.1','159289.1','93061.1','196620.1','158878.1','158879.1','243277.1','223926.1','216895.1','196600.1','169963.1','265669.1','192222.1','160490.1','1314.1','198466.1','186103.1','193567.1','216600.1','171101.1','170187.1');
     #my %genomes = map { $_ => 1 } @genome_list;
     my %genomes = map { $_ => 1 } @$genomes;
    
     my @orgs = sort map { $org = $_; $gs = &ext_genus_species($fig,$org); $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" } grep { ! $genomes{$_} } @genome_list;
    #my @orgs = sort map { $org = $_; $gs = &ext_genus_species($fig,$org); $gc=scalar $fig->all_contigs($org); "$gs ($org) [$gc contigs]" } @$genomes;
    
    push(@$html,
	            $cgi->h1('Pick NMPDR Genomes to Extend with'),
	            $cgi->scrolling_list(-name => 'korgs',
					 -values => [@orgs],
					 -size => 10,
					 -multiple => 1
					 ),
	            $cgi->hr
	     );


}

sub format_rows {
    my($fig,$cgi,$html,$roles,$genomes,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;

    my($i);
    my $subsetC = $subsetsC->{$active_subsetC};
    my $subsetR = $subsetsR->{$active_subsetR};

    if (@$rows > 0)
    {
	my $col_hdrs = ["Genome ID","Organism","Variant Code"];
	for ($i=1; ($i < @$roles); $i++)
	{
	    if ($roles->[$i])
	    {
		if ($subsetC->{$i})
		{
		    if ($roles->[$i] =~ /^(.*\S.*)\t(.*)$/)
		    {
			push(@$col_hdrs,$1);
		    }
		    else
		    {
			push(@$col_hdrs,$i);
		    }
		}
	    }
	}
	my $tab = &format_existing_rows($fig,$cgi,$html,$genomes,$rows,$roles,$subsetC,$subsetR,$col_hdrs);
	($col_hdrs,$tab) = &format_alternatives($cgi,$subsetC,$subsetsC,$col_hdrs,$tab);
	push(@$html,&HTML::make_table($col_hdrs,$tab,"Basic Spreadsheet"),
	            $cgi->hr
	     );

	push(@$html,$cgi->scrolling_list(-name => 'sort', 
					 -value => ['unsorted','alphabetic','by_variant','by_phylo','by_tax_id'],
					 -default => 'unsorted'
					 ));
    }
}

sub format_alternatives {
    my($cgi,$subsetC,$subsetsC,$col_hdrs,$tab) = @_;
    my($tab1,$i,%in,$col,$set,%seen,$genome,$row,$cell);

    my @start    = sort { $a <=> $b } keys(%$subsetC);
    my $expand   = $cgi->param('ignore_alt');
    my @alt_sets = grep { (! $expand) && ($_ =~ /^\*/) } keys(%$subsetsC);
    foreach $set (@alt_sets) # map { [ sort { $a <=> $b } keys(%{$subsetsC->{$_}}) ] }
    {
	foreach $col (keys(%{$subsetsC->{$set}}))
	{
	    $in{$col} = $set;
	}
    }
    my $col_hdrsC = [];
    push(@$col_hdrsC,@{$col_hdrs}[0..2]);
    for ($i=0; ($i < @start); $i++)
    {
	if ($in{$start[$i]})
	{
	    if (! $seen{$in{$start[$i]}})
	    {
		push(@$col_hdrsC,$in{$start[$i]});
		$seen{$in{$start[$i]}} = 1;
	    }
	}
	else
	{
	    push(@$col_hdrsC,$col_hdrs->[$i+3]);
	}
    }
	    
    $tab1 = [];
    my $x;
    foreach $x (@$tab)
    {
	if ((@$tab1 > 0) && ((@$tab1 % 10) == 0)) 
	{ 
	    push(@$tab1,[map { "<b>$_</b>" } @$col_hdrsC]) ;
	}
	$genome = $x->[0]->[0];
	$row = [$x->[1],$x->[2],$x->[3]];
	undef %seen;
	my @pegs = ();
	my @colors = ();
	for ($i=0,$cell=0; ($i < @start); $i++)
	{
	    if ($in{$start[$i]})
	    {
		if (! defined($seen{$in{$start[$i]}}))
		{
		    push(@{$pegs[$cell]},&fid_links($cgi,$x->[$i+4],$genome,"-$start[$i]"));
		    push(@colors,$x->[$i+4]->[1]);
		    $seen{$in{$start[$i]}} = $cell;
		    $cell++;
		}
		else
		{
		    push(@{$pegs[$seen{$in{$start[$i]}}]},&fid_links($cgi,$x->[$i+4],$genome,"-$start[$i]"));
		    if (($colors[$seen{$in{$start[$i]}}] eq '#FFFFFF') && ($x->[$i+4]->[1] ne '#FFFFFF'))
		    {
			$colors[$seen{$in{$start[$i]}}] = $x->[$i+4]->[1];
		    }
		}
	    }
	    else
	    {
		push(@{$pegs[$cell]},&fid_links($cgi,$x->[$i+4],$genome,""));
		push(@colors,$x->[$i+4]->[1]);
		$cell++;
	    }
	}
	my $color = &pick_color(@colors);
	my $j;
	for ($j=0; ($j < @pegs); $j++)
	{
	    push(@$row,"\@bgcolor=\"$colors[$j]\"\:" . join("<br>",@{$pegs[$j]}));
	}
#	push(@$row,map { "\@bgcolor=\"$color\"\:" . join("<br>",$_ ? @$_ : ()) } @pegs);
	push(@$tab1,$row);
    }
    return ($col_hdrsC,$tab1);
}

sub pick_color {
    my(@colors) = @_;
    my($color,$i,@tmp,%count);

    my %counts;
    foreach $color (@colors)
    {
	$count{$color}++;
    }
    @tmp = sort { $count{$b} <=> $count{$a} } keys(%count);
    for ($i=0; ($i < @tmp) && ($tmp[$i] eq '#FFFFFF'); $i++) {}
    return ($i == @tmp) ? '#FFFFFF' : $tmp[$i];
}

sub format_existing_rows {
    my($fig,$cgi,$html,$genomes,$rows,$roles,$subsetC,$subsetR,$col_hdrs) = @_;
    my($i,$j,$genome,$row,$entries);
    my(@tab1);

    if (@$genomes != @$rows) 
    {
	print STDERR &Dumper($genomes,$rows); die "mismatch between genomes and rows";
    }

    my $iR = 1;
    for ($i=0; ($i < @$genomes); $i++)
    {
	$genome = $genomes->[$i];
	next if (! $genome);
	my $vcode_value = $rows->[$i]->[0];

	my @tmp = ();
	for ($j=1; ($j < @$roles); $j++)
	{
	    $rows->[$i]->[$j] = &verify_entry($fig,$genome,$rows->[$i]->[$j]);
	    if ($subsetR->{$genome} && $subsetC->{$j})
	    {
		if ($cgi->param('refill'))
		{
		    $rows->[$i]->[$j] = join(",",map { $_ =~ /(\d+)$/; $1 } &seqs_with_role_precisely($fig,$j,$genome,$roles));
		}
		elsif ($cgi->param('precise_fill') && (! $rows->[$i]->[$j]))
		{
		    $rows->[$i]->[$j] = join(",",map { $_ =~ /(\d+)$/; $1 } &seqs_with_role_precisely($fig,$j,$genome,$roles));
		}
	    }
	    $tmp[$j-1] = $rows->[$i]->[$j];
	}

	@tmp = &group_by_clusters($fig,$genome,\@tmp);

	if ($subsetR->{$genome})
	{
	    my $variant = join("", map { ($_->[0] =~ /\S/) ? 1 : 0 } @tmp);

	    my($genomeV,$vcodeV);
	    if ($cgi->param('can_alter'))
	    {
		$genomeV = $cgi->textfield(-name => "genome$iR", -size => 15, -value => $genome, -override => 1);
		$vcodeV  = $cgi->textfield(-name => "vcode$iR", -value => $vcode_value, -size => 5);
	    }
	    else
	    {
		push(@$html,$cgi->hidden(-name => "genome$iR", -value => $genome, -override => 1),
			    $cgi->hidden(-name => "vcode$iR", -value => $vcode_value));
		$genomeV = $genome;
		$vcodeV  = $vcode_value;
	    }

	    #
	    # Wrap genomeV in a <a name> tag so we can zing here too.
	    #

	    $genomeV = "<a name=\"$genome\">$genomeV</a>";

	    $row = [[$genome,$variant],  # key for sorting
		    $genomeV,
		    &ext_genus_species($fig,$genome),
		    $vcodeV
		   ];
	    $j = 1;
	    while ($j < @$roles)
	    {
		if ($roles->[$j])
		{
		    push(@$html,$cgi->hidden(-name => "row$iR.$j", -value => $tmp[$j-1]->[0], -override => 1));
		    if ($subsetC->{$j})
		    {
#			push(@$row,&fid_links($cgi,$tmp[$j-1],$genome));
			push(@$row,$tmp[$j-1]);
		    }
		}
		$j++;
	    }
	    push(@tab1,$row);
	}
	else
	{
	    push(@$html,$cgi->hidden(-name => "genome$iR", -value => $genome, -override => 1),
		        $cgi->hidden(-name => "vcode$iR", -value => $vcode_value, -override => 1)
		 );

	    $j = 1;
	    while ($j < @$roles)
	    {
		if ($roles->[$j])
		{
		    push(@$html,$cgi->hidden(-name => "row$iR.$j", -value => $tmp[$j-1]->[0], -override => 1));
		}
		$j++;
	    }
	}
	$iR++;
    }

    my($sort);
    if ($sort = $cgi->param('sort'))
    {
	if ($sort eq "by_variant")
	{
	    @tab1 = sort { ($a->[0]->[1] cmp $b->[0]->[1]) or ($fig->genus_species($a->[0]->[0]) cmp $fig->genus_species($b->[0]->[0])) } @tab1;
	}
	elsif ($sort eq "by_phylo")
	{
	    @tab1 = map      { $_->[0] }
	            sort     { $a->[1] cmp $b->[1] }
	            map      { [$_, $fig->taxonomy_of($_->[0]->[0])] }
		    @tab1;
	}
        elsif ($sort eq "by_tax_id")
        {
            @tab1 = map      { $_->[0] }
                    sort     { $a->[1] <=> $b->[1] }
                    map      { [$_, $_->[0]->[0]] }
                    @tab1;
        }
	elsif ($sort eq "alphabetic")
	{
	    @tab1 = map      { $_->[0] }
	            sort     { $a->[1] cmp $b->[1] }
	            map      { [$_, $fig->genus_species($_->[0]->[0])] }
		    @tab1;
	}
    }
    return [@tab1];
}

sub format_subsets {
    my($fig,$cgi,$html,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;

    &format_subsetsC($fig,$cgi,$html,$subsetsC,$active_subsetC);
    &format_subsetsR($fig,$cgi,$html,$subsetsR,$active_subsetR);
}

sub format_subsetsC {
    my($fig,$cgi,$html,$subsetsC,$active_subsetC) = @_;
    my($i);

    my $col_hdrs = ["Subset","Includes These Roles"];
    my $tab = [];

    my $n = 1;
    &format_existing_subsetsC($cgi,$html,$tab,$subsetsC,\$n);
    if ($cgi->param('can_alter'))
    {
	for ($i=0; ($i < 5); $i++)
	{
	    &format_subsetC($cgi,$html,$tab,$n,"");
	    $n++;
	}
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Subsets of Roles"),
	        $cgi->hr
	 );

    if (keys(%$subsetsC) > 1)
    {
	push(@$html,$cgi->scrolling_list(-name => 'active_subsetC',
					 -values => [sort keys(%$subsetsC)],
					 -default => $active_subsetC
					 ),
	            $cgi->br
	     );
    }
    else
    {
	push(@$html,$cgi->hidden(-name => 'active_subsetC', -value => $active_subsetC, -override => 1));
    }
}

sub format_subsetsR {
    my($fig,$cgi,$html,$subsets,$active_subsetR) = @_;
    my($i);

    my $link = &tree_link;
    push(@$html,$cgi->br,$link,$cgi->br);

    my @tmp = grep { $_ ne "All" } sort keys(%$subsets);
    push(@$html,$cgi->scrolling_list(-name => 'active_subsetR',
				     -values => ["All",@tmp],
				     -default => $active_subsetR,
				     -size => 5
				     ),
	        $cgi->br
	 );
}

sub format_existing_subsetsC {
    my($cgi,$html,$tab,$subsetsC,$nP) = @_;
    my($nameCS);

    foreach $nameCS (sort keys(%$subsetsC))
    {
	&format_subsetC($cgi,$html,$tab,$$nP,$nameCS,$subsetsC->{$nameCS});
	$$nP++;
    }
}

sub format_subsetC {
    my($cgi,$html,$tab,$n,$nameCS,$subsetC) = @_;

    if ($nameCS ne "All")
    {
	my $subset = join(",",sort { $a <=> $b } keys(%$subsetC));
	my($posT,$subsetT);
	if ($cgi->param('can_alter'))
	{
	    $posT    = $cgi->textfield(-name => "nameCS$n", -size => 30, -value => $nameCS, -override => 1);
	    $subsetT = $cgi->textfield(-name => "subsetC$n", -size => 80, -value => $subset, -override => 1);
	}
	else
	{
	    push(@$html,$cgi->hidden(-name => "nameCS$n", -value => $nameCS, -override => 1),
		        $cgi->hidden(-name => "subsetC$n", -value => $subset, -override => 1));
	    $posT = $nameCS;
	    $subsetT = $subset;
	}
	push(@$tab,[$posT,$subsetT]);
    }
}

sub format_roles {
    my($fig,$cgi,$html,$roles,$genomes,$rows) = @_;
    my($i);

    my $col_hdrs = ["Column","Abbrev","Functional Role","Other Subsystems with this Role"];
    my $tab = [];

    my $n = 1;
    &format_existing_roles($fig,$cgi,$html,$tab,$roles,\$n,$genomes,$rows);
    if ($cgi->param('can_alter'))
    {
	for ($i=0; ($i < 5); $i++)
	{
	    &format_role($fig,$cgi,$html,$tab,$n,"",$roles,$genomes,$rows);
	    $n++;
	}
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Functional Roles"),
	        $cgi->hr
	 );
}

sub format_existing_roles {
    my($fig,$cgi,$html,$tab,$roles,$nP,$genomes,$rows) = @_;
    my($role,$i);

    for ($i=1; ($i < @$roles); $i++)
    {
	$role = $roles->[$i];
	&format_role($fig,$cgi,$html,$tab,$$nP,$role,$roles,$genomes,$rows);
	$$nP++;
    }
}

sub format_role {
    my($fig,$cgi,$html,$tab,$n,$role,$roles,$genomes,$rows) = @_;
    my($abbrev,$text,$other_ss_text,$r,$ss_list,$new_text);
    my($ss_hash);
    my($posT,$abbrevT,$roleT,$otherSS);    

    if ($role =~ /^(.*)\t(.*)$/)
    {
	$abbrev = $1;
	$text   = $2;
    }
    else
    {
	$abbrev = "";
	$text   = $role;
    }

    $ss_hash = $fig->subsystem_roles();

    $new_text = $text;
    
     $other_ss_text = "None";
    
     foreach $r (keys(%$ss_hash)){
	if ($r eq $new_text ){
	      $ss_list = $ss_hash->{$r};
	      $other_ss_text = join(",",@$ss_list);
	      #$other_ss_text = "new";
        }
    }
 	
    if ($cgi->param('can_alter'))
    {
	$posT = $cgi->textfield(-name => "posR$n", -size => 3, -value => $n, -override => 1);
	$abbrevT = $cgi->textfield(-name => "abbrev$n", -size => 7, -value => $abbrev, -override => 1);
	$roleT = $cgi->textfield(-name => "role$n", -size => 80, -value => $text, -override => 1);
        $otherSS = $cgi->textfield(-name => "role$n", -size => 80, -value => $other_ss_text, -override => 1);
    }
    else
    {
	push(@$html,$cgi->hidden(-name => "posR$n", -value => $n, -override => 1),
		    $cgi->hidden(-name => "abbrev$n", -value => $abbrev, -override => 1),
	            $cgi->hidden(-name => "role$n", -value => $text, -override => 1),
	            $cgi->hidden(-name => "role$n", -value => $other_ss_text, -override => 1)
	     );

	$posT = $n;
	$abbrevT = $abbrev;
	$roleT = $text;
	$otherSS = $other_ss_text;
    }
    #
    # Wrap the first element in the table with a <A NAME="role_rolename"> tag
    # so we can zing to it from elsewhere. We remove any non-alphanumeric
    # chars in the role name.
    #

    my $posT_html;
    {
	my $rn = $text;
	$rn =~ s/[ \/]/_/g;
	$rn =~ s/\W//g;

	$posT_html = "<a name=\"$rn\">$posT</a>";
    }
     
   
    push(@$tab,[$posT_html,$abbrevT,$roleT,$otherSS]);

    if ($cgi->param('check_problems'))
    {
	my @roles    = grep { $_->[0] ne $text } &gene_functions_in_col($fig,$n,$roles,$genomes,$rows);
	my($x,$peg);
	foreach $x (@roles)
	{
	    push(@$tab,["","",$x->[0]]);
	    push(@$tab,["","",join(",",map { &HTML::fid_link($cgi,$_) } @{$x->[1]})]);
	}
    }
}


sub write_spreadsheet_from_input_parameters {
    my($fig,$cgi,$html,$ssa,$user) = @_;
    my($i,$j,$pos,$role,$subset,@roles,$genome,$row,$nameCS,$nameRS,%role_map,%role_map2);
    my($param,@param,@tmp,$active_subsetC,$pair);
  
    my $roles          = [];
    my $genomes        = [];
    my $rows           = [];
    my $subsetsC       = {};
    my $active_subsetC = "All";
    my $subsetsR       = {};
    my $active_subsetR = "All";

    if ($cgi->param('can_alter'))
    {
	&log_update($ssa,$user);

	if (-s "$FIG_Config::data/Subsystems/$ssa/spreadsheet")
	{
	    rename("$FIG_Config::data/Subsystems/$ssa/spreadsheet","$FIG_Config::data/Subsystems/$ssa/spreadsheet~");
	}

	if ($cgi->param('notes'))
	{
	    if (-s "$FIG_Config::data/Subsystems/$ssa/notes")
	    {
		rename("$FIG_Config::data/Subsystems/$ssa/notes","$FIG_Config::data/Subsystems/$ssa/notes~");
	    }
	    else
	    {
		open(NOTES,">$FIG_Config::data/Subsystems/$ssa/notes");
		close(NOTES);
		chmod(0777,"$FIG_Config::data/Subsystems/$ssa/notes");
	    }
	}
	elsif (-s "$FIG_Config::data/Subsystems/$ssa/notes")
	{
	    my $notes = &FIG::file_read("$FIG_Config::data/Subsystems/$ssa/notes");
	    $cgi->param(-name => "notes", -value => $notes);
	}

	open(SSA,">$FIG_Config::data/Subsystems/$ssa/spreadsheet")
	    || die "could not open $FIG_Config::data/Subsystems/$ssa/spreadsheet";
    }
    @param = grep { $_ =~ /^posR/ } $cgi->param;
    foreach $param (@param)
    {
	if ($param =~ /^posR(\d+)/)
	{
	    $i = $1;
	    if (($pos = $cgi->param("posR$i")) && ($role = $cgi->param("role$i")))
	    {
		$role =~ s/^\s+//;
		$role =~ s/\s+$//;
		if ($role =~ /\S/)
		{
		    if ($_ = $cgi->param("abbrev$i"))
		    {
			$tmp[$pos] = "$_\t$role";
		    }
		    else
		    {
			$tmp[$pos] = "\t$role";
		    }
		    $role_map2{$pos} = $i;
		}
	    }
	}
    }

    $j = 1;
    foreach $pos (sort { $a <=> $b } keys(%role_map2))
    {
	$roles->[$j] = $tmp[$pos];
	$role_map{$role_map2{$pos}} = $j;
	$j++;
    }

    if ($cgi->param('can_alter'))
    {
	foreach $role (@$roles)
	{
	    if ($role)
	    {
		print SSA "$role\n";
	    }
	}
	print SSA "//\n";
    }

    @param = grep { $_ =~ /^nameCS/ } $cgi->param;
    foreach $param (@param)
    {
	if ($param =~ /^nameCS(\d+)/)
	{
	    $i = $1;
	    if (($nameCS = $cgi->param("nameCS$i")) && ($subset = $cgi->param("subsetC$i")))
	    {
		$nameCS =~ s/ /_/g;
		$subset =~ s/^\s+//;
		$subset =~ s/\s+$//;

		foreach $_ (split(/[\t ,;]+/,$subset))
		{
		    if ($_ =~ /^\d+$/)
		    {
			$subsetsC->{$nameCS}->{$role_map{$_}} = 1;
		    }
		}
	    }
	}
    }

    foreach $nameCS (sort keys(%$subsetsC))
    {
	$subset = $subsetsC->{$nameCS};
	if ($subset)
	{
	    @roles = sort { $a <=> $b } keys(%$subset);
	}
	
	if ($cgi->param('can_alter'))
	{
	    if (@roles > 0)
	    {
		print SSA join("\t",($nameCS,@roles)),"\n";
	    }
	    else
	    {
		push(@$html,$cgi->h2("invalid subset: $subset"));
	    }
	}
    }

    if (! ($active_subsetC = $cgi->param('active_subsetC')))
    {
	$active_subsetC = "All";
    }

    if (! $subsetsC->{"All"})
    {
	for ($i=1; ($i < @$roles); $i++)
	{
	    $subsetsC->{"All"}->{$i} = 1;
	}
    }
    if ($cgi->param('can_alter'))
    {
	print SSA "$active_subsetC\n";
	print SSA "\n";
    }
    

    my($taxonomic_groups,$id,$members,$genome);
    $taxonomic_groups = $fig->taxonomic_groups_of_complete(10);
    foreach $pair (@$taxonomic_groups)
    {
	($id,$members) = @$pair;
	foreach $genome (@$members)
	{
	    $subsetsR->{$id}->{$genome} = 1;
	}
    }

    $active_subsetR = $cgi->param('active_subsetR');
    if (! ($active_subsetR && $subsetsR->{$active_subsetR}))
    {
	$active_subsetR = &default_genome_set;
    }
    if ($cgi->param('can_alter'))
    {
	print SSA "$active_subsetR\n";
	print SSA "//\n";
    }

    $i = 1;
    while (defined($genome = $cgi->param("genome$i")))
    {
	if ($genome =~ /^\d+\.\d+$/)
	{
	    $genomes->[$i-1] = $genome;
	}
	$i++;
    }

    $i = 1;
    my($vcode_value,$j,$row,$entry,$non_null);
    while (defined($vcode_value = $cgi->param("vcode$i")))
    {
	if ($genomes->[$i-1])
	{
	    $row = [$vcode_value];
	    for ($j=1; ($j < (@$roles + 5)); $j++)
	    {
		if ($role_map{$j})
		{
		    if ($entry = $cgi->param("row$i.$j"))
		    {
			$row->[$role_map{$j}] = $entry;
		    }
		    else
		    {
			$row->[$role_map{$j}] = "";
		    }
		}
	    }
	    $rows->[$i-1] = $row;
	    if ($cgi->param('can_alter'))
	    {
		print SSA join("\t",($genomes->[$i-1],@$row)),"\n";
	    }
	}
	$i++;
    }

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

    if ($cgi->param('can_alter'))
    {
	my @orgs1 = ();
	if ($cgi->param('add_solid'))
	{
	    my %genomes1 = map { $_ => 1 } (@$genomes,@orgs);;
	    @orgs1    = sort  grep { ! $genomes1{$_} }  $fig->genomes("complete",undef);
	}
	&extend_ssa($fig,$genomes,$roles,$rows,\@orgs,\@orgs1,\*SSA);


	close(SSA);
	chmod(0777,"$FIG_Config::data/Subsystems/$ssa/spreadsheet");
	if (($_ = $cgi->param('notes')) && open(NOTES,">$FIG_Config::data/Subsystems/$ssa/notes"))
	{
	    print NOTES $_;
	    close(NOTES);
	}
	&backup("$FIG_Config::data/Subsystems/$ssa");

    }
#   print &Dumper($roles,$subsets,$genomes,$rows); die "aborted";

    #
    # Update the subsystem index.
    #
    # (Put this in an eval in case we get a failure here).
    #

    eval {
	my $sub = $fig->get_subsystem($ssa, 1);
	$sub->db_sync();
    };
    
    return ($roles,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR,$genomes,$rows);
}
    
sub format_ssa_table {
    my($cgi,$html,$user,$ssaP) = @_;
    my($ssa,$curator);
    my($url1,$link1);

    my $can_alter = $cgi->param('can_alter');
    push(@$html, $cgi->start_form(-action => "ssa2.cgi",
				  -method => 'post'),
	         $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	         $cgi->hidden(-name => 'can_alter', -value => $can_alter, -override => 1),
	         $cgi->hidden(-name => 'request', -value => 'delete_or_export_ssa', -override => 1)
	 );
    push(@$html,"<font size=\"+2\">Please do not ever edit someone else\'s spreadsheet (by using their
	         user ID), and <b>never open multiple windows to
                 process the same spreadsheet</b></font>.  It is, of course, standard practice to open a subsystem 
                 spreadsheet and then to have multiple other SEED windows to access data and modify annotations.  Further,
	         you can access someone else's subsystem spreadsheet using your ID (which will make it impossible
                 for you to edit the spreadsheet).
                 Just do not open the same subsystem spreadsheet for editing in multiple windows simultaneously.",
	 $cgi->br,
	 $cgi->br
        );

    my $col_hdrs = [
		    "Name","Curator","Exchangable","Version",
		    "Reset to Previous Timestamp","Delete",
		    "Export Full Subsystem","Export Just Assignments", "Publish to Clearinghouse",
		    ];
    my $title    = "Existing Subsystem Annotations";
    my $tab = [];
    foreach $_ (@$ssaP)
    {
	my($publish_checkbox);
	($ssa,$curator) = @$_;

	my($url,$link);
	if ((-d "$FIG_Config::data/Subsystems/$ssa/Backup") && ($curator eq $cgi->param('user')))
	{
	    $url = &FIG::cgi_url . "/ssa2.cgi?user=$user&ssa_name=$ssa&request=reset";
	    $link = "<a href=$url>reset</a>";
	}
	else
	{
	    $link = "";
	}

	if (($fig->is_exchangable_subsystem($ssa)) && ($curator eq $cgi->param('user')))
	{
	    $url1  = &FIG::cgi_url . "/ssa2.cgi?user=$user&ssa_name=$ssa&request=make_unexchangable";
	    $link1 = "Exchangable<br><a href=$url1>Make not exchangable</a>";
	}
	elsif ($curator eq $cgi->param('user'))
	{
	    $url1  = &FIG::cgi_url . "/ssa2.cgi?user=$user&ssa_name=$ssa&request=make_exchangable";
	    $link1 = "Not exchangable<br><a href=$url1>Make exchangable</a>";
	}
	else
	{
	    $link1 = "";
	}

	#
	# Only allow publish for subsystems we are curating?
	#
	if ($curator eq $cgi->param('user'))
	{
	    $publish_checkbox = $cgi->checkbox(-name => "publish_to_clearinghouse",
					       -value => $ssa,
					       -label => "Publish"),

	}
	    
	push(@$tab,[
		    &ssa_link($ssa,$user),
		    $curator,
		    $link1,
	            $fig->subsystem_version($ssa),
		    $link,
		    ($curator eq $cgi->param('user')) ? $cgi->checkbox(-name => "delete", -value => $ssa) : "",
		    $cgi->checkbox(-name => "export", -value => $ssa, -label => "Export full"),
		    $cgi->checkbox(-name => "export_assignments", -value => $ssa, -label => "Export assignments"),
		    $publish_checkbox,
		    ]);
    }
    push(@$html,
	 &HTML::make_table($col_hdrs,$tab,$title),
	 $cgi->submit(-name => 'delete_export',
		      -label => 'Process marked deletions and exports'),
	 $cgi->submit(-name => 'publish',
		      -label => "Publish marked subsystems"),
	 $cgi->end_form
	 );
}

sub ssa_link {
    my($ssa,$user) = @_;
    my $name = $ssa; $name =~ s/_/ /g;
    my $target = "window$$";
    my $can_alter = &curator($ssa) eq $user;

    my $url = &FIG::cgi_url . "/ssa2.cgi?user=$user&ssa_name=$ssa&request=show_ssa&can_alter=$can_alter";
    return "<a href=$url target=$target>$name</a>";
}

sub tree_link {
    my $target = "window$$";
    my $url = &FIG::cgi_url . "/ssa2.cgi?request=show_tree";
    return "<a href=$url target=$target>Show Phylogenetic Tree</a>";
}


sub existing_subsystem_annotations {
    my($ssa,$name);
    my @ssa = ();
    if (opendir(SSA,"$FIG_Config::data/Subsystems"))
    {
	@ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
	closedir(SSA);
    }
    return sort { $a->[0] cmp $b->[0] } @ssa;
}

sub curator {
    my($ssa) = @_;
    my($who) = "";

    if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
    {
	$_  = <DATA>;
	if ($_ =~ /^\d+\t(\S+)\s+started/)
	{
	    $who = $1;
	}
	close(DATA);
    }
    return $who;
}

sub log_update {
    my($ssa,$user) = @_;

    $ssa =~ s/[ \/]/_/g;

    if (open(LOG,">>$FIG_Config::data/Subsystems/$ssa/curation.log"))
    {
	my $time = time;
	print LOG "$time\t$user\tupdated\n";
	close(LOG);
    }
    else
    {
	print STDERR "failed to open $FIG_Config::data/Subsystems/$ssa/curation.log\n";
    }
}

sub extend_ssa {
    my($fig,$genomes,$roles,$rows,$new_genomes,$poss_new_genomes,$fh) = @_;
    my($genome,$i,$row,$role);

    foreach $genome (@$new_genomes)
    {
	push(@$genomes,$genome);
	$row = [0];
	for ($i=1; ($i < @$roles); $i++)
	{
	    push(@$row,join(",",map { $_ =~ /(\d+)$/; $1 } &seqs_with_role_precisely($fig,$i,$genome,$roles)));
	}
	push(@$rows,$row);
	print $fh join("\t",($genome,@$row)),"\n";
    }

    foreach $genome (@$poss_new_genomes)
    {
	$row = [0];
	my $bad = 0;
	for ($i=1; ($i < @$roles); $i++)
	{
	    my $entry = join(",",map { $_ =~ /(\d+)$/; $1 } &seqs_with_role_precisely($fig,$i,$genome,$roles));
	    if (! $entry)
	    {
		$bad = 1;
		last;
	    }
	    push(@$row,$entry);
	}
	if (! $bad)
	{
	    push(@$genomes,$genome);
	    push(@$rows,$row);
	    print $fh join("\t",($genome,@$row)),"\n";
	}
    }
}


sub seqs_with_role_precisely {
    my($fig,$i,$genome,$roles) = @_;

# The $i parm is a bit weird.  The actual role we want is in $roles->[$i].  Any existing versions are in
# $rows->[*]->[$i] entries.  You look for acceptable roles matching $roles->[$i] (after tab)

    my @pegs = ();
    if ($roles->[$i] =~ /([^\t]+)$/)
    {
	@pegs = $fig->seqs_with_role($1,"master",$genome);
    }
    return @pegs;
}

sub gene_functions_in_col {
    my($fig,$i,$roles,$genomes,$rows) = @_;
    my(%roles,$j,$row,$genomeJ,$entry,@pegs,$peg,$func);

    if ($roles->[$i] =~ /([^\t]+)$/)
    {
	$roles{$1} = [];
    }
    
    for ($j=0; ($j < @$rows); $j++)
    {
	$row = $rows->[$j];
	$genomeJ = $genomes->[$j];
	if ($row->[$i] =~ /(\S.*\S)/)
	{
	    $entry = $1;
	    @pegs = map { "fig|$genomeJ.peg.$_" } split(/,/,$entry);
	    foreach $peg (@pegs)
	    {
		if ($func = $fig->function_of($peg))
		{
		    push(@{$roles{$func}},$peg);
		}
	    }
	}
    }
    return map { [$_,$roles{$_}] } sort keys(%roles);
}


sub verify_entry {
    my($fig,$genome,$entry) = @_;
    my($peg);

    my @verified = ();
    foreach $peg (split(/[, \t]+/,$entry))
    {
	if ($fig->is_real_feature("fig|$genome.peg.$peg"))
	{
	    push(@verified,$peg);
	}
    }
    return join(",",@verified);
}

sub export {
    my($fig,$cgi,$ssa) = @_;
    my($line);

    my ($exportable,$notes) = $fig->exportable_subsystem($ssa);
    foreach $line (@$exportable,@$notes)
    {
	print $line;
    }
}
	
sub export_assignments {
    my($fig,$cgi,$ssa) = @_;
    my(@roles,$i,$entry,$id,$user);

    if (($user = $cgi->param('user')) && open(SSA,"<$FIG_Config::data/Subsystems/$ssa/spreadsheet"))
    {
	$user =~ s/^master://;
	&FIG::verify_dir("$FIG_Config::data/Assignments/$user");
	my $who = &curator($ssa);
	my $file = &FIG::epoch_to_readable(time) . ":$who:generated_from_subsystem_$ssa";
	
	if (open(OUT,">$FIG_Config::data/Assignments/$user/$file"))
	{
	    while (defined($_ = <SSA>) && ($_ !~ /^\/\//)) 
	    {
		chop;
		push(@roles,$_);
	    }
	    while (defined($_ = <SSA>) && ($_ !~ /^\/\//))	{}
	    while (defined($_ = <SSA>))
	    {
		chop;
		my @flds = split(/\t/,$_);
		my $genome = $flds[0];
		for ($i=2; ($i < @flds); $i++)
		{
		    my @entries = split(/,/,$flds[$i]);
		    foreach $id (@entries)
		    {
			my $peg = "fig|$genome.peg.$id";
			my $func = $fig->function_of($peg);
			print OUT "$peg\t$func\n";
		    }
		}
	    }
	    close(OUT);
	}
	close(SSA);
    }
}

sub format_missing {
    my($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;
    my($i,$j,$missing,$user,$role,$org,$link,$genus_species,$abr);

    my $subsetC = $subsetsC->{$active_subsetC};
    my $subsetR = $subsetsR->{$active_subsetR};

    my @alt_sets = grep { ($_ =~ /^\*/) } keys(%$subsetsC);
    my($set,$col,%in);
    foreach $set (@alt_sets) 
    {
	foreach $col (keys(%{$subsetsC->{$set}}))
	{
	    $in{$col} = $set;
	}
    }
    push(@$html,$cgi->h1('To Check Missing Entries:'));

    for ($i=0; ($i < @$rows); $i++)
    {
	$org = $genomes->[$i];
	next if (! $subsetR->{$org});
	my @missing = &columns_missing_entries($cgi,$subsetsC,$subsetC,$rows,$i,$roles,\%in);

	$missing = [];
	foreach $j (@missing)
	{
	    $user = $cgi->param('user');
	    $role = $roles->[$j];
	    if ($role =~ /^(.*)\t(.*)$/)
	    {
		($abr,$role) = ($1,$2);
	    }
	    else
	    {
		$abr = "";
	    }
	    my $roleE = $cgi->escape($role);
	    
	    $link = "<a href=" . &FIG::cgi_url . "/pom.cgi?user=$user&request=find_in_org&role=$roleE&org=$org>$abr $role</a>";
	    push(@$missing,$link);
	}

	if (@$missing > 0)
	{
	    $genus_species = &ext_genus_species($fig,$org);
	    push(@$html,$cgi->h2("$org: $genus_species"));
	    push(@$html,$cgi->ul($cgi->li($missing)));
	}
    }
}

sub columns_missing_entries {
    my($cgi,$subsetsC,$subsetC,$rows,$i,$roles,$in) = @_;
    my(%missing_cols,$j,$k);
    my(@really_missing) = ();

    for ($j=1; ($j < @$roles); $j++)
    {
	if (! $rows->[$i]->[$j])
	{
	    $missing_cols{$j} = 1;
	}
    }

    for ($j=1; ($j < @$roles); $j++)
    {
	if ($missing_cols{$j} && $subsetC->{$j})
	{
	    my($set);
	    if (($set = $in->{$j}) && (! $cgi->param('ignore_alt')))
	    {
		my @set = keys(%{$subsetsC->{$set}});
		for ($k=0; ($k < @set) && $missing_cols{$set[$k]}; $k++) {}
		if ($k == @set)
		{
		    push(@really_missing,$j);
		}
	    }
	    else
	    {
		push(@really_missing,$j);
	    }
	}
    }
    return @really_missing;
}

sub format_missing_including_matches 
{
    my($fig,$cgi,$html,$genomes,$roles,$rows,
       $subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;
    
    my($i,$j,$missing,$user,$role,$org,$link,$genus_species,$abr);

    my $subsetC = $subsetsC->{$active_subsetC};
    my $subsetR = $subsetsR->{$active_subsetR};

    my @alt_sets = grep { ($_ =~ /^\*/) } keys(%$subsetsC);
    my($set,$col,%in);
    foreach $set (@alt_sets) 
    {
	foreach $col (keys(%{$subsetsC->{$set}}))
	{
	    $in{$col} = $set;
	}
    }

    push(@$html,$cgi->h1('To Check Missing Entries:'));

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

    my $can_alter = $cgi->param('can_alter');
    $user = $cgi->param('user');
    push(@$html,
	 $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	 $cgi->hidden(-name => 'can_alter', -value => $can_alter, -override => 1));
    
    for ($i=0; ($i < @$rows); $i++)
    {
	$org = $genomes->[$i];
	next if (($_ = $cgi->param('just_genome')) && ($org != $_));
	next if (! $subsetR->{$org});
	
	my @missing = &columns_missing_entries($cgi,$subsetsC,$subsetC,$rows,$i,$roles,\%in);

	$missing = [];

	foreach $j (@missing)
	{
	    $role = $roles->[$j];
	    if ($role =~ /^(.*)\t(.*)$/)
	    {
		($abr,$role) = ($1,$2);
	    }
	    else
	    {
		$abr = "";
	    }
	    my $roleE = $cgi->escape($role);

		#
		# All the way up to here is code to retrieve the role name.
		#

		#
		# Invoke find_role_in_org to get the roles we might have.
		#

	    my @hits = $fig->find_role_in_org($role, $org, $user, $cgi->param("sims_cutoff"));

	    push(@$missing,@hits);
	}
	$genus_species = &ext_genus_species($fig,$org);
	push(@$html,$cgi->h2("$org: $genus_species"));

	if (@$missing > 0)
	{
	    my $colhdr = ["Assign", "P-Sc", "PEG", "Len", "Current fn", "Matched peg", "Len", "Function"];
	    my $tbl = [];
	    
	    for my $hit (@$missing)
	    {
		my($psc, $my_peg, $my_len, $my_fn, $match_peg, $match_len, $match_fn) = @$hit;

		my $my_peg_link = &HTML::fid_link($cgi, $my_peg, 1);
		my $match_peg_link = &HTML::fid_link($cgi, $match_peg, 0);

		my $checkbox = $cgi->checkbox(-name => "checked",
					      -value => "to=$my_peg,from=$match_peg",
					      -label => "");

		push(@$tbl, [$checkbox,
			     $psc,
			     $my_peg_link, $my_len, $my_fn,
			     $match_peg_link, $match_len, $match_fn]);
	    }

	    push(@$html, &HTML::make_table($colhdr, $tbl, ""));
	}
	else
	{
	    push(@$html, $cgi->p("No matches."));
	}
	   
    }
    push(@$html,
	 $cgi->submit(-value => "Process assignments",
			      -name => "batch_assign"),
	 $cgi->end_form);
}

sub format_dups {
    my($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;
    my($i,$j,$duplicates,$user,$role,$org,$link,$genus_species,$abr,$func,$peg);

    my $subsetC = $subsetsC->{$active_subsetC};
    my $subsetR = $subsetsR->{$active_subsetR};

    push(@$html,$cgi->h1('To Check Duplicates:'));

    for ($i=0; ($i < @$rows); $i++)
    {
	$org = $genomes->[$i];
	next if (! $subsetR->{$org});

	$duplicates = [];
	for ($j=1; ($j < @$roles); $j++)
	{
	    if (($rows->[$i]->[$j] =~ /,/) && $subsetC->{$j})
	    {
		$user = $cgi->param('user');
		$role = $roles->[$j];
		if ($role =~ /^(.*)\t(.*)$/)
		{
		    ($abr,$role) = ($1,$2);
		}
		else
		{
		    $abr = "";
		}
		push(@$duplicates,"$role<br>" . $cgi->ul($cgi->li([map { $peg = "fig|$org.peg.$_"; $func = $fig->function_of($peg,$user); &HTML::fid_link($cgi,$peg) . " $func" } split(/,/,$rows->[$i]->[$j])])));
	    }
	}
	if (@$duplicates > 0)
	{
	    $genus_species = &ext_genus_species($fig,$org);
	    push(@$html,$cgi->h2("$org: $genus_species"));
	    push(@$html,$cgi->ul($cgi->li($duplicates)));
	}
    }
}

sub format_excluded {
    my($fig,$cgi,$html,$genomes,$roles,$rows,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;
    my($i,$j,$show,$user,$role,$org,$link,$genus_species,$abr,$func,$peg,@excluded,@in,%in);

    my $subsetC = $subsetsC->{$active_subsetC};
    my $subsetR = $subsetsR->{$active_subsetR};

    push(@$html,$cgi->h1('To PEGs with Role, but not in Spreadsheet:'));

    for ($i=0; ($i < @$rows); $i++)
    {
	$org = $genomes->[$i];
	next if (! $subsetR->{$org});

	$show = [];
	for ($j=1; ($j < @$roles); $j++)
	{
	    next if (! $subsetC->{$j});

	    if ($rows->[$i]->[$j])
	    {
		@in = map { "fig|$org.peg.$_" } split(/,/,$rows->[$i]->[$j]);
	    }
	    else
	    {
		@in = ();
	    }
	    %in = map { $_ => 1 } @in;
	    $user = $cgi->param('user');
	    $role = $roles->[$j];
	    if ($role =~ /^(.*)\t(.*)$/)
	    {
		($abr,$role) = ($1,$2);
	    }
	    else
	    {
		$abr = "";
	    }
	    @excluded = grep { ! $in{$_} } &seqs_with_role_precisely($fig,$j,$org,$roles);
	    if (@excluded > 0)
	    {
		push(@$show,"$role<br>" . $cgi->ul($cgi->li([map { $peg = $_; $func = $fig->function_of($peg,$user); &HTML::fid_link($cgi,$peg) . " $func" } @excluded])));
	    }
	}
	if (@$show > 0)
	{
	    $genus_species = &ext_genus_species($fig,$org);
	    push(@$html,$cgi->h2("$org: $genus_species"));
	    push(@$html,$cgi->ul($cgi->li($show)));
	}
    }
}

sub format_coupled {
    my($fig,$cgi,$html,$genomes,$roles,$rows,$type,$subsetsC,$active_subsetC,$subsetsR,$active_subsetR) = @_;
    my($i,$j,@show,$user,$org,$link,$gs,$func,$peg,$peg1,$peg2,%in,%seen,%seen2);
    my(@cluster,$sc,$x,$id2,@in,$sim,@coupled);

    my $subsetC = $subsetsC->{$active_subsetC};
    my $subsetR = $subsetsR->{$active_subsetR};

    for ($i=0; ($i < @$rows); $i++)
    {
	$org = $genomes->[$i];
	next if (! $subsetR->{$org});

	for ($j=1; ($j < @$roles); $j++)
	{
	    if ($rows->[$i]->[$j] && $subsetC->{$j})
	    {
		push(@in,map { "fig|$org.peg.$_" } split(/,/,$rows->[$i]->[$j]));
	    }
	}
    }

    %in = map { $_ => 1 } @in;
    $user = $cgi->param('user');
    @show = ();
    foreach $peg1 (@in)
    {
	if ($type eq "careful")
	{
	    @coupled = $fig->coupling_and_evidence($peg1,5000,1.0e-10,0.2,1);
	}
	else
	{
	    @coupled = $fig->fast_coupling($peg1,5000,1);
	}

	foreach $x (@coupled)
	{
	    ($sc,$peg2) = @$x;
	    if ((! $in{$peg2}) && ((! $seen{$peg2}) || ($seen{$peg2} < $sc)))
	    {
		$seen{$peg2} = $sc;
#		print STDERR "$sc\t$peg1 -> $peg2\n";
	    }
	}
    }
	
    foreach $peg1 (sort { $seen{$b} <=> $seen{$a} } keys(%seen))
    {
	if (! $seen2{$peg1})
	{
	    @cluster = ($peg1);
	    $seen2{$peg1} = 1;
	    for ($i=0; ($i < @cluster); $i++)
	    {
		foreach $sim ($fig->sims($cluster[$i],1000,1.0e-10,"fig"))
		{
		    $id2 = $sim->id2;
		    if ($seen{$id2} && (! $seen2{$id2}))
		    {
			push(@cluster,$id2);
			$seen2{$id2} = 1;
		    }
		}
	    }
	    push(@show, [scalar @cluster,
			 $cgi->br .
			 $cgi->ul($cgi->li([map { $peg = $_; 
						  $sc = $seen{$peg};
						  $func = $fig->function_of($peg,$user); 
						  $gs = $fig->genus_species($fig->genome_of($peg));
						  $link = &HTML::fid_link($cgi,$peg);
						  "$sc: $link: $func \[$gs\]" } 
					    sort { $seen{$b} <=> $seen{$a} }
					    @cluster]))
			 ]);
	}
    }

    if (@show > 0)
    {
	@show = map { $_->[1] } sort { $b->[0] <=> $a->[0] } @show;
	push(@$html,$cgi->h1('Coupled, but not in Spreadsheet:'));
	push(@$html,$cgi->ul($cgi->li(\@show)));
    }
}

sub ext_genus_species {
    my($fig,$genome) = @_;

    my $gs = $fig->genus_species($genome);
    my $c  = substr($fig->taxonomy_of($genome),0,1);
    return "$gs [$c]";
}
	
sub show_tree {

    my($id,$gs);   
    my($tree,$ids) = $fig->build_tree_of_complete;
    my $relabel = {};
    foreach $id (@$ids)
    {
	if ($gs = $fig->genus_species($id))
	{
	    $relabel->{$id} = "$gs ($id)";
	}
    }
    $_ = &display_tree($tree,$relabel);
    print $cgi->pre($_),"\n";
}

sub export_align_input
{

}

sub align_column {
    my($fig,$cgi,$html,$col,$roles,$genomes,$rows,$subsetsR,$active_subsetR) = @_;
    my($colN,@checked,$cutoff);

    my $subsetR = $subsetsR->{$active_subsetR};

    my $checked;

    if (($colN = &which_column($col,$roles)) &&
	((@checked = &seqs_to_align($colN,$genomes,$rows,$subsetR)) > 1))
    {
	if ($cutoff = $cgi->param('include_homo'))
	{
	    my $max = $cgi->param('max_homo');
	    $max = $max ? $max : 100;
	    push(@checked,&get_homologs($fig,\@checked,$cutoff,$max));
	}
	$checked = join("\' \'",@checked);
    }
    else
    {
	push(@$html,"<h1>You need to check at least two sequences</h1>\n");
	return;
    }


    #
    # See if we want to produce the alignment, or just produce the
    # input to the alignment.
    #

    if ($cgi->param("show_align_input"))
    {
	push(@$html, "<pre>\n");
	my $relabel;
        foreach my $id (@checked)
	{
	    my $seq;
	    if ($seq = $fig->get_translation($id))
	    {
		push(@$html,  ">$id\n$seq\n");
		my $func = $fig->function_of($id);
		$relabel->{$id} = "$id: $func";
	    }
	    else
	    {
		push(@$html, "could not find translation for $id\n");
	    }
	}
	push(@$html, "\n</pre>\n");
    }
    else
    {
	push(@$html,"<pre>\n");
	my %org = map { ( $_, $fig->org_of($_) ) } @checked;
	#  Modified by GJO to compress tree and add organism names to tree:
	#  push(@$html,`$FIG_Config::bin/align_with_clustal -org -func -tree \'$checked\'`);

	#  Simpler version
	# push @$html, map { chomp;
	#                    /^   *\|[ |]*$/      # line that adds only tree height
	#                    ? ()                 # remove it
	#                    : /- ([a-z]+\|\S+):/ && defined( $org{$1} ) # tree id?
	#                    ? "$_ [$org{$1}]\n"  # add the name
	#                    : "$_\n"             # otherwise leave unmodified
	#                  } `$FIG_Config::bin/align_with_clustal -org -func -tree \'$checked\'`;

	#  More complex version the preserves double spaced tree tips
	my $tip = 0;
	my @out = ();

	foreach ( `$FIG_Config::bin/align_with_clustal -org -func -tree \'$checked\'` )
	{
	    chomp;
	    if    ( /^   *\|[ |]*$/ ) {}  # line that adds only tree height
	    elsif ( /- ([a-z]+\|\S+):/ )  # line with tree tip
	    {
	        if ( defined( $org{$1} ) ) { $_ .= " [$org{$1}]" }  # add org
	        if ( $tip ) { push @out, "  |\n" }  # 2 tips in a row? add line 
	        push @out, "$_\n";      # output current line
	        $tip = 1;
	    }
	    else                          # not a tip
	    {
	        push @out, "$_\n";
	        $tip = 0;
	    }
	}
	push(@$html,&set_links($cgi,\@out));
	push(@$html,"</pre>\n");
    }
}

sub which_column {
    my($col,$roles) = @_;
    my($i);

    if (($col =~ /^(\d+)/) && ($1 <= @$roles))
    {
	return $1;
    }
    else
    {
	for ($i=1; ($i < @$roles) && ($roles->[$i] !~ /^$col\t/); $i++) {}
	return ($i < @$roles) ? $i : undef;
    }
}

sub seqs_to_align {
    my($colN,$genomes,$rows,$subsetR) = @_;
    my($i);

    my @seqs = ();
    for ($i=0; ($i < @$rows); $i++)
    {
	my $genome = $genomes->[$i];
	if ($subsetR->{$genome})
	{
	    push(@seqs,map { "fig|$genome.peg.$_" } split(/,/,$rows->[$i]->[$colN]));
	}
    }
    return @seqs;
}

sub get_homologs {
    my($fig,$checked,$cutoff,$max) = @_;
    my($peg,$sim,$id2);

    my @homologs = ();
    my %got = map { $_ => 1 } @$checked;

    foreach $peg (@$checked)
    {
	foreach $sim ($fig->sims($peg,$max,$cutoff,"fig"))
	{
	    $id2 = $sim->id2;
	    if (! $got{$id2})
	    {
		push(@homologs,[$sim->psc,$id2]);
		$got{$id2} = 1;
	    }
	}
    }
    @homologs = map { $_->[1] } sort { $a->[0] <=> $b->[0] } @homologs;
    if (@homologs > $max) { $#homologs = $max-1 }

    return @homologs;
}

sub set_links {
    my($cgi,$out) = @_;
   
    my @with_links = ();
    foreach $_ (@$out)
    {
	if ($_ =~ /^(.*)(fig\|\d+\.\d+\.peg\.\d+)(.*)$/)
	{
	    my($before,$peg,$after) = ($1,$2,$3);
	    push(@with_links, $before . &HTML::fid_link($cgi,$peg) . $after . "\n");
	}
	else
	{
	    push(@with_links,$_);
	}
    }
    return @with_links;
}

sub backup {
    my($ssaD) = @_;

    my $sz1 = &size("$ssaD/spreadsheet") + &size("$ssaD/notes");
    my $sz2 = &size("$ssaD/spreadsheet~") + &size("$ssaD/notes~");
    if (abs($sz1-$sz2) > 10)
    {
	&make_backup($ssaD);
    }
}

sub make_backup {
    my($ssaD) = @_;

    &FIG::verify_dir("$ssaD/Backup");
    my $ts = time;
    rename("$ssaD/spreadsheet~","$ssaD/Backup/spreadsheet.$ts");
    rename("$ssaD/notes~","$ssaD/Backup/notes.$ts");
    &incr_version($ssaD);
}

sub incr_version {
    my($dir) = @_;
    my($ver);

    if (open(VER,"<$dir/VERSION"))
    {
	if (defined($ver = <VER>) && ($ver =~ /^(\S+)/))
	{
	    $ver = $1;
	}
	else
	{
	    $ver = 0;
	}
	close(VER);
    }
    else
    {
	$ver = 0;
    }
    open(VER,">$dir/VERSION") || die "could not open $dir/VERSION";
    chmod(0777,"$dir/VERSION");
    $ver++;
    print VER "$ver\n";
}
	

sub size {
    my($file) = @_;

    return (-s $file) ? -s $file : 0;
}

sub reset_ssa {
    my($fig,$cgi,$html) = @_;
    my($ssa,@spreadsheets,$col_hdrs,$tab,$t,$readable,$url,$link,@tmp);

    if (($ssa = $cgi->param('ssa_name')) && opendir(BACKUP,"$FIG_Config::data/Subsystems/$ssa/Backup"))
    {
	@spreadsheets = sort { $b <=> $a }
	                map { $_ =~ /^spreadsheet.(\d+)/; $1 }
			grep { $_ =~ /^spreadsheet/ } 
	                readdir(BACKUP);
	closedir(BACKUP);
	$col_hdrs = ["When","Number Genomes"];
	$tab = [];
	foreach $t (@spreadsheets)
	{
	    $readable = &FIG::epoch_to_readable($t);
	    $url = &FIG::cgi_url . "/ssa2.cgi?user=$user&ssa_name=$ssa&request=reset_to&ts=$t";
	    $link = "<a href=$url>$readable</a>";
	    open(TMP,"<$FIG_Config::data/Subsystems/$ssa/Backup/spreadsheet.$t")
		|| die "could not open $FIG_Config::data/Subsystems/$ssa/Backup/spreadsheet.$t";
	    $/ = "//\n";
	    $_ = <TMP>;
	    $_ = <TMP>;
	    $_ = <TMP>;
	    chomp;
	    $/ = "\n";

	    @tmp = grep { $_ =~ /^\d+\.\d+/ } split(/\n/,$_);
	    push(@$tab,[$link,scalar @tmp]);
	}
    }
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Possible Points to Reset From"));
}

sub reset_ssa_to {
    my($fig,$cgi,$html) = @_;
    my($ts,$ssa);

    if (($ssa = $cgi->param('ssa_name')) &&
	 ($ts = $cgi->param('ts')) && 
	 (-s "$FIG_Config::data/Subsystems/$ssa/Backup/spreadsheet.$ts"))
    {
	system "cp -f $FIG_Config::data/Subsystems/$ssa/Backup/spreadsheet.$ts $FIG_Config::data/Subsystems/$ssa/spreadsheet";
	chmod(0777,"$FIG_Config::data/Subsystems/$ssa/spreadsheet");
	if (-s "$FIG_Config::data/Subsystems/$ssa/Backup/notes.$ts")
	{
	    system "cp -f $FIG_Config::data/Subsystems/$ssa/Backup/notes.$ts $FIG_Config::data/Subsystems/$ssa/notes";
	    chmod(0777,"$FIG_Config::data/Subsystems/$ssa/notes");
	}
	push(@$html,$cgi->h1("Reset"));
    }
}
		
sub make_exchangable {
    my($fig,$cgi,$html) = @_;
    my($ssa);

    if (($ssa = $cgi->param('ssa_name')) &&
	 (-s "$FIG_Config::data/Subsystems/$ssa/spreadsheet") &&
	open(TMP,">$FIG_Config::data/Subsystems/$ssa/EXCHANGABLE"))
    {
	print TMP "1\n";
	close(TMP);
	chmod(0777,"$FIG_Config::data/Subsystems/$ssa/EXCHANGABLE");
    }
}

sub make_unexchangable {
    my($fig,$cgi,$html) = @_;
    my($ssa);

    if (($ssa = $cgi->param('ssa_name')) &&
	 (-s "$FIG_Config::data/Subsystems/$ssa/EXCHANGABLE"))
    {
	unlink("$FIG_Config::data/Subsystems/$ssa/EXCHANGABLE");
    }
}

sub fid_links {
    my($cgi,$entry,$genome,$suff) = @_;
    my($pegN);

    my @links = ();
    foreach $pegN (split(/,/,$entry->[0]))
    {
	push(@links,&HTML::fid_link($cgi,"fig|$genome.peg.$pegN","local") . $suff);
    }
    return @links;
}

sub group_by_clusters {
    my($fig,$genome,$tmp) = @_;
    my(@pegs,$entry,$pegN,%pegs,$peg,$peg1,%conn,%seen,@entries);
    my($i,$x,@cluster,@clusters,%in,$best,$cluster,$which,$colors);

    if (! $cgi->param('show_clusters'))
    {
	return map { [$_,"#FFFFFF"] } @$tmp;
    }

    @pegs = ();
    foreach $entry (@$tmp)
    {
	foreach $pegN (split(/,/,$entry))
	{
	    push(@pegs,"fig|$genome.peg.$pegN");
	}
    }
    %pegs = map { $_ => 1 } @pegs;
    @pegs = keys(%pegs);

    foreach $peg (@pegs)
    {
	foreach $peg1 (grep { $pegs{$_} && ($_ ne $peg) } $fig->close_genes($peg,5000))
	{
	    push(@{$conn{$peg}},$peg1);
	}
    }

    @clusters = ();
    while ($peg = shift @pegs)
    {
	if (! $seen{$peg})
	{
	    @cluster = ($peg);
	    $seen{$peg} = 1;
	    for ($i=0; ($i < @cluster); $i++)
	    {
		$x = $conn{$cluster[$i]};
		foreach $peg1 (@$x)
		{
		    if (! $seen{$peg1})
		    {
			push(@cluster,$peg1);
			$seen{$peg1} = 1;
		    }
		}
	    }
	    push(@clusters,[@cluster]);
	}
    }

    @clusters = sort { @$b <=> @$a } @clusters;
    for ($i=0; ($i < @clusters); $i++)
    {
	$cluster = $clusters[$i];
	foreach $peg (@$cluster)
	{
	    $peg =~ /(\d+)$/;
	    $in{$1} = $i;
	}
    }

    $colors = 
        [
          '#C0C0C0',
          '#FF40C0',
          '#FF8040',
          '#FF0080',
          '#FFC040',
          '#40C0FF',
          '#40FFC0',
          '#C08080',
          '#C0FF00',
          '#00FF80',
          '#00C040'
        ];

    @entries = ();
    foreach $entry (@$tmp)
    {
	$best = undef;
	foreach $pegN (split(/,/,$entry))
	{
	    $which = $in{$pegN};
	    if ((! defined($best)) || ($best > $which))
	    {
		$best = $which;
	    }
	}

	if (defined($best) && (@{$clusters[$best]} > 1) && ($best < @$colors))
	{
	    push(@entries,[$entry,$colors->[$best]]);
	}
	else
	{
	    push(@entries,[$entry,'#FFFFFF']);
	}
    }
    return @entries;
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3