#######################################################################
# 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
#
# This module displays a list of ligation batches the user has entered
# in the last 20 working days. Against each batch are the first and last
# clones, and the lig numbers made for them an the numbers of ligs in that
# batch.
# The user can select one and press print.  All the labels will be printed
# plus a worksheet listing all of the ligations.
#
# It would be good to merge the code for this and LemurEnterBatchOfLigs :)
#
# $Id: LemurReprintBatch.pm,v 1.13 2001/03/16 14:51:17 pjm Exp $
#

package LemurReprintBatch;

use strict;
use WrapDBI;
use LemurUtils;
use Mail;
use Date::Manip;

my $debug = 0;

sub new {
    my ($type, $dbUser, $sessionID) = @_;

    my $self = {
	dbUser           => $dbUser,
	session_id       => $sessionID,
    };
    bless($self, $type);

    # hard code $self->{user} = 'pjm' for testing/pretend to be someone else
    $self->{user} = getpwuid($<);

    if( $dbUser eq 'dev1' ){
        print "User = dev1\n";
    }

    $self->createWindow();

    $self->get_data();

    return $self;
}

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

    my $mw  = new MainWindow;
    $self->{mw} = $mw;

    $mw->protocol('WM_DELETE_WINDOW' => sub { 
	$self->hide();
    });

    $mw->title('Reprint Batch');

    my $b = 
	$mw->Button(-font        => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		    -text        => 'Reprint a batch of ligations',
		    -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;
    });

    my $frame = $mw->Frame(-relief => 'raised',);

    $frame->Label()->pack();
    $frame->Label(-width  => 60,
                  -height => 4,
                  -text =>
                  "Below is a list of the batches you have created in the ".
                  "last 20 working\n".
                  "days. Click on the batch you require and press print. ".
                  "The worksheet\n".
                  "and ligation labels will be printed out.",
                  )->pack();
    $frame->Label()->pack(); # spacing
    $frame->pack();

    $self->{listbox} =
        $mw->Scrolled('Listbox',
                      -width  => 72,
                      -height => 13,
                      -relief => 'groove',
                      -font   =>
                 '-schumacher-clean-bold-r-normal--14-140-75-75-c-80-iso8859-1',
                      )->pack(-expand => 1,
                              -fill   => 'both');

    $mw->Label()->pack(); # spacing

    # BUTTONS
    my $butt_frame = $mw->Frame(-relief => 'raised',);

    $butt_frame->Button(-text    => 'Print',
                        -command => sub {
                            $self->press_print();
                        },
                        )->pack(-side => 'left');

#    $butt_frame->Label(-width => 50)->pack(-side => 'left'); # spacing

    $butt_frame->Checkbutton(text      => 'Print labels',
                             -width    => 22,
                             -variable => \$self->{print_labels},
                             )->pack(-side => 'left');

    $butt_frame->Checkbutton(text      => 'Print worksheet',
                             -width    => 22,
                             -variable => \$self->{print_worksheet},
                             )->pack(-side => 'left');

    $self->{print_labels}    = 1;# default to print both
    $self->{print_worksheet} = 1;
    

    $butt_frame->Button(-text    => 'Quit',
                        -command => sub {
                            $self->hide();
                        },
                        )->pack(-side => 'left');
    $butt_frame->pack();
    
}

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

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

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

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

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

    my $offset_days = 20; # 20 work days before todays date
#    $offset_days    = 4 if $debug;#Kill_Equus puts OPERATOR as pjm, loadsa ligs


    &Date_Init("DateFormat=nonUS"); # so 12/10/1999 is oct 12, not dec 10

    my $date_todays    = &ParseDate("today");
    my $date_from      = &Date_PrevWorkDay($date_todays, $offset_days);
    my $date           = &UnixDate($date_from, '%e/%m/%y');

    $self->get_batch_info($self->{user}, $date);
}

