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

Annotation of /FigWebServices/feature.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3