$APE::Tk::RequirementDisplayer::VERSION = '1.0';

package APE::Tk::RequirementDisplayer;

use Tk::widgets qw/Pane Entry LabFrame Font BrowseEntry/;
use base qw/Tk::Derived Tk::Frame/;
use strict;
use Checkbarcode2;
use Carp;
use Class::Throwable;
use SITk::BarcodeEntry;
use SITk::SLabel;

use constant TRUE  => 1;
use constant FALSE => 0;

Construct Tk::Widget 'RequirementDisplayer';


########################################################################
## Standard Tk mega widget method for creating this mega widget and 
## initialising the super class widget.
########################################################################
sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
    $mw->bind($class,'<Configure>'=>\&_adjustWidgets);
    $mw->bind($class,'<Map>'=>\&_adjustWidgets);
}


########################################################################
## Standard Tk mega widget method for defining mega widget
## characteristics and capturing arguments unknown to Tk.
########################################################################
sub Populate {
    my ($self,$args) = @_;
    ## This argument is what it's all about.
    die "ERROR: argument -atomicProcessContainer is missing." 
	unless $args->{-atomicProcessContainer};
    die "ERROR: argument -atomicProcessContainer is not of type APE::AtomicProcessContainer"
	unless $args->{-atomicProcessContainer}->isa('APE::AtomicProcessContainer');
    $args->{-submitcommand}       = sub { return 1; } unless defined $args->{-submitcommand};
    $args->{-processcommand}      = [\&_processData]  unless defined $args->{-processcommand};
    $self->{_transactionControl}  = delete $args->{-transactionControl}  || FALSE;
    ## Reset global vars.
    $self->{_entryWidgets}     = ();
    $self->{_labelWidgets}     = ();
    $self->{_checkBttnWidgets} = ();
    ## Grab options unknown to Tk.
    $self->{_atomicProcessContainer}   = delete $args->{-atomicProcessContainer};
    $self->{_inputController}          = $self->{_atomicProcessContainer}->getInputController;
    $self->{_requirementContainerList} = $self->{_inputController}->getRequirementContainerList;
    $self->{wrap}                      = delete $args->{-wrap} || undef;
    $self->{_parentDesc}               = delete $args->{-parentDesc}  || 'Unknown';
    $self->{_description}              = delete $args->{-description} || 'Unknown';
    $self->{_noBttns}                  = delete $args->{-noBttns};
    $self->{_noArray}                  = delete $args->{-noArray};

    ## Create the standard buttons.
    my $bttnFrame = $self->_createBttns;
    my $dataFrame = $self->_createHeaders;
    my $pane      = $self->_displayRequirements($dataFrame);
    ## Create this widgets config specs so configure method works for
    ## user.
    $self->ConfigSpecs(-state            => [[@{$self->{_labelWidgets}},@{$self->{_entryWidgets}},
						$bttnFrame->children,$self->{_tractLabel},
						$self->{_titleLabel},@{$self->{_labFrameLabelWidgets}}]
					     ,qw/state State normal/],
		       -autoFocus        => [qw/METHOD autoFocus AutoFocus 1/],
		       -activeBackground => [qw/METHOD activeBackground ActiveBackground white/],
		       -entryBg          => [qw/METHOD entryBg EntryBg grey77/],
		       -duplicateData    => [qw/METHOD duplicateData DuplicateData/,FALSE],
		       -background       => [['SELF',$pane,@{$self->{_labelWidgets}}],qw/background Background/],
		       -resultcommand    => [qw/CALLBACK resultcommand ResultCommand/],
		       -submitcommand    => [qw/CALLBACK submitcommand SubmitCommand/],
		       -errorcommand     => [qw/CALLBACK errorcommand ErrorCommand/],
		       -processcommand   => [qw/CALLBACK processcommand ProcessCommand/]);

    ## Advertise important widgets.
    $self->Advertise('pane'                  => $pane);
    $self->Advertise('bttnFrame'             => $bttnFrame);
    $self->Advertise('entryWidgets'          => $self->{_entryWidgets});
    $self->Advertise('checkBttnWidgets'      => $self->{_checkBttnWidgets}); 

    $self->SUPER::Populate($args);
    #$self->_entryBinds;
}


########################################################################
## Method to configure the duplicateData flag. If set to true then
## duplicate data entries will be overlooked. If set to false then
## duplicates will be searched for and if found an error will be
## thrown.
########################################################################
sub duplicateData {
    my ($self,$val) = @_;
    $self->{_duplicateData} = $val ? TRUE : FALSE;
}


