################################################################################
# Author: pjm
# Description;
#
# Collection of routines that are involved in transfering data from Equus to
# Oracle (and maybe vice versa).
#
# $Id: Kill_Equus.pm,v 1.23 2003/07/30 10:09:44 rmd Exp $
#
################################################################################

package Kill_Equus;

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

my $bug_mail = 'bug';
my $debug    = 0;

sub openEquus {
    my ($user) = @_;

    my $hostname  = Sys::Hostname::hostname();
    my $pid       = $$;
    my $prog      = $0;
    $prog         =~ s/.*\///;
    my $temp_file = $prog."_".$hostname."_".$pid."";

    my $tFiles = TempFiles->new(prefix => $temp_file,
				dir    => '/nfs/sids/equus/tmp_files/');

    my $EDI = EquusDatabaseInterface->new($tFiles,
					  $user,  # used for Oracle readonly
					  0,      # No debug
                                          1);     # No Tk
    $EDI->reconnect(); # force it do connect so element 'db' in EDI object

    # return EDI and the db object within it so can do direct access
    return ($EDI, $EDI->{db});
}

sub openOracle {
    my ($user) = @_;
    my ($dbh);

    $dbh = WrapDBI->connect($user, {RaiseError => 1});
    die "Could not connect to database" if !defined $dbh;
    $dbh->{AutoCommit} = 0;

    return $dbh;
}

# Give it a clone name and it will attempt to add those ligs from Equus to
# Oracle
#
sub try_add_ligations_for_clone {
    my ($equus_db, $EDI, $dbh, $clone_name) = @_;

    my @ligations = &equus_get_ligs_for_clone($equus_db, $clone_name);

    print "$clone_name had ligations : ", join(', ', @ligations), "\n";
    print "Attempting to add them ot Oracle\n";

    eval {
        foreach my $lig (@ligations){
            Kill_Equus::try_to_add_ligation_to_oracle($dbh, $EDI,
                                                      $equus_db,
                                                      $lig, $debug);
            print "Ligation $lig added\n";
        }
    };

    print "$@\n" if $@;

    return 0 if $@;
    return 1;
}

sub equus_get_ligs_for_clone {
    my ($equus_db, $clone_name) = @_;

    my $clone_obj    = $equus_db->fetch(-class => 'Clone',
                                        -name  => $clone_name,
                                        );

    return undef unless( $clone_obj );

    my @ligations = $clone_obj->at("Ligation");
    my @lig_nums;

    foreach my $lig_obj (@ligations){
        push @lig_nums, "$lig_obj";
    }

    # $ligation is an object pointer, get scalar value to pass back
    return @lig_nums;
}

sub equus_get_plates_for_ligation {
    my ($equus_db, $ligation) = @_;

    my $lig_obj    = $equus_db->fetch(-class => 'Ligation',
                                      -name  => $ligation,
                                      );

    return undef unless( $lig_obj );

    my @plates = $lig_obj->at("Plate");

    # return scalar name, not object ref
    my %return_hash;

    foreach my $p (@plates){

#        print "Plate $p: ", Data::Dumper::Dumper($p);

        my $plate_obj = $equus_db->fetch(-class => 'Plate',
                                         -name  => $p);

        my $team = $plate_obj->at("Team[1]");

        $return_hash{"$p"} = "$team";
    }

#    print "Kill_Equus: ", Data::Dumper::Dumper(\%return_hash);

    return %return_hash;
}

# simply get lig number for a plate so the ligation will exist in Oracle
# before adding the plate
#
sub try_to_add_ligation_for_plate_to_oracle {
    my ($dbh, $EDI, $equus_db, $plate_name, $debug_value) = @_;

    $debug = $debug_value if defined $debug_value;

    my $ligation = &equus_get_ligation_from_plate( $EDI, $equus_db,
                                                   $plate_name );

    print "lig = $ligation, plate_name = $plate_name\n" if $debug;

    if( ! defined $ligation || $ligation eq '' ){
        die "Could not get ligation for plate $plate_name from Equus";
    }

    &try_to_add_ligation_to_oracle($dbh,
                                   $EDI,
                                   $equus_db,
                                   $ligation,
                                   $debug_value);

    return $ligation
}

# . Make sure the ligation exists and is a number
# . return if ligation > 20000, lemur crteated so probably ok
# . If ligation not in oracle, create it
# . If it is already in Oracle check it against the Equus record. Mail $bug_mail
#   if can not match up or fix Oracle records.
#
sub try_to_add_ligation_to_oracle {
    my ($dbh, $EDI, $equus_db, $ligation, $debug_value) = @_;

    $debug = $debug_value if defined $debug_value;

    if( $ligation ){
        if( $ligation !~ /^\d+$/ ){
            die "Could not add ligation '$ligation' to Oracle";
        }

        # don't waste time, entered via lemur. Data probably ok.
        return if $ligation > 20000;

        print "\nLigation $ligation found in Equus\n" if $debug;

        unless( Kill_Equus::ligation_exists_in_oracle($dbh, $ligation) ){

            if( $debug ){
                print "Ligation $ligation did NOT exist in Oracle - adding\n";
            }
            &add_ligation_to_oracle( $EDI, $equus_db, $dbh, $ligation );
        }
        else {
            if( $debug ){
                print "Ligation $ligation was in Oracle already - Checking.\n";
            }

            &make_ligations_the_same($equus_db, $dbh, $ligation);
        }
    }
    else {
        print "\nNo ligation found\n\n" if $debug;

        die "could not find ligation $ligation in Equus\n";
    }

}

# for the supplied plate name, return the ligatin it came from
sub equus_get_ligation_from_plate {
    my ($EDI, $equus_db, $plate_name) = @_;

    my $plate_obj    = $equus_db->fetch(-class => 'Plate',
                                        -name  => $plate_name,
                                        );

    return undef unless( $plate_obj );

    my ($ligation) = $plate_obj->at("Ligation");

    # $ligation is an object pointer, get scalar value to pass back
    return "$ligation";
}

