#!/usr/local/bin/perl
# author pjm
# Description
#
# If it finds a lig in Oracle it will put it into Equus if not already present.
# If it is present it will try to update it if it is different.
#
# Usage: put_oracle_ligs_into_equus.pl -last 1000
#
#        OR
#
#        put_oracle_ligs_into_equus.pl 28000 28001
#
#        OR
#
#        put_oracle_ligs_into_equus.pl -3000 -2000
#
# In the last example, if the greatest ligation number is 30000, this program
# will update ligations 27000 to 28000. Used by crons so we don't hammer
# Oracle or Equus with the last 10000 ligations, just do a set of 1000 each
# night.
#
# $Id: put_oracle_ligs_into_equus.pl,v 1.14 2001/09/04 18:55:54 pjm Exp $
#


use strict;
use WrapDBI;
use EquusDatabaseInterface;
#require "/nfs/galyep/pjm/badger-bin/EquusDatabaseInterface.pm";
use TempFiles;
use Sys::Hostname;
use Benchmark;
use Kill_Equus;
#require "/nfs/galyep/pjm/badger-bin/Kill_Equus.pm";

use Data::Dumper;

$|        = 1; # No buffering, want to see what its doing...
my $debug = 0;

*MAIN::EQUUS_TEMP_DIR  = \ '/nfs/sids/equus/tmp_files/';

my $send_email_to      = 'pjm'; # email bug later?
my @messages;


# Get & check from to ligation numbers
my $lig_from = shift;
my $lig_to   = shift;

if( ! defined($lig_from)  || !defined($lig_to) ){
    print "Args: <from> <to>  (eg; 21000 21100)\n";
    print "      OR\n";
    print "      -last 500    (eg, the most recent 500 ligations)\n";
    exit 0;
}


# Args good, loop for each ligation number
my $timer1 = new Benchmark();

print "\n";

my $dbh;
my $db_user       = 'reports';
my $equus_changed = 0;

my ($EDI, $equus_db) = Kill_Equus::openEquus('reports');
$equus_db->auto_save(0);

eval {
    $dbh =  WrapDBI->connect($db_user, {RaiseError => 1});
    die "Could not connect to database" if !defined $dbh;
    $dbh->{AutoCommit} = 0;
    my %cache;               # stores prepared SQL & stuff

    $EDI->reconnect(); # attempt to turn off auto_save (again).

    &get_from_to_numbers($dbh);
    &get_all_ligations_details($dbh, \%cache, $lig_from, $lig_to);
    &prepare_sql($dbh, \%cache);

    print "Adding/updating ligations $lig_from - $lig_to\n\n";

    foreach my $lig_num ($lig_from..$lig_to){
        # print "$lig_num\n";

        my ($volume,
            $clear,
            $blue,
            $comments,
            $clone_name,
            $from_kb,
            $to_kb,
            $frag_box,
            $vector_name,
            $date) = &get_ligation_details($dbh, \%cache, $lig_num);



#       if( $clone_name ){ # this is used for debugging only
        if( 0 ){
            print "   volume       $volume\n";
            print "   clear        $clear\n";
            print "   blue         $blue\n";
            print "   comments     $comments\n";
            print "   clone_name   $clone_name\n";
            print "   from_kb      $from_kb\n";
            print "   to_kb        $to_kb\n";
            print "   frag_box     $frag_box\n";
            print "   vector_name  $vector_name\n";
            print "   date         $date\n";
        }

        if( $clone_name ){
            print "$lig_num was found in Oracle. Looking in Equus...\n"
                if $debug;

            if( $EDI->checkExists('Ligation', $lig_num) ){

                if( &ligations_not_same($dbh, $equus_db, \%cache, $lig_num) ){

                    print "$lig_num: Existed in Equus, making the same as".
                        " Oracle...";

                    $EDI->updateLigation($clone_name,
                                         $lig_num,
                                         $date,
                                         $vector_name,
                                         $from_kb,
                                         $to_kb,
                                         $volume,
                                         $blue,
                                         $clear,
                                         $frag_box,
                                         $comments);
                    $equus_changed = 1;
                    print "Done.\n";
                }
                else {
                    print "$lig_num: Ligations same between Oracle & Equus\n"
                        if $debug;
                }
            }
            else {
                print "$lig_num: Not found in Equus. Adding it now...\n";

                my @paths = $EDI->addLigation($clone_name,
                                              $lig_num,
                                              $date,
                                              $vector_name,
                                              $from_kb,
                                              $to_kb,
                                              $volume,
                                              $blue,
                                              $clear,
                                              $frag_box,
                                              $comments);

                if( scalar(@paths) == 0 ) {
                    $EDI->rollback;
                    warn "\n*** Equus rollback done ***";
                    return 0;
                }

                $equus_changed = 1;
            }
        }
        else {
            print "$lig_num: LIGATION NOT IN ORACLE CORRECTLY, NO CLONE NAME\n\n";
        }
    }
};

