# -*- perl -*-
#
# Copyright (c) 2003-2006 University of Chicago and Fellowship
# for Interpretations of Genomes. All Rights Reserved.
#
# This file is part of the SEED Toolkit.
# 
# The SEED Toolkit is free software. You can redistribute
# it and/or modify it under the terms of the SEED Toolkit
# Public License. 
#
# You should have received a copy of the SEED Toolkit Public License
# along with this program; if not write to the University of Chicago
# at info@ci.uchicago.edu or the Fellowship for Interpretation of
# Genomes at veronika@thefig.info or download a copy from
# http://www.theseed.org/LICENSE.TXT.
#


use URI::Escape;  # uri_escape()
use HTML;
use strict;
use tree_utilities;

use CGI;

my $cgi = new CGI;
if (0)
{
    my $VAR1;
    eval(join("",`cat /tmp/align_dna_parms`));
    $cgi = $VAR1;
    print STDERR &Dumper($cgi);
}

if (0)
{
    print $cgi->header;
    my @params = $cgi->param;
    print "<pre>\n";
    foreach $_ (@params)
    {
	print "$_\t:",join(",",$cgi->param($_)),":\n";
    }

    if (0)
    {
	if (open(TMP,">/tmp/align_dna_parms"))
	{
	    print TMP &Dumper($cgi);
	    close(TMP);
	}
    }
    exit;
}

use FIG;
my $fig = new FIG;

my $html = [];
push @$html, "<TITLE>SEED Align DNA</TITLE>\n"; 

#
# parameters: @ids        = $cgi->param('peg')        are the ids of the relevant PEGs
#             $upstream   = $cgi->param('upstream')   # of characters upstream (default = 0)
#             $gene       = $cgi->param('gene')       # of characters of gene (defaults to all)
#                                                    

my $upstream   = $cgi->param('upstream');
$upstream      = $upstream ? $upstream : 0;

my $gene       = $cgi->param('gene');
my @pegs       = $cgi->param('peg');

my $seqF = "$FIG_Config::temp/dna$$.fasta";
open(SEQ,">$seqF") || die "could not open $seqF";

my $peg;
my $n = 0;
my %data_per_seq;
foreach $peg (@pegs)
{
    my($coding,$location);
    $location = $fig->feature_location($peg);
    my($contig,$beg,$end) = $fig->boundaries_of($location);
    if ((! defined($gene)) || ($gene !~ /^\d+/))
    {
	$coding = $fig->dna_seq(&FIG::genome_of($peg),$location)
    }
    elsif ($gene > 0)
    {
	$coding = substr($fig->dna_seq(&FIG::genome_of($peg),$location),0,$gene);
    }
    else
    {
	$coding = "";
    }

    my $trans;
    if ((length($coding) > 2) && $cgi->param('Show With Translation'))
    {
	$trans = $fig->get_translation($peg);
    }
    else
    {
	$trans = "";
    }

    my $upstream_seq = "";
    if ($upstream)
    {
	$upstream_seq = $fig->upstream_of($peg,$upstream,0);
    }
    my $seq = $upstream_seq . $coding;
    print SEQ ">$peg\n$seq\n";
    $data_per_seq{$peg} = [0,$beg,($beg < $end) ? '+' : '-',length($upstream_seq),$trans];
    $n++;
}
close(SEQ);

if ($n > 1)
{
    push(@$html,$cgi->start_form(-action => "align_DNA.cgi",
			         -method => 'post'),
	        $cgi->hidden(-name => 'peg', -value => [@pegs], -override => 1),
	        $cgi->param('Show With Translation') ? $cgi->submit('Show Without Translation') 
	                                        : $cgi->submit('Show With Translation'),
                $cgi->br,$cgi->br,$cgi->br,
	        "&nbsp;","&nbsp;","Size upstream: ",
	        $cgi->textfield(-name => 'upstream', -size => 4, -value => $upstream),
	        "&nbsp;","&nbsp;",	
	        "&nbsp;","&nbsp;", "Restrict coding area to (optional): ",
	        $cgi->textfield(-name => 'gene',   -size => 4, -value => $gene),
                $cgi->br,$cgi->br,$cgi->br
        );


    $/ = "\n>";
    my @tmp = `$FIG_Config::bin/align_fasta < $seqF`;

    my($ln,@pegs);
    while (defined($_ = shift @tmp))
    {
	chomp;
	if ($_ =~ /^>?(\S+)[^\n]*\n(.*)/s)
	{
	    my $peg  =  $1;
	    my $seq =  $2;
	    $seq =~ s/\s//gs;
	    push(@{$data_per_seq{$peg}},$seq);
	    if (! $ln) { $ln = length($seq) }
	    push(@pegs,$peg);
	}
    }
    if (@pegs < 2)
    {
	push(@$html,$cgi->h1('Too few sequences or alignment failure'));
    }
    else
    {
	my $i=0;
	for ($i=0; ($i < $ln); $i += 50)
	{
	    &process_one_block($fig,$cgi,$html,\@pegs,$i,($i < ($ln-50)) ? 50 : ($ln - $i),\%data_per_seq);
	    push(@$html,$cgi->br,$cgi->br,$cgi->br,$cgi->br);
	}
    }
}
else
{
    push(@$html,$cgi->h1("Less than 2 sequences defined -- alignment failed"));
}
#unlink $seqF;
&HTML::show_page($cgi, $html);

sub process_one_block {
    my($fig,$cgi,$html,$pegs,$i,$n,$data_per_seq) = @_;
    my($peg,@coding,$j);

    push(@$html,"<table border>\n");
    foreach $peg (@$pegs)
    {
	my $data = $data_per_seq->{$peg};

	my($offset,$beg,$strand,$upstream_left,$translation,$seq) = @$data;

	my $position = ($strand eq "+") ? $beg+$offset-$upstream_left : $beg+$upstream_left-$offset;
	push(@$html,"<tr><td>$peg/$position</td>\n");
	if ($cgi->param('Show With Translation'))
	{
	    @coding = ("<tr><td>coding</td>");
	}
	else
	{
	    @coding = ();
	}

	for ($j=0; ($j < $n); $j++)
	{
	    my $c = substr($seq,$i+$j,1);
	    my $color = "";
	    if     ($c =~ /a/i)        { $color = 'red' }
	    elsif  ($c =~ /c/i)        { $color = 'green' }
	    elsif  ($c =~ /g/i)        { $color = 'blue' }
	    elsif  ($c =~ /[tu]/i)     { $color = 'yellow' }

	    if ($c =~ /-/)
	    {
		if ($cgi->param('Show With Translation'))
		{
		    push(@coding,"<td> </td>\n");
		}
	    }
	    else
	    {
		if ($upstream_left)
		{
		    $upstream_left--;
		    $data->[3] = $upstream_left;
		    if ($cgi->param('Show With Translation'))
		    {
			push(@coding,"<td> </td>\n");
		    }
		}
		else
		{
		    if ($cgi->param('Show With Translation'))
		    {
			my($p);
			if (($offset % 3) == 0)
			{
			    $p = substr($translation,$offset / 3,1);
			}
			else
			{
			    $p = " ";
			}
			push(@coding,"<td>$p</td>\n");
		    }
		    $data->[0]++;
		    $offset++;
		}
	    }
	    push(@$html,"<td bgcolor=$color>$c</td>\n");
	}
	push(@$html,"</tr>\n");
	if ($cgi->param('Show With Translation'))
	{
	    push(@coding,"</tr>\n");
	    push(@$html,@coding);
	}
    }
    push(@$html,"</table>\n");
    $/ = "\n";
}