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

Annotation of /FigWebServices/assignments.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3