package APE::InputControllerFactory::ConcreteInputController::COORDS2PLATE_InputController;

$APE::InputControllerFactory::ConcreteInputController::COORDS2PLATE_InputController::VERSION = '0.1';

use base qw(APE::InputControllerFactory::ConcreteInputController::STUDY_InputController);

use strict;
use warnings;

use APE::InputControllerFactory::Plugin::UniqueRequirementCreator;

=head1 NAME

APE::InputControllerFactory::ConcreteInputController::COORDS2PLATE_InputController - a concrete input controller that


=head1 SYNOPSIS

use APE::InputControllerFactory::ConcreteInputController::COORDS2PLATE_InputController

my $object = APE::InputControllerFactory::ConcreteInputController::COORDS2PLATE_InputController->new
  (
   XXX fill in options
   );


=head1 DESCRIPTION

XXX fill in description.


=head1 CONSTANTS

=over 5

=item TRUE

This is a boolean true constant.

=cut

use constant TRUE  => 1;


=item FALSE

This is a boolean false constant.

=cut

use constant FALSE => 0;


=back

=head1 CONSTRUCTOR

=over 5

=item $object = APE::InputControllerFactory::ConcreteInputController::COORDS2PLATE_InputController->new(option => value,...?);

The following arguments may be passed to the constructor so are
options for all derived classes of type Entity.

=over 5

=item example

Required. An example option.

=back

=cut

my %_attributes = ();


=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);
}

=head1 METHODS

=over 10

=item $object->_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 $arg (keys(%args)) {
	$self->{"_".$arg} = delete $args{$arg}
	  if exists $_attributes{$arg};
    }

    ## Check for required attributes.
    foreach my $requiredArg (qw//) {
	die "Error: argument '$requiredArg' is required"
	  unless $self->{"_".$requiredArg};
    }

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


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


=item $inputController->createRequirements()

Uses the UniqueRequirementCreator plugin to create Requirement objects
for each of the unique input entities. Adds a study requirement
provided by the base class. Add another requirement for the selecting
of well coordinates.

=cut

sub createRequirements {
    my $self = shift;
    return if $self->hasRequirements();
    my $requirementCreator = APE::InputControllerFactory::Plugin::UniqueRequirementCreator
      ->new(controller=>$self);
    $requirementCreator->run();
    my $inputRequirementContainer = new
      APE::InputControllerFactory::ConcreteInputController::RequirementContainer
	  (outDescription => "Well co-ordinate");
    $inputRequirementContainer->pushRequirement
      (new APE::InputControllerFactory::ConcreteInputController::Requirement
       (type         => 'Input',
	id           => 'coords',
	description  => 'Enter 4x well coords [rowcol,rowcol,..]: ',
	checkingCode => sub {
	    my ($self,$data) = @_;
	    die "Error: coords are the incorrect format - example a1,a2,a3,a4 or a1,d6,g3,h8"
	      unless $data =~ /^([a-h]([1-9]|1[012])),([a-h]([1-9]|1[012])),([a-h]([1-9]|1[012])),([a-h]([1-9]|1[012]))$/;
	}));

    $self->unshiftRequirementContainer($inputRequirementContainer);
    $self->addStudyRequirement();
}


=item $inputController->process(Requirement)

Looks for an input Requirement with an id of 'coords', splits them by
comma and stores in the objects _coords key as an array
reference. Passes each Requirement to the base classes process object
that looks for the Requirement containing the study details and calls
getData() and setData() to embed the study name for the flush
controller.

=cut

sub process {
    my ($self,$requirement) = @_;
    if($requirement->isInput() &&
       $requirement->getId() eq 'coords') {
	## The coordinates Requirement.
	my @coords = split(",",$requirement->getData());
	$self->{_coords} = \@coords;
	warn "*** Coords set: @{$self->{_coords}} ***\n";
    }
    ## Use the STUDY input controllers method to set the study id into
    ## the data - $self->setData([$data,$studyId]) or something
    ## similar - check the class.
    $self->SUPER::process($requirement);
}


=item $inputController->arrayData(Requirement)

Looks for a Requirement object with a type of EP and sends it to the
_alterArrayPattern() method. All Requirement objects are passed to the
base classes arrayData() and the results are returned.

=cut

sub arrayData {
    my ($self,$requirement) = @_;
    if($requirement->getType() eq 'EP') {
	$self->_alterArrayPatterns($requirement);
    }
    return $self->SUPER::arrayData($requirement);
}


=item $inputController->_alterArrayPattern(Requirement)

Expects the passed Requirement object to have 4x attached
AtomicProcess objects. Alters each AtomicProcess objects ArrayPattern
objects source map to each of the passed coords, i.e. AtomicProcess 1
will have its ArrayPattern objects source coordinates changed to first
passed coordinate in $self->{_coords} array reference.

=cut

sub _alterArrayPatterns {
    my ($self,$requirement) = @_;
    die "Error: coordinates for altering array patterns have not been set\n"
      unless ref $self->{_coords} eq 'ARRAY' && scalar @{$self->{_coords}} == 4;
    my $apList = $requirement->getAttachedList();
    die "Error: altering array patterns failed - expecting 4 ".
      "AtomicProcess objects, found ".scalar @$apList."\n"
      unless ref $apList eq 'ARRAY' && scalar @$apList == 4;
    for(my $i=0; $i < scalar @$apList; $i++) {
	my $coord = $self->{_coords}[$i];
	warn "*** Altering array pattern so source coord is '$coord' ***\n";
	my $atomicProcess = $apList->[$i];
	my $inFormat      = $atomicProcess->getInFormat();
	my $rowColMapData = $self->getRowColMapFromFormat($inFormat);
	my $arrayPatternHash = $atomicProcess->deleteArrayPatternHash();
	foreach my $mapId (keys(%{$arrayPatternHash})) {
	    foreach my $arrayPattern (@{$arrayPatternHash->{$mapId}}) {
		print STDERR "Before AP($coord): "
		  . $arrayPattern->getInRow
		    . $arrayPattern->getInColumn . " -> "
		      . $arrayPattern->getOutRow
			. $arrayPattern->getOutColumn . "\n";
		my $mapData  = $rowColMapData->{coord}{$coord};
		my $newIdMap = $mapData->[0];
		my $newRow   = $mapData->[1];
		my $newCol   = $mapData->[2];
		$arrayPattern->setInCoords( $newIdMap, $newRow,
						    $newCol );
		print STDERR "After AP($coord): "
		  . $arrayPattern->getInRow
		    . $arrayPattern->getInColumn . " -> "
		      . $arrayPattern->getOutRow
			. $arrayPattern->getOutColumn . "\n";
		$atomicProcess->addArrayPattern($arrayPattern);

	    }
	}
    }
}

1;

=back

=head1 ALSO SEE


=head1 AUTHOR

Simon Holroyd <holroyd@sanger.ac.uk>

=cut

