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

Annotation of /FigWebServices/HOPSS.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3