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

Annotation of /FigWebServices/set_variants.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 : olson 1.3 #
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 : overbeek 1.1
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/extend_ssa_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/extend_ssa_parms"))
52 :     {
53 :     print TMP &Dumper($cgi);
54 :     close(TMP);
55 :     }
56 :     }
57 :     exit;
58 :     }
59 :     my($genome);
60 :    
61 :     my $html = [];
62 :     my $subsys = $cgi->param('subsystem');
63 :     if (! $subsys)
64 :     {
65 :     my @ssa = &existing_subsystem_annotations;
66 :    
67 :     if (@ssa > 0)
68 :     {
69 :     &format_ssa_table($cgi,$html,\@ssa);
70 :     }
71 :     else
72 :     {
73 :     push(@$html,$cgi->h1('Sorry, no subsystems defined'));
74 :     }
75 :     }
76 :     elsif ($subsys && ($cgi->param('request') eq "show_variants"))
77 :     {
78 :     &show_variants($cgi,$fig,$html,$subsys);
79 :     }
80 :     elsif ($subsys && ($cgi->param('request') eq "set_variants"))
81 :     {
82 :     &set_variants($cgi,$fig,$html,$subsys);
83 :     }
84 :     else
85 :     {
86 :     push(@$html,$cgi->h1('invalid parameters'));
87 :     }
88 :    
89 :     &HTML::show_page($cgi,$html);
90 :    
91 :     sub format_ssa_table {
92 :     my($cgi,$html,$ssaP) = @_;
93 :    
94 :     push(@$html, $cgi->start_form(-action => "set_variants.cgi",
95 :     -method => 'post'),
96 :     $cgi->hidden(-name => 'request', -value => 'show_variants', -override => 1),
97 :     $cgi->scrolling_list( -name => 'subsystem',
98 :     -values => [ map { $_->[0] } @$ssaP ],
99 :     -size => 10
100 :     ),
101 :     $cgi->br,
102 :     $cgi->submit( 'Pick One' ),
103 :     $cgi->end_form
104 :     );
105 :     }
106 :    
107 :     sub existing_subsystem_annotations {
108 :     my($ssa,$name);
109 :     my @ssa = ();
110 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
111 :     {
112 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
113 :     closedir(SSA);
114 :     }
115 :     return sort { $a->[0] cmp $b->[0] } @ssa;
116 :     }
117 :    
118 :     sub curator {
119 :     my($ssa) = @_;
120 :     my($who) = "";
121 :    
122 :     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
123 :     {
124 :     $_ = <DATA>;
125 :     if ($_ =~ /^\d+\t(\S+)\s+started/)
126 :     {
127 :     $who = $1;
128 :     }
129 :     close(DATA);
130 :     }
131 :     return $who;
132 :     }
133 :    
134 :     sub show_variants {
135 :     my($cgi,$fig,$html,$subsys) = @_;
136 :    
137 :     my $sub = $fig->get_subsystem($subsys);
138 :     my @genomes = $sub->get_genomes;
139 :     my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
140 :     my @roles = $sub->get_roles;
141 :    
142 :     my $abbrev = &format_roles($fig,$cgi,$html,$sub);
143 :    
144 :     my(@has,$role,%has_filled);
145 :     foreach $genome (@genomes)
146 :     {
147 :    
148 :     next if (! &ok_variant($variant_codes{$genome}));
149 :     @has = ();
150 :     foreach $role (@roles)
151 :     {
152 :     push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
153 :     }
154 : overbeek 1.2 $has_filled{join(",",@has)}->{$variant_codes{$genome}}++;
155 : overbeek 1.1 }
156 :    
157 :     my($col_hdrs,$tab,$pattern);
158 : overbeek 1.2 $col_hdrs = ["Pattern","# Genomes with Pattern","Existing Variant Code","Set To"];
159 : overbeek 1.1 $tab = [];
160 :     foreach $pattern (sort keys(%has_filled))
161 :     {
162 :     my @codes = keys(%{$has_filled{$pattern}});
163 :     my $code;
164 : golsen 1.4 my $nrow = @codes;
165 : overbeek 1.1 if (@codes > 0)
166 :     {
167 :     $code = shift @codes;
168 : golsen 1.4 push( @$tab, [ [ $pattern, "td rowspan=$nrow"],
169 :     $has_filled{$pattern}->{$code},
170 :     $code,
171 :     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
172 :     ]);
173 : overbeek 1.1 }
174 : golsen 1.4
175 : overbeek 1.1 foreach $code (@codes)
176 :     {
177 : golsen 1.4 push(@$tab,[$has_filled{$pattern}->{$code},
178 : overbeek 1.1 $code,
179 :     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
180 :     ]);
181 :     }
182 :     }
183 :     push(@$html,$cgi->start_form(-action => 'set_variants.cgi',-method => 'post'),
184 :     &HTML::make_table($col_hdrs,$tab,"Existing Patterns and Variant Codes"),
185 :     $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1),
186 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
187 :     $cgi->hr,
188 :     $cgi->submit(-name => "set_variants", -value => "Set Variants")
189 :     );
190 :     }
191 :    
192 :    
193 :     sub format_roles {
194 :     my($fig,$cgi,$html,$subsystem) = @_;
195 :     my($i);
196 :    
197 :     my $abbrevP = {};
198 :     my $col_hdrs = ["Column","Abbrev","Functional Role"];
199 :     my $tab = [];
200 :    
201 :     my $n = 1;
202 :     &format_existing_roles($fig,$cgi,$html,$subsystem,$tab,\$n,$abbrevP);
203 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Functional Roles"),
204 :     $cgi->hr
205 :     );
206 :     return $abbrevP;
207 :     }
208 :    
209 :     sub format_existing_roles {
210 :     my($fig,$cgi,$html,$subsystem,$tab,$nP,$abbrevT) = @_;
211 :     my($role);
212 :    
213 :     foreach $role ($subsystem->get_roles)
214 :     {
215 :     &format_role($fig,$cgi,$html,$subsystem,$tab,$nP,$role,$abbrevT);
216 :     $$nP++;
217 :     }
218 :     }
219 :    
220 :     sub format_role {
221 :     my($fig,$cgi,$html,$subsystem,$tab,$nP,$role,$abbrevP) = @_;
222 :     my($abbrev);
223 :    
224 :     my $i = $subsystem->get_role_index($role);
225 :     $abbrev = $role ? $subsystem->get_role_abbr($i) : "";
226 :     $abbrevP->{$role} = $abbrev;
227 :     push(@$tab,[$$nP,$abbrev,$role]);
228 :     }
229 :    
230 :    
231 :     sub ok_variant {
232 :     my($variant) = @_;
233 :    
234 :     return 1; # (defined($variant) && ($variant ne "-1"));
235 :     }
236 :    
237 :     sub set_variants {
238 :     my($cgi,$fig,$html,$subsys) = @_;
239 :     my $param;
240 :    
241 :     my $sub = $fig->get_subsystem($subsys);
242 :     my @genomes = $sub->get_genomes;
243 :    
244 :     my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
245 :     my @roles = $sub->get_roles;
246 :    
247 :     my $abbrev = &format_roles($fig,$cgi,[],$sub);
248 :    
249 :     my(@has,$role,%genomes_with,$genome,$pattern,$x,$vc);
250 :     foreach $genome (@genomes)
251 :     {
252 :     my $vc = $variant_codes{$genome};
253 :     next if (! &ok_variant($vc));
254 :    
255 :     @has = ();
256 :     foreach $role (@roles)
257 :     {
258 :     push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
259 :     }
260 :     $pattern = join(",",@has);
261 :     push(@{$genomes_with{"$pattern,$vc"}}, $genome);
262 :     }
263 :    
264 :     my @params = grep { $_ =~ /^p:/ } $cgi->param;
265 :     foreach $param (@params)
266 :     {
267 :     if ($param =~ /^p:(.*):(.*)$/)
268 :     {
269 :     ($pattern,$vc) = ($1,$2);
270 :     $pattern =~ s/ //g;
271 :     $vc =~ s/ //g;
272 :     my $to = $cgi->param($param);
273 :     if ($x = $genomes_with{"$pattern,$vc"})
274 :     {
275 :     push(@$html,"<ul>\n");
276 :     foreach $genome (@$x)
277 :     {
278 :     if ($to ne $variant_codes{$genome})
279 :     {
280 :     my $old = $variant_codes{$genome};
281 :     my $gs = $fig->genus_species($genome);
282 :     push(@$html,"<li>resetting $genome $gs from $old to $to\n");
283 :     $sub->set_variant_code($sub->get_genome_index($genome),$to);
284 :     }
285 :     }
286 :     push(@$html,"</ul>");
287 :     }
288 :     }
289 :     }
290 :     $sub->write_subsystem();
291 :     push(@$html,$cgi->hr);
292 :    
293 :     &show_variants($cgi,$fig,$html,$subsys);
294 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3