package Checkfinentries;

####################
# Modules
####################

use Time::localtime;
use IPC::Open2;
use strict;
use EquusDatabaseInterface;
use OORepository;
use vars qw(@ISA @EXPORT);
use Exporter;
use SqlEngine2;
use Class::Throwable;
$Class::Throwable::Debug = 1; # ensure we get a stack trace from exceptions
$SqlEngine2::verbosity = 1;

@ISA = ('Exporter');
@EXPORT = qw(&start_check);


#####################
# Global module vars
#####################
my $reduce_out = 1; # If defined - less output to STDERR

my $ERROR_TAG;     # Colour tagging for the supplied sample grid
my $ERROR_INFO;    # Error text for the supplied sample grid 

my $se2;           # SqlEngine2 object
my $dbhTracking;   # DataBase handle for tracking

my $errors;        # A counter for the number of errors seen


#####################
# Subroutines
#####################
sub initDatabase { 
   ($dbhTracking) = @_;
    warn "inside initDatabase - dbh - $dbhTracking\n";

    eval {
	
	# Make a SqlEngine object
	$se2 = new SqlEngine2();
	
	my $i;
	warn "Sql libs need to be in here somewhere...\n" unless ($reduce_out);
	unless ($reduce_out){
	    printf "%d %s\n", $i++, $_ for @INC;
	}

	# Load a SQL library
	$se2->loadSqlLib(['Checkfinentries']);
	
	# If we have been supplied with a db handle - see if we can do something with it
	unless (UNIVERSAL::isa($dbhTracking, "DBI::db")){
	    my $ref = ref $dbhTracking;
	    die "dbh supplied to initDatabase does not look correct ! $ref\n";
	}
	
	my $user = $se2->getRow('Checkfinentries::getUser', [], $dbhTracking);
	warn "Checkfinentries::getUser returns\n";
	warn Data::Dumper::Dumper($user) unless ($reduce_out);
	
    };
    if ($@) {
	die "Issues encountered initiating SqlEngine2\n$@";
    }
    
}



