package APE::InputControllerFactory::ConcreteInputController::Requirement;

$APE::InputControllerFactory::ConcreteInputController::Requirement::VERSION = '1.2';

use strict;
use warnings;
use Carp;

=head1 NAME

APE::InputControllerFactory::ConcreteInputController::Requirement -
represents an arraying process requirement.

=head1 SYNOPSIS


=head1 DESCRIPTION

This class represents a single requirement in an arraying process. The
requirement can be for an entity or a user input.

=head1 CONSTANTS

=over 5

=item TRUE

Boolean true.

=cut

use constant TRUE => 1;


=item FALSE

Boolean false.

=cut

use constant FALSE => 0;

{

=back

=head1 CONSTRUCTOR

The following arguments can be passed to the constructor.

=over 5

=item id

Optional. The unique id number of this Requirement.

=item default

Optional. The default value that this Requirement should use if no
other value is set.

=item type

Required. Requirements usually require entities, this is the entity
type i.e. EP for an oligo primer plate, PC for a PCR plate. The type
is used in the checkingCode that verifies input - see checkingCode
argument.

The type may also be 'Input'. This means that the Requirement should
expect user input instead of an entity. Note: the checking code must
be set when using type 'Input', otherwise the checkingCode will revert
to a pattern match on the word 'Input'.

=item description

Required. A description of what this Requirement requires.

=item checkingCode

Optional. A code ref or regular expression that will be used to check
data that is entered into this requirement. Default is to use the
'type' value in a pattern match (/^type\d+/). See the checkData()
method.

=item options

Optional. A list of options that may be selected from. This is useful
when this Requirement is being used as part of a GUI. The GUI may use
these options to create a drop down list for selection.

=back

=cut

    my %_attributes = ( 
			id                      => undef,
			default                 => undef,
			type                    => undef,
			description             => undef,
			checkingCode            => undef,
			options                 => undef,
		       );

    my %object;


=head2 INSTANTIATION PROCESS

The new method for this object calls the _init() method on $self. If
$self is a derived class then it's _init() method will be called
giving it the chance to remove any arguments it requires from the
%args hash. If there is no _init() method in the derived class then
the _init() method in this class is called.

Derived classes implementing a _init() method should return the %args
hash to the base class:

package Derived::Class;

sub _init {
   my ($self,%args) = @_;
   my $argument = delete $args{classArgument};
   return $self->SUPER::_init(%args);
}

=cut

    sub new {
	my ($proto,%args) = @_;
	my $class = ref($proto) || $proto;
	my $self  = bless {}, $class;
	%args = $self->_init(%args);
	my @leftover = keys %args;
	die "Error: the following arguments are unknown - @leftover\n" 
	  if @leftover;
	return $self;
    }


=head1 METHODS

=over 10

=item $ape->_init(%args);

Private method. This method is called by the new method during object
instantiation (see the INSTANTIATION process). The method removes any
of the arguments required by the object from the %args hash and
returns it.

See the INSTANTIATION section for information on how to use this
method in a derived class.

=cut

    sub _init {
	my ($self,%args) = @_;
	foreach my $attName (keys(%args)) {
	    if(exists($_attributes{$attName})) { 
		$object{ $self }->{$attName} = delete $args{$attName};
	    }
	}

	## Link the passed AtomicProcess to this Requirement. This
	## just means that the AtomicProcess object will use the data
	## found by this Requirement.
	if($args{atomicProcess}) {
	    $self->attach( delete $args{atomicProcess} );
	}

	## Attribute type must be set.
	croak "Error: attribute 'type' has not been set."
	    unless $object{ $self }->{type};

	## Attribute description must be set.
	croak "Error: attribute 'description' must be set."
	    unless $object{ $self }->{description};

	## Set the checking code to be a basic pattern match if it
	## hasn't been set already.
	$object{ $self }->{checkingCode} = qr/^$object{ $self }->{type}\d+$/
	    unless $object{ $self }->{checkingCode};

	return %args;
    }


=item $requirement->getId();

Returns the unique id of this Requirement.

=item $requirement->getDefault();

Returns the default selection that will be used if this Requirements
setData() method is not called with a valid piece of data.

=item $requirement->getType();

Returns this Requirements type, this may be a two letter prefix of the
type of entity expected or 'Input' to indicate that this Requirement
is waiting for user input that will pass the checkingCode.

=item $requirement->getDescription();

Returns the description of this Requirement.

=item $requirement->getOptions();

Returns the options that may be used as the data for this Requirement.

=cut

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

=item $requirement->setData([$data,[$noCheck]]);

Sets the data $data as the data to satisfy this requirement. If no
data is supplied then the default data is set. If no default data is
set then the data field is left empty and will fail the checkingCode.

The passed data, or the default if no data was passed, is checked
using the checkingCode - see the checkCode() method.

The $noCheck flag, if true, prevents this method from calling the
checkCode() method, so should be used with caution.

=cut

    sub setData {
	my ($self,$data,$noCheck) = @_;
 	if($object{ $self }->{default} && !$data)
	{ $data = $object{ $self }->{default}; }
	$self->clearData;
	$object{ $self }->{data} = $data;
	eval   { $self->checkData() unless $noCheck; };
	if($@) { croak $@;                           }
    }


=item $requirement->clearData();

Clears the data attribute value. This method is called by the
setData() method.

=cut

    sub clearData {
	my $self = shift;
	$object{ $self }->{data} = undef;
    }


=item $requirement->checkData();

Checks the data set using the setData() method with the
checkingCode. The checkingCode may be a regular expression or a code
reference.

If the checkingCode is a code reference then it is called and passed a
reference to this object and the set data in that order. The code
reference should simply return if the data passes or throw an
exception (die) if it fails.

If the checkingCode is a regular expression then it will throw and
exception (die) if the data fails.

Returns boolean false on success, otherwise an exception is thrown
(die).

=cut

    sub checkData {
	my $self = shift;
	if(ref($self->getCheckingCode()) eq 'Regexp') {
	    my $description = $self->getDescription;
	    croak "ERROR: $description - checking code failed\n"
		unless $self->getData() =~ $self->getCheckingCode();
	    return FALSE; 
	}elsif(ref($self->getCheckingCode()) eq 'CODE') {
	    eval  { &{$self->getCheckingCode()}($self,$object{ $self }->{data}); };
	    if($@){ croak $@; }
	    return FALSE;
	}
	croak "ERROR: CheckingCode for type '", $self->getType() . 
	    " is an unsupported type - ", ref($self->getCheckingCode()), "\n";
    }


=item $requirement->setCheckingCode($checkingCode);

Sets the passed checkingCode. Must be either a regular expression or a
code reference, otherwise an exception is thrown (die).

=cut

    sub setCheckingCode {
	my ($self,$checkingCode) = @_;
	croak "ERROR: checking code must be a reference ".
	  "to a reg exp or code block"
	    unless ref $checkingCode 
	      || ref $checkingCode eq 'Regexp'
		|| ref $checkingCode eq 'CODE';
	$object{ $self }->{checkingCode} =
	  $checkingCode;
    }


=item $requirement->setDataStore($data);

Sets the dataStore to the passed data. The dataStore may be used to
store general data associated with this Requirement.

=cut

    sub setDataStore {
	my ($self,$dataStoreData) = @_;
	$object{ $self }->{dataStore} = $dataStoreData;
    }


=item $requirement->getDataStore();

Returns the general data held in the dataStore attribute. Use the
setDataStore() to store data.

=cut

    sub getDataStore { $object{ $_[0] }->{dataStore} }


=item $requirement->setDescription($description);

Sets the description of this Requirement to something other than the
description used during object instantiation.

=cut

    sub setDescription {
	my ($self,$description) = @_;
	$object{ $self }->{description} = $description;
    }

=item $requirement->attach(APE::AtomicProcess);

Method to attach an AtomicProcess to an instance of this class. This
method is part of the Observer design pattern. This class is the
subject and the AtomicProcess object is the observer. When this class
finishes gathering its requirements it notifies each of its
APE::AtomicProcess objects. They may then use this classes methods to
gather the data they require to complete their part of the arraying
process.

=cut

    sub attach {
	my ($self,$atomicProcess) = @_;
	if($atomicProcess && UNIVERSAL::isa
	   ($atomicProcess,"APE::AtomicProcess")) {
	    push(@{$object{ $self }->{attachedList}},
		 $atomicProcess);
	}else{
	    die "Error: no APE::AtomicProcess object ".
	      "to attach or object is not the correct type.";
	}
	return scalar(@{$object{ $self }->{attachedList}});
    }


=item $requirement->detach(APE::AtomicProcess);

This method detaches an AtomicProcess object from an instance of this
class. See method attach() for more information on the Observer design
pattern.

Not yet implemented.

=cut

    ## XXX Needs implementing.
    sub detach {
	my ($self,$atomicProcess) = @_;
    }

=item $requirement->notify();

Method that's called when this subject objects state changes due to an
InputController reaching a state where arraying may start. This
methods passes on the state change request to its registered observer
AtomicProcess objects.

=cut

    sub notify {
	my $self = shift;
	my $atomicProcessList = $self->getAttachedList;
	foreach my $ap (@$atomicProcessList) {
	    $ap->update($self);
	}
    }


=item $requirement->getAttachedList();

Returns the list of attached APE::AtomicProcess objects.

=cut

    sub getAttachedList { $object{ $_[0] }->{attachedList} }


=item $requirement->getData();

Returns the data set into this Requirement.

=cut

    sub getData { $object{ $_[0] }->{data} }


=item $requirement->isInput();

Returns boolean true if this Requirement object is of type
'Input'. Use this method instead of checking the 'type' object
attribute as more types may appear with constants.

=cut

    sub isInput {
	my $self = shift;
	return FALSE unless defined $object{ $self }->{type};
 	if($object{ $self }->{type} eq 'Input') {
	    return TRUE;
	}
	return FALSE;
    }


=item DESTROY

Class destructor. If you derive from this class please call this
destructor from your destructor.

 package Derived::Class;

 sub new {}

 sub DESTROY {
     my $self = shift;
     $self->SUPER::DESTROY();
 }

=cut

    sub DESTROY {
	my $self = shift;
	delete $object{$self};
    }
}


=back

=head1 ALSO SEE


=head1 AUTHOR

Simon Holroyd <holroyd@sanger.ac.uk>

=cut

1;
