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

Diff of /FigWebServices/samples.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3, Sat Nov 30 03:05:28 2013 UTC revision 1.4, Sun Dec 1 14:34:47 2013 UTC
# Line 23  Line 23 
23      CGI::param("user", undef);      CGI::param("user", undef);
24  }  }
25  ########################################################################  ########################################################################
26    use CGI;
27    
28    
29    if (-f "$FIG_Config::data/Global/why_down")
30    {
31        local $/;
32        open my $fh, "<$FIG_Config::data/Global/why_down";
33        my $down_msg = <$fh>;
34    
35        print CGI::header();
36        print CGI::head(CGI::title("SEED Server down"));
37        print CGI::start_body();
38        print CGI::h1("SEED Server down");
39        print CGI::p("The seed server is not currently running:");
40        print CGI::pre($down_msg);
41        print CGI::end_body();
42        exit;
43    }
44    
45    if ($FIG_Config::readonly)
46    {
47        CGI::param("user", undef);
48    }
49    ########################################################################
50  # -*- perl -*-  # -*- perl -*-
51  #  #
52  # Copyright (c) 2003-2006 University of Chicago and Fellowship  # Copyright (c) 2003-2006 University of Chicago and Fellowship
# Line 128  Line 152 
152  sub show_atomic_regulons {  sub show_atomic_regulons {
153      my($sample1,$parms) = @_;      my($sample1,$parms) = @_;
154    
155        my @html = ();
156        push(@html,&study($parms,$sample1),"<hr><br>");
157    
158      my $atomic_regulonsH = $parms->{sample2ar}->{$sample1};      my $atomic_regulonsH = $parms->{sample2ar}->{$sample1};
159      my @atomic_regulons  = keys(%$atomic_regulonsH);      my @atomic_regulons  = keys(%$atomic_regulonsH);
160      my $col_hdrs = ['Atomic Regulon','AR-Name','PEG','PEG-ON-OFF','Function'];      my $col_hdrs = ['Atomic Regulon','AR-Name','PEG','PEG-ON-OFF','Function'];
# Line 150  Line 177 
177              }              }
178          }          }
179      }      }
180      return &HTML::make_table($col_hdrs,\@rows,"Atomic Regulons in $sample1");      push(@html,&HTML::make_table($col_hdrs,\@rows,"Atomic Regulons in $sample1"));
181        return @html;
182  }  }
183    
184  sub show2 {  sub show2 {
# Line 161  Line 189 
189      $parms->{tables}  = $tablesD;      $parms->{tables}  = $tablesD;
190    
191      &load_parms($parms);      &load_parms($parms);
192        push(@$html,&study($parms,$sample1));
193        push(@$html,&study($parms,$sample2),"<hr><br>");
194    
195      push(@$html,&comp_table($sample1,$sample2,$parms));      push(@$html,&comp_table($sample1,$sample2,$parms));
196  }  }
197    
198    sub study {
199        my($parms,$sample) = @_;
200    
201        my @html;
202        my $study = $parms->{sample2study}->{$sample};
203        my $tuple = $parms->{study}->{$study};
204        my($desc,$explanation) = @$tuple;
205        push(@html,"<h2>Study $study: $sample</h2>\n");
206        push(@html,"<h3>Description</h3>$desc<br>");
207        push(@html,"<h3>Explanation</h3>$explanation<br>");
208        return @html;
209    }
210    
211  sub comp_table {  sub comp_table {
212      my($sample1,$sample2,$parms) = @_;      my($sample1,$sample2,$parms) = @_;
213    
# Line 251  Line 295 
295    
296      my %ar_names = map { ($_ =~ /^(\d+)\t(\S.*\S)/) ? ($1 => $2) : () } `cat $tablesD/AR.entity`;      my %ar_names = map { ($_ =~ /^(\d+)\t(\S.*\S)/) ? ($1 => $2) : () } `cat $tablesD/AR.entity`;
297      $parms->{ar_names} = \%ar_names;      $parms->{ar_names} = \%ar_names;
298    
299        my %exp_cond2study;
300        my %study2exp_conds;
301        foreach $_ (`cat $tablesD/Study-ExpCond`)
302        {
303            if ($_ =~ /^(\S+)\t(\S+)/)
304            {
305                my($study,$exp_cond) = ($1,$2);
306                $exp_cond2study{$2} = $1;
307                push(@{$study2exp_conds{$study}},$exp_cond);
308            }
309        }
310        $parms->{exp_cond2study}  = \%exp_cond2study;
311        $parms->{study2exp_conds} = \%study2exp_conds;
312    
313        my %sample2study;
314        my %study2samples;
315        foreach $_ (`cat $tablesD/ExpCond-Sample`)
316        {
317            if ($_ =~ /(\S+)\t(\S+)/)
318            {
319                my($exp_cond,$sample) = ($1,$2);
320                if (my $study = $exp_cond2study{$exp_cond})
321                {
322                    push(@{$study2samples{$study}},$sample);
323                    $sample2study{$sample} = $study;
324                }
325            }
326        }
327        $parms->{sample2study}  = \%sample2study;
328        $parms->{study2samples} = \%study2samples;
329    
330        my %study;
331        foreach $_ (`cat $tablesD/Study.entity`)
332        {
333            chomp;
334            my($study,$desc,$explanation) = split(/\t/,$_);
335            $study{$study} = [$desc,$explanation];
336  }  }
337        $parms->{study} = \%study;
338    }
339    
340    
341  sub peg_link {  sub peg_link {
342      my($peg) = @_;      my($peg) = @_;

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3