package TasukeVcfEncode;

use strict;
use Data::Dumper;
use CommonLibTASUKE;

our %VALID_FORMAT = ('GT'=>1, 'AD'=>1, 'DP'=>1, 'GQ'=>1, 'PL'=>1);

sub new {
	my $class = shift;
	my $self = {
		'commonMysql'	=> new CommonMysql(),
		'vcf'	=> '',
		'outDir'	=> '',
		'samples'	=> [],
		'memVcfFormat'	=> {},
		'numSamples'	=> 0,
#		'ploidy'        => 0,
		'useZero'	=> 0
	};
	return bless $self, $class;
}
sub getUlimitS {
	my $self = shift;
	return `ulimit -Sn`;
}
sub getUlimitH {
	my $self = shift;
	return `ulimit -Hn`;
}
sub setUlimit {
	my $self = shift;
	my($limit) = @_;
	return `ulimit -n $limit`;
}
sub prepareCommon {
	my $self = shift;
	my($vcf, $outDir) = @_;

	if( !(-f $vcf) ) {
		printf STDERR "VCF file not found: %s\n", $vcf;
		return 1;
	}
	$self->{'vcf'} = $vcf;

	if(!(-d $outDir ) ) {
		printf STDERR "outDir not found: %s\n", $outDir;
		return 1;
	}
	$self->{'outDir'} = $outDir;

	my $code = 1;
	my $fh = getFileHandle($vcf);
	while(<$fh>) {
		chomp;
		my $datarow = $_;
		next if($datarow !~ m/\S/);

		if($datarow =~ m/^#/) {
			if($datarow =~ m/^#CHROM\t/) {
				my @cols = split /\t/, $datarow;
				my $stCol = 9;
				my $enCol = @cols - 1;
				for(my $i=$stCol; $i<=$enCol; $i++) {
					my $idx = $i - $stCol;
					my $fp;
					my $path = sprintf("%s/%d", $outDir, $idx);
					$self->{'samples'}->[$idx] = {
						'name'	=> $cols[$i],
						'path'	=> $path,
						'binStrArr'	=> []
					}; 
				}
				$code = 0;
				last;
			}
		} else {
			last;
		}
	}
#print STDERR Dumper($self->{'samples'});
	close($fh);
	$self->{'numSamples'} = @{$self->{'samples'}};

	# Create prop file.
#	$self->writePropFile();

	return $code;
}
sub prepare {
	my $self = shift;
	my($binDir) = @_;
	$self->{'outDir'} = $binDir;
}
sub finish {
	my $self = shift;
#	foreach my $ref (@{$self->{'samples'}}) {
#		close($ref->{'fp'}) if($ref->{'fp'});
#	}
}
sub writePropFile {
	my $self = shift;
	local *PROP;
	open(PROP, sprintf(">%s/prop", $self->{'outDir'})) or die("Error: $!\n");
	foreach my $key (keys(%{$self})) {
		next if( ref($self->{$key}) eq 'ARRAY' || ref($self->{$key}) eq 'HASH');
		printf PROP "%s=%s\n", $key, $self->{$key};
	}
	close(PROP);
}
sub readPropFile {
	my $self = shift;

	return if(!$self->{'outDir'});

	local *PROP;
	open(PROP, sprintf("<%s/prop", $self->{'outDir'})) or die("Error: $!\n");
	while(<PROP>) {
		chomp;
		my $datarow = $_;
		next if($datarow !~ m/\S/);

		my @arr = split /\=/, $datarow;
		next if($arr[0] eq 'outDir');
		$self->{$arr[0]} = $arr[1];
	}
	close(PROP);
}
sub writeSampleInfo {
	my $self = shift;

	return if(!$self->{'outDir'});

	foreach my $ref (@{$self->{'samples'}}) {
		my $fp;
		open($fp, ">>". $ref->{'path'});
		print $fp join("", @{$ref->{'binStrArr'}});
#foreach my $binStr (@{$ref->{'binStrArr'}}) {
#	print $fp $binStr;
#}
		close($fp);
#		my $fp = $ref->{'fp'};
#		print $fp join("", @{$ref->{'binStrArr'}});
		$ref->{'binStrArr'} = [];
	}
}
sub openBin {
	my $self = shift;
	my($idx ) = @_;

	return undef if(!$self->{'outDir'});

	my $path = sprintf("%s/%d", $self->{'outDir'}, $idx);
	return getFileHandle($path);
}
sub encodeOnerow {
	my $self = shift;
	my($seqId, $onerowArr) = @_;

	return if(!$self->{'outDir'});

	my $INDEL = "Dels=";

	# FORMAT
	my @validFmt;
	my %fmt2idx;
	if(exists($self->{'memVcfFormat'}->{$onerowArr->[8]})) {
		@validFmt = @{$self->{'memVcfFormat'}->{$onerowArr->[8]}->[0]};
		%fmt2idx = %{$self->{'memVcfFormat'}->{$onerowArr->[8]}->[1]};
	} else {
		my @sgt = split /:/, $onerowArr->[8];
		my $sgtLen = @sgt;
		for(my $i=0; $i<$sgtLen; $i++) {
			next if(!exists($VALID_FORMAT{$sgt[$i]}));
			push @validFmt, $sgt[$i];
			$fmt2idx{$sgt[$i]} = $i;
		}
		$self->{'memVcfFormat'}->{$onerowArr->[8]} = [\@validFmt, \%fmt2idx];
	}

	my $stCol = 9;
	my $enCol = 9 + $self->{'numSamples'} - 1;
	my $idx = 0;
	for(my $i=$stCol; $i<=$enCol; $i++) {
		my %valHash;
		my @sgtv = split /:/, $onerowArr->[$i];
		foreach my $key (@validFmt) {
			my $val = $sgtv[$fmt2idx{$key}];
			next if(!defined($val) || ($val ne '0' && !$val));

			$val =~ s/\|/\//g if($key eq 'GT');
			if($key eq 'PL' && length($val) > 65534) {
				$val = substr($val, 0, 65534);
			}
			$valHash{$key} = $val;
		}
=head
		my %valHash;
		my @sgtv = split /:/, $onerowArr->[$i];
		for (my $j=0; $j < $sgtLen; $j++) {
			my $key = $sgt[$j];
			next if(!$key || !exists($VALID_FORMAT{$key}));
			my $val = $sgtv[$j];
			next if(!defined($val) || ($val ne '0' && !$val));

#			$val =~ s/^\s+//;
#			$val =~ s/\s+$//;
			$val =~ s/\|/\//g if($key eq 'GT');
			if($key eq 'PL' && length($val) > 65534) {
				$val = substr($val, 0, 65534);
			}
			$valHash{$key} = $val;
		}
=cut
			
		if($valHash{'GT'} =~ m/^\./ || !exists($valHash{'GT'})) {
			$valHash{'DP'} = -1;
			$valHash{'GQ'} = -1;
			$valHash{'DP1'} = -1;
			$valHash{'DP3'} = -1;
		} else {
			$self->setDepth(\%valHash);
			$valHash{'DP'} = -1 if(!$valHash{'DP'} || $valHash{'DP'} eq '.');
			$valHash{'GQ'} = -1 if(!$valHash{'GQ'} || $valHash{'GQ'} eq '.');
		}
		$valHash{'seqId'} = $seqId;
		push @{$self->{'samples'}->[$idx]->{'binStrArr'}}, $self->encodeSampleInfo(\%valHash);

		$idx++;
	}
}
sub encodeSampleInfo {
	my $self = shift;
	my($valHash) = @_;

	#TODO limit for DP1,DP3, GQ
	my @binStrArr;
	push @binStrArr, pack('L', $valHash->{'seqId'});	# uint32
	if($self->validSite($valHash)) {
#		if($self->{'ploidy'} == 0) {
#			my @gtArr = split /\//, $valHash->{'GT'};
#			$self->{'ploidy'} = @gtArr;
#		}

		# valid site.
		if($valHash->{'GT'} =~ m/^\./) {
			push @binStrArr, pack('c', '2');
			# GT is dynamically generated.
		} else {
			push @binStrArr, pack('c', '1');
			push @binStrArr, packVarString('C', $valHash->{'GT'});	# uint8
			push @binStrArr, pack('f', $valHash->{'DP'});	# float32
			push @binStrArr, pack('f', $valHash->{'GQ'});	# float32
			push @binStrArr, pack('s', $valHash->{'DP1'});	# int16
			push @binStrArr, pack('s', $valHash->{'DP3'});	# int16
			push @binStrArr, packVarString('S', $valHash->{'PL'});
		}
	} else {
		push @binStrArr, pack('c', '0');	# Ref hom(0/0) and don't regist it.
	}
	return join("", @binStrArr);
}
sub decodeSampleInfo {
	my $self = shift;
	my($fh) = @_;

	return undef if(!$fh);

	my %valHash;
	my $bin;
	my $stat = sysread($fh, $bin, 4);
	return undef if(!$stat);
	$valHash{'seqId'} = unpack('L', $bin);
	sysread($fh, $bin, 1);
	my $validFlg = unpack('c', $bin);
	if($validFlg) {
		if($validFlg eq '2') {	# ./.
			$valHash{'GT'} = './.';		# Ploidy is not reflected
		} else {
			$valHash{'GT'} =  unpackVarString('C', $fh);
#			if($self->{'ploidy'} == 0) {
#				my @gtArr = split /\//, $valHash->{'GT'};
#				$self->{'ploidy'} = @gtArr;
#			}

			sysread($fh, $bin, 4);
			my $dp = unpack('f', $bin);
			sysread($fh, $bin, 4);
			my $gq = unpack('f', $bin);
			sysread($fh, $bin, 2);
			my $dp1 = unpack('s', $bin);
			sysread($fh, $bin, 2);
			my $dp3 = unpack('s', $bin);
			my $pl =  unpackVarString('S', $fh);

			$valHash{'DP'} = $dp if($dp >= 0);
			$valHash{'GQ'} = $gq if($gq >= 0);
			$valHash{'DP1'} = $dp1 if($dp1 >= 0);
			$valHash{'DP3'} = $dp3 if($dp3 >= 0);
			$valHash{'PL'} = $pl;
		}
	}
	return \%valHash;
}

