#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
#
# Author: pjm
# Description;
# 
# Allows a subcloner to enter a DNA prep into the system. Normally this
# would happen in Dodo but preps can come from external sources.
# Pathogens need to do this a lot.
#
# $Id: LemurEnterPrep.pm,v 1.10 2003/11/20 12:40:43 mdf Exp $
#

package LemurEnterPrep;

require Exporter;

use     strict;
use     WrapDBI;
use     Mail;
use     Tk;
require NewBrowseEntry;

use Data::Dumper;

my $debug = 0;

sub new {
    my ($type,
        $parentWindow,
        $db_user,
        $session_id,
        $mode)        = @_;

    my $realUserName = getpwuid($<);

    my $self = {
        db_user      => $db_user,
        session_id   => $session_id,
        realUserName => $realUserName,
        mode         => $mode
    };
    bless($self, $type);


    $self->setupHashTables;
    $self->createWindow($parentWindow);


    return $self;
}

sub setupHashTables {
    my ($self) = @_;
    my $dbh;

    eval {
        $dbh         = WrapDBI->connect($self->{db_user}, {RaiseError => 1});
        $self->{dbh} = $dbh;

        if( !defined $dbh ) {
            $self->{dbh} = '';
            $self->expire("Could not connect to database") ;
        }

        $dbh->{AutoCommit} = 0;

        $self->{session_id} =
            $dbh->fetch_scalar(qq[ select SEQ_SESSION.NEXTVAL from dual ]);

        $self->get_prep_types        ($dbh);
        $self->get_band_quality_types($dbh);
        $self->get_organisms         ($dbh);
        $self->get_user_id           ($dbh);
    };

    if ($@) {
        $dbh->disconnect() if $dbh;
        if( $@ =~ /You are logged in as/ ){
            LemurUtils->expire("$@\n");
        }
        else {
            LemurUtils->expire("$@");
        }
    }
}

sub get_prep_types {
    my ($self, $dbh) = @_;

    my $array_array = $dbh->fetch_all(qq[
                                         select ID_DICT,  DESCRIPTION
                                         from   DNAPREPTYPEDICT 
                                         order by ID_DICT
                                         ]);

    foreach my $array_ref (@{$array_array}){
        $self->{prep_types_hash}->{$array_ref->[1]} = $array_ref->[0];

        push @{$self->{prep_types}}, $array_ref->[1];
    }
}

# Stores BANDQUALITYDICT in an array sorted by ID_DICT for diplaying this to the
# user and a hash look up.
##
sub get_band_quality_types {
    my ($self, $dbh) = @_;

    my $array_array = $dbh->fetch_all(qq[
                                         select ID_DICT,  DESCRIPTION
                                         from   BANDQUALITYDICT
                                         order by ID_DICT
                                         ]);

    foreach my $array_ref (@{$array_array}){

        $self->{band_quality_hash}->{$array_ref->[1]} = $array_ref->[0];

        push @{$self->{band_qualities}}, $array_ref->[1];
    }
}

# creates simple list of all species available
#
sub get_organisms {
    my ($self, $dbh) = @_;

    my $array_array = $dbh->fetch_all(qq[select SPECIESNAME from SPECIES ]);

    foreach my $array_ref (@{$array_array}){
        push @{$self->{organisms}}, $array_ref->[0];
    }
}

sub get_user_id {
    my ($self, $dbh) = @_;

    my $email_addr = getpwuid($<);

    if( $self->{db_user} eq 'dev1' ){ # FOR DEBUGGING ONLY!!!
        $self->{id_role} = 10000;
        return;
    }

    $self->{id_role} =
        LemurUtils->get_team_person_role_id_role_for($dbh, $email_addr);

    unless( $self->{id_role} ){
        die "\nYou are logged in as '$email_addr'. No entry ".
            "can be found for you as a subcloner in the ".
            "database. Contact bug if this should not be ".
            "the case.\n\n\n";
    }
}

