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

View of /FigWebServices/study.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (download) (annotate)
Mon Dec 2 17:06:31 2013 UTC (5 years, 11 months ago) by overbeek
Branch: MAIN
CVS Tags: rast_rel_2014_0729, rast_rel_2014_0912, HEAD
progress

########################################################################
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 /homes/overbeek/Ross/JoseERmodel/CGI/tmp.study`));
    $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,">/homes/overbeek/Ross/JoseERmodel/CGI/tmp.study"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}
my $html     = [];
my $genome   = $cgi->param('genome');
my $study     = $cgi->param('study');
my $tablesD  = "/homes/overbeek/Ross/JoseERmodel/CGI/Organisms/224308.113/Tables";

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

&load_parms($parms);
if ($genome && (! $study))
{
    &show_all($fig,$cgi,$html,$genome,$tablesD,$parms);
}
elsif ($genome && $study)
{
    push(@$html,"<h1>Samples in Study $study</h1>");
    &show1($fig,$cgi,$html,$genome,$tablesD,$parms,$study);
}

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

sub show1 {
    my($fig,$cgi,$html,$genome,$tablesD,$parms,$study) = @_;
    push(@$html,$cgi->start_form(-method => 'get', -action => 'samples.cgi', -target => '_blank'));
    push(@$html,&show_study($study,$cgi,$html,$parms),
	        $cgi->hidden(-name => 'genome',-value => $genome),
	        $cgi->submit('Pick 1 or 2 Samples'),
	        $cgi->end_form());
}

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


    push(@$html,$cgi->start_form(-method => 'get', -action => 'samples.cgi', -target => '_blank'));
    my @studies = keys(%{$parms->{study2samples}});
    foreach my $study (sort @studies)
    {
	&show_study($study,$cgi,$html,$parms);
    }
    push(@$html, $cgi->hidden(-name => 'genome',-value => $genome),
	         $cgi->submit('Pick 1 or 2 Samples'),
	         $cgi->end_form());
}

sub show_study {
    my($study,$cgi,$html,$parms) = @_;
    my $samples = $parms->{study2samples}->{$study};
    my $tuple = $parms->{study}->{$study};
    my($desc,$explanation) = @$tuple;
    push(@$html,"<h2>Study: $study</h2>\n");
    push(@$html,"<h3>Description</h3>$desc<br>\n");
    push(@$html,"<h3>Explanation</h3>$explanation<br><br>\n");
    my $samples = $parms->{study2samples}->{$study};
    foreach my $sample (@$samples)
    {
	push(@$html,$cgi->checkbox(-label => $sample, -name => 'sample', -value => $sample),
	            "<br>\n");
    }
    push(@$html,"<br><hr><br>\n");
}

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 %sample2peg;
    my %peg2sample;
    foreach $_ (`cat $tablesD/peg.on.off.calls`)
    {
	if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
	{
	    $sample2peg{$1}->{$2} = $3;
	    $peg2sample{$2}->{$1} = $3;
	}
    }
    $parms->{sample2peg} = \%sample2peg;
    $parms->{peg2sample} = \%peg2sample;

    my $sample2ar = {};
    my $ar2sample = {};
    foreach $_ (`cat $tablesD/atomic.regulon.on.off.calls`)
    {
	if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
	{
	    $sample2ar->{$1}->{$2} = $3;
	    $ar2sample->{$2}->{$1} = $3;
	}
    }
    $parms->{sample2ar} = $sample2ar;
    $parms->{ar2sample} = $ar2sample;

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

    my %exp_cond2study;
    my %study2exp_conds;
    foreach $_ (`cat $tablesD/Study-ExpCond`)
    {
	if ($_ =~ /^(\S+)\t(\S+)/)
	{
	    my($study,$exp_cond) = ($1,$2);
	    $exp_cond2study{$2} = $1;
	    push(@{$study2exp_conds{$study}},$exp_cond);
	}
    }
    $parms->{exp_cond2study}  = \%exp_cond2study;
    $parms->{study2exp_conds} = \%study2exp_conds;

    my %sample2study;
    my %study2samples;
    foreach $_ (`cat $tablesD/ExpCond-Sample`)
    {
	if ($_ =~ /(\S+)\t(\S+)/)
	{
	    my($exp_cond,$sample) = ($1,$2);
	    if (my $study = $exp_cond2study{$exp_cond})
	    {
		push(@{$study2samples{$study}},$sample);
		$sample2study{$sample} = $study;
	    }
	}
    }
    $parms->{sample2study}  = \%sample2study;
    $parms->{study2samples} = \%study2samples;

    my %study;
    foreach $_ (`cat $tablesD/Study.entity`)
    {
	chomp;
	my($study,$desc,$explanation) = split(/\t/,$_);
	$study{$study} = [$desc,$explanation];
    }
    $parms->{study} = \%study;
    my %exp_cond2study;
    my %study2exp_conds;
    foreach $_ (`cat $tablesD/Study-ExpCond`)
    {
	if ($_ =~ /^(\S+)\t(\S+)/)
	{
	    my($study,$exp_cond) = ($1,$2);
	    $exp_cond2study{$2} = $1;
	    push(@{$study2exp_conds{$study}},$exp_cond);
	}
    }
    $parms->{exp_cond2study}  = \%exp_cond2study;
    $parms->{study2exp_conds} = \%study2exp_conds;

    my %sample2study;
    my %study2samples;
    foreach $_ (`cat $tablesD/ExpCond-Sample`)
    {
	if ($_ =~ /(\S+)\t(\S+)/)
	{
	    my($exp_cond,$sample) = ($1,$2);
	    if (my $study = $exp_cond2study{$exp_cond})
	    {
		push(@{$study2samples{$study}},$sample);
		$sample2study{$sample} = $study;
	    }
	}
    }
    $parms->{sample2study}  = \%sample2study;
    $parms->{study2samples} = \%study2samples;

    my %study;
    foreach $_ (`cat $tablesD/Study.entity`)
    {
	chomp;
	my($study,$desc,$explanation) = split(/\t/,$_);
	$study{$study} = [$desc,$explanation];
    }
    $parms->{study} = \%study;
}

sub sample_link {
    my($parms,$sample) = @_;

    my $genome = $parms->{genome};
    return "<a href=sample.cgi?genome=$genome&sample1=$sample>$sample</a>";
}

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 stim_links {
    my($parms,$peg) = @_;

    my $stims = $parms->{peg2stimulii_links}->{$peg};
    my $stim_links = "";
    if ($stims)
    {
	$stim_links = join(",",@$stims);
    }
    return $stim_links;
}


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 atomic_regulon_links {
    my($parms,$ars) = @_;

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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3