package GTx::APE::ArrayPattern;

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

use strict;
use warnings;
use Carp;
use SqlEngine2;

use constant LOGIN => 'gt_process';

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

{
    my %_attributes = (
		       inMapId     => undef,
		       inMapFormat => undef,
		       inRow       => undef,
		       inColumn    => undef,
		       inFormat    => undef,
		       inQuadrant  => undef,

		       outMapId    => undef,
		       outRow      => undef,
		       outColumn   => undef,
		       outFormat   => undef,
		       outQuadrant => undef,

		       outData     => [],
		       );

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

	$object{ $self }->{sqlObj} = new SqlEngine2();
	
	return %args;
    }

    
    #################################################################
    ## Protected method to alter this ArrayPattern objects inRow.
    ## N.B. Resetting the inRow means that you must reset the inMapId
    ##      as they may be used in other areas of APE.
    #################################################################
    sub _setInCoord {
	my ($self,$newInCoord) = @_;
	my ($row,$column) = $newInCoord =~ /^(\w+)(\d+)$/;
	$object{ $self }->{inRow}    = $row;
	$object{ $self }->{inColumn} = $column;
	eval  { $self->_rowColMapLookup(); };
	if($@){ croak $@;                  }
    }

    #################################################################
    ## Method to lookup the rocol_map data from the database when the
    ## row or column is reset. 
    #################################################################
    sub _rowColMapLookup {
	my $self = shift;
	my $data = eval {
 	    $object{ $self }->{sqlObj}
	    ->getAll('GTx/APE/ArrayPattern::RowColMapLookup',
		     [ $object{ $self }->{inRow},
		       $object{ $self }->{inColumn},
		       $object{ $self }->{inMapFormat} ],
		     SqlEngine2::getDbh(LOGIN)); };
	if($@ || !$data) { 
	    croak "ERROR: can't get rowcol_map lookup data using - '",
	    $object{ $self }->{inRow}, $object{ $self }->{inColumn}, 
	    "' format - ", $object{ $self }->{inFormat}, ": $@\n"; }
	
	$object{ $self }->{inMapId } = $data->[0][0];
	$object{ $self }->{inRow   } = $data->[0][1];
	$object{ $self }->{inColumn} = $data->[0][2];
	
	return TRUE;
    }
	

    #################################################################
    ## Method to set the out data. This data is the name of the
    ## physical thing that is coming from in and going to out.
    #################################################################
    sub setOutData {
	my ($self,$data) = @_;
	push(@{$object{ $self }->{outData}},$data);
    }


    #################################################################
    ## Method to clear the out data attribute value that may have been
    ## previously set using the setOutData method. 
    #################################################################
    sub clearOutData {
	my $self = shift;
	#$object{ $self }->{outData} = undef;
	$object{ $self }->{outData} = [];
    }

    
    #################################################################
    ## Method to return boolean if this ArrayPattern has out data set
    ## and so is ready for flushing.                           
    #################################################################
    sub hasOutData {
	my $self = shift;
	return scalar(@{$object{ $self }->{outData}}) ? TRUE : FALSE;
    }


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

1;
