#!/usr/bin/perl

use strict;
use CGI;
use CGI::Carp qw[fatalsToBrowser];
use PSSM2;
use FileHandle;

# overwrite the existing file or not. Default is to overwrite
# chanage the value to 0 if you do not want to overwrite an existing file.
my $g_overwrite=1;

# if you want to restrict upload to files with certain extentions, change
# the value of $g_restrict_by_ext=1 and ALSO modify the @g_allowed_ext if you
# want to add other allowable extensions.
my $g_restrict_by_ext=1;
# case insensitive, so file with Jpeg JPEG GIF gif etc will be allowed
my @g_allowed_ext=("fas,fsa");


my $g_debug = 0;
my $g_title = "File upload";
my $g_upload_path = 'foo';





BEGIN { push(@INC,'.'); }

my($query) = new CGI;
main($query);
exit(0);


sub main {
	my($q) = @_;
	my(%params, $pssmObj, $parsefile);
	_set_params($q,\%params);

	if($q->param('dopssm')) {
		$pssmObj = PSSM->new(\%params);
		## They are submitting raw sequences.
		my(@pssm_results) = do_pssm(\%params,$q->param('seqs'),$pssmObj);
		print_results(\%params,$pssmObj,@pssm_results);
		$pssmObj->quit();
	} elsif($q->param('upload')) {
		$pssmObj = PSSM->new(\%params);
		## They are uploading a FASTA file for us to parse.
		$parsefile = upload();
		
		# print STDERR "\n my parse_file is: " . $parsefile . "\n";
		
		my($raw_seqs) = parse_file($parsefile);
		# $pssmObj->setmatrix('x4r5');
		my(@pssm_results) = do_pssm(\%params,$raw_seqs,$pssmObj);
		print_results(\%params,$pssmObj,@pssm_results);
		$pssmObj->quit();
	} else {
		## Generate initial form page.
		print_form();
		return();
	}
	return();
}

sub parse_file {
	my($file) = @_;
	open(FH, $file);
	undef $/;
	my $lines = <FH>;
	#print STDERR "\n parse_file: " . $lines . "\n";
	close FH;
	return $lines;
}

sub upload {
	my ($filename, $upload_filehandle, $upload_dir);
	$upload_dir = "/home/ubik/computing/pssm/foo"; 
	$filename = $query->param("seqfile"); 
	$filename =~ s/.*[\/\\](.*)/$1/; 
	$upload_filehandle = $query->upload("seqfile"); 
	
	open UPLOADFILE, ">$upload_dir/$filename"; 
	
	while ( <$upload_filehandle> ) { 
		s/\s+$//g;
		print UPLOADFILE "$_\n"; 
	} 
	
	close UPLOADFILE; 
	return $upload_dir . "/" . $filename;
}

sub do_pssm {
	my($params,$raw_seqs,$pssmObj) = @_;
	my(@a,$i,$inc,@newSeqids);
	
	# print STDERR "\n do_pssm: \n" . $raw_seqs . "\n";
	
	my($seqidAref, $seqsAref) = fasta_parser($pssmObj,$raw_seqs);
	
	# foreach my $j (0 .. @{$seqidAref}-1) {
	# 	print STDERR " do_pssm: '$seqidAref->[$j]' is '$seqsAref->[$j]'\n";
	# }
	
	## $pssmObj->setmatrix("x4r5"); # could also be "sinsi"
	$pssmObj->setmatrix($params->{matrix});
	my($prseqs,$alscr,$alpct) = $pssmObj->prepseq($seqsAref);
	
	#foreach(@{$prseqs}) {
	#	print STDERR "do_pssm prseqs: $_\n";
	#}
	
	for (@a=(),$i=0; $i<=@{$prseqs}-1; $i++) {
		# has alternative alignments
    	push (@a, $i) if $prseqs->[$i] =~ / /;
	}

	foreach (@a) {
	    $_ += $inc; # put index in register based on previous splice
		# get the alternative aligns
    	my(@alt) = split(/ /, $prseqs->[$_]);

		## Add a notation to the pssmObj about our alternative aligns 
		$pssmObj->{alts}->{$seqidAref->[$_]} = [ @alt ];

    	# replicate info for this sequence appropriately
    	splice(@{$prseqs}, $_, 1, @alt);
    	splice(@{$seqidAref}, $_, 1, ($seqidAref->[$_]) x @alt);
    	splice(@{$alscr}, $_, 1, ($alscr->[$_]) x @alt);
    	splice(@{$alpct}, $_, 1, ($alpct->[$_]) x @alt);
    	$inc += @alt-1;
	} 

	my($scr,$pred,$x4pct,$r5pct,$gen,$pos,$net) = $pssmObj->dopssm($prseqs);
	return($prseqs,$seqidAref,$seqsAref,$scr,$pred,$x4pct,$r5pct,$gen,$pos,
		$net,$alpct);
}


