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

View of /FigWebServices/subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (download) (annotate)
Thu Dec 9 06:00:02 2004 UTC (15 years, 3 months ago) by redwards
Branch: MAIN
Changes since 1.21: +62 -0 lines
Fixed bugs with "show PEGs in roles that do not match precisely".
Also, added a new function to allow reannotation of an entire column at once.

# -*- perl -*-

use FIG;
my $fig = new FIG;

use Subsystem;

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;
}

# request to display the phylogenetic tree
#
my $request = $cgi->param("request");
if ($request && ($request eq "show_tree"))
{
    print $cgi->header;
    &show_tree;
    exit;
}

my $html = [];

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

if ($cgi->param('resynch_peg_connections') && (my $ssa = $cgi->param('ssa_name')))
{
    my $subsystem = new Subsystem($ssa,$fig,0);
    $subsystem->db_sync(0);
    undef $subsystem;
    &one_cycle($fig,$cgi,$html);
}
elsif ($user && ($cgi->param("extend_with_billogix")))
{
    #
    # Start a bg task to extend the subsystem.
    #

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

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

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

    if ($sub && ($user eq $sub->get_curator))
    {
	#
	# 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;
}
else
{
    $request = defined($request) ? $request : "";
    
    if    (($request eq "reset") && $user)
    {
	&reset_ssa($fig,$cgi,$html);        # allow user to go back to a previous version of the ss
    }
    elsif    (($request eq "reset_to") && $user)
    {
	&reset_ssa_to($fig,$cgi,$html);     # this actually resets to the previous version
	&one_cycle($fig,$cgi,$html);
    }
    elsif    (($request eq "make_exchangable") && $user)
    {
	&make_exchangable($fig,$cgi,$html);
	&show_initial($fig,$cgi,$html);
    }
    elsif    (($request eq "make_unexchangable") && $user)
    {
	&make_unexchangable($fig,$cgi,$html);
	&show_initial($fig,$cgi,$html);
    }
    elsif    ($request eq "show_ssa")
    {
	&one_cycle($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") && $user &&
	    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") && $user &&
	   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 ($user && ($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 => "subsys.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);


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 => "subsys.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;
    }

    my $subsystem = new Subsystem($ssa,$fig,1);    # create new subsystem

    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');

    
    if ($copy_from1 && (@cols_to_take1 > 0))
    {
	$subsystem->add_to_subsystem($copy_from1,\@cols_to_take1,"take notes");  # add columns and notes
    }

    if ($copy_from2 && (@cols_to_take2 > 0))
    {
	$subsystem->add_to_subsystem($copy_from2,\@cols_to_take2,"take notes");  # add columns and notes
    }

    $subsystem->write_subsystem();

    $cgi->param(-name => "can_alter",
		-value => 1);
    &one_cycle($fig,$cgi,$html);
}

# The basic update logic (cycle) includes the following steps:
# 
#     1. Load the existing spreadsheet
#     2. reconcile row and subset changes
#     3. process spreadsheet changes (fill/refill/add genomes/update variants)
#     4. write the updated spreadsheet back to disk
#     5. render the spreadsheet
#
sub one_cycle {
    my($fig,$cgi,$html) = @_;

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

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

    my $subsystem = new Subsystem($ssa,$fig,0);
    if (&handle_role_and_subset_changes($fig,$subsystem,$cgi,$html))
    {
	&process_spreadsheet_changes($fig,$subsystem,$cgi,$html);

	if ($cgi->param('can_alter') && ($user = $cgi->param('user')) && ($user eq $subsystem->get_curator))
	{
	    $subsystem->write_subsystem();
	}
	&produce_html_to_display_subsystem($fig,$subsystem,$cgi,$html,$ssa);
    }
}

sub handle_role_and_subset_changes {
    my($fig,$subsystem,$cgi,$html) = @_;
    my $user;

    if ((! $cgi->param('can_alter')) || (! ($user = $cgi->param('user'))) || ($user ne $subsystem->get_curator))
    {
	return 1;    # no changes, so...
    }
    else
    {
	my($role,$p,$abr,$r,$n);
	my @tuplesR = ();
	my @roles   = grep { $_ =~ /^role/ }   $cgi->param();
	if (@roles == 0)  { return 1 }     # initial call, everything is as it was

	foreach $role (@roles)
	{
	    if (($role =~ /^role(\d+)/) && defined($n = $1))
	    {
		if ($r = $cgi->param("role$n"))
		{
		    $r =~ s/^\s+//;
		    $r =~ s/\s+$//;

		    if (($p = $cgi->param("posR$n")) && ($abr = $cgi->param("abbrev$n")))
		    {
			push(@tuplesR,[$p,$r,$abr]);
		    }
		    else
		    {
			push(@$html,$cgi->h1("You need to give a position and abbreviation for $r"));
			return 0;
		    }
		}
	    }
	}
	$subsystem->set_roles([map { [$_->[1],$_->[2]] } sort { $a->[0] <=> $b->[0] } @tuplesR]);


	my($subset_name,$s,$test,$entries,$entry);
	my @subset_names  = grep { $_ =~ /^nameCS/ } $cgi->param();

	if (@subset_names == 0) { return 1 }

	my %defined_subsetsC;
	foreach $s (@subset_names)
	{
	    if (($s =~ /^nameCS(\d+)/) && defined($n = $1) && ($subset_name = $cgi->param($s)))
	    {

		my($text);
		$entries = [];
		if ($text = $cgi->param("subsetC$n"))
		{
		    foreach $entry (split(/[\s,]+/,$text))
		    {
			if ($role = &to_role($entry,\@tuplesR))
			{
			    push(@$entries,$role);
			}
			else
			{
			    push(@$html,$cgi->h1("Invalid role designation in subset $s: $entry"));
			    return 0;
			}
		    }
		}
		$defined_subsetsC{$subset_name} = $entries;
	    }
	}

	foreach $s ($subsystem->get_subset_namesC)
	{
	    next if ($s eq "All");
	    if ($entries = $defined_subsetsC{$s})
	    {
		$subsystem->set_subsetC($s,$entries);
		delete $defined_subsetsC{$s};
	    }
	    else
	    {
		$subsystem->delete_subsetC($s);
	    }
	}

	foreach $s (keys(%defined_subsetsC))
	{
	    $subsystem->set_subsetC($s,$defined_subsetsC{$s});
	}
    }
    return 1;
}

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

    if (($x =~ /^(\d+)$/) && ($1 <= @$role_tuples)) { return $role_tuples->[$x-1]->[1] }

    for ($i=0; ($i < @$role_tuples) && 
	       ($role_tuples->[0] != $x) &&
	       ($role_tuples->[1] != $x) &&
	 ($role_tuples->[2] != $x); $i++) {}
    if ($i < @$role_tuples)
    {
	return $role_tuples->[$i]->[1];
    }
    return undef;
}
    
sub process_spreadsheet_changes {
    my($fig,$subsystem,$cgi,$html) = @_;

    my $user;
    if ((! $cgi->param('can_alter')) || (! ($user = $cgi->param('user'))) || ($user ne $subsystem->get_curator))
    {
	return 1;    # no changes, so...
    }
    else
    {
	my $notes = $cgi->param('notes');
	if ($notes)
	{
	    $subsystem->set_notes($notes);
	}

	my(@param,$param,$genome,$val);
	@param = grep { $_ =~ /^genome\d+\.\d+$/ } $cgi->param;

	my %removed;
	foreach $param (@param)
	{
	    if ($cgi->param($param) =~ /^\s*$/)
	    {
		$param =~ /^genome(\d+\.\d+)/;
		$genome = $1;
		$subsystem->remove_genome($genome);
		$removed{$genome} = 1;
	    }
	}

	@param = grep { $_ =~ /^vcode\d+\.\d+$/ } $cgi->param;
	foreach $param (@param)
	{
	    if ($cgi->param($param) =~ /^\s*(\S+)\s*$/)
	    {
		$val = $1;
		$param =~ /^vcode(\d+\.\d+)/;
		$genome = $1;
		if (! $removed{$genome})
		{
		    $subsystem->set_variant_code($subsystem->get_genome_index($genome),$val);
		}
	    }
	}
	
	if ($cgi->param('refill'))
	{
	    &refill_spreadsheet($fig,$subsystem);
	}
	elsif ($cgi->param('precise_fill'))
	{
	    &fill_empty_cells($fig,$subsystem);
	}

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

	my $org;
	foreach $org (@orgs)
	{
	    &add_genome($fig,$subsystem,$cgi,$html,$org);
	}
    }
}

sub refill_spreadsheet {
    my($fig,$subsystem) = @_;
    my($genome,$role,@pegs1,@pegs2,$i);

    foreach $genome ($subsystem->get_genomes())
    {
	foreach $role ($subsystem->get_roles())
	{
	    @pegs1 = sort $subsystem->get_pegs_from_cell($genome,$role);
	    @pegs2 = sort $fig->seqs_with_role($role,"master",$genome);

	    if (@pegs1 != @pegs2)
	    {
		$subsystem->set_pegs_in_cell($genome,$role,\@pegs2);
	    }
	    else
	    {
		for ($i=0; ($i < @pegs1) && ($pegs1[$i] eq $pegs2[$i]); $i++) {}
		if ($i < @pegs1)
		{
		    $subsystem->set_pegs_in_cell($genome,$role,\@pegs2);
		}
	    }
	}
    }
}

sub fill_empty_cells {
    my($fig,$subsystem) = @_;
    my($genome,$role,@pegs);

    foreach $genome ($subsystem->get_genomes())
    {
	foreach $role ($subsystem->get_roles())
	{
	    @pegs = $subsystem->get_pegs_from_cell($genome,$role);
	    if (@pegs == 0)
	    {
		@pegs = $fig->seqs_with_role($role,"master",$genome);
		if (@pegs > 0)
		{
		    $subsystem->set_pegs_in_cell($genome,$role,\@pegs);
		}
	    }
	}
    }
}

sub add_genome {
    my($fig,$subsystem,$cgi,$html,$genome) = @_;
    my($role,@pegs);
    
    $subsystem->add_genome($genome);
    foreach $role ($subsystem->get_roles())
    {
	@pegs = $fig->seqs_with_role($role,"master",$genome);
	$subsystem->set_pegs_in_cell($genome,$role,\@pegs);
    }
}

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

    my $user = $cgi->param('user');
    my $ssa  = $cgi->param('ssa_name');
    my $can_alter = ($cgi->param('can_alter') && $user && ($user eq $subsystem->get_curator));

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

    push(@$html, $cgi->h1("Subsystem: $name"),
                 $cgi->start_form(-action => "subsys.cgi",
				  -method => 'post'),
	         $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	         $cgi->hidden(-name => 'request', -value => 'show_ssa', -override => 1),
	         $cgi->hidden(-name => 'can_alter', -value => $can_alter, -override => 1),
	         $cgi->hidden(-name => 'ssa_name', -value => $name, -override => 1),
	         $cgi->br,
	 );

    &format_roles($fig,$cgi,$html,$subsystem,$can_alter);
    &format_subsets($fig,$cgi,$html,$subsystem,$can_alter);

    #
    # Put link into constructs tool.
    #

    if ($can_alter)
    {
	push(@$html, $cgi->p,
	     $cgi->a({href => "construct.cgi?ssa=$ssa&user=$user",
			  target => "_blank"},
		     "Define higher level constructs."),
	     $cgi->p);
    }



    &format_rows($fig,$cgi,$html,$subsystem);

    if ($can_alter)
    {
	&format_extend_with($fig,$cgi,$html,$subsystem);
	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);
			 
    push(@$html,$cgi->checkbox(-name => 'ignore_alt', -value => 1, -checked => 0, -override => 1,-label => 'ignore alternatives'),$cgi->br);
    push(@$html,$cgi->checkbox(-name => 'ext_ids', -value => 1, -checked => 0, -label => 'use external ids'),$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),"]",
	        "&nbsp; &nbsp; [To restrict to a single role: ",
                $cgi->textfield(-name => "just_role", -size => 15),"]",
	        $cgi->br,$cgi->br
        );

    push(@$html,$cgi->checkbox(-name => 'check_assignments', -value => 1, -checked => 0, -override => 1,-label => 'check assignments'),
	        '&nbsp;&nbsp;[',
                $cgi->checkbox(-name => 'strict_check', -value => 1, -checked => 0, -override => 1,-label => 'strict'),
	        ']',
	        "&nbsp; &nbsp; [To restrict to a single genome: ",
                $cgi->textfield(-name => "just_genome_assignments", -size => 15),"]",
	        "&nbsp; &nbsp; [To restrict to a single role: ",
                $cgi->textfield(-name => "just_role_assignments", -size => 15),"]",
	        $cgi->br.$cgi->br
        );

    if ($can_alter)
    {
	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);
    if ($can_alter)
    {
	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),
	     );
	     
     # RAE: A new function to reannotate a single column
     # I don't understand how you get CGI.pm to reset (and never have).
     # $cgi->delete("col_to_annotate"); # this does nothing to my script and there is always the last number in this box
     #push(@$html, $cgi->br,"Change annotation for column: ", $cgi->textfield(-name => "col_to_annotate", -size => 7));
     push(@$html, $cgi->br,"Change annotation for column: ", '<input type="text" name="col_to_annotate" value="" size="7">');

    if ($can_alter)
    {
	push(@$html,
	     $cgi->p. $cgi->hr."If you wish to check the subsystem, ",
	     $cgi->a({href => "check_subsys.cgi?user=$user&subsystem=$ssa&request=check_ssa"},
		     "click here"),
	     $cgi->br,
	     $cgi->p,
	     $cgi->hr,
	     "You should resynch PEG connections only if you detect PEGs that should be connected to the
              spreadsheet, but do not seem to be.  This can only reflect an error in the code.  If you find
              yourself having to use it, send mail to Ross.",
	     $cgi->br,
	     $cgi->submit(-value => "Resynch PEG Connections",
			  -name => "resynch_peg_connections"),
	     $cgi->br,
	     $cgi->submit(-value => "Start automated subsystem extension",
			     -name => "extend_with_billogix"),
	     $cgi->br);
    }

    my $notes = $subsystem->get_notes();
    if ($can_alter)
    {
	push(@$html,$cgi->hr,"NOTES:\n",$cgi->br,$cgi->textarea(-name => 'notes', -rows => 40, -cols => 100, -value => $notes));
    }
    elsif ($notes)
    {
	push(@$html,$cgi->h2('notes'),"<pre>$notes</pre>");
    }

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

    my $target = "align$$";
    my @roles = $subsystem->get_roles;
    my $rolesA = [];
    my $i;
    my $dir = $subsystem->get_dir;
    for ($i=1; ($i <= @roles); $i++)
    {
	if (-s "$dir/Alignments/$i/tree")
	{
	    push(@$rolesA,"$i: $roles[$i-1]");
	}
    }
    if (@$rolesA > 0)
    {
	push(@$html, $cgi->hr,
	             $cgi->h1('To Assign Using a Tree'),
	             $cgi->start_form(-action => "assign_using_tree.cgi",
				      -target => $target,
				      -method => 'post'),
	             $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	             $cgi->hidden(-name => 'ali_dir', -value => "$dir/Alignments", -override => 1),
	             $cgi->scrolling_list(-name => 'ali_num',
					  -values => $rolesA,
					  -size => 10,
					  -multiple => 0
					  ),
	             $cgi->br,
	             $cgi->submit(-value => "use_tree",
				  -name => "use_tree"),
	             $cgi->end_form
	 );
    }

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

    if ($cgi->param('show_missing'))
    {
	&format_missing($fig,$cgi,$html,$subsystem);
    }

    if ($cgi->param('show_missing_including_matches'))
    {
	&format_missing_including_matches($fig,$cgi,$html,$subsystem);
    }

    if ($cgi->param('check_assignments'))
    {
	&format_check_assignments($fig,$cgi,$html,$subsystem);
    }

    if ($cgi->param('show_dups'))
    {
	&format_dups($fig,$cgi,$html,$subsystem);
    }

    if ($cgi->param('show_coupled'))
    {
	&format_coupled($fig,$cgi,$html,$subsystem,"careful");
    }
    elsif ($cgi->param('show_coupled_fast'))
    {
	&format_coupled($fig,$cgi,$html,$subsystem,"fast");
    }

    my $col;
    if ($col = $cgi->param('col_to_align'))
    {
	&align_column($fig,$cgi,$html,$col,$subsystem);
    }
    elsif ($col = $cgi->param('col_to_annotate'))
    {
        &annotate_column($fig,$cgi,$html,$col,$subsystem);
    }

}

