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

Annotation of /FigWebServices/proteinfamilies.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (view) (download)

1 : redwards 1.1 # -*- perl -*-
2 :    
3 :     =pod
4 :    
5 :     =head1 proteinfamilies.cgi
6 :    
7 : redwards 1.3 A base web interface for getting information about protein families in and out. Initially we are going to make a 3 (or 4) column table of protein, family and other proteins.
8 : redwards 1.1
9 :     =cut
10 :    
11 :     use strict;
12 :     use FIG;
13 :     use HTML;
14 :     use raelib;
15 :     use CGI;
16 :     my $cgi=new CGI;
17 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
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 :     my $html = [];
44 :     my $user = $cgi->param('user');
45 :    
46 :     unshift(@$html, "<TITLE>The SEED - Global Protein Families </TITLE>\n");
47 :    
48 : redwards 1.2 my %proteinbase=(
49 :     "fig" => "/FIG/protein.cgi?user=$user&prot=fig|",
50 :     "cog" => "http://www.ncbi.nlm.nih.gov/COG/old/palox.cgi?",
51 :     "sp" => "http://www.expasy.org/uniprot/",
52 :     "tr" => "http://www.expasy.org/uniprot/",
53 :     "kegg" => "http://www.genome.jp/dbget-bin/www_bget?",
54 :     );
55 :    
56 :    
57 :    
58 :     if ($cgi->param('Show Proteins In Each Family'))
59 : redwards 1.1 {
60 : redwards 1.2 my @needed=grep {$cgi->param($_)} $cgi->param("allfams");
61 :     $cgi->param(-name=>'family', -value=>\@needed);
62 :     &show_family($fig,$cgi,$html);
63 :     }
64 :     elsif ($cgi->param("Combine Families With And"))
65 :     {
66 :     &combine_families($fig,$cgi,$html);
67 :     }
68 :     elsif ($cgi->param('Compare FIG Functions'))
69 :     {
70 :     my @needed=grep {$cgi->param($_)} $cgi->param("allfams");
71 :     $cgi->param(-name=>'family', -value=>\@needed);
72 :     &compare_functions($fig,$cgi,$html);
73 :     }
74 :     elsif ($cgi->param('family'))
75 :     {
76 :     &show_family($fig,$cgi,$html);
77 : redwards 1.1 }
78 :     elsif ($cgi->param('prot'))
79 :     {
80 : redwards 1.2 &show_protein($fig,$cgi,$html);
81 : redwards 1.1 }
82 :     else
83 :     {
84 :     &show_initial($fig,$cgi,$html);
85 :     }
86 :    
87 :     &HTML::show_page($cgi,$html,1);
88 :     exit;
89 :    
90 :    
91 :     sub show_initial {
92 :     my ($fig,$cgi,$html)=@_;
93 :     # generate a blank page
94 : redwards 1.2 push @$html,
95 :     "<h2>Protein Families</h2>\n",
96 :     "<p>Please enter a protein ID . You will recieve a list of all the families that protein is in. \n",
97 :     "You can use a FIG ID such as fig|83333.1.peg.3, or an ID from SwissProt, KEGG, NCBI, and others.</p>",
98 :     $cgi->start_form(),
99 :     "Please enter a protein id: ", $cgi->textfield(-name=>"prot", -size=>40), "<br>",
100 :     "<p>Alternately, you can enter a family. Please enter a family name in the format pir|PIRSF001547 or fig|PF002363.</p>",
101 :     "Please enter a family id: ", $cgi->textfield(-name=>"family", -size=>40), "<br>",
102 :     $cgi->submit, $cgi->reset, $cgi->end_form;
103 : redwards 1.1 return $html;
104 :     }
105 :    
106 : redwards 1.2 sub show_protein {
107 : redwards 1.1 my ($fig,$cgi,$html)=@_;
108 : redwards 1.2 foreach my $peg ($cgi->param('prot')) {
109 :     my @families=$fig->families_for_protein($peg);
110 :     unless (@families)
111 :     {
112 :     push @$html, "<h2 style='color: red'>Sorry, $peg is not in any protein families</h2>";
113 :     return;
114 :     }
115 :    
116 :     my $tab=[];
117 :     my $self=$cgi->url;
118 :     foreach my $fam (@families) {
119 :     push @$tab, ["<a href='$self?family=$fam'>$fam</a>", $fig->family_function($fam), $fig->sz_family($fam), $cgi->checkbox(-name=>$fam, -label=>'')];
120 : redwards 1.1 }
121 : redwards 1.2
122 :     my $col_hdrs=['Family ID', 'Family Function', 'Number of Unique Proteins in Family', 'Choose Family'];
123 :     push @$html, "<h2>Families for $peg</h2>\n",
124 :     $cgi->start_form,
125 :     "<p>$peg is in the following ", scalar(@families), " families. Please choose one or more families using the checkboxes</p>\n",
126 :     &HTML::make_table($col_hdrs, $tab, "Families for $peg"), "\n",
127 :     $cgi->submit('Show Proteins In Each Family'), $cgi->submit("Combine Families With And"), $cgi->submit("Compare FIG Functions"),
128 :     $cgi->hidden(-name=>"allfams", -value=>\@families), "\n",
129 :     $cgi->reset, $cgi->end_form;
130 : redwards 1.1 }
131 :     }
132 : redwards 1.2
133 :     sub show_family {
134 : redwards 1.1 my ($fig,$cgi,$html)=@_;
135 : redwards 1.2 foreach my $fam ($cgi->param('family')) {
136 :     my @eids=sort {$a <=> $b} $fig->ids_in_family($fam);
137 :     my $tab=[];
138 : redwards 1.3 my $col_hdrs=['Cluster ID', 'Polypeptides with same amino acid sequence'];
139 : redwards 1.2 foreach my $eid (@eids) {
140 :     my @pegs=$fig->eid_to_prots($eid);
141 :     foreach my $p (@pegs) {
142 :     foreach my $k (keys %proteinbase) {
143 :     if ($p =~ /^$k/) {$p =~ s/^(.*?)\|//; $p = "<a href='$proteinbase{$k}$p'>$1|$p</a>"}
144 : redwards 1.1 }
145 :     }
146 : redwards 1.2 push @$tab, [$eid, (join ", ", (@pegs))];
147 : redwards 1.1 }
148 : redwards 1.2
149 :     push @$html, "<h2>$fam Family</h2>\n",
150 :     "<p>The family $fam has the function ", $fig->family_function($fam), ", and contains ", $fig->sz_family($fam), " proteins, as shown in the table below.<br>",
151 : redwards 1.3 "Each of the sequences with a given ID have the same amino acid sequence, and hence are the same polypeptide, ",
152 :     "even though they may come from different organisms.</p>",
153 : redwards 1.2 "<p>The links will take you to the respective databases for each of the other protein families.\n</p>",
154 :     $cgi->start_form,
155 :     &HTML::make_table($col_hdrs, $tab, "Proteins in " . $fig->family_function($fam) . " ($fam)"),
156 :     $cgi->hidden(-name=>'family', -value=>"$fam"), $cgi->submit("Compare FIG Functions"),
157 :     $cgi->end_form;
158 : redwards 1.1 }
159 :     }
160 :    
161 : redwards 1.2 sub combine_families {
162 : redwards 1.1 my ($fig,$cgi,$html)=@_;
163 : redwards 1.2 # first find all the families and all the eids in those families
164 : redwards 1.3 my $eids; my @families; my $allprots;
165 : redwards 1.2 foreach my $f (grep {$cgi->param($_)} $cgi->param("allfams"))
166 :     {
167 :     push @families, $f;
168 : redwards 1.3 foreach my $e ($fig->ids_in_family($f)) {$eids->{$e}->{$f}=1; $allprots++}
169 : redwards 1.1 }
170 : redwards 1.3
171 : redwards 1.2 # now figure out those eids that are in all families
172 :     # we are going to do this with a boolean switch rather than just counting occurences
173 :     my @wanted;
174 :     foreach my $eid (keys %$eids) {
175 :     my $keep=1;
176 : redwards 1.3 foreach my $f (@families) {undef $keep unless ($eids->{$eid}->{$f})}
177 :     push @wanted, $eid if ($keep);
178 : redwards 1.2 }
179 :    
180 :     my $tab=[];
181 : redwards 1.3 my $col_hdrs=['Cluster ID', 'Polypeptides with same amino acid sequence'];
182 :     foreach my $eid (sort {$a <=> $b} @wanted) {
183 : redwards 1.2 my @pegs=$fig->eid_to_prots($eid);
184 :     foreach my $p (@pegs) {
185 :     foreach my $k (keys %proteinbase) {
186 :     if ($p =~ /^$k/) {$p =~ s/^(.*?)\|//; $p = "<a href='$proteinbase{$k}$p'>$1|$p</a>"}
187 :     }
188 : redwards 1.1 }
189 : redwards 1.2 push @$tab, [$eid, (join ", ", (@pegs))];
190 : redwards 1.1 }
191 : redwards 1.2
192 :    
193 :     push @$html, "<h2>Proteins in ", (join ", ", (@families)), " families</h2>\n",
194 : redwards 1.3 "<h3>Summary</h3>\n<p>There were $allprots proteins in the ", scalar(@families), " families that you selected.\n<br>",
195 :     "Out of a those proteins, there were ", scalar(keys %$eids),
196 :     " unique proteins, and ", scalar(@wanted), " proteins are present in the ",
197 :     scalar(@families), " families.</p>\n",
198 :     "Each of the sequences with a given ID have the same amino acid sequence, and hence are the same polypeptide, even though they may come from different organisms.</p>",
199 : redwards 1.2 "<p>The links will take you to the respective databases for each of the other protein families.\n</p>",
200 :     $cgi->start_form,
201 :     &HTML::make_table($col_hdrs, $tab, "Proteins in " . (join ", ", (@families)) . " families"),
202 :     $cgi->end_form;
203 : redwards 1.1 }
204 :    
205 : redwards 1.2 sub compare_functions {
206 :     my ($fig,$cgi,$html)=@_;
207 :     foreach my $fam ($cgi->param('family')) {
208 :     my @eids=sort {$a <=> $b} $fig->ids_in_family($fam);
209 :     my $tab=[];
210 :     my $col_hdrs=['FIG ID', 'Genome', 'Assigned Function'];
211 :     foreach my $eid (@eids) {
212 :     foreach my $peg (grep {/^fig/} $fig->eid_to_prots($eid)) {
213 :     my $p=$peg;
214 :     $p =~ s/fig\|//;
215 :     $p = "<a href='$proteinbase{'fig'}$p'>$peg</a>";
216 :     push @$tab, [$p, ($fig->genus_species($fig->genome_of($peg))), scalar($fig->function_of($peg))];
217 :     }
218 :     }
219 :    
220 :     push @$html, "<h2>Functions in $fam Family</h2>\n",
221 :     "<p>The family $fam has the function ", $fig->family_function($fam), ".\n",
222 :     "The functions shown here are the functions of just the proteins in the SEED database from this family</p>",
223 :     $cgi->start_form,
224 :     &HTML::make_table($col_hdrs, $tab, "Proteins in " . $fig->family_function($fam) . " ($fam)"),
225 :     $cgi->hidden(-name=>'family', -value=>"$fam"), $cgi->submit("Compare FIG Functions"),
226 :     $cgi->end_form;
227 :     }
228 :     }
229 : redwards 1.1

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3