# for the supplied plate name, return the ligatin it came from
sub oracle_get_ligation_from_plate {
    my ($dbh, $plate_name) = @_;

    return $dbh->fetch_scalar(qq[select distinct l.ID_LIGATION
                                 from   BECKMAN_BOX bb, BB_MAP bbm, SUBCLONE sc,
                                        LIGATION l
                                 where  bb.NAME          = '$plate_name'
                                 and    bb.ID_BECKMANBOX = bbm.ID_BECKMANBOX
                                 and    bbm.ID_SUBCLONE  = sc.ID_SUBCLONE
                                 and    sc.ID_LIGATION   = l.ID_LIGATION ]);
}

sub add_ligation_to_oracle {
    my ($EDI, $equus_db, $dbh, $ligation) = @_;

    my ($clone, $vector, $min_size, $max_size, $volume,
        $blue,  $clear,  $fragmentBox, $remark ) =
            Kill_Equus::equus_get_ligation_info($equus_db, $ligation);

    unless( Kill_Equus::clone_exists_in_oracle($dbh, $clone) ){
        die "Clone $clone did not exist in Oracle";
    }

    &check_ligation_values(\$clone, \$vector, \$min_size, \$max_size, \$volume,
                           \$blue,  \$clear,  \$fragmentBox, \$remark);

print "\nvalues: $clone, $vector, $min_size, $max_size, $volume,
                 $blue,  $clear,  $fragmentBox, $remark\n";

    &Kill_Equus::insert_lig_records_into_oracle($dbh,
                                                $ligation,
                                                $volume,
                                                $clear,
                                                $blue,
                                                $min_size,
                                                $max_size,
                                                $vector,
                                                $clone,
                                                $fragmentBox);
}


# Will set default values if values not already set
# if $debug it will output the values found in equus for this ligation
#
sub check_ligation_values {
    my ($clone, $vector, $min_size, $max_size, $volume,
        $blue,  $clear,  $fragmentBox, $remark) = @_;

    if( $$clone eq '' ){
        print "WARNING: no clone info found for ligation\n"
            if $debug;
    }
    if( $$vector eq '' ){
        print "WARNING: no vector info found for ligation\n"
            if $debug;
    }
    if( $$min_size eq '' ){
        print "WARNING: no min_size info found for ligation\n"
            if $debug;
        $$min_size = -1;
    }
    if( $$max_size eq '' ){
        print "WARNING: no max_size info found for ligation\n"
            if $debug;
        $$max_size = -1;
    }
    if( $$volume eq '' ){
        print "WARNING: no volume info found for ligation\n"
            if $debug;
        $$volume = -1;
    }
    if( $$blue eq '' ){
        print "WARNING: no blue info found for ligation\n"
            if $debug;
        $$blue = -1;
    }
    if( $$clear eq '' ){
        print "WARNING: no clear info found for ligation\n"
            if $debug;
        $$clear = -1;
    }
    if( $$fragmentBox eq '' ){
        print "WARNING: no fragmentBox info found for ligation\n"
            if $debug;
    }
    
    if( $debug ){
        print "Info found in Equus;\n";
        print "   clone      : $$clone\n";
        print "   vector     : $$vector\n";
        print "   min_size   : $$min_size\n";
        print "   max_size   : $$max_size\n";
        print "   volume     : $$volume\n";
        print "   blue       : $$blue\n";
        print "   clear      : $$clear\n";
        print "   fragmentBox: $$fragmentBox\n";
        print "   remark     : $$remark\n";
    }  
}


sub clone_exists_in_oracle {
    my ($dbh, $clone_name) = @_;

    return $dbh->fetch_scalar(qq[ select count(*) from clone
                                  where  clonename = '$clone_name' ]);
}

# Takes a bunch of arguments to create 4 records needed to represent enough
# information about a ligation for Asp. The tables involved are 
#
#    LIGATION_BATCH, FRAGMENTION_BAND, LIGATION, LIGATION_STATUS
#
# NOTE:
# A dummy record for FRAGMENTATION has been created  ID_FRAG = 1931.
#                                     (if dev1 user, ID_FRAG = 367 )
# All FRAGMENTATION_BANDs created by this program will be linked to that record!
#
#
sub insert_lig_records_into_oracle {
    my ($dbh,
        $lig_num,
        $volume,
        $positive,
        $negative,
        $from,
        $to,
        $seq_vector,
        $clone,
        $fragmentBox)      = @_;

    # sanity checks
    $fragmentBox = "''" unless $fragmentBox;
    $volume      = -1   unless $volume;

    # LIGATION_BATCH - assume everything SmaI enzyme
    my $id_vectorsite = &get_id_vectorsite_for_vector($dbh, $seq_vector);

    unless( $id_vectorsite ){
        die "   Could not get ID_VECTORSITE for '$seq_vector SmaI'";
    }

    my $id_ligbatch =
        $dbh->fetch_scalar(qq[select seq_LIGBATCH.nextval from dual]);

    $dbh->do(qq[
                insert into LIGATION_BATCH
                       (ID_LIGBATCH, SEQ_VECTOR)
                values ($id_ligbatch, $id_vectorsite) ]);

    # FRAGMENTION_BAND
    my $id_fragband = $dbh->fetch_scalar(qq[
                                            select SEQ_FRAGBAND.nextval
                                            from   dual]);


    my $user = $dbh->fetch_scalar(qq[ select user from dual ]);
    my $id_frag = 1931;
    $id_frag    =  367 if $user eq 'DEV1';

    $dbh->do(qq[
                insert into FRAGMENTATION_BAND
                values ($id_fragband,
                        $id_frag,
                        $from,
                        $to,
                        $fragmentBox)]);

    # LIGATION
    $dbh->do(qq[
                insert into LIGATION
                       (ID_LIGATION,
                        ID_FRAGBAND,
                        ID_LIGBATCH,
                        VOLUME,
                        POSITIVE,
                        NEGATIVE,
                        CLONENAME,
                        COMMENTS)
                values ($lig_num, $id_fragband, $id_ligbatch, $volume,
                        $positive, $negative, '$clone',
                        '')
                ]);

    # LIGATION_STATUS - give it a status of passed so it will not appear in
    # lemur
    my $user = getpwuid($<);

    $dbh->do(qq[
                insert into LIGATION_STATUS
                values ($lig_num,
                        5,
                        SYSDATE,
                        1,
                        0,
                        'Kill_Equus',
                        '$user')]);
}

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

    return $dbh->fetch_scalar(qq[select count(*)
                                 from   LIGATION
                                 where  ID_LIGATION = $ligation]);
}

