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

Annotation of /FigWebServices/set_variants.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3