package GTx::APE::InputController::Requirement;

use strict;
use warnings;
use Carp;

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

{
    my %_attributes = ( 
			default             => undef,
			arrayingEntityIndex => undef,
			atomicProcessIndex  => undef,
			type                => undef,
			description         => undef,
			data                => undef,
			dataStore           => undef,
			checkingCode        => undef,
		       );

    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 arrayingEntityIndex must be set.
	croak "ERROR: attribute 'arrayingEntityIndex' has not been set."
	    unless defined $object{ $self }->{arrayingEntityIndex};

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

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

	## 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;
    }


    #################################################################
    ## Method to set the data input required.
    #################################################################
    sub setData {
	my ($self,$data) = @_;
 	if($object{ $self }->{default} && !$data) 
	{ $data = $object{ $self }->{default}; }
	$object{ $self }->{data} = undef;
	$object{ $self }->{data} = $data;
	eval   { $self->checkData(); };
	if($@) { croak $@;           }
    }

    
    #################################################################
    ## Method to sanity check the data attribute. 
    #################################################################
    sub checkData {
	my $self = shift;
	if(ref($self->getCheckingCode()) eq 'Regexp') {
	    croak "ERROR: incorrect format\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";
    }

    
    #################################################################
    ## Method to set the dataStore attribute. The dataStore is used
    ## for any general data that this object should store.
    #################################################################
    sub setDataStore {
	my ($self,$dataStoreData) = @_;
	$object{ $self }->{dataStore} = $dataStoreData;
    }


    #################################################################
    ## Method to set the description attribute. This may be set after
    ## the object is instatiated if the Requirement object is based on
    ## a group of objects where one decides the description but all
    ## must be considered.
    #################################################################
    sub setDescription {
	my ($self,$description) = @_;
	$object{ $self }->{description} = $description;
    }


    #################################################################
    ## Method to push additional indexes to the arrayingEntityIndex and
    ## the atomicProcessIndex attributes.
    #################################################################
    sub pushIndexes {
	my ($self,$arrayingEntityIndex,$atomicProcessIndex) = @_;
	croak "ERROR: Attribute arrayingEntityIndex was not initialised as an array." 
	    unless ref($object{ $self }->{arrayingEntityIndex}) eq 'ARRAY';
	croak "ERROR: Attribute atomicProcessIndex was not initialised as an array." 
	    unless ref($object{ $self }->{atomicProcessIndex})  eq 'ARRAY';
	my $aeCount = push(@{$object{ $self }->{arrayingEntityIndex}},$arrayingEntityIndex);
	my $apCount = push(@{$object{ $self }->{atomicProcessIndex }},$atomicProcessIndex );
	return [$aeCount,$apCount];
    }


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

1;
