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

View of /FigWebServices/set_variants.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (download) (annotate)
Fri May 3 17:20:50 2013 UTC (6 years, 6 months ago) by redwards
Branch: MAIN
CVS Tags: rast_rel_2014_0912, rast_rel_2014_0729, HEAD
Changes since 1.5: +9 -3 lines
adding a limitation to the set variants page

# -*- 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,1,undef,undef,["http://edwards.sdsu.edu/FIG/Html/css/set_variants.js"]);

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->p("The current username is: ", $cgi->textfield(-name => 'user', -value=>$user)),
		 $cgi->p("Please enter some text to limit this list of subsystems: ",
		 $cgi->textfield(-name => 'startswith', -id=>'startswith', -size=>20, -onChange=>'selector();'),
		 $cgi->button({-name => 'Limit list', -onClick=>'selector();'}, "Change the list"),
		 ),
		 $cgi->div({-id => "subsystem_selection"},
	         $cgi->scrolling_list( -name   => 'subsystem', -id=>'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