sub fasta_parser {
	my($pssmObj,$lines) = @_;	
	my(@seqids,@seqs,$lastline,$lcount,$arcount,$switch);
	my($time) = time();
	
	# convert all incoming text from dos(cf/nl) to unix(nl) format
	$lines =~ s/\r\n/\n/g;
	# convert all incoming text from macintosh(nl) to unix(nl) format
	$lines =~ s/\r/\n/g;
	#print STDERR "fasta_parser: now opening file....\n";
	my($file) = "/var/tmp/pssm/seq$$.$time.fasta";
	open(OUT, ">$file") || 
		print STDERR "Could not open $file\: $!\n";
	print OUT $lines;
	close(OUT);
			
	my(@fasta);
	my($fasta_aref) = $pssmObj->parse_file($file);
	foreach(@{$fasta_aref}) {
		push(@fasta,$_);
	}
	@fasta = sort {$a <=> $b} @fasta;

	foreach(@fasta) {
		# 0print STDERR "FASTA: $_\n";
		++$lcount;
		s/\s+$//;
		if (!$_) {
			# blank line, just skip it!
			print STDERR "fasta_parser: Blank line.\n";
			next;
		} elsif ($_ =~ /^\>/ && $lastline !~ /^\>/) {
			# print STDERR "fasta_parser: got line with seqid: $_\n";
			if ($switch) { 
				++$arcount; 
			} else { 
				$switch = 1; 
				$arcount = 0; 
			}
			# a new sequence id
			$lastline = $_;
			s/^\>//;
			my($id,@misc) = split(/\s+/);
			$id =~ s/[\s,]+//g;
			## Do we need a uniq id for each seq?
			$id = _gen_uniqid(\@seqids) if(!$id);
			
			# print STDERR  "id: " . $id . "\n";
			
			#$lastseqid = $id;
			$seqids[$arcount] = $id;
		} elsif ($_ !~ /^\>/ && $_ =~ /^[A-Za-z\-]+$/ && $lastline =~ /^\>/) {
			# first part of the actual sequence
			# print STDERR "fasta_parser: got seq: $_\n";
			s/\s+//g;
			$seqs[$arcount] = uc($_);
			$lastline = $_;
		} elsif ($_ !~ /^\>/ && $lastline !~ /^\>/ && $_ =~ /^[A-Za-z\-]+$/) {
			# more lines of a sequence
			# print STDERR "fasta_parser: got multiline seq: $_\n";
			s/\s+//g;
			$seqs[$arcount] .= uc($_);
			$lastline = $_;
		} else {
			print STDERR "Input not in FASTA format";
			return("ERROR: Input not in FASTA format (line $lcount)"
					. ": \"$_\"");
		}
	}
	close(FASTA);
	unlink($file);	
	return(\@seqids,\@seqs);
}

sub _gen_uniqid {
	my($seqs) = @_;
	my($id,$i,$j);
	until($i) {
		$id = int(rand(1000));
		$id = "seq_" . $id;
		foreach(@{$seqs}) {
			if($_ eq $id) { ++$j; }
		}
		++$i if(!$j);
	}
	return($id);
}

sub _set_params {
	my($q,$params) = @_;
	$params->{pamfnstem} = $q->param('pamfnstem') || "HIVPAM10";
	$params->{x4cons} = $q->param('x4cons') 
			|| "CTRPNNNTRKSIHIGPGRAFYTTGRIIGDIRQAHC";
	$params->{r5cons} = $q->param('r5cons')
			|| "CTRPNNNTRKSIHIGPGRAFYATGEIIGDIRQAHC";
	$params->{matrix} = $q->param('matrix')
			||  "x4r5";
	return();
}



