#!/usr/bin/perl -w

# tasuke_variant_vcf_multi.pl
# http://tasuke.dna.affrc.go.jp/
#
# Author: Norio Tabei
#
# Copyright (c) 2026 National Institute of Agrobiological Sciences
#

use strict;
use warnings;
use DBI;
use Getopt::Long;
use FindBin qw($Bin);
use lib "$Bin";
use POSIX 'WNOHANG';
use CommonLibTASUKE;
use Data::Dumper;

my $NAME   = '';
my $RESTORE= 0;
my $RESTORE_COMMON = 0;
my $REGGT00 = 0;
my $VCF    = '';
my $DB     = '';
my $HOST   = 'localhost';
my $USER   = '';
my $PASS   = '';
my $THREADS_DUMMY = 0;
my $ACCMAPFILE = '';
my $CHECKONLY = 0;
my $MEASUREDB = 0;
my $FORCEFLG = 0;
my $APPENDFLG = 0;
my $UNIT_COMMON_SQL = 100;	# Common: Bulk insert SQL Records.
				# The EFF information is large. There is a limit to the size of the query, so it cannot be made large.
my $UNIT_COMMON_COMMIT = 100;	# Common: Number of SQL executions to commit
my $SKIP_COMMON = 0;

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

my $commonMysql = new CommonMysql();

################################################################
# Checking parameters and database connection
################################################################
GetOptions(	'n|name=s'	=> \$NAME,
		'r|restore'	=> \$RESTORE,
		'q|restorecommon'	=> \$RESTORE_COMMON,
		'z|reggt00'	=> \$REGGT00,
		'f|file=s'	=> \$VCF,
		'db|database=s'	=> \$DB,
		'h|host=s'	=> \$HOST,
		'u|user=s'	=> \$USER,
		'p|password=s'	=> \$PASS,
		'm|accmap=s'	=> \$ACCMAPFILE,
		'k|checkonly'	=> \$CHECKONLY,
		's|measure'	=> \$MEASUREDB,
		'c|force'	=> \$FORCEFLG,
		'a|append',	=> \$APPENDFLG,
#		't|threads=i'	=> \$THREADS_DUMMY
);

my $connect;
if ( !$DB || !$USER ) {
	_error_method();
	_exit(1);
	
}
if($VCF) {
	if(!(-f $VCF)) {
		print STDERR "VCF file not found: $VCF\n";
		_exit(1);
	}
} elsif(!$RESTORE) {
	print STDERR "VCF file(-f) is required.\n";
	_exit(1);
	#TODO VCF is not required for RESTORE mode.
}

$connect = DBI->connect('DBI:mysql:database='. $DB. ';host='. $HOST, $USER, $PASS, {AutoCommit => 0})
        or die "Can't connect to database: $DBI::errstr\n";

my $MODE_IS_MULTIVCF = $commonMysql->modeIsPlusMultiVcf($connect);
if(!$MODE_IS_MULTIVCF) {
	print STDERR "The database is in single-VCF mode (-m svcf). This script is for multi-VCF mode (-m mvcf) only.";
	_exit(1);
}

###########################################################
# Checking base table
###########################################################
if ( ! defined _check_exists_table("sys_accession") ) {
    print "Some basic table does not exists.\n";
    print "Did you execute 'tasuke_init.pl' at the first?\n";
    _exit(1);
}

my $chrId2info = getChrInfoMap();
my $vcfSamples = getVcfSamplelist($VCF);
my ($dbAccInfoList, $dbAcc2InfoMap) = getDbAccInfo();

my $oriSample2accMap = {};
if($NAME) {
	setMapByNames($oriSample2accMap, $vcfSamples, $NAME)
} elsif($ACCMAPFILE) {
	setMapByFile($oriSample2accMap, $ACCMAPFILE);
} else {
	# SampleName = AccessionID
	foreach my $vcfSample (@{$vcfSamples}) {
		$oriSample2accMap->{$vcfSample} = $vcfSample;
	}
}

my @existSamples;
my @skipSamples;
my ($sample2accMap, $nonExistSamples) = deleteNonExistSamples($oriSample2accMap, $dbAcc2InfoMap);
{
	foreach my $sample (@{$vcfSamples}) {
		my $acc = "";
		if(exists($sample2accMap->{$sample})) {
			push @existSamples, $sample;
		} elsif(!exists($oriSample2accMap->{$sample})) {
			push @skipSamples, $sample;
		}
	}
}