sub start_check {
    
    ######################################################################
    # $DATA = [ [ [] ] ] ---> our input at the moment
    # $DATA_TAG = [ [ [] ] ] ---> tags the problem back in the interface
    # $DATA_INFO = [ [ [] ] ] ---> stores info on what is wrong
    ######################################################################

    my (
	$dbh, 
	$project, 
	$valid_custom, 
	$valid_chems, 
	$valid_adds, 
	$backwards, 
	$D, 
	$costcode, 
	$SECT_in,             # why is this sent in ?
	$lastSECT, 
	$GRID_ROWS, 
	$DATA_TAG, 
	$DATA_INFO, 
	$auto, 
	$chem2suff, 
	$old_suff, 
	$id_robot, 
	$ext_primers, 
	$team, 
	$DP_avail_check, 
 	$reduce_out
	) = @_;      # 21 parameters

    my $DATA;
    # dn1; now accepts $id_robot, $ext_primers
    # DD we also need to know the teamname in question
    
    # Set up for DB queries
    &initDatabase($dbh);

    $errors = 0;
    my @update_report;

    unless (defined $team){
	die "Checkfinentries::start_check requires a team to function !\n";
    }

    unless (defined $DP_avail_check){ # turn off DP team-availability check if not specified
	$DP_avail_check = 0;
    }
    
    # EST/VIRAL BYPASS
    #
    # If the project is an EST/VIRAL, checking DP availability needs to be skipped.
    # In the case of autofinishing the $DP_avail_check will always = 1 initially.
    if ($DP_avail_check == 1) {
	my $reply = $se2->getRow('Checkfinentries::estViralBypass', [$project], $dbhTracking);
	warn "Checkfinentries::estViralBypass returns\n" unless ($reduce_out);
	warn Data::Dumper::Dumper($reply) unless ($reduce_out);
        if ($reply){
            $DP_avail_check = 0;
        }
    }

    unless (defined $id_robot){
	$id_robot = 0;
    }

    unless (defined $ext_primers){
	$ext_primers = 0;
    }
    
    if ($id_robot > 0){
	# Is this project recorded as being currently 'robot aware' ?
	warn "\t***** Robot checking mode activated...\n";
	my $check = $se2->getRow('Checkfinentries::robotProject', [$project], $dbhTracking);
	warn "Checkfinentries::robotProject returns\n" unless ($reduce_out);
	warn Data::Dumper::Dumper($check) unless ($reduce_out);
	unless ($check){
	    push @update_report, "Project $project is not registered as having any plates currently on robot $id_robot!\nChecking stopped ... Cannot submit !";
	    return (\@update_report, 1, 1);
	}
    }



    # We need to check the project-directory for already existing readnames
    my $wgs = 0;
    my $online;
    my $wgs_dbh;

    # TODO - nasty call to finch2_general.pm
    my ($ext_database, $ext_project) = &get::ext_db_info("", $dbhTracking, $project); 

    # Is this a 'whole-genome-shotgun' project ?
    my $wgs_lookup;
    my $sth_wgs;
    if ( (defined $ext_database) && (defined $ext_project) ){
	$wgs = 1;
	
	# Get a connection to the whole-genome shotgun database, we can use
	# this later to check if the read has been through asp
	$wgs_dbh = WrapDBI->connect('pathasp',
				    {RaiseError => 1, AutoCommit => 0}
				    );
	# SQL - wgsLookup - Note that this query is made up on the fly (ie. schema owner for .read)
	# hence have avoided using SqlEngine2
	$wgs_lookup = "
select count(*)
from   $ext_database.read
where  readname = ?
";
	$sth_wgs = $wgs_dbh->prepare($wgs_lookup) || die "ERROR:$DBI::errstr";

    } else {

	# Not a 'whole-genome-shotgun' project - we must look in the project directory
	my $repos = new OORepository;
	$online = $repos->get_online_path_from_project($project);

	unless (defined $online) {
	    die "Quitting Checkfinentries.pm: This is not a whole-genome-shotgun project and an online path cannot be found from the repository.\n";
	}

	# Check the online path is reachable
	unless (-e $online){
	    push @update_report, "Contact bug ! Cannot access project $project at $online...";
	    return (\@update_report, 1, 1);
	}
    }
    

    # mapping from suffix -> id's
    my $suff2chem = {};
    my $fus;
    foreach my $sui (keys %$chem2suff){
	$fus = $chem2suff->{$sui};
	push @{$suff2chem->{$fus}}, $sui;
    }

    # reverse $valid_adds
    my $valid_adds2 = {};
    foreach my $n (keys %$valid_adds){
	my $e = $valid_adds->{$n};
	$valid_adds2->{"$e"} = $n;
    }

    

    $ERROR_TAG = $$DATA_TAG;
    $ERROR_INFO = $$DATA_INFO;
    
    my $DATA = $$D;
    my $count = 0;
    my $duplicate_oligos = 0;
    my $internal_oligo_check  = [[]];
    my %oligo_seen= ();
    my $missing_DP;
    my %template_seen;
    

    # A connection to equus
    my $edi = EquusDatabaseInterface->new();

    my $csf = 0;
    my $r;                                 # The row of the supplied sample grid
    foreach my $SECT ( 1 .. ($lastSECT)) { # The page of the supplied sample grid
	for ($r=0;$r<$GRID_ROWS;$r++) {    
	    

            $csf++;
	    ########################################################
	    warn "----------------------------\n" unless ($reduce_out);
	    warn "Checking SECT $SECT row $r\t csf - $csf\n" unless ($reduce_out);
	    my $time = localtime;
	    my ($h, $m, $s) = ($time->hour, $time->min, $time->sec);
	    warn "$h:$m   -   $s\n" unless ($reduce_out);
	    ########################################################

	    
	    my $template = $DATA->[$SECT]->[$r]->[0];
	    my $suffix = $DATA->[$SECT]->[$r]->[1];
	    my $oligo_name = $DATA->[$SECT]->[$r]->[2];
	    my $oligo_sequence = $DATA->[$SECT]->[$r]->[3];
	    my $runtype = $DATA->[$SECT]->[$r]->[4];
	    my $id_scsp = $DATA->[$SECT]->[$r]->[6];
	    my $add = $DATA->[$SECT]->[$r]->[7];
	    my $id_frequest = $DATA->[$SECT]->[$r]->[9];

	    # If we are looking at a completely blank row -> skip it
	    if ( ($template eq '') &&
		 ($suffix eq '') &&
		 ($oligo_name eq '') &&
		 ($oligo_sequence eq '') &&
		 ($runtype eq '') &&
		 ($id_scsp eq '') &&
		 ($add eq '') &&
		 ($id_frequest eq'')
		 ){
		next;
	    } else {
		$count++;
	    }
	    
# We must check that we do not have oligo name entries WITH oligo sequences 
# that match within the widgets.
# eg. oligo1    GAGAGAGAGAG
#     oligo1    AAAAAGGAGAG -> hence if oligo1 occurs again after the first time WITH SEQUENCE, we should
#                              warn of this.
#############################################################################################################
	    # get oligo_name for each row
	    $internal_oligo_check->[$r]->[0] = $oligo_name;
	    # get oligo_sequence for each row
	    $internal_oligo_check->[$r]->[1] = $oligo_sequence;
	    # We must count how many times an oligo-name occurs along with an oligo sequence
	    if ($internal_oligo_check->[$r]->[0] ne '' && $internal_oligo_check->[$r]->[1] ne '') {
		# there is something in both name and sequence for this row
		$oligo_seen{$internal_oligo_check->[$r]->[0]}++;
		# so we have seen this name with a sequence n times
		if ($oligo_seen{$internal_oligo_check->[$r]->[0]} > 1) {
		    #if the same oligoname has already been seen with a sequence- tag the error
		    $ERROR_TAG->[$SECT]->[$r]->[3] = 'LimeGreen';
		    my $prev = $ERROR_INFO->[$SECT]->[$r]->[3];
		    $ERROR_INFO->[$SECT]->[$r]->[3] = "$prev -- Only enter new oligo sequences once.";
		    $duplicate_oligos++;
		}
	    }

	    warn "check_suffix\n" unless ($reduce_out);
	    my ($iteration) = &check_suffix(
					    $suffix, 
					    $SECT,
					    $r,
					    );

	    warn "check_idscsp\n" unless ($reduce_out);
	    my ($scinv) = &check_idscsp(
					$template, 
					$suffix, 
					$oligo_name, 
					$oligo_sequence, 
					$runtype, 
					$id_scsp, 
					$add, 
					$valid_chems, 
					$valid_custom, 
					$backwards, 
					$SECT,
					$r,
					);

	    unless ($scinv eq 'INVALID'){ # A valid id_scsp is needed for template checking
		warn "check_template\n" unless ($reduce_out);


		# TODO - requirement - if the template is the result of a retransformation - check that that the status of the retransformation is suitable wrt finch2 should prevent submission
		# RR_STATUS table - not current status of 'failed'
		# Likewise for PCR products - are we actually checking this

		&check_template(
				$project, 
				$template, 
				$suffix, 
				$iteration, 
				$oligo_name, 
				$oligo_sequence, 
				$runtype, 
				$id_scsp, 
				$add, 
				\$missing_DP,  
				$edi, 
				\%template_seen, 
				$chem2suff, 
				$suff2chem, 
				$wgs, 
				$online, 
				$sth_wgs, 
				$ext_database, 
				$old_suff, 
				$team, 
				$DP_avail_check, 
				$SECT,
				$r,
				);
		# Also now checks previous submissions and the project directory for duplicates
	    }
	    
	    warn "check_oligo\n" unless ($reduce_out);
	    &check_oligo(
			 $project,
			 $template, 
			 $suffix, 
			 $oligo_name, 
			 $oligo_sequence, 
			 $runtype, 
			 $id_scsp, 
			 $add, 
			 $valid_custom, 
			 \%oligo_seen, 
			 $costcode, 
			 $auto,
			 $SECT,
			 $r);
	    

	    
	    warn "check_add\n" unless ($reduce_out);
	    &check_add(
		       $add, 
		       $valid_adds2, 
		       $SECT,
		       $r,		     
		       );

	    
	    # We don't want to break UQ_SEQREAD unique constraint, so check the table.
            # As not ALL reads go through this table we should probably also check the
            # project directory.
	    # template.row.col.suffix.iteration.[primername]
	    # 
	    # let's assume that $suffix always contains the suffix and the optional
	    # iteration
	    
	    warn "check_seqread\n" unless ($reduce_out);
	    &check_seqread(
			   $template, 
			   $suffix, 
			   $oligo_name,
			   $SECT,
			   $r,
			   );
	    
	    # We may need to check the relevant 384 well dnaplate is on the robot (if appropriate)
	    if ($id_robot > 0){
		warn "check_robot\n" unless ($reduce_out);
		&check_robot(
			     $id_robot, 
			     $template,
			     $SECT,
			     $r
			     );
	    }
	    
	    # Don't allow orders that contain *JUST* oligos (ie. no template etc.) if
	    # the fin_serv is registered as using an external primer ordering root
	    if ($ext_primers > 0){
		warn "check_not_internal\n" unless ($reduce_out);
		&check_not_internal(
				    $template, 
				    $suffix, 
				    $oligo_name, 
				    $oligo_sequence, 
				    $runtype, 
				    $id_scsp, 
				    $add,
				    $SECT,
				    $r
				    );
	    }

	    # If an id_frequest is supplied then this suggests that the samples are being
	    # re-submitted from a 'holding area'. We should check that the id_frequest does actually
	    # exist
	    if ($id_frequest ne ''){
		warn "check_id_frequest\n" unless ($reduce_out);
		&check_id_frequest(
				   $id_frequest,
				   $SECT,
				   $r,
				   );
	    }
	    
	}
    }


    
# We now need to trap self-matches
# eg. the iteration is different,
    my $internal_hits;
    my $internal_hit_data = [];
    my %hit_seen= ();

    warn "checking self-matches in list\n" unless ($reduce_out);

    my $r; # The row of the supplied sample grid
    if ( ($duplicate_oligos == 0) && ($errors == 0) ) {
	foreach my $SECT ( 1 .. ($lastSECT)) { # The page of the supplied sample grid
	    for ($r=0;$r<$GRID_ROWS;$r++) {

                # Duplicate check

		# Users are changing 05->5 to get the stuff through with the same
		# iteration (ie. they want to keep the 'g' -> dGTP) hence make
		# the check more strict.
		
		my $this_template = "$DATA->[$SECT]->[$r]->[0]";
		# get the col number from the end
		my ($check_col) = $this_template =~ /(\d+)$/;
		$this_template =~ s/\d+$//;
		# get $check_col in a form with no leading zero
		$check_col++;
		$check_col--;

		my $new_template = "$this_template" . "$check_col";
		
		$internal_hit_data->[$r] = "$new_template"."$DATA->[$SECT]->[$r]->[1]"."$DATA->[$SECT]->[$r]->[2]";


		if ( ($DATA->[$SECT]->[$r]->[0] ne '') && ($DATA->[$SECT]->[$r]->[1] ne '') ) {
		    # there is something in both template and suffix for this row
		    $hit_seen{$internal_hit_data->[$r]}++;
		    # so we have seen this name with a sequence n times
		    if ($hit_seen{$internal_hit_data->[$r]} > 1) {
			#if the same entry has already been seen -tag the error
			$ERROR_TAG->[$SECT]->[$r]->[0] = 'LimeGreen';
			$ERROR_TAG->[$SECT]->[$r]->[1] = 'LimeGreen';
			$ERROR_TAG->[$SECT]->[$r]->[2] = 'LimeGreen';
			$ERROR_INFO->[$SECT]->[$r]->[0] = 'This is an internally repeated request. Please add/change the iteration';
			$ERROR_INFO->[$SECT]->[$r]->[1] = 'This is an internally repeated request. Please add/change the iteration';
			$ERROR_INFO->[$SECT]->[$r]->[2] = 'This is an internally repeated request. Please add/change the iteration';
			$internal_hits++;
		    }
		}
	    }
 	}	
    }

    
    if ( ($duplicate_oligos > 0) || ($errors > 0) || ($internal_hits > 0) ) {
	if ($duplicate_oligos > 0) {
	    push @update_report, "Please check or remove the entries tagged in green. You should only enter a new oligo sequence once.";
	}
	if ($errors > 0) {
	    push @update_report, "Please check or remove the entries tagged in red. Syntax error(s) detected.";
	}
	if ($internal_hits > 0) {
	    push @update_report, "Please check or remove the entries tagged in green. Duplicate sample names detected.";
	}
    }

    
    # Total errors ?
    my $total_errors = ($duplicate_oligos + $errors + $internal_hits);

    if ($count == 0){
	push @update_report, "No samples to check !";
    } elsif ( ($duplicate_oligos == 0) && ($errors == 0) && ($internal_hits == 0) ){
	push @update_report, "No errors detected in submission.";
    } else {
	push @update_report, "Total problems $total_errors";
    }

    if ($missing_DP > 0){
	push @update_report, "$missing_DP requests required unavailable DNA plates.";
    }


    if (defined $sth_wgs){
	$sth_wgs->finish();
    }

    if (defined $wgs_dbh){
	$wgs_dbh->disconnect();
    }

    # Returns the no. of missing DPs
    return (\@update_report, $total_errors, $count, $missing_DP);
}


