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

Annotation of /FigWebServices/feature.cgi

Parent Directory Parent Directory | Revision Log Revision Log


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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3