#!/usr/bin/perl -s
################################################################################
# blastdp 򥳥ԡƺ
# 
#   ϤʣʪΥǡξб뤿
#     -keepSpName ץɲ
#
#
################################################################################
require 'MBGD_Conf.pl';

$ConvUpper = 1;
$| = 1;

if ($ENV{'WWWROOT'}) {
    $HOMEDIR = "$ENV{'WWWROOT'}/..";
} else {
    if ($ENV{'DIR_DATA'}) {
        $HOMEDIR = $ENV{'DIR_DATA'};
    }
    else {
        $curr_dir = `dirname $0`; chomp $curr_dir;
        $HOMEDIR = "$curr_dir/..";
    }
}

if ($DBTAB) {
    $ENV{'DBTAB'} = $DBTAB;
}
else {
    $ENV{'DBTAB'} = "$DIR_mbgdhome/etc/dbtab" if (! $ENV{'DBTAB'});
}
$ENV{'PAMFILE'} = "$ENV{'MBGD_HOME'}/etc/allpamout.jtt";

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

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

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

($dbname) = ($ENV{'MYSQL_DB'} =~ /dbi:mysql:(.+)$/);

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);

        # E-value κƷ׻
#        $pval = &eval_corr($pval);
        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;
            }
            $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 "";
#    open(BGET, "$CMD_mbget -f $DBent |") || die "mbget failed\n";

    my($cmd) = "$CMD_mbget -dbname=$dbname -f @DBent";
#    open(BGET, "-|") || exec "$CMD_mbget", "-dbname=$dbname", "-f", @DBent;
    open(BGET, "-|") || exec "$cmd";

    $i = -1;
    while (<BGET>) {
        if (/^>[ ]*(\S+)/) {
            $id = $1;
#($sp,$name) = split(/:/,$id);
#$name =~ tr/a-z/A-Z/;
#$id= "$sp:$name";
#print STDERR "$id\n";

#            $i++;
#            if ($keepSpName) {
#                s#$id#$DBent[$i]#;
#            }
        }
#        $DBseq{$DBent[$i]} .= $_;
        $DBseq{$id} .= $_;
    }
    close(BGET);
}
exit if (! keys %Pvals);

$pid = open(P1, "|-");
if ($pid) {
    &parent_proc;
} else {
    &child_proc;
}
close(P1);

###############################################################################
#
sub parent_proc {
    foreach $ids (keys %Pvals) {
        ($id1,$id2) = split(/$;/,$ids);
        if ($Qfile) {
            print P1 "$Qseq{$id1}\n$DBseq{$id2}\n" if ($Qseq{$id1} && $DBseq{$id2});
print STDERR "$id2 not found\n" if (! $DBseq{$id2});
        } else {
            print P1 "$id1\n$id2\n";
        }
    }
    print P1 "\n";   # bget λΤ
}

###############################################################################
#
sub child_proc {
    $pid = open(P2, "-|");
    if (! $pid) {
        ## Child:  pipe process
        if ($Qfile) {
            exec("$CMD_dp2 -A -s -G -P0 $DPOPT -");
        } else {
            $execmd = "$CMD_mbget -dbname=$dbname -f | $CMD_dp2 -A -s -G -P0 $DPOPT -";
            exec("$execmd");
        }
    } else {
        ## Parent: filtering the output
        while (<P2>) {
            chomp();
            ($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(P2);
    }
}

###############################################################################
#
sub eval_corr {
    local($eval) = @_;
    local($N0) = 1000000;		## Normalized dbsize
    local($corr);
    $corr = sprintf("%.2g", $eval * $N0 / $N);
    $corr =~ s/^\s+//;

    return $corr;
}

###############################################################################
#
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;#
###############################################################################
