$APE::Tk::Tools::CherryPicker::VERSION = '1.0';

package APE::Tk::Tools::CherryPicker;

use Tk::widgets qw/Label Button BrowseEntry HList Dialog/;
use base qw/Tk::Derived Tk::Pane/;
use strict;
use warnings;
use Carp;
use SqlEngine2;
use Class::Throwable;
use Checkbarcode2;

use APE::Tk::PlateSelector;

use constant LOGIN => 'reports';

use constant TRUE  => 1;
use constant FALSE => 0;
 
$Class::Throwable::Debug = 1; # ensure we get a stack trace from exceptions
$SqlEngine2::verbosity   = 1; # Show debugging warnings


Construct Tk::Widget 'CherryPicker';


########################################################################
## Generic method called by Tk when constructing this widget. 
########################################################################
sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
}


########################################################################
## Generic method called by Tk when constructing this widget. This
## method gathers passed aguments that are not relevant to Tk and
## processes them before calling the base classes Populate mathod
## N.B. the position of the call to the base classes Populate method is
## important and must remain above the calls to any of the class
## methods that create widgets. If this is not the case and in the
## event that the widget user attempts to use the Scrolled widget
## ($mw->Scrolled('CherryPicker')) around the CherryPicker widget the
## CherryPicker widgets will be packed in the base classes Frame
## widget, instead of the scrolled panes Frame widget. This will result
## in no scrolling.
########################################################################
sub Populate {
    my ($self,$args) = @_;

    ## We require an sql_lib file to use for plate type lookups.
    $self->{_sqlLibName} = delete $args->{-sqlLib} || 
	die("ERROR: argument -sqlLib is required.");
    $self->{_sqlEngine2} = new SqlEngine2();

    ## Assign sticky arguments to allow widget to expand unless the
    ## user has specified their own.
    $args->{-sticky} = $args->{-sticky} || 'news';

    ## Assign a start command if one hasn't been passed.
    $args->{-submitcommand} = sub { return TRUE; } unless $args->{-submitcommand};

    ## IMPORTANT: Leave this statement here. It should be called early
    ## to allow the widget user to create a Scrolled version,
    ## otherwise the following widgets are packed into a frame that is
    ## not controlled by the Scrolled pane. Nasty things will happen
    ## if this call is moved.
    $self->SUPER::Populate($args);
    $self->_createInputFrame;
    $self->_createPlateFrame;
    $self->_createWellDataFrame;
    $self->_createCpDataFrame;

    ## @@DEBUG: dummy plate data entry.
    $self->_insertDummyPlates([qw/EP37767S EP37768T EP49686I/]);#EP65742Q EP65743R EP65744S/]);

    ## Bind for plate name/barcode entry.
    $self->{_browseEntry}->bind('<Return>'=>[\&_newPlate,$self]);

    $self->ConfigSpecs(-state         => [qw/METHOD state State normal/],
		       -submitcommand => [qw/CALLBACK submitcommand SubmitCommand/]);
}

## @@DEBUG: method to add dummy plates for testing.
sub _insertDummyPlates {
    my ($self,$plates) = @_;
    foreach my $dummyPlate (@{$plates}) {
	print STDERR "*** Inserting dummy plate data: $dummyPlate\n";
	$self->{_browseEntry}->Subwidget('entry')->Subwidget('entry')->delete(0,'end');
	$self->{_browseEntry}->Subwidget('entry')->Subwidget('entry')->insert(0,$dummyPlate);
	_newPlate($self->{_browseEntry}->Subwidget('entry')->Subwidget('entry'),$self);
    } 
}


########################################################################
## Method to allow the state of this mega widget to be altered.
########################################################################
sub state {
    my ($self,$state) = @_;
    return $self->{_browseEntry}->cget(-state) unless $state;
    $self->{_browseEntry}->configure(-state=>$state);
    $self->{_clearAllBttn}->configure(-state=>$state);
    $self->{_goBttn}->configure(-state=>$state);
    $self->{_showBreakdownBttn}->configure(-state=>$state);
    if(defined $self->{_currentPlateSelector}){
	$self->{_currentPlateSelector}->configure(-state=>$state);
    }
}


