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

Annotation of /FigWebServices/lock_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 :    
20 :     use FIG;
21 :     my $fig = new FIG;
22 :    
23 :     use Subsystem;
24 :    
25 :     use HTML;
26 :     use strict;
27 :    
28 :     use CGI;
29 :     my $cgi = new CGI;
30 :    
31 :     if (0)
32 :     {
33 :     my $VAR1;
34 :     eval(join("",`cat /tmp/lock_subsys_parms`));
35 :     $cgi = $VAR1;
36 :     # print STDERR &Dumper($cgi);
37 :     }
38 :    
39 :     if (0)
40 :     {
41 :     print $cgi->header;
42 :     my @params = $cgi->param;
43 :     print "<pre>\n";
44 :     foreach $_ (@params)
45 :     {
46 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
47 :     }
48 :    
49 :     if (0)
50 :     {
51 :     if (open(TMP,">/tmp/lock_subsys_parms"))
52 :     {
53 :     print TMP &Dumper($cgi);
54 :     close(TMP);
55 :     }
56 :     }
57 :     exit;
58 :     }
59 :    
60 :     my $user = $cgi->param('user');
61 :     $user =~ s/^master://;
62 :     $fig->set_user($user);
63 :    
64 :     my $html = [];
65 :     unshift @$html, "<TITLE>Set Locks for a Subsystem</TITLE>\n";
66 :    
67 :     if (! $user)
68 :     {
69 :     push(@$html,$cgi->h1('you need to set a user'));
70 :     &HTML::show_page($cgi,$html);
71 :     exit;
72 :     }
73 :    
74 :     my $subsys = $cgi->param('subsystem');
75 :     if (! $subsys)
76 :     {
77 :     my @ssa = &existing_subsystem_annotations($user);
78 :    
79 :     if (@ssa > 0)
80 :     {
81 :     &format_ssa_table($cgi,$html,\@ssa);
82 :     }
83 :     else
84 :     {
85 :     push(@$html,$cgi->h1('Sorry, no subsystems defined'));
86 :     }
87 :     }
88 :     elsif ($cgi->param('lock annotations'))
89 :     {
90 : overbeek 1.2 my @orgs;
91 :     if ($cgi->param('select_all_genomes'))
92 :     {
93 :     @orgs = map { $_->[0] } @{$fig->subsystem_genomes($subsys)};
94 :     }
95 :     else
96 :     {
97 :     @orgs = $cgi->param('genome_to_lock');
98 :     @orgs = map { $_ =~ /^(\d+\.\d+)/; $1 } @orgs;
99 :     }
100 :    
101 :     my @roles ;
102 :     if ($cgi->param('select_all_roles'))
103 :     {
104 :     @roles = $fig->subsystem_to_roles($subsys);
105 :     }
106 :     else
107 :     {
108 :     @roles = $cgi->param('roles_to_lock');
109 :     }
110 : overbeek 1.1 push(@$html,"<br>");
111 :    
112 :     foreach my $genome (@orgs)
113 :     {
114 :     foreach my $role (@roles)
115 :     {
116 :     foreach my $peg ($fig->pegs_in_subsystem_cell($subsys,$genome,$role))
117 :     {
118 :     $user =~ s/master://;
119 :     $fig->lock_fid($user,$peg);
120 :     push(@$html,"locked $peg<br>\n");
121 :     }
122 :     }
123 :     }
124 :     &show_subsystem($fig,$cgi,$html,$subsys,$user);
125 :     }
126 :     elsif ($cgi->param('unlock annotations'))
127 :     {
128 : overbeek 1.2 my @orgs;
129 :     if ($cgi->param('select_all_genomes'))
130 :     {
131 :     @orgs = map { $_->[0] } @{$fig->subsystem_genomes($subsys)};
132 :     }
133 :     else
134 :     {
135 :     @orgs = $cgi->param('genome_to_lock');
136 :     @orgs = map { $_ =~ /^(\d+\.\d+)/; $1 } @orgs;
137 :     }
138 :    
139 :     my @roles ;
140 :     if ($cgi->param('select_all_roles'))
141 :     {
142 :     @roles = $fig->subsystem_to_roles($subsys);
143 :     }
144 :     else
145 :     {
146 :     @roles = $cgi->param('roles_to_lock');
147 :     }
148 : overbeek 1.1 push(@$html,"<br>");
149 :    
150 :     foreach my $genome (@orgs)
151 :     {
152 :     foreach my $role (@roles)
153 :     {
154 :     foreach my $peg ($fig->pegs_in_subsystem_cell($subsys,$genome,$role))
155 :     {
156 :     $user =~ s/master://;
157 :     $fig->unlock_fid($user,$peg);
158 :     push(@$html,"unlocked $peg<br>\n");
159 :     }
160 :     }
161 :     }
162 :     &show_subsystem($fig,$cgi,$html,$subsys,$user);
163 :     }
164 :     else
165 :     {
166 :     &show_subsystem($fig,$cgi,$html,$subsys,$user);
167 :     }
168 :    
169 :     &HTML::show_page($cgi,$html);
170 :    
171 :     sub format_ssa_table {
172 :     my($cgi,$html,$ssaP) = @_;
173 :    
174 :     push(@$html, $cgi->start_form(-action => "lock_subsys.cgi",
175 :     -method => 'post'),
176 :     $cgi->hidden(-name => 'user', -value=>$user),
177 :     $cgi->scrolling_list( -name => 'subsystem',
178 :     -values => [ map { $_->[0] } @$ssaP ],
179 :     -size => 10
180 :     ),
181 :     $cgi->br,
182 :     $cgi->submit( 'Pick One' ),
183 :     $cgi->end_form
184 :     );
185 :     }
186 :    
187 :     sub existing_subsystem_annotations {
188 :     my($user) = @_;
189 :    
190 :     my($ssa,$name);
191 :     my @ssa = ();
192 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
193 :     {
194 :     @ssa = grep { $_->[1] =~ s/^master://; $_->[1] eq $user }
195 :     map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,$fig->subsystem_curator($ssa)] }
196 :     grep { $_ !~ /^\./ }
197 :     readdir(SSA);
198 :     closedir(SSA);
199 :     }
200 :     return sort { $a->[0] cmp $b->[0] } @ssa;
201 :     }
202 :    
203 :     sub show_subsystem {
204 :     my($fig,$cgi,$html,$subsys,$user) = @_;
205 :    
206 :     push(@$html, $cgi->start_form(-action => "lock_subsys.cgi",
207 :     -method => 'post'),
208 :     $cgi->hidden(-name => 'subsystem', -value => $subsys),
209 :     $cgi->hidden(-name => 'user', -value => $user)
210 :     );
211 :    
212 :     my $format = $cgi->param('format');
213 :     if (! $format) { $format = 'concise' }
214 :    
215 :     my $subO = $fig->get_subsystem($subsys);
216 :    
217 :     push(@$html,$cgi->hr);
218 :     push(@$html,$cgi->h3('Reset Subsets'));
219 :     my @subset_names = sort $subO->get_subset_namesC;
220 :     my($active_subsetC,$active_subsetR);
221 :     $active_subsetC = ($cgi->param('active_subsetC') or $subO->get_active_subsetC );
222 :     if (@subset_names > 1)
223 :     {
224 :     push(@$html,$cgi->scrolling_list(-name => 'active_subsetC',
225 :     -values => [@subset_names],
226 :     -default => $active_subsetC
227 :     )
228 :     );
229 :     }
230 :     $active_subsetR = ($cgi->param('active_subsetR') or $subO->get_active_subsetR);
231 :     my @tmp = grep { $_ ne "All" } sort $subO->get_subset_namesR;
232 :     push(@$html,$cgi->scrolling_list(-name => 'active_subsetR',
233 :     -values => ["All",@tmp],
234 :     -default => $active_subsetR,
235 :     -size => 5
236 :     )
237 :     );
238 :     push(@$html,$cgi->hr);
239 :     my @colmem = $subO->get_subsetC($active_subsetC);
240 :     # print &Dumper($subO->get_role($colmem[0]),$subO->get_role_abbr($colmem[0]));
241 :     my @rowmem = $subO->get_subsetR($active_subsetR);
242 :     my @genomes = grep { $subO->get_variant_code_for_genome($_) !~ /^(0|-1)$/ } @rowmem;
243 :     # print &Dumper(\@genomes,$active_subsetR); die "aborted";
244 :    
245 :     my $col_hdrs = ['','Abbrev','Role'];
246 :     my $tab = [];
247 :     my $i;
248 :     for ($i=1; ($i <= @colmem); $i++)
249 :     {
250 :     push(@$tab,[$i,$subO->get_role_abbr($colmem[$i-1]),$subO->get_role($colmem[$i-1])]);
251 :     }
252 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Roles"));
253 :     push(@$html,$cgi->hr,"Reset format<br>");
254 :    
255 :     push(@$html,$cgi->radio_group(-name => 'format',
256 :     -values => ['concise','show pegs'],
257 :     -default => $format,
258 :     -override => 1
259 :     ));
260 :     $col_hdrs = ['Genome','genus species','variant'];
261 :     $tab = [];
262 :     for ($i=1; ($i <= @colmem); $i++)
263 :     {
264 :     push(@$col_hdrs,($format eq "concise") ? $i : $subO->get_role_abbr($colmem[$i]));
265 :     }
266 :    
267 :     foreach my $genome (@genomes)
268 :     {
269 :     my $genome_idx = $subO->get_genome_index($genome);
270 :     my $row = [$genome,$fig->genus_species($genome),$subO->get_variant_code($genome_idx)];
271 :     foreach my $role_idx (@colmem)
272 :     {
273 :     my $cell = $subO->get_cell($genome_idx,$role_idx);
274 :     my @tuples = map { [$_,$fig->is_locked_fid($_)] } @$cell;
275 :     my @locks = ();
276 :     for ($i=0;($i < @tuples); $i++)
277 :     {
278 :     my $url = &HTML::fid_link($cgi,$tuples[$i]->[0],0,1);
279 :     my($val,$link);
280 :     if ($format eq "concise")
281 :     {
282 :     $val = ($tuples[$i]->[1]) ? "+" : "-";
283 :     $link = $val;
284 :     }
285 :     else
286 :     {
287 :     $tuples[$i]->[0] =~ /(\d+)$/;
288 :     $val = ($tuples[$i]->[1]) ? "+$1" : "-$1";
289 :     $link = "<a href=$url>$val</a>";
290 :     }
291 :     push(@locks,$link);
292 :     }
293 :     push(@$row,join("<br>",@locks));
294 :     }
295 :     push(@$tab,$row);
296 :     }
297 :    
298 :     my $sort = $cgi->param('sort') || 'by_phylo';
299 :     if ($sort eq "by_pattern")
300 :     {
301 :     my @tmp = ();
302 :     my $row;
303 :     foreach $row (@$tab)
304 :     {
305 :     my @var = ();
306 :     my $i;
307 :     for ($i=3; ($i < @$row); $i++)
308 :     {
309 :     push(@var, $row->[$i] ? 1 : 0);
310 :     }
311 :     push(@tmp,[join("",@var),$row]);
312 :     }
313 :     $tab = [map { $_->[1] } sort { $a->[0] cmp $b->[0] } @tmp];
314 :     }
315 :     elsif ($sort eq "by_phylo")
316 :     {
317 :     $tab = [map { $_->[0] }
318 :     sort { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
319 :     map { [$_, $fig->taxonomy_of($_->[0])] }
320 :     @$tab];
321 :     }
322 :     elsif ($sort eq "alphabetic")
323 :     {
324 :     $tab = [sort { ($a->[1] cmp $b->[1]) or ($a->[0] <=> $b->[0]) } @$tab];
325 :     }
326 :     elsif ($sort eq "by_variant")
327 :     {
328 :     $tab = [sort { ($a->[2] cmp $b->[2]) or ($a->[1] <=> $b->[1]) } @$tab];
329 :     }
330 :    
331 :     push(@$html,&HTML::make_table($col_hdrs,$tab,'Spreadsheet'));
332 :     my %sortmenu = (
333 :     alphabetic => "Alphabetical",
334 :     by_pattern => "Patterns",
335 :     by_phylo => "Phylogeny",
336 :     by_variant => "Variant Code",
337 :     );
338 :    
339 :     push @$html, $cgi->hr,
340 :     "Sort spreadsheet genomes by ",
341 :     $cgi->popup_menu( -name => 'sort',
342 :     -values => [sort keys %sortmenu],
343 :     -labels => \%sortmenu,
344 :     -default => $sort,
345 :     -override => 1
346 :     );
347 :    
348 :     push(@$html,$cgi->hr,
349 :     $cgi->submit('show again, after setting/uynsetting locks and parameters')
350 :     );
351 :    
352 :     my @orgs = map { "$_->[0]: " . $_->[1] }
353 :     map { [$_,$fig->genus_species($_)] }
354 :     grep { $subO->get_variant_code($subO->get_genome_index($_)) ne "-1" }
355 :     map { $_->[0] } @$tab;
356 :    
357 :     my @roles = map { $subO->get_role($_) } @colmem;
358 :    
359 :     push(@$html,$cgi->hr,$cgi->h1('Lock PEGs in Cells'));
360 :     push(@$html, $cgi->scrolling_list( -name => 'genome_to_lock',
361 :     -values => [ @orgs ],
362 :     -size => 10,
363 :     -multiple => 1
364 : overbeek 1.2 ),
365 :     $cgi->checkbox(-name => 'select_all_genomes', -value => 1, -checked => 0, -override => 1,
366 :     -label => 'select all genomes'),
367 :     "<br>",
368 : overbeek 1.1 $cgi->scrolling_list( -name => 'roles_to_lock',
369 :     -values => [ @roles ],
370 :     -size => 10,
371 :     -multiple => 1
372 : overbeek 1.2 ),
373 :     $cgi->checkbox(-name => 'select_all_roles', -value => 1, -checked => 0, -override => 1,
374 :     -label => 'select all roles'),
375 :     "<br>");
376 : overbeek 1.1
377 :     push(@$html,$cgi->submit('lock annotations')," OR ");
378 :     push(@$html,$cgi->submit('unlock annotations'),$cgi->br);
379 :     push(@$html,$cgi->end_form);
380 :     }
381 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3