sub plate_exists_in_oracle {
    my ($dbh, $plate_name) = @_;

    return $dbh->fetch_scalar(qq[ select ID_BECKMANBOX from BECKMAN_BOX
                                  where  NAME = '$plate_name' ]);
}

# give it a plate name and it will attempt to return id_beckmanbox
sub oracle_get_id_beckmanbox {
    my ($dbh, $plate_name) = @_;

    return $dbh->fetch_scalar(qq[select ID_BECKMANBOX
                                 from   BECKMAN_BOX
                                 where  NAME = '$plate_name']);
}

# return true if information is the same
sub make_ligations_the_same {
    my ($equus_db, $dbh, $ligation) = @_;

    # Get the same details from Equus & Oracle for $ligation

    my ($e_clone,    $e_vector,
        $e_min_size, $e_max_size,
        $e_volume,
        $e_blue,  $e_clear, 
        $e_fragmentBox, $e_remark) =
            Kill_Equus::equus_get_ligation_info($equus_db, $ligation);

    print "EQUUS
        $e_clone,    $e_vector,
        $e_min_size, $e_max_size,
        $e_volume,
        $e_blue,  $e_clear, 
        $e_fragmentBox, $e_remark\n" if $debug;

    my ($o_clone,    $o_vector,
        $o_min_size, $o_max_size,
        $o_volume,
        $o_blue,  $o_clear, 
        $o_fragmentBox, $o_remark) =
            Kill_Equus::oracle_get_ligation_info($dbh, $ligation);

    print "ORACLE
        $o_clone,    $o_vector,
        $o_min_size, $o_max_size,
        $o_volume,
        $o_blue,  $o_clear, 
        $o_fragmentBox, $o_remark\n" if $debug;

    # Compare the details stored for the same ligation
    # Mail somebody if clone, vector or frag size differs.
    # Update blue, clear, volume & vector (id_ligbatch) if they have zero
    # as a value - they were prolly created by ligadd

    my $update_ligation = undef; # used for set ID_LIGBATCH = 234, VOLUME = 1...

    if( $e_clone ne $o_clone ){
        Mail::sendMail( -to      => "$bug_mail",
                        -subject => "Ligation $ligation: clone names differ", 
                        -message => "Ligation    : $ligation\n".
                                    "Oracle clone: $o_clone\n".
                                    "Equus clone : $e_clone\n");
    }

    if( ($e_min_size != $o_min_size) || ($e_max_size != $o_max_size) ){

        if( $o_min_size eq '0' &&  $o_max_size eq '0' ){
            my $id_fragband = &get_id_fragband_for_lig($dbh,
                                                       $e_min_size,
                                                       $e_max_size,
                                                       $e_fragmentBox);

            my $nextline = '';
            $nextline = ", " if $update_ligation;

            $update_ligation .= "$nextline ID_FRAGBAND = $id_fragband";
            
        }
        else {
           Mail::sendMail(-to      => "$bug_mail",
                          -subject => "Ligation $ligation: size differs", 
                          -message => "Ligation    : $ligation\n".
                          "Oracle clone: $o_min_size - $o_max_size\n".
                          "Equus clone : $e_min_size - $e_max_size\n");
         }
    }

    # if the vector has been set in Oracle, check its the same one as equus
    if( $o_vector ){
# This mail bombed me with 2000+ emails in one night.
#        if( $e_vector ne $o_vector ){
#            Mail::sendMail( -to      => "$bug_mail",
#                            -subject => "Ligation $ligation: seq vectors ".
#                                        "differ",
#                            -message => "Ligation     : $ligation\n".
#                                        "Oracle vector: $o_vector\n".
#                                        "Equus  vector: $e_vector\n");
#        }
    }
    else{
        # No oracle vector specified, use Equus one if that is specified
        if( $e_vector ){
            my $id_ligbatch = &get_ligbatch_for_vector($dbh, $e_vector);

            my $nextline = '';
            $nextline = ", " if $update_ligation;

            $update_ligation .= "$nextline ID_LIGBATCH = $id_ligbatch";
        }
        else {
            Mail::sendMail( -to      => "$bug_mail",
                            -subject => "Ligation $ligation: vector unknown ",
                            -message => "Ligation    : $ligation\n".
                                        "No vector in Equus or oracle!");
        }
    }

    if( $o_volume == 0 && $e_volume ){
        my $nextline = '';
        $nextline = ", " if $update_ligation;

        $update_ligation .= "$nextline volume = $e_volume";
    }

    if( ($o_blue == 0 && $o_clear == 0)  && $e_blue && $e_clear){
        my $nextline = '';
        $nextline = ", " if $update_ligation;

        $update_ligation .= "$nextline negative = $e_blue, positive = $e_clear";
    }

    if( $update_ligation ){
        $dbh->do(qq[update LIGATION
                    set    $update_ligation
                    where  ID_LIGATION = $ligation ]);
    }

    # Check it has a status record, old ligadd would not have created one.
    my $status = &oracle_get_ligation_status($dbh, $ligation);

    unless( $status ){
        print "ERROR: ligation $ligation does not have a status!\n" if $debug;
        
        $dbh->do(qq[ insert into LIGATION_STATUS
                     values ($ligation,
                             5,
                             SYSDATE,
                             1,
                             0,
                             'Kill_Equus',
                             'bug') ]);

        Mail::sendMail( -to      => "$bug_mail",
                        -subject => "Ligation $ligation: Should be Passed now",
                        -message => "Ligation    : $ligation\n".
                                    "Should have added Passed status!");
    }    
}

