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

Annotation of /FigWebServices/feature.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

1 : mkubal 1.1 use FIG;
2 :     my $fig = new FIG;
3 :    
4 :     use HTML;
5 :     use strict;
6 :     use GenoGraphics;
7 :     use CGI;
8 :     my $cgi = new CGI;
9 :    
10 :     if (0)
11 :     {
12 :     my $VAR1;
13 :     eval(join("",`cat /tmp/protein_parms`));
14 :     $cgi = $VAR1;
15 :     # print STDERR &Dumper($cgi);
16 :     }
17 :    
18 :     if (0)
19 :     {
20 :     print $cgi->header;
21 :     my @params = $cgi->param;
22 :     print "<pre>\n";
23 :     foreach $_ (@params)
24 :     {
25 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
26 :     }
27 :    
28 :     if (0)
29 :     {
30 :     if (open(TMP,">/tmp/protein_parms"))
31 :     {
32 :     print TMP &Dumper($cgi);
33 :     close(TMP);
34 :     }
35 :     }
36 :     exit;
37 :     }
38 :    
39 :     my $html = [];
40 : disz 1.2 unshift @$html, "<TITLE>The SEED Feature Page</TITLE>\n";
41 : mkubal 1.1
42 :     my $feature = $cgi->param('feature');
43 :     if (! $feature)
44 :     {
45 :     unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
46 :     push(@$html,"<h1>Sorry, you need to specify a feature</h1>\n");
47 :     &HTML::show_page($cgi,$html);
48 :     exit;
49 :     }
50 :    
51 :     if ($feature !~ /^fig\|/)
52 :     {
53 :     if ($_ = $fig->by_alias($feature))
54 :     {
55 :     $feature = $_;
56 :     }
57 :     else
58 :     {
59 :     unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
60 :     push(@$html,"<h1>Sorry, $feature appears not to have a FIG id at this point</h1>\n");
61 :     &HTML::show_page($cgi,$html);
62 :     exit;
63 :     }
64 :     }
65 :    
66 : disz 1.2 #my $request = $cgi->param("request") || "";
67 : mkubal 1.1 #
68 : disz 1.2 #if ($request eq "view_annotations") { &view_annotations($fig,$cgi,$html,$feature); }
69 :     #elsif ($request eq "view_all_annotations") { &view_all_annotations($fig,$cgi,$html,$feature); }
70 :     #elsif ($request eq "dna_sequence") { &dna_sequence($fig,$cgi,$html,$feature); }
71 :     #else { &show_initial($fig,$cgi,$html,$feature); }
72 : mkubal 1.1
73 : disz 1.2 &show_initial($fig,$cgi,$html,$feature);
74 : mkubal 1.1
75 :     &HTML::show_page($cgi,$html);
76 :     exit;
77 :    
78 :    
79 :     #==============================================================================
80 :     # view_annotations
81 :     #==============================================================================
82 :    
83 :     sub view_annotations {
84 : disz 1.2 my($fig,$cgi,$html,$feature) = @_;
85 : mkubal 1.1
86 : disz 1.2 unshift @$html, "<TITLE>The SEED: eature Annotations</TITLE>\n";
87 : mkubal 1.1 my $col_hdrs = ["who","when","annotation"];
88 : disz 1.2 my $tab = [ map { [$_->[2],$_->[1],"<pre>" . $_->[3] . "<\/pre>"] } $fig->feature_annotations($feature) ];
89 : mkubal 1.1 if (@$tab > 0)
90 :     {
91 : disz 1.2 push(@$html,&HTML::make_table($col_hdrs,$tab,"Annotations for $feature"));
92 : mkubal 1.1 }
93 :     else
94 :     {
95 : disz 1.2 push(@$html,"<h1>No Annotations for $feature</h1>\n");
96 : mkubal 1.1 }
97 :     }
98 :    
99 :     sub view_all_annotations {
100 :     my($fig,$cgi,$html,$peg) = @_;
101 :     my($ann);
102 :    
103 :     unshift @$html, "<TITLE>The SEED: Protein Annotations</TITLE>\n";
104 :     if ($fig->is_real_feature($peg))
105 :     {
106 :     my $col_hdrs = ["who","when","PEG","genome","annotation"];
107 :     my @related = $fig->related_by_func_sim($peg,$cgi->param('user'));
108 :     push(@related,$peg);
109 :    
110 :     my @annotations = $fig->merged_related_annotations(\@related);
111 :    
112 :     my $tab = [ map { $ann = $_;
113 :     [$ann->[2],$ann->[1],&HTML::fid_link($cgi,$ann->[0]),
114 :     $fig->genus_species(&FIG::genome_of($ann->[0])),
115 :     "<pre>" . $ann->[3] . "</pre>"
116 :     ] } @annotations];
117 :     if (@$tab > 0)
118 :     {
119 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"All Related Annotations for $peg"));
120 :     }
121 :     else
122 :     {
123 :     push(@$html,"<h1>No Annotations for $peg</h1>\n");
124 :     }
125 :     }
126 :     }
127 :    
128 :    
129 :     #==============================================================================
130 :     # show_initial
131 :     #==============================================================================
132 :    
133 :     sub show_initial {
134 : disz 1.2 my($fig,$cgi,$html,$feature) = @_;
135 : mkubal 1.1
136 : disz 1.2 unshift @$html, "<TITLE>The SEED: Feature Page</TITLE>\n";
137 :     my $gs = $fig->org_of($feature);
138 :     if ($feature =~ /^fig\|\d+\.\d+\.peg/)
139 : mkubal 1.1 {
140 : disz 1.2 if (! $fig->is_real_feature($feature))
141 : mkubal 1.1 {
142 : disz 1.2 push(@$html,"<h1>Sorry, $feature is an unknown identifier</h1>\n");
143 : mkubal 1.1 }
144 :     else
145 :     {
146 : disz 1.2 push(@$html,"<h1>Feature $feature: $gs</h1>\n");
147 : mkubal 1.1 my $msg;
148 :     my $url = $cgi->self_url();
149 :     if ($cgi->param('translate')) {
150 :     $url =~ s/[;&]translate(=[^;&])?//i or $url =~ s/translate(=[^;&])?[;&]//i;
151 :     $msg = "Turn Off Function Translation";
152 :     }
153 :     else
154 :     {
155 :     $url .= ";translate=1";
156 :     $msg = "Translate Function Assignments";
157 :     }
158 : disz 1.2 #push(@$html, "<a href=\"$url\">$msg</a><br>\n");
159 : mkubal 1.1
160 : disz 1.2 &display_peg($fig,$cgi,$html,$feature);
161 : mkubal 1.1 }
162 :     }
163 :     else
164 :     {
165 : disz 1.2 &display_external($fig,$cgi,$html,$feature);
166 : mkubal 1.1 }
167 :     }
168 :    
169 :     #==============================================================================
170 :     # display_peg
171 :     #==============================================================================
172 :    
173 :     sub display_peg {
174 :     my($fig,$cgi,$html,$peg) = @_;
175 :     my $loc;
176 :    
177 :     my $half_sz = 5000;
178 :    
179 :     if ($loc = $fig->feature_location($peg))
180 :     {
181 :     my($contig,$beg,$end) = &FIG::boundaries_of($loc);
182 :     my $min = &FIG::max(0,&FIG::min($beg,$end) - $half_sz);
183 :     my $max = &FIG::max($beg,$end) + $half_sz;
184 :     my($feat,$min,$max) = $fig->genes_in_region(&FIG::genome_of($peg),$contig,$min,$max);
185 :    
186 :     &print_context($fig,$cgi,$html,$peg,$feat,$min,$max);
187 :     }
188 :    
189 : disz 1.2 #&print_assignments($fig,$cgi,$html,$peg);
190 :     my @links = $fig->peg_links($peg);
191 :     if (@links > 0)
192 :     {
193 :     my $col_hdrs = [1,2,3,4,5];
194 :     my $title = "Links to Related Entries in Other Sites";
195 :     my $tab = [];
196 :     my ($n,$i);
197 :     for ($i=0; ($i < @links); $i += 5)
198 :     {
199 :     $n = (($i + (5-1)) < @links) ? $i+(5-1) : $i+(@links - $i);
200 :     push(@$tab,[@links[$i..$n]]);
201 :     }
202 :     push(@$html,&HTML::make_table($col_hdrs,$tab,$title));
203 :     }
204 : mkubal 1.1 push(@$html,$cgi->hr);
205 :     my $link1 = $cgi->self_url() . "&request=view_annotations";
206 :     my $link2 = $cgi->self_url() . "&request=view_all_annotations";
207 :     push(@$html,"<br><a href=$link1>To View Annotations</a>/<a href=$link2>To View All Related Annotations</a>\n");
208 :    
209 :    
210 : disz 1.2 my $link = $cgi->self_url() . "&request=dna_sequence";
211 : mkubal 1.1 push(@$html,"<br><a href=$link>DNA Sequence</a>\n");
212 :    
213 :     $link = $cgi->url();
214 :     $link =~ s/protein.cgi/fid_checked.cgi/;
215 :     my $user = $cgi->param('user');
216 :     if (! $user)
217 :     {
218 :     $user = "";
219 :     }
220 :     else
221 :     {
222 : disz 1.2 $link = $link . "?fid=$feature&user=$user&checked=$feature&assign/annotate=assign/annotate";
223 : mkubal 1.1 push(@$html,"<br><a href=$link target=checked_window>To Make an Annotation</a>\n");
224 :     }
225 :    
226 :     my $has_translation = $fig->translatable($peg);
227 :    
228 :    
229 :     }
230 :    
231 :    
232 :    
233 :    
234 :     ################# Context on the Chromosome ############################
235 :    
236 :     sub print_context {
237 :     my($fig,$cgi,$html,$peg,$feat,$beg,$end) = @_;
238 : disz 1.2 my($contig1,$beg1,$end1,$strand,$max_so_far,$comment, $aliases);
239 :     my($fid1,$sz,$color,$map,$gg,$n,$link);
240 : mkubal 1.1
241 :    
242 :     my $user = $cgi->param('user');
243 :     push(@$html,$cgi->start_form(-action => &FIG::cgi_url . "/chromosomal_clusters.cgi"),
244 : disz 1.2 $cgi->hidden(-name => "feature", -value => $peg),
245 : mkubal 1.1 $cgi->hidden(-name => "user", -value => $user));
246 :    
247 : disz 1.2 my $col_hdrs = ["fid","starts","ends","size","","comment","aliases"];
248 : mkubal 1.1 my($tab) = [];
249 :     my $genes = [];
250 :    
251 : disz 1.2 #my $peg_function = &trans_function_of($cgi,$fig,$peg,$user);
252 : mkubal 1.1
253 : disz 1.2 #my($role,$role1,%related_roles);
254 :     #foreach $role (&FIG::roles_of_function($peg_function))
255 :     #{
256 :     # foreach $role1 ($fig->neighborhood_of_role($role))
257 :     # {
258 :     # $related_roles{$role1} = 1;
259 :     # }
260 :     # }
261 : mkubal 1.1
262 :     foreach $fid1 (@$feat)
263 :     {
264 :     $aliases = join( ', ', $fig->feature_aliases($fid1) );
265 :     ($contig1,$beg1,$end1) = $fig->boundaries_of(scalar $fig->feature_location($fid1));;
266 :     $strand = ($beg1 < $end1) ? "+" : "-";
267 :    
268 :     if ($fid1 eq $peg) { $color = "green" }
269 :     else { $color = "red" }
270 :    
271 :     if ($fid1 =~ /peg\.(\d+)$/)
272 :     {
273 :     $n = $1;
274 : disz 1.2 $link = $cgi->url() . "?feature=$fid1&user=$user";
275 : mkubal 1.1 }
276 :     elsif ($fid1 =~ /\.([a-z]+)\.\d+$/)
277 :     {
278 :     $n = uc $1;
279 :     $link = "";
280 :     }
281 :     else
282 :     {
283 :     $n ="";
284 :     $link = "";
285 :     }
286 :    
287 :     push(@$genes,[&FIG::min($beg1,$end1),&FIG::max($beg1,$end1),($strand eq "+") ? "rightArrow" : "leftArrow", $color,$n,$link]);
288 :     $max_so_far = &FIG::max($beg1,$end1);
289 :    
290 :    
291 :     if (&FIG::ftype($fid1) eq "peg")
292 :     {
293 :     $comment = &trans_function_of($cgi,$fig,$fid1,$user);
294 :     }
295 :     else
296 :     {
297 :     $comment = "";
298 :     }
299 :     $comment = &set_map_links($fig,&FIG::genome_of($fid1),$comment);
300 :     if ($fid1 eq $peg)
301 :     {
302 :     $comment = "\@bgcolor=\"#00FF00\":$comment";
303 :     }
304 :     $sz = abs($end1-$beg1)+1;
305 :    
306 : disz 1.2
307 :     push(@$tab,[&HTML::fid_link($cgi,$fid1,"local"),$beg1,$end1,$sz,$strand,
308 :     $comment,&HTML::set_prot_links($cgi,$aliases)]);
309 : mkubal 1.1 }
310 :     $map = ["",$beg,$end,$genes];
311 :     $gg = [$map];
312 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"Context on contig $contig1"));
313 : disz 1.2 # push(@$html,$cgi->br,$cgi->submit('pin with checked genes'),$cgi->end_form,$cgi->br);
314 : mkubal 1.1 push(@$html,@{ &GenoGraphics::render($gg,700,4,0,1) });
315 :     return;
316 :     }
317 :    
318 :     sub set_map_links {
319 :     my($fig,$org,$func) = @_;
320 :    
321 :     if ($func =~ /^(.*)(\d+\.\d+\.\d+\.\d+)(.*)$/)
322 :     {
323 :     my $before = $1;
324 :     my $ec = $2;
325 :     my $after = $3;
326 :     return &set_map_links($fig,$org,$before) . &set_ec_to_maps($fig,$org,$ec) . &set_map_links($fig,$org,$after);
327 :     }
328 :     return $func;
329 :     }
330 :    
331 :     sub set_ec_to_maps {
332 :     my($fig,$org,$ec) = @_;
333 :    
334 :     my @maps = $fig->ec_to_maps($ec);
335 :     if (@maps > 0)
336 :     {
337 :     $cgi->delete('request');
338 :     my $url = $cgi->self_url() . "&request=ec_to_maps&ec=$ec&org=$org";
339 :     my $link = "<a href=\"$url\">$ec</a>";
340 :     return $link;
341 :     }
342 :     return $ec;
343 :     }
344 :    
345 :     sub show_ec_to_maps {
346 :     my($fig,$cgi,$html,$ec) = @_;
347 :    
348 :     my $ec = $cgi->param('ec');
349 :     if (! $ec)
350 :     {
351 :     push(@$html,$cgi->h1("Missing EC number"));
352 :     return;
353 :     }
354 :    
355 :     my @maps = $fig->ec_to_maps($ec);
356 :     if (@maps > 0)
357 :     {
358 :     my $col_hdrs = ["map","metabolic topic"];
359 :     my $map;
360 :     my $tab = [map { $map = $_; [&map_link($cgi,$map),$fig->map_name($map)] } @maps];
361 :     push(@$html,&HTML::make_table($col_hdrs,$tab,"$ec: " . $fig->ec_name($ec)));
362 :     }
363 :     }
364 :    
365 :     sub map_link {
366 :     my($cgi,$map) = @_;
367 :    
368 :     $cgi->delete('request');
369 :     my $url = $cgi->self_url() . "&request=link_to_map&map=$map";
370 :     my $link = "<a href=\"$url\">$map</a>";
371 :     return $link;
372 :     }
373 :    
374 :     sub link_to_map {
375 :     my($fig,$cgi,$html) = @_;
376 :    
377 :     my $map = $cgi->param('map');
378 :     if (! $map)
379 :     {
380 :     push(@$html,$cgi->h1("Missing Map"));
381 :     return;
382 :     }
383 :    
384 :     my $org = $cgi->param('org');
385 :     if (! $org)
386 :     {
387 :     push(@$html,$cgi->h1("Missing Org Parameter"));
388 :     return;
389 :     }
390 :     my$user = $cgi->param('user');
391 :     $user = $user ? $user : "";
392 :    
393 :     $ENV{"REQUEST_METHOD"} = "GET";
394 :     $ENV{"QUERY_STRING"} = "user=$user&map=$map&org=$org";
395 :     my @out = `./show_kegg_map.cgi`;
396 :     &HTML::trim_output(\@out);
397 :     push(@$html,@out);
398 :     }
399 :    
400 :    
401 :     sub dna_sequence {
402 :     my($fig,$cgi,$html,$fid) = @_;
403 :     my($seq,$func,$i);
404 :    
405 :     unshift @$html, "<TITLE>The SEED: Nucleotide Sequence</TITLE>\n";
406 :     if ($seq = $fig->dna_seq($fig->genome_of($fid),scalar $fig->feature_location($fid)))
407 :     {
408 : disz 1.2 $func = $fig->function_of($feature,$cgi->param('user'));
409 : mkubal 1.1 push(@$html,$cgi->pre,">$fid $func\n");
410 :     for ($i=0; ($i < length($seq)); $i += 60)
411 :     {
412 :     if ($i > (length($seq) - 60))
413 :     {
414 :     push(@$html,substr($seq,$i) . "\n");
415 :     }
416 :     else
417 :     {
418 :     push(@$html,substr($seq,$i,60) . "\n");
419 :     }
420 :     }
421 :     push(@$html,$cgi->end_pre);
422 :     }
423 :     else
424 :     {
425 :     push(@$html,$cgi->h1("No DNA sequence available for $fid"));
426 :     }
427 :     }
428 :    
429 :    
430 :    
431 :    
432 :     sub in {
433 :     my($x,$xL) = @_;
434 :     my($i);
435 :    
436 :     for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
437 :     return ($i < @$xL);
438 :     }
439 :    
440 :     sub in_bounds {
441 :     my($min,$max,$x) = @_;
442 :    
443 :     if ($x < $min) { return $min }
444 :     elsif ($x > $max) { return $max }
445 :     else { return $x }
446 :     }
447 :    
448 :     sub decr_coords {
449 :     my($genes,$min) = @_;
450 :     my($gene);
451 :    
452 :     foreach $gene (@$genes)
453 :     {
454 :     $gene->[0] -= $min;
455 :     $gene->[1] -= $min;
456 :     }
457 :     return $genes;
458 :     }
459 :    
460 :     sub flip_map {
461 :     my($genes,$min,$max) = @_;
462 :     my($gene);
463 :    
464 :     foreach $gene (@$genes)
465 :     {
466 :     ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
467 :     $gene->[2] = ($gene->[2] eq "rightArrow") ? "leftArrow" : "rightArrow";
468 :     }
469 :     return $genes;
470 :     }
471 :    
472 :     sub cluster_genes {
473 :     my($all_pegs,$peg) = @_;
474 :     my(%seen,$i,$j,$k,$x,$cluster,$conn,$pegI,$red_set);
475 :    
476 :     my @color_sets = ();
477 :    
478 :     $conn = &get_connections_by_similarity($all_pegs);
479 :     for ($i=0; ($i < @$all_pegs); $i++)
480 :     {
481 :     if ($all_pegs->[$i] eq $peg) { $pegI = $i }
482 :     if (! $seen{$i})
483 :     {
484 :     $cluster = [$i];
485 :     $seen{$i} = 1;
486 :     for ($j=0; ($j < @$cluster); $j++)
487 :     {
488 :     $x = $conn->{$cluster->[$j]};
489 :     foreach $k (@$x)
490 :     {
491 :     if (! $seen{$k})
492 :     {
493 :     push(@$cluster,$k);
494 :     $seen{$k} = 1;
495 :     }
496 :     }
497 :     }
498 :    
499 :     if ((@$cluster > 1) || ($cluster->[0] eq $pegI))
500 :     {
501 :     push(@color_sets,$cluster);
502 :     }
503 :     }
504 :     }
505 :     for ($i=0; ($i < @color_sets) && (! &in($pegI,$color_sets[$i])); $i++) {}
506 :     $red_set = $color_sets[$i];
507 :     splice(@color_sets,$i,1);
508 :     @color_sets = sort { @$b <=> @$a } @color_sets;
509 :     unshift(@color_sets,$red_set);
510 :    
511 :     my $color_sets = {};
512 :     for ($i=0; ($i < @color_sets); $i++)
513 :     {
514 :     foreach $x (@{$color_sets[$i]})
515 :     {
516 :     $color_sets->{$all_pegs->[$x]} = $i;
517 :     }
518 :     }
519 :     return $color_sets;
520 :     }
521 :    
522 :     sub get_connections_by_similarity {
523 :     my($all_pegs) = @_;
524 :     my($i,$j,$tmp,$peg,%pos_of);
525 :     my($sim,%conn,$x,$y);
526 :    
527 :     for ($i=0; ($i < @$all_pegs); $i++)
528 :     {
529 :     $tmp = $fig->maps_to_id($all_pegs->[$i]);
530 :     push(@{$pos_of{$tmp}},$i); # map the representative in nr to subscript in all_pegs
531 :     if ($tmp ne $all_pegs->[$i])
532 :     {
533 :     push(@{$pos_of{$all_pegs->[$i]}},$i);
534 :     }
535 :     }
536 :    
537 :     foreach $y (keys(%pos_of))
538 :     {
539 :     $x = $pos_of{$y};
540 :     for ($i=0; ($i < @$x); $i++)
541 :     {
542 :     for ($j=$i+1; ($j < @$x); $j++)
543 :     {
544 :     push(@{$conn{$x->[$i]}},$x->[$j]);
545 :     push(@{$conn{$x->[$j]}},$x->[$i]);
546 :     }
547 :     }
548 :     }
549 :    
550 :     for ($i=0; ($i < @$all_pegs); $i++)
551 :     {
552 :     foreach $sim ($fig->sims($all_pegs->[$i],500,1.0e-5,"raw"))
553 :     {
554 :     if (defined($x = $pos_of{$sim->id2}))
555 :     {
556 :     foreach $y (@$x)
557 :     {
558 :     push(@{$conn{$i}},$y);
559 :     }
560 :     }
561 :     }
562 :     }
563 :     return \%conn;
564 :     }
565 :    
566 :     sub set_colors_text_and_links {
567 :     my($gg,$all_pegs,$color_sets) = @_;
568 :     my($map,$gene,$peg,$color);
569 :    
570 :     foreach $map (@$gg)
571 :     {
572 :     foreach $gene (@{$map->[3]})
573 :     {
574 :     $peg = $gene->[5];
575 :     if (defined($color = $color_sets->{$peg}))
576 :     {
577 :     $gene->[3] = ($color == 0) ? "red" : "color$color";
578 :     $gene->[4] = $color + 1;
579 :     }
580 :     $gene->[5] = &peg_url($cgi,$peg);
581 :     }
582 :     }
583 :     }
584 :    
585 :     sub peg_url {
586 :     my($cgi,$peg) = @_;
587 :    
588 :     my $prot = $cgi->param('prot');
589 :     $cgi->delete('prot');
590 :     my $url = $cgi->self_url() . "&prot=$peg&compare_region=1";
591 :     $cgi->delete('prot');
592 :     $cgi->param(-name => 'prot', -value => $prot);
593 :    
594 :     return $url;
595 :     }
596 :    
597 : disz 1.2 sub trans_function_of {
598 :     my($cgi,$fig,$peg,$user) = @_;
599 : mkubal 1.1
600 : disz 1.2 if (wantarray())
601 :     {
602 :     my $x;
603 :     my @funcs = $fig->function_of($peg);
604 :     if ($cgi->param('translate'))
605 :     {
606 :     @funcs = map { $x = $_; $x->[1] = $fig->translate_function($x->[1]); $x } @funcs;
607 :     }
608 :     return @funcs;
609 :     }
610 :     else
611 : mkubal 1.1 {
612 : disz 1.2 my $func = $fig->function_of($peg,$user);
613 :     if ($cgi->param('translate'))
614 : mkubal 1.1 {
615 : disz 1.2 $func = $fig->translate_function($func);
616 : mkubal 1.1 }
617 : disz 1.2 return $func;
618 : mkubal 1.1 }
619 :     }
620 : disz 1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3