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

View of /FigWebServices/set_variants.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (download) (annotate)
Mon Mar 20 02:01:08 2006 UTC (14 years, 2 months ago) by overbeek
Branch: MAIN
CVS Tags: mgrast_dev_08112011, rast_rel_2009_05_18, mgrast_dev_08022011, 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, mgrast_dev_02212011, rast_rel_2010_1206, 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, rast_rel_2009_03_26, mgrast_dev_10262011, rast_rel_2008_11_24, rast_rel_2008_08_07
Changes since 1.4: +10 -0 lines
RAE: Adding a link into set variants from subsys.cgi and back

# -*- 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 Subsystem;

use HTML;
use strict;

use CGI;
my $cgi = new CGI;

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

$fig->set_user($user);

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

my $html = [];
unshift @$html, "<TITLE>Set Variants</TITLE>\n";

my $subsys = $cgi->param('subsystem');
if (! $subsys)
{
    my @ssa = &existing_subsystem_annotations;

    if (@ssa > 0)
    {
	&format_ssa_table($cgi,$html,\@ssa);
    }
    else
    {
	push(@$html,$cgi->h1('Sorry, no subsystems defined'));
    }
}
elsif ($subsys && ($cgi->param('request') eq "show_variants"))
{
    push @$html, "<h1>Set variants for ", &HTML::sub_link($cgi, $subsys), "</h1>\n";
    &show_variants($cgi,$fig,$html,$subsys);
}
elsif ($subsys && ($cgi->param('request') eq "set_variants"))
{
    push @$html, "<h1>Set variants for ", &HTML::sub_link($cgi, $subsys), "</h1>\n";
    &set_variants($cgi,$fig,$html,$subsys);
}
else
{
    push(@$html,$cgi->h1('invalid parameters'));
}

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

sub format_ssa_table {
    my($cgi,$html,$ssaP) = @_;

    push(@$html, $cgi->start_form(-action => "set_variants.cgi",
				  -method => 'post'),
	         $cgi->hidden(-name => 'request', -value => 'show_variants', -override => 1),
                 $cgi->hidden(-name => 'user', -value=>$user),
	         $cgi->scrolling_list( -name   => 'subsystem',
				       -values => [ map { $_->[0] } @$ssaP ],
				       -size   => 10
				       ),
	         $cgi->br,
	         $cgi->submit( 'Pick One' ),
	         $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 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 show_variants {
    my($cgi,$fig,$html,$subsys) = @_;

    my $sub           = $fig->get_subsystem($subsys);
    my @genomes       = $sub->get_genomes;
    my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
    my @roles         = $sub->get_roles;

    my $abbrev = &format_roles($fig,$cgi,$html,$sub);

    my(@has,$role,%has_filled);
    foreach $genome (@genomes)
    {

	next if (! &ok_variant($variant_codes{$genome}));
	@has = ();
	foreach $role (@roles)
	{
	    push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
	}
	$has_filled{join(",",@has)}->{$variant_codes{$genome}}++;
    }

    my($col_hdrs,$tab,$pattern);
    $col_hdrs = ["Pattern","# Genomes with Pattern","Existing Variant Code","Set To"];
    $tab = [];
    foreach $pattern (sort keys(%has_filled))
    {
	my @codes = keys(%{$has_filled{$pattern}});
	my $code;
	my $nrow = @codes;
	if (@codes > 0)
	{
	    $code = shift @codes;
	    push( @$tab, [ [ $pattern, "td rowspan=$nrow"],
			   $has_filled{$pattern}->{$code},
			   $code,
			   $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
		         ]);
	}

	foreach $code (@codes)
	{
	    push(@$tab,[$has_filled{$pattern}->{$code},
			$code,
			$cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
			]);
	}
    }
    push(@$html,$cgi->start_form(-action => 'set_variants.cgi',-method => 'post'),
                $cgi->hidden(-name => 'user', -value=>$user),
	        &HTML::make_table($col_hdrs,$tab,"Existing Patterns and Variant Codes"),
	        $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1),
	        $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
	        $cgi->hr,
                $cgi->submit(-name => "set_variants", -value => "Set Variants")
	 );
}
	    

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

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

    my $n = 1;
    &format_existing_roles($fig,$cgi,$html,$subsystem,$tab,\$n,$abbrevP);
    push(@$html,&HTML::make_table($col_hdrs,$tab,"Functional Roles"),
	        $cgi->hr
	 );
    return $abbrevP;
}

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

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

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

    my $i = $subsystem->get_role_index($role);
    $abbrev = $role ? $subsystem->get_role_abbr($i) : "";
    $abbrevP->{$role} = $abbrev;
    push(@$tab,[$$nP,$abbrev,$role]);
}


sub ok_variant {
    my($variant) = @_;

    return 1; # (defined($variant) && ($variant ne "-1"));
}

sub set_variants {
    my($cgi,$fig,$html,$subsys) = @_;
    my $param;

    my $sub           = $fig->get_subsystem($subsys);
    my @genomes       = $sub->get_genomes;
    
    my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
    my @roles         = $sub->get_roles;

    my $abbrev = &format_roles($fig,$cgi,[],$sub);

    my(@has,$role,%genomes_with,$genome,$pattern,$x,$vc);
    foreach $genome (@genomes)
    {
	my $vc = $variant_codes{$genome};
	next if (! &ok_variant($vc));

	@has = ();
	foreach $role (@roles)
	{
	    push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
	}
	$pattern = join(",",@has);
	push(@{$genomes_with{"$pattern,$vc"}}, $genome);
    }

    my @params = grep { $_ =~ /^p:/ } $cgi->param;
    foreach $param (@params)
    {
	if ($param =~ /^p:(.*):(.*)$/)
	{
	    ($pattern,$vc) = ($1,$2);
	    $pattern =~ s/ //g;
	    $vc      =~ s/ //g;
	    my $to = $cgi->param($param);
	    if ($x = $genomes_with{"$pattern,$vc"})
	    {
		push(@$html,"<ul>\n");
		foreach $genome (@$x)
		{
		    if ($to ne $variant_codes{$genome})
		    {
			my $old = $variant_codes{$genome};
			my $gs = $fig->genus_species($genome);
			push(@$html,"<li>resetting $genome $gs from $old to $to\n");
			$sub->set_variant_code($sub->get_genome_index($genome),$to);
		    }
		}
		push(@$html,"</ul>");
	    }
	}
    }
    $sub->write_subsystem();
    push(@$html,$cgi->hr);

    &show_variants($cgi,$fig,$html,$subsys);
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3