if( $@ ){
    die "$@";
}

$dbh->disconnect if $dbh;

#
# $db->rollback;

if( $equus_changed ){
    print "\nAbout to commit...";
    $EDI->commit;
    print "Done.\n";
}
else {
    print "\nNothing was changed.\n";
}

my $timer2 = new Benchmark();
my $diff   = timediff($timer2, $timer1);

print "  - it took ", timestr($diff), "\n";

$equus_db->auto_save(0); # Equus seems to take a long time to disconnect...?

#

#
# START OF SUBROUTINES **************************************************
#
#

sub get_from_to_numbers {

    if( $lig_from eq '-last' ){
        # need to get the last $lig_to ligation numbers and reset $lig_from and
        # $lig_to. Lookup in oracle what the last lig number used was to work
        # it out.
        my $last = $lig_to;
        my $max  = $dbh->fetch_scalar(q[ select max(ID_LIGATION)
                                         from   LIGATION
                                         where  ID_LIGATION < 141014 ]);

        if( $max ){
            $lig_from = $max - $last + 1; # $lig_to still 
            $lig_to   = $max;
        }

    }
    elsif( $lig_from < 0 && $lig_to <= 0 ){
        if( $lig_from > $lig_to ){
            die "ERROR: from value must be less than the to value\n";
        }

        # user wants -2000 to -1000 off the max lig number
        my $max  = $dbh->fetch_scalar(q[ select max(ID_LIGATION)
                                         from   LIGATION
                                         where  ID_LIGATION < 141014 ]);

        if( $max ){
            $lig_from = $max + $lig_from; # add negative number
            $lig_to   = $max + $lig_to;
        }
    }
    elsif( ($lig_from < 0 && $lig_to > 0) ||
           ($lig_from > 0 && $lig_to < 0)   ){

        die "ERROR: You can't have one argument negative and ".
            "the other positive!\n";
    }
}

sub get_all_ligations_details {
    my ($dbh, $cache, $lig_from, $lig_to) = @_;

    my $sth = $dbh->prepare(q[select l.id_ligation,
                                     l.VOLUME, l.POSITIVE, l.NEGATIVE,
                                     l.COMMENTS, l.CLONENAME,
                                     ftb.SIZE_FROM_KB, ftb.SIZE_TO_KB,
                                     ftb.FRAGMENT_BOX,
                                     vs.VECTORNAME,
                                     to_char(ls.STATUSDATE, 'yyyy-mm-dd' )
                              from   LIGATION l,
                                     LIGATION_STATUS ls,
                                     FRAGMENTATION_BAND ftb,
                                     LIGATION_BATCH lb,
                                     VECTORSITE vs
                              where  l.ID_LIGATION  >= ?
                              AND    l.id_ligation  <= ?
                              and    ls.ID_LIGATION = l.id_ligation
                              and    ls.STATUS     in (1, 2)
                              and    l.ID_FRAGBAND  = ftb.ID_FRAGBAND
                              and    l.ID_LIGBATCH  = lb.ID_LIGBATCH
                              and    lb.SEQ_VECTOR  = vs.ID_VECTORSITE
                              ORDER BY l.id_ligation]);

    $sth->execute($lig_from, $lig_to);
    my $ref = $sth->fetchall_arrayref();
    $sth->finish();

    if( defined $ref && $ref ){
        foreach my $row_ref (@{$ref}){
            my $id_ligation = $row_ref->[0];
            my @values      = @{$row_ref}[1..10];

            $cache->{ligs}->{$id_ligation} = \@values;
        }
    }

#    print Data::Dumper::Dumper($cache->{ligs});
#    die "Just Testing\n";
}

sub prepare_sql {
    my ($dbh, $cache) = @_;

    $cache->{sql}->{get_lig_details} =
        $dbh->prepare(qq[select l.VOLUME, l.POSITIVE, l.NEGATIVE,
                                l.COMMENTS, l.CLONENAME,
                                ftb.SIZE_FROM_KB, ftb.SIZE_TO_KB,
                                ftb.FRAGMENT_BOX,
                                vs.VECTORNAME,
                                to_char(ls.STATUSDATE, 'yyyy-mm-dd' )
                         from   LIGATION l,
                                LIGATION_STATUS ls,
                                FRAGMENTATION_BAND ftb,
                                LIGATION_BATCH lb,
                                VECTORSITE vs
                         where  l.ID_LIGATION  = ?
                         and    ls.ID_LIGATION = l.id_ligation
                         and    ls.STATUS      = ?
                         and    l.ID_FRAGBAND  = ftb.ID_FRAGBAND
                         and    l.ID_LIGBATCH  = lb.ID_LIGBATCH
                         and    lb.SEQ_VECTOR  = vs.ID_VECTORSITE ]);
}

