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

View of /FigWebServices/atomic_regulon.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (download) (annotate)
Sun Dec 1 14:34:47 2013 UTC (6 years, 1 month ago) by overbeek
Branch: MAIN
CVS Tags: rast_rel_2014_0729, rast_rel_2014_0912, HEAD
Changes since 1.3: +36 -3 lines
add ar-names

########################################################################
use CGI;


if (-f "$FIG_Config::data/Global/why_down")
{
    local $/;
    open my $fh, "<$FIG_Config::data/Global/why_down";
    my $down_msg = <$fh>;
    
    print CGI::header();
    print CGI::head(CGI::title("SEED Server down"));
    print CGI::start_body();
    print CGI::h1("SEED Server down");
    print CGI::p("The seed server is not currently running:");
    print CGI::pre($down_msg);
    print CGI::end_body();
    exit;
}

if ($FIG_Config::readonly)
{
    CGI::param("user", undef);
}
########################################################################
use CGI;


if (-f "$FIG_Config::data/Global/why_down")
{
    local $/;
    open my $fh, "<$FIG_Config::data/Global/why_down";
    my $down_msg = <$fh>;
    
    print CGI::header();
    print CGI::head(CGI::title("SEED Server down"));
    print CGI::start_body();
    print CGI::h1("SEED Server down");
    print CGI::p("The seed server is not currently running:");
    print CGI::pre($down_msg);
    print CGI::end_body();
    exit;
}

if ($FIG_Config::readonly)
{
    CGI::param("user", undef);
}
########################################################################
# -*- 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 URI::Escape;  # uri_escape
use FIG;
my $fig = new FIG;

use HTML;
use strict;

use CGI;
my $cgi = new CGI;
if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/atomic_regulon`));
    $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/atomic_regulon"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}
my $html = [];
my $genome    = $cgi->param('genome');
my $atomic_regulon  = $cgi->param('atomic_regulon');
my $tablesD = "/homes/overbeek/Ross/JoseERmodel/CGI/Organisms/224308.113/Tables";

if (! $genome)
{
    push(@$html,"<h3>Invalid parameters: 'genome' must be set</h3>");
}
else
{
    if ($atomic_regulon)
    {
	&show1($fig,$cgi,$html,$genome,$tablesD,$atomic_regulon);
    }
    else
    {
	&show_all($fig,$cgi,$html,$genome,$tablesD);
    }
}

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

sub show_all {
    my($fig,$cgi,$html,$genome,$tablesD) = @_;
    my $parms = {};

    &load_parms($parms);

    my $col_hdrs = ['Atomic Regulon', 'Size','Description'];
    my $arH = $parms->{ar2pegs};
    my $ar;
    my @ars = map { $ar = $_;
		    [&atomic_regulon_link($ar,$genome),
		     scalar @{$arH->{$ar}},
	            $parms->{ar_names}->{$ar}] 
                  } keys(%$arH);
    my @rows   = sort {$b->[1] <=> $a->[1] } @ars;
    push(@$html,&HTML::make_table($col_hdrs,\@rows,'Atomic Regulons'));
}

sub show1 {
    my($fig,$cgi,$html,$genome,$tablesD,$atomic_regulon) = @_;

    my $parms = {};
    $parms->{genome} = $genome;
    $parms->{tables}  = $tablesD;

    &load_parms($parms);
    my $ar_name = $parms->{ar_names}->{$atomic_regulon} || 'no description yet';
    push(@$html,"<h1>Atomic_Regulon $atomic_regulon ($ar_name) in genome $genome</h1>");
    push(@$html,&ar_table($atomic_regulon,$parms));
}

sub ar_table {
    my($atomic_regulon,$parms) = @_;
    my @rows;
    
    my $peg_to_stimulii = $parms->{peg2stimulii_links};
    my $pegs = $parms->{ar2pegs}->{$atomic_regulon};
    foreach my $peg (@$pegs)
    {
	my $stims = $peg_to_stimulii->{$peg};
	my $stim_links = "";
        if ($stims)
	{
	    $stim_links = join(",",@$stims);
	}
	my $func = $parms->{peg2func}->{$peg};
	push(@rows,[$parms->{peg2link}->{$peg},
		    &pubseed_link($peg),
		    $stim_links,
		    $func]);
    }
    @rows = sort { &SeedUtils::by_fig_id($a->[1],$b->[1]) or ($a->[2] cmp $b->[2]) } @rows;
    return &HTML::make_table(['PEG','PubSEED','Stimulii','Function'],\@rows,"PEGs in Atomic Regulon $atomic_regulon");
}

sub load_parms {
    my($parms) = @_;

    my %funcH = map { ($_ =~ /^(fig\S+)\t(\S.*\S)/) ? ($1 => $2) : () } `echo $genome | svr_all_features peg | svr_function_of`;
    $parms->{peg2func} = \%funcH;

    my %peg2ar;
    my %ar2peg;
    foreach $_ (`cat $tablesD/PegToAr`)
    {
	if ($_ =~ /^(\d+)\t(\S+)/)
	{
	    push(@{$peg2ar{$2}},$1);
	    push(@{$ar2peg{$1}},$2);
	}
    }
    $parms->{peg2ars} = \%peg2ar;
    $parms->{ar2pegs} = \%ar2peg;

    my %stim2readable = map { ($_ =~ /^(\S+)\t(\S+)/) ? ($1 => $2) : () } `cat $tablesD/Stimulus.entity`;
    $parms->{stim2readable} = \%stim2readable;

    my %peg_linkH = map { ($_ =~ /^(\S+)\t(\S+)\t(\S+)/) ? ($1 => join(",",(&peg_link($1),$2,$3))) : &peg_link($1) } 
		    `cat $tablesD/aliases`;
    $parms->{peg2link} = \%peg_linkH;
    &peg_to_stimulii_links($parms);
    my %ar_names = map { ($_ =~ /^(\d+)\t(\S.*\S)/) ? ($1 => $2) : () } `cat $tablesD/AR.entity`;
    $parms->{ar_names} = \%ar_names;
}

sub peg_link {
    my($peg) = @_;
    my $g = &SeedUtils::genome_of($peg);
    return "<a target=_blank href=peg.cgi?genome=$g&peg=$peg>$peg</a>";
}

sub stim_link {
    my($stim,$stimReal,$genome) = @_;
    
    return "<a target=_blank href=stimulus.cgi?stimulus=$stim&genome=$genome>$stimReal</a>";
}

sub atomic_regulon_link {
    my($atomic_regulon,$genome) = @_;

    return "<a target=_blank href=atomic_regulon.cgi?atomic_regulon=$atomic_regulon&genome=$genome>$atomic_regulon</a>";
}

sub peg_to_stimulii_links {
    my($parms) = @_;

    my $peg_to_stimulii = {};

    my %stimH = map { ($_ =~ /^(\S+)\t(\S+)/) ? ($1 => &stim_link($1,$2,$genome)) : () } `cat $tablesD/Stimulus.entity`;
    foreach $_ (`cat $tablesD/PegToStim`)
    {
	$_ =~ /^(\S+)\t(\S+)/;
	push(@{$peg_to_stimulii->{$1}},$stimH{$2});
    }
    $parms->{peg2stimulii_links} = $peg_to_stimulii;
}

sub pubseed_link {
    my($peg) = @_;

    return "<a Target=_blank href=http://pubseed.theseed.org/seedviewer.cgi?page=Annotation&feature=$peg>$peg</a>";
}

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3