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

Annotation of /FigWebServices/assignments.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : overbeek 1.1
2 :     use FIG;
3 :     my $fig = new FIG;
4 :    
5 :     use HTML;
6 :     use strict;
7 :    
8 :     use CGI;
9 :     my $cgi = new CGI;
10 :    
11 :     if (0)
12 :     {
13 :     print $cgi->header;
14 :     my @params = $cgi->param;
15 :     print "<pre>\n";
16 :     foreach $_ (@params)
17 :     {
18 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
19 :     }
20 :     exit;
21 :     }
22 :    
23 :     my $html = [];
24 :    
25 :     my $request = $cgi->param("request");
26 :     $request = defined($request) ? $request : "";
27 :    
28 :     if ($cgi->param('delete checked entries'))
29 :     {
30 :     &delete_checked($fig,$cgi,$html);
31 :     &show_initial($fig,$cgi,$html);
32 :     }
33 :     elsif ($request eq "edit_set")
34 :     {
35 :     &edit_set($fig,$cgi,$html);
36 :     }
37 :     elsif ($request eq "delete_set")
38 :     {
39 :     &delete_set($fig,$cgi,$html);
40 :     }
41 :     elsif ($request eq "accept_set")
42 :     {
43 :     &accept_set($fig,$cgi,$html);
44 :     }
45 :     else
46 :     {
47 :     &show_initial($fig,$cgi,$html);
48 :     }
49 :    
50 :     &HTML::show_page($cgi,$html);
51 :    
52 :     sub show_initial {
53 :     my($fig,$cgi,$html) = @_;
54 :    
55 :     my @sets = &assignment_sets;
56 :     if (@sets == 0)
57 :     {
58 :     push(@$html,$cgi->h1("No Assignment Sets Defined"));
59 :     return;
60 :     }
61 :    
62 :     my $target = "window$$";
63 :     my $user = $cgi->param('user');
64 :     push(@$html, $cgi->h1('Assignment Sets'),
65 :     $cgi->start_form(-action => "assignments.cgi",
66 :     -target => $target,
67 :     -method => 'post'),
68 :     $cgi->hidden(-name => 'user', -value => $user),
69 :     );
70 :    
71 :     my $col_hdrs = ["Edit/Examine","Delete","Accept All","Set Date","Comment"];
72 :     my $tab = [];
73 :     my $title = "Existing Assignment Sets";
74 :     foreach $set (sort { &compare_set_names($a,$b) } @sets)
75 :     {
76 :     $set =~ /(\d+-\d+-\d+:\d+:\d+:\d+)(:(.*))?/;
77 :     $when = $1;
78 :     $comment = $3;
79 :     push(@$tab,[
80 :     &edit_link($cgi,$set),
81 :     &delete_link($cgi,$set),
82 :     &accept_link($cgi,$set),
83 :     $when,
84 :     $comment
85 :     ]
86 :     );
87 :     }
88 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
89 :     }
90 :    
91 :     sub edit_link {
92 :     my($cgi,$set) = @_;
93 :    
94 :     return $cgi->self_url() . "&request=edit_set&set=$set";
95 :     }
96 :    
97 :     sub delete_link {
98 :     my($cgi,$set) = @_;
99 :    
100 :     return $cgi->self_url() . "&request=delete_set&set=$set";
101 :     }
102 :    
103 :     sub accept_link {
104 :     my($cgi,$set) = @_;
105 :    
106 :     return $cgi->self_url() . "&request=accept_set&set=$set";
107 :     }
108 :    
109 :     sub assignment_sets {
110 :    
111 :     my @sets = ();
112 :     if (opendir(SETS,"$FIG_Config::data/Assignments"))
113 :     {
114 :     @sets = grep { $_ =~ /^\d+-\d+-\d+:\d+:\d+:\d+/ } readdir(SETS);
115 :     closedir(SETS);
116 :     }
117 :     return @sets;
118 :     }
119 :    
120 :     sub compare_set_names {
121 :     my($a,$b) = @_;
122 :     my(@whenA,@whenB,$i);
123 :    
124 :     if (($a =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenA = ($3,$1,$2,$4,$5,$6,$7)) &&
125 :     ($b =~ /^(\d+)-(\d+)-(\d+):(\d+):(\d+):(\d+)(.*)/) && (@whenB = ($3,$1,$2,$4,$5,$6,$7)))
126 :     {
127 :     for ($i=0; ($i < 6) && ($whenA[$i] == $whenB[$i]); $i++) {}
128 :     if ($i < 6)
129 :     {
130 :     return ($whenA[$i] <=> $whenB[$i]);
131 :     }
132 :     else
133 :     {
134 :     returnb ($whenA[6] cmp $whenB[6]);
135 :     }
136 :     }
137 :     return ($a cmp $b);
138 :     }
139 :    
140 :     sub edit_set {
141 :     my($fig,$cgi,$html) = @_;
142 :     my($line,$userR,$func1,$func2,$col_hdrs,$tab,$peg,$conf);
143 :    
144 :     my $user = $cgi->param('user');
145 :     if (! $user)
146 :     {
147 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to edit assignments"));
148 :     return;
149 :     }
150 :     elsif ($user =~ /^master:/)
151 :     {
152 :     $userR = "master";
153 :     }
154 :     else
155 :     {
156 :     $userR = $user;
157 :     }
158 :    
159 :     my $set = $cgi->param('set');
160 :     if (! $set)
161 :     {
162 :     push(@$html,$cgi->h1("Sorry, but you need to specify a set to edit"));
163 :     return;
164 :     }
165 :    
166 :     my $target = "window$$";
167 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
168 :     {
169 :     push(@$html, $cgi->h1('Edit Set $set'),
170 :     $cgi->start_form(-method => 'post',
171 :     -target => $target,
172 :     -action => 'edit_checked.cgi'
173 :     ),
174 :     $cgi->hidden(-name => 'user', -value => $user),
175 :     $cgi->hidden(-name => 'set', -value => $set)
176 :     );
177 :    
178 :     $col_hdrs = ["delete","PEG","Functions"];
179 :     $tab = [];
180 :     if (open(SET,"<$FIG_Config::data/Assignments/$userR/$set"))
181 :     {
182 :     while (defined($line = <SET>))
183 :     {
184 :     chop $line;
185 :     ($peg,$func1,$conf) = split(/\t/,$line);
186 :     if ($conf) { $func1 = "$func1\t$conf" }
187 :     $func2 = &func_of($fig,$peg,$user);
188 :     if ($func1 ne $func2)
189 :     {
190 :     push(@$tab,[
191 :     $cgi->checkbox(-name => 'checked', -value => $peg, -checked => 1,-override => 1),
192 :     &HTML::fid_link($cgi,$peg),
193 :     "$func1<br>$func2"
194 :     ]
195 :     );
196 :     }
197 :     }
198 :     close(SET);
199 :     }
200 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"",["nowrap"]));
201 :     push(@$html,$cgi->submit("delete checked entries"));
202 :     }
203 :     }
204 :    
205 :     sub delete_set {
206 :     my($fig,$cgi,$html) = @_;
207 :    
208 :     my $user = $cgi->param('user');
209 :     my $userR = $user;
210 :     $userR =~ s/^master://;
211 :     my $set = $cgi->param('set');
212 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
213 :     {
214 :     unlink("$FIG_Config::data/Assignments/$userR/$set");
215 :     push(@$html,$cgi->h1("Deleted set $set"));
216 :     }
217 :     else
218 :     {
219 :     push(@$html,$cgi->h1("Delete Failed: set $set does not exist"));
220 :     }
221 :     }
222 :    
223 :     sub accept_set {
224 :     my($fig,$cgi,$html) = @_;
225 :    
226 :     my $user = $cgi->param('user');
227 :     my $set = $cgi->param('set');
228 :     if ($user)
229 :     {
230 :     my $userR = $user;
231 :     $userR =~ s/^master://;
232 :     if (system("fig assign_functionF $user $FIG_Config::data/Assignments/$userR/$set > /dev/null") == 0)
233 :     {
234 :     push(@$html,$cgi->h1("Made Assignments from $set"));
235 :     }
236 :     else
237 :     {
238 :     push(@$html,$cgi->h1("Call Support: some error occurred"));
239 :     }
240 :     }
241 :     else
242 :     {
243 :     push(@$html,$cgi->h1("Sorry, but you need to specify a user to accept assignments"));
244 :     }
245 :     }
246 :    
247 :     sub func_of {
248 :     my($fig,$peg,$user) = @_;
249 :     my $func;
250 :    
251 :     if ($user =~ /^master:/)
252 :     {
253 :     $func = $fig->function_of($peg,"master");
254 :     }
255 :     else
256 :     {
257 :     $func = $fig->function_of($peg,$user);
258 :     }
259 :     return $func;
260 :     }
261 :    
262 :     sub delete_checked {
263 :     my($fig,$cgi,$html) = @_;
264 :    
265 :     my $user = $cgi->param('user');
266 :     my $set = $cgi->param('set');
267 :     if ($user)
268 :     {
269 :     my $userR = $user;
270 :     $userR =~ s/^master://;
271 :     if (-s "$FIG_Config::data/Assignments/$userR/$set")
272 :     {
273 :     @entries = `cat $FIG_Config::data/Assignments/$userR/$set`;
274 :    
275 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3