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

Annotation of /FigWebServices/assignments.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (view) (download)

1 : olson 1.15 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : overbeek 1.1 use FIG;
19 :     my $fig = new FIG;
20 :    
21 :     use HTML;
22 :     use strict;
23 :    
24 :     use CGI;
25 :     my $cgi = new CGI;
26 :    
27 :     if (0)
28 :     {
29 :     print $cgi->header;
30 :     my @params = $cgi->param;
31 :     print "<pre>\n";
32 :     foreach $_ (@params)
33 :     {
34 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
35 :     }
36 :     exit;
37 :     }
38 :    
39 :     my $html = [];
40 :    
41 : overbeek 1.2 my $user = $cgi->param('user');
42 : overbeek 1.16 if ($user !~ /^master:/) { "master:$user" }
43 :    
44 : overbeek 1.2 if (! $user)
45 : overbeek 1.1 {
46 : overbeek 1.2 push(@$html,$cgi->h1("Sorry, you need to specify a user to process assignment sets"));
47 : overbeek 1.1 }
48 :     else
49 :     {
50 : overbeek 1.2 my $request = $cgi->param("request");
51 :     $request = defined($request) ? $request : "";
52 :    
53 :     if ($cgi->param('delete checked entries'))
54 :     {
55 :     &delete_checked($fig,$cgi,$html);
56 : overbeek 1.5 $cgi->delete('delete checked entries');
57 :     $cgi->delete("request");
58 :     $cgi->delete("set");
59 : overbeek 1.2 &show_initial($fig,$cgi,$html);
60 :     }
61 :     elsif ($request eq "edit_set")
62 :     {
63 :     &edit_set($fig,$cgi,$html);
64 :     }
65 :     elsif ($request eq "delete_set")
66 :     {
67 :     &delete_set($fig,$cgi,$html);
68 :     }
69 :     elsif ($request eq "accept_set")
70 :     {
71 :     &accept_set($fig,$cgi,$html);
72 :     }
73 :     else
74 :     {
75 :     &show_initial($fig,$cgi,$html);
76 :     }
77 : overbeek 1.1 }
78 :    
79 :     &HTML::show_page($cgi,$html);
80 :    
81 :     sub show_initial {
82 :     my($fig,$cgi,$html) = @_;
83 : overbeek 1.2 my($set,$when,$comment);
84 : overbeek 1.1
85 : overbeek 1.2 my $user = $cgi->param('user');
86 :     my @sets = &assignment_sets($user);
87 : overbeek 1.1 if (@sets == 0)
88 :     {
89 :     push(@$html,$cgi->h1("No Assignment Sets Defined"));
90 :     return;
91 :     }
92 :    
93 :     my $target = "window$$";
94 :     push(@$html, $cgi->h1('Assignment Sets'),
95 :     $cgi->start_form(-action => "assignments.cgi",
96 :     -target => $target,
97 :     -method => 'post'),
98 :     $cgi->hidden(-name => 'user', -value => $user),
99 :     );
100 :    
101 :     my $col_hdrs = ["Edit/Examine","Delete","Accept All","Set Date","Comment"];
102 :     my $tab = [];
103 :     my $title = "Existing Assignment Sets";
104 : overbeek 1.2
105 : overbeek 1.1 foreach $set (sort { &compare_set_names($a,$b) } @sets)
106 :     {
107 :     $set =~ /(\d+-\d+-\d+:\d+:\d+:\d+)(:(.*))?/;
108 :     $when = $1;
109 :     $comment = $3;
110 :     push(@$tab,[
111 :     &edit_link($cgi,$set),
112 :     &delete_link($cgi,$set),
113 :     &accept_link($cgi,$set),
114 :     $when,
115 :     $comment
116 :     ]
117 :     );
118 :     }
119 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
120 :     }
121 :    
122 :     sub edit_link {
123 :     my($cgi,$set) = @_;
124 : redwards 1.11
125 :     # modified by RAE so that this can be called from within assignments.cgi and the options can be changed.
126 : overbeek 1.14 return "<a href=" . $cgi->url(-relative => 1) . "?user=".$cgi->param('user') . "&request=edit_set&set=$set&all=0>edit</a>" . "/" .
127 :     "<a href=" . $cgi->url(-relative => 1) . "?user=".$cgi->param('user') . "&request=edit_set&set=$set&all=1>examine</a>";
128 : overbeek 1.1 }
129 :    
130 :     sub delete_link {
131 :     my($cgi,$set) = @_;
132 :    
133 : redwards 1.12 # modified by RAE so that this can be called from within assignments.cgi and the options can be changed.
134 : overbeek 1.14 return "<a href=" . $cgi->url(-relative => 1) . "?user=".$cgi->param('user')."&request=delete_set&set=$set>delete</a>";
135 : redwards 1.12 #return "<a href=" . $cgi->self_url() . "&request=delete_set&set=$set>delete</a>";
136 : overbeek 1.1 }
137 :    
138 :     sub accept_link {
139 :     my($cgi,$set) = @_;
140 :    
141 : redwards 1.11 # modified by RAE so that this can be called from within assignments.cgi and the options can be changed.
142 : overbeek 1.14 return "<a href=" . $cgi->url(-relative => 1) . "?user=".$cgi->param('user')."&request=accept_set&set=$set>accept</a>";
143 : overbeek 1.1 }
144 :    
145 :     sub assignment_sets {
146 : overbeek 1.2 my($user) = @_;
147 : overbeek 1.1
148 : overbeek 1.2 my $userR = $user;
149 :     $userR =~ s/^master://;
150 : overbeek 1.1 my @sets = ();
151 : overbeek 1.2 if (opendir(SETS,"$FIG_Config::data/Assignments/$userR"))
152 : overbeek 1.1 {
153 :     @sets = grep { $_ =~ /^\d+-\d+-\d+:\d+:\d+:\d+/ } readdir(SETS);
154 :     closedir(SETS);
155 :     }
156 :     return @sets;
157 :     }
158 :    
159 :     sub compare_set_names {
160 :     my($a,$b) = @_;
161 :     my(@whenA,@whenB,$i);
162 :    
163 :     if (($a =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenA = ($3,$1,$2,$4,$5,$6,$7)) &&
164 :     ($b =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenB = ($3,$1,$2,$4,$5,$6,$7)))
165 :     {
166 :     for ($i=0; ($i < 6) && ($whenA[$i] == $whenB[$i]); $i++) {}
167 :     if ($i < 6)
168 :     {
169 :     return ($whenA[$i] <=> $whenB[$i]);
170 :     }
171 :     else
172 :     {
173 : olson 1.9 return ($whenA[6] cmp $whenB[6]);
174 : overbeek 1.1 }
175 :     }
176 :     return ($a cmp $b);
177 :     }
178 :    
179 :     sub edit_set {
180 :     my($fig,$cgi,$html) = @_;
181 :     my($line,$userR,$func1,$func2,$col_hdrs,$tab,$peg,$conf);
182 :    
183 :     my $user = $cgi->param('user');
184 :     if (! $user)
185 :     {
186 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to edit assignments"));
187 :     return;
188 :     }
189 :     else
190 :     {
191 :     $userR = $user;
192 : overbeek 1.2 $userR =~ s/^master://;
193 : overbeek 1.1 }
194 :    
195 :     my $set = $cgi->param('set');
196 :     if (! $set)
197 :     {
198 :     push(@$html,$cgi->h1("Sorry, but you need to specify a set to edit"));
199 :     return;
200 :     }
201 :    
202 :     my $target = "window$$";
203 : overbeek 1.6 if (-e "$FIG_Config::data/Assignments/$userR/$set")
204 : overbeek 1.1 {
205 :     if (open(SET,"<$FIG_Config::data/Assignments/$userR/$set"))
206 :     {
207 : overbeek 1.6 my $op = $cgi->param('all') ? "Examine" : "Edit";
208 :     push(@$html, $cgi->h1("$op Set $set"),
209 : overbeek 1.2 $cgi->start_form(-method => 'post',
210 :     -target => $target,
211 :     -action => 'assignments.cgi'
212 :     ),
213 :     $cgi->hidden(-name => 'user', -value => $user),
214 :     $cgi->hidden(-name => 'set', -value => $set)
215 :     );
216 :    
217 : overbeek 1.13 $col_hdrs = ["delete","PEG","In SubSys","Proposed Function", "Current function","UniProt ID","UniProt Function"];
218 : overbeek 1.2 $tab = [];
219 : overbeek 1.3 my @keep = ();
220 : overbeek 1.1 while (defined($line = <SET>))
221 :     {
222 :     chop $line;
223 :     ($peg,$func1,$conf) = split(/\t/,$line);
224 :     if ($conf) { $func1 = "$func1\t$conf" }
225 :     $func2 = &func_of($fig,$peg,$user);
226 : overbeek 1.8 if ($func1 ne $func2)
227 : overbeek 1.1 {
228 : overbeek 1.3 push(@keep,"$line\n");
229 : overbeek 1.13 my @subs = $fig->peg_to_subsystems($peg);
230 :     my $in_sub = @subs;
231 :     my @uni = $fig->to_alias($peg,"uni");
232 :     my $uni_link = (@uni > 0) ? &HTML::uni_link($cgi,$uni[0]) : "";
233 :     my $uni_func = $uni_link ? $fig->function_of($uni[0]) : "";
234 : overbeek 1.1 push(@$tab,[
235 : overbeek 1.13 $cgi->checkbox(
236 :     -name => 'checked',
237 :     -value => $peg,
238 :     -checked => 0,
239 :     -override => 1,
240 :     -label => ""
241 :     ),
242 : overbeek 1.1 &HTML::fid_link($cgi,$peg),
243 : overbeek 1.13 $in_sub,
244 :     $func1, $func2,
245 :     $uni_link,$uni_func
246 : overbeek 1.1 ]
247 :     );
248 :     }
249 :     }
250 :     close(SET);
251 : overbeek 1.3
252 : overbeek 1.2 if (@$tab > 0)
253 :     {
254 : overbeek 1.7 push(@$html,&HTML::make_table($col_hdrs,$tab,""));
255 : overbeek 1.2 push(@$html,$cgi->submit("delete checked entries"));
256 : redwards 1.11 # modified by RAE to include these links at the bottom of the page so that you can accept after reviewing
257 :     push(@$html,"<p><b>", &accept_link($cgi, $set), "/", &edit_link($cgi, $set), " these annotations</b></p>");
258 : overbeek 1.2 }
259 :     else
260 :     {
261 :     push(@$html,$cgi->h2("No new assignments"));
262 :     }
263 :     }
264 :     else
265 :     {
266 :     push(@$html,$cgi->h1("Sorry, could not open $FIG_Config::data/Assignments/$userR/$set; sounds like a permissions problem"));
267 : overbeek 1.1 }
268 : overbeek 1.2 }
269 :     else
270 :     {
271 :     push(@$html,$cgi->h1("Sorry, $set does not exist for user $user"));
272 : overbeek 1.1 }
273 :     }
274 :    
275 :     sub delete_set {
276 :     my($fig,$cgi,$html) = @_;
277 :    
278 :     my $user = $cgi->param('user');
279 :     my $userR = $user;
280 :     $userR =~ s/^master://;
281 :     my $set = $cgi->param('set');
282 : overbeek 1.6 if (-e "$FIG_Config::data/Assignments/$userR/$set")
283 : overbeek 1.1 {
284 :     unlink("$FIG_Config::data/Assignments/$userR/$set");
285 : redwards 1.12 push(@$html,$cgi->h2("Deleted set $set"));
286 : overbeek 1.14 push(@$html,$cgi->h2("<a href=" . $cgi->url(-relative => 1) . "?user=".$cgi->param('user').">Return to Assignment Sets</a>"));
287 : overbeek 1.1 }
288 :     else
289 :     {
290 :     push(@$html,$cgi->h1("Delete Failed: set $set does not exist"));
291 :     }
292 :     }
293 :    
294 :     sub accept_set {
295 :     my($fig,$cgi,$html) = @_;
296 :    
297 :     my $user = $cgi->param('user');
298 :     my $set = $cgi->param('set');
299 : overbeek 1.4 my @flds = split(/:/,$set);
300 :     my $who = $flds[4];
301 :    
302 : overbeek 1.1 if ($user)
303 :     {
304 :     my $userR = $user;
305 : overbeek 1.4 if ($userR =~ s/^master://)
306 :     {
307 :     $who = "master:$who";
308 :     }
309 :    
310 :     if (system("$FIG_Config::bin/fig assign_functionF $who $FIG_Config::data/Assignments/$userR/$set > /dev/null") == 0)
311 : overbeek 1.1 {
312 : redwards 1.12 push(@$html,$cgi->h2("Made Assignments from $set"));
313 :     my $dellink=&delete_link($cgi,$set);
314 :     $dellink =~ s/>delete</>Delete</;
315 :     push(@$html,$cgi->h2("$dellink this Assignment Set from the pending assignments"));
316 : overbeek 1.1 }
317 :     else
318 :     {
319 : overbeek 1.2 push(@$html,$cgi->h1("Call Support: some error occurred in accepting assignments from $FIG_Config::data/Assignments/$userR/$set"));
320 : overbeek 1.1 }
321 :     }
322 :     else
323 :     {
324 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to accept assignments"));
325 :     }
326 :     }
327 :    
328 :     sub func_of {
329 :     my($fig,$peg,$user) = @_;
330 :     my $func;
331 :    
332 :     if ($user =~ /^master:/)
333 :     {
334 :     $func = $fig->function_of($peg,"master");
335 :     }
336 :     else
337 :     {
338 :     $func = $fig->function_of($peg,$user);
339 :     }
340 :     return $func;
341 :     }
342 :    
343 :     sub delete_checked {
344 :     my($fig,$cgi,$html) = @_;
345 : overbeek 1.2 my($line);
346 : overbeek 1.1
347 :     my $user = $cgi->param('user');
348 :     my $set = $cgi->param('set');
349 : overbeek 1.2 my @checked = $cgi->param('checked');
350 :     my %checked = map { $_ => 1 } @checked;
351 :    
352 : overbeek 1.1 if ($user)
353 :     {
354 :     my $userR = $user;
355 :     $userR =~ s/^master://;
356 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
357 :     {
358 : overbeek 1.2 if (rename("$FIG_Config::data/Assignments/$userR/$set","$FIG_Config::data/Assignments/$userR/$set~"))
359 :     {
360 :     if (open(IN,"<$FIG_Config::data/Assignments/$userR/$set~") &&
361 : overbeek 1.5 open(OUT,">$FIG_Config::data/Assignments/$userR/$set"))
362 : overbeek 1.2 {
363 :     while (defined($line = <IN>))
364 :     {
365 :     if (($line =~ /^(\S+)/) && (! $checked{$1}))
366 :     {
367 :     print OUT $line;
368 :     }
369 :     }
370 :     close(IN);
371 :     close(OUT);
372 :    
373 :     if (chmod(0777,"$FIG_Config::data/Assignments/$userR/$set"))
374 :     {
375 :     unlink("$FIG_Config::data/Assignments/$userR/$set~");
376 :     push(@$html,$cgi->h1("ok"));
377 :     }
378 :     else
379 :     {
380 :     push(@$html,$cgi->h1("chmod failure: permissions problem"));
381 :     }
382 :     }
383 :     else
384 :     {
385 :     push(@$html,$cgi->h1("could not open $FIG_Config::data/Assignments/$userR/$set; maybe a permissions problem"));
386 :     }
387 :     }
388 :     else
389 :     {
390 :     push(@$html,$cgi->h1("Could not rename $FIG_Config::data/Assignments/$userR/$set"));
391 :     }
392 :     }
393 :     }
394 :     else
395 :     {
396 :     push(@$html,$cgi->h1("invalid user"));
397 :     }
398 : overbeek 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3