package GTx::APE::ArrayingEntity;

use strict;
use warnings;
use Carp;

use GTx::APE::ArrayingEntity;

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


{
    my %_attributes = (
		       parentProcessId   => undef,
		       flushController   => undef,
		       outPrefix         => undef,
		       outConcreteEntity => undef,
		       outDescription    => undef,
		       outFormat         => undef,
		       sessionId         => undef,
		       inPrefixList      => [],
		       atomicProcessList => [],

		       allowMissingArrayData => 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
    ## ArrayingEntity object.
    #################################################################
    sub new {
	no strict 'refs';
	my ($proto,%args) = @_;
	
	my $class = ref($proto) || $proto;
	my $self = bless {}, $class;
	
	%args = $self->_init(%args);

	my @leftover = keys %args;

	confess "Error: @leftover" 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};
	    }
	}

	## Set the allowMissingArrayData flag if it isn't set already.
	$object{ $self }->{allowMissingArrayData} = FALSE
	    unless defined $object{ $self }->{allowMissingArrayData};

	return %args;
    }

    
    #################################################################
    ## Method to summarise the AtomicProcess objects stored in this
    ## container in to the in's and out's.
    #################################################################
    sub getSummary {
	my $self = shift;
	my @summary = ();
	my %lookup  = ();
	my %count   = ();
	foreach my $ap (@{$object{ $self }->{atomicProcessList}}) {
	    if(!exists($lookup{in}{ $ap->getInConcreteEntity() })) { 
		$lookup{in}{ $ap->getInConcreteEntity() }++;
		$count {in}{ $ap->getInDescription() }++;
	    }
	    if(!exists($lookup{out}{ $ap->getOutConcreteEntity() })) { 
		$lookup{out}{ $ap->getOutConcreteEntity() }++;
		$count {out}{ $ap->getOutDescription() }++;
	    }
	}
	foreach my $io (sort keys(%count)) {
	    foreach my $desc (keys(%{$count{$io}})) {
		push( @summary, sprintf("%-3s - %-5d X %-s",$io,$count{$io}{$desc},$desc) );
	    }
	}
	
	return \@summary;
    }
    

    #################################################################
    ## Method to add a new AtomicProcess object to this objects
    ## atomicProcessList.
    #################################################################
    sub newAtomicProcess {
	my ($self,$atomicProcess) = @_;
	$object{ $self }->{outConcreteEntity} = $atomicProcess->getOutConcreteEntity();
	push(@{$object{ $self }->{inPrefixList}}, $atomicProcess->getInPrefix());
 	push(@{$object{ $self }->{atomicProcessList}}, $atomicProcess);
    }


    #################################################################
    ## Method to return the number of AtomicProcess objects in the
    ## atomicProcessList.
    #################################################################
    sub getAtomicProcessCount {
	my $self = shift;
	return scalar(@{$object{ $self }->{atomicProcessList}});
    }


    #################################################################
    ## Method to add a FlushController object to this ArrayingEntity
    ## object. See the FlushController for more information.
    #################################################################
    sub addFlushController {
	my ($self,$flushControllerClass) = @_;
	$object{ $self }->{flushController} = undef;
	$object{ $self }->{flushController} = $flushControllerClass;
    }

    
    #################################################################
    ## Method to signify the begining of a transaction to the attached
    ## FlushController object.  See the FlushController for more
    ## information.
    #################################################################
    sub beginTransaction {
	my $self = shift;
	print STDERR "ArrayingEntity: beginTransaction\n";
	eval  { $self->getFlushController()->beginTransaction(); };
	if($@){ croak $@;                                        }
    }


    #################################################################
    ## Method to flush an array pattern to the attached FlushController
    ## object. See the FlushController for more information.
    #################################################################
    sub flush {
	my $self = shift;
	print STDERR "ArrayingEntity: flush\n";
	if($self->hasArrayingData()) {
	    my $result;
	    eval  { $result = $self->getFlushController()->flush(); };
	    if($@){ croak $@;                                       }
	    else  { return $result;                                 }
	}else{
	    print STDERR "ArrayingEntity is missing arraying data.\n";
	    if($object{ $self }->{allowMissingArrayData}) {
		## Arraying data is missing but this object allows this functionality - continue.
		warn "*** WARNING: arraying data is missing - ArrayingEntity object is ignoring flush call.\n";
		return undef;
	    }else{
		## Arraying data is missing and this object does NOT allow this functionality - croak/die.		
		croak "ERROR: arraying data is missing - this ArrayingEntity object " . 
		    "does not allow this functionality - " . 
		    $object{ $self }->{parentProcessId}, "\n";
	    }
	}
    }


    #################################################################
    ## Method to rollback an unsuccessful transaction. Calls the
    ## attached FlushController objects rollbackTransaction that can do
    ## whatever the programmer wants. See the FlushController for more
    ## information.
    #################################################################
    sub rollbackTransaction {
	my $self = shift;
	print STDERR "ArrayingEntity: rollbackTransaction\n";
	eval  { $self->getFlushController()->rollbackTransaction(); };
	if($@){ croak $@;                                           }
    }


    #################################################################
    ## Method to commit a transaction that has been completed
    ## successfully.  Calls the attached FlushController objects
    ## commitTransaction method that can do whatever the programmer
    ## wants. See the FluchController for more information.
    #################################################################
    sub commitTransaction {
	my $self = shift;
	print STDERR "ArrayingEntity: commitTransaction\n";
	eval  { $self->getFlushController()->commitTransaction(); };
	if($@){ croak $@;                                         }
    }


    #################################################################
    ## Method to return boolean if a FlushController object is already
    ## attached to this ArrayingEntity object.
    #################################################################
    sub hasFlushController {
	my $self = shift;
	return defined $object{ $self }->{flushController};
    }


    #################################################################
    ## Method to check if all arraying data has been inputed.
    #################################################################
    sub hasArrayingData {
	my $self = shift;
	foreach my $atomicProcess (@{$object{ $self }->{atomicProcessList}}) {
	    return FALSE unless $atomicProcess->hasArrayingData();
	}
	return TRUE;
    }


    #################################################################
    ## Method to set the session id to be used by this objects
    ## FlushController.
    #################################################################
    sub setSessionId {
	my ($self,$sessionId) = @_;
	croak "ERROR: argument 'sessionId' is missing.\n" unless $sessionId;
	print STDERR "Setting sessionId to '$sessionId'\n";
	$object{ $self }->{sessionId} = $sessionId;
    }


    #################################################################
    ## Method to set the allowMissingArrayData flag attribute. If set
    ## to FALSE and a single ArrayPattern object is missing data then
    ## the flush method will fail to call the FlushController objects
    ## flush method and an exception will be thrown.
    #################################################################
    sub setAllowMissingArrayData {
	my ($self,$state) = @_;
	$object{ $self }->{allowMissingArrayData} = $state ? TRUE : FALSE;
	print STDERR "Set allowMissingArrayData to: >", $object{ $self }->{allowMissingArrayData}, "<\n";
    }


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

1;
