#
# orthologer - Pipeline for deducing orthology from fasta files.
# Copyright (C) 2005-2023 E. Zdobnov lab: F. Tegenfeldt
# <fredrik.tegenfeldt@unige.ch> based on code by E. Kriventseva
#
# This file is part of orthologer.
#
# orthologer is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# orthologer is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with orthologer.  If not, see <http://www.gnu.org/licenses/>.
#
use DB_File;    # Access DB databases
use Fcntl;      # Needed for above...
use strict;

#check args
my $size = @ARGV;
if ( $size!=4 ) {
    print "usage : fetch_inparalogs.pl <BRH file A:B> <Full A:A alignment> <Full B:B alignment> <overlap>\n";
    exit -1;
}

my $minOverlap = $ARGV[3];

# open input files
open(BRH,"<$ARGV[0]") or die $!;
open(AA,"cat $ARGV[1] |") or die $!;
open(BB,"cat $ARGV[2] |") or die $!;

# create DB
my $localdir="/tmp/";
unlink "$localdir/AA.$$.tmp_db";
unlink "$localdir/BB.$$.tmp_db";

tie(my %AA, 'DB_File', "$localdir/AA.$$.tmp_db", O_CREAT, 0644, $DB_File::DB_BTREE) || die;
tie(my %BB, 'DB_File', "$localdir/BB.$$.tmp_db", O_CREAT, 0644, $DB_File::DB_BTREE) || die;

# read input files
# commented lines (starting with '#') are ignored

# read A:A
while (<AA>) {
    next if (/^\s*\#.*/);
    my @aa = split /\s+/, $_;
    next if ($aa[0] eq $aa[1]);
    $AA{$aa[0]}.=$_;
}

# read B:B
while (<BB>) {
    next if (/^\s*\#.*/);
    my @bb = split /\s+/, $_;
    next if ($bb[0] eq $bb[1]);
    $BB{$bb[0]}.=$_;
}

# Loop over all BRH's
while (<BRH>) {
    next if (/^\s*\#.*/);
    my ($ab_id1,$ab_id2,$ab_score,$ab_e_val,$ab_ident, $ab_start1,$ab_end1,$ab_start2,$ab_end2) = split /\s+/, $_;
    # A   B
    my (@A, @B) = ();

#    print "#DBG: [A,B] $ab_id1, $ab_id2\n";
    # loop over A:A 
    foreach my $aa (split /\n/, $AA{$ab_id1}) {
        my ($aa_id1,$aa_id2,$aa_score,$aa_e_val,$aa_ident, $aa_start1,$aa_end1,$aa_start2,$aa_end2) = split /\s+/, $aa;
        if ($aa_score < $ab_score) {
            last;
        }
        my $overlapTst=($aa_end1>$ab_end1?$ab_end1:$aa_end1)-($aa_start1>$ab_start1?$aa_start1:$ab_start1);
        if ( ($ab_ident <= $aa_ident) and ($overlapTst > $minOverlap) ) {
            push(@A,"$aa_id2($aa_score;$aa_start1;$aa_end1;$aa_start2;$aa_end2)");
        } else {
#            print "#DBG:   [A,A'] $aa_id1, $aa_id2 failed with overlap $overlapTst, id = $ab_ident > $aa_ident\n";
#            print "#DBG:   [A,A'] $aa_start1,$aa_end1 and $ab_start1,$ab_end1\n";
        }
    }
    foreach my $aa (split /\n/, $AA{$ab_id2}) {
        my ($aa_id1,$aa_id2,$aa_score,$aa_e_val,$aa_ident, $aa_start1,$aa_end1,$aa_start2,$aa_end2) = split /\s+/, $aa;
        if ($aa_score < $ab_score) {
            last;
        }
        my $overlapTst=($aa_end1>$ab_end2?$ab_end2:$aa_end1)-($aa_start1>$ab_start2?$aa_start1:$ab_start2);
        if ( ($ab_ident <= $aa_ident) and ($overlapTst > $minOverlap) ) {
            push(@B,"$aa_id2($aa_score;$aa_start1;$aa_end1;$aa_start2;$aa_end2)");
        } else {
#            print "#DBG:   [A,A'] $aa_id1, $aa_id2 failed with overlap $overlapTst, id = $ab_ident > $aa_ident\n";
#            print "#DBG:   [A,A'] $aa_start1,$aa_end1 and $ab_start2,$ab_end2\n";
        }
    }

    # loop over B:B
    foreach my $bb (split /\n/, $BB{$ab_id1}) {
        my ($bb_id1,$bb_id2,$bb_score,$bb_e_val,$bb_ident, $bb_start1,$bb_end1,$bb_start2,$bb_end2) = split /\s+/, $bb;
        if ($bb_score < $ab_score) {
            last;
        }
        my $overlapTst=($bb_end1>$ab_end1?$ab_end1:$bb_end1)-($bb_start1>$ab_start1?$bb_start1:$ab_start1);
        if ( ($ab_ident <= $bb_ident) and ($overlapTst > $minOverlap) ) {
            push(@A,"$bb_id2($bb_score;$bb_start1;$bb_end1;$bb_start2;$bb_end2)");
        } else {
#            print "#DBG:   [B,B'] $bb_id1, $bb_id2 failed with overlap $overlapTst, id = $ab_ident > $bb_ident\n";
#            print "#DBG:   [B,B'] $bb_start1,$bb_end1 and $ab_start1,$ab_end1\n";
        }
    }
    foreach my $bb (split /\n/, $BB{$ab_id2}) {
        my ($bb_id1,$bb_id2,$bb_score,$bb_e_val,$bb_ident, $bb_start1,$bb_end1,$bb_start2,$bb_end2) = split /\s+/, $bb;
        if ($bb_score < $ab_score) {
            last;
        }
        my $overlapTst=($bb_end1>$ab_end2?$ab_end2:$bb_end1)-($bb_start1>$ab_start2?$bb_start1:$ab_start2);
        if ( ($ab_ident <= $bb_ident) and ($overlapTst > $minOverlap) ) {
            push(@B,"$bb_id2($bb_score;$bb_start1;$bb_end1;$bb_start2;$bb_end2)");
        } else {
#            print "#DBG:   [B,B'] $bb_id1, $bb_id2 failed with overlap $overlapTst, id = $ab_ident > $bb_ident\n";
#            print "#DBG:   [B,B'] $bb_start1,$bb_end1 and $ab_start1,$ab_end1\n";
        }
    }

    # print out result
    if ( (@B>0) or (@A>0) ) {
        print "$ab_id1:{",join(',',@A),"}\t$ab_id2:{",join(',',@B),"}\n";
    }
}
close BRH;

untie %AA;
untie %BB;
unlink "$localdir/AA.$$.tmp_db";
unlink "$localdir/BB.$$.tmp_db";