sub format_extend_with {
    my($fig,$cgi,$html,$subsystem) = @_;
    my($org,$gs);

    my %genomes = map { $_ => 1 } $subsystem->get_genomes();

    my @orgs = sort map { $org = $_; $gs = &ext_genus_species($fig,$org); "$gs ($org)" } 
	       grep { ! $genomes{$_} } 
	       $fig->genomes("complete",undef);

    push(@$html,
	        $cgi->h1('Pick Organisms to Extend with'),
	        $cgi->scrolling_list(-name => 'new_genome',
				     -values => [@orgs],
				     -size => 10,
				     -multiple => 1
				     ),
	        $cgi->hr
	 );
}

sub format_roles {
    my($fig,$cgi,$html,$subsystem,$can_alter) = @_;
    my($i);

    my $col_hdrs = ["Column","Abbrev","Functional Role"];
    my $tab = [];

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

sub format_existing_roles {
    my($fig,$cgi,$html,$subsystem,$tab,$nP,$can_alter) = @_;
    my($role);

    foreach $role ($subsystem->get_roles)
    {
	&format_role($fig,$cgi,$html,$subsystem,$tab,$$nP,$role,$can_alter);
	$$nP++;
    }
}

sub format_role {
    my($fig,$cgi,$html,$subsystem,$tab,$n,$role,$can_alter) = @_;
    my($abbrev);

    $abbrev = $role ? $subsystem->get_role_abbr($subsystem->get_role_index($role)) : "";

    my($posT,$abbrevT,$roleT);
    if ($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 => $role, -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 => $role, -override => 1));
	$posT = $n;
	$abbrevT = $abbrev;
	$roleT = $role;
    }
    #
    # 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 = $role;
	$rn =~ s/[ \/]/_/g;
	$rn =~ s/\W//g;

	$posT_html = "<a name=\"$rn\">$posT</a>";
    }
    

    push(@$tab,[$posT_html,$abbrevT,$roleT]);

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