sub validSite {
	my $self = shift;
	my($hashref) = @_;

	return 0 if(!exists($hashref->{'GT'}));

	my $gtStr = $hashref->{'GT'};

	if($gtStr !~ m/[^\/0]/ && !$self->{'useZero'}) {
		return 0;
	} else {
		return 1;
	}
}

### Static methods

sub getFileHandle {
    my($file) = @_;
    my $fh;
    if ($file =~ m/\.tar\.gz$/) {
        open $fh, "tar zxf $file -O 2> /dev/null|" or die "file open error: $!";
    } elsif($file =~ m/\.tar\.bz2$/) {
        open $fh, "tar jxf $file -O 2> /dev/null|" or die "file open error: $!";
    } elsif($file =~ m/\.gz$/) {
        open $fh, "gzip -dc $file 2> /dev/null|" or die "file open error: $!";
    } elsif($file =~ m/\.bz2$/) {
        open $fh, "bzip2 -dc $file 2> /dev/null|" or die "file open error: $!";
    } else {
        open $fh, '<', $file or die "file open error: $!";
    }
    return $fh;
}
sub isEffFormat {
	my($str) = @_;
	if($str =~ m/^[^\|\(]+\(/) {
		return 1;
	} else {
		return 0;
	}
}
sub packVarString {
	my($fmt, $str) = @_;

	my $len = length($str);
	my $binStr = pack($fmt, $len);
#	my $binStr = pack('S', $len);	# uint16
	$binStr .= $str if($len > 0);
	return $binStr;
}
sub unpackVarString {
	my($fmt, $fh) = @_;
	my $bytes = 2;
		$bytes = 1 if($fmt eq 'c' || $fmt eq 'C');
	sysread($fh, my $bin, $bytes);
	my $len = unpack($fmt, $bin);
#	sysread($fh, my $bin, 2);
#	my $len = unpack('S', $bin);	# uint16
	my $str = '';
	if($len > 0) {
		sysread($fh, $bin, $len);
		$str = unpack('a'. $len, $bin);
	}
	return $str;
}
sub splitKeyVal {
	my($keyVal) = @_;
	my @arr = split /:/, $keyVal;
	return $arr[0] => $arr[1];
}

sub setDepth {
	my $self = shift;	# Currently unused
	my($valHash) = @_;
	my $isCorrectAd = 1;
	$isCorrectAd = 0 if(!exists($valHash->{'AD'}) || $valHash->{'AD'} eq '.');

	if($isCorrectAd) {
		my @Predp4Arr = split(",", $valHash->{'AD'});

		my $dp1 = $Predp4Arr[0];
		my $dp3 = 0;
		my @gtarray = split(/\//, $valHash->{'GT'});
		my $gtarrayNum = scalar(@gtarray);
		if($gtarrayNum == 1) {
			@gtarray = ('0', $gtarray[0]);
		} elsif($gtarrayNum > 2) {
			my %tmphash;
			@tmphash{@gtarray} = undef;	# Slice: ArrayVals => UniqKeys
			@gtarray = sort {$a <=> $b} keys(%tmphash);
			push(@gtarray, $gtarray[0]) if(scalar(@gtarray) == 1);	# 1/1/1/1 => 1 =(push)=> 1/1
		}
		if($gtarray[0] eq '0' && $gtarray[1] eq '0') {	# 0/0
			$dp3 = $Predp4Arr[0];
		}elsif($gtarray[0] ne $gtarray[1]) {
			if($gtarray[0] ne '0') {	# for hetero 1/2 1/3 2/3
				$dp3 = $Predp4Arr[$gtarray[0]] + $Predp4Arr[$gtarray[1]];
			} else {	# for hetero 0/1 0/2 0/3
				$dp3 = $Predp4Arr[$gtarray[1]];
			}
		}else{	#for homo ./. 1/1 2/2 3/3
			$dp3 = $Predp4Arr[$gtarray[1]];
		}
		$valHash->{'DP1'} = int($dp1);
		$valHash->{'DP3'} = int($dp3);
	} else {
		$valHash->{'DP1'} = -1;
		$valHash->{'DP3'} = -1;
	}
}
sub setInfo {
	my $self = shift;
	my($comHash, $valHash) = @_;

	if($valHash->{'GT'} =~ m/^\./) {
		# if GT is "./.", GTROW is not registered.
		$valHash->{'EFF_GRP'} = 0;
		$valHash->{'pos'} = $comHash->{'POS'};
		$valHash->{'variant'} = 's';
	} else {
		my @gtarray = split(/\//, $valHash->{'GT'});

		# If ploidy > 2, Top two GTs with the highest frequency of occurrence (smallest GT) are used.
		my $gtarrayNum = scalar(@gtarray);
		if($gtarrayNum == 1) {
			@gtarray = ('0', $gtarray[0]);
		} elsif($gtarrayNum > 2) {
			my %tmphash;
			@tmphash{@gtarray} = undef;	# Slice: ArrayVals => UniqKeys
			@gtarray = sort {$a <=> $b} keys(%tmphash);
			push(@gtarray, $gtarray[0]) if(@gtarray == 1);	# 1/1/1/1 => 1 =(push)=> 1/1
		}
		my $gtSingle;
		my @altArrAll = split /,/, $comHash->{'ALTS'};
		my $altsStr = "";
		my $repAlt = "";
		if($gtarray[0] eq '0' && $gtarray[1] eq '0') {	# 0/0
			$gtSingle = '0/0';
			$altsStr = $comHash->{'REF'};
			$repAlt = $altsStr;
		}elsif($gtarray[0] ne $gtarray[1]) {
			if($gtarray[0] ne '0'){	# for hetero 1/2 1/3 2/3
				$gtSingle = '1/2';
				$altsStr = $altArrAll[$gtarray[0] - 1] . ",". $altArrAll[$gtarray[1] - 1];
				$repAlt = $altArrAll[$gtarray[0] - 1];
			} else {	# for hetero 0/1 0/2 0/3
				$gtSingle = '0/1';
				$altsStr = $altArrAll[$gtarray[1] - 1];
				$repAlt = $altsStr;
			}
		}else{	#for homo ./. 1/1 2/2 3/3
			$gtSingle = '1/1';
			$altsStr = $altArrAll[$gtarray[0] - 1];
			$repAlt = $altsStr;
		}

		# GTROW,GT
		$valHash->{'GTROW'} = $valHash->{'GT'};
		$valHash->{'GT'} = $gtSingle;

		# ALT
		$valHash->{'ALT'} = $altsStr;

		# DP1,DP2,DP3,DP4
		if(exists($valHash->{'DP1'})) {
			$valHash->{'DP2'} = 0;
			$valHash->{'DP4'} = 0;
		}

		# variant type
		my $variant = "s";
		my $pos2 = $comHash->{'POS'};
		my $refLen = length($comHash->{'REF'});
		my $repAltLen = length($repAlt);
		if ($refLen < $repAltLen) {
			$variant = "i";
		}
		if($repAlt eq "." || $refLen > $repAltLen) {
			$variant="d";
			$pos2 = $comHash->{'POS'} + 1;
		}
		$valHash->{'variant'} = $variant;
		$valHash->{'pos'} = $pos2;

		# EFF_GRP
		if($valHash->{'GT'} ne '0/0' && $valHash->{'GT'} ne './.') {
			my $level = 0;
			if(isEffFormat($comHash->{'EFF'})) {
				$level = $self->{'commonMysql'}->getMaxEffGrpEff($comHash->{'EFF'}, $altsStr);
			} else {
				$level = $self->{'commonMysql'}->getMaxEffGrpAnn($comHash->{'EFF'}, $altsStr);
			}
			$valHash->{'EFF_GRP'} = $level;
		}
	}
}

1;