my $existSamplesNum = scalar(@existSamples);
{
	if($RESTORE) {
		printf STDERR "> The following AccessionIDs is the target for deleting variant record: %d\n", $existSamplesNum;
	} else {
		printf STDERR "> The following AccessionIDs is the target for DB registration: %d\n", $existSamplesNum;
	}
	print STDERR "   +-----------------------------------------+\n";
	print STDERR "   |      AccessionID     <- VCF SampleName  |\n";
	print STDERR "   +-----------------------------------------+\n";
	my $i = 1;
	foreach my $sample (@existSamples) {
		my $acc = $sample2accMap->{$sample};
		printf STDERR "   \| %-4d %-15s <- %-15s \| \n", $i, $acc, $sample;
		$i++;
	}
	print STDERR "   +-----------------------------------------+\n\n";
}

my $notExistNum = scalar(@{$nonExistSamples});
if($notExistNum > 0) {
	printf STDERR "> !!! The AccessionIDs in the following samples are invalid: %d\n", $notExistNum;
	printf STDERR "> These will be skipped.\n";
	my $sorted = sortSampleVcfOrder($vcfSamples, $nonExistSamples);
	my $count = 1;
	foreach my $nonExistSample (@{$sorted}) {
		my $acc = $oriSample2accMap->{$nonExistSample};
		printf STDERR "   \| %-4d %-15s <- %-15s \| \n", $count, $acc, $nonExistSample;
		$count++;
	}
	print STDERR "\n";
#	_exit(1);
} else {
	printf STDERR "> A valid AccessionID was found in all the specified samples.\n\n";
}

my $skipNum = scalar(@skipSamples);
if($skipNum > 0) {
	printf STDERR "> The following VCF samples will be skipped (because it is not specified by user): %d\n", $skipNum;
	foreach my $sample (@skipSamples) {
		printf STDERR "$sample\n";
	}
	print STDERR "\n";
} 

my $dbAccsLen = scalar(@{$dbAccInfoList});
my $vcfSamplesLen =  scalar(@{$vcfSamples});
my $SpecifiedIdsLen = scalar(keys(%{$oriSample2accMap}));
my $statStr = sprintf "> Statistics\n> AllAccsInDB:%d   VcfSamples:%d   In it,SpecifiedSamples:%d   AccIdFound:%d   notFound(skip):%d",
        $dbAccsLen, $vcfSamplesLen, $SpecifiedIdsLen, $existSamplesNum, $notExistNum;

if($RESTORE) {
	print STDERR "$statStr\n\n";
	if($CHECKONLY) {
		print STDERR "> [This is CHECK-ONLY mode] it exits without deleting.\n";
	} else {
		if(!$FORCEFLG) { 
			print STDERR "> Delete only the Variant record. AccessionID itself is \"not\" deleted.\n";
			print STDERR "> Are you sure deleteing?[y|n] ";
			while (defined(my $line = <STDIN>)){
				chomp($line);
				if ( $line eq "y" || $line eq "Y" ) { last; }
				elsif ( $line eq "n" || $line eq "N" ) { print STDERR "Canceled.\n"; _exit(0); }
				else { print STDERR "> [y|n] "; }
			}
		}
		truncateTables($sample2accMap, $dbAcc2InfoMap);
	}
	_exit(0);
}