########################################################################
## Method to adjust the label widget containing the title of the process
## that this RequirementDisplayer is showing the Requirement objects of.
## This method is called when the RequirementDisplayer is mapped to the
## screen for the first time and each time the widget is configure - this
## includes the window container being resized.
########################################################################
sub _adjustWidgets {
    my $self = shift;
    $self->update('idletasks');
    my $width = $self->{_titleLabel}->width == 1 ? $self->{_titleLabel}->reqwidth : $self->{_titleLabel}->width;
    $self->{_titleLabel}->configure(-wraplength=>$width);
    $self->update('idletasks');
}


########################################################################
## Method to create the header data based on the tract and process name
## of which this RequirementDisplayer is going to show Requirement
## objects for. The _titleLabel is resized by the _adjustWidgets method
## callback.
########################################################################
sub _createHeaders {
    my $self = shift;
    my $dataFrame   = $self->Frame(-relief=>'ridge',-border=>1)->pack(-side=>'left',-fill=>'both',-expand=>1);
    my $headerFrame = $dataFrame->Frame(-relief=>'raised',-border=>5)->pack(-fill=>'x',-pady=>5,-padx=>5);
    
    my $tractFont = $self->Font(-family=>'helvetica',-size=>12);
    my $titleFont = $self->Font(-family=>'helvetica',-size=>24);
    $self->{_tractLabel} = $headerFrame->SLabel(-text=>$self->{_parentDesc}, -font=>$tractFont)
	->pack(-fill=>'x');
    $self->{_titleLabel} = $headerFrame->SLabel(-text=>$self->{_description},-font=>$titleFont)
	->pack(-fill=>'x');
    return $dataFrame;
}


########################################################################
## Method to display the Requirement objects to the user. This method
## pairs each entry widget with a Requirement object and stores both.
########################################################################
sub _displayRequirements {
    my ($self,$dataFrame) = @_;
    ## Create the scrolled pane widget.
    my $pane = $dataFrame->Scrolled('Pane',-scrollbars=>'osoe')
	->pack(-fill=>'both',-expand=>1)->Subwidget('pane');
    ## Find the length of the longest Requirement description.
    my $maxWidth = $self->_getMaxWidth();
    my $row=0;
    ## Create the Requirement object input widgets.
    foreach my $requirementContainer (@{$self->{_requirementContainerList}}) {
	$requirementContainer->clearOtherData;
	$requirementContainer->clearLinkedData;
	my $type = $requirementContainer->isInput ? "Input" : "Creates";
	my $requirementFrame = $pane->LabFrame
	    (-label     => $type." - ".$requirementContainer->getOutDescription,
	     -labelside => 'acrosstop')->pack(-fill=>'x',-pady=>5,-padx=>5,-ipady=>5,-ipadx=>5);
	$requirementContainer->pushOtherData($requirementFrame);
	push(@{$self->{_labFrameWidgets}},$requirementFrame);
	push(@{$self->{_labFrameLabelWidgets}},$requirementFrame->Subwidget('label'));
	foreach my $requirement (@{$requirementContainer->getRequirementList}) {
	    my $l = $requirementFrame->SLabel(-text=>$requirement->getDescription,-width=>$maxWidth,-bg=>'grey77')
		->grid(-pady=>2,-padx=>2,-column=>0,-row=>$row,-sticky=>'e');
	    my $e;
	    if(my $options = $requirement->getOptions) {
		my $be = $requirementFrame->BrowseEntry(-state=>'readonly')
		    ->grid(-pady=>2,-padx=>2,-column=>1,-row=>$row,-sticky=>'w');
		foreach(@{$options}) { $be->insert('end',$_); }
		$e = $be->Subwidget('entry')->Subwidget('entry');
	    }else{
		$e = $requirementFrame->BarcodeEntry->grid(-pady=>2,-padx=>2,-column=>1,-row=>$row,-sticky=>'w');
	    }
	    my $c = $requirementFrame->Checkbutton()->grid(-column=>2,-row=>$row++);
	    push(@{$self->{_labelWidgets}},$l);
	    push(@{$self->{_entryWidgets}},$e);
	    push(@{$self->{_checkBttnWidgets}},$c);
	    $requirementContainer->pushLinkedData([$requirement,$l,$e,$c]);
	    ## Multi select bind placed on each Checkbutton widget.
	    my $index = scalar(@{$self->{_checkBttnWidgets}})-1;
	    $c->bind('<Control-Button-1>'=>sub{ $self->_multiSelect($c,$index); });
	}
    }
    return $pane;
}