########################################################################
## Method to create the _inputDataFrame Frame widget and to populate it
## with the widgets used to gather input from the user - this includes
## the _browseEntry BrowseEntry widget that is used by the user to
## input the barcode or name of the plate that they wish to cherry pick
## from.
########################################################################
sub _createInputFrame {
    my $self = shift;
    my $inputFrame = 
	$self->Frame(-relief=>'ridge',-border=>1)
	->pack(-fill=>'x',-anchor=>'n',-pady=>5,-padx=>5);
    $inputFrame->Label(-text=>'Input Selection',-bg=>'white')
	->pack(-fill=>'x',-expand=>1,-anchor=>'n',-pady=>2,-padx=>2);
    $self->{_browseEntry} = 
	$inputFrame->BrowseEntry(-label=>'Scan/Select Plate',-textvariable=>\$self->{_plate},
				 -browsecmd=>[\&_showNewPlate,$self])
	->pack(pady=>10);
    return $inputFrame;
}


########################################################################
## Method to create the _plateFrame Frame widget. This is initially an 
## empty frame that is later populated with the _currentPlateSelector 
## PlateSelector widget.
########################################################################
sub _createPlateFrame {
    my $self = shift;
    $self->{_plateFrame} =
	$self->Frame(-relief=>'ridge',-border=>1,-height=>400,-width=>500)
	->pack(-side=>'left',-fill=>'both',-expand=>1,-pady=>5,-padx=>5);
}


########################################################################
## Method to create the _wellDataFrame Frame widget and to populate it 
## with the widgets used to display the well data associated with the 
## _currentPlateSelector PlateSelector widget.
########################################################################
sub _createWellDataFrame {
    my $self = shift;
    my $wellDataFrame = 
	$self->Frame(-relief=>'ridge',-border=>1)
	->pack(-side=>'right',-fill=>'both',-expand=>1,-pady=>5,-padx=>5);
    $self->{_wellDataLabel} =
	$wellDataFrame->Label(-text=>'Well Data',-bg=>'white',-width=>40)
	->pack(-fill=>'x',-pady=>2,-padx=>2);
    $self->{_hlist} =
	$wellDataFrame->HList(-header=>1,-columns=>2,-itemtype=>'text')
	->pack(-fill=>'both',-expand=>1,-pady=>2,-padx=>2);    
    $self->{_hlist}->headerCreate(0,-text=>'Name');
    $self->{_hlist}->headerCreate(1,-text=>'Data');
    $self->{_cpDataFrame} =
	$wellDataFrame->Frame(-relief=>'ridge',-border=>1)
	->pack(-fill=>'x',-pady=>5,-padx=>5);
    $self->{_clearAllBttn} =
	$wellDataFrame->Button(-text=>'Clear All',-command=>[\&_clearAll,$self])
	->pack(-side=>'left',-pady=>5,-padx=>5);
    $self->{_goBttn} =
	$wellDataFrame->Button(-text=>'Submit',-bg=>'red',-activebackground=>'red',-command=>[\&_go,$self])
	->pack(-side=>'right',-pady=>5,-padx=>5);
}


########################################################################
## Method to create the widgets to populate the _cpDataFrame. These 
## widgets are actually placed into another frame. The widgets are for
## displaying the total number of selected wells as well as the number 
## of selected wells on the _currentPlateSelector widget.
########################################################################
sub _createCpDataFrame {
    my $self = shift;
    $self->{_cpCount} = 0;
    my $dataFrame = $self->{_cpDataFrame}->Frame->pack(-side=>'left');
    $dataFrame->Label(-text=>"Total No. wells picked",-bg=>'lightgrey')
	->grid(-column=>0,-row=>0,-pady=>2,-padx=>2,-sticky=>'w');
    $self->{_cpCountLabel} = 
	$dataFrame->Label(-text=>$self->{_cpCount})
	->grid(-column=>1,-row=>0,-pady=>2,-padx=>2,-sticky=>'w');

    $dataFrame->Label(-text=>"No. wells picked",-bg=>'lightgrey')
	->grid(-column=>0,-row=>1,-pady=>2,-padx=>2,-sticky=>'w');
    $self->{_cpIndCountLabel} = 
	$dataFrame->Label(-text=>'0')
	->grid(-column=>1,-row=>1,-pady=>2,-padx=>2,-sticky=>'w');

    $self->{_showBreakdownBttn} = 
	$dataFrame->Button(-text=>'Show breakdown',-state=>'disabled',-command=>sub{ $self->_showBreakdownTl; })
	->grid(-column=>0,-row=>2,-columnspan=>2,-pady=>2,-padx=>2,-sticky=>'w');
}


