

#
# THIS MODULE IS NO LONGER USED.
#
#           IGNORE THIS FILE
#
# $Id: LemurGetPlateReq.pm,v 1.4 1999/08/10 16:11:44 pjm Exp $
#

package LemurGetPlateReq;

require Exporter;

use     strict;
use     WrapDBI;
use     LemurUtils;

use     Data::Dumper;

##########################################
# CONSTANTS
# i use emacs - leave space after '\' char
##########################################

*LemurGetPlateReq::NUM_ROWS    = \10; # make this 15??? 12 is usual for a day...
*LemurGetPlateReq::BITMAP_DIR  = \ "$ENV{'BADGER'}/lib/finch/bitmaps";

my $debug = 1;

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

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

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

    return $self;
}

#

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

    my $mw  = new MainWindow;

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

    $mw->title('Plates Requests');
    $mw->Label(width   => 40)->pack;
    $mw->Label(font    => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
	       text    => "Plates Requested",
	       height  => 1,
	       -bg          => 'white',
	       -relief      => 'groove',
	       -borderwidth => '3',
	       )->pack(-side => 'top');
    $mw->Label(width   => 40)->pack;

    $self->{mw} = $mw;

    my $topFrame    = $mw->Frame(-relief => 'raised',);
    my $tf          = $topFrame->Frame(-relief => 'raised',);
    my $upDownFrame = $topFrame->Frame();

    $self->createTableFrame($tf);

    $tf->pack(-side => 'right');

    # Make an 'up-button';
    my ($upButton, $downButton, $makeWorkButton);

    $mw->Bitmap('up',
		-file     => "$LemurGetPlateReq::BITMAP_DIR/uarrw.xbm",
		-maskfile => "$LemurGetPlateReq::BITMAP_DIR/uarrw.xbm"
	       );

    $upButton = $upDownFrame->Button(-image   => 'up',
#				     -command => sub { $self->pressedUp; }
				     ); 
    $upButton->pack(-side => 'top');

    # Make a 'down-button';
    $mw->Bitmap('down',
		-file     => "$LemurGetPlateReq::BITMAP_DIR/darrw.xbm",
	       	-maskfile => "$LemurGetPlateReq::BITMAP_DIR/darrw.xbm"
		);
    
    $downButton = $upDownFrame->Button(-image   => 'down',
#			               -command => sub { $self->pressedDown; }
				       );
    $downButton->pack(-side => 'bottom');

    $upDownFrame->pack(-side => 'left');

    # Generate buttons

    my $buttonFrame; 
    my $workToggButt;
    my $cancelButton;
    my $dummyLabel;

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

    $makeWorkButton = $buttonFrame->Button(-text    => 'Print Requests',
					   -width   => 12,
					   -command => sub{
#					       $self->pressedMakeWork;
					   });

    my $pageNum = 
	$buttonFrame->Label(-text     => 'Page 1',
			    -textvariable => \$self->{pageNumLabel},
			    -width    => 36,
			    );

    $workToggButt =
	$buttonFrame->Checkbutton(-text     => 'Show Requests already printed',
				  -width    => 34,
				  -variable =>
				      \$self->{showAllJobs},
				  -command => sub{
				      LemurUtils->setWait([$mw]);
#				      $self->getData( $self->{showAllJobs} );
				      LemurUtils->unSetWait([$mw]);
				  },
				  );

    $cancelButton   = $buttonFrame->Button(-text    => 'Done',
					   -width   => 12,
					   -command => sub {
					       # $self->hide();
					       $self->{mw}->destroy;
					   });

    $makeWorkButton->grid (-row => 1, -column => 1);
    $pageNum->grid        (-row => 1, -column => 2);
    $workToggButt->grid   (-row => 1, -column => 3);
    $cancelButton->grid   (-row => 1, -column => 4);

    $topFrame->pack(-side => 'top');
    $buttonFrame->pack(-side => 'bottom');
}

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

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

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

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

