#!/usr/local/bin/perl

#######################################################################
# 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.                      #
#######################################################################

 #    #    ##     ####   #    #     #    #    #  ######           ####
 ##  ##   #  #   #    #  #    #     #    ##   #  #               #    #
 # ## #  #    #  #       ######     #    # #  #  #####           #    #
 #    #  ######  #       #    #     #    #  # #  #               #  # #
 #    #  #    #  #    #  #    #     #    #   ##  #               #   #
 #    #  #    #   ####   #    #     #    #    #  ###### #######   ### #

require Exporter;

use DBI;

require Tk::NoteBook;
require Tk::LabEntry;
use owl_general;
#require "/nfs/disk68/dn1/badger-bin/finch/owl_general.pm";

@machine_q::ISA = qw(Exporter);
@machine_q::EXPORT = qw(machine_q);

package machine_q;

# DN1

sub machine_q {

    my ($who, $db_database, $db_user, $db_pass, $mw, $ID_SEQSERVICE, $data, $runtype, $Q, $team, $format, $platename, $session_id, $samples, $maps, $regetmaps) = @_;

    my $top = $mw->Toplevel();
    $top->configure (-title => "machine_q");
    $top-> configure(-cursor  => 'hand2');

    # make a frame at the bottom of $top
    $bottom = $top->Frame(-relief => 'ridge', -borderwidth => '6');
    $bottom->pack(-side => 'bottom', -expand => 'yes', -fill => 'both');

###############################################################
# What are the available machines for this $ID_SEQSERVICE >?<
###############################################################

    my @machines = ();
    my @id_machines = ();

    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";

    my $statement = "
select ID_SEQMACHINE, TYPE, LNUM, WTR, NAME
from seqmachine
where id_seqservice = \'$ID_SEQSERVICE\'
and ISACTIVE = 1
order by id_seqmachine
";

    my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    my $info;
    while (($ID_SEQMACHINE, $TYPE, $LNUM, $WTR, $NAME) = $sth->fetchrow()){
	$info = "ID-$ID_SEQMACHINE"."_TYPE-$TYPE"."_NAME-$NAME";
	push @machines, $info;
	push @id_machines, $ID_SEQMACHINE;
    }
    $sth->finish;

    if ($#machines == -1){
	# There are no machines assigned to this seqservice
	$top->Label( -font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		    -text => "There are no machines assigned to this seqservice !",
		    "-height" => 1 )->pack(-side => 'left');
	
    }

########################################################## 
# ...And what's been scheduled for these machines already
##########################################################
    
    my @run_data = get->runs($dbh, $ID_SEQSERVICE, \@id_machines);
#    my $capture = Data::Dumper::Dumper(@run_data);
#    warn $capture;
   

###############################################################
# Get the possible-runtypes from the database - Table RUNTYPE #
###############################################################
    # But remember !! We cannot select a 377 run if the machine in question 
    # is a 373

    $statement = "
select ID_RUNTYPE, DESCRIPTION
from runtype 
";
    $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $info = '';
    my @runs = ();
    while (($ID_RUNTYPE, $DESCRIPTION) = $sth->fetchrow()){
	$info = "ID" . "$ID_RUNTYPE" . "   $DESCRIPTION";
	push @runs, $info;
    }
    $sth->finish;

#################################################
# what about $runtype >?<... we need to convert #
#################################################
    if ($runtype ne 'NULL'){
	$statement = "
select DESCRIPTION
from runtype
where id_runtype = \'$runtype\' 
";
	$sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth->execute || die "ERROR:$DBI::errstr";
	($DESCRIPTION) = $sth->fetchrow();
	$runtype = "ID" . "$runtype" . "   $DESCRIPTION";
	$sth->finish;
    } else {
	$runtype = "Select a runtype";
    }
    
    ################################
    # Disconnect from the database #
    ################################
    $dbh->disconnect;


#############################################################
# We want to make x number of tabs for                        
# x number of Sequencing-machines      
#
# Create the notebook- add x pages.
# (x frames with tabs)             
# Then create LabEntry(etc) widgets and pack them as usual.
#############################################################

    ######################
    # Make the notebook
    ######################
    my $n = $top->NoteBook(
			   -ipadx => "6",
			   -pady => "6"
			   )->pack;

    my $this_machine;
    my $count = 0;
    my @machine;
    my @framea;
    my @frameb;
    my @Button_add;
    my @Button_rem;
    my @box;
    my @run;
	
    foreach $this_machine (@machines) {
	##################################
	# Parse $this_machine now        #
	# eg. ID-223_TYPE-373_NAME-TEST1 #
	##################################
	my ($machine_ID, $machine_type, $machine_name);
	if ($this_machine =~ /^ID-(\d+)_(TYPE-\d+)_NAME-(\w+)/){
	    $machine_ID = $1;
	    $machine_type = $2;
	    $machine_name = $3;
	} else {
	    die "Cannot parse $this_machine !\n";
	}

	######################### 
	# Make the page
	######################### 
	$machine[$count] = $n->add("mach$count",
				   #-label => "Machine_$count",
				   -label => "$machine_name",
				   );
	
	#########################
	# Fill the page
	#########################

	# Some machine-info
	$machine[$count]->LabEntry(
				   -label => "Machine Info:", -width => 30,
				   -labelPack => [qw/-side left -anchor w/],
				   #-textvariable => \$machines[$count],
				   -textvariable => \$machine_type,
				   -background => 'honeydew2',
				   -state => 'disabled'
				   )->pack(qw/-anchor nw/);


	# Some frames
	$framea[$count] = $machine[$count]->Frame();
	$frameb[$count] = $machine[$count]->Frame(-relief => 'ridge', -borderwidth => '6');
	$framea[$count]->pack(-side => 'left', -expand => 'yes', -fill => 'both');
	$frameb[$count]->pack(-side => 'right', -expand => 'yes', -fill => 'both');

        # Fill the left-frame
	my $localMachine = $machines[$count]; # make a local version of this machine
                			      # for the sub to use
	$Button_add[$count] = $framea[$count]->Button(
						      -width => 20,
						      -height => '1',
						      -text => 'Add to the loading Q',
						      -command => sub {
							  add2machine($who, $db_database, $db_user, $db_pass, $runtype, $localMachine, $mw, $top, $Q, $platename, $session_id, $team, $format, $data, $samples, $maps, $regetmaps);
						      });
	$Button_add[$count]->pack(-side => 'top', -expand => 'no', -fill => 'x');


	########################################################################
	# ...if machine_q is in 'read-only' mode we should disable some things #
	########################################################################
	if ($data eq 'None'){
	    $Button_add[$count]->configure(-state => 'disabled');
	}

	# Fill the right-frame
	$box[$count] = $frameb[$count]->ScrlListbox (
						     -bg => 'Lemonchiffon2',
						     -scrollbars => 'e',
						     -label => "Currently assigned:",
						     -height => 15
						     );
	$box[$count]->pack(-side => 'top', -expand => 1, -fill => 'both');


	#################################################################################################
	my $localbox = $box[$count];
	# New buttons here
	$Button_rel[$count] = $framea[$count]->Button(
						      -state => 'disabled',
						      -width => 20,
						      -height => '1',
						      -text => 'Release from the Q',
						      -command => sub {
							  # add2machine($who, $db_database, $db_user, $db_pass, $runtype, $localMachine, $mw, $top, $Q, $platename, $session_id, $team, $format, $data, $samples, $maps, $regetmaps);
							  my $ID_GEL = $localbox->get('active');
							  #warn "Releasing gel $ID_GEL \n";
							  rel_from_machine($mw, $who, $db_database, $db_user, $db_pass, $ID_GEL, $Q, $regetmaps, $top);
						      });
	$Button_rel[$count]->pack(-side => 'bottom', -expand => 'no', -fill => 'x');
	
	
	$Button_rem[$count] = $framea[$count]->Button(
						      -state => 'disabled',
						      -width => 20,
						      -height => '1',
						      -text => 'Remove run completely',
						      -command => sub {
							  # add2machine($who, $db_database, $db_user, $db_pass, $runtype, $localMachine, $mw, $top, $Q, $platename, $session_id, $team, $format, $data, $samples, $maps, $regetmaps);
							  my $ID_GEL = $localbox->get('active');
							  #warn "Releasing gel $ID_GEL \n";
							  rem_from_machine($mw, $who, $db_database, $db_user, $db_pass, $ID_GEL, $Q, $regetmaps, $top);
						      });
	$Button_rem[$count]->pack(-side => 'bottom', -expand => 'no', -fill => 'x');






        # Fill the scrll-box with the correct-info
	#$box[$count]->insert('end', @{$test_date->{$count}});
        $box[$count]->insert('end', @{$run_data[$count]});

	# Selected-run info display tool
	$run[$count] = $framea[$count]->ScrlListbox (
						     -bg => 'honeydew2',
						     -scrollbars => 'e',
						     -label => "Selected run info.",
						     -height => 8
						     );
	$run[$count]->pack(-anchor => 's', -side => 'bottom', -expand => 1, -fill => 'x');

        $run[$count]->delete(0, 'end');


##################################################### 
        my $localinfo = $run[$count];
	my $localrelease = \$Button_rel[$count];
	my $localremove = \$Button_rem[$count];
        $box[$count]->bind ('<Double-Button-1>' => sub {
	    # Get the selected id
	    my $ID_GEL = $localbox->get('active');
	    unless ($ID_GEL eq ''){
		&fill_info($db_database, $db_user, $db_pass, $ID_GEL, $localinfo);
	    }

	    ############################
	    # Turn on the other options
	    ############################
	    $$localrelease->configure(-state => 'active', -text => "Release run $ID_GEL");
	    $$localremove->configure(-state => 'active', -text => "Remove run $ID_GEL");

        });
#####################################################



	#########
	$count++;

       
    }


    #################
    # A quit button #
    #################
    my $exitButton = $bottom->Button(- text => 'Close',
				  -command => sub {
				      $top->destroy;
				      $$Q = 0;
				      });
    $exitButton->pack(-side => 'bottom', -expand => 'yes', -fill => 'x');


    my $runtype_choice;
    unless ($#machines == -1){
    ################################# 
    # What do we want to assign >?< #
    #################################
	my $to_assign = $bottom->LabEntry(
				       -label => "Gel sample/s:", -width => 10,
				       -labelPack => [qw/-side left -anchor w/],
				       -textvariable => \$data,
				       #-background => 'tomato1',
				       -state => 'disabled' 

#				       )->pack(qw/-anchor nw/);
				       )->pack(-side => 'left');

	#############################################
	# ...and what runtype do we want to use >?< #
	#############################################
	$runtype_choice = $bottom->BrowseEntry(-label => 'Run:', -width => 25,
						  -variable => \$runtype, 
						  #-background => 'tomato1',
						  -state => 'readonly'
						  #-choices => $ref
						  )->pack(-side => 'left');

    }

    unless ($#machines == -1){
    ###############################################
    # Some test code to fill our BrowseEntry tool #
    ###############################################
	my $next;
	foreach $next (@runs){
	    #warn "--->$next\n";
	    $runtype_choice->insert('end', $next);
	}
    }


}
sub add2machine {
    my ($who, $db_database, $db_user, $db_pass, $runtype, $machine, $mw, $top, $Q, $platename, $session_id, $team, $format, $data, $samples, $maps, $regetmaps) = @_;

    # Dereference $samples and $maps
    my @samples = @$samples;
    my @maps = @$maps;

    #print "SAMPLES -> @samples \n";
    #print "MAPS -> @maps \n";
    #print "RUNTYPE -> $runtype \n";
    #print "MACHINE -> $machine \n";

    #######################################################################
    # If this was a No-Pref run... we must force a decision at this point # 
    #######################################################################
    if ($runtype eq 'Select a runtype'){
      main::popup ($mw, "STOP", ["You must select a runtype !\n"]);
	return();
    }

    #RUNTYPE -> ID1   377 - 3.5h
    #################################### 
    # Get the runtype id from $runtype #
    ####################################
    # eg. RUNTYPE -> ID1   377 - 3.5h
    if ($runtype =~ /^ID(\d+)\s+/){
   	$runtypex = $1;
    } else {
	die "Cannot parse $runtype \n";
    }
    #warn "new runtype -> $runtypex \n";



    ###########################################################################
    # The chosen plates may not be suitable for loading on the chosen machine #
    # ...we must check                                                        #
    ###########################################################################
    # what are the seqchems for the selected maps >?<     -> get from @samples
    # what is the selected runtype >?<                    -> $runtypex
    # ...go through the contents of @samples
    my $a;
    my $request;
    my $IDS;
    my $MOB;
    my $dbh;
    my $bad_counter = 0;

	###########################
	# Connect to the database #
	###########################
    $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";

    foreach $a (@samples){
	#warn "$a \n";
	# ...get the id_frequest for each sample
	# eg. a1#1#_plate648#25789#
	if ($a =~ /#(\d+)#$/ ){
	    $request = $1;
	} else {
	    die "Error parsing $request \n";
	}
	#warn "request -> $request \n";

	# ...from $request get the id_seqchem
	my $statementids = "
select ID_SEQCHEM from finish_request where ID_FREQUEST = \'$request\'
";

	#warn $statementids;

	my $sthids = $dbh->prepare($statementids) || die "ERROR:$DBI::errstr";
	$sthids->execute || die "ERROR:$DBI::errstr";
	$IDS = $sthids->fetchrow();
	$sthids->finish;
	#warn "returned ID_SEQCHEM -> $IDS \n";


        # ...use this with $runtype to make sure there is a mobility entry in $entry
	my $statementmob = "
select MOBFILE from mobility
where ID_SEQCHEM = \'$IDS\'
and ID_RUNTYPE = \'$runtypex\'
";

	#warn "$statementmob \n";

	my $sthmob = $dbh->prepare($statementmob) || die "ERROR:$DBI::errstr";
	$sthmob->execute || die "ERROR:$DBI::errstr";
	$MOB = $sthmob->fetchrow();
	$sthmob->finish;
	#warn "returned mobility -> $MOB \n";
	if ($MOB eq '') {
	    $bad_counter++;
	}

    }
    
    if ($bad_counter != 0){
      main::popup ($mw, "STOP", ["You cannot run this chemistry with the chosen runtype !\n"]);
	$dbh->disconnect();
	return();
    }


    ########################################################################
    # The machine type in $runtype must match the machine type in $machine #
    ########################################################################
    my $runtype_machine;
    my $machine_machine;
    my $this_machineID;
    if ($runtype =~ /^\w+\s+(\d+)/){
	$runtype_machine = $1;
    } else {
	#die "Cannot parse $runtype !!! \n";
	#######################################################
	# We can prevent rubbish being typed in $runtype here #
	#######################################################
      main::popup ($mw, "STOP", ["Your chosen runtype is not in the database !\n"]);
	$dbh->disconnect();
	return();
    }

    if ($machine =~ /^ID-(\d+)_\w+-(\d+)/){
	$machine_machine = $2;
	$this_machineID = $1;
    }
    #print "machine -> $machine \n";
    #print "runtype_machine -> $runtype_machine \n";
    #print "machine_machine -> $machine_machine \n";
    #print "machine_ID -> $this_machineID \n";
    if ($runtype_machine ne $machine_machine){
      main::popup ($mw, "STOP", ["Your chosen runtype is invalid for this machine !\n"]);
	$dbh->disconnect();
	return();
    }

    #print "OK ---> Let's GO !!! \n";


    #######################################################################
    # ok... we now need to update the database to Q this run on a machine #
    #######################################################################
        
    #############################################
    #############################################
    ## Create a new loadingplate and a new gel ##
    #############################################
    #############################################

    ######################################
    # 1. Get a new id_loadingplate value #
    ######################################
    my $statement_loadingplate = "
select seq_LOADINGPLATE.nextval from dual
";
    my $sthlp = $dbh->prepare($statement_loadingplate) || die "ERROR:$DBI::errstr";
    $sthlp->execute || die "ERROR:$DBI::errstr";
    my $ID_LOADINGPLATE = $sthlp->fetchrow();
    $sthlp->finish;
  

    #############################
    # 2. Get a new id_gel value #
    #############################
    my $statement_gel = "
select seq_GEL.nextval from dual
";
    my $sthg = $dbh->prepare($statement_gel) || die "ERROR:$DBI::errstr";
    $sthg->execute || die "ERROR:$DBI::errstr";
    my $ID_GEL = $sthg->fetchrow();
    $sthg->finish;

    ###################################################### 
    # 3. Populate a new loadingplate and create a status #
    ######################################################
    my $statement_newlp = "insert into loadingplate (ID_LOADINGPLATE, PLATENAME, TEAM, CATEGORY, FORMAT, ID_RUNTYPE, FASTTRACK, WESTPAV) values(\'$ID_LOADINGPLATE\', \'$platename\', \'$team\', 2, \'$format\', \'$runtypex\', 0, 0)";

    #warn "HERE $statement_newlp \n";

    my $sthlpm = $dbh->prepare($statement_newlp) || die "ERROR:$DBI::errstr";
    $sthlpm->execute || die "ERROR:$DBI::errstr";
    $sthlpm->finish;

    my $statement_newlpstatus = "
insert into loadingplate_status (ID_LOADINGPLATE, STATUS, ISCURRENT, STATUSDATE, SESSIONID, PROGRAM, OPERATOR) values (\'$ID_LOADINGPLATE\', 10, 1, sysdate, \'$session_id\', 'machine_q', \'$who\')";
    my $sthlpmst = $dbh->prepare($statement_newlpstatus) || die "ERROR:$DBI::errstr";
    $sthlpmst->execute || die "ERROR:$DBI::errstr";
    $sthlpmst->finish;


    #########################
    # 4. Populate a new gel #
    #########################
    # we need a value for LNUM for this submission
    # we know the total number of samples requested to load -> $data
    # table lnumdict contains the possibles
    my $statement_lnum = "
select ID_DICT from lnumdict
where ID_DICT >= \'$data\'
";

    #warn "HERE_2 $statement_lnum \n";

    my $sthlnum = $dbh->prepare($statement_lnum) || die "ERROR:$DBI::errstr";
    $sthlnum->execute || die "ERROR:$DBI::errstr";
    # We only want the first value
    my $sub_LNUM = $sthlnum->fetchrow();
    $sthlnum->finish;
    
    #warn "LNUM ->->-> $sub_LNUM \n";

    #...and make the new gel 
    my $statement_newgel = "
insert into gel (ID_GEL, LNUM) values (\'$ID_GEL\', \'$sub_LNUM\')
";
    my $sthng = $dbh->prepare($statement_newgel) || die "ERROR:$DBI::errstr";
    $sthng->execute || die "ERROR:$DBI::errstr";
    $sthng->finish;

    ##################################
    # 5. Create a status for the gel #
    ##################################
    my $statement_gels = "insert into gel_status (ID_GEL, STATUS, ISCURRENT, STATUSDATE, SESSIONID, PROGRAM, OPERATOR) values (\'$ID_GEL\', 10, 1, sysdate, \'$session_id\', 'machine_q', \'$who\')";
    my $sthgels = $dbh->prepare($statement_gels) || die "ERROR:$DBI::errstr";
    $sthgels->execute || die "ERROR:$DBI::errstr";
    $sthgels->finish;


    ###############################################################
    ###############################################################
    ## Go through the selected samples for this new loadingplate  #
    ##                                                            #     
    ## -create a new loadingsample entry                          #
    ## -add a loadingsample entry to request_map                  #
    ## -create a new gel sample                                   #
    ###############################################################
    ###############################################################
    my $next;
    my $ID_MAP = 1;
    my $ID_FREQUEST;
    my $ID_SEQCHEM;

    foreach $next(@samples) {
	#warn "SAMPLE -> $next \n";
	# Example -> SAMPLE -> a1(1)_plate491(24701)
	# Info we need is;
	#  $ID_MAP $ID_SEQCHEM $ID_SEQCHEM
	if ($next =~ /^\w+#(\d+)#_plate\d+#(\d+)#/){
	    #$ID_MAP = $1;
	    $ID_FREQUEST = $2;
	} else {
	    die "arg ! cannot parse $next \n";
	}
	#warn "ID_MAP -> $ID_MAP \n";
	#warn "ID_FREQUEST -> $ID_FREQUEST \n";
	# Find out $ID_SEQCHEM for this $ID_FREQUEST from table 
	my $statement_sq = "
select ID_SEQCHEM from finish_request
where ID_FREQUEST = \'$ID_FREQUEST\'
";
	my $sthsq = $dbh->prepare($statement_sq) || die "ERROR:$DBI::errstr";
	$sthsq->execute || die "ERROR:$DBI::errstr";
	my $ID_SEQCHEM = $sthsq->fetchrow();
	$sthsq->finish;

    #######################################
    # 1. Create a new loadingsample entry #
    #######################################
	# get a new value for ID_LOADINGSAMPLE
	my $statement_loadingsample = "
select seq_LOADINGSAMPLE.nextval from dual
";
    my $sthls = $dbh->prepare($statement_loadingsample) || die "ERROR:$DBI::errstr";
    $sthls->execute || die "ERROR:$DBI::errstr";
    my $ID_LOADINGSAMPLE = $sthls->fetchrow();
    $sthls->finish;

	# ...and populate table loadingsample
	my $statement_lspop = "insert into loadingsample (ID_LOADINGSAMPLE, ID_LOADINGPLATE, ID_MAP, ID_SEQCHEM) values (\'$ID_LOADINGSAMPLE\', \'$ID_LOADINGPLATE\', \'$ID_MAP\', \'$ID_SEQCHEM\')";
	my $sthlspop = $dbh->prepare($statement_lspop) || die "ERROR:$DBI::errstr";
	$sthlspop->execute || die "ERROR:$DBI::errstr";
	$sthlspop->finish;

    ############################################## 
    # 2. Add a loadingsample entry to REQUESTMAP #
    ##############################################
	my $statement_rm = "
update request_map 
set ID_LOADINGSAMPLE = \'$ID_LOADINGSAMPLE\'
where id_frequest = \'$ID_FREQUEST\'
";
	my $sth_rm = $dbh->prepare($statement_rm) || die "ERROR:$DBI::errstr";
	$sth_rm->execute || die "ERROR:$DBI::errstr";
	$sth_rm->finish;
	
    ##############################
    # 3. Create a new GEL_SAMPLE #
    ##############################
	my $statement_gs = "insert into gel_sample (ID_GEL, ID_LOADINGSAMPLE, LANE) values (\'$ID_GEL\', \'$ID_LOADINGSAMPLE\', \'$ID_MAP\')";
	my $sth_gs = $dbh->prepare($statement_gs) || die "ERROR:$DBI::errstr";
	$sth_gs->execute || die "ERROR:$DBI::errstr";
	$sth_gs->finish;


	$ID_MAP++;

    } # matches foreach $next(@samples) {
    
    ###############################################################
    ###############################################################
    ## Go through the maps used to create this loadingplate       #
    ##                                                            #     
    ## -update the status of the maps                             #
    ## -the new status depends on whether all the entries for     #
    ##  an id_mapplate have loadingsample entries                 #
    ###############################################################
    ###############################################################
    my $next2;
    my $this_MAP;
    foreach $next2 (@maps){
	#warn "MAP -> $next2 \n";
	# example -> 491_S2T1_96 
	# grab the id_mapplate value for this plate
	if ($next2 =~ /^(\d+)_/){
	    $this_MAP = $1;
	} else {
	    die "arg ! cannot parse $next2 \n";
	}
	########################################################
	# 1. Find out what the new status will be for this map #
	# ie. Partially assigned or Fully assigned >?<         #
	########################################################
	my $statement_news = "
select ID_FREQUEST from request_map where id_mapplate = \'$this_MAP\' and ID_LOADINGSAMPLE is NULL
";
	#warn "$statement_news \n";

	my $sthnews = $dbh->prepare($statement_news) || die "ERROR:$DBI::errstr";
	$sthnews->execute || die "ERROR:$DBI::errstr";
	my $return;
	my @return_array;
	while ($return = $sthnews->fetchrow()){
	    push @return_array, $return;
	}
	$sthnews->finish;
	my $status;

	my $number = ($#return_array + 1);
	#warn "******************************* return -> $number ************************** \n";

	if ($number == 0){
	    # no rows were selected -> Fully assigned
	    $status = 4;
	} else {
	    # something was returned -> Partially assigned
	    $status = 3;
	}

	########################################################
	# 2. Update the status for this map -> mapplate status #
	########################################################
	# make the old status iscurrent = 0
	my $statement_upmap = "
update mapplate_status
set ISCURRENT = 0
where ISCURRENT = 1
and ID_MAPPLATE = \'$this_MAP\'
";
	my $sthupmap = $dbh->prepare($statement_upmap) || die "ERROR:$DBI::errstr";
	$sthupmap->execute || die "ERROR:$DBI::errstr";
	$sthupmap->finish;

	# ...and enter a new status entry
	my $statement_nmap = "insert into mapplate_status(ID_MAPPLATE, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR) values (\'$this_MAP\', \'$status\', sysdate, 1, \'$session_id\', 'machine_q', \'$who\')";
	my $sthnmap = $dbh->prepare($statement_nmap) || die "ERROR:$DBI::errstr";
	$sthnmap->execute || die "ERROR:$DBI::errstr";
	$sthnmap->finish;

    } # end of foreach $next2 (@maps){

    ##############################
    ##############################
    ## Q up the selected-machine #
    ##############################
    ##############################
    # Make a GEL_QUEUE entry
    my $statement_gq = "
insert into GEL_QUEUE(ID_GEL, ID_SEQMACHINE, ID_RUNTYPE) values (\'$ID_GEL\', \'$this_machineID\', \'$runtypex\')";

    #warn $statement_gq;

    my $sthgq = $dbh->prepare($statement_gq) || die "ERROR:$DBI::errstr";
    $sthgq->execute || die "ERROR:$DBI::errstr";
    $sthgq->finish;



    ################### FINISH DB INTERACTION ######################

    $dbh->disconnect();
    $$Q = 0;
    ###################################
    # Call the redisplay code in main #
    ###################################
    &$regetmaps;
    #######################
    # And kill the window #
    #######################
  main::popup ($mw, "STOP", ["Your plate(s) have been added to the loading queue.\n\nGEL_ID is $ID_GEL !\n"]);
    $top->destroy;

}


sub fill_info {
    # A sub to fill up the info-box with relevant stuff    
    my ($db_database, $db_user, $db_pass, $ID_GEL, $box) = @_;

    # connect to the database
    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";

    my @list;

    # which gel are we looking at >?<
    my $gel = "GEL ID is "."$ID_GEL";
    push @list, $gel;

    # when was the gel submitted to the queue >?<
    $s_date = "
select statusdate
from gel_status
where iscurrent = 1
and id_gel = \'$ID_GEL\'
";

    $sth_sdate = $dbh->prepare($s_date) || die "ERROR:$DBI::errstr";
    $sth_sdate->execute || die "ERROR:$DBI::errstr";
    my $date = $sth_sdate->fetchrow();
    $date = "Submitted "."$date";
    push @list, $date;
    push @list, "\n";
    $sth_sdate->finish;

    # whose samples are they >?<



    # sample-info for this gel
    $s_ssheet = "
select unique gel_sample.lane, finish_request.platename, finish_request.rowletter, finish_request.colnum, seqchem.suffix, finish_request.iteration, mobility.mobfile, seqchem.matrixtype, finish_batch.finisher, primer.primername 
from gel_queue, gel_sample, request_map, finish_request, mobility, seqchem, finish_batch, primer
where gel_queue.id_gel = gel_sample.id_gel
and gel_sample.id_loadingsample = request_map.id_loadingsample
and request_map.id_frequest = finish_request.id_frequest
and finish_request.id_seqchem = mobility.id_seqchem
and finish_request.id_fbatch = finish_batch.id_fbatch
and finish_request.id_primer = primer.id_primer(+)
and mobility.id_runtype = gel_queue.id_runtype
and finish_request.id_seqchem = seqchem.id_seqchem
and gel_queue.id_gel = \'$ID_GEL\'
order by gel_sample.lane
   ";
    
    $sth_ssheet = $dbh->prepare($s_ssheet) || die "ERROR:$DBI::errstr";
    $sth_ssheet->execute || die "ERROR:$DBI::errstr";
    my $input;
    my $email;
    my $s_email;
    my $sth_email;
    while (($forget,$platename,$row,$col,$suffix,$iteration,$mobfile,$matrix,$finisher,$primer) = $sth_ssheet->fetchrow()) {
	$row_count++;

#####################################################
	$s_email = "
select person.email 
from person, team_person_role
where person.id_person = team_person_role.id_person
and team_person_role.id_role = $finisher
";
	$sth_email = $dbh->prepare($s_email) || die "ERROR:$DBI::errstr";
	$sth_email->execute || die "ERROR:$DBI::errstr";
	$email = $sth_email->fetchrow();
	$sth_email->finish();
####################################################

	$input = "$email   $platename$row$col$suffix$iteration$primer   $mobfile   $matrix";
	push @list, $input;
    }
    $sth_ssheet->finish;

    $box->delete(0, 'end');
    $box->insert('end', @list);

    $dbh->disconnect;

}

sub rel_from_machine {
    my ($mw, $who, $db_database, $db_user, $db_pass, $ID_GEL, $Q, $regetmaps, $top) = @_;
    #warn "$who, $db_database, $db_user, $db_pass, $ID_GEL, $session_id \n";

    if ($ID_GEL eq ''){ return(); };

    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";

    ######################
    # Sort out gel_status
    ######################
    my $s = "update gel_status set iscurrent = 0 where ID_GEL = \'$ID_GEL\'";
    my $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $sth->finish();

    $s = "insert into gel_status (ID_GEL, STATUS, ISCURRENT, STATUSDATE, PROGRAM, OPERATOR) values (\'$ID_GEL\', 101, 1, sysdate, 'mq_cancelled', \'$who\')";
    $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $sth->finish();

    #################################################
    # Find out the relevant id_loadingsample records
    #################################################
    $s = "select id_loadingsample from gel_sample where id_gel = \'$ID_GEL\' order by lane";
    $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    my @loadingsample;
    my $ls;
    while ($ls = $sth->fetchrow()){
	push @loadingsample, $ls;
	push @loadingsample, ",";
    }
    my $comma = pop @loadingsample;
    $sth->finish();

    #####################################
    # Find out the id_mapplates involved
    #####################################
    $s = "select unique id_mapplate from request_map where ID_LOADINGSAMPLE in (@loadingsample)";
    #warn $s;
    $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    my @id_mapplate;
    my @m;
    my $mp;
    while ($mp = $sth->fetchrow()){
	push @id_mapplate, $mp;
	push @m, $mp;
	push @id_mapplate, ",";
    }
    $comma = pop @id_mapplate;
    $sth->finish();
    #warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ \n";
    #warn "@id_mapplate \n";

    ##########################################
    # ... and remove the id_loadsample record
    ##########################################
    $s = "update request_map set id_loadingsample = NULL where ID_LOADINGSAMPLE in (@loadingsample)";
    $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $sth->finish();

    ###########################
    # Sort out mapplate_status
    ###########################
    $s = "update mapplate_status set iscurrent = 0 where id_mapplate in (@id_mapplate)";
    $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $sth->finish();

    my $next;
    foreach $next (@m){
	$s = "insert into mapplate_status (ID_MAPPLATE, STATUS, ISCURRENT, STATUSDATE, PROGRAM, OPERATOR) values (\'$next\', 9, 1, sysdate, 'mq_map_made_available', \'$who\')";

	#warn $s;

	$sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	$sth->execute || die "ERROR:$DBI::errstr";
	$sth->finish();
    }
    $dbh->disconnect();

    $$Q = 0;
    &$regetmaps;
  main::popup ($mw, "STOP", ["Map(s) @id_mapplate are now available again.\n\nRun $ID_GEL has been cancelled !"]);
    $top->destroy;
}

sub rem_from_machine {
    my ($mw, $who, $db_database, $db_user, $db_pass, $ID_GEL, $Q, $regetmaps, $top) = @_;

    if ($ID_GEL eq ''){ return(); };

    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";

    ######################
    # Sort out gel_status
    ######################
    my $s = "update gel_status set iscurrent = 0 where ID_GEL = \'$ID_GEL\'";
    my $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $sth->finish();

    $s = "insert into gel_status (ID_GEL, STATUS, ISCURRENT, STATUSDATE, PROGRAM, OPERATOR) values (\'$ID_GEL\', 101, 1, sysdate, 'mq_cancelled', \'$who\')";
    $sth = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    $sth->finish();
    $dbh->disconnect();

    $$Q = 0;
    &$regetmaps;
  main::popup ($mw, "STOP", ["Run $ID_GEL has been cancelled !"]);
    $top->destroy;
}

1;

