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

Annotation of /FigWebServices/pir.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.10 - (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.9 $html=&table_annotations($html, $pegbypir, $pirid);
59 : redwards 1.10 push @$html, $cgi->p({class=>"diagnostic"}, ("<small>Generating this table took approximately " . (time-$^T) . " seconds\n</small>"));
60 : redwards 1.5 }
61 :     elsif ($cgi->param('pirsf')) {
62 : redwards 1.1 # we want to display one of the correspondances
63 : redwards 1.5 my $selfurl=$cgi->url;
64 :     push @$html, $cgi->p;
65 :     if ($cgi->param('ssonly')) {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&user=" . $cgi->param('user') . "\">Show All Matches</a>\n"}
66 :     else {push @$html, "<a href=\"$selfurl?pirsf=" . $cgi->param("pirsf") . "&ssonly='1'&user=" . $cgi->param('user') . "\">Show only matches with a subsystem</a>\n"}
67 :    
68 :     my $col_hdrs = ["PIR Superfamily<br><small>Link goes to PIR<small>", "Genome", "PEG", "FIG Function", "FIG Subsystem"];
69 : redwards 1.1 my $tab = [];
70 : redwards 1.2 foreach my $peg (@{$pegbypir->{$cgi->param('pirsf')}}) {
71 : redwards 1.1 my @sslinks;
72 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {
73 :     push @sslinks, $cgi->a({href => "subsys.cgi?&user=$user&ssa_name=" . $$subsys[0] . "&request=show_ssa"}, $$subsys[0]);
74 :     }
75 :    
76 :     my $pirlink=$cgi->param('pirsf');
77 : redwards 1.2 $pirlink =~ /^PIR(SF\d+)/;
78 :     $pirlink="<a href='http://pir.georgetown.edu/sfcs-cgi/new/pirclassif.pl?id=$1'>PIR$1</a>" . $pirid->{$cgi->param('pirsf')};
79 : redwards 1.4 next if ($cgi->param("ssonly") && !(scalar @sslinks));
80 : 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)]);
81 : redwards 1.1 }
82 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Correspondance between SEED and PIR"));
83 :     }
84 :     else {
85 :     unshift @$html, "<TITLE>The SEED - PIR comparison page</TITLE>\n";
86 :     &show_initial($fig,$cgi,$html);
87 :     }
88 :    
89 :     &HTML::show_page($cgi,$html,1);
90 :     exit;
91 :    
92 :    
93 :    
94 :    
95 :    
96 :     sub show_initial {
97 :     my ($fig,$cgi,$html)=@_;
98 :     # generate a blank page
99 :     # we want a list of all functions that have >= 1 peg unless we want all
100 :     my $min=10;
101 :     if ($cgi->param("min")) {$min=$cgi->param("min")}
102 :     if ($cgi->param("showall")) {$min=0}
103 :     my $full=1;
104 :     if ($cgi->param("preliminary")) {$full=0}
105 :     # count different subsystems per sf
106 :     my $ss; my @pirsf;
107 : redwards 1.2 foreach my $sf (keys %$pegbypir) {
108 :     next unless ($pegbypir->{$sf});
109 :     next unless (scalar @{$pegbypir->{$sf}} >= $min);
110 :     next if ($full && $pirid->{$sf} =~ /\(preliminary\)/i);
111 :     next if (!$full && $pirid->{$sf} =~ /\(full/i);
112 : redwards 1.1 push @pirsf, $sf;
113 :     if ($cgi->param('showsubsys')) {
114 : redwards 1.2 foreach my $peg (@{$pegbypir->{$sf}}) {
115 : redwards 1.1 foreach my $subsys ($fig->subsystems_for_peg($peg)) {
116 :     $ss->{$sf}->{$$subsys[0]}++;
117 :     }
118 :     }
119 :     }
120 :     }
121 :    
122 :     # now generate the labels
123 :     my $display;
124 :     foreach my $sf (@pirsf) {
125 :     next unless ($sf);
126 : redwards 1.2 my $displayname=$pirid->{$sf};
127 : redwards 1.1 if (length($displayname) > 50) {$displayname=substr($displayname, 0, 50)}
128 : redwards 1.2 if ($cgi->param('showsubsys')) {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "/". (scalar keys %{$ss->{$sf}}) . "]"}
129 :     else {$display->{$sf}=$displayname . " [". scalar @{$pegbypir->{$sf}} . "]"}
130 : redwards 1.1 }
131 :     unshift @pirsf, ''; $display->{''}='';
132 :    
133 :     push (@$html, $cgi->start_form(-action => "pir.cgi"),
134 :     $cgi->h2("Please choose your super family"),
135 :     "First, please enter a username: ", $cgi->textfield(-name=>"user"), $cgi->p,
136 :     "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. ",
137 :     "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 ",
138 :     "of PEGs that map to that superfamily, and the second number in parenthesis is the number of <em>different</em> ",
139 :     "subsystems that those PEGs are in.\n", $cgi->p,
140 :     $cgi->popup_menu(-name=>'pirsf', -values=>[keys %$display], -labels=>$display), $cgi->p,
141 :     "\nMinimum number of pegs per PIR superfamily shown in list &nbsp; <input type='text' name='min' value='$min' size=3 />",
142 :     "or show all PIR superfamilies: ", $cgi->checkbox(-name=>"showall", -label=>""), $cgi->p,
143 :     $cgi->checkbox(-name=>"showsubsys", -label=>"Show subsystem counts in pull down menu (this will slow things down!)"), $cgi->p,
144 :     $cgi->checkbox(-name=>"preliminary", -label=>"Show only preliminary PIR superfamilies"), $cgi->p,
145 :     $cgi->submit('submit', 'Update view'),
146 :     $cgi->submit('submit', 'Show Correspondance'),
147 :     $cgi->reset,
148 :    
149 :    
150 :     $cgi->end_form,
151 :     );
152 :    
153 :     }
154 :    
155 :    
156 :    
157 :     =head1 read_pir_file
158 :    
159 :     Read the PIR data file that describes superfamilies and the PIR proteins that have those families.
160 :     The PIR data file is from ftp://ftp.pir.georgetown.edu/pir_databases/pirsf/data/pirsfinfo.dat and
161 :     contains the family name beginning with a > and then a list of PIR ids.
162 :    
163 : redwards 1.2 I split this using the PIRSF\d+ and return two hashes. One that correlates PIRSF\d+ to fig id and one
164 :     that correlates it to superfamily names.
165 : redwards 1.1
166 :     =cut
167 :    
168 :     sub read_pir_file {
169 :    
170 :     # just read the file, convert it to an HTML table and return it
171 :     unless (-e "$FIG_Config::data/Global/pirsfcorrespondance.txt") {
172 :     print STDERR "Can't find the correspondance file pirsfcorrespondance.txt so we are going to make it\n";
173 :     raelib->pirsfcorrespondance("$FIG_Config::data/Global/pirsfinfo.dat", "$FIG_Config::data/Global/pirsfcorrespondance.txt");
174 :     }
175 :     open (IN, "$FIG_Config::data/Global/pirsfcorrespondance.txt") || die "Can't open $FIG_Config::data/Global/pirsfcorrespondance.txt";
176 :     my $pir;
177 : redwards 1.2 my $functions;
178 :     my $id;
179 : redwards 1.1 my $added;
180 :     while (<IN>) {
181 :     chomp;
182 :     if (s/^>//) {
183 :     unless ($added) {
184 :     # we didn't find anything that maps here
185 : redwards 1.2 $pir->{$id}=undef;
186 : redwards 1.1 }
187 : redwards 1.2 /^(PIRSF\d+)\s+(.*?)$/;
188 :     $id=$1;
189 :     $functions->{$id}=$2;
190 : redwards 1.1 undef $added;
191 :     }
192 :     else {
193 : redwards 1.2 my ($pirid, $peg)=split /\t/;
194 : redwards 1.1 next unless ($peg);
195 : redwards 1.2 push @{$pir->{$id}}, $peg;
196 : redwards 1.1 $added=1;
197 :     }
198 :     }
199 : redwards 1.2 return $pir, $functions;
200 : redwards 1.1 }
201 : redwards 1.5
202 : redwards 1.9 =head1 table_annotations
203 : redwards 1.5
204 : redwards 1.9 Return a table sorted by the number of annotations, and list a bunch of stuff
205 : redwards 1.5
206 :     =cut
207 :    
208 : redwards 1.9 sub table_annotations {
209 :     my ($html, $pegbypir, $pirid)=@_;
210 :     my $count; my $subsystems;
211 :     foreach my $sf (keys %$pegbypir) {
212 :     my $function; my $ss;
213 :     foreach my $peg (@{$pegbypir->{$sf}}) {
214 :     $function->{scalar $fig->function_of($peg)}++;
215 :     foreach my $subsys ($fig->subsystems_for_peg($peg)) {$ss->{$$subsys[0]}++}
216 : redwards 1.5 }
217 : redwards 1.9 $subsystems->{$sf}=join "; ", keys %$ss;
218 :     $count->{$sf}=scalar keys %$function;
219 : redwards 1.5 }
220 :    
221 : redwards 1.6 my $col_hdrs = ["Number of SEED annotations in a Superfamily", "PIRSF<br><small>(Link goes to SEED/PIR comparison)</small>",
222 :     "Superfamily name", "Subsystems in superfamily"];
223 : redwards 1.10 my $tab; my $lastcount; my $row;
224 : 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
225 : redwards 1.9 foreach my $sf (sort {$count->{$b} <=> $count->{$a}} keys %$count) {
226 : redwards 1.10 $row++;
227 : redwards 1.9 if ($lastcount ne $count->{$sf}) {
228 :     $lastcount=$count->{$sf};
229 : redwards 1.10 if ($tab && $row > 50) {
230 :     push(@$html,&HTML::make_table($col_hdrs,$tab,""));
231 :     $row=0;
232 :     undef $tab;
233 :     }
234 : redwards 1.9 }
235 :     push @$tab, [
236 :     $count->{$sf},
237 : redwards 1.10 "<a href=\"http://seed-linux-2.uchicago.edu/FIG/pir.cgi?pirsf=$sf&ssonly='1'&user=''\">$sf</a>",
238 : redwards 1.9 $pirid->{$sf},
239 :     $subsystems->{$sf},
240 :     ];
241 : redwards 1.5 }
242 : redwards 1.6 push(@$html,&HTML::make_table($col_hdrs,$tab,""));
243 : redwards 1.5 return $html;
244 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3