#######################################################################
# 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;
#
#
# $Id: LemurChangeStatus.pm,v 1.5 2005/11/21 15:50:24 mdf Exp $
#

package LemurChangeStatus;

use     strict;
use     WrapDBI;
use     Mail;

use     Tk;
use     NewBrowseEntry;

my $debug;

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

    my $self = {
	db_user     => $db_user,
        session_id  => $session_id,
    };

    bless $self;

    $self->maybe_prepare_sql();
    $self->setup_hashes();
    $self->create_window($parent_window);
    
    return $self;
}

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

    $self->{sth_valid_status}->execute();
    my $ref = $self->{sth_valid_status}->fetchall_arrayref();

    foreach my $row (@{$ref}){
        $self->{valid_status}->{$row->[1]} = $row->[0];
    }

    # Should be passed in from 'lemur'
    unless( defined $self->{session_id} ){
        $self->{session_id} =
            $self->{dbh}->fetch_scalar(q[SELECT seq_session.nextval
                                         FROM   dual ]);
    }

    $self->{real_user} = getpwuid($<);
}

sub create_window {
    my ($self, $parent_window) = @_;


    $self->{mw} = $parent_window->Toplevel();
    push @{$self->{all_widgets}}, $self->{mw};

    $self->{mw}->title("Change Ligation Status");
    $self->{mw}->Label(width   => 30)->pack;

    my $b = 
	$self->{mw}->Button(-font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
                            -text        => "Change Ligation Status",
                            -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();

    # ligation number & clone name
    my $topf = $self->{mw}->Frame()->pack();

    $topf->Label(-width  => 16,
                 -text   => 'Ligation Number',
                 -anchor => 'nw'
                 )->grid(-row    => 1,  
                         -column => 0 ,
                         -sticky => 'nw');

    my $ligf = $topf->Frame()->grid(-row    => 1,  
                                    -column => 1,
                                    -sticky => 'nw');

    my $t = 
	$ligf->Entry(-width        => 8,
                     -relief       => 'sunken',
                     -bg           => 'lemonchiffon2',
                     -textvariable => \$self->{id_ligation},
                     )->pack();

    $t->bind('<KeyPress-Return>', sub {
	$self->get_ligation_details($self->{ligNum});
    });

    $self->{ligNumWidget} = $t;

    push @{$self->{all_widgets}}, $t;

    # CLONE NAME
    $ligf->Label (-width  => 16,
                  -text   => '', 
                  -textvariable => \$self->{clone_name},
                  )->pack();

    $self->{status_display} =
        $topf->Scrolled('Listbox',
                      -width  => 35,
                      -height => 7,
                      -relief => 'groove',
                      -font   =>
                 #'-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
                      )->grid(-row    => 1,
                              -column => 2,
                              -sticky => 'nw');

    # Comment
    my $comf = $topf->Frame()->grid(-row        => 2,
                                    -column     => 0,
                                    -columnspan => 3,
                                    -sticky     => 'nw');
    
    $comf->Label(-width  => 14,
                 -text   => 'Comment', 
                 -anchor => 'nw',
                 )->pack(-side => 'left', -anchor => 'nw');

    $comf->Entry(-width        => 63,
                 -relief       => 'sunken',
                 -textvariable => \$self->{comments},
                 )->pack(-side => 'right');

    # Middle Section
    my $midf = $topf->Frame()->grid(-row => 4, -column => 0, -columnspan => 2);

    $midf->Button(-text    => 'Add Status',
                  -command => sub { $self->add_status() },
                  )->pack(-side => 'left');

    $self->{status_widget} =
        $midf->BrowseEntry(-width    => 16,
                           -relief   => 'sunken',
                           -state    => 'readonly',
                           -variable => \$self->{new_status},
                           -choices  => [ sort keys %{$self->{valid_status}} ],
                           -browsecmd => sub {
                               shift; # ref to this widget
                               my $s = shift; # what was picked

                               $self->{id_status} = 
                                   $self->{valid_status}->{$s};
                           },
                           )->pack(-side => 'left');

    # Bottom Section
#    my $botf = $self->{mw}->Frame()->pack(-anchor => 'w');
   
#    $midf->Label(-width => 25)->pack(-side => 'left');

    $topf->Button(-text => 'Quit',
                  -command => sub {
                      $self->quit;
                  })->grid( -row => 4, -column => 2, -sticky => 'ne');
}

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

    my @sths = grep /^sth/, keys %{$self};

    foreach my $sth (@sths){
        $self->{$sth}->finish();
    }

    if( defined $self->{we_connected} ){
        $self->{dbh}->disconnect();
    }

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

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

    $self->{sth_lig_details}->execute($self->{id_ligation});

    my ($clone_name,
        $comments) = $self->{sth_lig_details}->fetchrow_array();

    $self->{sth_lig_details}->finish();

    $self->{clone_name} = $clone_name;
    $self->{comments}   = $comments;

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

    # If found a ligation with id specified, lookup status's
    if( $clone_name ){
	$self->{sth_status}->execute($self->{id_ligation});
	my $ref = $self->{sth_status}->fetchall_arrayref();
	$self->{sth_status}->finish();

        return unless defined $ref;

	foreach my $row (@{$ref}){
            $self->{status_display}->insert('end',
                                            "$row->[0] $row->[1] $row->[2]");
	}
    }
}

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

     unless( defined $self->{sth_lig_details} ){
	$self->connect_to_oracle();

        $self->{sth_valid_status} =
            $self->{dbh}->prepare(q[SELECT id_dict, description
                                    FROM   ligationstatusdict
                                    WHERE  id_dict NOT IN (5, 9) ]);

	$self->{sth_lig_details} =
	    $self->{dbh}->prepare(q[SELECT clonename, comments
                                    FROM   ligation
				    WHERE  id_ligation = ? ]);

	$self->{sth_status} =
	    $self->{dbh}->prepare(q[SELECT ls.statusdate, lsd.description,
                                           ls.operator
				    FROM   ligationstatusdict lsd,
                                           ligation_status ls
				    WHERE  ls.id_ligation = ?
                                    AND    ls.status      = lsd.id_dict
				    ORDER BY ls.statusdate ]);

        $self->{sth_iscurrent_zero} =
            $self->{dbh}->prepare(q[UPDATE ligation_status
                                    SET    iscurrent   = 0
                                    WHERE  id_ligation = ?
                                    AND    iscurrent   = 1 ]);

        $self->{sth_insert_lig} =
            $self->{dbh}->prepare(q[INSERT INTO ligation_status
                                    (id_ligation, status, statusdate, iscurrent,
                                     sessionid, program, operator)
                             VALUES (?, ?, SYSDATE, 1, ?, ?, ?) ]);

        $self->{sth_update_comments} =
            $self->{dbh}->prepare(q[UPDATE ligation
                                    SET    comments    = ?
                                    WHERE  id_ligation = ? ]);
    }
   
}

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

