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

Annotation of /FigWebServices/region.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : paczian 1.1 #
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 :     #
7 :     # The SEED Toolkit is free software. You can redistribute
8 :     # it and/or modify it under the terms of the SEED Toolkit
9 :     # Public License.
10 :     #
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 :     use strict;
19 :     use warnings;
20 :    
21 :     use CGI;
22 :     use URI::Escape;
23 :     use Data::Dumper;
24 :    
25 :     use FIG;
26 :     use FIG_CGI;
27 :     use FIG_Config;
28 :     use FigWebServices::SeedComponents;
29 :     use GenoGraphics;
30 :    
31 :     eval {
32 :     &main;
33 :     };
34 :    
35 :     if ($@)
36 :     {
37 :     my $cgi = new CGI();
38 :    
39 :     print $cgi->header();
40 :     print $cgi->start_html();
41 :    
42 :     # print out the error
43 :     print $@;
44 :    
45 :     print $cgi->end_html();
46 :    
47 :     }
48 :    
49 :     sub main {
50 :     my ($fig, $cgi, $user) = FIG_CGI::init(debug_save => 0,
51 :     debug_load => 0,
52 :     print_params => 0);
53 :     my $peg = $cgi->param('prot') || "fig|83333.1.peg.4";
54 :     my $parameters = { fig_object => $fig,
55 :     peg_id => $peg,
56 :     table_style => 'plain',
57 :     fig_disk => $FIG_Config::fig_disk . "/",
58 :     form_target => 'region.cgi',
59 :     title => "$peg Region",
60 :     user => "" };
61 :    
62 :     print $cgi->header();
63 :    
64 :     print js();
65 :    
66 :     print FigWebServices::SeedComponents::Framework::get_plain_header($parameters);
67 :    
68 :     my $gg = get_gg_data($peg, $fig, $cgi);
69 :     foreach (@{&GenoGraphics::render($gg,700,4,0,2)}) {
70 :     print;
71 :     }
72 :    
73 :     print "</body></html>";
74 :    
75 :     }
76 :    
77 :     sub js {
78 :     my $html_path = "./Html";
79 :    
80 :     return qq~<script src="$html_path\/css\/FIG.js" type="text/javascript"></script>~;
81 :     }
82 :    
83 :     sub get_gg_data {
84 :     my ($peg, $fig, $cgi) = @_;
85 :    
86 :     my $sz_region = 16000;
87 :    
88 :     my $gg = [];
89 :     my $loc = $fig->feature_location($peg);
90 :     my ($contig,$beg,$end) = $fig->boundaries_of($loc);
91 :     my $all_pegs;
92 :     if ($contig && $beg && $end) {
93 :     my $mid = int(($beg + $end) / 2);
94 :     my $min = int($mid - ($sz_region / 2));
95 :     my $max = int($mid + ($sz_region / 2));
96 :     my $genes = [];
97 :     my ($feat,undef,undef) = $fig->genes_in_region($fig->genome_of($peg),$contig,$min,$max);
98 :     foreach my $fid (@$feat) {
99 :     my $user = "master";
100 :     my ($contig1,$beg1,$end1) = $fig->boundaries_of($fig->feature_location($fid));
101 :     $beg1 = &in_bounds($min,$max,$beg1);
102 :     $end1 = &in_bounds($min,$max,$end1);
103 :     my $aliases = join( ', ', $fig->feature_aliases($fid) );
104 :     my $function = $fig->function_of($fid,$user);
105 :     my ( $uniprot ) = $aliases =~ /(uni\|[^,]+)/;
106 :     my $info = join('<br/>', "<b>PEG:</b> $fid",
107 :     "<b>Contig:</b> $contig1",
108 :     "<b>Begin:</b> $beg1",
109 :     "<b>End:</b> $end1",
110 :     $function ? "<b>Function:</b> $function" : (),
111 :     $uniprot ? "<b>Uniprot ID:</b> $uniprot" : ()
112 :     );
113 :    
114 :     my $sprout = $cgi->param('SPROUT') ? 1 : "";
115 :    
116 :     my $fmg = "<a href=\&quot;region.cgi?prot=$fid\&quot>show</a>";
117 :    
118 :     my $shape = "Rectangle";
119 :     if (($fid !~ /\.bs\./) && ($beg1 < $end1)) { $shape = "rightArrow" }
120 :     elsif (($fid !~ /\.bs\./) && ($beg1 > $end1)) { $shape = "leftArrow" }
121 :    
122 :     push(@$genes,[$fig->min($beg1,$end1),
123 :     $fig->max($beg1,$end1),
124 :     $shape,
125 :     ($fid ne $peg) ? "grey" : 'red',
126 :     "",
127 :     $fid,
128 :     $info, $fmg]);
129 :    
130 :     if ($fid =~ /peg/) {
131 :     push(@$all_pegs,$fid);
132 :     }
133 :     }
134 :    
135 :     # Sequence title can be replaced by [ title, url, popup_text, menu, popup_title ]
136 :     my $org = $fig->org_of($peg);
137 :     my $desc = "Genome: $org<br />Contig: $contig";
138 :     my $map = [ [ FIG::abbrev( $org ), undef, $desc, undef, 'Contig' ],
139 :     0,
140 :     $max+1 - $min,
141 :     ($beg < $end) ? &decr_coords($genes,$min) : &flip_map($genes,$min,$max)
142 :     ];
143 :     push(@$gg,$map);
144 :     }
145 :     &GenoGraphics::disambiguate_maps($gg);
146 :     return $gg;
147 :     }
148 :    
149 :     sub flip_map {
150 :     my($genes,$min,$max) = @_;
151 :     my($gene);
152 :    
153 :     foreach $gene (@$genes) {
154 :     ($gene->[0],$gene->[1]) = ($max - $gene->[1],$max - $gene->[0]);
155 :     if ($gene->[2] eq "rightArrow") { $gene->[2] = "leftArrow" }
156 :     elsif ($gene->[2] eq "leftArrow") { $gene->[2] = "rightArrow" }
157 :     }
158 :     return $genes;
159 :     }
160 :    
161 :     sub in_bounds {
162 :     my($min,$max,$x) = @_;
163 :    
164 :     if ($x < $min) { return $min }
165 :     elsif ($x > $max) { return $max }
166 :     else { return $x }
167 :     }
168 :    
169 :     sub decr_coords {
170 :     my($genes,$min) = @_;
171 :     my($gene);
172 :    
173 :     foreach $gene (@$genes) {
174 :     $gene->[0] -= $min;
175 :     $gene->[1] -= $min;
176 :     }
177 :     return $genes;
178 :     }
179 :    
180 :     sub in {
181 :     my($x,$xL) = @_;
182 :     my($i);
183 :    
184 :     for ($i=0; ($i < @$xL) && ($x != $xL->[$i]); $i++) {}
185 :     return ($i < @$xL);
186 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3