sub _entryBinds {
    my $self = shift;
    foreach my $entry (@{$self->{_entryWidgets}}) {
	$entry->bind('<Control-g>'=>sub{
	    my $data = $entry->get;
	    return unless $data;
	    if(my $id = makeID($data)) {
		$entry->delete(0,'end');
		$entry->insert('end',$id);
	    }
	});
    }
}


########################################################################
## Method to create the buttons that run down the left side of this
## mega widget.
########################################################################
sub _createBttns {
    my $self = shift;
    my $bttnFrame = $self->Frame()->pack(-side=>'left',-fill=>'y');
    ## Create the buttons that select, deselect, clear and submit the
    ## collected data for processing.
    unless($self->{_noBttns}) {
	my $selectAllBttn    = $bttnFrame->Button(-text=>'Select All',  -width=>15,-command=>sub{$self->_changeState(1);}  )
	    ->pack(-pady=>3,-padx=>3);
	my $deselectAllBttn  = $bttnFrame->Button(-text=>'Deselect All',-width=>15,-command=>sub{$self->_changeState(0);})
	    ->pack(-pady=>3,-padx=>3);
	my $clearSelectedBttn= $bttnFrame->Button(-text=>'Clear Selected',-width=>15,-command=>sub{$self->_clearSelected;})
	    ->pack(-pady=>3,-padx=>3);
	my $clearErrors      = $bttnFrame->Button(-text=>'Clear Errors',-width=>15,-command=>sub{$self->_clearErrorWidgets;})
	    ->pack(-pady=>3,-padx=>3);
	my $addChksum        = $bttnFrame->Button(-text=>'Chksum Selected',-width=>15,-command=>sub{$self->_addChksum();})
	    ->pack(-pady=>3,-padx=>3);
	my $submitBttn       = $bttnFrame->Button(-text=>'Submit',-width=>15,-bg=>'red',
					      -activebackground=>'red',-command=>sub{$self->_submit;})
	    ->pack(-pady=>3,-padx=>10);
    }

    return $bttnFrame;
}


########################################################################
## Method to submit the data contained in each Requirement object via
## the associated entry. If a container (Requirement objects are
## grouped in container frames that represent the RequirementContainer
## objects) has any data then it is an error to have missing data. If a
## container has no data then it is assumed that the user does not
## require the containers output. If any of the data fails to satisfy
## the Requirement objects data checking method then an error is
## raised.
########################################################################
sub _submit {
    my $self = shift;
    ## XXX: Moved to below the following block that does basic checking.
    ## This allows the submit command callback to be called when all 
    ## basic checks have been made.
    #return unless $self->Callback(-submitcommand,$self->{_requirementContainerList});
    $self->toplevel->Busy;
    $self->_clearErrorWidgets;
    my @errors=();
    my $rcList = $self->{_requirementContainerList};
    ## Check for missing or inconsistent data in RequirementContainer objects
    ## and entry widgets. Store errors to produce a group submission report.
    for(my $rci=0; $rci < scalar(@{$rcList}); $rci++) {
	my $linkedData = $rcList->[$rci]->getLinkedData;
	foreach my $lData (@{$linkedData}) {
	    my $requirement = $lData->[0];
	    my $label       = $lData->[1];
	    my $entry       = $lData->[2];
	    my $eData       = $entry->get;
	    my $rData       = $requirement->getData;

	    ## Check if the entry is blank - obviously an error.
	    if($self->_missingData($entry->get,$entry,$requirement,\@errors)) {
		next;
	    }

	    ## Check for inconsistent data in the entry and its
	    ## Requirement object.  This method will fix the data
	    ## mismatch and return false unless an error occurred.
	    if($self->_dataMisMatch($entry->get,$rData,$requirement,$entry,\@errors)) {
		next;
	    }
	}
    }

    ## Report errors and throw a Tk error which is actually thrown on
    ## the next main loop cycle and doesn't cause a return like a
    ## croak or die call.
    if($self->_hasErrorWidgets()) {
	$self->_handleErrors(@errors);
	return;
    }

    ## Execute the submit command callback with the list of RequirementContainer
    ## objects. If FALSE is returned then submission is stopped here.
    unless($self->Callback(-submitcommand,$self->{_requirementContainerList})) {
	$self->toplevel->Unbusy();
	return;
    }

    unless($self->{_noArray}) {
	## Array the data and flush the newly arrayed data to the database.
	eval  { $self->_arrayData($rcList); $self->_flushData; $self->{_atomicProcessContainer}->cleanUp; };
	if($@){ $self->Tk::Error("Errors found when attempting to submit your requirements",$@); 
		$self->Callback(-errorcommand,\@errors);
		$self->toplevel->Unbusy; }
    }

    $self->toplevel->Unbusy;
}