sub createTableFrame {
    my ($self, $tf) = @_;
    my $widgets     = $self->{widgets};
    my ($x, $y, $width);

    # x and y are the wrong way round here - y is on x axis....

    my @columnWidth = (6, 16, 10, 10, 10, 10, 13);
    my @dodgyData   = ('43','dj12345678','12345678','m13mp18','420/120',
		       '10','25-Jun-1999');

    for($x = 0; $x <= $LemurGetPlateReq::NUM_ROWS; $x++) {

	# create 5 label widgets
	for($y = 0; $y < 7; $y++) {

	    $width = $columnWidth[$y];

	    $self->{widgets}->[$x][$y] = $tf->Label(-relief => 'sunken',
						    -width  => $width,
						    -bg     => 'lightblue',
						    -text   => $dodgyData[$y],
						    );
	    $self->{widgets}->[$x][$y]->grid(-row => $x+1, -column => $y);
	}

	# Entry gadget - who will do the ligations for this DNA Prep.
        # Make sure create label for column heading only.

	if( $x == 0 ) {
	    $self->{widgets}->[$x][$y] = $tf->Label(-text   => "Temp text",
						    -relief => 'sunken',
						    -width  => 18,
						    -bg     => 'lightblue');
	}
	else {
	    # weirdness here with '-variable => \$assignTo[$x]'. 
	    # See above comment
	    $self->{widgets}->[$x][$y] =
		$tf->BrowseEntry(-width    => 16,
				 -relief   => 'sunken',
				 -state    => 'readonly',
				 -variable => \$self->{assignTo}->[$x],
				 -choices  =>
				     [ sort keys %{$self->{operatorHash}} ],
				 -browsecmd => $self->returnSub("$x"),
				 );
	}

        $self->{widgets}->[$x][$y]->grid(-row    => $x + 1, 
					 -column => $y);
    }


    # put in column headings

    $self->{widgets}->[0][0]->configure(text => "Team",
					bg   => 'grey');
    $self->{widgets}->[0][1]->configure(text => "Clone",
					bg   => 'grey');
    $self->{widgets}->[0][2]->configure(text => "Lib Num",
					bg   => 'grey');
    $self->{widgets}->[0][3]->configure(text => "Seq Vector",
					bg   => 'grey');
    $self->{widgets}->[0][4]->configure(text => "Clear/Blue",
					bg   => 'grey');
    $self->{widgets}->[0][5]->configure(text => "Num Plates",
					bg   => 'grey');
    $self->{widgets}->[0][6]->configure(text => "Wanted by",
					bg   => 'grey');
    $self->{widgets}->[0][7]->configure(text => "Assign To",
					bg   => 'grey');
}

# Used to clear $self->{assignTo}->[$x] to '' when <nobody> is selected on
# BrowseEntry widget.

sub returnSub {
    my $self = shift;
    my $x    = shift;

    return sub {
	if( $self->{assignTo}->[$x] eq '<nobody>' ) {
	    $self->{assignTo}->[$x] = '';
	}
    }
}

################################################################################
# connects to DB and handles any errors. Calls various subroutines to setup
# hash tables with data from dictionaries.
################################################################################

sub setupHashTables {

    my ($self) = @_;
    my ($dbh);

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

	$self->getSubcloners($dbh);

    };

    if ($@) {
	if ($DBI::err) {
	    $self->expire("$DBI::errstr: $@ Occured in setupHashtables()");
	} else {
	    $self->expire("$@: Occured in setupHashtables()");
	}
    }

    $dbh->disconnect if $dbh;
}

################################################################################
# setup $self->{operatorHash}
################################################################################

sub getSubcloners {

    my ($self, $dbh) = @_;
    my ($arrayOfArrays, $arrayRef);
    my %operatorHash;

    $arrayOfArrays = $dbh->fetch_all(
         "select PERSON.ID_PERSON, PERSON.FORENAME, PERSON.SURNAME, PERSON.EMAIL
          from   PERSON, TEAM_PERSON_ROLE
          where  TEAM_PERSON_ROLE.ROLETYPE  = 'Subcloning' 
          and    TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON "); 
 
    foreach $arrayRef (@$arrayOfArrays) {
	my $fullName = (@$arrayRef[1]." ".@$arrayRef[2]);

	$operatorHash{$fullName}          = @$arrayRef[0];
	$self->{email_id_of}->{$fullName} = @$arrayRef[3];
    }

    $operatorHash{'<nobody>'} = ''; # if user selected someone, then changed 
                                    # their mind.

    $self->{operatorHash} = \%operatorHash;
}

#
#
#

sub expire {

    my ($self, $errorMsg, $dbh) = @_;

    $dbh->disconnect if $dbh; 
    warn "ERROR: $errorMsg\n";

    Mail::sendMail( -to      => 'pjm',
                    -subject => "Lemur: Error in Get Requested Plates.", 
                    -message => $errorMsg);

    die "\n";
}

#####
# EOF
#####
1;

# $Log: LemurGetPlateReq.pm,v $
# Revision 1.4  1999/08/10 16:11:44  pjm
# removed \n from subject
#
# Revision 1.3  1999/07/27 11:24:29  pjm
#   THIS MODULE IS NO LONGER USED. COMMENT ADDED TO SAY THIS...#
#