sub check_id_frequest {
    my (
	$id_frequest,
	$SECT,
	$r,
	) = @_;
    
    my $check_id_frequest = $se2->getRow('Checkfinentries::checkHoldingAreaFrequest', [$id_frequest], $dbhTracking);
    warn "Checkfinentries::checkHoldingAreaFrequest returns\n" unless ($reduce_out);
    warn Data::Dumper::Dumper($check_id_frequest) unless ($reduce_out);
    
    unless ($check_id_frequest){
	$errors++;
	$ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
	my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	$ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- This request has an id_frequest ($id_frequest) but no holding area submission can be found.";
    }

}


sub check_not_internal {
    my (
	$template, 
	$suffix, 
	$oligo_name, 
	$oligo_sequence, 
	$runtype, 
	$id_scsp, 
	$add,
	$SECT,
	$r,
	) = @_;
    
    if ( ($template eq '') && 
	 ($suffix eq '') && 
	 ($oligo_name ne '') && 
	 ($oligo_sequence ne '') && 
	 ($runtype eq '') && 
	 ($id_scsp eq '') && 
	 ($add eq '') ){
	
	$errors++;
	$ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
	my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	$ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- You cannot order primers without a template via this finservice.";
	
    }
}



sub check_template {
    my (
	$project, 
	$template, 
	$suffix, 
	$iteration, 
	$oligo_name, 
	$oligo_sequence, 
	$runtype, 
	$id, 
	$add, 
	$missing_DP, 
	$edi, 
	$template_seen, 
	$chem2suff, 
	$suff2chem, 
	$wgs, 
	$online, 
	$sth_wgs, 
	$ext_database, 
	$old_suff, 
	$team, 
	$DP_avail_check, 
	$SECT,
	$r,
	) = @_;
    

    unless (  # May be a completely blank row
	     ($template eq '') && 
	     ($suffix eq '') && 
	     ($oligo_name ne '') && 
	     ($oligo_sequence ne '') && 
	     ($runtype eq '') && 
	     ($id eq '') && 
	     ($add eq '') 
	     ){
	
	if ($template eq ''){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- You must supply a template.";
	}
    }

    my ($plate, $row, $col);
    my $check_previous = 1; 
    
    my $new_template = $template;
    # get the col number from the end
    my ($check_col) = $new_template =~ /(\d+)$/;
    $new_template =~ s/\d+$//;
    # get $check_col in a form with no leading zero
    $check_col++;
    $check_col--;

    # Make 2x versions of the readname; 1 with a leading zero
    # and one without (wrt. the column)
    
    my @read_possibles;
    my $read1 = "$new_template" . "$check_col" . "." . "$suffix" . "$oligo_name";
    push @read_possibles, $read1;
    
    if ($check_col < 10){
	my $new_col = "0" . "$check_col";
	my $read2 = "$new_template" . "$new_col" . "." . "$suffix" . "$oligo_name";
	push @read_possibles, $read2;
    }



    # Is the supplied $template valid ?
    if ($template ne ''){
        
	if ($template  =~ /^(\S+)([a-p])(\d{1,2}$)/) {
	#if ($template  =~ /^(\S+)([a-h])(\d{1,2}$)/) {
	    # \S+      ---> match 1 or more non whitespace-characters
            # [a-h]    ---> match any single lowercase a to h
            # \d{1,2}  ---> match 1 to 2 digits
	    
	    $plate = $1;
	    $row = $2;
	    $col = $3; 
	    
	    unless (defined $template_seen->{$plate}) {
		# Check that the platename is valid in either the Oracle or Equus database.
		my ($plate_obj, $name);
		
		warn "checking platename ...\n" unless ($reduce_out);

                # Check for dodgy characters in plate name
                if ($plate =~ /[\.\/]/) {
                    $errors++;
                    $ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
                    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
                    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- $plate contains invalid characters!!\n.";
                    $check_previous = 0;                    
                }

		($plate_obj, $name) = &check_platename(
						       $plate, 
						       $edi, 
						       $row, 
						       $col
						       );
                
		# Where plate information is not found make an 
		# additional check for the sourceplatemap information.
                unless (($plate_obj) || ($name)){
                    ($name) = &check_sourceplatemap(
						    $template
						    );
                }
                
		if ( ($plate_obj)||($name) ){
		    $template_seen->{$plate}++;
		    
                } else {
		    
		    # If not found check PCR_PRODUCT next
		    ($name) = &check_pcr_plate (
						$plate
						);
		    if ($name){
			warn "SUFFIX:- $suffix\n" unless ($reduce_out);
			warn "PCR TYPE NAME found:-$name\n" unless ($reduce_out);
			$template_seen->{$plate}++;
			
		    } else {
			# - flag an error if this fails
                        $errors++;
                        $ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
                        my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
                        $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- $plate cannot be found in Oracle or Equus\n.";
                        $check_previous = 0;
                    }
                }
            }
            

	    # Some additional sanity checking on the derived sample_name info
	    if ( ( $col > 24) || ($col < 1)) {
		$errors++;
		$ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
		my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
		$ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- Column number out of range.";
		$check_previous = 0;
	    }



	    # Optional check for DP availability to a team
	    unless ($DP_avail_check == 0){ # this is an optional check
		unless ($suffix =~ /^w/){  # pcr products aren't tracked in team_dnaplate
		    
		    # Does the team in question currently have access to the dnaplate in question ?
		    $new_template =~ s/[a-z]$//;

		    my $dnaplate_avail = $se2->getRow('Checkfinentries::teamDnaPlate', 
						      [$new_template, $team], $dbhTracking);
		    warn "Checkfinentries::teamDnaPlate returns\n" unless ($reduce_out);
		    warn Data::Dumper::Dumper($dnaplate_avail) unless ($reduce_out);

		    unless (defined $dnaplate_avail){
			$errors++;
			$$missing_DP++;
			
			$ERROR_TAG->[$SECT]->[$r]->[0] = 'cyan1';
			my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
			
			# Add a special id to the start of the struct
			# so that we can potentially handle these orders
			# differently in Submitfinentries.pm
			$ERROR_INFO->[$SECT]->[$r]->[0] = "xxx $prev -- Team $team does not have access to a relevant DNA plate for $new_template.";
		    }
		}
	    }


	    # This code will only find previous finishing-submissions if they they
	    # were submitted through the crusade-system (Nb. id_scsp is used in the
	    # lookup).
	    my $id_frequest;
	    if ( ($check_previous == 1) && ($plate ne '') && ($row ne '') && ($col ne '') && ($id ne '') ){

		my $crusade_check = 0; # did we find a previous request via crusade ?
		
		# NOTE THAT MULTIPLE ID'S MAY NEED TO BE CHECKED HERE !
		# what id_scsp are we looking at ? $id
		# what suffix does this correspond to ? $chem2suff->{$id}
		my $c_suff = $chem2suff->{$id};
		my @c_array = @{$suff2chem->{$c_suff}};

		warn "Checking previous Crusade submissions\n" unless ($reduce_out);
		foreach my $next_chem (@c_array){
		    my $new_id_frequest;
		    
		    if ($oligo_name ne ''){
			if ($iteration ne ''){
			    # Custom primer - iteration
			    $new_id_frequest = $se2->getRow('Checkfinentries::crusadeFrequestOligoIteration', 
							    [
							     $project, 
							     $plate, 
							     $row, 
							     $col, 
							     $next_chem, 
							     $iteration, 
							     $oligo_name
							     ], $dbhTracking);
			    warn "Checkfinentries::crusadeFrequestOligoIteration returns\n" unless ($reduce_out);
			    warn Data::Dumper::Dumper($new_id_frequest) unless ($reduce_out);
			    
			    if (defined $new_id_frequest){
				$id_frequest = $new_id_frequest;
			    }
			} else {
			    # Custom primer - no iteration
			    $new_id_frequest = $se2->getRow('Checkfinentries::crusadeFrequestOligoNoIteration', 
							    [$project,
							     $plate,
							     $row,
							     $col,
							     $next_chem,
							     $oligo_name
							     ], $dbhTracking);
			    warn "Checkfinentries::crusadeFrequestOligoNoIteration returns\n" unless ($reduce_out);
			    warn Data::Dumper::Dumper($new_id_frequest) unless ($reduce_out);
			    
			    if (defined $new_id_frequest){
				$id_frequest = $new_id_frequest;
			    }
			}
			
		    } else {
			# No custom primer - iteration
			if ($iteration ne ''){
			    $new_id_frequest = $se2->getRow('Checkfinentries::crusadeFrequestIteration', 
							    [
							     $project,
							     $plate,
							     $row,
							     $col,
							     $next_chem,
							     $iteration
							     ], $dbhTracking);
			    warn "Checkfinentries::crusadeFrequestIteration returns\n" unless ($reduce_out);
			    warn Data::Dumper::Dumper($new_id_frequest) unless ($reduce_out);

			    if (defined $new_id_frequest){
				$id_frequest = $new_id_frequest;
			    }
			} else {
			    # No custom primer - no iteration
			    $new_id_frequest = $se2->getRow('Checkfinentries::crusadeFrequestNoIteration', 
							    [
							     $project,
							     $plate,
							     $row,
							     $col,
							     $next_chem
							     ], $dbhTracking);
			    warn "Checkfinentries::crusadeFrequestNoIteration returns\n" unless ($reduce_out);
			    warn Data::Dumper::Dumper($new_id_frequest) unless ($reduce_out);
			    
			    if (defined $new_id_frequest){
				$id_frequest = $new_id_frequest;
			    }
			}
		    }
		}
		
		if (defined $id_frequest){
		    
		    $errors++;
		    $ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
		    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
		    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- This request has been ordered previously through crusade: See id_frequest $id_frequest.";
		    
		    $crusade_check = 1;
		}
		
	    }



	    ###################################################################
	    # Depending on whether this project is wgs or not, some dir checks
	    ###################################################################
	    if ($wgs == 0){
		warn "Checking project dir\n" unless ($reduce_out);

		# check the project-dir in $online
		foreach my $readname (@read_possibles) {
		    my $duplicated = 0;
		    $duplicated = (-e "$online/$readname"
				   || -e "$online/Failures/$readname"
				   || -e "$online/awol/$readname"
				   || -e "$online/awol/Failures/$readname"
				   || read_in_ts_project($project, $readname));
		    
		    if ($duplicated) {
			$errors++;
			$ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
			my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
			$ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- Request $readname is already in project directory: $online.";
		    }
		}



	    } else {

		warn "Checking wgs database\n" unless ($reduce_out);

		foreach my $readname (@read_possibles) {
		    $sth_wgs->execute($readname);
		    my ($count) = $sth_wgs->fetchrow();
		    if ($count > 0){
			$errors++;
			$ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
			my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
			$ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- Request $readname is already present in the read table of the $ext_database database. ";
		    }
		}
	    }


   
	} else {
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- No match to 'plate row column' could be found";
	}             
    }    
}
    


