package GTx::APE::FlushController::PC_FlushController;

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

use base 'GTx::APE::FlushController';

use strict;
use warnings;
use Carp;
use SqlEngine2;
use Class::Throwable;

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

use constant LOGIN            => 'snp';
use constant PCR_PLATE_STATUS => 1;   ## Created.
use constant PCR_PLATE_TYPE   => 1;   ## ExoSeq.
use constant STUDY_ID         => 135; ## ExoSeq

$Class::Throwable::Debug = 0;
$SqlEngine2::verbosity   = 0;


{
    my %_attributes = ( 
			arrayingEntity => undef
		       );

    my %object; # key = stringified object reference, value = hash of { key = attName, value = data }
    
    foreach my $attName (keys(%_attributes)) {
	no strict 'refs';
	*{__PACKAGE__ . "::get\u$attName"} = sub { $object{ $_[0] }->{$attName} }
    }


    #################################################################
    ## 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};
	    }
	}   
	return $self->SUPER::_init(%args);
    }


    #################################################################
    ## Start a new transaction.
    #################################################################
    sub beginTransaction {
    	my $self = shift;
    	$object{ $self }->{sqlEngine} = new SqlEngine2();
    	$object{ $self }->{dbh} = SqlEngine2::getDbh(LOGIN);
    	$object{ $self }->{sqlEngine}->beginTransaction( SqlEngine2::getDbh(LOGIN) );
    }

    
    #################################################################
    ## Over-ridden method from FlushController base class.
    #################################################################
    sub flush {
	my $self = shift;
	
	my $entity    = ${$self->getArrayingEntity()};
	my $user      = ${$self->getUserObj()};
	my $parentProcessId = $entity->getParentProcessId();
	my $outFormat       = $entity->getOutFormat();
	my $sessionId       = $entity->getSessionId();
	my $programName     = $self->getProgramName();


	my $team   = $user->getWorkingTeam()->getTeamName();
	my $roleId = $user->getWorkingTeam()->getWorkingRole()->getRoleId();

	croak "ERROR: there is no working team set.\n" unless $team;
	croak "ERROR: there is no working role set.\n" unless $roleId;
	croak "ERROR: there is no sessionId set.\n"    unless $sessionId;
	croak "ERROR: there is no program name set.\n" unless $programName;

	## Create the one and only PCR plate.
	my $idPcrPlate = eval { 
	    $self->createPcrPlate(sessionId=> $sessionId,
				  plateType=> PCR_PLATE_TYPE,
				  status   => PCR_PLATE_STATUS,
				  studyId  => STUDY_ID,
				  'format' => $outFormat,
				  team     => $team,
				  roleId   => $roleId,
				  program  => $programName); };
	if($@){ croak "ERROR: can't create new oligo plate: $@\n"; }
	
	print STDERR "Created new PCR plate....\n";
	print STDERR "SessionId: $sessionId\nPlateType: ", PCR_PLATE_TYPE, "\nStatus: ", PCR_PLATE_STATUS . 
	    "\nFormat: $outFormat\nTeam: $team\nRoleId: $roleId\n";
	
	## This flushes mixer primer ArrayPattern hash.
	my $mixerAtomicProcessHash; 
	my $epName;
	
	## Find the mixer AtomicProcess object.
	foreach my $atomicProcess (@{${$object{ $self }->{arrayingEntity}}->getAtomicProcessList()}) {
	    if($atomicProcess->getInPrefix() eq 'EP') {
		$epName = $atomicProcess->getInDataId();
		$mixerAtomicProcessHash = $atomicProcess->getArrayPatternHash();
	    }
	}
	croak "ERROR: no primer mixer plate found in ArrayingEntity.\n" unless keys %{$mixerAtomicProcessHash};

	my @summary;
	my $columnNumber;

	## Create the new PCR plate based on the array data.
	foreach my $atomicProcess (@{${$object{ $self }->{arrayingEntity}}->getAtomicProcessList()}) {
	    next if $atomicProcess->getInPrefix() eq 'EP';
	    my $aph      = $atomicProcess->getArrayPatternHash();
	    my $inDataId = $atomicProcess->getInDataId();
	    my $inPrefix = $atomicProcess->getInPrefix();
	    print STDOUT "Flushing inDataId: $inDataId Prefix: $inPrefix\n";
	    foreach my $inMapId (keys(%{$aph})) {
		foreach my $arrayPattern (sort{$a->getOutMapId() <=> $b->getOutMapId()} @{$aph->{$inMapId}}) {
		    ## Grab ArrayPattern data.
		    my $inRow          = $arrayPattern->getInRow();
		    my $inCol          = $arrayPattern->getInColumn();
		    my $outRow         = $arrayPattern->getOutRow();
		    my $outCol         = $arrayPattern->getOutColumn();
		    my $outMapId       = $arrayPattern->getOutMapId();
		    my $outData        = $arrayPattern->getOutData()->[0];
		    my $epArrayPattern = undef;

		    #print STDERR "DN plate OutData contains '" .
		    #scalar(@{$arrayPattern->getOutData()}) . "' block(s) of data.\n";

		    ## Match the primer ArrayPattern object to the DN
		    ## ArrayPattern object using the outMapId
		    ## attribute.
		    unless($epArrayPattern = _matchArrayPattern($mixerAtomicProcessHash,$arrayPattern)) {
			croak "ERROR: can't match ArrayPattern object output to EP ArrayPattern object output\n";
		    }
		    
		    #print STDERR "EP ArrayPattern has '", scalar(@{$epArrayPattern->getOutData()}), "' with '",
		    #scalar(@{$epArrayPattern->getOutData()->[0]}), "' data in the 0 index.\n";
		    
		    ## Get the well details to match the DNA to the primer.
		    my $idDnaWell  = $outData->[3];
		    my $epInRow    = $epArrayPattern->getInRow();
		    my $epInCol    = $epArrayPattern->getInColumn();
		    my $epOutData  = $epArrayPattern->getOutData();
		    my $idWell     = $epOutData->[0][6];
		    my $idWell2    = $epOutData->[1][6];
		    
		    ## Capture the column number.
		    if($inRow . $inCol eq 'a1' && !$columnNumber) {
			$columnNumber = $epArrayPattern->getInColumn();
			print STDERR "Storing column number $columnNumber\n";
		    }

		    ## There should always be an id_dnawell.
		    croak "ERROR: id_dnawell is missing from ArrayPattern within AtomicProcess " . 
			"with parent process id: $parentProcessId\n"
			unless $idDnaWell;
		    
		    ## There should always be an id_well.
		    croak "ERROR: an id_well is missing from ArrayPattern within AtomicProcess " . 
			"with parent process id: $parentProcessId\n"
			unless $idWell && $idWell2;

		    ## The well id's should always be the same - sense and antisense.
		    croak "ERROR: id_well of primer 1 does not match id_well of primer 2: $idWell != $idWell2\n"
			unless $idWell == $idWell2;

		    ## Get the next PCR well id.
		    my $idPcrWell = eval  { $self->getNextPcrWell(); };
		    if($@){ croak $@;                                }

		    push(@summary,[$sessionId,$idPcrPlate,$inRow.$inCol,$epInRow.$epInCol,
				   $arrayPattern->getOutMapId(),$outRow.$outCol,
				   $idPcrWell,$idDnaWell,$idWell]);
		    
		    ## Create the new PCR plate well with contents.
		    eval  { $self->newPcrPlateWell($idPcrWell,$arrayPattern->getOutMapId(),
						   $idPcrPlate,$idDnaWell,$idWell); };
		    if($@){ croak "ERROR: can't create new PCR plate well: $@\n"    }
		}
	    }
	}
	
	my $description;
	## Hardwired return values - not tidy but OK for phase 1.
	if($parentProcessId == 5739) {
	    $description = ["48 DNA x 8 STS","Column $columnNumber of $epName"];
	}elsif($parentProcessId == 5672) {
	    $description = ["384 DNA x 1 STS",$epName];
	}else{
	    $description = ["Unknown","Unknown"];
	}
	
	return new GTx::APE::FlushController::Result(sessionId       => $sessionId,
						     id              => $idPcrPlate,
						     type            => 'PC',
						     description     => $description,
						     'format'        => $outFormat,
						     report          => $self->createReport(\@summary),
						     flushController => \$self);
    }


    #################################################################
    ## Method to match an ArrayPattern from a DNA plate to an
    ## ArrayPattern from an EP plate using the output id_map.
    #################################################################
    sub _matchArrayPattern {
	my ($mixerAtomicProcessHash,$arrayPattern) = @_;
	my $outMapId = $arrayPattern->getOutMapId();
	foreach my $mapId (keys(%{$mixerAtomicProcessHash})) {
	    foreach my $arrayPattern (@{$mixerAtomicProcessHash->{$mapId}}) {
		if($arrayPattern->getOutMapId() == $outMapId) {
		    #print STDERR "Matched ArrayPattern '" . $arrayPattern->getOutMapId() . " = " .
		    #$outMapId . "\n";
		    return $arrayPattern;
		}
	    }
	}
	return FALSE;
    }


    #################################################################
    ## Method to output a sorted summary of the insertion.
    #################################################################
    sub createReport {
	my ($self,$summary) = @_;
	my @report=();
	my $count =0;
	push(@report,sprintf("%-13s %-13s %-13s %-13s %-13s %-13s %-13s %-13s %-13s\n",
			     "SessionId","PcrPlateId","DNAInCoord","EPInCoord","OutMapId","OutCoord",
			     "PcrWellId","DnaWellId","WellId"));
	push(@report,sprintf("%-13s %-13s %-13s %-13s %-13s %-13s %-13s %-13s %-13s\n",
			     "-"x13,"-"x13,"-"x13,"-"x13,"-"x13,"-"x13,"-"x13,"-"x13,"-"x13));
	foreach my $line (sort{ $a->[4] <=> $b->[4]  } @{$summary}) {
	    push(@report,sprintf("%-13s %-13s %-13s %-13s %-13s %-13s %-13s %-13s %-13s\n",
				 $line->[0],$line->[1],$line->[2],$line->[3],
				 $line->[4],$line->[5],$line->[6],$line->[7],$line->[8]));
	    $count++;
	}
	push(@report,"\nCount: $count\n");
	return \@report;
    }


    #################################################################
    ## Method to create a new DNA plate with a status.
    #################################################################
    sub createPcrPlate {
	my ($self,%options) = @_;
	croak "ERROR: argument plateType is missing."   unless $options{plateType};
	croak "ERROR: argument format is missing."      unless $options{format};
	croak "ERROR: argument team is missing."        unless $options{team};
	croak "ERROR: argument roleId is missing."      unless $options{roleId};
	croak "ERROR: argument program is missing."     unless $options{program};
	croak "ERROR: argument sessionId is missing."   unless $options{sessionId};
	croak "ERROR: argument status is missing."      unless $options{status};
	croak "ERROR: argument studyId is missing."     unless $options{studyId};
	#croak "ERROR: argument createdFrom is missing." unless $options{createdFrom};
	## Get the next id_pcrplate.
	my $idPcrPlate = eval { $self->getNextPcrPlateId(); };
	if($@) { croak "ERROR: can't get new id_pcrplate: $@\n"; }
	## Create the new pcr plate.
	eval  { $self->newPcrPlate($idPcrPlate,$options{format},$options{studyId},
				   $options{team},$options{plateType}); };
	if($@){ croak "ERROR: can't create new pcrplate: $@\n";  }
	## Create a new pcr plate status.
	eval  { $self->newPcrPlateStatus($idPcrPlate,$options{status},$options{roleId},
					   $options{sessionId},$options{program}); };
	if($@){ croak "ERROR: can't create new pcrplate status: $@\n";  }
	print STDERR "Created pcr plate: $idPcrPlate\n";
	return $idPcrPlate;
    }


    #################################################################
    ## Method to get the next id_pcrplate from the sequence.
    #################################################################
    sub getNextPcrPlateId {
    	my $self = shift;
    	my $idPcrPlate = 
    	    eval { $object{ $self }->{sqlEngine}
    		   ->getRow('ExoSeq::next_pcrplate',
    			    [],$object{ $self }->{dbh});};
    	
    	if($@) { croak $@;           }
    	else   { return $idPcrPlate; }
    }
    

    #################################################################
    ## Method to get the next id_pcrwell from the sequence.
    #################################################################
    sub getNextPcrWell {
    	my $self = shift;
    	my $idPcrWell = 
    	    eval { $object{ $self }->{sqlEngine}->getRow('ExoSeq::next_pcrwell',
    							 [],$object{ $self }->{dbh}); };
    	if($@) { croak $@;          }
    	else   { return $idPcrWell; }
    }
    
    
    #################################################################
    ## Method to create a new Pcr plate.
    #################################################################
    sub newPcrPlate {
    	my ($self,$idPcrPlate,$format,$studyId,$team,$pcrPlateType) = @_;
    	eval  { $object{ $self }->{sqlEngine}->do('ExoSeq::insert_pcrplate_study',
    						  [$idPcrPlate,$format,$studyId,$team,$pcrPlateType], 
    						  $object{ $self }->{dbh}); };
    	if($@) { croak $@; }
    }


    #################################################################
    ## Method to create a new Pcr plate status.
    #################################################################
    sub newPcrPlateStatus {
    	my ($self,$idPcrPlate,$status,$idRole,$sessionId,$program) = @_;
    	eval { $object{ $self }->{sqlEngine}->do('ExoSeq::insert_pcrplatestatus',
    						 [$idPcrPlate,$status,1,$idRole,$sessionId,$program],
    						 $object{ $self }->{dbh}); };
    	if($@) { croak $@; }
    }


    #################################################################
    ## Method to create a Pcr well in a Pcr plate.
    #################################################################
    sub newPcrPlateWell {
    	my ($self,$idPcrWell,$idMap,$idPcrPlate,$idDnaWell,$idWell) = @_;
    	eval { $object{ $self }->{sqlEngine}->do('ExoSeq::insert_pcrwell',
    						 [$idPcrWell,$idMap,$idPcrPlate,$idDnaWell,$idWell],
    						 $object{ $self }->{dbh}); };
    	if($@) { croak $@; }
    }


    #################################################################
    ## Over-ridden method from FlushController base class.
    #################################################################
    sub rollbackTransaction {
    	my $self = shift;
    	$object{ $self }->{sqlEngine}->rollbackTransaction( $object{ $self }->{dbh} );
    }


    #################################################################
    ## Over-ridden method from FlushController base class.
    #################################################################
    sub commitTransaction {
    	my $self = shift;
    	$object{ $self }->{sqlEngine}->commitTransaction( $object{ $self }->{dbh} );
    }


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

1;
