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

Annotation of /FigWebServices/pir.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 :    
3 :     =pod
4 :    
5 :     =head1
6 :    
7 :     Compare some data between SEED and PIR. We probably need to add things like p2p or automatic ftp gets or something like that
8 :    
9 :     =cut
10 :    
11 :     use strict;
12 :     use FIG;
13 :     use HTML;
14 :     use raelib;
15 :     use CGI;
16 :     my $cgi=new CGI;
17 :    
18 :    
19 :     my $fig;
20 :     eval {
21 :     $fig = new FIG;
22 :     };
23 :    
24 :     if ($@ ne "")
25 :     {
26 :     my $err = $@;
27 :    
28 :     my(@html);
29 :    
30 :     push(@html, $cgi->p("Error connecting to SEED database."));
31 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
32 :     {
33 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
34 :     }
35 :     else
36 :     {
37 :     push(@html, $cgi->pre($err));
38 :     }
39 :     &HTML::show_page($cgi, \@html, 1);
40 :     exit;
41 :     }
42 :    
43 :    
44 :    
45 :     $ENV{"PATH"} = "$FIG_Config::bin:$FIG_Config::ext_bin:" . $ENV{"PATH"};
46 :    
47 :     my $html = [];
48 :     my $user = $cgi->param('user');
49 :    
50 :     # make sure that we read the file at the beginning
51 : redwards 1.2 my ($pegbypir, $pirid) =&read_pir_file();
52 : redwards 1.1
53 :    
54 :    
55 :    
56 :    
57 : redwards 1.5 if ($cgi->param('tabulate')) {
58 : redwards 1.11 print STDERR "Starting the tabulations at ", time, "\n";
59 : redwards 1.9 $html=&table_annotations($html, $pegbypir, $pirid);
60 : redwards 1.11 print STDERR "Done with the tabulations at ", time, "\n";
61 : redwards 1.10 push @$html, $cgi->p({class=>"diagnostic"}, ("<small>Generating this table took approximately " . (time-$^T) . " seconds\n</small>"));
62 : redwards 1.5 }
63 :     elsif ($cgi->param('pirsf')) {
64 : redwards 1.1 # we want to display one of the correspondances
65 : redwards 1.5 my $selfurl=$cgi->url;
66 :     push @$html, $cgi->p;
67 :     if ($cgi->param('ssonly')) {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&user=" . $cgi->param('user') . "\">Show All Matches</a>\n"}
68 :     else {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&ssonly='1'&user=" . $cgi->param('user') . "\">Show only matches with a subsystem</a>\n"}
69 :    
70 :     my $col_hdrs = ["PIR Superfamily<br><small>Link goes to PIR<small>", "Genome", "PEG", "FIG Function", "FIG Subsystem"];
71 : redwards 1.1 my $tab = [];
72 : redwards 1.2 foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
73 : redwards 1.1 my @sslinks;
74 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {
75 :     push @sslinks, $cgi->a({href => "subsys.cgi?&user=$user&ssa_name=" . $$subsys[0] . "&request=show_ssa"}, $$subsys[0]);
76 :     }
77 :    
78 :     my $pirlink=$cgi->param('pirsf');
79 : redwards 1.2 $pirlink =~ /^PIR(SF\d+)/;
80 :     $pirlink="<a href='http://pir.georgetown.edu/sfcs-cgi/new/pirclassif.pl?id=$1'>PIR$1</a>" . $pirid->{$cgi->param('pirsf')};
81 : redwards 1.4 next if ($cgi->param("ssonly") && !(scalar @sslinks));
82 : redwards 1.2 push (@$tab, [$pirlink, $fig->genus_species($fig->genome_of($peg)), &HTML::fid_link($cgi, $peg, 1), (scalar $fig->function_of($peg)), (join ", ", @sslinks)]);
83 : redwards 1.1 }
84 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Correspondance between SEED and PIR"));
85 :     }
86 :     else {
87 :     unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";
88 :     &show_initial($fig,$cgi,$html);
89 :     }
90 :    
91 :     &HTML::show_page($cgi,$html,1);
92 :     exit;
93 :    
94 :    
95 :    
96 :    
97 :    
98 :     sub show_initial {
99 :     my ($fig,$cgi,$html)=@_;
100 :     # generate a blank page
101 :     # we want a list of all functions that have >= 1 peg unless we want all
102 :     my $min=10;
103 :     if ($cgi->param("min")) {$min=$cgi->param("min")}
104 :     if ($cgi->param("showall")) {$min=0}
105 :     my $full=1;
106 :     if ($cgi->param("preliminary")) {$full=0}
107 :     # count different subsystems per sf
108 :     my $ss; my @pirsf;
109 : redwards 1.2 foreach my $sf (keys %$pegbypir) {
110 :     next unless ($pegbypir->{$sf});
111 :     next unless (scalar @{$pegbypir->{$sf}} >= $min);
112 :     next if ($full && $pirid->{$sf} =~ /\(preliminary\)/i);
113 :     next if (!$full && $pirid->{$sf} =~ /\(full/i);
114 : redwards 1.1 push @pirsf, $sf;
115 :     if ($cgi->param('showsubsys')) {
116 : redwards 1.2 foreach my $peg (@{$pegbypir->{$sf}}) {
117 : redwards 1.1 foreach my $subsys ($fig->subsystems_for_peg($peg)) {
118 :     $ss->{$sf}->{$$subsys[0]}++;
119 :     }
120 :     }
121 :     }
122 :     }
123 :    
124 :     # now generate the labels
125 :     my $display;
126 :     foreach my $sf (@pirsf) {
127 :     next unless ($sf);
128 : redwards 1.2 my $displayname=$pirid->{$sf};
129 : redwards 1.1 if (length($displayname) > 50) {$displayname=substr($displayname, 0, 50)}
130 : redwards 1.2 if ($cgi->param('showsubsys')) {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "/". (scalar keys %{$ss->{$sf}}) . "]"}
131 :     else {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "]"}
132 : redwards 1.1 }
133 :     unshift @pirsf, ''; $display->{''}='';
134 :    
135 :     push (@$html, $cgi->start_form(-action => "pir.cgi"),
136 :     $cgi->h2("Please choose your super family"),
137 :     "First, please enter a username: ", $cgi->textfield(-name=>"user"), $cgi->p,
138 :     "The pull down list shows the PIR superfamilies. If only one number is shown (default) this is the number of PEGs that map to that superfamily. ",
139 :     "If you choose to show subsystem counts in this menu, you will get two numbers. The first of the two numbers in parenthesis is the number ",
140 :     "of PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",
141 :     "subsystems that those PEGs are in.\n", $cgi->p,
142 :     $cgi->popup_menu(-name=>'pirsf', -values=>[keys %$display], -labels=>$display), $cgi->p,
143 :     "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />",
144 :     "or show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,
145 :     $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in pull down menu (this will slow things down!)"), $cgi->p,
146 :     $cgi->checkbox(-name=>"preliminary", -label=>"Show only preliminary PIR superfamilies"), $cgi->p,
147 :     $cgi->submit('submit', 'Update view'),
148 :     $cgi->submit('submit', 'Show Correspondance'),
149 :     $cgi->reset,
150 :    
151 :    
152 :     $cgi->end_form,
153 :     );
154 :    
155 :     }
156 :    
157 :    
158 :    
159 :     =head1 read_pir_file
160 :    
161 :     Read the PIR data file that describes superfamilies and the PIR proteins that have those families.
162 :     The PIR data file is from ftp://ftp.pir.georgetown.edu/pir_databases/pirsf/data/pirsfinfo.dat and
163 :     contains the family name beginning with a > and then a list of PIR ids.
164 :    
165 : redwards 1.2 I split this using the PIRSF\d+ and return two hashes. One that correlates PIRSF\d+ to fig id and one
166 :     that correlates it to superfamily names.
167 : redwards 1.1
168 :     =cut
169 :    
170 :     sub read_pir_file {
171 :    
172 :     # just read the file, convert it to an HTML table and return it
173 :     unless (-e "$FIG_Config::data/Global/pirsfcorrespondance.txt") {
174 :     print STDERR "Can't find the correspondance file pirsfcorrespondance.txt so we are going to make it\n";
175 :     raelib->pirsfcorrespondance("$FIG_Config::data/Global/pirsfinfo.dat", "$FIG_Config::data/Global/pirsfcorrespondance.txt");
176 :     }
177 :     open (IN, "$FIG_Config::data/Global/pirsfcorrespondance.txt") || die "Can't open $FIG_Config::data/Global/pirsfcorrespondance.txt";
178 :     my $pir;
179 : redwards 1.2 my $functions;
180 :     my $id;
181 : redwards 1.1 my $added;
182 :     while (<IN>) {
183 :     chomp;
184 :     if (s/^>//) {
185 :     unless ($added) {
186 :     # we didn't find anything that maps here
187 : redwards 1.2 $pir->{$id}=undef;
188 : redwards 1.1 }
189 : redwards 1.2 /^(PIRSF\d+)\s+(.*?)$/;
190 :     $id=$1;
191 :     $functions->{$id}=$2;
192 : redwards 1.1 undef $added;
193 :     }
194 :     else {
195 : redwards 1.2 my ($pirid, $peg)=split /\t/;
196 : redwards 1.1 next unless ($peg);
197 : redwards 1.2 push @{$pir->{$id}}, $peg;
198 : redwards 1.1 $added=1;
199 :     }
200 :     }
201 : redwards 1.2 return $pir, $functions;
202 : redwards 1.1 }
203 : redwards 1.5
204 : redwards 1.9 =head1 table_annotations
205 : redwards 1.5
206 : redwards 1.9 Return a table sorted by the number of annotations, and list a bunch of stuff
207 : redwards 1.5
208 :     =cut
209 :    
210 : redwards 1.9 sub table_annotations {
211 :     my ($html, $pegbypir, $pirid)=@_;
212 :     my $count; my $subsystems;
213 :     foreach my $sf (keys %$pegbypir) {
214 :     my $function; my $ss;
215 :     foreach my $peg (@{$pegbypir->{$sf}}) {
216 :     $function->{scalar $fig->function_of($peg)}++;
217 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {$ss->{$$subsys[0]}++}
218 : redwards 1.5 }
219 : redwards 1.9 $subsystems->{$sf}=join "; ", keys %$ss;
220 :     $count->{$sf}=scalar keys %$function;
221 : redwards 1.5 }
222 :    
223 : redwards 1.6 my $col_hdrs = ["Number of SEED annotations in a Superfamily", "PIRSF<br><small>(Link goes to SEED/PIR comparison)</small>",
224 :     "Superfamily name", "Subsystems in superfamily"];
225 : redwards 1.10 my $tab; my $lastcount; my $row;
226 : redwards 1.6 # note we are going to make a new table every 200 rows because that way the browsers don't get messed up
227 : redwards 1.9 foreach my $sf (sort {$count->{$b} <=> $count->{$a}} keys %$count) {
228 : redwards 1.10 $row++;
229 : redwards 1.9 if ($lastcount ne $count->{$sf}) {
230 :     $lastcount=$count->{$sf};
231 : redwards 1.10 if ($tab && $row > 50) {
232 :     push(@$html,&HTML::make_table($col_hdrs,$tab,""));
233 : redwards 1.11 print STDERR "Added to html at $lastcount\n";
234 : redwards 1.10 $row=0;
235 :     undef $tab;
236 :     }
237 : redwards 1.9 }
238 :     push @$tab, [
239 :     $count->{$sf},
240 : redwards 1.10 "<a href=\"http://seed-linux-2.uchicago.edu/FIG/pir.cgi?pirsf=$sf&ssonly='1'&user=''\">$sf</a>",
241 : redwards 1.9 $pirid->{$sf},
242 :     $subsystems->{$sf},
243 :     ];
244 : redwards 1.5 }
245 : redwards 1.11 print STDERR "Added to html last time\n";
246 : redwards 1.6 push(@$html,&HTML::make_table($col_hdrs,$tab,""));
247 : redwards 1.5 return $html;
248 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3