sub equus_get_ligation_info {
    my ($equus_db, $ligation) = @_;

    my $lig_obj = $equus_db->fetch(-class  => 'Ligation',
                                   -name   => $ligation,
                                   -filled => 1);

    return undef unless( $lig_obj );

    my $clone       = $lig_obj->at("Clone[1]");
    my $vector      = $lig_obj->at("Sequencing_vector[1]");
    my $min_size    = $lig_obj->at("Size[1]");
    my $max_size    = $lig_obj->at("Size[2]");
    my $volume      = $lig_obj->at("Vol.Volume[1]");
    my $blue        = $lig_obj->at("Plaque_count.Blue[1]");
    my $clear       = $lig_obj->at("Plaque_count.Clear[1]");
    my $fragmentBox = $lig_obj->at("Fragment_box[1]");
    my $remark      = $lig_obj->at("Remark[1]");

    return ("$clone", "$vector", "$min_size", "$max_size", "$volume",
            "$blue",  "$clear",  "$fragmentBox", "$remark" );
}

# Given the ligation number it returns;
#
#    CLONENAME,       clone
#    VECTORNAME,      vector
#    SIZE_FROM_KB,    min_size
#    SIZE_TO_KB,      max_size
#    VOLUME,          volume
#    NEGATIVE,        blue
#    POSITIVE,        clear
#    FRAGMENT_BOX,    fragment_box
#    COMMENTS         remark
#
# It is done as 3 SQL statements because if done in 1 larger statement it may
# not return anything if ID_LIGBATCH or ID_FRAGBAND wasn't filled in
#
sub oracle_get_ligation_info {
    my ($dbh, $ligation) = @_;

    if( $ligation !~ /^\d*$/ ){
        die "Internal error: get_details_from_ligation not supplied number";
    }

    my ($clone, $volume,
        $blue,  $clear,
        $comments,
        $id_ligbatch, $id_fragband) =
            $dbh->fetch_row(qq[
                               select l.CLONENAME, l.VOLUME,
                                      l.NEGATIVE, l.POSITIVE, l.COMMENTS,
                                      l.ID_LIGBATCH, l.ID_FRAGBAND
                               from   LIGATION l
                               where  l.ID_LIGATION = $ligation ]);

    my ($vector, $min_size, $max_size, $fragmentBox);

    if( $id_fragband ){
        ($min_size,
         $max_size,
         $fragmentBox) = $dbh->fetch_row(qq[select SIZE_FROM_KB, SIZE_TO_KB,
                                                   FRAGMENT_BOX
                                            from   FRAGMENTATION_BAND
                                            where  ID_FRAGBAND = $id_fragband]);
    }
    else {
        ($min_size,
         $max_size,
         $fragmentBox) = (0,0,'');
    }

    if( $id_ligbatch ){
        $vector =
            $dbh->fetch_scalar(qq[ select vs.VECTORNAME
                                   from   VECTORSITE vs, LIGATION_BATCH lb
                                   where  lb.ID_LIGBATCH = $id_ligbatch
                                   and    lb.SEQ_VECTOR  = vs.ID_VECTORSITE
                                   ]);
    }
    else {
        $vector = '';
    }

    return ($clone,
            $vector,
            $min_size,
            $max_size,
            $volume,
            $blue,
            $clear,
            $fragmentBox,
            $comments);
}

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

    if( $ligation !~ /^\d*$/ ){
        die "Internal error: get_details_from_ligation not supplied number";
    }

    return  $dbh->fetch_scalar(qq[ select STATUS
                                   from   LIGATION_STATUS
                                   where  ID_LIGATION = $ligation
                                   and    ISCURRENT   = 1 ]);
}


# creates link table for ligation -> vectorsite
#
sub get_ligbatch_for_vector {
    my ($dbh, $vector) = @_;

    my $id_vectorsite = &get_id_vectorsite_for_vector($dbh, $vector);

    unless( $id_vectorsite ){
        die "   Could not get ID_VECTORSITE for '$vector SmaI'";
    }

    my $id_ligbatch   = $dbh->fetch_scalar(qq[select seq_LIGBATCH.nextval
                                              from   dual ]);

    $dbh->do(qq[ insert into LIGATION_BATCH
                 values ($id_ligbatch, $id_vectorsite) ]);

    return $id_ligbatch;
}

# for a given vector returns a valid id_vecotrsite.
# Default enzyme used is SmaI, tries NONE after that.
#
sub get_id_vectorsite_for_vector {
    my ($dbh, $vector) = @_;

    print "get_id_vectorsite_for_vector(): looking up $vector\n" if $debug;

    # get round the fact 'M13' used as a generic name for m13mp18
    if( $vector eq 'M13' || $vector eq 'm13' ){
        print "Selecting vector m13mp18 (was $vector)\n";
        $vector = 'm13mp18';
    }

    my $sth = $dbh->prepare(q[select vs.ID_VECTORSITE
                              from   VECTORSITE vs, VECTORSITE_ENZYME vse
                              where  vs.VECTORNAME    = ?
                              and    vs.ID_VECTORSITE = vse.ID_VECTORSITE
                              and    vse.ENZYMENAME   = ? ]);

    my $id_vectorsite;

    $sth->execute($vector, 'SmaI');
    ($id_vectorsite) = $sth->fetchrow_array();

    unless( $id_vectorsite ){
        $sth->execute($vector, 'NONE');
        ($id_vectorsite) = $sth->fetchrow_array();
    }

    return $id_vectorsite;
}

