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

Annotation of /FigWebServices/assignments.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (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 :    
106 : overbeek 1.2 return "<a href=" . $cgi->self_url() . "&request=edit_set&set=$set>edit</a>";
107 : overbeek 1.1 }
108 :    
109 :     sub delete_link {
110 :     my($cgi,$set) = @_;
111 :    
112 : overbeek 1.2 return "<a href=" . $cgi->self_url() . "&request=delete_set&set=$set>delete</a>";
113 : overbeek 1.1 }
114 :    
115 :     sub accept_link {
116 :     my($cgi,$set) = @_;
117 :    
118 : overbeek 1.2 return "<a href=" . $cgi->self_url() . "&request=accept_set&set=$set>accept</a>";
119 : overbeek 1.1 }
120 :    
121 :     sub assignment_sets {
122 : overbeek 1.2 my($user) = @_;
123 : overbeek 1.1
124 : overbeek 1.2 my $userR = $user;
125 :     $userR =~ s/^master://;
126 : overbeek 1.1 my @sets = ();
127 : overbeek 1.2 if (opendir(SETS,"$FIG_Config::data/Assignments/$userR"))
128 : overbeek 1.1 {
129 :     @sets = grep { $_ =~ /^\d+-\d+-\d+:\d+:\d+:\d+/ } readdir(SETS);
130 :     closedir(SETS);
131 :     }
132 :     return @sets;
133 :     }
134 :    
135 :     sub compare_set_names {
136 :     my($a,$b) = @_;
137 :     my(@whenA,@whenB,$i);
138 :    
139 :     if (($a =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenA = ($3,$1,$2,$4,$5,$6,$7)) &&
140 :     ($b =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenB = ($3,$1,$2,$4,$5,$6,$7)))
141 :     {
142 :     for ($i=0; ($i < 6) && ($whenA[$i] == $whenB[$i]); $i++) {}
143 :     if ($i < 6)
144 :     {
145 :     return ($whenA[$i] <=> $whenB[$i]);
146 :     }
147 :     else
148 :     {
149 :     returnb ($whenA[6] cmp $whenB[6]);
150 :     }
151 :     }
152 :     return ($a cmp $b);
153 :     }
154 :    
155 :     sub edit_set {
156 :     my($fig,$cgi,$html) = @_;
157 :     my($line,$userR,$func1,$func2,$col_hdrs,$tab,$peg,$conf);
158 :    
159 :     my $user = $cgi->param('user');
160 :     if (! $user)
161 :     {
162 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to edit assignments"));
163 :     return;
164 :     }
165 :     else
166 :     {
167 :     $userR = $user;
168 : overbeek 1.2 $userR =~ s/^master://;
169 : overbeek 1.1 }
170 :    
171 :     my $set = $cgi->param('set');
172 :     if (! $set)
173 :     {
174 :     push(@$html,$cgi->h1("Sorry, but you need to specify a set to edit"));
175 :     return;
176 :     }
177 :    
178 :     my $target = "window$$";
179 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
180 :     {
181 :     if (open(SET,"<$FIG_Config::data/Assignments/$userR/$set"))
182 :     {
183 : overbeek 1.2 push(@$html, $cgi->h1("Edit Set $set"),
184 :     $cgi->start_form(-method => 'post',
185 :     -target => $target,
186 :     -action => 'assignments.cgi'
187 :     ),
188 :     $cgi->hidden(-name => 'user', -value => $user),
189 :     $cgi->hidden(-name => 'set', -value => $set)
190 :     );
191 :    
192 :     $col_hdrs = ["delete","PEG","Functions"];
193 :     $tab = [];
194 : overbeek 1.3 my @keep = ();
195 : overbeek 1.1 while (defined($line = <SET>))
196 :     {
197 :     chop $line;
198 :     ($peg,$func1,$conf) = split(/\t/,$line);
199 :     if ($conf) { $func1 = "$func1\t$conf" }
200 :     $func2 = &func_of($fig,$peg,$user);
201 :     if ($func1 ne $func2)
202 :     {
203 : overbeek 1.3 push(@keep,"$line\n");
204 : overbeek 1.1 push(@$tab,[
205 : overbeek 1.3 $cgi->checkbox(-name => 'checked', -value => $peg, -checked => 0,-override => 1),
206 : overbeek 1.1 &HTML::fid_link($cgi,$peg),
207 :     "$func1<br>$func2"
208 :     ]
209 :     );
210 :     }
211 :     }
212 :     close(SET);
213 : overbeek 1.3
214 :     if (open(SET,">$FIG_Config::data/Assignments/$userR/$set"))
215 :     {
216 :     foreach $line (@keep)
217 :     {
218 :     print SET $line;
219 :     }
220 :     close(SET);
221 :     chmod(0777,"$FIG_Config::data/Assignments/$userR/$set");
222 :     }
223 :    
224 : overbeek 1.2 if (@$tab > 0)
225 :     {
226 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"",["nowrap"]));
227 :     push(@$html,$cgi->submit("delete checked entries"));
228 :     }
229 :     else
230 :     {
231 :     push(@$html,$cgi->h2("No new assignments"));
232 :     }
233 :     }
234 :     else
235 :     {
236 :     push(@$html,$cgi->h1("Sorry, could not open $FIG_Config::data/Assignments/$userR/$set; sounds like a permissions problem"));
237 : overbeek 1.1 }
238 : overbeek 1.2 }
239 :     else
240 :     {
241 :     push(@$html,$cgi->h1("Sorry, $set does not exist for user $user"));
242 : overbeek 1.1 }
243 :     }
244 :    
245 :     sub delete_set {
246 :     my($fig,$cgi,$html) = @_;
247 :    
248 :     my $user = $cgi->param('user');
249 :     my $userR = $user;
250 :     $userR =~ s/^master://;
251 :     my $set = $cgi->param('set');
252 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
253 :     {
254 :     unlink("$FIG_Config::data/Assignments/$userR/$set");
255 :     push(@$html,$cgi->h1("Deleted set $set"));
256 :     }
257 :     else
258 :     {
259 :     push(@$html,$cgi->h1("Delete Failed: set $set does not exist"));
260 :     }
261 :     }
262 :    
263 :     sub accept_set {
264 :     my($fig,$cgi,$html) = @_;
265 :    
266 :     my $user = $cgi->param('user');
267 :     my $set = $cgi->param('set');
268 : overbeek 1.4 my @flds = split(/:/,$set);
269 :     my $who = $flds[4];
270 :    
271 : overbeek 1.1 if ($user)
272 :     {
273 :     my $userR = $user;
274 : overbeek 1.4 if ($userR =~ s/^master://)
275 :     {
276 :     $who = "master:$who";
277 :     }
278 :    
279 :     if (system("$FIG_Config::bin/fig assign_functionF $who $FIG_Config::data/Assignments/$userR/$set > /dev/null") == 0)
280 : overbeek 1.1 {
281 :     push(@$html,$cgi->h1("Made Assignments from $set"));
282 :     }
283 :     else
284 :     {
285 : overbeek 1.2 push(@$html,$cgi->h1("Call Support: some error occurred in accepting assignments from $FIG_Config::data/Assignments/$userR/$set"));
286 : overbeek 1.1 }
287 :     }
288 :     else
289 :     {
290 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to accept assignments"));
291 :     }
292 :     }
293 :    
294 :     sub func_of {
295 :     my($fig,$peg,$user) = @_;
296 :     my $func;
297 :    
298 :     if ($user =~ /^master:/)
299 :     {
300 :     $func = $fig->function_of($peg,"master");
301 :     }
302 :     else
303 :     {
304 :     $func = $fig->function_of($peg,$user);
305 :     }
306 :     return $func;
307 :     }
308 :    
309 :     sub delete_checked {
310 :     my($fig,$cgi,$html) = @_;
311 : overbeek 1.2 my($line);
312 : overbeek 1.1
313 :     my $user = $cgi->param('user');
314 :     my $set = $cgi->param('set');
315 : overbeek 1.2 my @checked = $cgi->param('checked');
316 :     my %checked = map { $_ => 1 } @checked;
317 :    
318 : overbeek 1.1 if ($user)
319 :     {
320 :     my $userR = $user;
321 :     $userR =~ s/^master://;
322 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
323 :     {
324 : overbeek 1.2 if (rename("$FIG_Config::data/Assignments/$userR/$set","$FIG_Config::data/Assignments/$userR/$set~"))
325 :     {
326 :     if (open(IN,"<$FIG_Config::data/Assignments/$userR/$set~") &&
327 : overbeek 1.5 open(OUT,">$FIG_Config::data/Assignments/$userR/$set"))
328 : overbeek 1.2 {
329 :     while (defined($line = <IN>))
330 :     {
331 :     if (($line =~ /^(\S+)/) && (! $checked{$1}))
332 :     {
333 :     print OUT $line;
334 :     }
335 :     }
336 :     close(IN);
337 :     close(OUT);
338 :    
339 :     if (chmod(0777,"$FIG_Config::data/Assignments/$userR/$set"))
340 :     {
341 :     unlink("$FIG_Config::data/Assignments/$userR/$set~");
342 :     push(@$html,$cgi->h1("ok"));
343 :     }
344 :     else
345 :     {
346 :     push(@$html,$cgi->h1("chmod failure: permissions problem"));
347 :     }
348 :     }
349 :     else
350 :     {
351 :     push(@$html,$cgi->h1("could not open $FIG_Config::data/Assignments/$userR/$set; maybe a permissions problem"));
352 :     }
353 :     }
354 :     else
355 :     {
356 :     push(@$html,$cgi->h1("Could not rename $FIG_Config::data/Assignments/$userR/$set"));
357 :     }
358 :     }
359 :     }
360 :     else
361 :     {
362 :     push(@$html,$cgi->h1("invalid user"));
363 :     }
364 : overbeek 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3