sub createWindow {
    my ($self, $parentWindow) = @_;

    $self->{mw} = $parentWindow->Toplevel();
    my $mw = $self->{mw};

    my $b = 
	$mw->Button(-font        => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		    -text        => "Enter a New External Prep",
		    -height      => 1,
		    -bg          => 'white',
		    -relief      => 'groove',
		    -borderwidth => '3',
		    )->pack(-side => 'top');

    $b->bindtags(['EggButton',$b->toplevel,'all']);
    $b->bind('EggButton', '<Control-Button-2>', sub{ 
	warn "\$debug was $debug, setting to 1\n";
	$debug = 1;
    });


    $self->{mw}->Label()->pack;

    my $grid = $mw->Frame();
    my $row  = 1;

    $grid->Label(-text   => 'Organism',
                 -width  => 15,
                 -anchor => 'w')->grid(-row => $row, -column => 0);

    $grid->BrowseEntry(-width     => 20,
                       -relief    => 'sunken',
                       -variable  => \$self->{organism_choosen},
                       -choices   => $self->{organisms},
                       -state     => 'readonly',
                       -browsecmd => sub {
                           shift;
                           $self->get_clones_for(shift);
                       },
                       )->grid(-row => $row, -column => 1);

    # CLONE
    ++$row;

    $grid->Label(-text   => 'Clone',
                 -width  => 15,
                 -anchor => 'w')->grid(-row => $row, -column => 0);

    $self->{clone_widget} =
        $grid->BrowseEntry(-width     => 20,
                           -relief    => 'sunken',
                           -variable  => \$self->{clone_choosen},
                           -browsecmd => sub {
                               shift;
                               my $clone = shift;
                               $self->{chromo} = 
                                   $self->{clone_hash}->{$clone}->{chromo};
                               $self->{organism_choosen} =
                                   $self->{clone_hash}->{$clone}->{organism};
                               $self->{picked} = 1;

                               $self->set_prep_numbers();
                           },
                           )->grid(-row => $row, -column => 1);

    my $subby = sub {
	LemurUtils->setWait([$self->{mw}]);

	$self->{picked} = 0;
	$self->search_for_clone_name($self->{clone_choosen});

        LemurUtils->unSetWait([$self->{mw}]);
    };

    $self->{clone_widget}->bind('<KeyPress-Return>', $subby);
    $self->{clone_widget}->bind('<KeyPress-Tab>', sub {
	$self->{picked} = 0;
	$self->search_for_clone_name($self->{clone_choosen});
    });
      



    ++$row;

    $grid->Label(-width        => 20,
                 -textvariable => \$self->{chromo},
                 -anchor       => 'w',
                 )->grid(-row => $row, -column => 1);    

    ++$row;

    $grid->Label(-text   => 'Prep Number',
                 -width  => 15,
                 -anchor => 'w')->grid(-row => $row, -column => 0);

    $self->{prep_numbers_widget} =
        $grid->BrowseEntry(-width     => 20,
                           -relief    => 'sunken',
                           -variable  => \$self->{prep_number},
                           -state     => 'readonly',
                           -choices   => [1,2,3,4,5,6,7,8,9,10,11,12],
                           )->grid(-row => $row, -column => 1);
    ++$row;

    $grid->Label(-text   => 'Prep Type',
                 -width  => 15,
                 -anchor => 'w')->grid(-row => $row, -column => 0);


    $grid->BrowseEntry(-width     => 20,
                       -relief    => 'sunken',
                       -variable  => \$self->{prep_type},
                       -state     => 'readonly',
                       -choices   => $self->{prep_types},
                       )->grid(-row => $row, -column => 1);
    ++$row;
 
    $grid->Label(-text   => 'Band Quality',
                 -width  => 15,
                 -anchor => 'w')->grid(-row => $row, -column => 0);

    $grid->BrowseEntry(-width     => 20,
                       -relief    => 'sunken',
                       -variable  => \$self->{band_quality},
                       -state     => 'readonly',
                       -choices   => $self->{band_qualities}
                       )->grid(-row => $row, -column => 1);
    ++$row;

    $grid->Label(-text   => 'Comments',
                 -width  => 15,
                 -anchor => 'w')->grid(-row => $row, -column => 0);

    $grid->Entry(-width     => 23,
                 -relief    => 'sunken',
                 -textvariable  => \$self->{comments},
                 )->grid(-row => $row, -column => 1);

    ++$row;

    # BUTTONS
    $grid->Label()->grid(-row => $row, -column => 0); # blank line

    ++$row;

    $grid->Button(-text   => 'Add',
                  -width  => 6,
                  -command => sub {
                      $self->add_pressed();
                  },
                  )->grid(-row => $row, -column => 0, -sticky => 'w');

    $grid->Button(-text    => 'Done',
                  -width   => 6,
                  -command => sub {
                      $self->clear_everything();
                      $self->hide();
                  },
                  )->grid(-row => $row, -column => 1, -sticky => 'e');

    $grid->pack();
}