sub check_platename {
    my (
	$plate, 
	$edi, 
	$row, 
	$col
	) = @_;

    my $name = $se2->getRow('Checkfinentries::bbName', [$plate, $row, $col], $dbhTracking);
    warn "Checkfinentries::bbName returns\n" unless ($reduce_out);
    warn Data::Dumper::Dumper($name) unless ($reduce_out);


    my $plate_obj;
    unless ($name) {
	# The following connection is needed because equus tends to loose it's connection if left unattended
	$edi->reconnect();
	$plate_obj = $edi->{db}->fetch(-class => 'Plate',
				       -name  => $plate);
    }
    
    return ($plate_obj, $name);
}


sub check_sourceplatemap {
    my (
	$template
	) = @_;
    
    my $name = $se2->getRow('Checkfinentries::sourcePlateSampleName', [$template], $dbhTracking);
    warn "Checkfinentries::sourcePlateSampleName returns\n" unless ($reduce_out);
    warn Data::Dumper::Dumper($name) unless ($reduce_out);

    return ($name);
}


sub check_pcr_plate {
    my (
	$plate
	) = @_;
    
    my $name = $se2->getRow('Checkfinentries::pcrTemplateName', [$plate], $dbhTracking);
    warn "Checkfinentries::pcrTemplateName returns\n" unless ($reduce_out);
    warn Data::Dumper::Dumper($name) unless ($reduce_out);
    
    return ($name);
}