sub gene_functions_in_col {
    my($fig,$role,$subsystem) = @_;
    my(%roles,$peg,$func);
   
   
    # RAE this is dying if $subsystem->get_col($subsystem->get_role_index($role) + 1) is not defined
    # it is also not returning the right answer, so we need to fix it.
    # I am not sure why this is incremented by one here (see the note) because it is not right
    # and if you don't increment it by one it is right.
    
                                            # incr by 1 to get col indexed from 1 (not 0)
    #my @pegs = map { @$_ } @{$subsystem->get_col($subsystem->get_role_index($role) + 1)}; 
    
    return undef unless ($role); # this takes care of one error
    my $col_role=$subsystem->get_col($subsystem->get_role_index($role));
    return undef unless (defined $col_role);
    my @pegs = map { @$_ } @$col_role;

    foreach $peg (@pegs)
    {
	if ($func = $fig->function_of($peg))
	{
	    push(@{$roles{$func}},$peg);
	}
    }
    return map { [$_,$roles{$_}] } sort keys(%roles);
}

sub format_subsets {
    my($fig,$cgi,$html,$subsystem,$can_alter) = @_;

    &format_subsetsC($fig,$cgi,$html,$subsystem,$can_alter);
    &format_subsetsR($fig,$cgi,$html,$subsystem);
}