=item $rd->_handleErrors(@errors)

Private method for handling internal errors. This method adds a top
level error message to @errors. The @errors array is a list of array
references containing an error message and a widget reference
(optional) - see SITk::OutputBox for information on the @errors
format.

This method calls Tk::Error(@errors) - see Tk::Error for how to
override this method and capture @errors. It also executes the
-errorcommand callback and passes a reference to @errors.

This method calls $self->toplevel->Unbusy() as it considers that some
graphical work is being done and $widget->busy() may have been called.

=cut

sub _handleErrors {
    my ($self,@errors) = @_;
    ## Report errors and throw a Tk error which is actually thrown on
    ## the next main loop cycle and doesn't cause a return like a
    ## croak or die call.
    unshift(@errors,$self->_errorWidgetCount . " errors found - please correct errors and try again.");
    $self->Tk::Error(@errors);
    $self->Callback(-errorcommand,\@errors);
    $self->toplevel->Unbusy;
}


########################################################################
## Method to array each RequirementContainer objects data to their Atomic
## Process objects. See the InputController base class for all other 
## InputControllers for information on this process.
########################################################################
sub _missingData {
    my ($self,$eData,$entry,$requirement,$errors) = @_;
    unless($eData) {
	if(my $defaultData = $requirement->getDefault) {
	    _insertEntry($entry,$defaultData);
	    return FALSE;
	}
	$self->{_errorWidgets}{$entry} =
	{_widget => $entry,
	 _bg     => $entry->cget(-bg)};
	push(@{$errors},["Entry contains no data",$entry]);
	return TRUE;
    }
    return FALSE
}


########################################################################
## Method that checks the data in the entry widget against the data
## held in the Requirement object associated with the same entry
## widget. If the data is not equal then the Requirement is updated to
## match the entry and any errors in that process are reported.
## Returns false if the data is not a mismatch or the data was a
## mismatch but has been corrected so now is not a mismatch. Otherwise
## returns true if an error in correcting the mismatch occurred.
########################################################################
sub _dataMisMatch {
    my ($self,$eData,$rData,$requirement,$entry,$errors) = @_;
    $rData = $rData->[0] if ref $rData eq 'ARRAY';
    unless($eData eq $rData) {
	eval  { my $data = $self->_validateData($requirement,$entry,$eData); 
		$self->Callback('-processcommand',$self,$requirement,$data);
		#$self->_processData($requirement,$data);
		_insertEntry($entry,$data); };
	if($@){ 
	    my $error = $@;
	    $self->{_errorWidgets}{$entry} =
	    {_widget => $entry,
	     _bg     => $entry->cget(-bg)};
	    push(@{$errors},["Setting and processing data '$eData' failed",$entry,$error]);
	    return TRUE;
	}
	return FALSE
    }
    return FALSE;
}


########################################################################
## Method to array each RequirementContainer objects data to their Atomic
## Process objects. See the InputController base class for all other 
## InputControllers for information on this process.
########################################################################
sub _arrayData {
    my ($self,$rcList) = @_;
    for(my $rci=0; $rci < scalar(@{$rcList}); $rci++) {
	$self->{_inputController}->arrayContainerData($rcList->[$rci]);
    }
}


########################################################################
## Method to flush the data arrayed to the AtomicProcess objects in the
## _arrayData method. See the AtmicProcessContainer object for information
## on the propogation of the flush command to all AtomicProcess objects.
## If there's a -resultcommand callback then it is called once the flush
## has completed successfully, if not then a default pattern is printed
## to STDERR and the AtomicProcessContainer is rolled back to prevent 
## un required changes being made to the database.
########################################################################
sub _flushData {
    my $self = shift;
    my $results; 
    eval  { 
	$self->{_atomicProcessContainer}->beginTransaction;
	$self->{_inputController}->setSessionId;
	$results = $self->{_atomicProcessContainer}->flush; 
    };
    if($@){ 
	my $error = $@; 
	$self->{_atomicProcessContainer}->rollbackTransaction; 
	croak "ERROR: flush failed: $error"; 
    }

    if($self->cget(-resultcommand)) {
	eval  { $self->Callback(-resultcommand,$results); };
	if($@){ my $error = $@; $self->{_atomicProcessContainer}->rollbackTransaction; croak $error; }
    }else{
	my $count = 0;
	foreach my $resObj (@{$results}) {
	    warn "*** SUMMARY OF RESULT: ", ++$count, " ***\n";
	    warn "SessionId  : ", $resObj->getSessionId(), "\n";
	    warn "Id         : ", $resObj->getId(), "\n";
	    warn "Type       : ", $resObj->getType(), "\n";
	    warn "Format     : ", $resObj->getFormat(), "\n";
	    foreach(@{$resObj->getDescription()}) {
		warn "Description: $_\n";
	    }
	}
	warn "\nResult count: ",scalar(@{$results}),"\n";
	$self->{_atomicProcessContainer}->rollbackTransaction;
    }
}