# Unlike the other functions in this module, equus_get_plate_info() does
# not die if the plate object can not be returned form Equus. It will just
# output a warning and return nothing.
#
sub equus_get_plate_info {
    my ($equus_db, $plate_name) = @_;

    my $plate_obj = $equus_db->fetch(-class  => 'Plate',
                                     -name   => $plate_name,
                                     -filled => 1);
    unless($plate_obj ){
        print STDERR "No plate called '$plate_name' found in Equus\n";
        return ();
    }

    my $team         = $plate_obj->at("Team[1]");
    my $prep_date    = $plate_obj->at("Prep.Prep_date[1]");
    my $prep_comment = $plate_obj->at("Prep.Prep_comment[1]");
    my $sequencer    = $plate_obj->at("Seq[1].Sequencer[1]");
    my $seq_date     = $plate_obj->at("Seq[1].Seq_date[1]");
    my $seq_comments = $plate_obj->at("Seq[1].Seq_comments[1]");

    return "$team", "$prep_date", "$prep_comment",
           "$sequencer", "$seq_date", "$seq_comments";
}

# From the given plate name try to create the records Platetrack would have.
# The goal is to link up the created records to LOADINGSAMPLE which should
# exist.
#
# Assumes 96 well Beckman boxes & DNAplates. This is old info after all.
#
sub add_bb_box_info_to_oracle {
    my ($equus_db, $dbh, $plate_name, $ligation, $force_dnaplate) = @_;

    # get info for plate and check it is valid.

    my ($team,
        $prep_date,
        $prep_comment,
        $sequencer,
        $seq_date,
        $seq_comments) = Kill_Equus::equus_get_plate_info($equus_db,
                                                          $plate_name);

    if( $debug ){
        print "The team who created the plate was $team\n";
        print "    prepped  on $prep_date\n";
        print "    prep comm   $prep_comment\n";
        print "    seq      on $seq_date\n";
        print "    by          $sequencer\n";
        print "    seq comment $seq_comments\n";
    }

    $team      = 71 if( $team !~ /^\d+/ ); # informatics does everything...

    $prep_date = &get_sql_format_date_for($prep_date);
    # $seq_date  = &get_sql_format_date_for($seq_date);

    if( $debug ){
        print "prep_date = $prep_date\n";
        # print "seq_date  = $seq_date\n\n";
    }

    # create _96_ SUBCLONE records
    my @id_subclones;
    my $sth_insert_sc
	= $dbh->prepare(q[insert into SUBCLONE (ID_SUBCLONE, ID_LIGATION)
			  values (?, ?)]);


    foreach my $x (1..96){

        my $id_subclone =
            $dbh->fetch_scalar(qq[select seq_subclone.nextval from dual]);

#        $dbh->do(qq[ insert into SUBCLONE values ($id_subclone, $ligation) ]);
        $sth_insert_sc->execute($id_subclone, $ligation);

        push @id_subclones, $id_subclone; # will be 0 - 95
    }

    print "Created SUBCLONES\n" if $debug;

    # create 1  BECKMAN_BOX & 2 BB_STATUS (1 for create, 3 for prepped)

    my $id_beckmanbox = $dbh->fetch_scalar(qq[SELECT seq_beckmanbox.nextval
                                              FROM   dual ]);



#    $dbh->do(qq[ insert into BECKMAN_BOX
#                 values ($id_beckmanbox, 96, '$plate_name', 1, $team, '')]);

    my $sth_insert_bb
	= $dbh->prepare(q[insert into BECKMAN_BOX (ID_BECKMANBOX, FORMAT,
						   NAME, IS_ORIGINAL,
						   TEAM, WAS_CALLED)
			  values (?, 96, ?, 1, ?, '')]);

    $sth_insert_bb->execute($id_beckmanbox, $plate_name, $team);

#    $dbh->do(qq[ insert into BB_STATUS
#                 values ($id_beckmanbox, 1, $prep_date, 0, 0,
#                         'Kill_Equus', '','')]);
#    $dbh->do(qq[ insert into BB_STATUS
#                 values ($id_beckmanbox, 3, $prep_date, 1, 0,
#                         'Kill_Equus', '','Created by Kill_Equus')]);
    

    my $sth_insert_bb_status
	= $dbh->prepare(q[insert into BB_STATUS (ID_BECKMANBOX, STATUS,
						 STATUSDATE, ISCURRENT,
						 SESSIONID, PROGRAM,
						 OPERATOR, REMARK)
			  values (?, ?, to_date(?,'yyyy/mm/dd'), 
				  ?, 0, 'Kill_Equus', '','')]);
    
    $sth_insert_bb_status->execute($id_beckmanbox, 1, $prep_date, 0);
    $sth_insert_bb_status->execute($id_beckmanbox, 3, $prep_date, 1);

    print "Created BECKMAN_BOX & BB_STATUS\n" if $debug;

    # create 96 BB_MAP entries & match them up to the 96 subclone entries
    my @id_bb_maps;
    my $sth_insert_bb_map
	= $dbh->prepare(q[insert into BB_MAP (ID_BBMAP, ID_SUBCLONE,
					      ID_BECKMANBOX, ID_MAP)
			  values (?, ?, ?, ?)]);

    foreach my $id_map (1..96){
        my $id_bbmap =
            $dbh->fetch_scalar(qq[ select seq_bbmap.nextval from dual ]);

#        $dbh->do(qq[ insert into BB_MAP
#                     values ($id_bbmap, $id_subclones[$id_map - 1],
#                             $id_beckmanbox, $id_map) ]);

        $sth_insert_bb_map->execute($id_bbmap, $id_subclones[$id_map - 1],
                                    $id_beckmanbox, $id_map);

        push @id_bb_maps, $id_bbmap; # will be 0 - 95
    }

    print "created 96 BB_MAP entries\n" if $debug;

    # Before creating DNA_PLATE, make sure there are loadingsample records
    # to link up to otherwise there is no point.
    # loading plate should have the same name as the beckman box

#    my $ls_ref =
#        $dbh->fetch_all(qq[ select ls.ID_LOADINGSAMPLE, ls.ID_MAP
#                            from   LOADINGPLATE lp, LOADINGSAMPLE ls
#                            where  lp.PLATENAME       = '$plate_name'
#                            and    lp.ID_LOADINGPLATE = ls.ID_LOADINGPLATE
#                            order by ls.ID_LOADINGPLATE, ls.ID_MAP ]);

    my $sth_samples_for_plate =
        $dbh->prepare(q[select ls.ID_LOADINGSAMPLE, ls.ID_MAP
                        from   LOADINGPLATE lp, LOADINGSAMPLE ls
                        where  lp.PLATENAME       = ?
                        and    lp.ID_LOADINGPLATE = ls.ID_LOADINGPLATE
                        order by ls.ID_LOADINGPLATE, ls.ID_MAP]);

    $sth_samples_for_plate->execute($plate_name);
    my $ls_ref = $sth_samples_for_plate->fetchall_arrayref();

    #  if zero or more than 192 records, email bug to sort it out.
    my $num_samples = scalar @{$ls_ref};

    if( $num_samples == 0 ){
        print "$num_samples samples found for plate $plate_name\n" if $debug;

        unless( $force_dnaplate ){
            return;
        }
    }

    # Create DNA_PLATE, DNAPLATE_STATUS & 96 DNAPLATE_MAP entries linked
    # back to the BB_MAP records we just created

    my $id_dnaplate = $dbh->fetch_scalar(qq[ select seq_DNAPLATE.nextval
                                             from   dual ]);

    # $team is got from Equus - could be bag of sh*!^ - put in check above

#    $dbh->do(qq[ insert into DNA_PLATE
#                 values ($id_dnaplate, 96, '', 1, $team) ]);

#    $dbh->do(qq[ insert into DNAPLATE_STATUS
#                 values ($id_dnaplate, 1, $prep_date, 1, 0,  'Kill_Equus', '',
#                         'Created by Kill_Equus') ]);

    my $sth_insert_dp
	= $dbh->prepare(q[insert into DNA_PLATE (ID_DNAPLATE, FORMAT,
						 PREP_TYPE, COPY_TYPE,
						 TEAM)
			  values (?, 96, '', 1, ?)]);

    my $sth_insert_dps
	= $dbh->prepare(q[insert into DNAPLATE_STATUS (ID_DNAPLATE, STATUS,
						       STATUSDATE, ISCURRENT,
						       SESSIONID, PROGRAM,
						       OPERATOR, REMARK)
			  values (?, 1, to_date(?, 'yyyy/mm/dd'),
				  1, 0, 'Kill_Equus', '',
				  'Created by Kill_Equus')]);

    $sth_insert_dp->execute($id_dnaplate, $team);
    $sth_insert_dps->execute($id_dnaplate, $prep_date);

    print "Created DNA_PLATE & DNAPLATE_STATUS records\n" if $debug;

    # create 96 DNAPLATE_MAP records

    my %id_dnaplate_maps;
    my $sth_dpm_nextval = $dbh->prepare(q[select seq_DNAPLATEMAP.nextval
                                          from   dual]);
    my $sth_insert_dpm
	= $dbh->prepare(q[insert into DNAPLATE_MAP (ID_DNAPLATEMAP, ID_BBMAP,
						    ID_DNAPLATE, ID_MAP)
			  values (?, ?, ?, ?)]);

    foreach my $id_map (1..96){
#        my $id_dnaplatemap =
#            $dbh->fetch_scalar(qq[ select seq_DNAPLATEMAP.nextval
#                                   from   dual ]);
#        $dbh->do(qq[ insert into DNAPLATE_MAP
#                     values ($id_dnaplatemap, $id_bb_maps[$id_map - 1],
#                             $id_dnaplate, $id_map) ]);
        $sth_dpm_nextval->execute();
        my ($id_dnaplatemap) = $sth_dpm_nextval->fetchrow_array();

        $sth_insert_dpm->execute($id_dnaplatemap, $id_bb_maps[$id_map - 1],
                                 $id_dnaplate, $id_map);

        $id_dnaplate_maps{$id_map} = $id_dnaplatemap;
    }

    print "Inserted 96 DNAPLATE_MAP records\n" if $debug;


    # If it got to here & $num_samples = 0, $force_dnaplate has been set.
    #
    return $id_dnaplate if $num_samples == 0;


    # loop for each loading sample, check it doesn't already have a
    # ID_DNAPLATEMAP. If it doesn't, set each record to the 96 we've just
    # created

    my $sth_update_ls = $dbh->prepare(q[update LOADINGSAMPLE
                                        set    ID_DNAPLATEMAP   = ?
                                        where  ID_LOADINGSAMPLE = ?]);

    foreach my $row (@{$ls_ref}){

        my $id_loadingsample = $row->[0];
        my $ls_id_map        = $row->[1];
        my $id_dnaplatemap   = $id_dnaplate_maps{$ls_id_map};

print "id_loadingsample: $id_loadingsample, ls map: $ls_id_map, dpm map: $id_dnaplatemap\n" if $debug;

#        $dbh->do(qq[ update LOADINGSAMPLE
#                     set    ID_DNAPLATEMAP   = $id_dnaplatemap 
#                     where  ID_LOADINGSAMPLE = $id_loadingsample ]);

        $sth_update_ls->execute($id_dnaplatemap, $id_loadingsample);
    }

    print "All records created (probly).\n" if $debug;
    return $id_dnaplate;
}

