#!/usr/bin/perl -s

################################################################################
require "MBGD_Conf.pl";
require "ExecDp.pl";

################################################################################
#

#$ConvUpper = 1;
$| = 1;

if ($DBTAB) {
    $ENV{'DBTAB'} = $DBTAB;
}
$ENV{'DBTAB'} = "$DIR_mbgdhome/etc/dbtab" if (! $ENV{'DBTAB'});

$PVAL_CUTOFF = 1e-2 if (! defined $PVAL_CUTOFF);

$DPOPT = '-l' if (! $DPOPT);   ## Local

$db1 = $sp1 if ($sp1);
$db2 = $sp2 if ($sp2);

while (<>) {
    if (/^RANK/) {
        chomp();
        ($rank, $id1, $len1, $id2, $len2, $score, $pval, $n) = split(/#/);
        if (($db1) = ($id1 =~ /^([^:]+):/)) {
        } else {
            $id1 =~ tr/a-z/A-Z/ if ($ConvUpper);
            $id1 = "$sp1:$id1";
        }

        if (($db2) = ($id2 =~ /^([^:]+):/)) {
        } else {
            $id2 =~ tr/a-z/A-Z/ if ($ConvUpper);
            $id2 = "$sp2:$id2";
        }
        $db1 = $sp1 if ($sp1);
        $db2 = $sp2 if ($sp2);

        #
        if ($pval < $PVAL_CUTOFF) {
            if ($Line{$id1,$id2}) {
                print &replace_pval($Line{$id1,$id2},$pval,0);
                next;
            } elsif ($Line{$id2,$id1}) {
                print &replace_pval($Line{$id2,$id1},$pval,1);
                next;
            }

            if (($Pvals->{"$id1"}->{"$id2"} != 0) ||
                ($Pvals->{"$id2"}->{"$id1"} != 0)) {
                # Ȥ߹碌ϡ dp оݤȤʤäƤΤ SKIP 
                next;
            }
            $Pvals->{"$id1"}->{"$id2"} = $pval;
            $DBent{$id2} = 1;
        }
    } elsif (/^HSP/) {
        ($hsp,
         $region1, $region2,
         $score,
         $bit,
         $eval, $pval, $idt, $idtlen, $idtpct,
         $pos, $poslen, $pospct) = split(/#/);
    }
}

if ($Qfile) {
    open(Q, $Qfile) || die "Can not open $Qfile($!)";
    while (<Q>) {
        if (/^>[ ]*(\S+)/) {
            $id = $1;
        }
        $id = "$qdb:$id" if ($qdb && $id !~ /:/);
        $Qseq{$id} .= $_;
    }
    close(Q);

    #
    @DBent = keys %DBent;
    $DBent = join(' ', @DBent);
    open(BGET, "$cmd_bget -p $ENV{'DBTAB'} $DBent |") || die "";
    $i = -1;
    while (<BGET>) {
        if (/^>[ ]*(\S+)/) {
            $id = $1;
            $i++;
        }
        $DBseq{$DBent[$i]} .= $_;
    }
    close(BGET);
}
exit if (! keys(%{$Pvals}));

&procDp();
exit;

###############################################################################
#
sub procDp {
    my($filedpseq);
    my($cmd);

    if ($Qfile) {
        $filedpseq = &procDpQfile();
    }
    else {
        $filedpseq = &procDpStd();
    }

    #
    $cmd = &makeDpCmd($filedpseq, "$main::DpOpt $DPOPT");

    &procDpFormatTransfer($cmd);

    # եκ
    unlink("$filedpseq");


    return;
}

###############################################################################
#
sub procDpQfile {
    my($id1, $id2);
    my($filename);
    my($infoRes);
    local(*FH);

    $filename = "$DIR_mbgdhome/tmp/dp.$$";
    open(FH, ">$filename") || die("Can not open $filename($!)");
    foreach $id1 (keys(%{$Pvals})) {
        foreach $id2 (keys(%{$Pvals->{"$id1"}})) {
            print FH $Qseq{"$id1"}, "\n";
            print FH $DBseq{"$id2"}, "\n";
        }
    }
    close(FH);

    return $filename;
}

###############################################################################
#
sub procDpStd {
    my($fileTmp);
    my($id1, $id2);
    my($infoRes);
    my(@idPairList);

    foreach $id1 (keys(%{$Pvals})) {
        foreach $id2 (keys(%{$Pvals->{"$id1"}})) {
            push(@idPairList, "$id1\t$id2");
        }
    }

    #
    $fileTmp = "$DIR_work/tmp_dpseq.$$";

    #
    &GetSeqPair("$DIR_work/blastdb", $fileTmp, @idPairList);

    return $fileTmp;
}

###############################################################################
#
sub procDpFormatTransfer {
    my($cmd) = @_;
    local(*FH);

    open(FH, "$cmd | ") || die("Can not execute $cmd($!)");
    while(<FH>) {
        chomp();

        my($name1, $len1, 
           $name2, $len2,
           $from1, $to1,
           $from2, $to2,
           $matchlen, $matchnum, $percent,
           $bestscore,
           $mlpam, $exppam, $sdpam,
           $origscore) = split(/\s+/);

        if ($name1 !~ /:/) {
            $name1 =~ tr/a-z/A-Z/ if ($ConvUpper);
            $name1 = "$db1:$name1";
        }
        if ($name2 !~ /:/) {
            $name2 =~ tr/a-z/A-Z/ if ($ConvUpper);
            $name2 = "$db2:$name2";
        }
        $pval = $Pvals->{"$name1"}->{"$name2"};
        print "$name1 $name2 $from1 $to1 $len1 $from2 $to2 $len2 $matchlen $matchnum $percent $bestscore $pval $mlpam $exppam $sdpam $origscore\n";
    }
    close(FH);

    return;
}

###############################################################################
#
sub replace_pval {
    local($line,$newpval,$rev) = @_;
    local($name1,$name2,$from1,$to1,$len1,$from2,$to2,$len2,
        $matchlen,$matchnum,$percent,$bestscore,$pval,
        $mlpam,$exppam,$sdpam,$origscore)
        = split(/\s/, $line);
    local($out);
    my($ret);

    if ($rev) {
        $out = "$name2 $name1";
    } else {
        $out = "$name1 $name2";
    }

    $ret = "$out $from1 $to1 $len1 $from2 $to2 $len2 $matchlen $matchnum $percent $bestscore $newpval $mlpam $exppam $sdpam $origscore\n";

    return $ret;
}

###############################################################################
1;#
###############################################################################
