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

Annotation of /FigWebServices/samples.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

1 : overbeek 1.1 ########################################################################
2 :     use CGI;
3 :    
4 :    
5 :     if (-f "$FIG_Config::data/Global/why_down")
6 :     {
7 :     local $/;
8 :     open my $fh, "<$FIG_Config::data/Global/why_down";
9 :     my $down_msg = <$fh>;
10 :    
11 :     print CGI::header();
12 :     print CGI::head(CGI::title("SEED Server down"));
13 :     print CGI::start_body();
14 :     print CGI::h1("SEED Server down");
15 :     print CGI::p("The seed server is not currently running:");
16 :     print CGI::pre($down_msg);
17 :     print CGI::end_body();
18 :     exit;
19 :     }
20 :    
21 :     if ($FIG_Config::readonly)
22 :     {
23 :     CGI::param("user", undef);
24 :     }
25 :     ########################################################################
26 : overbeek 1.4 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 : overbeek 1.1 # -*- perl -*-
51 :     #
52 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
53 :     # for Interpretations of Genomes. All Rights Reserved.
54 :     #
55 :     # This file is part of the SEED Toolkit.
56 :     #
57 :     # The SEED Toolkit is free software. You can redistribute
58 :     # it and/or modify it under the terms of the SEED Toolkit
59 :     # Public License.
60 :     #
61 :     # You should have received a copy of the SEED Toolkit Public License
62 :     # along with this program; if not write to the University of Chicago
63 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
64 :     # Genomes at veronika@thefig.info or download a copy from
65 :     # http://www.theseed.org/LICENSE.TXT.
66 :     #
67 :    
68 :     use URI::Escape; # uri_escape
69 :     use FIG;
70 :     my $fig = new FIG;
71 :    
72 :     use HTML;
73 :     use strict;
74 :    
75 :     use CGI;
76 :     my $cgi = new CGI;
77 :     if (0)
78 :     {
79 :     my $VAR1;
80 :     eval(join("",`cat /tmp/samples`));
81 :     $cgi = $VAR1;
82 :     # print STDERR &Dumper($cgi);
83 :     }
84 :    
85 :     if (0)
86 :     {
87 :     print $cgi->header;
88 :     my @params = $cgi->param;
89 :     print "<pre>\n";
90 :     foreach $_ (@params)
91 :     {
92 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
93 :     }
94 :    
95 :     if (0)
96 :     {
97 :     if (open(TMP,">/tmp/samples"))
98 :     {
99 :     print TMP &Dumper($cgi);
100 :     close(TMP);
101 :     }
102 :     }
103 :     exit;
104 :     }
105 :     my $html = [];
106 :     my $genome = $cgi->param('genome');
107 : overbeek 1.5 my @samples = $cgi->param('sample');
108 :     my $sample1 = (@samples > 0) ? $samples[0] : $cgi->param('sample1');
109 :     my $sample2 = (@samples > 1) ? $samples[1] : $cgi->param('sample2');
110 : overbeek 1.1 my $tablesD = "/homes/overbeek/Ross/JoseERmodel/CGI/Organisms/224308.113/Tables";
111 :    
112 :     if ($genome && (! $sample1) && (! $sample2))
113 :     {
114 :     my @samples = `cat $tablesD/Sample.entity`;
115 :     chop @samples;
116 :    
117 :     push(@$html,$cgi->start_form(-action => 'samples.cgi', -target => '_blank'),
118 :     $cgi->textfield( -name => "sample1", -size => 100 ),"<br>",
119 :     $cgi->textfield( -name => "sample2", -size => 100 ),"<br>",
120 :     $cgi->hidden(-name => 'genome', -value => $genome),
121 :     $cgi->submit('compare samples'),"<br>",
122 :     $cgi->end_form);
123 :     }
124 : overbeek 1.3 elsif ((! $genome) || (! $sample1))
125 : overbeek 1.1 {
126 : overbeek 1.3 push(@$html,"<h3>Invalid parameters: 'genome' and 'sample1' must both be set</h3>");
127 : overbeek 1.1 }
128 : overbeek 1.3 elsif ($genome && $sample1 && $sample2)
129 : overbeek 1.1 {
130 :     push(@$html,"<h1>Comparing $sample1 and $sample2 in genome $genome</h1>");
131 : overbeek 1.3 &show2($fig,$cgi,$html,$genome,$tablesD,$sample1,$sample2);
132 :     }
133 :     elsif ($genome && $sample1)
134 :     {
135 :     push(@$html,"<h1>Atomic Regulons in $sample1</h1>");
136 :     &show1($fig,$cgi,$html,$genome,$tablesD,$sample1);
137 : overbeek 1.1 }
138 :    
139 :     &HTML::show_page($cgi,$html);
140 :     exit;
141 :    
142 : overbeek 1.3 sub show1 {
143 :     my($fig,$cgi,$html,$genome,$tablesD,$sample1) = @_;
144 :    
145 :     my $parms = {};
146 :     $parms->{genome} = $genome;
147 :     $parms->{tables} = $tablesD;
148 :    
149 :     &load_parms($parms);
150 :     push(@$html,&show_atomic_regulons($sample1,$parms));
151 :     }
152 :    
153 :     sub show_atomic_regulons {
154 :     my($sample1,$parms) = @_;
155 :    
156 : overbeek 1.4 my @html = ();
157 :     push(@html,&study($parms,$sample1),"<hr><br>");
158 :    
159 : overbeek 1.3 my $atomic_regulonsH = $parms->{sample2ar}->{$sample1};
160 :     my @atomic_regulons = keys(%$atomic_regulonsH);
161 :     my $col_hdrs = ['Atomic Regulon','AR-Name','PEG','PEG-ON-OFF','Function'];
162 :     my @rows;
163 :     foreach my $ar (sort { $a <=> $b } @atomic_regulons)
164 :     {
165 :     if ($atomic_regulonsH->{$ar} == 1)
166 :     {
167 :     my $ar_name = $parms->{ar_names}->{$ar} || '';
168 :     my $pegs = $parms->{ar2pegs}->{$ar};
169 :     foreach my $peg (sort { &SeedUtils::by_fig_id($a,$b) } @$pegs)
170 :     {
171 :     my $func = $parms->{peg2func}->{$peg} || '';
172 :     my $peg_on_off = $parms->{peg2sample}->{$peg}->{$sample1};
173 :     push(@rows,[&atomic_regulon_links($parms,[$ar]),
174 :     $ar_name,
175 :     &peg_link($peg),
176 :     $peg_on_off,
177 :     $func]);
178 :     }
179 :     }
180 :     }
181 : overbeek 1.4 push(@html,&HTML::make_table($col_hdrs,\@rows,"Atomic Regulons in $sample1"));
182 :     return @html;
183 : overbeek 1.3 }
184 :    
185 :     sub show2 {
186 : overbeek 1.1 my($fig,$cgi,$html,$genome,$tablesD,$sample1,$sample2) = @_;
187 :    
188 :     my $parms = {};
189 :     $parms->{genome} = $genome;
190 :     $parms->{tables} = $tablesD;
191 :    
192 :     &load_parms($parms);
193 : overbeek 1.4 push(@$html,&study($parms,$sample1));
194 :     push(@$html,&study($parms,$sample2),"<hr><br>");
195 :    
196 : overbeek 1.1 push(@$html,&comp_table($sample1,$sample2,$parms));
197 :     }
198 :    
199 : overbeek 1.4 sub study {
200 :     my($parms,$sample) = @_;
201 :    
202 :     my @html;
203 :     my $study = $parms->{sample2study}->{$sample};
204 :     my $tuple = $parms->{study}->{$study};
205 :     my($desc,$explanation) = @$tuple;
206 :     push(@html,"<h2>Study $study: $sample</h2>\n");
207 :     push(@html,"<h3>Description</h3>$desc<br>");
208 :     push(@html,"<h3>Explanation</h3>$explanation<br>");
209 :     return @html;
210 :     }
211 :    
212 : overbeek 1.1 sub comp_table {
213 :     my($sample1,$sample2,$parms) = @_;
214 :    
215 :     my @pegs = keys(%{$parms->{peg2func}});
216 :     my $sample1H = $parms->{sample2peg}->{$sample1};
217 :    
218 :     my $sample2H = $parms->{sample2peg}->{$sample2};
219 :     my $genome = $parms->{genome};
220 :     my $peg_to_stimulii = $parms->{peg2stimulii_links};
221 : overbeek 1.5 my $col_hdrs = ['PEG','Stimulii','Atomic Regulon','AR-desc','Sample1','Sample2','Function'];
222 : overbeek 1.1 my @rows;
223 :     foreach my $peg (@pegs)
224 :     {
225 :     my $v1 = $sample1H->{$peg};
226 :     my $v2 = $sample2H->{$peg};
227 :     if (abs($v1-$v2) == 2)
228 :     {
229 :     my $stims = &stim_links($parms,$peg);
230 :     my $func = $parms->{peg2func}->{$peg};
231 :     my $ars = $parms->{peg2ars}->{$peg};
232 : overbeek 1.5 my $ar_desc = defined($ars->[0]) ? $parms->{ar_names}->{$ars->[0]} : '';
233 :     push(@rows,[$peg,$stims,$ars,$ar_desc,$v1,$v2,$func]);
234 : overbeek 1.1 }
235 :     }
236 : overbeek 1.5 @rows = sort { ($a->[4] <=> $b->[4]) or ($a->[2]->[0] cmp $b->[2]->[0]) } @rows;
237 : overbeek 1.1 foreach my $row (@rows)
238 :     {
239 :     $row->[0] = &peg_link($row->[0]);
240 :     $row->[2] = &atomic_regulon_links($parms,$row->[2]);
241 :     }
242 : overbeek 1.5 return &HTML::make_table($col_hdrs,\@rows,"PEGs That Shift Between $sample1 and $sample2");
243 : overbeek 1.1 }
244 :    
245 :     sub load_parms {
246 :     my($parms) = @_;
247 :    
248 :     my %funcH = map { ($_ =~ /^(fig\S+)\t(\S.*\S)/) ? ($1 => $2) : () } `echo $genome | svr_all_features peg | svr_function_of`;
249 :     $parms->{peg2func} = \%funcH;
250 :    
251 :     my %peg2ar;
252 :     my %ar2peg;
253 :     foreach $_ (`cat $tablesD/PegToAr`)
254 :     {
255 :     if ($_ =~ /^(\d+)\t(\S+)/)
256 :     {
257 :     push(@{$peg2ar{$2}},$1);
258 :     push(@{$ar2peg{$1}},$2);
259 :     }
260 :     }
261 :     $parms->{peg2ars} = \%peg2ar;
262 :     $parms->{ar2pegs} = \%ar2peg;
263 :    
264 :     my %stim2readable = map { ($_ =~ /^(\S+)\t(\S+)/) ? ($1 => $2) : () } `cat $tablesD/Stimulus.entity`;
265 :     $parms->{stim2readable} = \%stim2readable;
266 :    
267 :     my %peg_linkH = map { ($_ =~ /^(\S+)\t(\S+)\t(\S+)/) ? ($1 => join(",",(&peg_link($1),$2,$3))) : &peg_link($1) }
268 :     `cat $tablesD/aliases`;
269 :     $parms->{peg2link} = \%peg_linkH;
270 :     &peg_to_stimulii_links($parms);
271 :    
272 :     my %sample2peg;
273 :     my %peg2sample;
274 :     foreach $_ (`cat $tablesD/peg.on.off.calls`)
275 :     {
276 :     if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
277 :     {
278 :     $sample2peg{$1}->{$2} = $3;
279 :     $peg2sample{$2}->{$1} = $3;
280 :     }
281 :     }
282 :     $parms->{sample2peg} = \%sample2peg;
283 :     $parms->{peg2sample} = \%peg2sample;
284 : overbeek 1.3
285 :     my $sample2ar = {};
286 :     my $ar2sample = {};
287 :     foreach $_ (`cat $tablesD/atomic.regulon.on.off.calls`)
288 :     {
289 :     if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
290 :     {
291 :     $sample2ar->{$1}->{$2} = $3;
292 :     $ar2sample->{$2}->{$1} = $3;
293 :     }
294 :     }
295 :     $parms->{sample2ar} = $sample2ar;
296 :     $parms->{ar2sample} = $ar2sample;
297 :    
298 :     my %ar_names = map { ($_ =~ /^(\d+)\t(\S.*\S)/) ? ($1 => $2) : () } `cat $tablesD/AR.entity`;
299 :     $parms->{ar_names} = \%ar_names;
300 : overbeek 1.4
301 :     my %exp_cond2study;
302 :     my %study2exp_conds;
303 :     foreach $_ (`cat $tablesD/Study-ExpCond`)
304 :     {
305 :     if ($_ =~ /^(\S+)\t(\S+)/)
306 :     {
307 :     my($study,$exp_cond) = ($1,$2);
308 :     $exp_cond2study{$2} = $1;
309 :     push(@{$study2exp_conds{$study}},$exp_cond);
310 :     }
311 :     }
312 :     $parms->{exp_cond2study} = \%exp_cond2study;
313 :     $parms->{study2exp_conds} = \%study2exp_conds;
314 :    
315 :     my %sample2study;
316 :     my %study2samples;
317 :     foreach $_ (`cat $tablesD/ExpCond-Sample`)
318 :     {
319 :     if ($_ =~ /(\S+)\t(\S+)/)
320 :     {
321 :     my($exp_cond,$sample) = ($1,$2);
322 :     if (my $study = $exp_cond2study{$exp_cond})
323 :     {
324 :     push(@{$study2samples{$study}},$sample);
325 :     $sample2study{$sample} = $study;
326 :     }
327 :     }
328 :     }
329 :     $parms->{sample2study} = \%sample2study;
330 :     $parms->{study2samples} = \%study2samples;
331 :    
332 :     my %study;
333 :     foreach $_ (`cat $tablesD/Study.entity`)
334 :     {
335 :     chomp;
336 :     my($study,$desc,$explanation) = split(/\t/,$_);
337 :     $study{$study} = [$desc,$explanation];
338 :     }
339 :     $parms->{study} = \%study;
340 : overbeek 1.1 }
341 :    
342 : overbeek 1.4
343 : overbeek 1.1 sub peg_link {
344 :     my($peg) = @_;
345 :     my $g = &SeedUtils::genome_of($peg);
346 : overbeek 1.2 return "<a target=_blank href=peg.cgi?genome=$g&peg=$peg>$peg</a>";
347 : overbeek 1.1 }
348 :    
349 :     sub stim_link {
350 :     my($stim,$stimReal,$genome) = @_;
351 :    
352 : overbeek 1.2 return "<a target=_blank href=stimulus.cgi?stimulus=$stim&genome=$genome>$stimReal</a>";
353 : overbeek 1.1 }
354 :    
355 :     sub stim_links {
356 :     my($parms,$peg) = @_;
357 :    
358 :     my $stims = $parms->{peg2stimulii_links}->{$peg};
359 :     my $stim_links = "";
360 :     if ($stims)
361 :     {
362 :     $stim_links = join(",",@$stims);
363 :     }
364 :     return $stim_links;
365 :     }
366 :    
367 :    
368 :     sub atomic_regulon_link {
369 :     my($atomic_regulon,$genome) = @_;
370 :    
371 : overbeek 1.2 return "<a target=_blank href=atomic_regulon.cgi?atomic_regulon=$atomic_regulon&genome=$genome>$atomic_regulon</a>";
372 : overbeek 1.1 }
373 :    
374 :     sub atomic_regulon_links {
375 :     my($parms,$ars) = @_;
376 :    
377 :     if ((!$ars) || (@$ars == 0)) { return '' }
378 :     my $genome = $parms->{genome};
379 :     return join(",",map { &atomic_regulon_link($_,$genome) } @$ars);
380 :     }
381 :    
382 :     sub peg_to_stimulii_links {
383 :     my($parms) = @_;
384 :    
385 :     my $peg_to_stimulii = {};
386 :    
387 :     my %stimH = map { ($_ =~ /^(\S+)\t(\S+)/) ? ($1 => &stim_link($1,$2,$genome)) : () } `cat $tablesD/Stimulus.entity`;
388 :     foreach $_ (`cat $tablesD/PegToStim`)
389 :     {
390 :     $_ =~ /^(\S+)\t(\S+)/;
391 :     push(@{$peg_to_stimulii->{$1}},$stimH{$2});
392 :     }
393 :     $parms->{peg2stimulii_links} = $peg_to_stimulii;
394 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3