sub check_idscsp {
    my (
	$template, 
	$suffix, 
	$oligo_name, 
	$oligo_sequence, 
	$runtype, 
	$id, 
	$add, 
	$valid_chems, 
	$valid_custom, 
	$backwards, 
	$SECT,
	$r,
	) = @_;

    unless (defined ($valid_chems->{$id}) ){
	unless ( ($template eq '') && ($suffix eq '') && ($oligo_name ne '') && ($oligo_sequence ne '') && ($runtype eq '') && ($id eq '') && ($add eq '') ){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[6] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[6];
	    $ERROR_INFO->[$SECT]->[$r]->[6] = "$prev -- This is an invalid ChemID entry.";
	    return ("INVALID");
	}
    }


    # A check for backwards compatibility
    unless (defined ($backwards->{$id}) ){
	unless ( ($template eq '') && ($suffix eq '') && ($oligo_name ne '') && ($oligo_sequence ne '') && ($runtype eq '') && ($id eq '') && ($add eq '') ){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[6] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[6];
	    $ERROR_INFO->[$SECT]->[$r]->[6] = "$prev -- This ChemID cannot be converted into an old_style seqchem. Contact Bug.";
	}
    } 


    # Is the chemistry approriate for a custom oligo-order
    if ($oligo_name eq ''){
	if (defined $valid_custom->{$id}){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[2] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[2];
	    $ERROR_INFO->[$SECT]->[$r]->[2] = "$prev -- This ChemID requires a custom oligo.";
	}
    }
}