########################################################################
## Method to return the count of widgets that have errored. 
########################################################################
sub _errorWidgetCount {
    my $self = shift;
    return keys %{$self->{_errorWidgets}};
}


########################################################################
## Method to return boolean if this RequirementDisplayer contains 
## any errored widgets.
########################################################################
sub _hasErrorWidgets {
    my $self = shift;
    return $self->_errorWidgetCount ? TRUE : FALSE;
}


########################################################################
## Method to clear any errored widgets. An errored widget has usually
## been formated to show it has an error, this method returns it to its
## previous state.
########################################################################
sub _clearErrorWidgets {
    my $self = shift;
    my $errorWidgets = $self->{_errorWidgets};
    foreach my $key (keys(%{$errorWidgets})) {
	$errorWidgets->{$key}{_widget}->
	    configure(-bg=>$errorWidgets->{$key}{_bg});
    } $self->{_errorWidgets} = undef;
}

sub _addChksum {
    my $self = shift;
    my $selectedEntries = $self->getSelectedEntries();
    foreach my $entry (@$selectedEntries) {
	if($entry->can('_makeID')) {
	    $entry->_makeID();
	}
    }
}


########################################################################
## Method to return a list of the selected entries. An entry is selected
## if the corresponding check button is selected.
########################################################################
sub getSelectedEntries {
    my $self = shift;
    my @selectedEntries;
    for(my $i=0; $i < scalar(@{$self->{_entryWidgets}}); $i++) {
	if($self->{_checkBttnWidgets}[$i]->{'Value'}) {
	    push(@selectedEntries,$self->{_entryWidgets}[$i]);
	}
    }
    return \@selectedEntries;
}


########################################################################
## Method to configure the background of all the entry widgets. This
## method is part of this mega widgets ConfigSpecs.
########################################################################
sub entryBg {
    my ($self,$colour) = @_;
    foreach(@{$self->{_entryWidgets}}) { $_->configure(-bg=>$colour); }
}


########################################################################
## Method to set focus binds on the entry widgets so that they change
## colour when they have focus and return to their previous colour when
## when focus is lost.
########################################################################
sub activeBackground {
    my ($self,$colour) = @_;
    foreach my $entry (@{$self->{_entryWidgets}}) {
	my $currentBgColour = $entry->cget(-bg);
	$entry->bind('<FocusIn>' =>sub { $_[0]->configure(-bg=>$colour); });
	$entry->bind('<FocusOut>'=>sub { $_[0]->configure(-bg=>$currentBgColour); });
    }
}


