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

Annotation of /FigWebServices/HOPSS.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 : olson 1.8 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : overbeek 1.1
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use URI::Escape; # uri_escape()
24 :     use HTML;
25 :     use CGI;
26 :    
27 :     my $cgi = new CGI;
28 :     if (0)
29 :     {
30 :     my $VAR1;
31 :     eval(join("",`cat /tmp/hopss_parms`));
32 :     $cgi = $VAR1;
33 :     # print STDERR &Dumper($cgi);
34 :     }
35 :    
36 :     if (0)
37 :     {
38 :     print $cgi->header;
39 :     my @params = $cgi->param;
40 :     print "<pre>\n";
41 :     foreach $_ (@params)
42 :     {
43 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
44 :     }
45 :    
46 :     if (0)
47 :     {
48 :     if (open(TMP,">/tmp/hopss_parms"))
49 :     {
50 :     print TMP &Dumper($cgi);
51 :     close(TMP);
52 :     }
53 :     }
54 :     exit;
55 :     }
56 :    
57 :     my $html = [];
58 : overbeek 1.6 push @$html, "<TITLE>HOPS</TITLE>\n";
59 : overbeek 1.1
60 :     my $request = $cgi->param('request');
61 :    
62 :     if (! $request)
63 :     {
64 :     push(@$html,$cgi->br,
65 :     $cgi->h2("A Public Depository of Open Problems and Conjectures Identified by SubSystem analysis"),
66 : overbeek 1.6 $cgi->h2("About <a href=Html/about_HOPSS.html target=help>HOPS</a> database"),$cgi->br,
67 : overbeek 1.2 "<br><br>"
68 : overbeek 1.1 );
69 :    
70 :     push(@$html,&summary($fig,$cgi));
71 :     push(@$html, $cgi->hr,
72 : overbeek 1.2 "<a href=HOPSS.cgi?request=new_problem>New Problem</a>\n<br><br><br><hr>",
73 :     "This site was inspired by the events surrounding the <a href=http://www-groups.dcs.st-and.ac.uk/~history/HistTopics/Scottish_Book.html>Scottish book</a> and the impact that it made upon mathematics. If you wish
74 :     to know more about that topic, ask Rick or Ross over beers.\n"
75 : overbeek 1.1 );
76 :     }
77 :     else
78 :     {
79 :     if ($request eq "new_problem")
80 :     {
81 :     &add_problem_form($fig,$cgi,$html),
82 :     }
83 :     elsif ($request eq "add_problem")
84 :     {
85 :     &add_problem($fig,$cgi,$html);
86 :     push(@$html,$cgi->h1('added'));
87 :     push(@$html,&summary($fig,$cgi));
88 :     push(@$html, $cgi->hr,
89 :     "<a href=HOPSS.cgi?request=new_problem>New Problem</a>\n"
90 :     );
91 :     }
92 :     elsif (($request eq "show_problem") && ($problem = $cgi->param('problem')))
93 :     {
94 :     &show_problem($fig,$cgi,$html,$problem);
95 :     }
96 :     elsif (($request eq "update_problem") && ($problem = $cgi->param('problem')))
97 :     {
98 :     &update_problem($fig,$cgi,$html,$problem);
99 :     }
100 :     }
101 :     &HTML::show_page($cgi,$html);
102 :    
103 :     sub show_problem {
104 :     my($fig,$cgi,$html,$problem) = @_;
105 :    
106 :     &load_form($fig,$cgi,$problem);
107 :     &update_form($fig,$cgi,$html,$problem);
108 :     }
109 :    
110 :     sub load_form {
111 :     my($fig,$cgi,$problem) = @_;
112 :    
113 :     my $kv = &read_problem($problem);
114 :     foreach $name (keys(%$kv))
115 :     {
116 :     my $val = $kv->{$name};
117 :     $cgi->param(-name => $name, -value => $val);
118 :     }
119 :     }
120 :    
121 :     sub update_problem {
122 :     my($fig,$cgi,$html,$problem) = @_;
123 :    
124 : overbeek 1.4 push(@$html,"<br><br><a href=HOPSS.cgi>Back to Summary</a>\n<br><br><br><hr>");
125 : overbeek 1.1 &write_problem($cgi,$problem);
126 :     &update_form($fig,$cgi,$html,$problem);
127 : overbeek 1.3 push(@$html,"<br><br><a href=HOPSS.cgi>Back to Summary</a>\n<br><br><br><hr>");
128 : overbeek 1.1 }
129 :    
130 :     sub update_form {
131 :     my($fig,$cgi,$html,$problem) = @_;
132 :    
133 :    
134 :     my(@types) = ('Missing gene for a role',
135 :     'Gene in subsystem without clear role',
136 :     'Role out of context',
137 :     'Missing input/output',
138 :     'Functionally coupled hypothetical',
139 :     'Orphan chromosomal cluster',
140 :     'Unresolved paralogs',
141 :     'other');
142 :    
143 : overbeek 1.4 my $time_of_creation = &parameter($cgi,"time_of_creation");
144 : overbeek 1.1 my $type = &parameter($cgi,"type");
145 :     my $title = &parameter($cgi,'title');
146 :     my $subsystem = &parameter($cgi,'subsystem');
147 :     my $who = &parameter($cgi,'who');
148 :     my $description = &parameter($cgi,'description');
149 :    
150 :     my @conjectures = grep { $_ } &parameter($cgi,'conjecture');
151 :     my @comments = grep { $_ } &parameter($cgi,'comment');
152 :    
153 :     push(@$html,$cgi->start_form(-action => "HOPSS.cgi", -method => 'post'),
154 :     $cgi->hidden(-name => 'request', -value => 'update_problem', -override => 1),
155 :     $cgi->hidden(-name => 'problem', -value => $problem, -override => 1),
156 : overbeek 1.4 $cgi->hidden(-name => 'time_of_creation', -value => $time_of_creation, -override => 1),
157 : overbeek 1.1 $cgi->br,
158 :     $cgi->br,
159 :     $cgi->br,
160 :     "<a href=Html/HOPSS_type.html target=help><b>Help on How to Pick Types</b></a>\n",
161 :     $cgi->br,
162 :     $cgi->scrolling_list(-name => 'type', -values => \@types, -default => $type, -size => 5),
163 :     $cgi->br,
164 :     $cgi->br,
165 :     $cgi->br,
166 :     'Title: ',$cgi->textfield(-name => 'title', -default => $title, -size=>60),
167 :     $cgi->br,
168 : overbeek 1.5 $cgi->br
169 :     );
170 :     if ($subsystem)
171 :     {
172 : overbeek 1.6 my $subsys_link = &subsys_link($cgi,$subsystem);
173 : overbeek 1.5 push(@$html,
174 :     $cgi->hidden(-name => 'subsystem', -value => $subsystem, -override => 1),
175 : overbeek 1.6 "Subsystem: $subsys_link <br><br>\n"
176 : overbeek 1.5 );
177 :     }
178 :     else
179 :     {
180 :     my @subsystems = sort { uc $a cmp uc $b } $fig->all_subsystems;
181 :     push(@$html,$cgi->scrolling_list(-name => 'subsystem', -values => \@subsystems, -size => 5));
182 :     }
183 :     push(@$html,
184 : overbeek 1.1 $cgi->br,
185 :     $cgi->br,
186 :     'Your Name: ',$cgi->textfield(-name => 'who', -default => $who, -size=>60),
187 :     $cgi->br,
188 :     $cgi->br,
189 :     # 'Approximate number of genomes: ',$cgi->textfield(-name => 'num_genomes', -default => '', -size=>60),
190 :     # $cgi->br,
191 :     # $cgi->br,
192 :     'Description of the Problem',
193 :     $cgi->br,
194 :     $cgi->br,
195 :     $cgi->textarea(-name => 'description', -rows => 20, -cols => 100, -value => $description),
196 :     $cgi->br,
197 :     $cgi->br
198 :     );
199 :     foreach $_ (@conjectures,'')
200 :     {
201 :     push(@$html,"Conjecture: ",$cgi->br,
202 :     $cgi->textarea(-name => 'conjecture', -rows => 20, -cols => 100, -value => $_, -override => 1),
203 :     $cgi->br,
204 :     $cgi->br
205 :     );
206 :     }
207 :    
208 :     foreach $_ (@comments,'')
209 :     {
210 : overbeek 1.6 push(@$html,"Verification Notes: ",$cgi->br,
211 : overbeek 1.1 $cgi->textarea(-name => 'comment', -rows => 20, -cols => 100, -value => $_, -override => 1),
212 :     $cgi->br,
213 :     $cgi->br
214 :     );
215 :     }
216 :    
217 :     push(@$html,
218 :     $cgi->submit('Update the Problem'),
219 :     $cgi->end_form
220 :     );
221 :     }
222 :    
223 :    
224 :    
225 :     sub summary {
226 :     my($fig,$cgi) = @_;
227 :    
228 :     my @existing = &problems;
229 :     if (@existing > 0)
230 :     {
231 : overbeek 1.7 my $col_hdrs = ['title','subsystem','type','timestamp','who','conjectures','Verification Notes'];
232 : overbeek 1.1 my $tab = [];
233 :    
234 :     my $problem;
235 :     foreach $problem (@existing)
236 :     {
237 :     $kv = &read_problem($problem );
238 :    
239 : overbeek 1.3 my $subsys_link = &subsys_link($cgi,&subsystem($kv));
240 : overbeek 1.1 push(@$tab,[
241 :     &problem_link($cgi,&title($kv),$problem),
242 : overbeek 1.3 $subsys_link,
243 : overbeek 1.1 &type($kv),
244 :     &time_of_creation($kv),
245 :     &who($kv),
246 :     &num_conjectures($kv),
247 :     &num_comments($kv)
248 :     ]);
249 :     }
250 : overbeek 1.3
251 : overbeek 1.1 return &HTML::make_table($col_hdrs,[sort { ($a->[1] cmp $b->[1]) } @$tab],"Summary of Existing Problems and Conjectures");
252 :     }
253 :     else
254 :     {
255 :     return $cgi->br;
256 :     }
257 :     }
258 :    
259 :     sub problem_link {
260 :     my($cgi,$title,$problem) = @_;
261 :    
262 :     return "<a href=HOPSS.cgi?request=show_problem&problem=$problem>$title</a>\n";
263 :     }
264 :    
265 :     sub type {
266 :     my($kv) = @_;
267 :    
268 :     return $kv->{'type'}->[0];
269 :     }
270 :    
271 :     sub time_of_creation {
272 :     my($kv) = @_;
273 :    
274 :     return $fig->epoch_to_readable($kv->{'time_of_creation'}->[0]);
275 :     }
276 :    
277 :     sub title {
278 :     my($kv) = @_;
279 :    
280 :     return $kv->{'title'}->[0];
281 :     }
282 :    
283 :     sub subsystem {
284 :     my($kv) = @_;
285 :    
286 :     return $kv->{'subsystem'}->[0];
287 :     }
288 :    
289 :     sub who {
290 :     my($kv) = @_;
291 :    
292 :     return $kv->{'who'}->[0];
293 :     }
294 :    
295 :     sub num_conjectures {
296 :     my($kv) = @_;
297 :    
298 : overbeek 1.3 my $x = $kv->{'conjecture'};
299 : overbeek 1.1 return $x ? scalar @$x : 0;
300 :     }
301 :    
302 :     sub num_comments {
303 :     my($kv) = @_;
304 :    
305 : overbeek 1.3 my $x = $kv->{'comment'};
306 : overbeek 1.1 return $x ? scalar @$x : 0;
307 :     }
308 :    
309 :     sub read_problem {
310 :     my($problem) = @_;
311 :    
312 :     my $kv = undef;
313 :     if (open(PROB,"<$FIG_Config::data/HOPSS/$problem/problem"))
314 :     {
315 :     $/ = "\n//\n";
316 :     while ($_ = <PROB>)
317 :     {
318 :     chomp;
319 :     if ($_ =~ /^(\S+)\n(.*)/s)
320 :     {
321 :     push(@{$kv->{$1}},$2);
322 :     }
323 :     }
324 :     $/ = "\n";
325 :     close(PROB);
326 :     }
327 :     return $kv;
328 :     }
329 :    
330 :     sub add_problem {
331 :     my($fig,$cgi,$html) = @_;
332 :    
333 :     &FIG::verify_dir("$FIG_Config::data/HOPSS");
334 :    
335 :     my @existing = &problems;
336 :     my $new_prob = &next_id(\@existing);
337 : overbeek 1.4 my $timestamp = time;
338 :     $cgi->param(-name => 'time_of_creation', -value => $timestamp);
339 : overbeek 1.1 &write_problem($cgi,$new_prob);
340 :     }
341 :    
342 :     sub write_problem {
343 :     my($cgi,$new_prob) = @_;
344 :    
345 :     &FIG::verify_dir("$FIG_Config::data/HOPSS/$new_prob");
346 :     if (-s "$FIG_Config::data/HOPSS/$new_prob/problem")
347 :     {
348 :     my $timestamp = time;
349 :     rename("$FIG_Config::data/HOPSS/$new_prob/problem",
350 :     "$FIG_Config::data/HOPSS/$new_prob/Backup/problem.$timestamp");
351 :     }
352 :     &FIG::verify_dir("$FIG_Config::data/HOPSS/$new_prob/Backup");
353 :     open(NEW,">$FIG_Config::data/HOPSS/$new_prob/problem")
354 :     || die "could not open $FIG_Config::data/HOPSS/$new_prob/problem";
355 :    
356 : overbeek 1.4 my $time_of_creation = &parameter($cgi,"time_of_creation");
357 : overbeek 1.1 my $type = &parameter($cgi,'type');
358 :     my $title = &parameter($cgi,'title');
359 :     my $subsystem = &parameter($cgi,'subsystem');
360 :     my $who = &parameter($cgi,'who');
361 :     # my $num_genomes = &parameter($cgi,'num_genomes');
362 :     my $description = &parameter($cgi,'description');
363 :     my @conjectures = grep { $_ } &parameter($cgi,'conjecture');
364 :     my @comments = grep { $_ } &parameter($cgi,'comment');
365 :    
366 :     print NEW "ID\n$new_prob\n//\n";
367 :    
368 : overbeek 1.4 print NEW "time_of_creation\n",$time_of_creation,"\n//\n";
369 : overbeek 1.1 print NEW "type\n$type\n//\n";
370 :     print NEW "title\n$title\n//\n";
371 :     print NEW "subsystem\n$subsystem\n//\n";
372 :     print NEW "who\n$who\n//\n";
373 :     # print NEW "num_genomes\n$num_genomes\n//\n";
374 :     print NEW "description\n$description\n//\n";
375 :     foreach $_ (@conjectures)
376 :     {
377 :     print NEW "conjecture\n$_\n//\n";
378 :     }
379 :    
380 :     foreach $_ (@comments)
381 :     {
382 :     print NEW "comment\n$_\n//\n";
383 :     }
384 :     close(NEW);
385 :     }
386 :    
387 :     sub problems {
388 :    
389 :     my @existing = ();
390 :     if (opendir(HOPSS,"$FIG_Config::data/HOPSS"))
391 :     {
392 :     @existing = grep { $_ !~ /^\./ } readdir(HOPSS);
393 :     closedir(HOPSSS);
394 :     }
395 :     return @existing;
396 :     }
397 :    
398 :     sub next_id {
399 :     my($existing) = @_;
400 :    
401 :     my $max = 0;
402 :     foreach $_ (@$existing)
403 :     {
404 :     $max = &FIG::max($max,$_);
405 :     }
406 :     return $max+1;
407 :     }
408 :    
409 :     sub parameter {
410 :     my($cgi,$name) = @_;
411 :    
412 :     if (wantarray)
413 :     {
414 :     my @val = $cgi->param($name);
415 :     if (@val > 0)
416 :     {
417 :     foreach $_ (@val)
418 :     {
419 : overbeek 1.3 # $_ =~ s/ //g;
420 : overbeek 1.1 }
421 :     }
422 :     else
423 :     {
424 :     @val = ();
425 :     }
426 :     return @val;
427 :     }
428 :     else
429 :     {
430 :     my $val = $cgi->param($name);
431 :     $val = $val ? $val : "";
432 : overbeek 1.3 # $val =~ s/ /\n/g;
433 : overbeek 1.1 return $val;
434 :     }
435 :     }
436 :    
437 :     sub add_problem_form {
438 :     my($fig,$cgi,$html) = @_;
439 :    
440 :     my(@types) = ('Missing gene for a role',
441 :     'Gene in subsystem without clear role',
442 :     'Role out of context',
443 :     'Missing input/output',
444 :     'Functionally coupled hypothetical',
445 :     'Orphan chromosomal cluster',
446 :     'Unresolved paralogs',
447 :     'other');
448 :    
449 :     my @subsystems = sort { uc $a cmp uc $b } $fig->all_subsystems;
450 :    
451 : overbeek 1.6 push(@$html,$cgi->h1("Please fill in the relevant fields"),
452 : overbeek 1.1 $cgi->start_form(-action => "HOPSS.cgi", -method => 'post'),
453 :     $cgi->hidden(-name => 'request', -value => 'add_problem', -override => 1),
454 :     $cgi->scrolling_list(-name => 'type', -values => \@types, -size => 5),
455 :     $cgi->br,
456 :     $cgi->br,
457 :     $cgi->br,
458 :     'Title: ',$cgi->textfield(-name => 'title', -default => '', -size=>60),
459 :     $cgi->br,
460 :     $cgi->br,
461 :     $cgi->scrolling_list(-name => 'subsystem', -values => \@subsystems, -size => 5),
462 :     $cgi->br,
463 :     $cgi->br,
464 :     'Your Name: ',$cgi->textfield(-name => 'who', -default => '', -size=>60),
465 :     $cgi->br,
466 :     $cgi->br,
467 :     # 'Approximate number of genomes: ',$cgi->textfield(-name => 'num_genomes', -default => '', -size=>60),
468 :     # $cgi->br,
469 :     # $cgi->br,
470 :     'Description of the Problem',
471 :     $cgi->br,
472 :     $cgi->br,
473 :     $cgi->textarea(-name => 'description', -rows => 20, -cols => 100, -value => ''),
474 :     $cgi->br,
475 :     $cgi->br,
476 :     $cgi->submit('Add the Problem'),
477 :     $cgi->end_form
478 :     );
479 :     }
480 :    
481 : overbeek 1.3 sub subsys_link {
482 :     my($cgi,$subsys) = @_;
483 :    
484 :     my $esc_sub = uri_escape($subsys); # in URI::Escape
485 :     my %opts = (ssa_name => $esc_sub,
486 :     request => 'show_ssa',
487 :     show_clusters => 1,
488 :     sort => 'by_phylo'
489 :     );
490 :    
491 :     my $opts = join("&", map { "$_=$opts{$_}" } keys(%opts));
492 :     my $url = $cgi->a({href => "display_subsys.cgi?$opts"}, $subsys);
493 :     return $url;
494 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3