sub format_subsetsC {
    my($fig,$cgi,$html,$subsystem,$can_alter) = @_;

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

    my $n = 1;
    &format_existing_subsetsC($cgi,$html,$subsystem,$tab,\$n,$can_alter);

    if ($can_alter)
    {
	my $i;
	for ($i=0; ($i < 5); $i++)
	{
	    &format_subsetC($cgi,$html,$subsystem,$tab,$n,"");
	    $n++;
	}
    }

    push(@$html,&HTML::make_table($col_hdrs,$tab,"Subsets of Roles"),
	        $cgi->hr
	 );

    my @subset_names = $subsystem->get_subset_namesC;
    if (@subset_names > 1)
    {
	my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
	push(@$html,$cgi->scrolling_list(-name => 'active_subsetC',
					 -values => [@subset_names],
					 -default => $active_subsetC
					 ),
	            $cgi->br
	     );
    }
    else
    {
	push(@$html,$cgi->hidden(-name => 'active_subsetC', -value => 'All', -override => 1));
    }
}

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

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

    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @tmp = grep { $_ ne "All" } sort $subsystem->get_subset_namesR;
    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,$subsystem,$tab,$nP,$can_alter) = @_;
    my($nameCS);

    foreach $nameCS (sort $subsystem->get_subset_namesC)
    {
	if ($nameCS !~ /all/i)
	{
	    &format_subsetC($cgi,$html,$subsystem,$tab,$$nP,$nameCS);
	    $$nP++;
	}
    }
}

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

    if ($nameCS ne "All")
    {
	my $subset = $nameCS ? join(",",map { $subsystem->get_role_index($_) + 1 } $subsystem->get_subsetC_roles($nameCS)) : "";

	$nameCS = $subset ? $nameCS : "";

	my($posT,$subsetT);

	$posT    = $cgi->textfield(-name => "nameCS$n", -size => 30, -value => $nameCS, -override => 1);
	$subsetT = $cgi->textfield(-name => "subsetC$n", -size => 80, -value => $subset, -override => 1);
	push(@$tab,[$posT,$subsetT]);
    }
}

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

