package APE::InputController::PRIMERCOUNT_InputController;

use base 'APE::InputController';

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

use APE::InputController::Requirement;

use constant LOGIN => 'snp';

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

{
    my %_attributes = ( 
			## ** Add your object attributes here **
			## They will automatically be given a get method.
			## e.g. attribute 'personForename' can be accessed
			## using getPersonForname(). There are no automatic 
			## set routines, they must be declared or the attribute 
			## value must be parsed in the constructor 
			## i.e new InputController(personForename=>'Simon');
			primerCount => undef
		       );

    my %object;
    
    foreach my $attName (keys(%_attributes)) {
	no strict 'refs';
	*{__PACKAGE__ . "::get\u$attName"} = sub { $object{ $_[0] }->{$attName} }
    }


    #################################################################
    ## 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};
		warn "*** SET $attName = $object{ $self }->{$attName}\n";
	    }
	}  
 
	## We require the primer count to be set.
	croak "ERROR: argument primerCount is missing" 
	    unless $object{ $self }->{primerCount};

	## Set the description as this is a specialised InputController.
	$args{description} = "An InputController that can distinguish between an EP sense and an ".
	    "EP antisense plate and perform a lookup in SNP to retrieve information on them.";

	return $self->SUPER::_init(%args);
    }
    

    #################################################################
    ## Overridden method from InputController base class.
    #################################################################
    sub createRequirements {
	my $self = shift;
	## Create the Requirement objects just once.
	return if $self->hasRequirements();
	## Call the super classes createRequirements method to get the
	## basic requirements.
	$self->SUPER::createRequirements();
	my $primerCount = $self->getPrimerCount;
	my $sqlEngineObj = $self->getSqlEngineObj;
	warn "Primer count: $primerCount\n";
	foreach my $rc (@{$self->getRequirementContainerList()}) {
	    next if $rc->isInput();
	    foreach my $requirement (@{$rc->getRequirementList()}) {
		next if $requirement->isInput();
		$requirement->setCheckingCode
		    ($self->getPrimerCountCheckingCode($sqlEngineObj,$primerCount));
	    }
	}
    }   


    #################################################################
    ## Method that returns a code ref that checks for the correct
    ## number of primers.
    #################################################################
    sub getPrimerCountCheckingCode {
	my ($self,$sqlEngineObj,$primerCount) = @_;
	return sub {
	    my ($self,$data) = @_;
	    ## self is this Requirement object, data is the
	    ## entered data i.e. the plate name.
	    my ($prefix,$id) = $data =~ /^(\w\w)(\d+)/;
	    my $requiredType = $self->getType;
		    throw Class::Throwable::Simple("ERROR: '$data' is not type '$requiredType'")
			unless $prefix eq $requiredType;
	    my $dbPrimerCount =
		eval { $sqlEngineObj->getRow('APE/InputController/PRIMERCOUNT_InputController::PrimerCount',
					     [$id],SqlEngine2::getDbh(LOGIN)); };
	    throw Class::Throwable::Simple("ERROR: problems finding the number of ".
					   "primers on plate '$data': $@") if $@;
	    warn "GOT PRIMER COUNT FROM DB: $dbPrimerCount\n";
	    unless($primerCount == $dbPrimerCount) {
		throw Class::Throwable::Simple("ERROR: found $dbPrimerCount primers on plate '$data'".
					       " - expected: $primerCount");
	    }
	}
    }


    #################################################################
    ## Method to destroy this object.
    #################################################################
    sub DESTROY {
	my $self = shift;
	delete $object{$self};
	$self->SUPER::DESTROY;
    }
}

1;
