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

Annotation of /FigWebServices/protein_by_ss.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (view) (download)

1 : mkubal 1.1 # -*- perl -*-
2 : olson 1.4 #
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 : mkubal 1.1
20 :     =pod
21 :    
22 :     =head1 proteininfo.cgi
23 :    
24 :     Get some information about a bunch of proteins.
25 :    
26 :     =cut
27 :    
28 :     # -*- perl -*-
29 :     use InterfaceRoutines;
30 :     use FIG;
31 :     use FIGGenDB;
32 :     use FIGjs;
33 :     use URI::Escape; # uri_escape
34 :     use HTML;
35 :     use Data::Dumper;
36 : redwards 1.6 #use strict;
37 : mkubal 1.1 use GenoGraphics;
38 :     use CGI;
39 :     use Tracer;
40 :    
41 :     my $cgi = new CGI;
42 :    
43 :     use HTML;
44 :     use raelib;
45 :     my $raelib=new raelib;
46 :    
47 :     use LWP::Simple qw(!head); # see the caveat in perldoc LWP about importing two head methods.
48 :    
49 :     my $fig;
50 :     eval {
51 :     $fig = new FIG;
52 :     };
53 :    
54 :     if ($@ ne "")
55 :     {
56 :     my $err = $@;
57 :    
58 :     my(@html);
59 :    
60 :     push(@html, $cgi->p("Error connecting to SEED database."));
61 :     if ($err =~ /Could not connect to DBI:.*could not connect to server/)
62 :     {
63 :     push(@html, $cgi->p("Could not connect to relational database of type $FIG_Config::dbms named $FIG_Config::db on port $FIG_Config::dbport."));
64 :     }
65 :     else
66 :     {
67 :     push(@html, $cgi->pre($err));
68 :     }
69 :     &HTML::show_page($cgi, \@html, 1);
70 :     exit;
71 :     }
72 :    
73 :     my $html = [];
74 :     my $user = $cgi->param('user');
75 :    
76 :     unshift(@$html, "<TITLE>The SEED - Protein Information</TITLE>\n");
77 :    
78 :     my $ids;
79 :     my $tag_to_id;
80 :     my $inputs;
81 :     if ($cgi->param('request') && $cgi->param('korgs') )
82 :     {
83 :     push @orgs, $cgi->param('korgs');
84 : redwards 1.6 $org = $orgs[0];
85 : mkubal 1.1 my $ids = &get_input_ids($org);
86 :     &protein_info($fig,$cgi,$html,$ids);
87 :     }
88 :     else
89 :     {
90 :     &show_initial($fig,$cgi,$html);
91 :     }
92 :    
93 :    
94 :     &HTML::show_page($cgi,$html,1);
95 :     exit;
96 :    
97 :    
98 :     sub get_input_ids {
99 :     my($org) = @_;
100 :    
101 :     my $input =$cgi->param('proteins');
102 :     my @inputs = ();
103 :     if ($input)
104 :     {
105 :     @inputs = grep { /^\S+$/ } split(/\s+/,$input);
106 :     }
107 :     elsif ($cgi->upload('fileupload'))
108 :     {
109 :     my $fh=$cgi->upload('fileupload');
110 :     @inputs = map { ($_ =~ /\S+/g) } <$fh> ;
111 :     }
112 : mkubal 1.3 if ($cgi->param('request') eq "Protein Information by ID")
113 :     {
114 :     return &parse_by_alias($fig,\@inputs,$org);
115 :     }
116 :     if ($cgi->param('request') eq "Protein Information by Other")
117 :     {
118 :     return &parse_by_search($fig,\@inputs,$org);
119 :     }
120 :    
121 : mkubal 1.1 }
122 :    
123 :     sub show_initial {
124 :     my ($fig,$cgi,$html)=@_;
125 :     # generate a blank page
126 :     push @$html,
127 :     $cgi->start_multipart_form(),
128 :     "<h2>Generate information and links about a series of proteins</h2>\n",
129 :     "<p>Please generate a list of protein IDs. There are several methods provided. You can choose one or more organisms from the scrolling list, you can paste some gene or protein IDs into the box or you can upload a file of IDs. Or you can do all three. We will then try and map the IDs that you find onto FIG IDs. If we are able to map them you will see a table of results. If we are unable to map some we'll let you know which ones. You can separate your accessions with spaces, returns, or commas.</p>\n",
130 :     "<p>Typical IDs are in the following format:</p>\n",
131 :     "<ol>\n<li><b>FIG</b>: &nbsp; fig|83333.1.peg.1697</li>\n<li><b>Genbank</b><ul><li>Refseq: &nbsp; begin with NP_ or NC_</li>\n",
132 :     "<li>gi numbers &nbsp; These are just numeric, please add the characters 'gi|' to make a number like gi|16129669</li>\n",
133 :     "<li>GenBank Accessions &nbsp; numbers and letters such as AAF12034</li>\n</ul>\n",
134 :     "<li><b>SwissProt, PIR, Trembl, Uniprot</b> &nbsp; a single letter and some digits</li>\n",
135 : mkubal 1.3 "<li>Other types of gene/protein identifiers can be used, but these take longer to process</li></ol>\n",
136 : mkubal 1.1 "<p>","</p>\n",
137 :     "<br><b>Choose one or more organisms from this list:</b><br>\n",
138 :     $raelib->scrolling_org_list($cgi, "1"),
139 :     "<b>Or paste some IDs here:</b><br>\n",
140 :     $cgi->textarea(-name=>"proteins", -rows=>10, -columns=>40), "<br>\n",
141 :     "<br><b>Or choose a file here:</b><br>\n",
142 :     $cgi->filefield(-name=>"fileupload", -size=>50), "<br>\n",
143 :    
144 : mkubal 1.3 $cgi->submit(-name=>'request', -value=>'Protein Information by ID'),
145 :     $cgi->submit(-name=>'request', -value=>'Protein Information by Other'),
146 :     $cgi->reset, $cgi->end_form;
147 : mkubal 1.1
148 :     return $html;
149 :     }
150 :    
151 :     sub protein_info {
152 :     my ($fig,$cgi,$html,$ids)=@_;
153 :     my @no_ss_pegs; my $tab; my $no_ss_tab; my @unknowns; my $best_clusters_link; my $fc; my $sprout;
154 :     # predefine the color section for the subsys link
155 :    
156 :     # my @initial_ids = keys(%{$ids});
157 :     foreach $_ (keys(%{$ids}))
158 :     {
159 :     if ($ids->{$_} =~ /^fig/)
160 :     {
161 :     $pegs{$ids->{$_}} = $_;
162 :     }
163 :     else{push(@unknowns,$_)}
164 :     }
165 :    
166 :     my @pegs = keys(%pegs);
167 : redwards 1.6
168 :     foreach $peg (@pegs)
169 : mkubal 1.1 {
170 :     my @subs = $fig->peg_to_subsystems($peg);
171 :     if(!scalar(@subs)){ push(@no_ss_pegs,$peg)}
172 :     else
173 :     {
174 : redwards 1.6 foreach $sub ($fig->peg_to_subsystems($peg))
175 : mkubal 1.1 {
176 : mkubal 1.2 $pegs_in_subsys{$sub}->{$peg} = 1;
177 : mkubal 1.1 }
178 :     }
179 :     }
180 :    
181 : redwards 1.6 foreach $subsys (sort keys(%pegs_in_subsys))
182 : mkubal 1.1 {
183 : mkubal 1.2
184 : mkubal 1.1 my $ss_link = "<a href='display_subsys.cgi?user=$user&ssa_name=". $subsys."'>" . $subsys . "</a>";
185 :    
186 : redwards 1.6 @pegs_in_subsys = keys(%{$pegs_in_subsys{$subsys}});
187 :     foreach $peg (@pegs_in_subsys)
188 : mkubal 1.1 {
189 :     my $first = $pegs{$peg};
190 :     my $ffp=join "", map {"<a href='proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));
191 :     unless ($ffp) {$ffp=" None "}
192 :     $best_clusters_link = "<a href=" . &cgi_url . "/homologs_in_clusters.cgi?prot=$peg&user=$user&SPROUT=$sprout><img src=\"Html/button-cl.png\" border=\"0\"></a>";
193 :    
194 :     my $in_cluster = &in_cluster_with($fig,$cgi,$peg);
195 :    
196 :     if (defined(my $fc_sc = $in_cluster->{$peg}))
197 :     {
198 :     $fc = &pin_link($cgi,$peg);
199 :     }
200 :     else
201 :     {
202 :     $fc = "";
203 :     }
204 :    
205 :     push @$tab, [$ss_link, $first, "<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n",
206 :     $fig->genus_species($fig->genome_of($peg)), scalar($fig->function_of($peg, $user)),$best_clusters_link,$fc,$ffp];
207 :    
208 :     }
209 :     }
210 :    
211 :     foreach my $peg (@no_ss_pegs)
212 :     {
213 :     my $first = $pegs{$peg};
214 :     my $ffp=join "", map {"<a href='proteinfamilies.cgi?user=$user&family=$_'>" . $fig->family_function($_) . "</a><br>\n"} ($fig->families_for_protein($peg));
215 :     unless ($ffp) {$ffp=" None "}
216 :     $best_clusters_link = "<a href=" . &cgi_url . "/homologs_in_clusters.cgi?prot=$peg&user=$user&SPROUT=$sprout><img src=\"Html/button-cl.png\" border=\"0\"></a>";
217 :    
218 :     my $in_cluster = &in_cluster_with($fig,$cgi,$peg);
219 :    
220 :     if (defined(my $fc_sc = $in_cluster->{$peg}))
221 :     {
222 :     $fc = &pin_link($cgi,$peg);
223 :     }
224 :     else
225 :     {
226 :     $fc = "";
227 :     }
228 :    
229 :     push @$no_ss_tab, ["None", $first, "<a href='protein.cgi?user=$user&prot=$peg'>$peg</a>\n",
230 :     $fig->genus_species($fig->genome_of($peg)), scalar($fig->function_of($peg, $user)),$best_clusters_link,$fc,$ffp];
231 :    
232 :     }
233 :    
234 :     $tab = [sort(@$tab)];
235 :    
236 :     push @$html, &HTML::make_table(["Subsystems<br><small>Link will color subsystem with all pegs</small>","ID", "FIG ID<br><small>Link goes to protein page</small>", "Genus Species", "Functional Role", "find<br>best<br>clusters","pins","Protein Families<br><small>Link will explore Protein Family</small>"], $tab, "IDs"), "\n";
237 :    
238 :     push (@$html,"<br><h3>Pegs Not in Subsystems</h3></br>");
239 :    
240 :     push @$html, &HTML::make_table(["Subsystems<br><small>Link will color subsystem with all pegs</small>","ID", "FIG ID<br><small>Link goes to protein page</small>", "Genus Species", "Functional Role", "find<br>best<br>clusters","pins","Protein Families<br><small>Link will explore Protein Family</small>"], $no_ss_tab, "IDs"), "\n";
241 :    
242 :    
243 :     if (scalar @unknowns)
244 :     {
245 :     open (OUT, ">$FIG_Config::temp/protein_info_not_found.$$.txt") || die "Can't open $FIG_Config::temp/protein_info_not_found.$$.txt";
246 :     print OUT join "\n", "For request from ", $cgi->remote_host, " couldn't find the following IDs", @unknowns, '';
247 :     close OUT;
248 :     my $list=join "</li>\n<li>", @unknowns;
249 :     push @$html, "<p>We do not know about the following IDs. Sorry.</p><ul><li>$list</li></ul>\n";
250 :     }
251 :    
252 :     }
253 :    
254 :     sub ev_link {
255 :     my($cgi,$neigh,$sc) = @_;
256 :    
257 :     my $prot = $cgi->param('prot');
258 :     my $sprout = $cgi->param('SPROUT');
259 :     my $link = $cgi->url() . "?request=show_coupling_evidence&prot=$prot&to=$neigh&SPROUT=$sprout";
260 :     return "<a href=$link>$sc</a>";
261 :     }
262 :    
263 :     =head2 parse_ids
264 :    
265 :     Given an array or list of IDs in any format separated from each other by spaces or commas, this will return a reference to a hash. The key is the ID, and the value is a reference to an arrays of the FIG IDs that match.
266 :    
267 :     =cut
268 :    
269 : mkubal 1.3 sub parse_by_search
270 : mkubal 1.1 {
271 :    
272 :     my ($fig,$given,$org) =@_;
273 :     my %hash;
274 :    
275 :     foreach my $id (@$given)
276 :     {
277 :     chomp($id);
278 :     my $temp = $id;
279 :     my $value = "none";
280 :     if($id !~/fig/)
281 :     {
282 :     my ($peg_index_data,undef) = $fig->search_index($id);
283 :     foreach my $peg (map { $_->[0] } @$peg_index_data)
284 :     {
285 :     if ($peg =~ /$org/ )
286 :     {
287 :     $value = $peg;
288 :     }
289 :     }
290 :     }
291 :    
292 :     else{ $value = $temp};
293 :    
294 :     $hash{$id} = $value;
295 :    
296 :     }
297 :     return \%hash;
298 :     }
299 :    
300 : mkubal 1.3 sub parse_by_alias
301 :     {
302 :    
303 :     my ($fig,$given,$org) =@_;
304 :     my %hash;
305 :    
306 :     foreach my $id (@$given)
307 :     {
308 :     chomp($id);
309 :     my $temp = $id;
310 :     my $value = "none";
311 :     if($id !~/fig/)
312 :     {
313 :     my @pegs = $fig->by_alias($id);
314 :     foreach my $peg (@pegs)
315 :     {
316 :     if ($peg =~ /$org/ )
317 :     {
318 :     $value = $peg;
319 :     }
320 :     }
321 :     }
322 :    
323 :     else{ $value = $temp};
324 :    
325 :     $hash{$id} = $value;
326 :    
327 :     }
328 :     return \%hash;
329 :     }
330 :    
331 :    
332 :    
333 : mkubal 1.1 sub pin_link {
334 :     my($cgi,$peg) = @_;
335 :     my $user = $cgi->param('user');
336 :     $user = defined($user) ? $user : "";
337 :    
338 :     my $sprout = $cgi->param('SPROUT') ? 1 : "";
339 :     my $cluster_url = "chromosomal_clusters.cgi?prot=$peg&user=$user&uni=1&SPROUT=$sprout";
340 :    
341 :     my $cluster_img = 0 ? "*" : '<img src="Html/button-pins-1.png" border="0">';
342 :     my $cluster_link = "<a href=\"$cluster_url\" target=pinned_region.$$>$cluster_img</a>";
343 :     return $cluster_link;
344 :     }
345 :    
346 :     sub in_cluster_with
347 :     {
348 :     my($fig_or_sprout,$cgi,$peg) = @_;
349 :     my %in_cluster;
350 :    
351 :     if ($fig_or_sprout->table_exists('fc_pegs') && $fig_or_sprout->is_complete(&FIG::genome_of($peg)))
352 :     {
353 :     %in_cluster = map { $_->[0] => &ev_link($cgi,$_->[0],$_->[1]) } $fig_or_sprout->coupled_to($peg);
354 :     if (keys(%in_cluster) > 0)
355 :     {
356 :     $in_cluster{$peg} = "";
357 :     }
358 :     elsif ($cgi->param('fc'))
359 :     {
360 :     %in_cluster = map { $_ => "" } $fig_or_sprout->in_cluster_with($peg);
361 :     if (keys(%in_cluster) == 1)
362 :     {
363 :     my @tmp = keys(%in_cluster);
364 :     delete $in_cluster{$tmp[0]};
365 :     }
366 :     }
367 :     }
368 :     return \%in_cluster;
369 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3