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

View of /FigWebServices/peg.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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.4: +32 -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/peg`));
    $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/peg"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}
my $html = [];
my $genome    = $cgi->param('genome');
my $peg  = $cgi->param('peg');
my $tablesD = "/homes/overbeek/Ross/JoseERmodel/CGI/Organisms/224308.113/Tables";

if ($genome && $peg)
{
    push(@$html,"<h1>peg: $peg</h1>");
    &show($fig,$cgi,$html,$genome,$tablesD,$peg);
}
else
{
    push(@$html,"<h3>Invalid parameters: set both 'genome' and 'peg'</h3>");
}

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

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

    my $parms = {};
    $parms->{genome}  = $genome;
    $parms->{tables}  = $tablesD;
    &load_parms($parms);

    push(@$html,&info($parms,$peg));
    push(@$html,&pccs($parms,$peg));
    return;
}

sub info {
    my($parms,$peg) = @_;

    my @html;
    my $ar_links = &ar_links($parms,$parms->{peg2ars}->{$peg});
    push(@html,"Atomic Regulons: $ar_links<br>\n");
    my $stim_links = &peg_stim_links($parms,$peg);
    push(@html,"Stimulii: $stim_links<br>\n");
    my $func = $parms->{peg2func}->{$peg};
    push(@html,"Function: $func<br>\n");
    push(@$html,"PubSEED: ",&pubseed_link($peg),"<br>");
    return @html;
}

sub pccs {
    my($parms,$peg) = @_;

    my $relevant = $parms->{peg2pcc}->{$peg};
    if ($relevant)
    {
	my @sorted = sort { abs($b->[0]) <=> abs($a->[0]) } @$relevant;
	my $col_hdrs = ['pcc','peg','atomic regulon','Desc','stimulii','function2'];
	my $rows = [];
	foreach my $tuple (@sorted)
	{
	    my($pcc,$peg2)  = @$tuple;
	    my $ars         = $parms->{peg2ars}->{$peg2} || '';
	    my $desc        = $ars ? $parms->{ar_names}->{$ars->[0]} : '';
	    my $ar_links2   = &ar_links($parms,$ars);
	    my $stim_links2 = &peg_stim_links($parms,$peg2);
	    my $func2       = $parms->{peg2func}->{$peg2};
	    push(@$rows,[$pcc,$peg2,$ar_links2,$desc,$stim_links2,$func2]);
	}
	return &HTML::make_table($col_hdrs,$rows,"Pegs with Correlated Expression");
    }
    else
    {
	return ();
    }
}

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 %stim2ar;
    my %ar2stim;
    foreach $_ (`cat $tablesD/ArToStim`)
    {
	if ($_ =~ /^(\d+)\t(\S+)/)
	{
	    push(@{$stim2ar{$2}},$1);
	    push(@{$ar2stim{$1}},$2);
	}
    }
    $parms->{stim2ars} = \%stim2ar;
    $parms->{ar2stims} = \%ar2stim;

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

    my $peg_linkH = {};
    my $gene2peg  = {};
    my $locus2peg = {};
    foreach $_ (`cat $tablesD/aliases`)
    {
	if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
	{
	    $peg_linkH->{$1} = join(",",(&peg_link($1),$2,$3));
	    $gene2peg->{$2}  = $1;
	    $locus2peg->{$3} = $1;
	}
    }
    $parms->{peg2link}  = $peg_linkH;
    $parms->{gene2peg}  = $gene2peg;
    $parms->{locus2peg} = $locus2peg;

    &peg_to_stimulii_links($parms);
    &close_pccs($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 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 stim_link {
    my($stim,$stimReal,$genome) = @_;
    
    return "<a Target=_blank href=stimulus.cgi?stimulus=$stim&genome=$genome>$stimReal</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 peg_stim_links {
    my($parms,$peg) = @_;

    my $links = $parms->{peg2stimulii_links}->{$peg};
    return $links ? join(",",@$links) : '';
}

sub ar_links {
    my($parms,$ars) = @_;
    if (! $ars) { return '' }
    my $links = join(",",map { &atomic_regulon_link($_,$parms->{genome}) } @$ars);
    return $links;
}

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

    my $peg2pcc = {};
    my $file    = $parms->{tables} . "/locus.pccs";
    open(PCC,"<$file") || die "could not open $file";
    my $locus2peg = $parms->{locus2peg};
    while (defined($_ = <PCC>))
    {
	if (($_ =~ /^(\S+)\t(\S+)\t(\S+)/) && (abs($3) >= 0.6))
	{
	    my $peg1 = $locus2peg->{$1};
	    if ($peg1)
	    {
		my $peg2 = $locus2peg->{$2};
		if ($peg2)
		{
		    push(@{$peg2pcc->{$peg1}},[$3,$peg2]);
		    push(@{$peg2pcc->{$peg2}},[$3,$peg1]);
		}
	    }
	}
    }
    close(PCC);
    $parms->{peg2pcc} = $peg2pcc;
}

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