# attempts to turn a date in Equus into one that can be put straight into
# an SQL statement.
#
sub get_sql_format_date_for {
    my ($date, $for_a_prepare) = @_;

    # try 2000-12-03
    if( $date !~ /^(\d{4,})-(\d{2})-(\d{2})/ ){

        # try 2000/12/03
        if( $date !~ /^(\d{4,})\/(\d{2})\/(\d{2})/ ){

            # give up
            my @localtime = localtime();

            my $year  = $localtime[5] + 1900;
            my $month = $localtime[4] + 1;
            my $day   = $localtime[3];

            $month    = '0'.$month if $month < 10;

            $date     = $year."/".$month."/".$day;

        }
        else {
            $date = "$1/$2/$3";
        }
    }
    else {
        $date = "$1/$2/$3";
    }

    return $date;
}

# id_frag is hard coded to 1931 - this is a fake FRAGMENTATION record for
# the purposes of Kill_Equus
#
sub get_id_fragband_for_lig {
    my ($dbh, $from, $to, $fragment_box) = @_;

    $fragment_box = "''" unless $fragment_box;

    my $id_fragband = $dbh->fetch_scalar(qq[
                                            select SEQ_FRAGBAND.nextval
                                            from   dual]);

    $dbh->do(qq[
                insert into FRAGMENTATION_BAND
                values ($id_fragband,
                        1931,
                        $from,
                        $to,
                        $fragment_box) ]);

    return $id_fragband;
}