########################################################################
## Method to clear all cherry picking data - this constitutes a return
## to the start up state for the widget. All data from the _browseEntry
## widget is deleted along with all of the stored PlateSelector widgets
## (including the _currentPlateSelector) and the lookup data associated
## with them. The user is requested for verification if any
## PlateSelector widgets currently exist.
########################################################################
sub _clearAll {
    my $self = shift;
    if(defined $self->{_plateSelector} && scalar(@{$self->{_plateSelector}})) {
	if($self->_verifyDialog("Verify",
				"Are you sure you wish to clear all plates?\n".
				"All cherry picking data will be lost.",
				['Yes','No']) eq 'No') { return; }
    }
    $self->{_browseEntry}->delete(0,'end');
    $self->{_browseEntry}->Subwidget('entry')->delete(0,'end');
    $self->{_plateHash}     = undef;
    $self->{_plateSelector} = undef;
    _destroyWidget($self->{_currentPlateSelector});
}


########################################################################
## Method to assign the chosen cherry picking data to the list of
## _interestedWidgets.  The list of _interestedWidgets is assumed to be
## a list of Tk::Entry widgets.
########################################################################
sub _go {
    my $self = shift;
    return unless $self->{_interestedWidgets};
    my $iwIndex = 0;
    my $iwList  = $self->{_interestedWidgets};
    foreach my $plateSelector (@{$self->{_plateSelector}}) {
	foreach my $plateCell (@{$plateSelector->getPlateCells}) {
	    if($plateCell->isSelected) {
		if(exists($iwList->[$iwIndex]) && exists($iwList->[$iwIndex+1])) {
		    $iwList->[$iwIndex++]->insert('end',$plateSelector->getPlateName);
		    $iwList->[$iwIndex++]->insert('end',$plateCell->getCoordString);
		}
	    }
	}
    }
    $self->Callback(-submitcommand);
}


########################################################################
## Method to add a new plate to the _browseEntry widget. The platename
## can be either scanned (barcode) or entered by hand. The
## barcode/platename is verified as a valid name and passed to the
## _addEntry method that executes a database lookup using the plate id
## - see the _addEntry method for more details.
########################################################################
sub _newPlate {
    my ($entry,$self) = @_;
    if(my $data = $entry->get) {
	my $validation = Verifynumber($data);
	die("Barcode is not good - your scanned barcode type is unknown.")
	    unless $validation->{Process} eq 'Good';
	$self->_addEntry($entry,$validation->{Type} . $validation->{Number});
    }
}


########################################################################
## Method to add a new plate entry to the BrowseEntry widget after
## attempting to execute a lookup query to gather data to display in
## the plate table. Stores the lookup data in an object hash - the key
## is the plate name ($data). $lookupData->[0] contains the headers as
## returned from the statement handle before executing the lookup
## query.  $lookupData->[1] is the actual list of lists containing the
## plate data.
########################################################################
sub _addEntry {
    my ($self,$entry,$data) = @_;
    if(my $lookupData = $self->_lookupData($data)) {
	$self->{_plateHash}->{$data} = [$lookupData->[0],_sortLookupData($lookupData->[1])];
	$self->{_browseEntry}->insert('end',$data);
	$entry->delete(0,'end');
    }else{
	die("Nothing found for '$data' - the plate does not exist in the database.");
    }
}


########################################################################
## Method to sort the lookup data found for a plate. The first column
## of each row of the lookup data is assumed to be the well coordinate
## in the form of column|well (e.g. a1). The well coordinate is set as 
## the primary key, it's value is the complete row of data for that 
## well coordinate.
########################################################################
sub _sortLookupData {
    my $lookupData = shift;
    my %sortedLookupData=();
    foreach my $row (@{$lookupData}) {
	my $coord = $row->[0];
	$sortedLookupData{$coord} = $row;
    }
    return \%sortedLookupData;
}