my $finalCode = 0;
if($CHECKONLY) {
	if($MEASUREDB) {
		measureDb($dbAccInfoList, $sample2accMap);
	}
	print STDERR "\n$statStr\n";
	print STDERR "\n> [This is CHECK-ONLY mode] Finished without DB registration.\n";
} else {
	my @TABLES;
	my @varTables;
	my $idx = 0;
	foreach my $sample (@{$vcfSamples}) {
		if(exists($sample2accMap->{$sample})) {
			my $accId = $sample2accMap->{$sample};
			my $accDb = $dbAcc2InfoMap->{$accId}->{'accession_db'};
			push @varTables, [$accId, $accDb, $idx];
			push @TABLES, sprintf("%s_variant", $accDb);
		}
		$idx++;
	}	
	
	print STDERR "> Checking if records exist in the target tables...\n";
	my %skipDbs;
	my @accsHasRecord;
	my $loop = 1;
	foreach my $varTableRefArr ( ((['sys_variant','sys']), @varTables) ) {
		printf STDERR "%d\t%s (%s_variant)\t", $loop, $varTableRefArr->[0], $varTableRefArr->[1];
		if(hasRecord($varTableRefArr->[1]. '_variant')) {
			printf STDERR "RecordExists";
			push @accsHasRecord, $varTableRefArr->[0];
			$skipDbs{$varTableRefArr->[1]} = 1 if(!$APPENDFLG);
		} else {
			printf STDERR "Empty";
		}
		printf STDERR "\n";
		$loop++;
	}
	if(keys(%skipDbs)) {
		my @varTablesDest;
		foreach my $varTableRefArr (@varTables) {
			push @varTablesDest, $varTableRefArr if(!$skipDbs{$varTableRefArr->[1]});
		}
		@varTables = @varTablesDest;
	}
	$SKIP_COMMON = 1 if(exists($skipDbs{'sys'}));

	if(!$FORCEFLG) {
		my $lenAccsHasRecord = scalar(@accsHasRecord);
		if($lenAccsHasRecord) {
			printf STDERR "> [!!!Please check!!!]\n%d tables below contain existing data.\n", $lenAccsHasRecord;
			print STDERR join(",", @accsHasRecord). "\n\n";
			if($APPENDFLG) {
				print STDERR "> This is \"Append\" mode, so it will add data to the existing table.\n";
				print STDERR "> [Note] Data with the same chr-pos will be registered multiple times.\n";
			} else {
				print STDERR "> Registration for the tables above will be skipped.\n";
			}
			print STDERR "> Are you sure proccessing?[y|n] ";
			while (defined(my $line = <STDIN>)){
				chomp($line);
				if ( $line eq "y" || $line eq "Y" ) {
					last;
				} elsif ( $line eq "n" || $line eq "N" ) {
					print STDERR "Canceled.\n"; _exit(0);
				} else {
					print STDERR "> [y|n] ";
				}
			}
		} 
	}

	# If this isn't done, the threads below will stall.
	# Is the database locked? hasRecord() seems to be the problem, but the cause is unknown.
#	$connect->disconnect or warn "Disconnection error: $DBI::errstr\n" if($connect);

	my $sqlLock = "LOCK TABLES sys_variant WRITE,". join(" WRITE,", @TABLES);
	$sqlLock =~ s/,$//;
	$sqlLock .= " WRITE";
	dbexe($sqlLock);
	$finalCode =_insertVarGATKm_common($chrId2info, \@varTables, $VCF);
	dbexe("UNLOCK TABLES");
}
_exit($finalCode);

