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

Annotation of /FigWebServices/feature.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (view) (download)

1 : olson 1.6 #
2 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
3 :     # for Interpretations of Genomes. All Rights Reserved.
4 :     #
5 :     # This file is part of the SEED Toolkit.
6 : parrello 1.7 #
7 : olson 1.6 # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 : parrello 1.7 # Public License.
10 : olson 1.6 #
11 :     # You should have received a copy of the SEED Toolkit Public License
12 :     # along with this program; if not write to the University of Chicago
13 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14 :     # Genomes at veronika@thefig.info or download a copy from
15 :     # http://www.theseed.org/LICENSE.TXT.
16 :     #
17 :    
18 : mkubal 1.1 use FIG;
19 :     my $fig = new FIG;
20 :    
21 :     use HTML;
22 :     use strict;
23 :     use GenoGraphics;
24 :     use CGI;
25 :     my $cgi = new CGI;
26 : overbeek 1.8 use FIG_CGI;
27 :     use FigWebServices::SeedComponents;
28 : mkubal 1.1
29 : overbeek 1.8 my ($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0,
30 :     debug_load => 1,
31 :     print_params => 0
32 :     );
33 : mkubal 1.1 my $html = [];
34 : disz 1.2 unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";
35 : overbeek 1.8 push(@$html,"<link type='text/css' rel='stylesheet' href='./Html/frame.css'>");
36 : mkubal 1.1
37 :     my $feature = $cgi->param('feature');
38 :     if (! $feature)
39 :     {
40 :     unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
41 :     push(@$html,"<h1>Sorry, you need to specify a feature</h1>\n");
42 :     &HTML::show_page($cgi,$html);
43 :     exit;
44 :     }
45 :    
46 :     if ($feature !~ /^fig\|/)
47 :     {
48 :     if ($_ = $fig->by_alias($feature))
49 :     {
50 :     $feature = $_;
51 :     }
52 :     else
53 :     {
54 :     unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
55 :     push(@$html,"<h1>Sorry, $feature appears not to have a FIG id at this point</h1>\n");
56 :     &HTML::show_page($cgi,$html);
57 :     exit;
58 :     }
59 :     }
60 :    
61 : disz 1.3 my $request = $cgi->param("request") || "";
62 :    
63 : overbeek 1.8 if ($request eq "view_annotations") { &view_annotations($fig,$cgi,$html,$feature); }
64 : disz 1.3 elsif ($request eq "view_all_annotations") { &view_all_annotations($fig,$cgi,$html,$feature); }
65 :     elsif ($request eq "dna_sequence") { &dna_sequence($fig,$cgi,$html,$feature); }
66 :     else { &show_initial($fig,$cgi,$html,$feature); }
67 : mkubal 1.1
68 :    
69 :     &HTML::show_page($cgi,$html);
70 :     exit;
71 :    
72 :    
73 :     #==============================================================================
74 :     # view_annotations
75 :     #==============================================================================
76 :    
77 :     sub view_annotations {
78 : disz 1.2 my($fig,$cgi,$html,$feature) = @_;
79 : mkubal 1.1
80 : disz 1.2 unshift @$html, "<TITLE>The SEED: eature Annotations</TITLE>\n";
81 : mkubal 1.1 my $col_hdrs = ["who","when","annotation"];
82 : disz 1.2 my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($feature) ];
83 : mkubal 1.1 if (@$tab > 0)
84 :     {
85 : disz 1.2 push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $feature"));
86 : mkubal 1.1 }
87 :     else
88 :     {
89 : disz 1.2 push(@$html,"<h1>No Annotations for $feature</h1>\n");
90 : mkubal 1.1 }
91 :     }
92 :    
93 :     sub view_all_annotations {
94 :     my($fig,$cgi,$html,$peg) = @_;
95 :     my($ann);
96 :    
97 :     unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
98 :     if ($fig->is_real_feature($peg))
99 :     {
100 :     my $col_hdrs = ["who","when","PEG","genome","annotation"];
101 :     my @related = $fig->related_by_func_sim($peg,$cgi->param('user'));
102 :     push(@related,$peg);
103 :    
104 :     my @annotations = $fig->merged_related_annotations(\@related);
105 :    
106 : parrello 1.7 my $tab = [ map { $ann = $_;
107 : mkubal 1.1 [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
108 :     $fig->genus_species(&FIG::genome_of($ann->[0])),
109 :     "<pre>" . $ann->[3] . "</pre>"
110 :     ] } @annotations];
111 :     if (@$tab > 0)
112 :     {
113 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
114 :     }
115 :     else
116 :     {
117 :     push(@$html,"<h1>No Annotations for $peg</h1>\n");
118 :     }
119 :     }
120 :     }
121 :    
122 :    
123 :     #==============================================================================
124 :     # show_initial
125 :     #==============================================================================
126 :    
127 :     sub show_initial {
128 : disz 1.2 my($fig,$cgi,$html,$feature) = @_;
129 : mkubal 1.1
130 : disz 1.2 unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
131 :     my $gs = $fig->org_of($feature);
132 : overbeek 1.8
133 :     if (! $fig->is_real_feature($feature))
134 :     {
135 :     push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");
136 :     }
137 :     else
138 :     {
139 :     push(@$html,"<h1>Feature $feature: $gs</h1>\n");
140 :     my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1);
141 :     &display_fid($fig,$cgi,$html,$feature);
142 :     }
143 : mkubal 1.1 }
144 :    
145 :     #==============================================================================
146 : overbeek 1.8 # display_fid
147 : mkubal 1.1 #==============================================================================
148 :    
149 : overbeek 1.8 sub display_fid {
150 :     my($fig,$cgi,$html,$fid) = @_;
151 : mkubal 1.1 my $loc;
152 :    
153 : overbeek 1.8
154 :     my $graph = &FigWebServices::SeedComponents::Protein::get_peg_view({ fig_object => $fig,
155 :     peg_id => $fid
156 :     }
157 :     );
158 :     push(@$html,$graph);
159 :    
160 :     my $contextH = &FigWebServices::SeedComponents::Protein::get_chromosome_context({ fig_object => $fig,
161 :     peg_id => $fid
162 :     }
163 :     );
164 :    
165 :     push(@$html,$contextH->{table});
166 : mkubal 1.1
167 :     push(@$html,$cgi->hr);
168 : overbeek 1.5 my $link1 = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=view_annotations";
169 :     my $link2 = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=view_all_annotations";
170 : mkubal 1.1 push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
171 :    
172 :    
173 : overbeek 1.5 my $link = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&request=dna_sequence";
174 : mkubal 1.1 push(@$html,"<br><a href=$link>DNA Sequence</a>\n");
175 :    
176 : overbeek 1.5 $link = $cgi->url(-relative => 1);
177 : mkubal 1.1 $link =~ s/protein.cgi/fid_checked.cgi/;
178 :     my $user = $cgi->param('user');
179 : parrello 1.7 if (! $user)
180 :     {
181 : mkubal 1.1 $user = "";
182 :     }
183 :     else
184 :     {
185 : disz 1.2 $link = $link . "?fid=$feature&user=$user&checked=$feature&assign/annotate=assign/annotate";
186 : mkubal 1.1 push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
187 :     }
188 :    
189 : overbeek 1.8 my $has_translation = $fig->translatable($fid);
190 : mkubal 1.1
191 :    
192 :     }
193 :    
194 :     sub dna_sequence {
195 :     my($fig,$cgi,$html,$fid) = @_;
196 :     my($seq,$func,$i);
197 :    
198 :     unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
199 :     if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))
200 :     {
201 : disz 1.2 $func = $fig->function_of($feature,$cgi->param('user'));
202 : mkubal 1.1 push(@$html,$cgi->pre,">$fid $func\n");
203 :     for ($i=0; ($i < length($seq)); $i += 60)
204 :     {
205 :     if ($i > (length($seq) - 60))
206 :     {
207 :     push(@$html,substr($seq,$i) . "\n");
208 :     }
209 :     else
210 :     {
211 :     push(@$html,substr($seq,$i,60) . "\n");
212 :     }
213 :     }
214 :     push(@$html,$cgi->end_pre);
215 :     }
216 :     else
217 :     {
218 :     push(@$html,$cgi->h1("No DNA sequence available for $fid"));
219 :     }
220 :     }
221 : parrello 1.7
222 : mkubal 1.1
223 :    
224 :    
225 :     sub in {
226 :     my($x,$xL) = @_;
227 :     my($i);
228 :    
229 :     for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
230 :     return ($i < @$xL);
231 :     }
232 :    
233 :     sub in_bounds {
234 :     my($min,$max,$x) = @_;
235 :    
236 :     if ($x < $min) { return $min }
237 :     elsif ($x > $max) { return $max }
238 :     else { return $x }
239 :     }
240 :    
241 :     sub decr_coords {
242 :     my($genes,$min) = @_;
243 :     my($gene);
244 :    
245 :     foreach $gene (@$genes)
246 :     {
247 :     $gene->[0] -= $min;
248 :     $gene->[1] -= $min;
249 :     }
250 :     return $genes;
251 :     }
252 :    
253 :     sub flip_map {
254 :     my($genes,$min,$max) = @_;
255 :     my($gene);
256 : parrello 1.7
257 : mkubal 1.1 foreach $gene (@$genes)
258 :     {
259 :     ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
260 :     $gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
261 :     }
262 :     return $genes;
263 :     }
264 :    
265 :     sub cluster_genes {
266 :     my($all_pegs,$peg) = @_;
267 :     my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
268 :    
269 :     my @color_sets = ();
270 :    
271 :     $conn = &get_connections_by_similarity($all_pegs);
272 :     for ($i=0; ($i < @$all_pegs); $i++)
273 :     {
274 :     if ($all_pegs->[$i] eq $peg) { $pegI = $i }
275 :     if (! $seen{$i})
276 :     {
277 :     $cluster = [$i];
278 :     $seen{$i} = 1;
279 :     for ($j=0; ($j < @$cluster); $j++)
280 :     {
281 :     $x = $conn->{$cluster->[$j]};
282 :     foreach $k (@$x)
283 :     {
284 :     if (! $seen{$k})
285 :     {
286 :     push(@$cluster,$k);
287 :     $seen{$k} = 1;
288 :     }
289 :     }
290 :     }
291 :    
292 :     if ((@$cluster > 1) || ($cluster->[0] eq $pegI))
293 :     {
294 :     push(@color_sets,$cluster);
295 :     }
296 :     }
297 :     }
298 :     for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
299 :     $red_set = $color_sets[$i];
300 :     splice(@color_sets,$i,1);
301 :     @color_sets = sort { @$b <=> @$a } @color_sets;
302 :     unshift(@color_sets,$red_set);
303 :    
304 :     my $color_sets = {};
305 :     for ($i=0; ($i < @color_sets); $i++)
306 :     {
307 :     foreach $x (@{$color_sets[$i]})
308 :     {
309 :     $color_sets->{$all_pegs->[$x]} = $i;
310 :     }
311 :     }
312 :     return $color_sets;
313 :     }
314 :    
315 :     sub get_connections_by_similarity {
316 :     my($all_pegs) = @_;
317 :     my($i,$j,$tmp,$peg,%pos_of);
318 :     my($sim,%conn,$x,$y);
319 :    
320 :     for ($i=0; ($i < @$all_pegs); $i++)
321 :     {
322 :     $tmp = $fig->maps_to_id($all_pegs->[$i]);
323 :     push(@{$pos_of{$tmp}},$i); # map the representative in nr to subscript in all_pegs
324 :     if ($tmp ne $all_pegs->[$i])
325 :     {
326 :     push(@{$pos_of{$all_pegs->[$i]}},$i);
327 :     }
328 :     }
329 :    
330 :     foreach $y (keys(%pos_of))
331 :     {
332 :     $x = $pos_of{$y};
333 :     for ($i=0; ($i < @$x); $i++)
334 :     {
335 :     for ($j=$i+1; ($j < @$x); $j++)
336 :     {
337 :     push(@{$conn{$x->[$i]}},$x->[$j]);
338 :     push(@{$conn{$x->[$j]}},$x->[$i]);
339 :     }
340 :     }
341 :     }
342 :    
343 :     for ($i=0; ($i < @$all_pegs); $i++)
344 :     {
345 :     foreach $sim ($fig->sims($all_pegs->[$i],500,1.0e-5,"raw"))
346 :     {
347 :     if (defined($x = $pos_of{$sim->id2}))
348 :     {
349 :     foreach $y (@$x)
350 :     {
351 :     push(@{$conn{$i}},$y);
352 :     }
353 :     }
354 :     }
355 :     }
356 :     return \%conn;
357 :     }
358 :    
359 :     sub set_colors_text_and_links {
360 :     my($gg,$all_pegs,$color_sets) = @_;
361 :     my($map,$gene,$peg,$color);
362 :    
363 :     foreach $map (@$gg)
364 :     {
365 :     foreach $gene (@{$map->[3]})
366 :     {
367 :     $peg = $gene->[5];
368 :     if (defined($color = $color_sets->{$peg}))
369 :     {
370 :     $gene->[3] = ($color == 0) ? "red" : "color$color";
371 :     $gene->[4] = $color + 1;
372 :     }
373 :     $gene->[5] = &peg_url($cgi,$peg);
374 :     }
375 :     }
376 :     }
377 :    
378 :     sub peg_url {
379 :     my($cgi,$peg) = @_;
380 :    
381 :     my $prot = $cgi->param('prot');
382 :     $cgi->delete('prot');
383 : overbeek 1.5 my $url = $cgi->url(-relative => 1, -query => 1, -path_info => 1) . "&prot=$peg&compare_region=1";
384 : mkubal 1.1 $cgi->delete('prot');
385 :     $cgi->param(-name => 'prot', -value => $prot);
386 :    
387 :     return $url;
388 : parrello 1.7 }
389 : mkubal 1.1
390 : disz 1.2 sub trans_function_of {
391 :     my($cgi,$fig,$peg,$user) = @_;
392 : mkubal 1.1
393 : disz 1.2 if (wantarray())
394 :     {
395 :     my $x;
396 :     my @funcs = $fig->function_of($peg);
397 :     if ($cgi->param('translate'))
398 :     {
399 :     @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;
400 :     }
401 :     return @funcs;
402 :     }
403 :     else
404 : mkubal 1.1 {
405 : disz 1.2 my $func = $fig->function_of($peg,$user);
406 :     if ($cgi->param('translate'))
407 : mkubal 1.1 {
408 : disz 1.2 $func = $fig->translate_function($func);
409 : mkubal 1.1 }
410 : disz 1.2 return $func;
411 : mkubal 1.1 }
412 :     }
413 : disz 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3