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

Annotation of /FigWebServices/assignments.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (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 :     &show_initial($fig,$cgi,$html);
38 :     }
39 :     elsif ($request eq "edit_set")
40 :     {
41 :     &edit_set($fig,$cgi,$html);
42 :     }
43 :     elsif ($request eq "delete_set")
44 :     {
45 :     &delete_set($fig,$cgi,$html);
46 :     }
47 :     elsif ($request eq "accept_set")
48 :     {
49 :     &accept_set($fig,$cgi,$html);
50 :     }
51 :     else
52 :     {
53 :     &show_initial($fig,$cgi,$html);
54 :     }
55 : overbeek 1.1 }
56 :    
57 :     &HTML::show_page($cgi,$html);
58 :    
59 :     sub show_initial {
60 :     my($fig,$cgi,$html) = @_;
61 : overbeek 1.2 my($set,$when,$comment);
62 : overbeek 1.1
63 : overbeek 1.2 my $user = $cgi->param('user');
64 :     my @sets = &assignment_sets($user);
65 : overbeek 1.1 if (@sets == 0)
66 :     {
67 :     push(@$html,$cgi->h1("No Assignment Sets Defined"));
68 :     return;
69 :     }
70 :    
71 :     my $target = "window$$";
72 :     push(@$html, $cgi->h1('Assignment Sets'),
73 :     $cgi->start_form(-action => "assignments.cgi",
74 :     -target => $target,
75 :     -method => 'post'),
76 :     $cgi->hidden(-name => 'user', -value => $user),
77 :     );
78 :    
79 :     my $col_hdrs = ["Edit/Examine","Delete","Accept All","Set Date","Comment"];
80 :     my $tab = [];
81 :     my $title = "Existing Assignment Sets";
82 : overbeek 1.2
83 : overbeek 1.1 foreach $set (sort { &compare_set_names($a,$b) } @sets)
84 :     {
85 :     $set =~ /(\d+-\d+-\d+:\d+:\d+:\d+)(:(.*))?/;
86 :     $when = $1;
87 :     $comment = $3;
88 :     push(@$tab,[
89 :     &edit_link($cgi,$set),
90 :     &delete_link($cgi,$set),
91 :     &accept_link($cgi,$set),
92 :     $when,
93 :     $comment
94 :     ]
95 :     );
96 :     }
97 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
98 :     }
99 :    
100 :     sub edit_link {
101 :     my($cgi,$set) = @_;
102 :    
103 : overbeek 1.2 return "<a href=" . $cgi->self_url() . "&request=edit_set&set=$set>edit</a>";
104 : overbeek 1.1 }
105 :    
106 :     sub delete_link {
107 :     my($cgi,$set) = @_;
108 :    
109 : overbeek 1.2 return "<a href=" . $cgi->self_url() . "&request=delete_set&set=$set>delete</a>";
110 : overbeek 1.1 }
111 :    
112 :     sub accept_link {
113 :     my($cgi,$set) = @_;
114 :    
115 : overbeek 1.2 return "<a href=" . $cgi->self_url() . "&request=accept_set&set=$set>accept</a>";
116 : overbeek 1.1 }
117 :    
118 :     sub assignment_sets {
119 : overbeek 1.2 my($user) = @_;
120 : overbeek 1.1
121 : overbeek 1.2 my $userR = $user;
122 :     $userR =~ s/^master://;
123 : overbeek 1.1 my @sets = ();
124 : overbeek 1.2 if (opendir(SETS,"$FIG_Config::data/Assignments/$userR"))
125 : overbeek 1.1 {
126 :     @sets = grep { $_ =~ /^\d+-\d+-\d+:\d+:\d+:\d+/ } readdir(SETS);
127 :     closedir(SETS);
128 :     }
129 :     return @sets;
130 :     }
131 :    
132 :     sub compare_set_names {
133 :     my($a,$b) = @_;
134 :     my(@whenA,@whenB,$i);
135 :    
136 :     if (($a =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenA = ($3,$1,$2,$4,$5,$6,$7)) &&
137 :     ($b =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenB = ($3,$1,$2,$4,$5,$6,$7)))
138 :     {
139 :     for ($i=0; ($i < 6) && ($whenA[$i] == $whenB[$i]); $i++) {}
140 :     if ($i < 6)
141 :     {
142 :     return ($whenA[$i] <=> $whenB[$i]);
143 :     }
144 :     else
145 :     {
146 :     returnb ($whenA[6] cmp $whenB[6]);
147 :     }
148 :     }
149 :     return ($a cmp $b);
150 :     }
151 :    
152 :     sub edit_set {
153 :     my($fig,$cgi,$html) = @_;
154 :     my($line,$userR,$func1,$func2,$col_hdrs,$tab,$peg,$conf);
155 :    
156 :     my $user = $cgi->param('user');
157 :     if (! $user)
158 :     {
159 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to edit assignments"));
160 :     return;
161 :     }
162 :     else
163 :     {
164 :     $userR = $user;
165 : overbeek 1.2 $userR =~ s/^master://;
166 : overbeek 1.1 }
167 :    
168 :     my $set = $cgi->param('set');
169 :     if (! $set)
170 :     {
171 :     push(@$html,$cgi->h1("Sorry, but you need to specify a set to edit"));
172 :     return;
173 :     }
174 :    
175 :     my $target = "window$$";
176 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
177 :     {
178 :     if (open(SET,"<$FIG_Config::data/Assignments/$userR/$set"))
179 :     {
180 : overbeek 1.2 push(@$html, $cgi->h1("Edit Set $set"),
181 :     $cgi->start_form(-method => 'post',
182 :     -target => $target,
183 :     -action => 'assignments.cgi'
184 :     ),
185 :     $cgi->hidden(-name => 'user', -value => $user),
186 :     $cgi->hidden(-name => 'set', -value => $set)
187 :     );
188 :    
189 :     $col_hdrs = ["delete","PEG","Functions"];
190 :     $tab = [];
191 : overbeek 1.1 while (defined($line = <SET>))
192 :     {
193 :     chop $line;
194 :     ($peg,$func1,$conf) = split(/\t/,$line);
195 :     if ($conf) { $func1 = "$func1\t$conf" }
196 :     $func2 = &func_of($fig,$peg,$user);
197 :     if ($func1 ne $func2)
198 :     {
199 :     push(@$tab,[
200 :     $cgi->checkbox(-name => 'checked', -value => $peg, -checked => 1,-override => 1),
201 :     &HTML::fid_link($cgi,$peg),
202 :     "$func1<br>$func2"
203 :     ]
204 :     );
205 :     }
206 :     }
207 :     close(SET);
208 : overbeek 1.2 if (@$tab > 0)
209 :     {
210 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"",["nowrap"]));
211 :     push(@$html,$cgi->submit("delete checked entries"));
212 :     }
213 :     else
214 :     {
215 :     push(@$html,$cgi->h2("No new assignments"));
216 :     }
217 :     }
218 :     else
219 :     {
220 :     push(@$html,$cgi->h1("Sorry, could not open $FIG_Config::data/Assignments/$userR/$set; sounds like a permissions problem"));
221 : overbeek 1.1 }
222 : overbeek 1.2 }
223 :     else
224 :     {
225 :     push(@$html,$cgi->h1("Sorry, $set does not exist for user $user"));
226 : overbeek 1.1 }
227 :     }
228 :    
229 :     sub delete_set {
230 :     my($fig,$cgi,$html) = @_;
231 :    
232 :     my $user = $cgi->param('user');
233 :     my $userR = $user;
234 :     $userR =~ s/^master://;
235 :     my $set = $cgi->param('set');
236 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
237 :     {
238 :     unlink("$FIG_Config::data/Assignments/$userR/$set");
239 :     push(@$html,$cgi->h1("Deleted set $set"));
240 :     }
241 :     else
242 :     {
243 :     push(@$html,$cgi->h1("Delete Failed: set $set does not exist"));
244 :     }
245 :     }
246 :    
247 :     sub accept_set {
248 :     my($fig,$cgi,$html) = @_;
249 :    
250 :     my $user = $cgi->param('user');
251 :     my $set = $cgi->param('set');
252 :     if ($user)
253 :     {
254 :     my $userR = $user;
255 :     $userR =~ s/^master://;
256 : overbeek 1.2 if (system("$FIG_Config::bin/fig assign_functionF $user $FIG_Config::data/Assignments/$userR/$set > /dev/null") == 0)
257 : overbeek 1.1 {
258 :     push(@$html,$cgi->h1("Made Assignments from $set"));
259 :     }
260 :     else
261 :     {
262 : overbeek 1.2 push(@$html,$cgi->h1("Call Support: some error occurred in accepting assignments from $FIG_Config::data/Assignments/$userR/$set"));
263 : overbeek 1.1 }
264 :     }
265 :     else
266 :     {
267 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to accept assignments"));
268 :     }
269 :     }
270 :    
271 :     sub func_of {
272 :     my($fig,$peg,$user) = @_;
273 :     my $func;
274 :    
275 :     if ($user =~ /^master:/)
276 :     {
277 :     $func = $fig->function_of($peg,"master");
278 :     }
279 :     else
280 :     {
281 :     $func = $fig->function_of($peg,$user);
282 :     }
283 :     return $func;
284 :     }
285 :    
286 :     sub delete_checked {
287 :     my($fig,$cgi,$html) = @_;
288 : overbeek 1.2 my($line);
289 : overbeek 1.1
290 :     my $user = $cgi->param('user');
291 :     my $set = $cgi->param('set');
292 : overbeek 1.2 my @checked = $cgi->param('checked');
293 :     my %checked = map { $_ => 1 } @checked;
294 :    
295 : overbeek 1.1 if ($user)
296 :     {
297 :     my $userR = $user;
298 :     $userR =~ s/^master://;
299 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
300 :     {
301 : overbeek 1.2 if (rename("$FIG_Config::data/Assignments/$userR/$set","$FIG_Config::data/Assignments/$userR/$set~"))
302 :     {
303 :     if (open(IN,"<$FIG_Config::data/Assignments/$userR/$set~") &&
304 :     open(OUT,"<$FIG_Config::data/Assignments/$userR/$set"))
305 :     {
306 :     while (defined($line = <IN>))
307 :     {
308 :     if (($line =~ /^(\S+)/) && (! $checked{$1}))
309 :     {
310 :     print OUT $line;
311 :     }
312 :     }
313 :     close(IN);
314 :     close(OUT);
315 :    
316 :     if (chmod(0777,"$FIG_Config::data/Assignments/$userR/$set"))
317 :     {
318 :     unlink("$FIG_Config::data/Assignments/$userR/$set~");
319 :     push(@$html,$cgi->h1("ok"));
320 :     }
321 :     else
322 :     {
323 :     push(@$html,$cgi->h1("chmod failure: permissions problem"));
324 :     }
325 :     }
326 :     else
327 :     {
328 :     push(@$html,$cgi->h1("could not open $FIG_Config::data/Assignments/$userR/$set; maybe a permissions problem"));
329 :     }
330 :     }
331 :     else
332 :     {
333 :     push(@$html,$cgi->h1("Could not rename $FIG_Config::data/Assignments/$userR/$set"));
334 :     }
335 :     }
336 :     }
337 :     else
338 :     {
339 :     push(@$html,$cgi->h1("invalid user"));
340 :     }
341 : overbeek 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3