sub getChrInfoMap {
	my %id2info;
	my $sth = $connect->prepare("SELECT * FROM sys_chromosome");
	$sth->execute();
	while(my $hashref = $sth->fetchrow_hashref()) {
		$id2info{$hashref->{'id'}} = $hashref;
	}
	return \%id2info;
}
sub hasRecord {
	my($table) = @_;
#	return $connect->selectrow_array("select * from $table limit 1");
	my $sth = $connect->prepare("select 1 from $table limit 1");
	$sth->execute() or die $!;
	my $res = $sth->fetchrow_arrayref();
	$sth->finish();
	return defined($res);
}
sub getFileHandle {
	my($VCF) = @_;
	my $fh;
	if ($VCF =~ m/\.tar\.gz$/) {
		open $fh, "tar zxf $VCF -O 2> /dev/null|" or die "file open error: $!";
	} elsif($VCF =~ m/\.tar\.bz2$/) {
		open $fh, "tar jxf $VCF -O 2> /dev/null|" or die "file open error: $!";
	} elsif($VCF =~ m/\.gz$/) {
		open $fh, "gzip -dc $VCF 2> /dev/null|" or die "file open error: $!";
	} elsif($VCF =~ m/\.bz2$/) {
		open $fh, "bzip2 -dc $VCF 2> /dev/null|" or die "file open error: $!";
	} else {
		open $fh, '<', $VCF or die "file open error: $!";
	}
	return $fh;
}
sub dbexe {
	my ($query) = @_;
	my $query_handle = $connect->prepare($query);
	$query_handle->execute();
	$query_handle->finish();
}
sub sortSampleVcfOrder {
	my ($vcfOrder, $samples) = @_;

	my $vcfOrderLen = @{$vcfOrder};
	my %sample2index;
	for(my $i=0; $i<$vcfOrderLen; $i++) {
		$sample2index{$vcfOrder->[$i]} = $i;
	}
	my @sorted =  sort {$sample2index{$a} <=> $sample2index{$b}} @{$samples};
	return \@sorted;
}
sub getVcfSamplelist {
	my($vcf) = @_;

	my @samples;
	local *FH;
#	open(FH, "<$vcf")  or die "$vcf: $!";
#	while(<FH>) {
	my $fh = getFileHandle($vcf);
	while(<$fh>) {
		chomp;
		my $datarow = trim($_);
		next if($datarow !~ m/\S/);

		if($datarow =~ m/#CHROM/i) {
			my @header = split /\t/, $datarow;
			my $headerLen = @header;
			for(my $i=9; $i<$headerLen; $i++) {
				push @samples, $header[$i];
			}
			last;
		}
	}
	close($fh);
#	close(FH);
	return \@samples;
}
sub getDbAccInfo {
	my $sth = $connect->prepare('select * from sys_accession');
	$sth->execute();
	my @array;
	my %hash;
	while(my $hashref = $sth->fetchrow_hashref) {
		push @array, $hashref;
		$hash{$hashref->{'accession_id'}} = $hashref;
	}
	$sth->finish();
	return (\@array, \%hash);
}
sub setMapByNames {
	my ($map, $vcfSamples, $namesStr) = @_;
	$namesStr =~ s/\s//g;
	my @names = split /,/, $namesStr;
	my $namesLen = @names;
	my $vcfSamplesLen = @{$vcfSamples};
	for(my $i=0; $i<$namesLen && $i<$vcfSamplesLen; $i++) {
		if($names[$i]) {
			$map->{$vcfSamples->[$i]} = $names[$i];
		}
	}
}
sub setMapByFile {
	my ($map, $accMapFile) = @_;

	local *FH;
	open(FH, "<$accMapFile") or die "$accMapFile: $!";
	while(<FH>) {
		chomp;
		my $datarow = trim($_);
		next if($datarow !~ m/\S/);

		my @vals = split /,/, $datarow;
		my $valsLen = @vals;
		for(my $i=0; $i<$valsLen; $i++) {
			$vals[$i] = trim($vals[$i]);
		}
#		my @vals = split /\s+/, $datarow;
		if($vals[0]) {
			if($vals[1]) {
				$map->{$vals[0]} = $vals[1];
			} else {
				$map->{$vals[0]} = $vals[0] 
			}
		}
	}
	close(FH);
}
sub deleteNonExistSamples{
	my ($map, $acc2Info) = @_;

	my %existsMap;
	my @nonExists;
	my @samples = keys(%{$map});
	foreach my $sample (@samples) {
		my $acc = $map->{$sample};
		if(!$acc || !exists($acc2Info->{$acc})) {
			push @nonExists, $sample;
		} else {
			$acc2Info->{$acc}->{'sample'} = $sample;
			$existsMap{$sample} = $map->{$sample};
		}		
	}
	return (\%existsMap, \@nonExists);
}
sub truncateTables {
	my ($map, $acc2Info) = @_;

	my @samples = keys(%{$map});
	push @samples, 'sys' if($RESTORE_COMMON);
	foreach my $sample (@samples) {
		my $sql = '';
		my $acc = '';
		if($sample eq 'sys') {
			$acc = $sample;
			$sql = sprintf "truncate table sys_variant";
		} else {
			$acc = $map->{$sample};
			my $db = $acc2Info->{$acc}->{'accession_db'};
			$sql = sprintf "truncate table %s_variant", $db;
		}
		my $status = 'success';
		my $sth = $connect->prepare($sql);
		$sth->execute() or $status = "failed";
		$sth->finish();
		printf STDERR "   | %-15s <- %-15s| %s;	=> %s\n", $acc, $sample, $sql, $status;
	}
}
sub test_getAccMap {
	my ($dbAccInfos, $vcfSamples) = @_;

	foreach my $vcfSample (@{$vcfSamples}) {
		my $vcfAcc = "";
		foreach my $dbAccInfo (@{$dbAccInfos}) {
			foreach my $col ('accession_id', 'accession_name', 'origin', 'origin_2', 'other_1', 'other_2') {
				if($vcfSample eq $dbAccInfo->{$col}) {
					$vcfAcc = $dbAccInfo->{'accession_id'};
					last;
				}
			}
		}
		if(!$vcfAcc) {
			foreach my $dbAccInfo (@{$dbAccInfos}) {
				my $accName = $dbAccInfo->{'accession_name'};
				$accName =~ s/\s//g;
				if($vcfSample =~ m/$accName/i) {
					$vcfAcc = $dbAccInfo->{'accession_id'};
					last;
				}

			}
		}
		printf "%s\t%s\n", $vcfSample, $vcfAcc;
	}
}
sub test_getAccCsv {
	my ($dbAccInfos) = @_;

	my @cols = ('accession_id', 'accession_name', 'variety', 'sub_variety', 'origin', 'origin_2', 'type', 'other_1', 'other_2');
	foreach my $info (@{$dbAccInfos}) {
		my @onefow;
		foreach my $col (@cols) {
			push @onefow, $info->{$col};
		}
		printf "%s\n", join(',', @onefow);
	}
}
sub _check_exists_table {
	my ($t) = @_;
	my $val;
	$val = $connect->selectrow_array("show tables like '$t'");
	return $val;
}
sub trim {
	my($str) = @_;
	$str =~ s/^\s+//;
#	$str =~ s/[\s\W]+$//;
	$str =~ s/\s+$//;
	return $str;
}
=head
sub killAllChildProcess {
	my($pids) = @_;
	foreach my $pid (@{$pids}) {
		kill(9, $pid);
	}
}
=cut
sub measureDb {
	my($accList, $sample2accMap) = @_;
	print STDERR "> Record count by accessionID\n\n";
	foreach my $accRef (@{$accList}) {
		my $sql = sprintf "select count(1) as cnt from %s_variant", $accRef->{'accession_db'};
		my $sth = $connect->prepare($sql);
		$sth->execute();
		my $arrayref = $sth->fetchrow_arrayref();
		$sth->finish();
		my $sampleName = $accRef->{'sample'};
		my $targetOrNot = "";
		$targetOrNot = '*' if(exists($sample2accMap->{$sampleName}));
		printf STDERR "%s %s  <-  %s\t%s_variant\t%s\n", $targetOrNot, $accRef->{'accession_id'}, $sampleName, $accRef->{'accession_db'}, $arrayref->[0];
	}
}