########################################################################
## Method to set the auto focus parameters for each entry in each
## container so that the user may orientate themseleves around the
## Requirements. Return, Up and Down keys are bound to each widget.
########################################################################
sub autoFocus {
    my ($self,$auto) = @_;
    return unless $auto;
    my $rcList = $self->{_requirementContainerList};
    for(my $rci=0; $rci < scalar(@{$rcList}); $rci++) {
	my $requirementList = $rcList->[$rci]->getRequirementList;
    	my $linkedData = $rcList->[$rci]->getLinkedData;
    	my $frame      = $rcList->[$rci]->getOtherData->[0];
	
	unless($rcList->[$rci]->isInput) {
	    $frame->Subwidget('label')->bind('<Enter>'=>sub{$self->{_bg} = $frame->cget(-bg);
							    $frame->configure(-bg=>'blue');});
	    $frame->Subwidget('label')->bind('<Leave>'=>sub{$frame->configure(-bg=>$self->{_bg});});
	    #$frame->Subwidget('label')->bind('<Button-1>'
	    #=>[\&viewArrayedEntity,$self,$rcList->[$rci],$requirementList]);
	}
	
    	for(my $i=0; $i < scalar(@{$linkedData}); $i++) {
	    my $requirement = $linkedData->[$i][0];
	    my $label       = $linkedData->[$i][1];
    	    my $entry       = $linkedData->[$i][2];
    	    my $checkBttn   = $linkedData->[$i][3];
	    my ($nextWidget,$previousWidget,$nextRequirement,$previousRequirement);

	    ## Find next.
	    if(exists $linkedData->[($i+1)]) {
		$nextWidget      = $linkedData->[($i+1)][2];
		$nextRequirement = $linkedData->[($i+1)][0];
	    }elsif(exists $rcList->[($rci+1)]) {
		$nextWidget      = $rcList->[($rci+1)]->getLinkedData->[0][2];
		$nextRequirement = $rcList->[($rci+1)]->getLinkedData->[0][0];
	    }elsif($self->{wrap}) {
		$nextWidget      = $rcList->[0]->getLinkedData->[0][2];
		$nextRequirement = $rcList->[0]->getLinkedData->[0][0];
	    }

	    ## Find previous.
	    if(($i-1) >= 0) {
		$previousWidget      = $linkedData->[($i-1)][2];
		$previousRequirement = $linkedData->[($i-1)][0];
	    }elsif(($rci-1) >= 0) {
		$previousWidget      = $rcList->[($rci-1)]->getLinkedData->[-1][2];
		$previousRequirement = $rcList->[($rci-1)]->getLinkedData->[-1][0];
	    }elsif($self->{wrap}) {
		$previousWidget      = $rcList->[-1]->getLinkedData->[-1][2];
		$previousRequirement = $rcList->[-1]->getLinkedData->[-1][0];
	    }

	    ## Bind on return press to send focus to next widget.
	    $entry->bind('<Return>',
			 [\&_autoFocusConfig,
			  $self,$rcList->[$rci],$requirement,$nextRequirement,$nextWidget,TRUE]);
	    ## Bind Down key to send focus to the next widget.
	    $entry->bind('<Down>',
			 [\&_autoFocusConfig, 
			  $self,$rcList->[$rci],$requirement,$nextRequirement,$nextWidget,FALSE]);
	    ## Bind Up key to send focus to the previous widget.
	    $entry->bind('<Up>',
			 [\&_autoFocusConfig, 
			  $self,$rcList->[$rci],$requirement,$previousRequirement,$previousWidget,FALSE]);
    	}
    }
    $rcList->[0]->getLinkedData->[0][2];
}


########################################################################
## Method to configure each of the widgets during the auto focus
## process. The binds created on each of the entries in the _autoFocus
## method call this method with the current widget, the current
## Requirement object and the next widget and Requirment object to auto
## focus to.
########################################################################
sub _autoFocusConfig {
    my ($currentWidget,$self,$rc,$currentRequirement,$nextRequirement,$nextWidget,$validate) = @_;
    if($validate) {
	if(my $data = $currentWidget->get) {
	    eval { $data = $self->_validateData($currentRequirement,$currentWidget,$data)
		       if $currentRequirement->getType() ne 'Input';
		   $self->Callback('-processcommand',$self,$currentRequirement,$data); };
		   #$self->_processData($currentRequirement,$data); };
	    if($@){ my $error = $@;
		    _insertEntry($currentWidget,$data);
		    _widgetError($currentWidget); 
		    _insertEntry($currentWidget,"");
		    $self->{_errorWidgets}{$currentWidget} =
		      {_widget => $currentWidget,
		       _bg     => $currentWidget->cget(-bg)};
		    my @errors = ([$error,$currentWidget]);
		    $self->_handleErrors(@errors);
		    $self->Callback("-errorcommand",\@errors);}
	    else  { _insertEntry($currentWidget,$data); }
	}
    }
    if($nextWidget) {
	#$self->{_inputController}->clearArrayingData($nextRequirement);
	#$nextWidget->delete(0,'end');
	$self->Subwidget('pane')->see($nextWidget);
	$nextWidget->focus;
    }
}


########################################################################
## Method to validate the data that has been entered into the
## entry. The data is considered to be a barcode id number as scanned
## by a barcode scanner or entered by a user. This method returns the
## validated string representation of the passed in data after
## conversion using the Checkbarcode module.
########################################################################
sub _validateData {
    my ($self,$requirement,$entry,$data) = @_;
    return $data if $requirement->getType eq 'Input';
    my $validation;
    eval { $validation = Verifynumber($data);
	   throw Class::Throwable::Simple("ERROR: barcode is not the correct type")
	       unless $validation->{Process} eq 'Good'; 
	   $self->_isDuplicateData($entry,$validation->{Prefix}.$validation->{Number});
       };
    if(UNIVERSAL::isa($@,'Class::Throwable::Simple')) {
	warn "Found Class::Throwable::Simple - throwing up\n";
	throw $@;
    }
    if($@){
	warn "Croak'ing now\n";
	croak $@;
    }
    return "$validation->{Type}$validation->{Number}";
}