# A clone may not come from a library. If it is a whole chromosome shotgun
# there may not be a cloning vector. In Equus the cloning vector will be set to
# NONE. This does a similar thing for Oracle...
#
# returns library name if succesful
#
sub fix_clones_vector_info {
    my ($dbh, $clone_name) = @_;


    # see if already defined in Oracle
    my ($species, $library_name) =
        $dbh->fetch_row(qq[ select SPECIESNAME, LIBRARYNAME from CLONE
                            where  CLONENAME = '$clone_name' ]);

    if( defined $library_name && $library_name ne '' ){
        print "Clone $clone_name is in library $library_name\n" if $debug;
        return $library_name; # everything is OK - why was this routine called?
    }


    # see what equus has to say about cloning vector - it should be 'NONE'
    my ($EDI, $equus_db) = &openEquus('lemur');
    print "got Equus connection\n" if $debug;

    my ($cloning_vector, $clone_seq_file) =
        &equus_get_clone_vector_info($equus_db, $clone_name);

    print "clone: $clone_name, cloning_vector: $cloning_vector, ".
          "clone_seq_file: $clone_seq_file\n" if $debug;

    unless( defined $cloning_vector && defined $clone_seq_file &&
            $cloning_vector ne ''   && $clone_seq_file ne ''     ){
        return undef;
    }


    # Update clone to show Libray it came from - probably 'NONE'
    if( $cloning_vector eq 'NONE' ){
        $dbh->do(qq[ update CLONE set LIBRARYNAME = 'NONE'
                     where  CLONENAME   = '$clone_name' ]);

        print "updated clone $clone_name so points at libray NONE\n" if $debug;

        return $library_name;
    }
}

# for a given clone, return the cloning vector and staden file of the vector
#
sub equus_get_clone_vector_info {
    my ($equus_db, $clone_name) = @_;

    my $clone_obj = $equus_db->fetch(-class  => 'Clone',
                                     -name   => $clone_name,
                                     -filled => 1);

    my $clone_vector = $clone_obj->at("Cloning_vector[1]");


    print "Equus Cloning_vector = $clone_vector\n" if $debug;


    if( $clone_vector eq 'NONE' ){
        return ('NONE', 'NONE');
    }

    my $vector_obj = $equus_db->fetch(-class  => 'Vector',
                                      -name   => $clone_vector,
                                      -filled => 1);
    
    my $staden_file = $clone_obj->at("Staden_file");

    return ("$clone_vector","$staden_file");
}

#
# I can't remember when or what uses this but it looks like it was a once off
# routine to put vectors from Equus into Oracle.
#
sub equus_get_all_vectors {
    my ($equus_db, $dbh) = @_;

    # Get vectors from Equus
    my @vectors = $equus_db->fetch(-class  => 'Vector',
                                   -name   => '*',
                                   -filled => 1);
    print Data::Dumper::Dumper(\@vectors);

    unless( @vectors ){
        die "ERROR: no vector found in Equus!";
    }

    #
    # For each vector, see if its name is in Oracle
    # and build a list of missing vectors into a to_do list
    #
    my $sth_v  = $dbh->prepare(q[SELECT vectorname
                                 FROM   vector
                                 WHERE  vectorname = ? ]);

    my $sth_vs = $dbh->prepare(q[SELECT id_vectorsite
                                 FROM   vectorsite
                                 WHERE  vectorname = ? ]);
    my %to_do;

    foreach my $vector (@vectors){
        print "Vector name: $vector\n";

        $sth_v->execute("$vector");
        $sth_vs->execute("$vector");

        my ($o_vector)     = $sth_v->fetchrow_array();
        my ($o_vectorsite) = $sth_vs->fetchrow_array();

        print "   Oracle vector: $o_vector, ID_VECTORSITE: $o_vectorsite\n";

        unless( $o_vector && $o_vectorsite ){
            # One of them _might_ be set (EDIT: oh no there isn't!)
            $to_do{$vector} = [$o_vector, $o_vectorsite];
        }

        $sth_v->finish();
        $sth_vs->finish();
    }

    print "\n\nTo Add Into Oracle\n\n";

    my $sth_insert_v  = $dbh->prepare(q[INSERT INTO vector
                                               (vectorname, vectortype)
                                        VALUES (?, ?) ]);

    my $sth_insert_vs = $dbh->prepare(q[INSERT INTO vectorsite
                                               (ID_VECTORSITE, VECTORNAME,
                                                STADENFILE, FASTAFILE,
                                                FORWARDCLONINGSITE,
                                               FORWARDPRIMERSITE, REVPRIMERSITE)
                                        VALUES (seq_vectorsite.nextval,
                                                ?, ?, ?, ?, ?, ?) ]);
    #
    # Add the missing vectors in
    #
    foreach my $vector (sort keys %to_do){
        print "$vector \t\t ", join(", ", @{$to_do{$vector}}), "\n";

        # yes, looping for each vector is bad - sue me!
        foreach my $vector_obj (@vectors){
            if( "$vector_obj" eq $vector ){
                # print Data::Dumper::Dumper($vector_obj);

                my $e_staden = $vector_obj->at("Staden_file[1]") || 'NULL';
                my $e_fasta  = $vector_obj->at("Fasta_file[1]")  || 'NULL';
                my $e_c_site = $vector_obj->at("Clone_site[1]")  || 'NULL';
                my $e_fwd    =
                    $vector_obj->at("Forward_primer_site[1]")  || 'NULL';
                my $e_rev    =
                    $vector_obj->at("Reverse_primer_site[1]")  || 'NULL';

                print "$e_staden, $e_fasta, $e_c_site, $e_fwd, $e_rev\n";

print "
      INSERT INTO vector
             (vectorname, vectortype)
      VALUES ($vector, 10)
";

                $sth_insert_v->execute($vector, 10); # type of NONE...

print "
       INSERT INTO vectorsite
              (ID_VECTORSITE, VECTORNAME,
               STADENFILE, FASTAFILE,
               FORWARDCLONINGSITE,
               FORWARDPRIMERSITE, REVPRIMERSITE)
       VALUES (seq_vectorsite.nextval,
                                    '$vector',
                                    '$e_staden', '$e_fasta',
                                    '$e_c_site',
                                    '$e_fwd', '$e_rev')
";
        if( 0 ){
                $sth_insert_vs->execute("$vector",
                                        "$e_staden", "$e_fasta",
                                        "$e_c_site",
                                        "$e_fwd", "$e_rev");
        }                                
                $dbh->do(qq[INSERT INTO vectorsite
                                   (ID_VECTORSITE, VECTORNAME,
                                    STADENFILE, FASTAFILE,
                                    FORWARDCLONINGSITE,
                                    FORWARDPRIMERSITE, REVPRIMERSITE)
                            VALUES (seq_vectorsite.nextval,
                                    '$vector',
                                    '$e_staden', '$e_fasta',
                                    $e_c_site,
                                    $e_fwd, $e_rev) ]);

                last;
            }
        }
    }

#    $dbh->rollback();
}