#### Disconnection and exit #######################################
sub _exit {
    my ($arg) = @_;
    my $code = 0;
    if(defined $arg){$code = $arg;}
    $connect->disconnect or warn "Disconnection error: $DBI::errstr\n" if($connect);
    exit($code);
}

sub _error_method {
	print STDERR "Usage: $0  -db [database] -u [user] -p [password] -f [VCFfile]\n\n";
	print STDERR "Either required (*1):\n";
	print STDERR "  -n <IDs> : Comma-separated AccessionID list (Corresponds to the order of VCF sample names) (*2)\n";
	print STDERR "  -m <Path>: Path to \"SampleName > AccID\" correspondence table. VCFsampleName[,]AccID[\\n]...\n";
	print STDERR "  (none)   : Consider VCF sample name as AccessionID.\n";
	print STDERR "Other options:\n";
	print STDERR "  -h <remote host> : (default: localhost)\n";
	print STDERR "  -z : Register GT:0/0 variant(not by default)\n";
	print STDERR "  -t <num>: Invalid parameter, kept for compatibility.\n";
	print STDERR "  -k : TEST mode. Check AccessionIDs, but do not perform DB registration.\n";
	print STDERR "Sub-action:\n";
	print STDERR "  -a : Append variant information to a table that already contains records.(*3) Records with the same position will be registered multiple times.\n";
	print STDERR "  -r : Truncate variant table(d*_variant) for the specified AccessionIDs. AccessionID itself is not deleted.\n";
	print STDERR "  -q : [Use with \"-r\"] Truncate common variant table(sys_variant)\n";
	print STDERR "\n";
	print STDERR "(*1) priority is n > m, Only the AccIDs specified here will be registered.\n";
	print STDERR "(*2) See description in tasuke_variant_vcf.pl on the Wiki.\n";
	print STDERR "(*3) By default, registration is skipped for tables where records already exist.\n";
	print STDERR "\n";
}