########################################################################
## Method to check for duplicate data in entry widgets. Entry widgets
## are only checked for duplicate data if the _duplicateData flag is
## set to false. Whilst the _duplicateData flag is set to false the
## entries populated are added to a hash that is checked each time a
## new entry has data entered into it.
########################################################################
sub _isDuplicateData {
    my ($self,$thisEntry,$verifiedData) = @_;
    return if $self->{_duplicateData};
    my $eData = $thisEntry->get;
    return unless $eData;
    ## Add the current entry and its data to the 
    if(!exists($self->{_entryDuplicationData}{$thisEntry})){
	$self->{_entryDuplicationData}{$thisEntry} = [$thisEntry,$eData];
    }
    ## Check the entries previously stored in the hash for duplicity.
    foreach my $entryHash (keys %{$self->{_entryDuplicationData}}) {
	my $entry       = $self->{_entryDuplicationData}{$entryHash}->[0];
	my $data        = $self->{_entryDuplicationData}{$entryHash}->[1];
	if($entry eq $thisEntry) {
	    ## This is the same entry as the one we are checking, the
	    ## data it holds may require updating.
	    unless($eData eq $data){
		warn "Entries data has changed - setting data from '$data' to '$eData'\n";
		$self->{_entryDuplicationData}{$entryHash}->[1] = $eData;
	    }
	    next;
	}

	## We have a possible duplicate, but we have to check that the
	## data hasn't changed since it was captured last.
	if($data eq $eData) {
	    warn "Found a possible duplication: '$eData' -> '$data'\n";
	    my $currentData = $entry->get;
	    warn "Comparing the stored data to the current data: '$data' -> '$currentData'\n";
	    if($data =~ /^$currentData/) {
		throw Class::Throwable::Simple("ERROR: you have already entered '$data'");
	    }
	}
    }


}


########################################################################
## Method to process the data entered by a user. The data is considered
## valid (see the _validateData mathod) and ready for processing by the
## Requirement object. The data is passed to the Requirement associated
## with the entry containing the data. The data is passed through a
## checking function that verifies that the data matches any
## pre-defined criteria.  The Requirement object is then passed to the
## InputController. The InputController attempts to execute a lookup
## associated with the data type. The lookup data is stored in the
## Requirement object in preparation for the arraying process.
########################################################################
sub _processData {
    my ($self,$requirement,$data) = @_;
    $requirement->setData($data);
    $self->{_inputController}->process($requirement);
}


########################################################################
## Method callback that allows the user to select a region of entries.
## A region of entries is selected by pressing and holding the ctrl
## button on the keyboard, then selecting the checkbutton of the start
## entry of the required region followed by the end entry.  All entries
## between, and including, the start and end entry will be selected.
########################################################################
sub _multiSelect {
    my ($self,$checkBttn,$index) = @_;
    if(defined $self->{_multiSelectIndex}) {
	my $start = $index;
	my $end   = $self->{_multiSelectIndex};
	if($index > $self->{_multiSelectIndex}) {
	    $start = $self->{_multiSelectIndex};
	    $end   = $index;
	}
	foreach my $i ($start..$end) { $self->{_checkBttnWidgets}->[$i]->{'Value'} = $self->{_multiSelectValue}; }
	$self->{_multiSelectIndex} = undef;
	return;
    }
    $self->{_multiSelectIndex} = $index;
    $self->{_multiSelectValue} = $checkBttn->{'Value'};
}


########################################################################
## Method that defines the characteristics of an errored widget. This
## method is called when a widget is first found to contain an
## error. The widget background is altered to red and the console bell
## is sounded. The widget reverts to its previous state after 4
## seconds.
########################################################################
sub _widgetError {
    my $widget = shift;
    my $previousColour = $widget->cget(-bg);
    $widget->configure(-bg=>'red');
    $widget->idletasks; 
    $widget->bell; 
    $widget->after(400);
    $widget->configure(-bg=>$previousColour);
}


