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

Annotation of /FigWebServices/study.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 :     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 -*-
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 /homes/overbeek/Ross/JoseERmodel/CGI/tmp.study`));
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,">/homes/overbeek/Ross/JoseERmodel/CGI/tmp.study"))
98 :     {
99 :     print TMP &Dumper($cgi);
100 :     close(TMP);
101 :     }
102 :     }
103 :     exit;
104 :     }
105 :     my $html = [];
106 :     my $genome = $cgi->param('genome');
107 :     my $study = $cgi->param('study');
108 :     my $tablesD = "/homes/overbeek/Ross/JoseERmodel/CGI/Organisms/224308.113/Tables";
109 :    
110 :     my $parms = {};
111 :     $parms->{genome} = $genome;
112 :     $parms->{tables} = $tablesD;
113 :    
114 :     &load_parms($parms);
115 :     if ($genome && (! $study))
116 :     {
117 :     &show_all($fig,$cgi,$html,$genome,$tablesD,$parms);
118 :     }
119 :     elsif ($genome && $study)
120 :     {
121 :     push(@$html,"<h1>Samples in Study $study</h1>");
122 :     &show1($fig,$cgi,$html,$genome,$tablesD,$parms,$study);
123 :     }
124 :    
125 :     &HTML::show_page($cgi,$html);
126 :     exit;
127 :    
128 :     sub show1 {
129 :     my($fig,$cgi,$html,$genome,$tablesD,$parms,$study) = @_;
130 :     push(@$html,$cgi->start_form(-method => 'get', -action => 'samples.cgi', -target => '_blank'));
131 :     push(@$html,&show_study($study,$cgi,$html,$parms),
132 :     $cgi->hidden(-name => 'genome',-value => $genome),
133 :     $cgi->submit('Pick 1 or 2 Samples'),
134 :     $cgi->end_form());
135 :     }
136 :    
137 :     sub show_all {
138 :     my($fig,$cgi,$html,$genome,$tablesD,$parms) = @_;
139 :    
140 :    
141 :     push(@$html,$cgi->start_form(-method => 'get', -action => 'samples.cgi', -target => '_blank'));
142 :     my @studies = keys(%{$parms->{study2samples}});
143 :     foreach my $study (sort @studies)
144 :     {
145 :     &show_study($study,$cgi,$html,$parms);
146 :     }
147 :     push(@$html, $cgi->hidden(-name => 'genome',-value => $genome),
148 :     $cgi->submit('Pick 1 or 2 Samples'),
149 :     $cgi->end_form());
150 :     }
151 :    
152 :     sub show_study {
153 :     my($study,$cgi,$html,$parms) = @_;
154 :     my $samples = $parms->{study2samples}->{$study};
155 :     my $tuple = $parms->{study}->{$study};
156 :     my($desc,$explanation) = @$tuple;
157 :     push(@$html,"<h2>Study: $study</h2>\n");
158 :     push(@$html,"<h3>Description</h3>$desc<br>\n");
159 :     push(@$html,"<h3>Explanation</h3>$explanation<br><br>\n");
160 :     my $samples = $parms->{study2samples}->{$study};
161 :     foreach my $sample (@$samples)
162 :     {
163 :     push(@$html,$cgi->checkbox(-label => $sample, -name => 'sample', -value => $sample),
164 :     "<br>\n");
165 :     }
166 :     push(@$html,"<br><hr><br>\n");
167 :     }
168 :    
169 :     sub load_parms {
170 :     my($parms) = @_;
171 :    
172 :     my %funcH = map { ($_ =~ /^(fig\S+)\t(\S.*\S)/) ? ($1 => $2) : () } `echo $genome | svr_all_features peg | svr_function_of`;
173 :     $parms->{peg2func} = \%funcH;
174 :    
175 :     my %peg2ar;
176 :     my %ar2peg;
177 :     foreach $_ (`cat $tablesD/PegToAr`)
178 :     {
179 :     if ($_ =~ /^(\d+)\t(\S+)/)
180 :     {
181 :     push(@{$peg2ar{$2}},$1);
182 :     push(@{$ar2peg{$1}},$2);
183 :     }
184 :     }
185 :     $parms->{peg2ars} = \%peg2ar;
186 :     $parms->{ar2pegs} = \%ar2peg;
187 :    
188 :     my %stim2readable = map { ($_ =~ /^(\S+)\t(\S+)/) ? ($1 => $2) : () } `cat $tablesD/Stimulus.entity`;
189 :     $parms->{stim2readable} = \%stim2readable;
190 :    
191 :     my %peg_linkH = map { ($_ =~ /^(\S+)\t(\S+)\t(\S+)/) ? ($1 => join(",",(&peg_link($1),$2,$3))) : &peg_link($1) }
192 :     `cat $tablesD/aliases`;
193 :     $parms->{peg2link} = \%peg_linkH;
194 :     &peg_to_stimulii_links($parms);
195 :    
196 :     my %sample2peg;
197 :     my %peg2sample;
198 :     foreach $_ (`cat $tablesD/peg.on.off.calls`)
199 :     {
200 :     if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
201 :     {
202 :     $sample2peg{$1}->{$2} = $3;
203 :     $peg2sample{$2}->{$1} = $3;
204 :     }
205 :     }
206 :     $parms->{sample2peg} = \%sample2peg;
207 :     $parms->{peg2sample} = \%peg2sample;
208 :    
209 :     my $sample2ar = {};
210 :     my $ar2sample = {};
211 :     foreach $_ (`cat $tablesD/atomic.regulon.on.off.calls`)
212 :     {
213 :     if ($_ =~ /^(\S+)\t(\S+)\t(\S+)/)
214 :     {
215 :     $sample2ar->{$1}->{$2} = $3;
216 :     $ar2sample->{$2}->{$1} = $3;
217 :     }
218 :     }
219 :     $parms->{sample2ar} = $sample2ar;
220 :     $parms->{ar2sample} = $ar2sample;
221 :    
222 :     my %ar_names = map { ($_ =~ /^(\d+)\t(\S.*\S)/) ? ($1 => $2) : () } `cat $tablesD/AR.entity`;
223 :     $parms->{ar_names} = \%ar_names;
224 :    
225 :     my %exp_cond2study;
226 :     my %study2exp_conds;
227 :     foreach $_ (`cat $tablesD/Study-ExpCond`)
228 :     {
229 :     if ($_ =~ /^(\S+)\t(\S+)/)
230 :     {
231 :     my($study,$exp_cond) = ($1,$2);
232 :     $exp_cond2study{$2} = $1;
233 :     push(@{$study2exp_conds{$study}},$exp_cond);
234 :     }
235 :     }
236 :     $parms->{exp_cond2study} = \%exp_cond2study;
237 :     $parms->{study2exp_conds} = \%study2exp_conds;
238 :    
239 :     my %sample2study;
240 :     my %study2samples;
241 :     foreach $_ (`cat $tablesD/ExpCond-Sample`)
242 :     {
243 :     if ($_ =~ /(\S+)\t(\S+)/)
244 :     {
245 :     my($exp_cond,$sample) = ($1,$2);
246 :     if (my $study = $exp_cond2study{$exp_cond})
247 :     {
248 :     push(@{$study2samples{$study}},$sample);
249 :     $sample2study{$sample} = $study;
250 :     }
251 :     }
252 :     }
253 :     $parms->{sample2study} = \%sample2study;
254 :     $parms->{study2samples} = \%study2samples;
255 :    
256 :     my %study;
257 :     foreach $_ (`cat $tablesD/Study.entity`)
258 :     {
259 :     chomp;
260 :     my($study,$desc,$explanation) = split(/\t/,$_);
261 :     $study{$study} = [$desc,$explanation];
262 :     }
263 :     $parms->{study} = \%study;
264 :     my %exp_cond2study;
265 :     my %study2exp_conds;
266 :     foreach $_ (`cat $tablesD/Study-ExpCond`)
267 :     {
268 :     if ($_ =~ /^(\S+)\t(\S+)/)
269 :     {
270 :     my($study,$exp_cond) = ($1,$2);
271 :     $exp_cond2study{$2} = $1;
272 :     push(@{$study2exp_conds{$study}},$exp_cond);
273 :     }
274 :     }
275 :     $parms->{exp_cond2study} = \%exp_cond2study;
276 :     $parms->{study2exp_conds} = \%study2exp_conds;
277 :    
278 :     my %sample2study;
279 :     my %study2samples;
280 :     foreach $_ (`cat $tablesD/ExpCond-Sample`)
281 :     {
282 :     if ($_ =~ /(\S+)\t(\S+)/)
283 :     {
284 :     my($exp_cond,$sample) = ($1,$2);
285 :     if (my $study = $exp_cond2study{$exp_cond})
286 :     {
287 :     push(@{$study2samples{$study}},$sample);
288 :     $sample2study{$sample} = $study;
289 :     }
290 :     }
291 :     }
292 :     $parms->{sample2study} = \%sample2study;
293 :     $parms->{study2samples} = \%study2samples;
294 :    
295 :     my %study;
296 :     foreach $_ (`cat $tablesD/Study.entity`)
297 :     {
298 :     chomp;
299 :     my($study,$desc,$explanation) = split(/\t/,$_);
300 :     $study{$study} = [$desc,$explanation];
301 :     }
302 :     $parms->{study} = \%study;
303 :     }
304 :    
305 :     sub sample_link {
306 :     my($parms,$sample) = @_;
307 :    
308 :     my $genome = $parms->{genome};
309 :     return "<a href=sample.cgi?genome=$genome&sample1=$sample>$sample</a>";
310 :     }
311 :    
312 :     sub peg_link {
313 :     my($peg) = @_;
314 :     my $g = &SeedUtils::genome_of($peg);
315 :     return "<a target=_blank href=peg.cgi?genome=$g&peg=$peg>$peg</a>";
316 :     }
317 :    
318 :     sub stim_link {
319 :     my($stim,$stimReal,$genome) = @_;
320 :    
321 :     return "<a target=_blank href=stimulus.cgi?stimulus=$stim&genome=$genome>$stimReal</a>";
322 :     }
323 :    
324 :     sub stim_links {
325 :     my($parms,$peg) = @_;
326 :    
327 :     my $stims = $parms->{peg2stimulii_links}->{$peg};
328 :     my $stim_links = "";
329 :     if ($stims)
330 :     {
331 :     $stim_links = join(",",@$stims);
332 :     }
333 :     return $stim_links;
334 :     }
335 :    
336 :    
337 :     sub atomic_regulon_link {
338 :     my($atomic_regulon,$genome) = @_;
339 :    
340 :     return "<a target=_blank href=atomic_regulon.cgi?atomic_regulon=$atomic_regulon&genome=$genome>$atomic_regulon</a>";
341 :     }
342 :    
343 :     sub atomic_regulon_links {
344 :     my($parms,$ars) = @_;
345 :    
346 :     if ((!$ars) || (@$ars == 0)) { return '' }
347 :     my $genome = $parms->{genome};
348 :     return join(",",map { &atomic_regulon_link($_,$genome) } @$ars);
349 :     }
350 :    
351 :     sub peg_to_stimulii_links {
352 :     my($parms) = @_;
353 :    
354 :     my $peg_to_stimulii = {};
355 :    
356 :     my %stimH = map { ($_ =~ /^(\S+)\t(\S+)/) ? ($1 => &stim_link($1,$2,$genome)) : () } `cat $tablesD/Stimulus.entity`;
357 :     foreach $_ (`cat $tablesD/PegToStim`)
358 :     {
359 :     $_ =~ /^(\S+)\t(\S+)/;
360 :     push(@{$peg_to_stimulii->{$1}},$stimH{$2});
361 :     }
362 :     $parms->{peg2stimulii_links} = $peg_to_stimulii;
363 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3