sub check_add {
    my (
	$add, 
	$valid_adds,
	$SECT,
	$r,
	) = @_;
    unless (defined ($valid_adds->{$add}) || (! defined $add) ){
	$errors++;
	$ERROR_TAG->[$SECT]->[$r]->[7] = 'red1';
	my $prev = $ERROR_INFO->[$SECT]->[$r]->[7];
	$ERROR_INFO->[$SECT]->[$r]->[7] = "$prev -- This is an invalid Additive entry.";
    }
}


sub check_robot {
    my (
	$id_robot, 
	$template,
	$SECT,
	$r,
	) = @_;
    
    $template =~ s/\w\d+$//;
    
    my $test = $se2->getRow('Checkfinentries::robotDnaplate', [$template, $id_robot], $dbhTracking);
    warn "Checkfinentries::robotDnaplate returns\n" unless ($reduce_out);
    warn Data::Dumper::Dumper($test) unless ($reduce_out);
    
    unless (defined $test){
	$errors++;
	$ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
	my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	$ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- Template $template is not available on robot $id_robot.";

	# Run a check on the dnaplate...
	my $ref = $se2->getAll('Checkfinentries::dnaPlateFromBBname', [$template], $dbhTracking);
	warn "Checkfinentries::dnaPlateFromBBname returns\n" unless ($reduce_out);
	warn Data::Dumper::Dumper($ref) unless ($reduce_out);
	my $count = 0;
	foreach my $RDP (@{$ref}) {
	    $count++;
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- DP$RDP";
	}


	unless ($count > 0){
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- There is no condensed robot format DP available !";
	}

    }

}