## Update variants ##############################
sub _insertVarGATKm_common {
	my ($chrId2Info, $varTables, $file) = @_;
	my $code = 0;

	my $currentUnitSql = 0;
	my $currentUnitCommit = 0;

	$| = 1;		# AutoFlush:On

	my $sqlCol = "insert into sys_variant (chr,pos_vcf,REF,ALTS,VDB,MQ,FQ,SP,EFF,AF1,AC1,QUAL) values ";
	my $sqlVal = "(?,?,?,?,?,?,?,?,?,?,?,?),";
	my @sqlParams;
	my @valsTemplate = ('',undef,'','',undef,undef,undef,undef,'','','',undef);

	my $sqlSampleCol = "insert into %s_variant (chr,pos_vcf,pos,variant,ALT,DP,DP1,DP2,DP3,DP4,GT,GTROW,PL,GQ,EFF_GRP) values ";
	my $sqlSampleVal = "(?,?,?,?,?,?,?,?,?,?,?,?,?,?,?),";
	my %sampleCol2sqlParams;

	my $fh = getFileHandle($file);
	my $total = 0;
	while(<$fh>) {
		chomp;
		my $datarow = $_;
		next if($datarow !~ m/\S/ || $datarow =~ m/^#/);

		my @line = split(/\t/, $datarow);
		my $CHR = $line[0];
		next if(!exists($chrId2Info->{$CHR}));
		my $POS = int($line[1]);
		my $REF = $line[3];
		my $ALTS = $line[4];
		my $QUAL = int($line[5]);
		my %valsHash;
		my $EFF = '';
		$EFF = $2 if($line[7] =~ m/(ANN|EFF)\=([^\;]+)/);

		my $refLen = length($REF);
		my @vals = @valsTemplate;	# Deep copy
		$vals[0] = $CHR;
		$vals[1] = $POS;
		$vals[2] = $REF;
		$vals[3] = $ALTS;
		$vals[4] = $valsHash{'VDB'} if(exists($valsHash{'VDB'}));
		$vals[5] = $valsHash{'MQ'} if(exists($valsHash{'MQ'}));
		$vals[6] = $valsHash{'FQ'} if(exists($valsHash{'FQ'}));
		$vals[7] = $valsHash{'SP'} if(exists($valsHash{'SP'}));
		$vals[8] = $EFF;
		$vals[9] = $valsHash{'AF'} if(exists($valsHash{'AF'}));
		$vals[10] = $valsHash{'AC'} if(exists($valsHash{'AC'}));
		$vals[11] = $QUAL;
		push @sqlParams, \@vals;
		$total++;
		$currentUnitSql++;

		parseSamples($varTables, \@line, {'CHR' => $CHR, 'POS' => $POS, 'REF' => $REF, 'ALTS' => $ALTS, 'EFF' => $EFF}, \%sampleCol2sqlParams);

		if($currentUnitSql >= $UNIT_COMMON_SQL) {
			print ".";
			_execSql($sqlCol, $sqlVal, \@sqlParams) if(!$SKIP_COMMON);
			_execVarGATKm_Samples($sqlSampleCol, $sqlSampleVal, \%sampleCol2sqlParams);
			@sqlParams = ();
			%sampleCol2sqlParams = ();
			$currentUnitSql = 0;

			$currentUnitCommit++;
			if($currentUnitCommit >= $UNIT_COMMON_COMMIT) {
				printf("Progress: %s\t%d\t RegisteredVariants:%d\t", $CHR, $POS, $total);

				$connect->commit();
				print " ->Commit\n";
				$currentUnitCommit = 0;
			}
		}

	}
	_execSql($sqlCol, $sqlVal, \@sqlParams) if(!$SKIP_COMMON);
	_execVarGATKm_Samples($sqlSampleCol, $sqlSampleVal, \%sampleCol2sqlParams);
	@sqlParams = ();
	%sampleCol2sqlParams = ();
	$connect->commit();
	print " ->Commit\n";

	close($fh);

	$| = 0;		# AutoFlush:Off

	return $code;
}
sub parseSamples {
	my($varTables, $onerowArr, $comHash, $outHash) = @_;

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

	foreach my $ref (@{$varTables}) {
		my $sampleIdx = $ref->[2];
		my $accDb = $ref->[1];

                my %valHash;
                my @sgtv = split /:/, $onerowArr->[$sampleIdx + 9];
                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;
                }

		if(!$REGGT00 && $valHash{'GT'} !~ m/[^\/0]/) {
			# Skip.
		} else {
			if($valHash{'GT'} =~ m/^\./ || !exists($valHash{'GT'})) {
				$valHash{'DP'} = -1;
				$valHash{'GQ'} = -1;
				$valHash{'DP1'} = -1;
				$valHash{'DP3'} = -1;
			} else {
				setDepth(\%valHash);
				$valHash{'DP'} = -1 if(!$valHash{'DP'} || $valHash{'DP'} eq '.');
				$valHash{'GQ'} = -1 if(!$valHash{'GQ'} || $valHash{'GQ'} eq '.');
			}
			setInfo($comHash, \%valHash);

			my @valsArr = ($comHash->{'CHR'}, $comHash->{'POS'}, $valHash{'pos'}, $valHash{'variant'},
				undef,undef,undef,undef,undef,undef,$valHash{'GT'},undef,undef,undef,undef);
			$valsArr[4] = $valHash{'ALT'} if(exists($valHash{'ALT'}));
			$valsArr[5] = $valHash{'DP'} if(exists($valHash{'DP'}));
			if(exists($valHash{'DP1'})) {
				$valsArr[6] = $valHash{'DP1'};
				$valsArr[7] = $valHash{'DP2'};
				$valsArr[8] = $valHash{'DP3'};
				$valsArr[9] = $valHash{'DP4'};
			}
			$valsArr[11] = $valHash{'GTROW'} if(exists($valHash{'GTROW'}));
			$valsArr[12] = $valHash{'PL'} if(exists($valHash{'PL'}));
			$valsArr[13] = $valHash{'GQ'} if(exists($valHash{'GQ'}));
			$valsArr[14] = $valHash{'EFF_GRP'} if(exists($valHash{'EFF_GRP'}));

			$outHash->{$sampleIdx} = [$accDb, []] if(!exists($outHash->{$sampleIdx}));
			push @{$outHash->{$sampleIdx}->[1]}, \@valsArr;
		}
        }
}
sub _execSql {
	my($sqlCol, $sqlVal, $sqlParams) = @_;

	my $sql = $sqlCol;
	my @arr;
	my $num = scalar(@{$sqlParams});
	return if($num == 0);
	for(my $i=0; $i<$num; $i++) {
		my $ref = $sqlParams->[$i];
		$sql .= $sqlVal;
		push @arr, @{$ref};
	}
	$sql =~ s/,$//;
	my $sth = $connect->prepare($sql);
	$sth->execute(@arr) || print "Error: $!\n". Dumper($sqlParams). "\n";
	$sth->finish();
}
sub _execVarGATKm_Samples {
	my($sqlCol, $sqlVal, $sampleCol2sqlParams) = @_;

	foreach my $sampleIdx (keys(%{$sampleCol2sqlParams})) {
		my $sqlParams = $sampleCol2sqlParams->{$sampleIdx};
		_execSql(sprintf($sqlCol, $sqlParams->[0]), $sqlVal, $sqlParams->[1]) if($sqlParams);
		$sampleCol2sqlParams->{$sampleIdx} = [];	# for Memory Reduction.
	}
}
sub setDepth {
        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($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 = $commonMysql->getMaxEffGrpEff($comHash->{'EFF'}, $altsStr);
                        } else {
                                $level = $commonMysql->getMaxEffGrpAnn($comHash->{'EFF'}, $altsStr);
                        }
                        $valHash->{'EFF_GRP'} = $level;
                }
        }
}
sub isEffFormat {
        my($str) = @_;
        if($str =~ m/^[^\|\(]+\(/) {
                return 1;
        } else {
                return 0;
        }
}

