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

Annotation of /FigWebServices/align_DNA.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download)

1 : overbeek 1.1 # -*- perl -*-
2 : olson 1.5 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 :     #
8 :     # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 :     # Public License.
11 :     #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : overbeek 1.1
20 :     use URI::Escape; # uri_escape()
21 :     use HTML;
22 :     use strict;
23 :     use tree_utilities;
24 :    
25 :     use CGI;
26 :    
27 :     my $cgi = new CGI;
28 :     if (0)
29 :     {
30 :     my $VAR1;
31 :     eval(join("",`cat /tmp/align_dna_parms`));
32 :     $cgi = $VAR1;
33 : overbeek 1.2 print STDERR &Dumper($cgi);
34 : overbeek 1.1 }
35 :    
36 :     if (0)
37 :     {
38 :     print $cgi->header;
39 :     my @params = $cgi->param;
40 :     print "<pre>\n";
41 :     foreach $_ (@params)
42 :     {
43 :     print "$_\t:",join(",",$cgi->param($_)),":\n";
44 :     }
45 :    
46 :     if (0)
47 :     {
48 :     if (open(TMP,">/tmp/align_dna_parms"))
49 :     {
50 :     print TMP &Dumper($cgi);
51 :     close(TMP);
52 :     }
53 :     }
54 :     exit;
55 :     }
56 :    
57 :     use FIG;
58 :     my $fig = new FIG;
59 :    
60 :     my $html = [];
61 :     push @$html, "<TITLE>SEED Align DNA</TITLE>\n";
62 :    
63 :     #
64 :     # parameters: @ids = $cgi->param('peg') are the ids of the relevant PEGs
65 :     # $upstream = $cgi->param('upstream') # of characters upstream (default = 0)
66 :     # $gene = $cgi->param('gene') # of characters of gene (defaults to all)
67 :     #
68 :    
69 :     my $upstream = $cgi->param('upstream');
70 :     $upstream = $upstream ? $upstream : 0;
71 :    
72 :     my $gene = $cgi->param('gene');
73 : overbeek 1.2 my @pegs = $cgi->param('peg');
74 : overbeek 1.1
75 :     my $seqF = "$FIG_Config::temp/dna$$.fasta";
76 :     open(SEQ,">$seqF") || die "could not open $seqF";
77 :    
78 :     my $peg;
79 :     my $n = 0;
80 : overbeek 1.2 my %data_per_seq;
81 :     foreach $peg (@pegs)
82 : overbeek 1.1 {
83 : overbeek 1.2 my($coding,$location);
84 :     $location = $fig->feature_location($peg);
85 :     my($contig,$beg,$end) = $fig->boundaries_of($location);
86 :     if ((! defined($gene)) || ($gene !~ /^\d+/))
87 : overbeek 1.1 {
88 : overbeek 1.2 $coding = $fig->dna_seq(&FIG::genome_of($peg),$location)
89 : overbeek 1.1 }
90 :     elsif ($gene > 0)
91 :     {
92 : overbeek 1.2 $coding = substr($fig->dna_seq(&FIG::genome_of($peg),$location),0,$gene);
93 : overbeek 1.1 }
94 :     else
95 :     {
96 :     $coding = "";
97 :     }
98 :    
99 : overbeek 1.2 my $trans;
100 : overbeek 1.3 if ((length($coding) > 2) && $cgi->param('Show With Translation'))
101 : overbeek 1.2 {
102 :     $trans = $fig->get_translation($peg);
103 :     }
104 :     else
105 :     {
106 :     $trans = "";
107 :     }
108 :    
109 : overbeek 1.1 my $upstream_seq = "";
110 :     if ($upstream)
111 :     {
112 :     $upstream_seq = $fig->upstream_of($peg,$upstream,0);
113 :     }
114 :     my $seq = $upstream_seq . $coding;
115 :     print SEQ ">$peg\n$seq\n";
116 : overbeek 1.2 $data_per_seq{$peg} = [0,$beg,($beg < $end) ? '+' : '-',length($upstream_seq),$trans];
117 : overbeek 1.1 $n++;
118 :     }
119 :     close(SEQ);
120 :    
121 :     if ($n > 1)
122 :     {
123 : overbeek 1.2 push(@$html,$cgi->start_form(-action => "align_DNA.cgi",
124 :     -method => 'post'),
125 :     $cgi->hidden(-name => 'peg', -value => [@pegs], -override => 1),
126 : overbeek 1.3 $cgi->param('Show With Translation') ? $cgi->submit('Show Without Translation')
127 :     : $cgi->submit('Show With Translation'),
128 : overbeek 1.2 $cgi->br,$cgi->br,$cgi->br,
129 :     "&nbsp;","&nbsp;","Size upstream: ",
130 :     $cgi->textfield(-name => 'upstream', -size => 4, -value => $upstream),
131 :     "&nbsp;","&nbsp;",
132 :     "&nbsp;","&nbsp;", "Restrict coding area to (optional): ",
133 :     $cgi->textfield(-name => 'gene', -size => 4, -value => $gene),
134 :     $cgi->br,$cgi->br,$cgi->br
135 :     );
136 :    
137 :    
138 : overbeek 1.1 $/ = "\n>";
139 :     my @tmp = `$FIG_Config::bin/align_fasta < $seqF`;
140 :    
141 : overbeek 1.2 my($ln,@pegs);
142 : overbeek 1.1 while (defined($_ = shift @tmp))
143 :     {
144 :     chomp;
145 :     if ($_ =~ /^>?(\S+)[^\n]*\n(.*)/s)
146 :     {
147 :     my $peg = $1;
148 :     my $seq = $2;
149 :     $seq =~ s/\s//gs;
150 : overbeek 1.2 push(@{$data_per_seq{$peg}},$seq);
151 :     if (! $ln) { $ln = length($seq) }
152 :     push(@pegs,$peg);
153 :     }
154 :     }
155 :     if (@pegs < 2)
156 :     {
157 :     push(@$html,$cgi->h1('Too few sequences or alignment failure'));
158 :     }
159 :     else
160 :     {
161 :     my $i=0;
162 :     for ($i=0; ($i < $ln); $i += 50)
163 :     {
164 :     &process_one_block($fig,$cgi,$html,\@pegs,$i,($i < ($ln-50)) ? 50 : ($ln - $i),\%data_per_seq);
165 :     push(@$html,$cgi->br,$cgi->br,$cgi->br,$cgi->br);
166 : overbeek 1.1 }
167 :     }
168 :     }
169 :     else
170 :     {
171 :     push(@$html,$cgi->h1("Less than 2 sequences defined -- alignment failed"));
172 :     }
173 : overbeek 1.2 #unlink $seqF;
174 : overbeek 1.1 &HTML::show_page($cgi, $html);
175 : overbeek 1.2
176 :     sub process_one_block {
177 :     my($fig,$cgi,$html,$pegs,$i,$n,$data_per_seq) = @_;
178 :     my($peg,@coding,$j);
179 :    
180 :     push(@$html,"<table border>\n");
181 :     foreach $peg (@$pegs)
182 :     {
183 :     my $data = $data_per_seq->{$peg};
184 :    
185 :     my($offset,$beg,$strand,$upstream_left,$translation,$seq) = @$data;
186 :    
187 :     my $position = ($strand eq "+") ? $beg+$offset-$upstream_left : $beg+$upstream_left-$offset;
188 :     push(@$html,"<tr><td>$peg/$position</td>\n");
189 : overbeek 1.3 if ($cgi->param('Show With Translation'))
190 : overbeek 1.2 {
191 :     @coding = ("<tr><td>coding</td>");
192 :     }
193 :     else
194 :     {
195 :     @coding = ();
196 :     }
197 :    
198 :     for ($j=0; ($j < $n); $j++)
199 :     {
200 :     my $c = substr($seq,$i+$j,1);
201 :     my $color = "";
202 :     if ($c =~ /a/i) { $color = 'red' }
203 :     elsif ($c =~ /c/i) { $color = 'green' }
204 :     elsif ($c =~ /g/i) { $color = 'blue' }
205 :     elsif ($c =~ /[tu]/i) { $color = 'yellow' }
206 : overbeek 1.4
207 :     if ($c =~ /-/)
208 :     {
209 :     if ($cgi->param('Show With Translation'))
210 :     {
211 :     push(@coding,"<td> </td>\n");
212 :     }
213 :     }
214 :     else
215 : overbeek 1.2 {
216 :     if ($upstream_left)
217 :     {
218 :     $upstream_left--;
219 :     $data->[3] = $upstream_left;
220 : overbeek 1.3 if ($cgi->param('Show With Translation'))
221 : overbeek 1.2 {
222 :     push(@coding,"<td> </td>\n");
223 :     }
224 :     }
225 :     else
226 :     {
227 : overbeek 1.3 if ($cgi->param('Show With Translation'))
228 : overbeek 1.2 {
229 :     my($p);
230 :     if (($offset % 3) == 0)
231 :     {
232 :     $p = substr($translation,$offset / 3,1);
233 :     }
234 :     else
235 :     {
236 :     $p = " ";
237 :     }
238 :     push(@coding,"<td>$p</td>\n");
239 :     }
240 :     $data->[0]++;
241 :     $offset++;
242 :     }
243 :     }
244 :     push(@$html,"<td bgcolor=$color>$c</td>\n");
245 :     }
246 :     push(@$html,"</tr>\n");
247 : overbeek 1.3 if ($cgi->param('Show With Translation'))
248 : overbeek 1.2 {
249 :     push(@coding,"</tr>\n");
250 :     push(@$html,@coding);
251 :     }
252 :     }
253 :     push(@$html,"</table>\n");
254 :     $/ = "\n";
255 :     }
256 :    

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3