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

Annotation of /FigWebServices/set_variants.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (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 :     $has_filled{join(",",@has)}->{$variant_codes{$genome}} = 1;
138 :     }
139 :    
140 :     my($col_hdrs,$tab,$pattern);
141 :     $col_hdrs = ["Pattern","Existing Variant Code","Set To"];
142 :     $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 :     $code,
152 :     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
153 :     ]);
154 :     }
155 :     foreach $code (@codes)
156 :     {
157 :     push(@$tab,["&nbsp;",
158 :     $code,
159 :     $cgi->textfield(-name => "p:$pattern:$code", -size => 5, -value => $code, -override => 1)
160 :     ]);
161 :     }
162 :     }
163 :     push(@$html,$cgi->start_form(-action => 'set_variants.cgi',-method => 'post'),
164 :     &HTML::make_table($col_hdrs,$tab,"Existing Patterns and Variant Codes"),
165 :     $cgi->hidden(-name => 'request', -value => 'set_variants', -override => 1),
166 :     $cgi->hidden(-name => 'subsystem', -value => $subsys, -override => 1),
167 :     $cgi->hr,
168 :     $cgi->submit(-name => "set_variants", -value => "Set Variants")
169 :     );
170 :     }
171 :    
172 :    
173 :     sub format_roles {
174 :     my($fig,$cgi,$html,$subsystem) = @_;
175 :     my($i);
176 :    
177 :     my $abbrevP = {};
178 :     my $col_hdrs = ["Column","Abbrev","Functional Role"];
179 :     my $tab = [];
180 :    
181 :     my $n = 1;
182 :     &format_existing_roles($fig,$cgi,$html,$subsystem,$tab,\$n,$abbrevP);
183 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Functional Roles"),
184 :     $cgi->hr
185 :     );
186 :     return $abbrevP;
187 :     }
188 :    
189 :     sub format_existing_roles {
190 :     my($fig,$cgi,$html,$subsystem,$tab,$nP,$abbrevT) = @_;
191 :     my($role);
192 :    
193 :     foreach $role ($subsystem->get_roles)
194 :     {
195 :     &format_role($fig,$cgi,$html,$subsystem,$tab,$nP,$role,$abbrevT);
196 :     $$nP++;
197 :     }
198 :     }
199 :    
200 :     sub format_role {
201 :     my($fig,$cgi,$html,$subsystem,$tab,$nP,$role,$abbrevP) = @_;
202 :     my($abbrev);
203 :    
204 :     my $i = $subsystem->get_role_index($role);
205 :     $abbrev = $role ? $subsystem->get_role_abbr($i) : "";
206 :     $abbrevP->{$role} = $abbrev;
207 :     push(@$tab,[$$nP,$abbrev,$role]);
208 :     }
209 :    
210 :    
211 :     sub ok_variant {
212 :     my($variant) = @_;
213 :    
214 :     return 1; # (defined($variant) && ($variant ne "-1"));
215 :     }
216 :    
217 :     sub set_variants {
218 :     my($cgi,$fig,$html,$subsys) = @_;
219 :     my $param;
220 :    
221 :     my $sub = $fig->get_subsystem($subsys);
222 :     my @genomes = $sub->get_genomes;
223 :    
224 :     my %variant_codes = map { $_ => $sub->get_variant_code($sub->get_genome_index($_)) } @genomes;
225 :     my @roles = $sub->get_roles;
226 :    
227 :     my $abbrev = &format_roles($fig,$cgi,[],$sub);
228 :    
229 :     my(@has,$role,%genomes_with,$genome,$pattern,$x,$vc);
230 :     foreach $genome (@genomes)
231 :     {
232 :     my $vc = $variant_codes{$genome};
233 :     next if (! &ok_variant($vc));
234 :    
235 :     @has = ();
236 :     foreach $role (@roles)
237 :     {
238 :     push(@has,($sub->get_pegs_from_cell($genome,$role) > 0) ? $abbrev->{$role} : ());
239 :     }
240 :     $pattern = join(",",@has);
241 :     push(@{$genomes_with{"$pattern,$vc"}}, $genome);
242 :     }
243 :    
244 :     my @params = grep { $_ =~ /^p:/ } $cgi->param;
245 :     foreach $param (@params)
246 :     {
247 :     if ($param =~ /^p:(.*):(.*)$/)
248 :     {
249 :     ($pattern,$vc) = ($1,$2);
250 :     $pattern =~ s/ //g;
251 :     $vc =~ s/ //g;
252 :     my $to = $cgi->param($param);
253 :     if ($x = $genomes_with{"$pattern,$vc"})
254 :     {
255 :     push(@$html,"<ul>\n");
256 :     foreach $genome (@$x)
257 :     {
258 :     if ($to ne $variant_codes{$genome})
259 :     {
260 :     my $old = $variant_codes{$genome};
261 :     my $gs = $fig->genus_species($genome);
262 :     push(@$html,"<li>resetting $genome $gs from $old to $to\n");
263 :     $sub->set_variant_code($sub->get_genome_index($genome),$to);
264 :     }
265 :     }
266 :     push(@$html,"</ul>");
267 :     }
268 :     }
269 :     }
270 :     $sub->write_subsystem();
271 :     push(@$html,$cgi->hr);
272 :    
273 :     &show_variants($cgi,$fig,$html,$subsys);
274 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3