sub print_csv {
	my($params,$prseqs,$seqidAref,$seqsAref,$scr,$pred,$x4pct,$r5pct,$gen,$pos,$net,$alpct)
		= @_;
	my($time) = time();
	my($now) = scalar gmtime();
	my($url) = "results/pssm_$$\_$time.txt";	
	my($file) = "/data/htdocs/pssm/$url";
	
	open(CSV, ">$file") || print STDERR "Cannot open $file\: $!\n";
	print CSV "WebPSSM ($params->{matrix}) Results $now GMT\n";
	print CSV "name\tscore\tpred\tx4.pct\tr5.pct\tgeno\tpos.chg\tnet.chg\tpercentile\n";
	my($i);
	for ($i=0; $i<=@{$prseqs}-1; $i++) {
		$scr->[$i] = sprintf("%.2f", $scr->[$i]);
		$x4pct->[$i] = sprintf("%.2f", $x4pct->[$i]);
		$r5pct->[$i] = sprintf("%.2f", $r5pct->[$i]);
		print CSV "$seqidAref->[$i]\t";	# sequence name
		print CSV "$scr->[$i]\t";		# score	
		print CSV "$pred->[$i]\t";		# predicted
		print CSV "$x4pct->[$i]\t";		# x4 percentile
		print CSV "$r5pct->[$i]\t";		# r5 percentile
		print CSV "$gen->[$i]\t";		# genotype
		print CSV "$pos->[$i]\t";		# pos.chg
		print CSV "$net->[$i]\t";		# net.chg
		print CSV "$alpct->[$i]\n";		# percentile
	}
	close(CSV);
	return($url);
}