sub search_for_clone_name {
    my ($self, $clone_name) = @_;
    my ($dbh)  = $self->{dbi};

    eval {
        unless ($dbh) {
            $dbh = WrapDBI->connect($self->{db_user}, {RaiseError => 1});
            $self->{dbi} = $dbh;
        }

        if( !defined $dbh ) {
            $self->{dbi} = '';
            $self->expire("Could not connect to database") ;
        }

        $dbh->{AutoCommit} = 0;

        my $and = '';

#        if( $self->{organism_choosen} ){
#            $and = "and   c.SPECIESNAME = '".$self->{organism_choosen}."'";
#        }

	my $arrayOfArrays =
            $dbh->fetch_all(qq[
                               select c.clonename, cd.DESCRIPTION, c.speciesname
                               from   CLONE c, CHROMOSOMEDICT cd
                               where  CLONENAME like '%$clone_name%' $and
                               and    c.CHROMOSOME  = cd.ID_DICT (+)
                               order by CLONENAME
                               ]);

        # setup cache
        foreach (@{$arrayOfArrays}){
            $self->{clone_hash}->{$_->[0]}->{chromo}   = $_->[1];
            $self->{clone_hash}->{$_->[0]}->{organism} = $_->[2];
        }

        # Add clones into drop down window on BrowsEentry widget
	$self->{clone_widget}->delete('0', 'end');

	foreach my $array ( @$arrayOfArrays ) {
	    $self->{clone_widget}->insert('end', (@$array)[0]);
	}

	# display the drop down window. 
        # Note: BtnDown is not a 'public' method.
	$self->{clone_widget}->BtnDown if ($self->{clone_widget}->{"popped"});
        $self->{clone_widget}->BtnDown;
    };
	
    if ($@) {
        LemurUtils->expire("$@");
    }
}

sub is_valid_clone_name {
    my ($self, $clone_name) = @_;
    my ($dbh)  = $self->{dbi};
    my $return_var;

    eval {
        unless ($dbh) {
            $dbh = WrapDBI->connect($self->{db_user}, {RaiseError => 1});
            $self->{dbi} = $dbh;
        }

        if( !defined $dbh ) {
            $self->{dbi} = '';
            $self->expire("Could not connect to database") ;
        }

        $dbh->{AutoCommit} = 0;

        if( LemurUtils->is_valid_clone_name($dbh, $clone_name) ){
            $return_var = 1;
        }
        else {
            $return_var = 0;
        }
    };
	
    if ($@) {
        LemurUtils->expire("$@");
    }

    return $return_var;
}

sub clear_everything {
    my ($self) = @_;

    $self->{organism_choosen} = '';
    $self->{clone_choosen}    = '';
    $self->{chromo}           = '';
    $self->{prep_number}      = '';
#    $self->{prep_type}        = '';
#    $self->{band_quality}     = '';
    $self->{comments}         = '';
}

sub show {
    my ($self) = @_;

    $self->{mw}->deiconify();
}

sub hide {
    my ($self) = @_;

    $self->{mw}->withdraw();
}

sub get_clones_for {
    my ($self, $organism) = @_;

    LemurUtils->setWait([$self->{mw}]);

    $self->{clone_choosen} = '';
    $self->{clone_widget}->delete(0.1, 'end');

    my (@clones) = $self->get_clones_cache($organism);

    if( scalar(@clones) == 0 ) {
        # if you ever get this message, means either the clonename field
        # has not been filled in in the DNAPrep record or no DNA Prep
        # record.

        LemurUtils->showError($self->{mw},
                              "No clones found for $organism.".
                              "Do you need to enter one via Gull?");

    } else {	   
        foreach my $clone ( @clones ) {
            $self->{clone_widget}->insert('end', $clone);
        }
    }

    LemurUtils->unSetWait([$self->{mw}]);
}

