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

Diff of /FigWebServices/align_DNA.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Sat Oct 1 19:20:54 2005 UTC revision 1.2, Sun Oct 2 23:15:37 2005 UTC
# Line 13  Line 13 
13      my $VAR1;      my $VAR1;
14      eval(join("",`cat /tmp/align_dna_parms`));      eval(join("",`cat /tmp/align_dna_parms`));
15      $cgi = $VAR1;      $cgi = $VAR1;
16  #   print STDERR &Dumper($cgi);      print STDERR &Dumper($cgi);
17  }  }
18    
19  if (0)  if (0)
# Line 53  Line 53 
53  $upstream      = $upstream ? $upstream : 0;  $upstream      = $upstream ? $upstream : 0;
54    
55  my $gene       = $cgi->param('gene');  my $gene       = $cgi->param('gene');
56    my @pegs       = $cgi->param('peg');
57    
58  my $seqF = "$FIG_Config::temp/dna$$.fasta";  my $seqF = "$FIG_Config::temp/dna$$.fasta";
59  open(SEQ,">$seqF") || die "could not open $seqF";  open(SEQ,">$seqF") || die "could not open $seqF";
60    
61  my $peg;  my $peg;
62  my $n = 0;  my $n = 0;
63  foreach $peg (grep { $_ =~ /^fig\|/ } $cgi->param('peg'))  my %data_per_seq;
64    foreach $peg (@pegs)
65  {  {
66        my($coding,$location);
67      my $coding;      $location = $fig->feature_location($peg);
68      if (! defined($gene))      my($contig,$beg,$end) = $fig->boundaries_of($location);
69        if ((! defined($gene)) || ($gene !~ /^\d+/))
70      {      {
71          $coding = $fig->dna_seq(&FIG::genome_of($peg),$fig->feature_location($peg));          $coding = $fig->dna_seq(&FIG::genome_of($peg),$location)
72      }      }
73      elsif ($gene > 0)      elsif ($gene > 0)
74      {      {
75          $coding = substr($fig->dna_seqa(&FIG::genome_of($peg),$fig->feature_location($peg)),0,$gene);          $coding = substr($fig->dna_seq(&FIG::genome_of($peg),$location),0,$gene);
76      }      }
77      else      else
78      {      {
79          $coding = "";          $coding = "";
80      }      }
81    
82        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      my $upstream_seq = "";      my $upstream_seq = "";
93      if ($upstream)      if ($upstream)
94      {      {
# Line 83  Line 96 
96      }      }
97      my $seq = $upstream_seq . $coding;      my $seq = $upstream_seq . $coding;
98      print SEQ ">$peg\n$seq\n";      print SEQ ">$peg\n$seq\n";
99        $data_per_seq{$peg} = [0,$beg,($beg < $end) ? '+' : '-',length($upstream_seq),$trans];
100      $n++;      $n++;
101  }  }
102  close(SEQ);  close(SEQ);
103    
104  if ($n > 1)  if ($n > 1)
105  {  {
106        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      $/ = "\n>";      $/ = "\n>";
122      my @tmp = `$FIG_Config::bin/align_fasta < $seqF`;      my @tmp = `$FIG_Config::bin/align_fasta < $seqF`;
123    
124      push(@$html,"<table border>\n");      my($ln,@pegs);
125      while (defined($_ = shift @tmp))      while (defined($_ = shift @tmp))
126      {      {
127          chomp;          chomp;
# Line 101  Line 130 
130              my $peg  =  $1;              my $peg  =  $1;
131              my $seq =  $2;              my $seq =  $2;
132              $seq =~ s/\s//gs;              $seq =~ s/\s//gs;
133              push(@$html,"<tr><td>$peg</td>");              push(@{$data_per_seq{$peg}},$seq);
134              my $c;              if (! $ln) { $ln = length($seq) }
135              foreach $c (split("",$seq))              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            }
150        }
151    }
152    else
153    {
154        push(@$html,$cgi->h1("Less than 2 sequences defined -- alignment failed"));
155    }
156    #unlink $seqF;
157    &HTML::show_page($cgi, $html);
158    
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                  my $color;              @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' }                  if     ($c =~ /a/i)        { $color = 'red' }
186                  elsif  ($c =~ /c/i)        { $color = 'green' }                  elsif  ($c =~ /c/i)        { $color = 'green' }
187                  elsif  ($c =~ /g/i)        { $color = 'blue' }                  elsif  ($c =~ /g/i)        { $color = 'blue' }
188                  elsif  ($c =~ /[tu]/i)     { $color = 'yellow' }                  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");                  push(@$html,"<td bgcolor=$color>$c</td>\n");
220              }              }
221              push(@$html,"</tr>");          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");      push(@$html,"</table>\n");
229      $/ = "\n";      $/ = "\n";
230  }  }
231  else  
 {  
     push(@$html,$cgi->h1("Less than 2 sequences defined -- alignment failed"));  
 }  
 unlink $seqF;  
 &HTML::show_page($cgi, $html);  

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3