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

Annotation of /FigWebServices/check_int_anno.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 :     #
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 :     use FIG;
20 :     use URI::Escape; # uri_escape
21 :     use HTML;
22 :     use Data::Dumper;
23 :     use strict;
24 :     use CGI;
25 :     use CGI::Carp qw(fatalsToBrowser);
26 :     my $cgi = new CGI;
27 :     my $fig = new FIG;
28 :    
29 :    
30 :     my $html = [];
31 :     unshift @$html, "<TITLE>The SEED Annotation Checking Page</TITLE>\n";
32 :    
33 :     my $file = "$FIG_Config::global/annotation_checks";
34 :    
35 :     my $user = $cgi->param('user');
36 :     if (! $user)
37 :     {
38 :     push(@$html,"<h1>Sorry, you need to specify a user</h1>\n");
39 :     &HTML::show_page($cgi,$html);
40 :     exit;
41 :     }
42 :    
43 :     $/ = "\n//\n";
44 :    
45 :    
46 :     if ($cgi->param("show") eq "subsystem")
47 :     {
48 :     $html=&showbyss($cgi,$html);
49 : overbeek 1.3 &HTML::show_page($cgi,$html);
50 : overbeek 1.1 exit;
51 :     }
52 :    
53 :    
54 :     my %probs;
55 :     foreach $_ (grep { $_ =~ /^I/ } `cat $file`)
56 :     {
57 :     if ($_ =~ /^I\n(\S[^\t]+\S)\t(\S[^\t]+\S)\t(\S+)\t(\S+)/s)
58 :     {
59 :     $probs{"$3\t$4"} = [$1,$2,$3,$4];
60 :     }
61 :     }
62 :    
63 :     my @tab = sort { ($a->[0] cmp $b->[0]) or ($a->[1] cmp $b->[1]) or &FIG::by_fig_id($a->[2],$b->[2]) or ($a->[3] cmp $b->[3]) }
64 :     map { $probs{$_} }
65 :     keys(%probs);
66 :    
67 :     my $start_at = $cgi->param('start_at');
68 :     $start_at = $start_at ? $start_at : 0;
69 :     my $do = $cgi->param('do');
70 :     $do = $do ? $do : 10000;
71 :    
72 :     my $col_hdrs = ["","FIG Function","Other Function","FIG IDs","Other IDs"];
73 :     my $tab = [];
74 :     my $got = 0;
75 :     my $i = $start_at;
76 :     while (($i < @tab) && ($got < $do))
77 :     {
78 :     my $f1 = $tab[$i]->[0];
79 :     my $f2 = $tab[$i]->[1];
80 :     my $peg1 = $tab[$i]->[2];
81 :    
82 :     my @set = ();
83 :     while (($i < @tab) && ($tab[$i]->[0] eq $f1) && ($tab[$i]->[1] eq $f2))
84 :     {
85 :     push(@set,$tab[$i]);
86 :     $i++;
87 :     }
88 :     my @fig = map { $_->[2] } @set;
89 :     my %fig = map { $_ => 1 } @fig;
90 :     @fig = sort { &FIG::by_fig_id($a,$b) } keys(%fig);
91 :    
92 :     my @other = map { $_->[3] } @set;
93 :     my %other = map { $_ => 1 } @other;
94 :     @other = sort keys(%other);
95 :    
96 :     my @figL = map { &HTML::fid_link($cgi,$_) } @fig;
97 :     my @otherL = map { &HTML::set_prot_links($cgi,$_) } @other;
98 :    
99 :     push(@$tab,[$start_at,$f1,$f2,join("<br>",@figL),join("<br>",@otherL)]);
100 :     $got++;
101 :     $start_at = $i;
102 :     }
103 :    
104 :     if (@$tab > 0)
105 :     {
106 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Discrepancies in Annotations"));
107 :     &HTML::show_page($cgi,$html);
108 :     }
109 :     else
110 :     {
111 :     $html = [];
112 :     push(@$html,"<h1>Nothing left to show</h1>\n");
113 :     &HTML::show_page($cgi,$html);
114 :     }
115 :    
116 :    
117 :    
118 :     sub showbyss {
119 :     ($cgi, $html)=@_;
120 : overbeek 1.3 local $/="\n//\n";
121 : overbeek 1.1 my $time=time;
122 :     my $limit=$cgi->param("limit");
123 : overbeek 1.2 unless ($limit) {$limit=5}
124 : overbeek 1.1 my $last=$cgi->param("last");
125 :     unless (defined ($last)) {$last=0}
126 :    
127 :     unless (-e $FIG_Config::global."/annotation_checks") {die "The annotation checks file ". $FIG_Config::global."/annotation_checks is missing"}
128 :    
129 :     open(IN, $FIG_Config::global."/annotation_checks") || die "Can't open ".$FIG_Config::global."/annotation_checks";
130 :     my $interesting; my $allss;
131 :     while (<IN>)
132 :     {
133 :     next unless (/^I/);
134 :     my @a=split /\n/;
135 :     my @pieces=split /\t/, $a[1];
136 :     my @allsubsys;
137 :     if ($allss->{$pieces[2]}) {@allsubsys=($allss->{$pieces[2]})}
138 :     else {
139 :     @allsubsys=$fig->subsystems_for_peg($pieces[2]);
140 :     $allss->{$pieces[2]}=\@allsubsys;
141 :     }
142 :     foreach my $tple (@allsubsys)
143 :     {
144 :     push @{$interesting->{$tple->[0]}}, \@pieces;
145 :     }
146 :     }
147 :     close IN;
148 :    
149 :    
150 :     $html=&directionlinks($html, $last, $limit);
151 :    
152 :     my $current=0;
153 :     foreach my $subsys (keys %$interesting)
154 :     {
155 :     next unless ($fig->subsystem_curator($subsys) eq $cgi->param("user"));
156 :     $current++;
157 :     next if ($current <= $last);
158 :     last if ($current > $last+$limit);
159 :     my $tab=[];
160 :     my $col_hdrs=["FIG Function", "Other Function", "FIG IDs", "Other IDs"];
161 :     foreach my $row (@{$interesting->{$subsys}})
162 :     {
163 :    
164 :     $row->[2]=&HTML::set_prot_links($cgi, $row->[2]) unless ($row->[2] =~ m/<a /);
165 :     $row->[3]=&HTML::set_prot_links($cgi, $row->[3]) unless ($row->[3] =~ m/<a /);
166 :     push @$tab, $row;
167 :     }
168 :     my %options=(width=>"100%");
169 :     push @$html,
170 :     &HTML::make_table($col_hdrs,$tab,"Discrepancies in ".&HTML::sub_link($cgi, $subsys)." &nbsp; Curator: ".$fig->subsystem_curator($subsys), %options),
171 :     $cgi->div({style=>"text-align: right"}, $cgi->p("<a href=\"#top\">Top</a>"));
172 :     }
173 :    
174 :     $html=&directionlinks($html, $last, $limit);
175 :    
176 :     return $html;
177 :     }
178 :    
179 :    
180 :     sub directionlinks {
181 :     my ($html, $last, $limit)=@_;
182 :     if ($last >= $limit)
183 :     {
184 :     push (@$html,
185 :     $cgi->p("<a name=\"top\" />\n"),
186 :     "<table border=0 width=100%><tr><td align=\"left\">",
187 :     "<a href=\"check_int_anno.cgi?user=".$cgi->param("user")."&show=subsystem&last=".($last-$limit)."&limit=$limit\">Previous $limit Subsystems</a>",
188 :     "</td><td align=\"right\">",
189 :     "<a href=\"check_int_anno.cgi?user=".$cgi->param("user")."&show=subsystem&last=".($last+$limit)."&limit=$limit\">Next $limit Subsystems</a>",
190 :     "</td></tr></table>\n");
191 :     }
192 :     else
193 :     {
194 :     push (@$html, "<table border=0 width=100%><tr><td align=\"left\">Previous $limit Subsystems</td><td align=\"right\">",
195 :     "<a href=\"check_int_anno.cgi?user=".$cgi->param("user")."&show=subsystem&last=".($last+$limit)."&limit=$limit\">Next $limit Subsystems</a>",
196 :     "</td></tr></table>\n");
197 :     }
198 :     return $html;
199 :     }
200 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3