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

Annotation of /FigWebServices/set_variants.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3