sub check_seqread {
    my (
	$template, 
	$suffix, 
	$oligo_name,
	$SECT,
	$r,
	) = @_;
    
    my @to_test;

    # Note that capminder always enters seqread.name with a 0 appended before columns 1-9
    # hence this is what we must check for

    my $col;
    if ($template =~ /(\d+)$/){
	$col = $1;

	$template =~ s/\d+$//;

	if ( ($col < 10) && ($col =~ /^[1-9]/) ){
	    $col = "0".$col;
	}
	$template = $template.$col;
    }

    my $readname = "$template" . "." . "$suffix" . "$oligo_name";
    push @to_test, $readname;
    

    foreach my $rn (@to_test) {

	my $read = $se2->getRow('Checkfinentries::seqreadName', [$rn], $dbhTracking);
	warn "Checkfinentries::seqreadName returns\n" unless ($reduce_out);
	warn Data::Dumper::Dumper($read) unless ($reduce_out);

	if (defined $read){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[0] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[0];
	    $ERROR_INFO->[$SECT]->[$r]->[0] = "$prev -- $rn has been processed already (seqread.name entry present).";
	}
    }


}





sub check_suffix {
    my (
	$suffix,
	$SECT,
	$r,
	) = @_;

    # The suffix entry is pretty much irrelevant (because we must have an id_scsp)
    # We DO need to check the given iteration though
    # The following assumes that the iteration will always come
    # after a suffix. 
    my $iteration = substr $suffix, 3;
    my $it_len = length $iteration;

    if ($iteration ne ''){
	if ( ($it_len > 1) || ($iteration !~ /[a-z]/) ){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[1] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[1];
	    $ERROR_INFO->[$SECT]->[$r]->[1] = "$prev -- The given iteration is not valid.";
	}
    }
    return ($iteration);
}