sub get_batch_info {
    my ($self, $user, $date) = @_;
    my ($dbh, $ref1, $ref2);

#############
#$user = 'atk' if $debug;
#$user = 'jlc';
#############

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

        die "Could not connect to Oracle at $date\n" unless $dbh;

        # look for any loigs that have been created (1,2) or passed ( 5 - when
        # entering a job it goes straight to passed)
        $ref1 = $dbh->fetch_all(qq[select l.ID_LIGBATCH,
                                          min(l.ID_LIGATION), max(l.ID_LIGATION)
                                   from   LIGATION l, LIGATION_STATUS ls
                                   where  l.ID_LIGATION = ls.ID_LIGATION
                                   and    ls.STATUS     in (1, 2, 5)
                                   and    ls.OPERATOR   = '$user'
                                   and    ls.STATUSDATE >
                                          to_date('$date', 'DD/MM/YY')
                                   group by l.ID_LIGBATCH
                                   order by l.ID_LIGBATCH ]);
        my $ligations;

        foreach my $row (@{$ref1}){
            $ligations .= $row->[1].",";
            $ligations .= $row->[2].",";
        }

        $ligations =~ s/,$//;

        if( $ligations ){
            $ref2 = $dbh->fetch_all(qq[select l.ID_LIGATION, l.CLONENAME
                                       from   LIGATION l
                                       where  l.ID_LIGATION in ($ligations)
                                       order  by ID_LIGATION ]);
        }
    };

    if( $@ ){

        Mail::sendMail( -to      => "pjm",
                        -subject => "Benchmark", 
                        -message => "$date : ".$@);
          $dbh->disconnect if $dbh;
          die "$@";
    }

    $dbh->disconnect if $dbh;

    # setup hash of lig num to clone name
    my %clone_for_lig;

    foreach my $row (@{$ref2}){
        $clone_for_lig{$row->[0]} = $row->[1];
    }

    my $string = sprintf("%5s %15s   %-15s %5s   %5s   %12s",
                             'Batch', 'First Clone', 'Last Clone', 'From',
                         'To', 'Num in batch');
    $self->{listbox}->insert('end', $string);
    $string = sprintf("%5s %15s   %-15s %5s   %5s   %4s",
                      '-----', '---------------', '---------------', '-----',
                      '-----', '------------');

    $self->{listbox}->insert('end', $string);

    foreach my $row (@{$ref1}){
        my $id_batch   = $row->[0];
        my $low_lig    = $row->[1];
        my $low_clone  = $clone_for_lig{$low_lig};
        my $high_lig   = $row->[2];
        my $high_clone = $clone_for_lig{$high_lig};
        my $num_ligs   = $high_lig - $low_lig + 1; # inclusive

        $string = sprintf("%5d %15s - %-15s %5d - %5d   %12d",
                          $id_batch, $low_clone, $high_clone, $low_lig,
                          $high_lig, $num_ligs);

        $self->{listbox}->insert('end', $string);
    }
}