########################################################################
## Method to insert a piece of data into an entry box. This method is 
## called as part of the auto focus process.
########################################################################
sub _insertEntry {
    my ($entryWidget,$data) = @_;
    warn "*** Widget is '$entryWidget'\n";
    my $state = $entryWidget->cget(-state);
    warn "*** Entry widget is currently at state '$state'\n";
    unless($state eq 'normal') {
	warn "*** Configuring the state of widget to normal from '$state'\n";
	$entryWidget->configure(-state=>'normal');
    }
    $entryWidget->delete(0,'end');
    $entryWidget->insert(0,$data);
    unless($state eq 'normal') {
	warn "*** Returning widget to state '$state'\n";
	$entryWidget->configure(-state=>$state);
    }
}


########################################################################
## Method that returns the largest width of all the Requirement objects
## description attributes.
########################################################################
sub _getMaxWidth {
    my $self = shift;
    my $max = 0;
    foreach my $requirementContainer (@{$self->{_requirementContainerList}}) {
	foreach(@{$requirementContainer->getRequirementList}){
	    if((my $len = length($_->getDescription())) > $max) {
		$max = $len;
	    }
	}
    }
    return $max + 2;
}


########################################################################
## Method to alter that state of all checkbutton widgets to state $state.
## This methid us used to select and deselect all of the checkbutton 
## widgets.
########################################################################
sub _changeState {
    my ($self,$state) = @_;
    return unless @{$self->{_checkBttnWidgets}};
    foreach(@{$self->{_checkBttnWidgets}}) {
	$_->select   if !$state && !$_->{'Value'};
	$_->deselect if  $state &&  $_->{'Value'};
	$_->invoke();
    }
}


########################################################################
## Method to clear the selected entries. An entry is selected if its 
## checkbutton is selected.
########################################################################
sub _clearSelected {
    my $self = shift;
    my $rcList = $self->{_requirementContainerList};
    for(my $rci=0; $rci < scalar(@{$rcList}); $rci++) {
	my $linkedData  = $rcList->[$rci]->getLinkedData;
	foreach my $lData (@{$linkedData}) {
	    my $checkButton = $lData->[3];
	    if($checkButton->{'Value'}) {
		my $requirement = $lData->[0];
		my $entry       = $lData->[2];
		$entry->delete(0,'end');
		$requirement->clearData;
	    }
	}
    }
}


1;


=head1 NAME

SITk::RequirementDisplayer - A mega widget that displays and gathers
data for APE::InputController::Requirement objects that are based
on a single process in the GT process tables.

=head1 SYNOPSIS

use Tk;
use SITk::RequirementDisplayer;

my $mw = MainWindow->new();

my $requirementDisplayer = 
    RequirementDisplayer(-atomicProcessContainer => $apc,
                         -parentDesc  => "The tract name of this process",
                         -description => "A description of this process",
                         -wrap => 0);

$requirementDisplayer->pack(-fill=>'both',-expand=>1);

MainLoop;

=head1 Description

This widget uses the InputController attached to the
APE::AtomicProcessContainer object to create the Requirement
objects used to execute the process. The
APE::InputController::Requirement objects are associated with
entry widgets and displayed to the user. The user is required to
complete the Requirements before submitting them for processing.

Database lookups are generated and executed based on the inputed data
type. The returned data is then used in the arraying process in
APE. The result is a list of APE::FlushController::Result objects
that represent the newly created entities in the database. Each of the
Result objects has an OutputController attached to it - see
APE::OutputController for more information.

=head2 OPTIONS

=over 10

=item -atomicProcessContainer

This is a APE::AtomicProcessContainer object that contains the
APE::ArrayingEntity objects used to execute the process. It also
has a APE::InputController object attached to it that creates the
APE::InputController::Requirement objects that denote the
required data from the user to execute the process.

=item -parentDesc

This is a description of the tract that the process belongs to. This
description is displayed above the requirements and the -description.

=item -description

This is a description of the process being executed and is displayed
below the -parentDesc in a large font.

=item -wrap

This is a boolean option. If true then when data is entered into the
last entry focus will shift to the first entry in the first
APE::InputController::RequirementContainer. If false then the
focus will not change from the last entry in the last
APE::InputController::RequirementContainer.

=item -resultcommand

Specifies a perl/Tk callback to associate with the completed execution
of the process. This callback is made when the process has been
successfully called and is passed the list of
APE::FlushController::Result objects.

=back

=head2 ADVERTISED

=over 10

=item bttnFrame

This is the frame containing the buttons. Add further buttons to this frame.

=item entryWidgets

A list of the entry widgets that are associated with the Requirement objects.

=item checkBttnWidgets

A list of the Checkbutton widgets located next to each of the entry widgets.

=back

=head1 AUTHOR

Simon Holroyd <holroyd@sanger.ac.uk>

=cut