sub get_ligation_details {
    my ($dbh, $cache, $ligation) = @_;

    if( defined $cache->{ligs}->{$ligation} ){
        print "   Using the ligation cache...\n" if $debug;
        return @{$cache->{ligs}->{$ligation}};
    }

    print "$ligation: *** NOT USING THE CACHE, NO CREATED STATUS? ***\n";

    $cache->{sql}->{get_lig_details}->execute($ligation, 5);
    my @array = $cache->{sql}->{get_lig_details}->fetchrow_array();
    $cache->{sql}->{get_lig_details}->finish();

    unless( @array ){
        print "$ligation: *** NO CREATED STATUS, TRY FAILED STATUS ***\n";

        $cache->{sql}->{get_lig_details}->execute($ligation, 9);
        @array = $cache->{sql}->{get_lig_details}->fetchrow_array();
        $cache->{sql}->{get_lig_details}->finish();
    }

    if( @array ){
        $cache->{ligs}->{$ligation} = \@array;
    }

    return @array;
}





# If ligations differ between DBs, returns 1. make sure the value is not zero
# Else 0
#
sub ligations_not_same {
    my ($dbh, $equus_db, $cache, $ligation) = @_;

    my ($o_volume,
        $o_clear,
        $o_blue,
        $o_comments,
        $o_clone_name,
        $o_from_kb,
        $o_to_kb,
        $o_frag_box,
        $o_vector_name,
        $o_date) = &get_ligation_details($dbh, $cache, $ligation);

    my ($e_clone_name,
        $e_vector_name,
        $e_from_kb,
        $e_to_kb,
        $e_volume,
        $e_blue,
        $e_clear,
        $e_frag_box,
        $e_comments) = Kill_Equus::equus_get_ligation_info($equus_db,
                                                           $ligation);

    if( $e_clone_name ne $o_clone_name ){
        print "\n", "*"x78, "\n";
        print "$ligation: NOT THE SAME: clone:  $e_clone_name ne ".
            "$o_clone_name\n";
        print "*"x78, "\n";
        return 1;
    }

    if( $e_vector_name ne $o_vector_name ){
        print "$ligation: NOT THE SAME: vector: ".
            " $e_vector_name ne $o_vector_name\n" if $debug;
        return 1;
    }

    if( ($e_from_kb != $o_from_kb) && $o_from_kb ){
        print "$ligation: NOT THE SAME: from_kb:  $e_from_kb ne $o_from_kb \n"
            if $debug;
        return 1;
    }

    if( ($e_to_kb != $o_to_kb) && $o_to_kb ){
        print "$ligation: NOT THE SAME: to_kb:  $e_to_kb ne $o_to_kb\n"
            if $debug;
        return 1;
    }

    if( ($e_volume != $o_volume) && $o_volume ){
        print "$ligation: NOT THE SAME: volume:  $e_volume ne $o_volume\n"
            if $debug;
        return 1;
    }

    if( ($e_blue != $o_blue) && $o_blue ){
        print "$ligation: NOT THE SAME: blue:  $e_blue ne $o_blue\n"
            if $debug;
        return 1;
    }

    if( ($e_clear != $o_clear) && $o_clear ){
        print "$ligation: NOT THE SAME: clear:  $e_clear ne $o_clear \n"
            if $debug;
        return 1;
    }

    if( ($e_frag_box != $o_frag_box) && $o_frag_box ){
        print "$ligation: NOT THE SAME: frag_box:  $e_frag_box ne $o_frag_box\n"
            if $debug;
        return 1;
    }

    if( ($e_comments ne $o_comments) && $o_comments ){
        print "$ligation: NOT THE SAME: comments: $e_comments ne $o_comments\n"
            if $debug;
        return 1;
    }
}

# The below subs are not used, left it in case want to send an email of
# stuff to someone instead of printing it to STDOUT
#
sub write {
    my ($line) = @_;

    push @messages, $line;
}

sub email_someone {
    Mail::sendMail( -to      => $send_email_to,
                    -subject => "put_oracle_ligs_into_equus.pl", 
                    -message => join("", @messages));
}