########################################################################
## Method to lookup data for the plate that has just been scanned/typed
## in to this widget. The .sql_lib filename is passed into this widget
## - see method Populate.  The data gathered here is used to create the
## table that the user can cherry pick from.  
## N.B. Each row of an SQL lookup must start with the id_map of the
## associated row of data.
########################################################################
sub _lookupData {
    my ($self,$data) = @_;
    my ($prefix,$suffix) = $data =~ /^(\S\S)(\d+)$/;
    die("ERROR: can't match prefix and suffix of '$data': $prefix -> $suffix")
	unless $prefix && $suffix;
    my ($headers,$lookupData);
     eval {
	 my $sql     = "$self->{_sqlLibName}\:\:$prefix\_lookup";
	 $headers    = $self->{_sqlEngine2}->getSthInfo($sql,'NAME',SqlEngine2::getDbh(LOGIN),1);
	 $lookupData = $self->{_sqlEngine2}->getAll($sql,[$suffix],SqlEngine2::getDbh(LOGIN)); };
    if($@) { die("ERROR: can't execute lookup sql $self->{_sqlLibName}\:\:$prefix\_lookup: $@"); }
    return [$headers,$lookupData];
}


########################################################################
## Method to show a new PlateSelector widget or re-use an already
## created and possibly populated PlateSelector widget. Also sets the
## widgets _currentPlateSelector var and adds binds to the new
## PlateSelector to show the lookup data associated with it as the user
## moves the mouse pointer over the wells.
########################################################################
sub _showNewPlate {
    my ($self,$widget,$plateName) = @_;

    return unless $plateName;
    
    ## Grid forget the current PlateSelector widget if one exists.
    if(exists($self->{_currentPlateSelector}) && $self->{_currentPlateSelector}->viewable){
	$self->{_currentPlateSelector}->gridForget;
    }

    ## Reuse the PlateSelector widget associated with this plate if
    ## one exists.
    if(my $plateSelector = $self->hasPlateSelector($plateName)) {
	$plateSelector->grid(-column=>0,-row=>1);
	$self->{_currentPlateSelector} = $plateSelector;
	$self->{_cpIndCountLabel}->configure(-text=>$self->{_cpIndCount}{ $self->{_currentPlateSelector} });
	return;
    }
    
    ## Create a new PlateSelector widget.
    my $lookupData = $self->{_plateHash}{$plateName};
    my $format     = keys(%{$lookupData->[1]});
    if($format     == 192) { $format = 96; }
    my $plateSelector; 
    $plateSelector = 
	$self->{_plateFrame}->PlateSelector(-name       => $plateName,
					    -inccommand => sub { $self->_incrementSelected; },
					    -deccommand => sub { $self->_decrementSelected; },
					    -format     => $format)
	->grid(-column=>0,-row=>1);
    
    push(@{$self->{_plateSelector}},$plateSelector);

    ## Set the new PlateSelector as the current PlateSelector and set
    ## the binds on each well.
    $self->{_currentPlateSelector} = $self->{_plateSelector}[-1];
    $self->{_cpIndCount}{ $self->{_currentPlateSelector} } = '0';
    $self->{_cpIndCountLabel}->configure(-text=>$self->{_cpIndCount}{ $self->{_currentPlateSelector} });
    $self->_addWellBinds;
}


########################################################################
## Method to increment the count of selected PlateCell widgets in the
## current PlateSelector widget.
########################################################################
sub _incrementSelected {
    my $self = shift;
    $self->{_cpCount}++;
    $self->{_cpIndCount}{ $self->{_currentPlateSelector} }++;
    $self->{_cpCountLabel}->configure(-text=>$self->{_cpCount});
    $self->{_cpIndCountLabel}->configure(-text=>$self->{_cpIndCount}{ $self->{_currentPlateSelector} });
}


########################################################################
## Method to decrement the count of selected PlateCell widgets in the
## current PlateSelector widget.
########################################################################
sub _decrementSelected {
    my $self = shift;
    $self->{_cpCount}--;
    $self->{_cpIndCount}{ $self->{_currentPlateSelector} }--;
    $self->{_cpCountLabel}->configure(-text=>$self->{_cpCount});
    $self->{_cpIndCountLabel}->configure(-text=>$self->{_cpIndCount}{ $self->{_currentPlateSelector} });
}


