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

Annotation of /FigWebServices/lock_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 :     my @orgs = $cgi->param('genome_to_lock');
91 :     @orgs = map { $_ =~ /^(\d+\.\d+)/; $1 } @orgs;
92 :     my @roles = $cgi->param('roles_to_lock');
93 :     push(@$html,"<br>");
94 :    
95 :     foreach my $genome (@orgs)
96 :     {
97 :     foreach my $role (@roles)
98 :     {
99 :     foreach my $peg ($fig->pegs_in_subsystem_cell($subsys,$genome,$role))
100 :     {
101 :     $user =~ s/master://;
102 :     $fig->lock_fid($user,$peg);
103 :     push(@$html,"locked $peg<br>\n");
104 :     }
105 :     }
106 :     }
107 :     &show_subsystem($fig,$cgi,$html,$subsys,$user);
108 :     }
109 :     elsif ($cgi->param('unlock annotations'))
110 :     {
111 :     my @orgs = $cgi->param('genome_to_lock');
112 :     @orgs = map { $_ =~ /^(\d+\.\d+)/; $1 } @orgs;
113 :     my @roles = $cgi->param('roles_to_lock');
114 :     push(@$html,"<br>");
115 :    
116 :     foreach my $genome (@orgs)
117 :     {
118 :     foreach my $role (@roles)
119 :     {
120 :     foreach my $peg ($fig->pegs_in_subsystem_cell($subsys,$genome,$role))
121 :     {
122 :     $user =~ s/master://;
123 :     $fig->unlock_fid($user,$peg);
124 :     push(@$html,"unlocked $peg<br>\n");
125 :     }
126 :     }
127 :     }
128 :     &show_subsystem($fig,$cgi,$html,$subsys,$user);
129 :     }
130 :     else
131 :     {
132 :     &show_subsystem($fig,$cgi,$html,$subsys,$user);
133 :     }
134 :    
135 :     &HTML::show_page($cgi,$html);
136 :    
137 :     sub format_ssa_table {
138 :     my($cgi,$html,$ssaP) = @_;
139 :    
140 :     push(@$html, $cgi->start_form(-action => "lock_subsys.cgi",
141 :     -method => 'post'),
142 :     $cgi->hidden(-name => 'user', -value=>$user),
143 :     $cgi->scrolling_list( -name => 'subsystem',
144 :     -values => [ map { $_->[0] } @$ssaP ],
145 :     -size => 10
146 :     ),
147 :     $cgi->br,
148 :     $cgi->submit( 'Pick One' ),
149 :     $cgi->end_form
150 :     );
151 :     }
152 :    
153 :     sub existing_subsystem_annotations {
154 :     my($user) = @_;
155 :    
156 :     my($ssa,$name);
157 :     my @ssa = ();
158 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
159 :     {
160 :     @ssa = grep { $_->[1] =~ s/^master://; $_->[1] eq $user }
161 :     map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,$fig->subsystem_curator($ssa)] }
162 :     grep { $_ !~ /^\./ }
163 :     readdir(SSA);
164 :     closedir(SSA);
165 :     }
166 :     return sort { $a->[0] cmp $b->[0] } @ssa;
167 :     }
168 :    
169 :     sub show_subsystem {
170 :     my($fig,$cgi,$html,$subsys,$user) = @_;
171 :    
172 :     push(@$html, $cgi->start_form(-action => "lock_subsys.cgi",
173 :     -method => 'post'),
174 :     $cgi->hidden(-name => 'subsystem', -value => $subsys),
175 :     $cgi->hidden(-name => 'user', -value => $user)
176 :     );
177 :    
178 :     my $format = $cgi->param('format');
179 :     if (! $format) { $format = 'concise' }
180 :    
181 :     my $subO = $fig->get_subsystem($subsys);
182 :    
183 :     push(@$html,$cgi->hr);
184 :     push(@$html,$cgi->h3('Reset Subsets'));
185 :     my @subset_names = sort $subO->get_subset_namesC;
186 :     my($active_subsetC,$active_subsetR);
187 :     $active_subsetC = ($cgi->param('active_subsetC') or $subO->get_active_subsetC );
188 :     if (@subset_names > 1)
189 :     {
190 :     push(@$html,$cgi->scrolling_list(-name => 'active_subsetC',
191 :     -values => [@subset_names],
192 :     -default => $active_subsetC
193 :     )
194 :     );
195 :     }
196 :     $active_subsetR = ($cgi->param('active_subsetR') or $subO->get_active_subsetR);
197 :     my @tmp = grep { $_ ne "All" } sort $subO->get_subset_namesR;
198 :     push(@$html,$cgi->scrolling_list(-name => 'active_subsetR',
199 :     -values => ["All",@tmp],
200 :     -default => $active_subsetR,
201 :     -size => 5
202 :     )
203 :     );
204 :     push(@$html,$cgi->hr);
205 :     my @colmem = $subO->get_subsetC($active_subsetC);
206 :     # print &Dumper($subO->get_role($colmem[0]),$subO->get_role_abbr($colmem[0]));
207 :     my @rowmem = $subO->get_subsetR($active_subsetR);
208 :     my @genomes = grep { $subO->get_variant_code_for_genome($_) !~ /^(0|-1)$/ } @rowmem;
209 :     # print &Dumper(\@genomes,$active_subsetR); die "aborted";
210 :    
211 :     my $col_hdrs = ['','Abbrev','Role'];
212 :     my $tab = [];
213 :     my $i;
214 :     for ($i=1; ($i <= @colmem); $i++)
215 :     {
216 :     push(@$tab,[$i,$subO->get_role_abbr($colmem[$i-1]),$subO->get_role($colmem[$i-1])]);
217 :     }
218 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Roles"));
219 :     push(@$html,$cgi->hr,"Reset format<br>");
220 :    
221 :     push(@$html,$cgi->radio_group(-name => 'format',
222 :     -values => ['concise','show pegs'],
223 :     -default => $format,
224 :     -override => 1
225 :     ));
226 :     $col_hdrs = ['Genome','genus species','variant'];
227 :     $tab = [];
228 :     for ($i=1; ($i <= @colmem); $i++)
229 :     {
230 :     push(@$col_hdrs,($format eq "concise") ? $i : $subO->get_role_abbr($colmem[$i]));
231 :     }
232 :    
233 :     foreach my $genome (@genomes)
234 :     {
235 :     my $genome_idx = $subO->get_genome_index($genome);
236 :     my $row = [$genome,$fig->genus_species($genome),$subO->get_variant_code($genome_idx)];
237 :     foreach my $role_idx (@colmem)
238 :     {
239 :     my $cell = $subO->get_cell($genome_idx,$role_idx);
240 :     my @tuples = map { [$_,$fig->is_locked_fid($_)] } @$cell;
241 :     my @locks = ();
242 :     for ($i=0;($i < @tuples); $i++)
243 :     {
244 :     my $url = &HTML::fid_link($cgi,$tuples[$i]->[0],0,1);
245 :     my($val,$link);
246 :     if ($format eq "concise")
247 :     {
248 :     $val = ($tuples[$i]->[1]) ? "+" : "-";
249 :     $link = $val;
250 :     }
251 :     else
252 :     {
253 :     $tuples[$i]->[0] =~ /(\d+)$/;
254 :     $val = ($tuples[$i]->[1]) ? "+$1" : "-$1";
255 :     $link = "<a href=$url>$val</a>";
256 :     }
257 :     push(@locks,$link);
258 :     }
259 :     push(@$row,join("<br>",@locks));
260 :     }
261 :     push(@$tab,$row);
262 :     }
263 :    
264 :     my $sort = $cgi->param('sort') || 'by_phylo';
265 :     if ($sort eq "by_pattern")
266 :     {
267 :     my @tmp = ();
268 :     my $row;
269 :     foreach $row (@$tab)
270 :     {
271 :     my @var = ();
272 :     my $i;
273 :     for ($i=3; ($i < @$row); $i++)
274 :     {
275 :     push(@var, $row->[$i] ? 1 : 0);
276 :     }
277 :     push(@tmp,[join("",@var),$row]);
278 :     }
279 :     $tab = [map { $_->[1] } sort { $a->[0] cmp $b->[0] } @tmp];
280 :     }
281 :     elsif ($sort eq "by_phylo")
282 :     {
283 :     $tab = [map { $_->[0] }
284 :     sort { ($a->[1] cmp $b->[1]) or ($a->[0]->[1] cmp $b->[0]->[1]) }
285 :     map { [$_, $fig->taxonomy_of($_->[0])] }
286 :     @$tab];
287 :     }
288 :     elsif ($sort eq "alphabetic")
289 :     {
290 :     $tab = [sort { ($a->[1] cmp $b->[1]) or ($a->[0] <=> $b->[0]) } @$tab];
291 :     }
292 :     elsif ($sort eq "by_variant")
293 :     {
294 :     $tab = [sort { ($a->[2] cmp $b->[2]) or ($a->[1] <=> $b->[1]) } @$tab];
295 :     }
296 :    
297 :     push(@$html,&HTML::make_table($col_hdrs,$tab,'Spreadsheet'));
298 :     my %sortmenu = (
299 :     alphabetic => "Alphabetical",
300 :     by_pattern => "Patterns",
301 :     by_phylo => "Phylogeny",
302 :     by_variant => "Variant Code",
303 :     );
304 :    
305 :     push @$html, $cgi->hr,
306 :     "Sort spreadsheet genomes by ",
307 :     $cgi->popup_menu( -name => 'sort',
308 :     -values => [sort keys %sortmenu],
309 :     -labels => \%sortmenu,
310 :     -default => $sort,
311 :     -override => 1
312 :     );
313 :    
314 :     push(@$html,$cgi->hr,
315 :     $cgi->submit('show again, after setting/uynsetting locks and parameters')
316 :     );
317 :    
318 :     my @orgs = map { "$_->[0]: " . $_->[1] }
319 :     map { [$_,$fig->genus_species($_)] }
320 :     grep { $subO->get_variant_code($subO->get_genome_index($_)) ne "-1" }
321 :     map { $_->[0] } @$tab;
322 :    
323 :     my @roles = map { $subO->get_role($_) } @colmem;
324 :    
325 :     push(@$html,$cgi->hr,$cgi->h1('Lock PEGs in Cells'));
326 :     push(@$html, $cgi->scrolling_list( -name => 'genome_to_lock',
327 :     -values => [ @orgs ],
328 :     -size => 10,
329 :     -multiple => 1
330 :     ),<br>,
331 :     $cgi->scrolling_list( -name => 'roles_to_lock',
332 :     -values => [ @roles ],
333 :     -size => 10,
334 :     -multiple => 1
335 :     ),"<br>");
336 :    
337 :     push(@$html,$cgi->submit('lock annotations')," OR ");
338 :     push(@$html,$cgi->submit('unlock annotations'),$cgi->br);
339 :     push(@$html,$cgi->end_form);
340 :     }
341 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3