# END OF MODULE
1;

# $Log: Kill_Equus.pm,v $
# Revision 1.23  2003/07/30  10:09:44  rmd
# Added column names to SQL insert statements in add_bb_box_info_to_oracle.
#
# Revision 1.22  2001/06/04  09:27:52  pjm
# if vector is M13 or m13 it alteres it to m13mp18, which Oracle recognises.
#
# Revision 1.21  2001/03/29  10:11:59  pjm
# Emails bug instead of pjm with any warning or errors.
# Commented equus_get_all_vectors() - I guess it was a one off routine but
# I have left it in as an example.
#
# Revision 1.20  2000/11/01  13:08:18  pjm
# added sub equus_get_plates_for_ligation(). It is used by request_dna_plates -
# it loops over each ligation for a project and calls this function. This
# sub will return a hash of "platename => Team".
#
# Revision 1.19  2000/10/17  13:43:03  pjm
# get_id_vectorsite_for_vector() modified. Preppares the SQL, if it can't
# find a vector wi enzyme SmaI it tries NONE.
#
# Revision 1.18  2000/10/12  08:10:08  pjm
# Stopped it mail bombing me if seq vectors are different between Oracle
# and Equus. Ligation: 17352, Oracle: lambda, Equus: lambda_ZAP_II_EcoRI
#
# Revision 1.17  2000/09/20  09:07:16  pjm
# creating 96 subclones, 96 bb_maps, 96 dna_plates and updating 96 loadingsamples
# was not done using a prepare. This should help the shared pool slightly :)
#
# Revision 1.16  2000/07/06  12:36:37  pjm
# now gives getpwuid($<) as operator in LIGATION_STATUS, not pjm
#
# Revision 1.15  2000/07/04  13:51:20  pjm
# added (ID_LIGBATCH, SEQ_VECTOR) for LIGATION_BATCH
# made it force creation of DNA_PLATES
#
# Revision 1.14  2000/05/10  15:27:16  pjm
# added extra arg when EquusDatabaseInterface->new() executed so no Tk interface
#
# Revision 1.13  2000/03/27  15:43:19  pjm
# added comma to mail subject line for vector warning
# now adds a ligation_status record if one not present - ligadd did not
# create one.
#
# Revision 1.12  2000/03/27  08:52:46  pjm
# Added subs(): equus_get_ligs_for_clone() try_add_ligations_for_clone()
# if dev1 user now uses a different ID_FRAG value of 546
#
# Revision 1.11  2000/03/01  16:49:14  pjm
# added check: if no ligaton found for a plate - plate probably not in Equus
#
# Revision 1.10  2000/03/01  16:14:06  pjm
# added 3 subs: oracle_get_ligation_from_plate(), fix_clones_vector_info() &
# equus_get_clone_vector_info().
# Added some use statements - if not called by oracle_lookup it didn't work.
#
# Revision 1.9  2000/02/24  17:43:12  pjm
# Now 2 subs for adding a ligation, 1 when we know the platename and 1 for
# when we already know the ligation number.
#
# Revision 1.8  2000/02/24  16:48:16  pjm
# added all the subroutines that were in add_plate_to_oracle_from_equus
# so could create other programs to use them (like adding a ligation, not a
# plate)
#
# Revision 1.7  2000/02/22  13:03:16  pjm
# added sub clone_exists_in_oracle()
#
# Revision 1.6  2000/02/22  12:15:26  pjm
# added check to make sure id_vectorsite is returned for a given vector.
#
# Revision 1.5  2000/02/17  18:28:45  pjm
# BB_STATUS was being set to 2 (cancelled), now set to 3 (prepped).
#
# Revision 1.4  2000/02/17  10:54:02  pjm
# took out message to bad_stuff.log so would not be warned of no loading plate
# with the same name (& loadingsamples).
#
# Revision 1.3  2000/02/16  16:36:14  pjm
# for status records, program = 'Kill_Equus', for remark =
# 'Created by Kill_Equus'
#
# Revision 1.2  2000/02/16  13:39:49  pjm
# instead of emailing pjm it adds stuff to bad_stuff.log
#
# Revision 1.1  2000/02/16  11:43:12  pjm
# Initial revision
#