sub print_results {
	my($params,$pssmObj,$prseqs,$seqidAref,$seqsAref,$scr,$pred,$x4pct,$r5pct,$gen,
		$pos,$net,$alpct) = @_;
	my($time) = scalar localtime(time);
	my($gmtime) = scalar gmtime();
	my($csvfile) = print_csv($params,$prseqs,$seqidAref,$seqsAref,$scr,$pred,$x4pct,
					$r5pct,$gen,$pos,$net,$alpct);
	print_html_header();
	print_css();
	print "<a name=TOP>\n";
	print "<div align='center'>\n";
	print "<div class='title'>WebPSSM results for PID$$ ($gmtime GMT)</div>\n";
	print "<div class='data'>Using the $params->{'matrix'} matrix.</div><br>\n";
	print "<div class='nav'>Download these results as a tab-delimited file\n"; 
	print "<a href=$csvfile>here</a>.<div><br>\n";
	print "<div class='nav'><a href=index.html>Return</a></div><br>\n";
	print "<table cellspacing=0 cellpadding=7 class=table>\n";
	print "<tr bgcolor=#333333>\n";
	print "<td class='header'>name</td>\n";
	print "<td><a class='header' href=\#SCORE>score</a></td>\n";
	print "<td><a class='header' href=\#PRED>pred</a></td>\n";
	print "<td><a class='header' href=\#X4>x4.pct</a></td>\n";
	print "<td><a class='header' href=\#R5>r5.pct</a></td>\n";
	print "<td><a class='header' href=\#GENO>geno</a></td>\n";
	print "<td><a class='header' href=\#POS>pos.chg</a></td>\n";
	print "<td><a class='header' href=\#NET>net.chg</a></td>\n";
	print "<td><a class='header' href=\#PCT>percentile</a></td>\n";
	print "</tr>\n";
	my($i,$switch);
	for ($i=0; $i<=@{$prseqs}-1; $i++) {
		$scr->[$i] = sprintf("%.2f", $scr->[$i]);
		$x4pct->[$i] = sprintf("%.2f", $x4pct->[$i]);
		$r5pct->[$i] = sprintf("%.2f", $r5pct->[$i]);
		if(!$switch) {
			print "<tr>\n";
			$switch = 1;
		} else {
			print "<tr bgcolor=c0c0c0>\n";
			$switch = 0;
		}
		if($pssmObj->{alts}->{$seqidAref->[$i]})  {
			print "<td><a class='data' href=\"\#$seqidAref->[$i]\">";
			print "$seqidAref->[$i]</a>\*</font></td>\n";
		} else {
			print "<td class='data'>$seqidAref->[$i]</td>\n";
		}
		print "<td align=right class='data'>$scr->[$i]</td>\n";
		print "<td align=right class='data'>$pred->[$i]</td>\n";
		print "<td align=right class='data'>$x4pct->[$i]</td>\n";
		print "<td align=right class='data'>$r5pct->[$i]</td>\n";
		print "<td align=right class='data'>$gen->[$i]</td>\n";
		print "<td align=right class='data'>$pos->[$i]</td>\n";
		print "<td align=right class='data'>$net->[$i]</td>\n";
		my($pct) = sprintf("%.2f", $alpct->[$i]);
		print "<td align=right class='data'>$pct</td>\n";
		print "</tr>\n";
	}
	print "</table><P>\n";

	if(keys(%{$pssmObj->{alts}})) {
		print "<table border=0><tr><td align=left>\n";
		print "Multiple alignments were generated for the";
		print " following sequences:";
		print "<ul>\n";
		foreach my $nseqid (keys %{$pssmObj->{alts}}) {
			print "<a name=$nseqid>";
			print "<li> $nseqid</a>\n";
			print "<ul>\n";
			foreach my $align (@{$pssmObj->{alts}->{$nseqid}}) {
				print "<li> $align\n";
			}
			print "</ul>\n";
		}
		print "</ul>\n";
		print "</td></tr></table><BR>\n";
	}
	print "<a href=index.html>Return</a><P>\n";
	print "<P>";
	print qq!
<table border=0 cellpadding=7 bgcolor=c0c0c0 width=400 class=table>
<tr><td align=left valign=top>
<div class=header align=center style=color:black>Explanation of results</div>
<div class=data>
<a name=SCORE><a href=\#TOP>score</a>:<BR>
Sequence PSSM score
<P>
<a name=PRED><a href=\#TOP>pred</a>:<BR>
1: CXCR4 use predicted; 0: CCR5 use only predicted
<P>
<a name=X4><a href=\#TOP>x4.pct</a>:<BR>
Percentile of score within score distribution of known X4 viruses.
<P>
<a name=R5><a href=\#TOP>r5.pct</a>:<BR>
Percentile of score within score distribution of known R5 viruses.
<P>
<a name=GENO><a href=\#TOP>geno</a>:<BR>
Amino acid residues at V3 sites 11 and 25; basic residues (R or K) at
either or both of these sites is predictive of CXCR4 use.
<P>
<a name=POS><a href=\#TOP>pos.chg</a>:<BR>
Total number of positively charged (R/K/H) amino acid residues. Higher
positive charge has been correlated with likelihood of CXCR4 use.
<P>
<a name=NET><a href=\#TOP>net.chg</a>:<BR>
Number of positively charged (R/K/H) amino acid residues, minus number
of negatively charged (D/E) residues.
<P>
<a name=PCT><a href=\#TOP>percentile</a>:<BR>
If this number is over .95, this sequence is most likely not a V3.
</div>
</td></tr></table>
</div>
!;
	print "<br><a href=index.html>Return</a></center>\n";
	print_html_footer();
}

sub print_html_header {
	print "Content-type: text/html\n";
	print "Pragma: no-cache\n\n";
	print qq!
<HTML>
<HEAD>
<TITLE>Web PSSM</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
!;
	return();
}

sub print_html_footer {
	print "</BODY></HTML>\n";
}


sub print_css {
	my $styles=<<END;
<style type='text/css'>
<!--
.title {
	font-family: Arial, Helvetica, sans-serif;
	font-size: 18px;
	font-weight: bold;
	color: #000000;
}
.header {
	font-family: Arial, Helvetica, sans-serif;
	font-size: 14px;
	font-weight: bold;
	color: #FFFFFF;
}
.data {
	font-family: Arial, Helvetica, sans-serif;
	font-size: 14px;
	font-weight: normal;
	color: #000000;
}
.nav {
	font-family: Arial, Helvetica, sans-serif;
	font-size: 12px;
	font-weight: bold;
	color: #000000;
}
.table {
	border: 1px solid #333333;
}
-->
</style>
END
;
	print $styles;
	return();
}

sub print_form {
	print "Content-type: text/html\n";
	print "Pragma: no-cache\n\n";
	open(INDEX, "index.html");
	while(<INDEX>) {
		print;
	}
	close(INDEX);
	return();
}


