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

Annotation of /FigWebServices/check_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.22 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 : olson 1.10 #
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/check_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/check_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 : overbeek 1.19 my $user = $cgi->param('user');
64 :     $user =~ s/master://;
65 :    
66 : overbeek 1.1 if (! $subsys)
67 :     {
68 : overbeek 1.19 if ($cgi->param('request') eq "check_summary")
69 : overbeek 1.1 {
70 : overbeek 1.19 &check_summary($fig,$cgi,$html,$user);
71 : overbeek 1.1 }
72 :     else
73 :     {
74 : overbeek 1.19 my @ssa = &existing_subsystem_annotations;
75 :    
76 :     if (@ssa > 0)
77 :     {
78 :     &format_ssa_table($cgi,$html,\@ssa);
79 :     }
80 :     else
81 :     {
82 :     push(@$html,$cgi->h1('Sorry, no subsystems defined'));
83 :     }
84 : overbeek 1.1 }
85 :     }
86 :     elsif ($subsys && ($cgi->param('request') eq "check_ssa"))
87 :     {
88 :     &check_subsystem($cgi,$fig,$html,$subsys);
89 :     }
90 :     &HTML::show_page($cgi,$html);
91 :    
92 :     sub format_ssa_table {
93 :     my($cgi,$html,$ssaP) = @_;
94 :    
95 : overbeek 1.2 my $user = $cgi->param('user');
96 :     $user = $user ? $user : "";
97 : overbeek 1.1 push(@$html, $cgi->start_form(-action => "check_subsys.cgi",
98 :     -method => 'post'),
99 :     $cgi->hidden(-name => 'request', -value => 'check_ssa', -override => 1),
100 : overbeek 1.2 $cgi->hidden(-name => 'user', -value => "$user", -override => 1),
101 : overbeek 1.1 $cgi->scrolling_list( -name => 'subsystem',
102 :     -values => [ map { $_->[0] } @$ssaP ],
103 :     -size => 10
104 :     ),
105 :     $cgi->br,
106 :     $cgi->submit( 'Pick One' ),
107 :     $cgi->end_form
108 :     );
109 :     }
110 :    
111 :     sub existing_subsystem_annotations {
112 :     my($ssa,$name);
113 :     my @ssa = ();
114 :     if (opendir(SSA,"$FIG_Config::data/Subsystems"))
115 :     {
116 :     @ssa = map { $ssa = $_; $name = $ssa; $ssa =~ s/[ \/]/_/g; [$name,&curator($ssa)] } grep { $_ !~ /^\./ } readdir(SSA);
117 :     closedir(SSA);
118 :     }
119 :     return sort { $a->[0] cmp $b->[0] } @ssa;
120 :     }
121 :    
122 :     sub curator {
123 :     my($ssa) = @_;
124 :     my($who) = "";
125 :    
126 :     if (open(DATA,"<$FIG_Config::data/Subsystems/$ssa/curation.log"))
127 :     {
128 :     $_ = <DATA>;
129 :     if ($_ =~ /^\d+\t(\S+)\s+started/)
130 :     {
131 :     $who = $1;
132 :     }
133 :     close(DATA);
134 :     }
135 :     return $who;
136 :     }
137 :    
138 :     sub check_subsystem {
139 :     my($cgi,$fig,$html,$subsys) = @_;
140 : redwards 1.4 my($col_hdrs1,$col_hdrs2,$tab1,$tab2,$x);
141 : overbeek 1.1
142 : redwards 1.4 my $user=$cgi->param('user');
143 : overbeek 1.21 my @raw_output = &get_check_data($cgi,$subsys,$fig);
144 : overbeek 1.12
145 :     # my @raw_output = &FIG::run_gathering_output("$FIG_Config::bin/check_subsystems", $subsys);
146 : overbeek 1.11 # warn "Got raw output @raw_output\n";
147 : olson 1.9 my @checked = map { chop; [split(/\t/,$_)] } @raw_output;
148 : overbeek 1.13
149 : redwards 1.4 # RAE: it only makes sense to have Assign Role in column 1, so I duplicate this instead of leaving the column empty. Blah.
150 : redwards 1.6 $col_hdrs1 = ["PEG","Function","Role","Assign Role","Other Subsystems","Genome"];
151 : redwards 1.4 $col_hdrs2 = ["PEG","Function","Role","Other Subsystems","Genome"];
152 : overbeek 1.1 $tab1 = [];
153 :     $tab2 = [];
154 :    
155 :     foreach $x (@checked)
156 :     {
157 : overbeek 1.12 if ($x->[1] =~ /^(mismatch|left-out)/)
158 : overbeek 1.1 {
159 : overbeek 1.12 my(undef,$code,$peg,$func,$role,$gs) = @$x;
160 : overbeek 1.16 next if (! $fig->is_real_feature($peg));
161 :     next if ($func ne scalar $fig->function_of($peg));
162 : overbeek 1.22 next if (($code eq "mismatch") && (&still_left_out($fig,$peg,$subsys)));
163 : overbeek 1.17 next if (($code eq "left-out") && (! &still_left_out($fig,$peg,$subsys)));
164 : overbeek 1.16
165 : overbeek 1.12 #RAE added the other subsystems column to the table
166 :     my $othersubsys='';
167 :     if (my @otherss = $fig->subsystems_for_peg($peg))
168 :     {
169 :     foreach my $ssr (@otherss)
170 :     {
171 :     next if ($$ssr[0] eq $subsys);
172 :     $othersubsys .= $cgi->a({href => "subsys.cgi?user=$user&ssa_name=" . $$ssr[0] . "&request=show_ssa"}, $$ssr[0]) . "<br\n";
173 :     }
174 :     }
175 :     my $link = &HTML::fid_link($cgi,$peg);
176 :     my $checkbox=$cgi->checkbox(-name=>"checked", -label=>'', -value=>"to=$peg,from=$role");
177 :     if ($code eq "mismatch")
178 :     {
179 :     push(@$tab1,[$link,$func,$role,$checkbox,$othersubsys,$gs]);
180 :     }
181 :     elsif ($code eq 'left-out')
182 :     {
183 :     push(@$tab2,[$link,$func,$role,$othersubsys,$gs]);
184 :     }
185 : overbeek 1.1 }
186 :     }
187 : redwards 1.4
188 :     # RAE addd the form controls
189 :     push(@$html, $cgi->start_form( -method => 'post', -action => 'fid_checked.cgi', -name => 'fid_checked'), $cgi->hidden(-name => 'user', -value => $user));
190 :     push(@$html,&HTML::make_table($col_hdrs1,$tab1,"PEGs IN Subsystem with MISMATCHING Functions"));
191 : redwards 1.5
192 : redwards 1.6 push(@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);
193 : redwards 1.7 push(@$html, $cgi->submit(-name=>'batch_assign', -label=>"Assign Roles to Selected PEGs"));
194 : overbeek 1.2 push(@$html,$cgi->hr,$cgi->br,$cgi->br);
195 :    
196 : redwards 1.4 push(@$html,&HTML::make_table($col_hdrs2,$tab2,"PEGs NOT in Subsystem with MATCHING Functions"));
197 : overbeek 1.8 push(@$html,$cgi->end_form);
198 : overbeek 1.13
199 :     my $col_hdrs3 = ['Genome','Genus and Species','Possible Variant Codes','Detected Roles'];
200 :     my $tab3 = [];
201 : overbeek 1.16
202 :     my $sobj = $fig->get_subsystem($subsys);
203 :     my %genomes_in_sub = map { $_ => 1 } $sobj->get_genomes;
204 :     my @to_add = grep { ($_->[1] eq 'maybe-add') && (! $genomes_in_sub{$_->[4]}) } @checked;
205 : overbeek 1.13
206 :     my($entry,$vcodes,$genome,$gs,@roles);
207 : overbeek 1.15 foreach $entry (sort { $a->[5] cmp $b->[5] } @to_add)
208 : overbeek 1.13 {
209 :     (undef,undef,undef,$vcodes,$genome,$gs,@roles) = @$entry;
210 :     push(@$tab3,[$genome,$gs,$vcodes,join("<br>",@roles)]);
211 :     }
212 :     push(@$html,&HTML::make_table($col_hdrs3,$tab3,"Genomes that Should Be Considered For Addition"));
213 :     }
214 :    
215 : overbeek 1.12 sub get_check_data {
216 : overbeek 1.21 my($cgi,$subsys,$fig) = @_;
217 : overbeek 1.12 my @raw_output;
218 :    
219 :     if ($cgi->param('fast') && (-e "$FIG_Config::data/Subsystems/$subsys/warnings"))
220 :     {
221 : overbeek 1.21 @raw_output = $fig->file_read("$FIG_Config::data/Subsystems/$subsys/warnings");
222 : overbeek 1.12 }
223 :     else
224 :     {
225 :     @raw_output = &FIG::run_gathering_output("$FIG_Config::bin/check_subsystems", $subsys);
226 :     # warn "Got raw output @raw_output\n";
227 :     }
228 :     return @raw_output;
229 :     }
230 :    
231 : overbeek 1.17 sub still_left_out {
232 : overbeek 1.18 my($fig,$peg,$sub) = @_;
233 : overbeek 1.17
234 :     my @subs = $fig->peg_to_subsystems($peg);
235 :     my $i;
236 :     for ($i=0; ($i < @subs) && ($sub ne $subs[$i]); $i++) {}
237 :     return ($i == @subs);
238 :     }
239 : overbeek 1.19
240 :     sub check_summary {
241 :     my($fig,$cgi,$html,$user) = @_;
242 :    
243 :     my $col_hdrs = ["Subsystem","Last Check Computed","Mismatching Entries","Missing Entries","Genomes to Add"];
244 :     my $tab = [];
245 :     my @subs = ();
246 :     foreach my $sub ($fig->all_subsystems)
247 :     {
248 :     my $curr = $fig->subsystem_curator($sub);
249 :     $curr =~ s/^master://;
250 :     if (($curr eq $user) &&
251 :     (-e "$FIG_Config::data/Subsystems/$sub/warnings"))
252 :     {
253 :     push(@subs,$sub);
254 :     }
255 :     }
256 :     foreach my $sub (@subs)
257 :     {
258 :     my $ts = localtime($^T - ((-M "$FIG_Config::data/Subsystems/$sub/warnings") * 24 * 60 * 60));
259 : overbeek 1.21 my @tmp = $fig->file_read("$FIG_Config::data/Subsystems/$sub/warnings");
260 : overbeek 1.19 my @mismatches = grep { ($_ =~ /mismatch\t(\S+)\t([^\t]+)/) } @tmp;
261 :     my $mismatchesN = (@mismatches > 0) ? @mismatches : 0;
262 :     my @left_out = grep { ($_ =~ /left-out\t(\S+)\t([^\t]+)/) } @tmp;
263 :     my $left_outN = (@left_out > 0) ? @left_out : 0;
264 :     my @maybe_add = grep { ($_ =~ /maybe-add\t[^\t]+\t[^\t]+\t(\d+\.\d+)/) } @tmp;
265 :     my $maybe_addN = (@maybe_add > 0) ? @maybe_add : 0;
266 : overbeek 1.20 push(@$tab,[&sub_link($cgi,$sub,$user),$ts,$mismatchesN,$left_outN,$maybe_addN]);
267 : overbeek 1.19 }
268 :     push(@$html,$cgi->h3("Note that the following statistics do not take into account actions since last check"),
269 :     &HTML::make_table($col_hdrs,$tab,"Summary of Possible Things to Check"));
270 :     }
271 : overbeek 1.20
272 :     sub sub_link {
273 :     my($cgi,$sub,$user) = @_;
274 :     my $url = &FIG::cgi_url . "/subsys.cgi?request=show_ssa&user=master:$user&ssa_name=$sub&can_alter=1&check=1";
275 :     my $target = "window$$";
276 :     return "<a href=$url target=$target>$sub</a>";
277 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3