# returns a list of clones for a specified organism. Also sets up a hash to
# lookup the chromosome description for a givem clone name
#
sub get_clones_cache {
    my ($self, $organism) = @_;

    # look in cache first
    if( $self->{organism_cache}->{$organism} ){
        print "Using the cache!!!\n" if $debug;
        return @{$self->{organism_cache}->{$organism}};
    }

    my $dbh = $self->{dbh};
    my $array_array;

    eval {
	unless( $dbh ) {
	    $dbh         = WrapDBI->connect($self->{db_user},
                                            {RaiseError => 1});
	    $self->{dbh} = $dbh;
	}

	if( !defined $dbh ) {
	    $self->{dbh} = '';
	    $self->expire("Could not connect to database");
	}

	$dbh->{AutoCommit} = 0;

        $array_array = $dbh->fetch_all(qq[select c.CLONENAME, cd.DESCRIPTION,
                                                 c.SPECIESNAME
                                          from   CLONE c, CHROMOSOMEDICT cd
                                          where  c.SPECIESNAME = '$organism'
                                          and    c.CHROMOSOME  = cd.ID_DICT (+)
                                          order by c.CLONENAME  ]);
    };

    if( $@ ){
        my $error = $@;

        LemurUtils->showError($self->{mw},
                              "Error: $error");
        return;
    }

    my @return_array;

    foreach (@{$array_array}){
        push @return_array, $_->[0];
        $self->{clone_hash}->{$_->[0]}->{chromo}   = $_->[1];
        $self->{clone_hash}->{$_->[0]}->{organism} = $_->[2];
    }

    # add list of clone to the cache
    $self->{organism_cache}->{$organism} = \@return_array;

    return @return_array;
}

# for the clone choosen, get any preps that may have already been enetered so
# we can make sure the user does not re-use those numbers
sub set_prep_numbers {
    my ($self) = @_;

    my $dbh;
    my $array_array;
    my $clone_name = $self->{clone_choosen};

    eval {
	$dbh = $self->connect_to_oracle();

        $array_array = $dbh->fetch_all(qq[ select MAX (PREP_NUMBER)
                                           from   DNAPREP
                                           where  CLONENAME = '$clone_name' ]);
    };

    if( $@ ){
        my $error = $@;

        LemurUtils->showError($self->{mw},
                              "Error: $error");
        return;
    }

    my ($string, @good_preps);

    # put prep numbers used into a string so we can grep them out. That way
    # users cant reuse a prep number.

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

        if( $string ){
            $string .= '|'.$row->[0];
        }
        else {
            $string .= $row->[0];
        }
    }

    if( $string ne '' ){
    #    @good_preps = grep !/[$string]/, (1,2,3,4,5,6,7,8,9,10);
    my $next_prep = $string +1;
    my $max_prep = $next_prep +5;
	@good_preps = ($next_prep..$max_prep);
	 }
    else {
        @good_preps = (1,2,3,4,5,6,7,8,9,10);
    }

    $self->{prep_numbers_widget}->delete(0.1, 'end');

    foreach my $prep_num (@good_preps){
        $self->{prep_numbers_widget}->insert('end', $prep_num);
    }

    $self->{prep_number} = ''; # get rid of last selection
}

sub connect_to_oracle {
    my ($self) = @_;

    my $dbh = $self->{dbh};

    unless( $dbh ) {
        $dbh         = WrapDBI->connect($self->{db_user}, {RaiseError => 1});
        $self->{dbh} = $dbh;
    }

    return $dbh;
}

sub add_pressed {
    my ($self) = @_;

    unless( $self->valid_data() ){
        return;
    }

    warn "Is Valid Data\n";

    eval {
        $self->add_prep();
    };

    if( $@ ){
        my $error = $@;
        $self->{dbh}->rollback();

        LemurUtils->showError($self->{mw},
                              "ERROR: $error. Prep NOT added.");
    }
    else {
        $self->{dbh}->commit();
        LemurUtils->showInfo($self->{mw},
                             "DNA Prep added.");
        $self->clear_everything();
        
    }
}

sub valid_data {
    my ($self) = @_;

    my $ok         = 1;
    my $must_enter = 'You must select ';

    unless( $self->{organism_choosen} ){
        $ok          = 0;
        $must_enter .= 'an organism, ';
    }

    unless( $self->{clone_choosen} ){
        $ok          = 0;
        $must_enter .= 'a clone, ';
    }
    else {
        unless( $self->is_valid_clone_name($self->{clone_choosen}) ){
            $ok          = 0;
            $must_enter .= 'a valid clone name, ';
        }
    }

    unless( $self->{prep_number} ){
        $ok          = 0;
        $must_enter .= 'a prep number, ';
    }

    unless( $self->{prep_type} ){
        $ok          = 0;
        $must_enter .= 'a prep type, ';
    }

    unless( $self->{band_quality} ){
        $ok          = 0;
        $must_enter .= 'the band quality, ';
    }

    unless( $ok ) {
	unless( $must_enter =~ /^You must select $/ ) {
	    $must_enter =~ s/,\s$/./;           # strip off ', ' at end
	    LemurUtils->showError($self->{mw}, $must_enter);
	}
    }

    return $ok;
}

