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

Annotation of /FigWebServices/check_subsys.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.19 - (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.12 my @raw_output = &get_check_data($cgi,$subsys);
144 :    
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.17 next if (($code eq "left-out") && (! &still_left_out($fig,$peg,$subsys)));
163 : overbeek 1.16
164 : overbeek 1.12 #RAE added the other subsystems column to the table
165 :     my $othersubsys='';
166 :     if (my @otherss = $fig->subsystems_for_peg($peg))
167 :     {
168 :     foreach my $ssr (@otherss)
169 :     {
170 :     next if ($$ssr[0] eq $subsys);
171 :     $othersubsys .= $cgi->a({href => "subsys.cgi?user=$user&ssa_name=" . $$ssr[0] . "&request=show_ssa"}, $$ssr[0]) . "<br\n";
172 :     }
173 :     }
174 :     my $link = &HTML::fid_link($cgi,$peg);
175 :     my $checkbox=$cgi->checkbox(-name=>"checked", -label=>'', -value=>"to=$peg,from=$role");
176 :     if ($code eq "mismatch")
177 :     {
178 :     push(@$tab1,[$link,$func,$role,$checkbox,$othersubsys,$gs]);
179 :     }
180 :     elsif ($code eq 'left-out')
181 :     {
182 :     push(@$tab2,[$link,$func,$role,$othersubsys,$gs]);
183 :     }
184 : overbeek 1.1 }
185 :     }
186 : redwards 1.4
187 :     # RAE addd the form controls
188 :     push(@$html, $cgi->start_form( -method => 'post', -action => 'fid_checked.cgi', -name => 'fid_checked'), $cgi->hidden(-name => 'user', -value => $user));
189 :     push(@$html,&HTML::make_table($col_hdrs1,$tab1,"PEGs IN Subsystem with MISMATCHING Functions"));
190 : redwards 1.5
191 : redwards 1.6 push(@$html, $cgi->br, &HTML::java_buttons("fid_checked", "checked"), $cgi->br);
192 : redwards 1.7 push(@$html, $cgi->submit(-name=>'batch_assign', -label=>"Assign Roles to Selected PEGs"));
193 : overbeek 1.2 push(@$html,$cgi->hr,$cgi->br,$cgi->br);
194 :    
195 : redwards 1.4 push(@$html,&HTML::make_table($col_hdrs2,$tab2,"PEGs NOT in Subsystem with MATCHING Functions"));
196 : overbeek 1.8 push(@$html,$cgi->end_form);
197 : overbeek 1.13
198 :     my $col_hdrs3 = ['Genome','Genus and Species','Possible Variant Codes','Detected Roles'];
199 :     my $tab3 = [];
200 : overbeek 1.16
201 :     my $sobj = $fig->get_subsystem($subsys);
202 :     my %genomes_in_sub = map { $_ => 1 } $sobj->get_genomes;
203 :     my @to_add = grep { ($_->[1] eq 'maybe-add') && (! $genomes_in_sub{$_->[4]}) } @checked;
204 : overbeek 1.13
205 :     my($entry,$vcodes,$genome,$gs,@roles);
206 : overbeek 1.15 foreach $entry (sort { $a->[5] cmp $b->[5] } @to_add)
207 : overbeek 1.13 {
208 :     (undef,undef,undef,$vcodes,$genome,$gs,@roles) = @$entry;
209 :     push(@$tab3,[$genome,$gs,$vcodes,join("<br>",@roles)]);
210 :     }
211 :     push(@$html,&HTML::make_table($col_hdrs3,$tab3,"Genomes that Should Be Considered For Addition"));
212 :     }
213 :    
214 : overbeek 1.12 sub get_check_data {
215 :     my($cgi,$subsys) = @_;
216 :     my @raw_output;
217 :    
218 :     if ($cgi->param('fast') && (-e "$FIG_Config::data/Subsystems/$subsys/warnings"))
219 :     {
220 : overbeek 1.13 @raw_output = `cat $FIG_Config::data/Subsystems/$subsys/warnings`;
221 : overbeek 1.12 }
222 :     else
223 :     {
224 :     @raw_output = &FIG::run_gathering_output("$FIG_Config::bin/check_subsystems", $subsys);
225 :     # warn "Got raw output @raw_output\n";
226 :     }
227 :     return @raw_output;
228 :     }
229 :    
230 : overbeek 1.17 sub still_left_out {
231 : overbeek 1.18 my($fig,$peg,$sub) = @_;
232 : overbeek 1.17
233 :     my @subs = $fig->peg_to_subsystems($peg);
234 :     my $i;
235 :     for ($i=0; ($i < @subs) && ($sub ne $subs[$i]); $i++) {}
236 :     return ($i == @subs);
237 :     }
238 : overbeek 1.19
239 :     sub check_summary {
240 :     my($fig,$cgi,$html,$user) = @_;
241 :    
242 :     my $col_hdrs = ["Subsystem","Last Check Computed","Mismatching Entries","Missing Entries","Genomes to Add"];
243 :     my $tab = [];
244 :     my @subs = ();
245 :     foreach my $sub ($fig->all_subsystems)
246 :     {
247 :     my $curr = $fig->subsystem_curator($sub);
248 :     $curr =~ s/^master://;
249 :     if (($curr eq $user) &&
250 :     (-e "$FIG_Config::data/Subsystems/$sub/warnings"))
251 :     {
252 :     push(@subs,$sub);
253 :     }
254 :     }
255 :     foreach my $sub (@subs)
256 :     {
257 :     my $ts = localtime($^T - ((-M "$FIG_Config::data/Subsystems/$sub/warnings") * 24 * 60 * 60));
258 :     my @tmp = `cat $FIG_Config::data/Subsystems/$sub/warnings`;
259 :     my @mismatches = grep { ($_ =~ /mismatch\t(\S+)\t([^\t]+)/) } @tmp;
260 :     my $mismatchesN = (@mismatches > 0) ? @mismatches : 0;
261 :     my @left_out = grep { ($_ =~ /left-out\t(\S+)\t([^\t]+)/) } @tmp;
262 :     my $left_outN = (@left_out > 0) ? @left_out : 0;
263 :     my @maybe_add = grep { ($_ =~ /maybe-add\t[^\t]+\t[^\t]+\t(\d+\.\d+)/) } @tmp;
264 :     my $maybe_addN = (@maybe_add > 0) ? @maybe_add : 0;
265 :     push(@$tab,[$sub,$ts,$mismatchesN,$left_outN,$maybe_addN]);
266 :     }
267 :     push(@$html,$cgi->h3("Note that the following statistics do not take into account actions since last check"),
268 :     &HTML::make_table($col_hdrs,$tab,"Summary of Possible Things to Check"));
269 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3