#    $self->{db_user} = 'dev1'; $ENV{TWO_TASK} = 'old_sids'; print "* DEV1 *\n";

    if( defined $self->{dbh} ){
	return;
    }
    else {
	$self->{dbh} = WrapDBI->connect($self->{db_user}, {RaiseError => 1});

	unless( defined $self->{dbh} ){
	    die "Could not connect to database";
	}

	$self->{dbh}->{AutoCommit} = 0;
        $self->{we_connected} = 1; # so we know to disconnect later, not passed
                                   # in dbh from calling module...
    }
}

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

    return unless defined $self->{id_status};

    eval {
        $self->{sth_lig_details}->execute($self->{id_ligation});

        my ($clone_name) = $self->{sth_lig_details}->fetchrow_array();

        $self->{sth_lig_details}->finish();

        # If found a ligation with id specified, add the status
        if( $clone_name ){
            $self->{sth_iscurrent_zero}->execute($self->{id_ligation});
            $self->{sth_insert_lig}->execute($self->{id_ligation},
                                             $self->{id_status},
                                             $self->{session_id},
                                             'LemurChangeStatus',
                                             $self->{real_user});

            $self->{sth_update_comments}->execute($self->{comments},
                                                  $self->{id_ligation});

            $self->{dbh}->commit();

            $self->get_ligation_details();


            # Let mcj know ligation status was changed by a subcloner
            my $subject = "Ligation $self->{id_ligation} changed status";
            my $message = "Ligation $self->{id_ligation} changed to ".
                "`$self->{new_status}` by $self->{real_user}";

            Mail::sendMail(-to      => "mcj",
                           -subject => $subject, 
                           -message => $message);
        }
    };

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

        $self->{dbh}->rollback(); print "Rollback done.\n";
        print $@;
    }
}

# END OF MODULE
1;

#
# $Log: LemurChangeStatus.pm,v $
# Revision 1.5  2005/11/21  15:50:24  mdf
# *** empty log message ***
#
# Revision 1.4  2001/06/29  11:06:30  pjm
# took pjm off email so he does not get spammed when 100 odd ligations are
# updated in one go :)
#
# Revision 1.3  2000/10/23  11:28:41  pjm
# Comments are displayed for a lig and are updated when Add Status is pressed.
#
# Revision 1.2  2000/10/23  10:46:37  pjm
# send email to mcj & pjm when someome changes a status.
#
# Revision 1.1  2000/10/23  10:25:23  pjm
# Initial revision
#
#