#
# Make sure the user has picked a batch not a column header.
# call the sub that actually does the printing.
#
sub press_print {
    my ($self) = @_;

    my $index = $self->{listbox}->curselection();

    return if $index < 2; # index starts a 0

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

    $self->{listbox}->get($index) =~ /^\s*(\d+)\s/;
    my $batch = $1;

    my $dbh;

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

        $self->print_labels($dbh, $batch);
    };

    my $error = $@;
    LemurUtils->unSetWait([$self->{mw}]);

    if( $error ){
        $dbh->rollback()   if $dbh;
        $dbh->disconnect() if $dbh;

        LemurUtils->showInfo($self->{mw}, "$error");
    }

    $dbh->disconnect() if $dbh;    
}

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

    my $PRINTER = $ENV{PRINTER};
    $PRINTER    = 'D350BW' unless $PRINTER;

    my $lig_label;

    if( $self->{print_labels} ){
        print "Setting up labels\n";
        $lig_label = Barcode->new();
        $lig_label->Type('LG');        # Ligation

        my $dbh2 = WrapDBI->connect('dodo', {RaiseError => 1});
        $lig_label->Database(\$dbh2);
        $lig_label->User( getpwuid($<) );
    }

    print "Getting info for batch $batch\n" if $debug;

    # their could be 2 status of 5 (pass) if it came froma job - 1 for getting
    # the ligation and another for updating the scores IN PATHOGEN MODE
    my $ref = $dbh->fetch_all(qq[
    select substr(l.ID_LIGATION, 1, 7) lig,
           substr(l.CLONENAME, 1, 11)  clonename,
           substr(ftb.SIZE_FROM_KB || ' - ' || ftb.SIZE_TO_KB, 1, 10) frag_size,
           substr(l.VOLUME, 1, 6)      volume,
           substr(vs.VECTORNAME, 1, 9) vector,
           substr(dp.PREP_NUMBER, 1, 4) Prep,
           ls.STATUSDATE
    from   LIGATION l, LIGATION_BATCH lb, VECTORSITE vs, FRAGMENTATION_BAND ftb,
           DNAPREP_FRAG dpf, DNAPREP dp, LIGATION_STATUS ls
    where  l.ID_LIGBATCH    = $batch
    and    l.ID_LIGBATCH    = lb.ID_LIGBATCH
    and    lb.SEQ_VECTOR    = vs.ID_VECTORSITE
    and    l.ID_FRAGBAND    = ftb.ID_FRAGBAND
    and    ftb.ID_FRAG      = dpf.ID_FRAG (+)
    and    dpf.ID_PREP      = dp.ID_PREP  (+)
    and    l.ID_LIGATION    = ls.ID_LIGATION
    and    (   ( ls.STATUS        in (1, 2) )
            or (ls.STATUS = 5 and ls.PROGRAM in ('Fragments.pm',
                                                 'EnterBatchOfJobs'))) ]);

    # quit if user specified bad batch number
    die "No ligations found for batch $batch\n" unless @{$ref};

   

    if( $self->{print_worksheet} ){
         open FILE, ">/tmp/print_ligation_batch" ||
            die "Couldn't create tmp file";

        print FILE "LIG     CLONENAME   FRAG_SIZE  VOLUME VECTOR    PREP\n";
        print FILE "------- ----------- ---------- ------ --------- ----\n";
    }

    foreach my $row (@{$ref}){
        my $lig     = $row->[0];
        my $clone   = $row->[1];
        my $size    = $row->[2];
        my $volume  = $row->[3];
        my $vector  = $row->[4];
        my $prep    = $row->[5];
        my $date    = $row->[6];

        if( $self->{print_worksheet} ){
            printf FILE "%7d %11s %10s %6d %9s %4d\n", $lig, $clone, $size,
                                                       $volume,
                                                       $vector, $prep;
            print "Printed line on worksheet for $lig\n";
        }

        if( $self->{print_labels} ){
            # print ligation barcode
            $lig_label->Barcode( $lig);
            $lig_label->Name(    $lig);
            $lig_label->Project( $lig);
            $lig_label->Suffix(  $vector);
            $lig_label->Owner(   $clone);
            $lig_label->Date(    $date );

            $lig_label->Labellist();

            print "Printed label for $lig\n";
        }
    }
    if( $self->{print_worksheet} ){
        close FILE;
        print "Closed temp file for worksheet\n";
    }

    if( $self->{print_labels} ){
        $lig_label->Printlabel();
        print "Labels have been printed\n";
    }

    print "\n\n";

    if( $self->{print_worksheet} ){
        if( -e "/tmp/print_ligation_batch" ){

            `lpr -P$PRINTER /tmp/print_ligation_batch`;
            print "Work Sheet has been printed to $PRINTER\n";
            
            my $count = unlink "/tmp/print_ligation_batch";

            if( $count == 0 ){
                die "Could not delete file /tmp/print_ligation_batch\n";
            }
        }
        else {
            die "File '/tmp/print_ligation_batch' did not exist!\n";
        }
    }

    LemurUtils->showInfo($self->{mw},
                         "Please collect your labels/worksheet from the ".
                         "printer(s)");
}


1;


#
# :$Log:
#
