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

Annotation of /FigWebServices/align_DNA.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download)

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3