sub format_rows {
    my($fig,$cgi,$html,$subsystem) = @_;
    my($i,%alternatives);

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

    my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @subsetC = $subsystem->get_subsetC_roles($active_subsetC);
    my %activeC = map { $_ => 1 } @subsetC;

    my @subsetR = $subsystem->get_subsetR($active_subsetR);
    my %activeR = map { $_ => 1 } @subsetR;

    if (! $ignore_alt)
    {
	my $subset;
	foreach $subset (grep { $_ =~ /^\*/ } $subsystem->get_subset_namesC)
	{
	    my @mem = grep { $activeC{$_} } $subsystem->get_subsetC_roles($subset);
	    if (@mem > 1)
	    {
		my $mem = [@mem];
		foreach $_ (@mem)
		{
		    $alternatives{$_} = [$subset,$mem];
		}
	    }
	}
    }

    my @in = $subsystem->get_genomes;

    if (@in > 0)
    {
	my $col_hdrs = ["Genome ID","Organism","Variant Code"];

	my @row_guide = ();

	my($role,%in_col);
	foreach $role (grep { $activeC{$_} } $subsystem->get_roles)
	{
	    if (! $in_col{$role})
	    {
		if ($_ = $alternatives{$role})
		{
		    my($abbrev,$mem) = @$_;
		    push(@$col_hdrs,$abbrev);
		    push(@row_guide,[map { [$_,"-" . ($subsystem->get_role_index($_) + 1)] } @$mem]);
		    foreach $_ (@$mem) { $in_col{$_} = 1 };
		}
		else
		{
		    push(@$col_hdrs,$subsystem->get_role_abbr($subsystem->get_role_index($role)));
		    push(@row_guide,[[$role,""]]);
		}
	    }
	}

	my $tab = [];
	my($genome,@pegs,@cells,$set,$peg_set,$pair,$role,$suffix,$row,$peg,$color_of,$cell,%count,$color,@colors);
	foreach $genome (grep { $activeR{$_} } @in)
	{
	    my($genomeV,$vcodeV,$vcode_value);
	    $vcode_value = $subsystem->get_variant_code($subsystem->get_genome_index($genome));
	    $row = [$genome, &ext_genus_species($fig,$genome),$vcode_value];

	    @pegs = ();
	    @cells = ();
	    foreach $set (@row_guide)
	    {
		$peg_set = [];
		foreach $pair (@$set)
		{
		    ($role,$suffix) = @$pair;
		    foreach $peg ($subsystem->get_pegs_from_cell($genome,$role))
		    {
			push(@$peg_set,[$peg,$suffix]);
		    }
		}
		push(@pegs,map { $_->[0] } @$peg_set);
		push(@cells,$peg_set);
	    }
	    $color_of = &group_by_clusters($fig,\@pegs);
	    foreach $cell (@cells)
	    {
		undef %count;
		foreach $_ (@$cell)
		{
		    if (($color = $color_of->{$_->[0]}) ne '#FFFFFF')
		    {
			$count{$color}++;
		    }
		}
		@colors = sort { $count{$b} <=> $count{$a} } keys(%count);
		$color = (@colors > 0) ? $colors[0] : '#FFFFFF';
		push(@$row,"\@bgcolor=\"$color\":" . join(", ",map { ($cgi->param('ext_ids') ? &external_id($fig,$cgi,$_->[0]) : &HTML::fid_link($cgi,$_->[0],"local")) . $_->[1] } @$cell));
	    }
	    push(@$tab,$row);
	}


	my($sort);
	if ($sort = $cgi->param('sort'))
	{
	    if ($sort eq "by_variant")
	    {
		my @tmp = ();
		my $row;
		foreach $row (@$tab)
		{
		    my @var = ();
		    my $i;
		    for ($i=3; ($i < @$row); $i++)
		    {
			push(@var, ($row->[$i] =~ /fig\|/) ? 1 : 0);
		    }
		    push(@tmp,[join("",@var),$row]);
		}
		$tab = [map { $_->[1] } sort { $a->[0] cmp $b->[0] } @tmp];
	    }
	    elsif ($sort eq "by_phylo")
	    {
		$tab = [map      { $_->[0] }
		        sort     { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
	                map      { [$_, $fig->taxonomy_of($_->[0])] }
		        @$tab];
	    }
	    elsif ($sort eq "by_tax_id")
	    {
		$tab = [sort     { $a->[0] <=> $b->[0] } @$tab];
	    }
	    elsif ($sort eq "alphabetic")
	    {
		$tab = [sort     { ($a->[1] cmp $b->[1]) or ($a->[0] <=> $b->[0]) } @$tab];
	    }
	}

	foreach $row (@$tab)
	{
	    my($genomeV,$vcodeV,$vcode_value);
	    $genome = $row->[0];
	    $vcode_value = $row->[2];
	    if ($cgi->param('can_alter'))
	    {
		$genomeV = $cgi->textfield(-name => "genome$genome", -size => 15, -value => $genome, -override => 1);
		$vcodeV  = $cgi->textfield(-name => "vcode$genome", -value => $vcode_value, -size => 10);
	    }
	    else
	    {
		push(@$html,$cgi->hidden(-name => "genome$genome", -value => $genome, -override => 1),
			    $cgi->hidden(-name => "vcode$genome", -value => $vcode_value));
		$genomeV = $genome;
		$vcodeV  = $vcode_value;
	    }
	    $row->[0] = $genomeV;
	    $row->[2] = $vcodeV;
	}

	my $tab1 = [];
	foreach $row (@$tab)
	{
	    if ((@$tab1 > 0) && ((@$tab1 % 10) == 0))
	    {
		push(@$tab1,[map { "<b>$_</b>" } @$col_hdrs]) ;
	    }
	    push(@$tab1,$row);
	}

	push(@$html,&HTML::make_table($col_hdrs,$tab1,"Basic Spreadsheet"),
	            $cgi->hr
	     );

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

sub group_by_clusters {
    my($fig,$pegs) = @_;
    my($peg,@clusters,@cluster,@colors,$color,%seen,%conn,$x,$peg1,@pegs,$i);

    my $color_of = {};
    foreach $peg (@$pegs) { $color_of->{$peg} = '#FFFFFF' }

    if ($cgi->param('show_clusters'))
    {
	@pegs = keys(%$color_of);

	foreach $peg (@pegs)
	{
	    foreach $peg1 (grep { $color_of->{$_} && ($_ 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]);
	    }
	}

	@colors = 
	    (
	     '#C0C0C0',
	     '#FF40C0',
	     '#FF8040',
	     '#FF0080',
	     '#FFC040',
	     '#40C0FF',
	     '#40FFC0',
	     '#C08080',
	     '#C0FF00',
	     '#00FF80',
	     '#00C040'
	    );

	@clusters = grep { @$_ > 1 } sort { @$a <=> @$b } @clusters;

	if (@clusters > @colors) { splice(@clusters,0,(@clusters - @colors)) }  # make sure we have enough colors

	my($cluster);
	foreach $cluster (@clusters)
	{
	    $color = shift @colors;
	    foreach $peg (@$cluster)
	    {
		$color_of->{$peg} = $color;
	    }
	}
    }
    return $color_of;
}

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 => "subsys.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 . "/subsys.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 . "/subsys.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 . "/subsys.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 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 ssa_link {
    my($ssa,$user) = @_;
    my $name = $ssa; $name =~ s/_/ /g;
    my $target = "window$$";
    if ($name =~ /([a-zA-Z]{3})/)
    {
	$target .= ".$1";
    }

    my $can_alter = &curator($ssa) eq $user;

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

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 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,$subsystem) = @_;
    my($org,$abr,$role,$missing);

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

    my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @subsetC = $subsystem->get_subsetC_roles($active_subsetC);
    my %activeC = map { $_ => 1 } @subsetC;

    my @subsetR = $subsystem->get_subsetR($active_subsetR);

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

    foreach $org (@subsetR)
    {
	my @missing = &columns_missing_entries($cgi,$subsystem,$org,\@subsetC,\%in);

	$missing = [];
	foreach $role (@missing)
	{
	    $abr = $subsystem->get_role_abbr($subsystem->get_role_index($role));
	    my $roleE = $cgi->escape($role);
	    
	    my $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)
	{
	    my $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,$subsystem,$org,$roles,$in) = @_;

    next if (($_ = $cgi->param('just_genome')) && ($org != $_));
    my $just_col = $cgi->param('just_col');
    my(@really_missing) = ();

    my($role,%missing_cols);
    foreach $role (@$roles)
    {
	next if ($just_col && ($role ne $just_col));
	if ($subsystem->get_pegs_from_cell($org,$role) == 0)
	{
	    $missing_cols{$role} = 1;
	}
    }

    foreach $role (@$roles)
    {
	if ($missing_cols{$role})
	{
	    my($set);
	    if (($set = $in->{$role}) && (! $cgi->param('ignore_alt')))
	    {
		my @set = $subsystem->get_subsetC_roles($set);

		my($k);
		for ($k=0; ($k < @set) && $missing_cols{$set[$k]}; $k++) {}
		if ($k == @set)
		{
		    push(@really_missing,$role);
		}
	    }
	    else
	    {
		push(@really_missing,$role);
	    }
	}
    }
    return @really_missing;
}

sub format_missing_including_matches 
{
    my($fig,$cgi,$html,$subsystem) = @_;
    my($org,$abr,$role,$missing);

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

    my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @subsetC = $subsystem->get_subsetC_roles($active_subsetC);
    my %activeC = map { $_ => 1 } @subsetC;

    my @subsetR = $subsystem->get_subsetR($active_subsetR);

    my @alt_sets = grep { ($_ =~ /^\*/) } $subsystem->get_subset_namesC;
    my($set,$col,%in);
    foreach $set (@alt_sets) 
    {
	my @mem = grep { $activeC{$_} } $subsystem->get_subsetC_roles($set);
	foreach $col (@mem)
	{
	    $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');
    push(@$html,
	 $cgi->hidden(-name => 'user', -value => $user, -override => 1),
	 $cgi->hidden(-name => 'can_alter', -value => $can_alter, -override => 1));

    my $just_role = &which_role($subsystem,$cgi->param('just_role'));
    
    foreach $org (@subsetR)
    {
	my @missing = &columns_missing_entries($cgi,$subsystem,$org,\@subsetC,\%in);
	$missing = [];
	foreach $role (@missing)
	{
#	    next if (($_ = $cgi->param('just_role')) && ($_ != ($subsystem->get_role_index($role) + 1)));
	    next if ($just_role && ($just_role ne $role));

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

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

	    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, ""));
	}
    }
    push(@$html,
	 $cgi->submit(-value => "Process assignments",
			      -name => "batch_assign"),
	 $cgi->end_form);
}

sub format_check_assignments {
    my($fig,$cgi,$html,$subsystem) = @_;
    my($org,$role);

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

    my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @subsetC = $subsystem->get_subsetC_roles($active_subsetC);
    my %activeC = map { $_ => 1 } @subsetC;

    my @subsetR = $subsystem->get_subsetR($active_subsetR);

    push(@$html,$cgi->h1('Potentially Bad Assignments:'));

    foreach $org (@subsetR)
    {
	next if (($_ = $cgi->param('just_genome_assignments')) && ($_ != $org));
	my @bad = ();

	foreach $role (@subsetC)
	{
	    next if (($_ = $cgi->param('just_role_assignments')) && ($_ != ($subsystem->get_role_index($role) + 1)));
	    push(@bad,&checked_assignments($cgi,$subsystem,$org,$role));
	}

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

sub checked_assignments {
    my($cgi,$subsystem,$genome,$role) = @_;
    my($peg,$line1,$line2,@out,$curr,$auto);

    my(@bad) = ();
    my @pegs = $subsystem->get_pegs_from_cell($genome,$role);
    if (@pegs > 0)
    {
	my $tmp = "/tmp/tmp.pegs.$$";
	open(TMP,">$tmp") || die "could not open $tmp";
	foreach $peg (@pegs)
	{
	    print TMP "$peg\n";
	}
	close(TMP);
	my $strict = $cgi->param('strict_check') ? "strict" : "";
	@out = `$FIG_Config::bin/check_peg_assignments $strict < $tmp 2> /dev/null`;
	unlink($tmp);

	while (($_ = shift @out) && ($_ =~ /^(fig\|\d+\.\d+\.peg\.\d+)/))
	{
	    $peg = $1;
	    if (($line1 = shift @out) && ($line1 =~ /^current:\s+(\S.*\S)/) && ($curr = $1) &&
		($line2 = shift @out) && ($line2 =~ /^auto:\s+(\S.*\S)/) && ($auto = $1))
	    {
		if (! $fig->same_func($curr,$auto))
		{
		    my $link = &HTML::fid_link($cgi,$peg);
		    push(@bad,"$link<br>$line1<br>$line2<br><br>");
		}
	    }
	}
    }
    return @bad;
}

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

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

    my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @subsetC = $subsystem->get_subsetC_roles($active_subsetC);
    my %activeC = map { $_ => 1 } @subsetC;

    my @subsetR = $subsystem->get_subsetR($active_subsetR);

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

    my($org,$duplicates,$role,$genus_species);
    foreach $org (@subsetR)
    {
	$duplicates = [];
	foreach $role (@subsetC)
	{
	    my(@pegs,$peg,$func);
	    if ((@pegs = $subsystem->get_pegs_from_cell($org,$role)) > 1)
	    {
		push(@$duplicates,"$role<br>" . $cgi->ul($cgi->li([map { $peg = $_; $func = $fig->function_of($peg,$user); &HTML::fid_link($cgi,$peg) . " $func" } @pegs])));
	    }
	}

	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_coupled {
    my($fig,$cgi,$html,$subsystem,$type) = @_;
    my($i,$j,@show,$user,$org,$link,$gs,$func,$peg,$peg1,$peg2,%in,%seen,%seen2);
    my(@cluster,$sc,$x,$id2,@in,$sim,@coupled);
    my($org,$role);

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

    my $active_subsetC = ($cgi->param('active_subsetC') or $subsystem->get_active_subsetC );
    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );

    my @subsetC = $subsystem->get_subsetC_roles($active_subsetC);
    my %activeC = map { $_ => 1 } @subsetC;

    my @subsetR = $subsystem->get_subsetR($active_subsetR);

    foreach $org (@subsetR)
    {
	foreach $role (@subsetC)
	{
	    push(@in,$subsystem->get_pegs_from_cell($org,$role));
	}
    }

    %in = map { $_ => 1 } @in;
    @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 annotate_column {
    # RAE: I added this function to allow you to reannotate a single column all at once
    # this is because I wanted to update some of my annotations after looking at UniProt
    # and couldn't see an easy way to do it.
    my($fig,$cgi,$html,$col,$subsystem) = @_;
    my $checked;
    my $roles = [$subsystem->get_roles];
    my $colN = &which_column($col,$roles);
    my @checked = &seqs_to_align($colN,$subsystem);
    return undef unless (@checked);
    
    # the following is read from fid_checked.cgi
    push( @$html, "<table border=1>\n",
	           "<tr><td>Protein</td><td>Organism</td><td>Current Function</td><td>By Whom</td></tr>"
	);
    
    foreach my $peg ( @checked ) {
        my @funcs = $fig->function_of( $peg );
        if ( ! @funcs ) { @funcs = ( ["", ""] ) }
        my $nfunc = @funcs;
	my $org = $fig->org_of( $peg );
	push( @$html, "<tr>",
	              "<td rowspan=$nfunc>$peg</td>",
	              "<td rowspan=$nfunc>$org</td>"
	    );
	my ($who, $what);
	push( @$html, join( "</tr>\n<tr>", map { ($who,$what) = @$_; "<td>$what</td><td>$who</td>" } @funcs ) );
	push( @$html, "</tr>\n" );
    }
    push( @$html, "</table>\n" );

    push( @$html, $cgi->start_form(-action => "fid_checked.cgi", -target=>"_blank"),
              $cgi->br, $cgi->br,
              "<table>\n",
              "<tr><td>New Function:</td>",
              "<td>", $cgi->textfield(-name => "function", -size => 60), "</td></tr>",
              "<tr><td colspan=2>", $cgi->hr, "</td></tr>",
              "<tr><td>New Annotation:</td>",
              "<td rowspan=2>", $cgi->textarea(-name => "annotation", -rows => 30, -cols => 60), "</td></tr>",
	      "<tr><td valign=top width=20%><br>", $cgi->submit('add annotation'), 
	      "<p><b>Please note:</b> At the moment you need to make sure that the annotation in the table at the ",
	      "top of this page reflects the new annotation. This may not be updated automatically.</p>",
	      "</td></tr>",
              "</table>",
              $cgi->hidden(-name => 'user', -value => $user),
              $cgi->hidden(-name => 'checked', -value => [@checked]),
              $cgi->end_form
     );
}


sub align_column {
    my($fig,$cgi,$html,$col,$subsystem) = @_;
    my($colN,@checked,$cutoff);

    my $checked;
    my $roles = [$subsystem->get_roles];

    if (($colN = &which_column($col,$roles)) &&
	((@checked = &seqs_to_align($colN,$subsystem)) > 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 $roles->[$1-1];
    }
    return undef;
}

sub seqs_to_align {
    my($role,$subsystem) = @_;
    my($genome);

    my $active_subsetR = ($cgi->param('active_subsetR') or $subsystem->get_active_subsetR );
    my @subsetR = $subsystem->get_subsetR($active_subsetR);

    my @seqs = ();
    foreach $genome (@subsetR)
    {
	push(@seqs,$subsystem->get_pegs_from_cell($genome,$role));
    }
    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}) && ($id2 =~ /^fig\|(\d+\.\d+)/) && ($fig->is_complete($1)))
	    {
		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 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 . "/subsys.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");
	}

	my $subsystem = new Subsystem($ssa,$fig,0);
	$subsystem->db_sync(0);
	undef $subsystem;
    }
}
		
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 which_role {
    my($subsystem,$role_indicator) = @_;
    my($n,$role,$abbr);

    if (($role_indicator =~ /^\s*(\d+)\s*$/) && ($n = $1) && ($role = $subsystem->get_role($n-1)))
    {
	return $role;
    }
    elsif (($role_indicator =~ /^\s*(\S+)\s*$/) && ($abbr = $1) && ($role = $subsystem->get_role_from_abbr($abbr)))
    {
	return $role;
    }
    return "";
}

sub external_id {
    my($fig,$cgi,$peg) = @_;
    my @tmp;
    my @aliases = ($fig->feature_aliases($peg),map { $_->[0] } $fig->mapped_prot_ids($peg));
    if      ((@tmp = grep { $_ =~ /^uni\|/ } @aliases) > 0)
    {
	@aliases = map { &HTML::uni_link($cgi,$_) } @tmp;
    }
    elsif   ((@tmp = grep { $_ =~ /^sp\|/ } @aliases) > 0)
    {
	@aliases = map { &HTML::sp_link($cgi,$_) } @tmp;
    }
    elsif   ((@tmp = grep { $_ =~ /^gi\|/ } @aliases) > 0)
    {
	@aliases = map { &HTML::gi_link($cgi,$_) } @tmp;
    }
    elsif   ((@tmp = grep { $_ =~ /^kegg\|/ } @aliases) > 0)
    {
	@aliases = map { &HTML::kegg_link($cgi,$_) } @tmp;
    }
    else
    {
	return wantarray() ? (&HTML::fid_link($cgi,$peg)) : &HTML::fid_link($cgi,$peg);
    }

    if (wantarray())
    {
	return @aliases;
    }
    else
    {
	return $aliases[0];
    }
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3