########################################################################
## Method to add an Enter and Leave bind to each of the PlateCell
## objects that represent each of the wells on the newly created
## PlateSelector widget. When the user's mouse pointer enters a
## PlateCell widget, the associated with that well coordinate is
## displayed in the _wellDataFrame.  When the user's mouse pointer
## leaves the PlateCell widget the data in the _wellDataFrame is
## cleared.
########################################################################
sub _addWellBinds {
    my $self = shift;
    my $plateCellList   = $self->{_currentPlateSelector}->getPlateCells;
    foreach my $plateCell (@{$plateCellList}) {
	$plateCell->bind('<Enter>'   =>[\&_showWellData,$self]);
	$plateCell->bind('<Leave>'   =>[\&_clearWellData,$self]);
    }
}


########################################################################
## Method to show the lookup data associated with the well that the
## user currently has their mouse pointer on. See _lookupData method
## for info on the structure of $self->{_plateHash}. This is a bind
## callback method.
########################################################################
sub _showWellData {
    my ($plateCell,$self) = @_;
    $self->{_wellDataLabel}->configure(-text=>"Well Data (".$plateCell->getCoordString.")");
    my $data      = $self->{_plateHash}->{$self->{_currentPlateSelector}->getPlateName};
    my $headers   = $data->[0];
    my $dataHash  = $data->[1];
    my $cellCoord = $plateCell->getCoordString;
    for(my $i=0; $i < scalar(@{$headers}); $i++) {
	$self->{_hlist}->add($headers->[$i]);
	$self->{_hlist}->itemCreate($headers->[$i],0,-text=>$headers->[$i]);
	$self->{_hlist}->itemCreate($headers->[$i],1,-text=>$dataHash->{$cellCoord}[$i]);
    }
}


########################################################################
## Method to clear the well data that is currently being shown in the 
## _wellDataFrame. This is a bind callback when the users mouse leaves
## a PlateCell object (well) on a PlateSelector widget.
########################################################################
sub _clearWellData {
    my ($plateCell,$self) = @_;
    $self->{_wellDataLabel}->configure(-text=>"Well Data");
    $self->{_hlist}->delete('all');
}


########################################################################
## Method to find if a PlateSelector for plate name $plateName exists.
## Returns the PlateSelector widget or undef if nothing found.
########################################################################
sub hasPlateSelector {
    my ($self,$plateName) = @_;
    foreach my $plateSelector (@{$self->{_plateSelector}}) {
	if($plateSelector->getPlateName eq $plateName) {
	    return $plateSelector;
	}
    }
}


########################################################################
## Method to set the list of interested widgets to populate with this 
## tools data. Each of the interested widgets is checked to see if it 
## can execute an insert method.
########################################################################
sub setInterestedWidgets {
    my ($self,$interestedWidgets) = @_;
    foreach my $iw (@{$interestedWidgets}) {
	unless(UNIVERSAL::can($iw,'insert')) {
	    die("Interested widget '$iw' can not execute method 'insert'");
	}
    }
    $self->{_interestedWidgets} = $interestedWidgets;
}


########################################################################
## Method to display a dialog widget to the user. The dialog informs
## them of the consequence of continuing the process a allows them to
## back out.
########################################################################
sub _verifyDialog {
    my ($self,$title,$message,$buttons,$bitmap) = @_;
    return $self->Dialog(-title          => $title,
			 -text           => $message,
			 -buttons        => $buttons,
			 -default_button => $buttons->[0],
			 -bitmap         => defined $bitmap ? $bitmap : 'question')->Show;
}


sub _showBreakdownTl {
    my $self = shift;
    _destroyWidget($self->{_btl});
    $self->{_btl} = $self->Toplevel(-title=>'CherryPicker Data Breakdown');
    $self->{_btl}->Menubutton(-relief => 'sunken',
			      -borderwidth  => 2,
			      -width        => 10,
			      -textvariable => \$self->{_tlBreakdownPlate},
			      -menuitems    => &_tlMenuBttnPopulate($self))->pack;
}

sub _tlMenuBttnPopulate {
    my $self  = shift;
    my $plates=[];
    foreach my $plateSelector (@{$self->{_plateSelector}}) {
	push(@{$plates},['command' => $plateSelector->getPlateName,
			 -command  => sub{$self->_tlShowPlate($plateSelector);}]);
    }
    return $plates;
}

sub _tlShowPlate {
    my ($self,$plateSelector) = @_;
    $self->{_tlBreakdownPlate} = $plateSelector->getPlateName;
}

########################################################################
## Method to destroy a widget.
########################################################################
sub _destroyWidget {
    my $widget = shift;
    if(Tk::Exists($widget)) { $widget->destroy; }
}
    
1;
