package GTx::APE::InputController;

BEGIN {
    #$ENV{WRAPDBI_TEST_CONFIG} = "/nfs/team71/usg/holroyd/badger-cvs/GTx/APE/DBlogs";
    $ENV{DEBUG_WRAPDBI} = 1;
};


use strict;
use warnings;
use Carp;
use SqlEngine2;
use Class::Throwable;

use GTx::APE::InputController::Requirement;

use constant LOGIN => 'snp';

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

$Class::Throwable::Debug = 1;
$SqlEngine2::verbosity   = 1;

{
    my %_attributes = (
		       description              => undef,
		       atomicProcessContainer   => undef,
		       default                  => undef,
		       sqlEngineObj             => undef,
		       requirementList          => [],
		       completedRequirementList => [],
		       );

    my %object;

    ## Autoloader wannabe. Inserts the sub calls that I want to be
    ## accessible into the symbol table.
    foreach my $attName (keys(%_attributes)) {
	no strict 'refs';
	*{__PACKAGE__ . "::get\u$attName"} = sub { $object{ $_[0] }->{$attName} }
    }

    
    #################################################################
    ## Constructor method for this object. Returns a new
    ## FlushController object.
    #################################################################
    sub new {
	my ($proto,%args) = @_;
	
	my $class = ref($proto) || $proto;
	my $self  = bless {}, $class;
	
	%args = $self->_init(%args);
	
	my @leftover = keys %args;
	
	confess "Error: the following arguments are unknown - @leftover\n" if @leftover;
	
	return $self;
    }


    #################################################################
    ## Initialise the objects private attributes. The argument is
    ## deleted as it is found, initialised and set.
    #################################################################
    sub _init {
	my ($self,%args) = @_;
	foreach my $attName (keys(%args)) {
	    if(exists($_attributes{$attName})) {
		$object{ $self }->{$attName} = delete $args{$attName};
	    }
	}
	
	## Attribute description must be set.
	croak "ERROR: attribute 'description' must be set."
	    unless $object{ $self }->{description}; 
	
	## Attribute sqlEngineObj must be set. Create a new object if
	## one isn't passed.
	$object{ $self }->{sqlEngineObj} = new SqlEngine2()
	    unless $object{ $self }->{sqlEngineObj};

	return %args;
    }


    #################################################################
    ## Method to create the requirements based on the contents of the 
    ## AtomicProcessContainer.
    #################################################################
    sub createRequirements {
	my $self = shift;
	print STDERR "Creating Requirement objects now....\n";
	my $atomicProcessContainer = ${$self->getAtomicProcessContainer()};
	print STDERR "GOT: ", $atomicProcessContainer->getParentProcessId(), "\n";
	my $arrayingEntityList     = $atomicProcessContainer->getArrayingEntityList();
	print STDERR "ArrayingEntityList has ", scalar(@{$arrayingEntityList}), " ArrayingEntity objects\n";
	for(my $aei=0; $aei < @{$arrayingEntityList}; $aei++) {
	    my $atomicProcessList = $arrayingEntityList->[$aei]->getAtomicProcessList();
	    for(my $api=0; $api < @{$atomicProcessList}; $api++) {
		my $description = $atomicProcessList->[$api]->getInDescription();
		my $position    = " [". ($aei+1) . "\/".($api+1)."]";
		my $default     = "[" . $self->getDefault() . "]" if $self->getDefault();
		$description    = $description . " - (".$atomicProcessList->[$api]->getInPrefix().")";
		$description    = $description . $position;
		$description    = $description . $default if $default;
		$self->pushRequirement( new GTx::APE::InputController::Requirement
					(default            =>$self->getDefault(),
					 arrayingEntityIndex=>$aei,
					 atomicProcessIndex =>$api,
					 type               =>$atomicProcessList->[$api]->getInPrefix(),
					 description        =>$description . ": "));
		print STDERR "Created a new Requirement: $description\n";
	    }
	}
    }


    #################################################################
    ## Method to process a Requirement object. The default action is  
    ## to process Requirement objects one at a time. Complete Requirement
    ## objects are pushed to the completeRequirementList. Requirement
    ## objects with duplicat data fields are not allowed by default.
    ## For a list of prefix types that this process method can lookup
    ## please see the InputController/DefaultController.sql_lib.
    #################################################################
    sub process {
	my ($self,$requirementObj) = @_;
	## Check for duplicate entries. Default = no duplicates.
	if($self->isDuplicateData($requirementObj)) {
	    croak "ERROR: '", $requirementObj->getData(), "' has already been entered.\n";
	}
	my $completedRequirementObj = eval { $self->getData($requirementObj); };
	if($@){ croak $@; }

	## Push this Requirement object to the completed list.
	$self->pushCompletedRequirement($completedRequirementObj);

	## Check if this is the last Requirement object - point of no
	## return.
	if($self->getRequirementCount() == $self->getCompletedRequirementCount()) {
	    ## Set the sessionId foreach ArrayingEntity via the AtomicProcessContainer.
	    eval  { ${$self->getAtomicProcessContainer()}->setSessionId($self->getSessionId()); };
	    if($@){ croak "ERROR: can't set the sessionId: $@\n";                               }
	}

	## Array the data from this Requirement object.
	$self->arrayData($completedRequirementObj);
    }

    
    #################################################################
    ## Method to complete a generic arraying of an AtomicProcess
    ## object. This method does not know how to deal with Requirement
    ## objects that have ArrayingEntityIndex and/or AtomicProcessIndex
    ## array types - over-ride this method in a specialised
    ## InputController if you want to deal with this.
    #################################################################
    sub arrayData {
	my ($self,$requirementObj) = @_;
	return if $requirementObj->getType() eq 'Input';
	## Find the parentage of this Requirement object.
	my $arrayingEntityIndex    = $requirementObj->getArrayingEntityIndex();
	my $atomicProcessIndex     = $requirementObj->getAtomicProcessIndex();
	my $atomicProcessContainer = ${$self->getAtomicProcessContainer()};
	my $arrayingEntity         = $atomicProcessContainer->getArrayingEntityList()->[$arrayingEntityIndex];
	my $atomicProcess          = $arrayingEntity->getAtomicProcessList()->[$atomicProcessIndex];
	## Array the data to the AtomicProcess objects ArrayPattern
	## objects.
	$atomicProcess->setArrayingData($requirementObj->getData(),
					$requirementObj->getDataStore());
	## Verify the arrayed data integrity.
	$self->verifyArrayingData($atomicProcess);
    }


    #################################################################
    ## Method to verify the integrity of the arrayed data. Add generic
    ## checks here.
    #################################################################
    sub verifyArrayingData {
	my ($self,$atomicProcess) = @_;
	## Check the consistency of the arrayed data.
	if(my $arrayPattern = $atomicProcess->isArrayedDataInconsistent()) {
	    croak "FATAL ERROR: ArrayPattern with outMapId '",
	    $arrayPattern->getOutMapId(), "' attached to AtomicProcess '",
	    $atomicProcess->getProcessId(), "' is inconsistent - outData count = '",
	    scalar(@{$arrayPattern->getOutData()}), "'\n";
	}
    }


    #################################################################
    ## Method to get the data associated with well known entity types.
    ## For a list of well known entity types please see the sql library
    ## InputController/DefaultController.sql_lib.
    #################################################################
    sub getData {
	my ($self,$requirementObj) = @_;
	## Split the data. Expects a plate name i.e. EP1234.
	my ($prefix,$id) = $requirementObj->getData() =~ /^(\w\w)(\d+)$/;
	my $sqlName      = $requirementObj->getType() . '_lookup';
	## Get data down to the AtomicProcess.
	my $arrayingEntityIndex    = $requirementObj->getArrayingEntityIndex();
	my $atomicProcessIndex     = $requirementObj->getAtomicProcessIndex();
	## The list may be an array, just check the first index and
	## assume the others are the same.
	if(ref($arrayingEntityIndex) eq 'ARRAY') {
	    $arrayingEntityIndex = $arrayingEntityIndex->[0];
	    $atomicProcessIndex  = $atomicProcessIndex->[0];
	}
	my $atomicProcessContainer = ${$self->getAtomicProcessContainer()};
	my $arrayingEntity         = $atomicProcessContainer->getArrayingEntityList()->[$arrayingEntityIndex];
	my $atomicProcess          = $arrayingEntity->getAtomicProcessList()->[$atomicProcessIndex];

	## Execute the SQL.
	my $lookupData = eval { 
	    $self->getSqlEngineObj()->getAll('GTx/APE/InputController/DefaultController::'. $sqlName,
					     [$id],
					     SqlEngine2::getDbh(LOGIN)); };

	if($@) { 
	    croak "ERROR: can't execute sql '$sqlName' - I probably " . 
		"don't know how to deal with a '$prefix' - you should " . 
		"attach a specialised InputController: $@\n";  
	}
	
	if(scalar(@{$lookupData})==0) { 
	    croak "ERROR: nothing found using '$prefix$id'.\n"; 
	}

	my $inFormat = $atomicProcess->getInFormat();
	## Check that the number of rows returned equals the
	## AtomicProcess inFormat attribute. 
	print STDERR "Testing format: ", scalar(@{$lookupData}), " = $inFormat\n";
	unless(scalar(@{$lookupData}) == $inFormat) {
	    croak "ERROR: '$prefix$id' appears to be a partial plate - required format is '$inFormat' " . 
		"format found is '",scalar(@{$lookupData}),"'\n";
	}


	## Set the lookup data in the Requirement.
	$requirementObj->setDataStore($lookupData);
	return $requirementObj;
    }

    
    #################################################################
    ## Method to get a session id for this input. Called by this
    ## objects arrayData method. Can be overridden. Default action is
    ## to get a new sessionId and return it unless this objects private
    ## sessionId attribute is set (use setSessionId()) in which case
    ## that is returned. This allows the programmer to determine the
    ## assignment of a sessionId to the ArrayingEntity (as shown in
    ## this objects arrayData method).
    #################################################################
    sub getSessionId {
	my $self = shift;
	return $object{ $self }->{sessionId} if $object{ $self }->{sessionId};
	my $sessionId = 
	    eval { $self->getSqlEngineObj()->getRow('ExoSeq::next_session',
						    [],SqlEngine2::getDbh(LOGIN)); };
	if($@) { croak $@;          }
	else   { return $sessionId; }
    }


    #################################################################
    ## Method to set the sessionId attribute for this object.
    #################################################################
    sub setSessionId {
	my ($self,$sessionId) = @_;
	croak "ERROR: argument 'sessionId' is missing.\n" unless $sessionId;
	croak "ERROR: argument 'sessionId' must be numeric.\n" unless $sessionId =~ /^\d+$/;
	$object{ $self }->{sessionId} = $sessionId;
    }


    #################################################################
    ## Method to delete the sessionId private attribute.
    #################################################################
    sub deleteSessionId {
	my $self = shift;
	return delete $object{ $self }->{sessionId};
    }


    #################################################################
    ## Method to check for duplicate data attributes in the completed
    ## Requirement list attribute (completeRequirementList).
    ## Return TRUE if the data is duplicated.
    #################################################################
    sub isDuplicateData {
	my ($self,$requirementObj) = @_;
	confess "ERROR: wrong type\n" unless $requirementObj->isa('GTx::APE::InputController::Requirement');
	return if $requirementObj->getType() eq 'Input';
	foreach my $req (@{$object{ $self }->{completedRequirementList}}) {
	    unless($req->getType() eq 'Input') {
		if($req->getData() eq $requirementObj->getData()) {
		    return TRUE;
		}
	    }
	}
    }

    
    #################################################################
    ## Method to get the number of Requirement objects in the list.
    #################################################################
    sub getRequirementCount {
	my $self = shift;
	return scalar(@{$object{ $self }->{requirementList}});
    }


    #################################################################
    ## Method to get the number of completed Requirement objects in the list.
    #################################################################
    sub getCompletedRequirementCount {
	my $self = shift;
	return scalar(@{$object{ $self }->{completedRequirementList}});
    }


    #################################################################
    ## Method to push a new Requirement object to the list.
    #################################################################
    sub pushRequirement { 
	my ($self,$requirementObj) = @_;
	return push(@{$object{ $self }->{requirementList}}, $requirementObj);
    }


    #################################################################
    ## Method to push a new Requirement object to the list.
    #################################################################
    sub pushCompletedRequirement { 
	my ($self,$requirementObj) = @_;
	return push(@{$object{ $self }->{completedRequirementList}}, $requirementObj);
    }


    #################################################################
    ## Method to pop a Requirement object off the list.
    #################################################################
    sub popRequirement {
	my $self = shift;
	return pop(@{$object{ $self }->{requirementList}});
    }


    #################################################################
    ## Method to pop a Requirement object off the list.
    #################################################################
    sub popCompletedRequirement {
	my $self = shift;
	return pop(@{$object{ $self }->{completedRequirementList}});
    }


    #################################################################
    ## Method to shift a Requirement object off the list.
    #################################################################
    sub shiftRequirement {
	my $self = shift;
	return shift(@{$object{ $self }->{requirementList}});
    }
    
 
    #################################################################
    ## Method to shift a Requirement object off the list.
    #################################################################
    sub shiftCompletedRequirement {
	my $self = shift;
	return shift(@{$object{ $self }->{completedRequirementList}});
    }


    #################################################################
    ## Method to unshift (opposite of shift) a Requirement object to
    ## the list.
    #################################################################
    sub unshiftRequirement {
	my ($self,$requirementObj) = @_;
	return unshift(@{$object{ $self }->{requirementList}},$requirementObj);
    }


    #################################################################
    ## Method to unshift (opposite of shift) a Requirement object to
    ## the list.
    #################################################################
    sub unshiftCompletedRequirement {
	my ($self,$requirementObj) = @_;
	return unshift(@{$object{ $self }->{completedRequirementList}},$requirementObj);
    }


    #################################################################
    ## Method to insert a new Requirement object at index.
    #################################################################
    sub insertRequirement {
	my ($self,$requirementObj,$index) = @_;
	return splice(@{$object{ $self }->{requirementList}},$index,$index,$requirementObj);
    }


    #################################################################
    ## Method to insert a new Requirement object at index.
    #################################################################
    sub insertCompletedRequirement {
	my ($self,$requirementObj,$index) = @_;
	return splice(@{$object{ $self }->{completedRequirementList}},$index,$index,$requirementObj);
    }


    #################################################################
    ## Method to delete a Requirement object at index.
    #################################################################
    sub deleteRequirement {
	my ($self,$index) = @_;
	return delete($object{ $self }->{requirementList}->[$index]);
    }


    #################################################################
    ## Method to delete a Requirement object at index.
    #################################################################
    sub deleteCompletedRequirement {
	my ($self,$index) = @_;
	return delete($object{ $self }->{completedRequirementList}->[$index]);
    }


    #################################################################
    ## Method to destory this object.
    #################################################################
    sub DESTROY { 
	my $self = shift;
	delete $object{ $self };
    }
}

1;