sub check_oligo {
    my (
	$project,
	$template, 
	$suffix, 
	$oligo_name, 
	$oligo_sequence, 
	$runtype, 
	$id, 
	$add, 
	$valid_custom, 
	$oligo_seen, 
	$costcode, 
	$auto,
	$SECT,
	$r,
	) = @_;

    
    # Do we need a costcode_entry
    if ( ($oligo_name ne '') && ($oligo_sequence ne '') ){
	if ($costcode eq 'Select cost-code'){
	    $errors++;

	    $ERROR_TAG->[$SECT]->[$r]->[3] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[3];
	    $ERROR_INFO->[$SECT]->[$r]->[3] = "$prev -- New oligo orders require that a costcode is supplied.";
	}
    }


    # Is the sequence valid
    if ($oligo_sequence =~ /[^GCAT]/){
	$errors++;
	$ERROR_TAG->[$SECT]->[$r]->[3] = 'red1';
	my $prev = $ERROR_INFO->[$SECT]->[$r]->[3];
	$ERROR_INFO->[$SECT]->[$r]->[3] = "$prev -- The oligo sequence contains invalid characters.";
    }

    # If there is a sequence, then there should be a name too
    if ( ($oligo_sequence ne '')  && ($oligo_name eq '') ){
	$errors++;
	$ERROR_TAG->[$SECT]->[$r]->[3] = 'red1';
	my $prev = $ERROR_INFO->[$SECT]->[$r]->[3];
	$ERROR_INFO->[$SECT]->[$r]->[3] = "$prev -- You must specify an oligo name.";
    } 

    # Is the chemistry approriate for a custom oligo-order
    if ($oligo_name ne ''){
	unless (defined $valid_custom->{$id}){
	    unless ( ($template eq '') && ($suffix eq '') && ($oligo_name ne '') && ($oligo_sequence ne '') && ($runtype eq '') && ($id eq '') && ($add eq '') ){
		$errors++;
		$ERROR_TAG->[$SECT]->[$r]->[6] = 'red1';
		my $prev = $ERROR_INFO->[$SECT]->[$r]->[6];
		$ERROR_INFO->[$SECT]->[$r]->[6] = "$prev -- This ChemID does not require a custom oligo.";
	    }
	}
    }
    
    if ($oligo_name ne ''){

	my $length = length $oligo_name;
	if ($length > 4){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[2] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[2];
	    $ERROR_INFO->[$SECT]->[$r]->[2] = "$prev -- Oligo names should have a max of 4 characters.";
	}

	if ($oligo_name =~ /\W/){
	    $errors++;
	    $ERROR_TAG->[$SECT]->[$r]->[2] = 'red1';
	    my $prev = $ERROR_INFO->[$SECT]->[$r]->[2];
	    $ERROR_INFO->[$SECT]->[$r]->[2] = "$prev -- Oligonames should only contain chars. including a-z A-Z 1-9.";
	}
	
	if ( ($oligo_name ne '') && ($oligo_sequence ne '') ){

	    my $pc = $se2->getRow('Checkfinentries::primername', [$oligo_name, $project], $dbhTracking);
	    warn "Checkfinentries::primername returns\n" unless ($reduce_out);
	    warn Data::Dumper::Dumper($pc) unless ($reduce_out);

	    if (defined $pc){
		$errors++;
		$ERROR_TAG->[$SECT]->[$r]->[2] = 'red1';
		my $prev = $ERROR_INFO->[$SECT]->[$r]->[2];
		$ERROR_INFO->[$SECT]->[$r]->[2] = "$prev -- This oligo name is already in the database.";
	    }
	    
	    ########################################################
	    # Latest change to allow re-use of autoselected primers
	    # (But still not allow *ordering* of A* primernames 
	    ########################################################
	    if ($auto == 0){
		if ($oligo_name =~ /^A/ ){
		    $errors++;
		    $ERROR_TAG->[$SECT]->[$r]->[2] = 'red1';
		my $prev = $ERROR_INFO->[$SECT]->[$r]->[2];
		    $ERROR_INFO->[$SECT]->[$r]->[2] = "$prev -- Oligo names starting with 'A' are reserved for auto selected requests.";
		}
	    }

	}



	# New oligos require a sequence - however, the sequence may have been specified previously
	if ( ($oligo_name ne '') && ($oligo_sequence eq '') ){
	    
	    unless (defined $oligo_seen->{$oligo_name}){

		my $pc = $se2->getRow('Checkfinentries::primername', [$oligo_name, $project], $dbhTracking);
		warn "Checkfinentries::primername returns\n" unless ($reduce_out);
		warn Data::Dumper::Dumper($pc) unless ($reduce_out);

		unless (defined $pc){
		    $errors++;
		    $ERROR_TAG->[$SECT]->[$r]->[2] = 'red1';
		    my $prev = $ERROR_INFO->[$SECT]->[$r]->[2];
		    $ERROR_INFO->[$SECT]->[$r]->[2] = "$prev -- This new custom oligo requires a sequence.";
		}
	    }
	}

    }
}

# Queries whether reading $name is present in project $proj already.
# As we cannot be sure if this has been stolen etc, we search by group
# name instead of the project table.
my $pid;
sub read_in_ts_project {
    my ($proj, $name) = @_;

    if (!defined($pid)) {
	$pid = open2(\*TSIn, \*TSOut, "ts_helper");
    }

    print TSOut "INPROJ $proj $name\n";
    
    return (<TSIn> != "0");
}


1;

__END__

=head1 NAME

Checkfinentries.pm - Called by finch2 and autofinch2 via the start_check subroutine.
Used to check rows of finish requests for duplicates and errors. The data to be checked is
supplied as pages of rows of requests.

=head1 PROCESSING OVERVIEW

start_check
    
=over 4

&initDatabase

Parameter checks

EST/VIRAL bypass

Robot project ?

Whole genome project ?

Online repository path ?

Mapping from suffix to ids

Valid additives

Equus connection

Go through each row of each page(section) of the data supplied

=over 4

Each request (row) is composed of;
template, suffix, oligo-name, oligo-sequence, runtype, id_scsp, additive, id_frequest (if previously submitted)

Check new oligo sequences are only entered once

&check_suffix (and iteration)

&check_idscsp

&check_template

=over 4

&check_platename

&check_sourceplatemap

&check_pcr_plate

Check for DP availability to a team

Check for previous finishing-submissions via crusade
(Primer vs. no primer, Iteration vs. no iteration)

Check the project (disk repository) then the internal trace server 
or a WGS database for duplicate requests

=back

&check_oligo (check costcode, sequence, chemistry, oligoname)

&check_add (a valid additive ?)

&check_seqread (Request processed already ?)

&check_robot (Is the relevant template on the robot ?)

&check_not_internal (Check correct primer ordering style for finservice)

=back

Go through each row of each page(section) of the data supplied

=over 4

Check for internal order duplicates

=back

Report on duplicates, errors and missing DNA plates

=cut