sub add_prep {
    my ($self) = @_;

    my $dbh = $self->{dbh};

    unless( $dbh ) {
        $dbh         = WrapDBI->connect($self->{db_user}, {RaiseError => 1});
        $self->{dbh} = $dbh;
    }

    if( !defined $dbh ) {
        $self->{dbh} = '';
        $self->expire("Could not connect to database");
    }

    $dbh->{AutoCommit} = 0;

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

    print "id_prep = $id_prep\n" if $debug;

    $dbh->do(qq[
                insert into DNAPREP
                       (ID_PREP,
                        PREP_NUMBER,
                        PREP_TYPE,
                        OPERATOR,
                        BANDQUALITY,
                        IS_PRIORITY,
                        CLONENAME,
                        COMMENTS)
                values ($id_prep,
                        $self->{prep_number},
                        $self->{prep_types_hash}->{$self->{prep_type}},
                        $self->{id_role},
                        $self->{band_quality_hash}->{$self->{band_quality}},
                        0,
                        '$self->{clone_choosen}',
                        '$self->{comments}')
                ]);
    print "DNAPREP inserted\n" if $debug;

    # create 3 DNAPREP_STATUS records - created, completed & assigned
    # If this isn't in Pathogen mode it will not create the assigned status
    # so it will turn up in Get DNA Prep window.

    $dbh->do(qq[
                insert into DNAPREP_STATUS
                       (ID_PREP,
                        STATUS,
                        STATUSDATE,
                        ISCURRENT,
                        SESSIONID,
                        PROGRAM,
                        OPERATOR)
                values ($id_prep,
                        1,
                        SYSDATE,
                        0,
                        $self->{session_id},
                        'LemurEnterPrep',
                        '$self->{realUserName}')
                ]);

    my $iscurrent = 0;

    if( $self->{mode} ne 'Pathogen Mode' ){
        $iscurrent = 1;
    }

    $dbh->do(qq[
                insert into DNAPREP_STATUS
                       (ID_PREP,
                        STATUS,
                        STATUSDATE,
                        ISCURRENT,
                        SESSIONID,
                        PROGRAM,
                        OPERATOR)
                values ($id_prep,
                        7,
                        SYSDATE,
                        $iscurrent,
                        $self->{session_id},
                        'LemurEnterPrep',
                        '$self->{realUserName}')
                ]);
    my $status_count = 2;

#    if( $self->{mode} eq 'Pathogen Mode' ){
    $dbh->do(qq[insert into DNAPREP_STATUS
                       (ID_PREP,
                        STATUS,
                        STATUSDATE,
                        ISCURRENT,
                        SESSIONID,
                        PROGRAM,
                        OPERATOR)
                values ($id_prep,
                        15,
                        SYSDATE,
                        1,
                        $self->{session_id},
                        'LemurEnterPrep',
                        '$self->{realUserName}') ]);
    ++$status_count;
#    }


    warn "$status_count DNAPREP_STATUS inserted\n" if $debug;
}


1;

#
# $Log: LemurEnterPrep.pm,v $
# Revision 1.10  2003/11/20  12:40:43  mdf
# modified the prep number code to select the next 5 prep numbers available rather than rely on a hard coded list.
#
# Revision 1.9  2003/11/20  10:38:52  mdf
# allows up to 10 preps to be created.
#
# Revision 1.8  2000/08/22  16:53:03  pjm
# Does not clear prep type & band quality.
# Behaviour changed when looking up clones - clone searches not restricted to
# organism previously picked.
#
# Revision 1.7  2000/06/30  08:57:06  pjm
# set up organism_cache and did a external join on the chromosome - may not be
# entered/not have one.
#
# Revision 1.6  2000/06/08  16:04:56  pjm
# adds a DNAPREP_STATUS of 15 for human preps, not just pathogen
#
# Revision 1.5  2000/03/23  12:25:50  pjm
# new() is sent extra parameter to say what mode it is in (pathogen or not
# pathogen for now). Determines if a prep status record of 15 is created.
#
# Revision 1.4  2000/02/14  16:43:38  pjm
# creates 3 DNAPREP_STATUS records instead of 1 for created. 2 for Completed
# and assigned to.
#
# Revision 1.3  2000/02/14  16:14:27  pjm
# When a clone is choosen from the list it now gets the prep numbers of
# preps for this clone. It now only displays the numbers NOT used so far.
#
# Revision 1.2  2000/02/14  13:35:52  pjm
# If organism does not have chromosomes it now does another query to just
# get the clonenames.
#
# Revision 1.1  2000/01/26  14:47:53  pjm
