#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

# $Id: clone_query.pm,v 1.26 2000/03/20 19:12:43 dn1 Exp $
# $Log: clone_query.pm,v $
# Revision 1.26  2000/03/20  19:12:43  dn1
# *** empty log message ***
#
# Revision 1.25  2000/03/20  19:07:02  dn1
# *** empty log message ***
#
# Revision 1.24  1999/09/07  16:23:20  dn1
# *** empty log message ***
#
# Revision 1.23  1999/09/07 12:53:42  dn1
# *** empty log message ***
#
# Revision 1.22  1999/09/02 17:30:33  dn1
# *** empty log message ***
#
# Revision 1.21  1999/08/31 13:54:02  dn1
# *** empty log message ***
#
# Revision 1.20  1999/05/28 11:37:17  dn1
# *** empty log message ***
#
# Revision 1.19  1999/05/13 11:17:19  dn1
# *** empty log message ***
#
# Revision 1.18  1999/03/22 18:08:27  dn1
# *** empty log message ***
#

#print STDERR "Using local version of clone_query.pm !!!\n";

# DN1
################################################################################
#
################################################################################

package add;

sub new_clone2db {
    my ($pkg, $dbh, $CLONENAME, $SPECIESNAME, $CHROMOSOME, $SUBREGION, $SOURCENAME, $SEQ, $FUN, $SEQ_REASON, $LIBRARYNAME, $REMARK, $STATUS, $HSM, $TYPE, $session, $prog, $who) = @_;

    my $statement;
    eval {

	$statement = "insert into clone(CLONENAME, SPECIESNAME, CHROMOSOME, SUBREGION, SOURCENAME, SEQUENCED_BY, FUNDED_BY, SEQ_REASON, LIBRARYNAME, REMARK, IS_HSM, CLONE_TYPE) values(\'$CLONENAME\', \'$SPECIESNAME\', \'$CHROMOSOME\', \'$SUBREGION\', \'$SOURCENAME\',\'$$SEQ\', \'$$FUN\', \'$SEQ_REASON\', \'$LIBRARYNAME\', \'$REMARK\', \'$HSM\', \'$$TYPE\')
";
	my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth->execute || die "ERROR:$DBI::errstr";
	$sth->finish;
    };

    my @problems;
    if ($@ ne ''){
	push @problems, $@;
    }

    eval {
    # ...and the new status entry
	$statement = "
insert into clone_status (CLONENAME, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR) values (\'$CLONENAME\', \'$STATUS\' , sysdate, 1, \'$$session\', \'$prog\', \'$who\')
";

	my $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth->execute || die "ERROR:$DBI::errstr";
	$sth->finish;
    };
    if ($@ ne ''){
	push @problems, $@;
    }


    push @problems, 'End';
    return (\@problems);

}


package clone_query;

sub make_with {
    my ($pkg, $counter, $clone_name_var, $species_name_var, $chromosome_var, $subregion_var, $sourcename_var, $seq_by_var, $fun_by_var, $seqreason_var, $library_name_var, $remark_var, $status_var, $projectname_var, $externalname_var, $fingerprint_var, $hsm_var, $type_var, $pri_var, $prirem_var) = @_;
    my $query;


    ################
    # Handle select
    ################

    $query = "select unique (clone.clonename), (clone.speciesname), (clone.chromosome), (clone.subregion), (clone.sourcename), (clone.sequenced_by), (clone.funded_by), (seqreasondict.description), (clone.libraryname), (clone.remark), (clonestatusdict.description), (clone.is_hsm), (clone.clone_type)";

    ################
    # Handle from
    ################

    $query = "$query" . " from clone, clone_status, clonestatusdict, seqreasondict";

    if ($projectname_var ne ''){
	$query = "$query" . " , clone_project ";
	}
    if ($externalname_var ne ''){
	$query = "$query" . ", external_name ";
    }

    if ($fingerprint_var ne ''){
	$query = "$query" . ", fp_priority ";
    }

    if ( ($pri_var ne '') || ($prirem_var ne '') ){
	$query = "$query" . ", clone_priority ";
    }

    ###############
    # Handle where
    ###############
    # We should always join clone and clone_status
    $query = "$query" . " where clone.clonename = clone_status.clonename and clone_status.status = clonestatusdict.id_dict and clone.seq_reason = seqreasondict.id_dict and ";

    # don't other forget joins >!<
    if ($projectname_var ne ''){
	$query = "$query" . " clone.clonename = clone_project.clonename and";
    }
    if ($externalname_var ne ''){
	$query = "$query" . " clone.clonename = external_name.clonename and";
    }
    if ($fingerprint_var ne ''){
	$query = "$query" . " clone.clonename = fp_priority.clonename and";
    }
    if ( ($pri_var ne '') || ($prirem_var ne '') ){
	$query = "$query" . " clone.clonename = clone_priority.clonename and ";
    }

 
    # rest of condtions
#    if ($clone_name_var ne ''){
#	$query = "$query" . " clone.clonename = \'$clone_name_var\'";
#	$counter--;
#	unless ($counter == 0){
#	    $query = "$query" . " and ";
#	}
#    }

    if ($clone_name_var ne ''){
	if ($clone_name_var =~ /\*/){
	    $clone_name_var =~ s/\*/%/g;
	    $query = "$query" . " clone.clonename like \'$clone_name_var\'";
	} else {
	    $query = "$query" . " clone.clonename = \'$clone_name_var\'";
	}
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }


    if ($species_name_var ne ''){
	$query = "$query" . " clone.speciesname = \'$species_name_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    
    if ($chromosome_var ne ''){
	$query = "$query" . " clone.chromosome = \'$chromosome_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($subregion_var ne ''){
	$query = "$query" . " clone.subregion = \'$subregion_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($sourcename_var ne ''){
	$query = "$query" . " clone.sourcename = \'$sourcename_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($seq_by_var ne ''){
	$query = "$query" . " clone.sequenced_by = \'$seq_by_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($fun_by_var ne ''){
	$query = "$query" . " clone.funded_by = \'$fun_by_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($seqreason_var ne ''){
	$query = "$query" . " clone.seq_reason = \'$seqreason_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($library_name_var ne ''){
	$query = "$query" . " clone.libraryname = \'$library_name_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($remark_var ne ''){
	$query = "$query" . " clone.remark = \'$remark_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($status_var ne ''){
	$query = "$query" . " clone_status.status = \'$status_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($hsm_var ne ''){
	if ($hsm_var eq 'yes'){
	    $query = "$query" . " clone.is_hsm = 1 ";
	} else {
	    $query = "$query" . " clone.is_hsm = 0 ";
	}
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($type_var ne ''){
	$query = "$query" . " clone.clone_type = \'$type_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    
    if ($projectname_var ne ''){
	$query = "$query" . " clone_project.projectname = \'$projectname_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($externalname_var ne ''){
	$query = "$query" . " external_name.externalname = \'$externalname_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($fingerprint_var ne ''){
	$query = "$query" . " fp_priority.priority = \'$fingerprint_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ( ($prirem_var ne '') || ($pri_var ne '') ){
	$query = "$query" . " clone_priority.is_current = 1 and ";
    }
    

    if ($pri_var ne ''){
	$query = "$query" . " clone_priority.priority = \'$pri_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    if ($prirem_var ne ''){
	$query = "$query" . " clone_priority.remark = \'$prirem_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    $query = "$query" . " and clone_status.iscurrent = 1 ";

#    warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n";
#    warn "MAKE WITH\n";
#    warn "$query \n";
#    warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n";

    my $return = \$query;
    bless $return, 'clone_query';
    return ($return);

}

sub count_with {

    my ($pkg, $counter, $clone_name_var, $species_name_var, $chromosome_var, $subregion_var, $sourcename_var, $seq_by_var, $fun_by_var, $seqreason_var, $library_name_var, $remark_var, $status_var, $projectname_var, $externalname_var, $fingerprint_var, $hsm_var, $type_var, $pri_var, $prirem_var) = @_;

    my $query;

    ################
    # Handle select
    ################
    $query = "select count( unique(clone.clonename) )";
    
    ################
    # Handle from
    ################
    $query = "$query" . " from clone, clone_status, clonestatusdict, seqreasondict ";
    if ($projectname_var ne ''){
	$query = "$query" . " , clone_project ";
	}
    if ($externalname_var ne ''){
	$query = "$query" . ", external_name ";
    }
    if ($fingerprint_var ne ''){
	$query = "$query" . ", fp_priority ";
    }
    if ( ($pri_var ne '') || ($prirem_var ne '') ){
	$query = "$query" . ", clone_priority ";
    }
    

    ###############
    # Handle where
    ###############
    # We should always join clone and clone_status
    $query = "$query" . " where clone.clonename = clone_status.clonename and clone_status.status = clonestatusdict.id_dict and clone.seq_reason = seqreasondict.id_dict and ";

    # don't other forget joins >!<
    if ($projectname_var ne ''){
	$query = "$query" . " clone.clonename = clone_project.clonename and ";
    }
    if ($externalname_var ne ''){
	$query = "$query" . " clone.clonename = external_name.clonename and ";
    }
    if ($fingerprint_var ne ''){
	$query = "$query" . " clone.clonename = fp_priority.clonename and ";
    }
    if ( ($pri_var ne '') || ($prirem_var ne '') ){
	$query = "$query" . " clone.clonename = clone_priority.clonename and ";
    }




    # rest of conditions
    if ($clone_name_var ne ''){
	if ($clone_name_var =~ /\*/){
	    $clone_name_var =~ s/\*/%/g;
	    $query = "$query" . " clone.clonename like \'$clone_name_var\'";
	} else {
	    $query = "$query" . " clone.clonename = \'$clone_name_var\'";
	}
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }



    if ($species_name_var ne ''){
	$query = "$query" . " clone.speciesname = \'$species_name_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    
    if ($chromosome_var ne ''){
	$query = "$query" . " clone.chromosome = \'$chromosome_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($subregion_var ne ''){
	$query = "$query" . " clone.subregion = \'$subregion_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    
    if ($sourcename_var ne ''){
	$query = "$query" . " clone.sourcename = \'$sourcename_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($seq_by_var ne ''){
	$query = "$query" . " clone.sequenced_by = \'$seq_by_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($fun_by_var ne ''){
	$query = "$query" . " clone.funded_by = \'$fun_by_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($seqreason_var ne ''){
	$query = "$query" . " clone.seq_reason = \'$seqreason_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($library_name_var ne ''){
	$query = "$query" . " clone.libraryname = \'$library_name_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($remark_var ne ''){
	$query = "$query" . " clone.remark = \'$remark_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($status_var ne ''){
	$query = "$query" . " clone_status.status = \'$status_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($hsm_var ne ''){

	if ($hsm_var eq 'yes'){
	    $query = "$query" . " clone.is_hsm = 1 ";
	} else {
	    $query = "$query" . " clone.is_hsm = 0 ";
	}
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($type_var ne ''){
	$query = "$query" . " clone.clone_type = \'$type_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($projectname_var ne ''){
	$query = "$query" . " clone_project.projectname = \'$projectname_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    if ($externalname_var ne ''){
	$query = "$query" . " external_name.externalname = \'$externalname_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }    

    if ($fingerprint_var ne ''){
	$query = "$query" . " fp_priority.priority = \'$fingerprint_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }

    #here
    if ( ($prirem_var ne '') || ($pri_var ne '') ){
	$query = "$query" . " clone_priority.is_current = 1 and";
    }


    if ($pri_var ne ''){
	$query = "$query" . " clone_priority.priority = \'$pri_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    if ($prirem_var ne ''){
	$query = "$query" . " clone_priority.remark = \'$prirem_var\'";
	$counter--;
	unless ($counter == 0){
	    $query = "$query" . " and ";
	}
    }
    

    $query = "$query" . " and clone_status.iscurrent = 1 ";
    
#    warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n";
#    warn "COUNT WITH\n";
#    warn "$query \n";
#    warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n";

    my $return = \$query;
    bless $return, 'clone_query';
    return ($return);
}

#-----------------------------------------------------------------------------
#-----------------------------------------------------------------------------

package datastructure;

sub new {
    my ($pkg, $FINGERPRINT, $OVERLAPS, $external, $projectname, $r_clonename, $r_speciesname, $r_chromosome, $r_subregion, $r_sourcename, $r_sequenced, $r_funded, $r_seq_reason, $r_libraryname, $r_remark, $r_status, $r_hsm, $r_clone_type, $PRIORITY) = @_;
    my %clone_hash = (
		      "Clonename" => $r_clonename,
		      "Speciesname" => $r_speciesname,
		      "Chromosome" => $r_chromosome,
		      "Subregion" => $r_subregion,
		      "Sourcename" => $r_sourcename,
		      "Sequenced_by" => $r_sequenced,
		      "Funded_by" => $r_funded,
		      "Seq_reason" => $r_seq_reason,
		      "Libraryname" => $r_libraryname,
		      "Remark" => $r_remark,
		      "Status" => $r_status,
		      "hsm" => $r_hsm,
		      "type" => $r_clone_type
		      );
    my $clone_hash = \%clone_hash;
    
    my %hash = (
		"Clone_info" => $clone_hash,
		"External_info" => $external,
		"Projectname_info" => $projectname,
		"Overlaps_info" => $OVERLAPS,
		"Fingerprint_info" => $FINGERPRINT,
		"Priority_info" => $PRIORITY
		);

    my $return = \%hash;    
    bless $return, $pkg;
    return ($return);

}

sub lock_data {
    my ($hit, $dbh) = @_;

    ################################################
    # Try and lock the clone table's relevant entry
    ################################################

    my $lock_fail = 0;

    eval {
	my $statement = "
select clonename, speciesname, chromosome, subregion, sourcename, sequenced_by, funded_by, seq_reason, libraryname, remark, is_hsm, clone_type
from clone
where clonename = \'$hit->{Clone_info}->{Clonename}\'
for update nowait 
";

	my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	$sth1->finish;
    };

    #####################
    # Could we do it >?<
    #####################

    #warn "$@\n";

    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){

	#############################
	# No :-( It's already locked
	#############################
	$lock_fail++;
    } else {
	######################################################################################
	# Yes :-) we've now locked this bit... what about external_name and clone_project >?<
	#
	# look in ARRAY $hit->{Projectname_info}
	# and     ARRAY  $hit->{External_info}
	######################################################################################
	my $p_counter = @{$hit->{Projectname_info} };
	my $e_counter = @{$hit->{External_info} };	
	my $laps_counter = @{$hit->{Overlaps_info} };
	my $next;
	foreach $next(1 .. ($p_counter-1)){
	    #warn "$next Projectname $hit->{Projectname_info}->[$next] \n";

	    eval {
		$statement = "
select clone_project.clonename, clone_project.projectname 
from clone_project
where clone_project.projectname = \'$hit->{Projectname_info}->[$next]\'
and clone_project.clonename = \'$hit->{Clone_info}->{Clonename}\'
for update nowait
";

		$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
		$sth1->execute || die "ERROR:$DBI::errstr";
		$sth1->finish;
	    };

#	    warn "$@\n";

	    #####################
	    # Could we do it >?<
	    #####################
	    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){

		#############################
		# No :-( It's already locked
		#############################
		$lock_fail++;
	    } else {
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
		#warn "@ locked projectname ok !\n";
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
	    }


	}

	foreach $next(1 .. ($e_counter-1)){
#	    warn "$next Externalname $hit->{External_info}->[$next] \n";

	    eval {
		$statement = "
select external_name.clonename, external_name.externalname 
from external_name
where external_name.externalname = \'$hit->{External_info}->[$next]\'
and external_name.clonename = \'$hit->{Clone_info}->{Clonename}\'
for update nowait
";

		$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
		$sth1->execute || die "ERROR:$DBI::errstr";
		$sth1->finish;
	    };

#	    warn "$@\n";

	    #####################
	    # Could we do it >?<
	    #####################
	    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){
	    
		#############################
		# No :-( It's already locked
		#############################
		$lock_fail++;
	    } else {
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
		#warn "@ locked externalname ok !\n";
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
	    }
	}

	eval {
	    $statement = "
select fp_priority.priority, fp_priority.clonename
from fp_priority
where fp_priority.clonename = \'$hit->{Clone_info}->{Clonename}\'
for update nowait
";
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish;
	};

	
	#warn "$@\n";

	    #####################
	    # Could we do it >?<
	    #####################
	if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){
	    
		#############################
		# No :-( It's already locked
		#############################
	    $lock_fail++;
	} else {
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
		#warn "@ locked fp_priority ok !\n";
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
	}

	#NEW -clone priority
	##################################################
	eval {
	    $statement = "
select clone_priority.clonename, clone_priority.assign_date, clone_priority.is_current, clone_priority.priority, clone_priority.remark, clone_priority.operator
from clone_priority
where clone_priority.clonename = \'$hit->{Clone_info}->{Clonename}\'
for update nowait
";
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish;
	};

	
	#warn "$@\n";

	    #####################
	    # Could we do it >?<
	    #####################
	if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){
	    
		#############################
		# No :-( It's already locked
		#############################
	    $lock_fail++;
	} else {
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
		#warn "@ locked fp_priority ok !\n";
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
	}
	##################################################
	#NEW -clone priority



	foreach $next(1 .. ($laps_counter-1)){

	    eval {
		$statement = "
select clone_overlaps.CLONENAME, clone_overlaps.OVERLAPS_CLONE, clone_overlaps.CONFIRMATION, clone_overlaps.SIZE_BP, clone_overlaps.VARIATION_CHECK, clone_overlaps.REMARK
from clone_overlaps
where clone_overlaps.CLONENAME = \'$hit->{Overlaps_info}->[$next]->{CLONENAME}\'
and clone_overlaps.OVERLAPS_CLONE = \'$hit->{Overlaps_info}->[$next]->{OVERLAPS_CLONE}\'
for update nowait
";

		$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
		$sth1->execute || die "ERROR:$DBI::errstr";
		$sth1->finish;
	    };

#	    warn "$@\n";
	    
	    #####################
	    # Could we do it >?<
	    #####################
	    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){
	    
		#############################
		# No :-( It's already locked
		#############################
		$lock_fail++;
	    } else {
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
		#warn "@ locked externalname ok !\n";
		#warn "@@@@@@@@@@@@@@@@@@@@@@@@\n";
	    }
	}

    }

###################################################################################################

    #####################################################################
    # NEW ! We also need to lock the recorded status info for this clone
    #####################################################################
    eval {
	my $statement = "
select CLONENAME, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR
from clone_status
where CLONENAME = \'$hit->{Clone_info}->{Clonename}\'
for update nowait
";

	my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	$sth1->finish;
    };

#    warn "$@\n";

    #####################
    # Could we do it >?<
    #####################
    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){

	#############################
	# No :-( It's already locked
	#############################
	$lock_fail++;
    
    }

###################################################################################################


    ##########################################################
    # ... so if $lock_fail is 1 the lock has failed somewhere
    ##########################################################

    #warn "lock -> $lock_fail !!! \n";

    return($lock_fail);

}


sub delete_alias {
    my ($hit, $dbh, $e_current_hit) = @_;

#    warn "Current EX name -> $e_current_hit \n";

#        # 1 - Name_a    
#        # 2 - Name_b
##--->   # 3 - Name_c  <---- We need to remove this one from the datastruct and shuffle all following entries up >!<
#        # 4 - Name_d
#        # 5 - Name_e
#    
#    my $capture = Data::Dumper::Dumper( $hit );
#    warn "THIS DATA ; Inside delete_alias >!< \n";
#    warn  "---------------------------------------------------------------- \n";
#    warn "$capture";

    # We can use $e_current_hit to cut the array in half :-)
    my @scrag_ends = splice @{$hit->{External_info}}, ($e_current_hit);
    # Now take the first entry off @scrag_ends (the one we don't want any more)
    my $not_wanted = shift @scrag_ends;    
    # ...and re-make the original array
    push @{$hit->{External_info}}, @scrag_ends;
}

sub add_alias {
    my ($hit, $dbh, $e_current_hit, $value) = @_;
    $hit->{External_info}->[$e_current_hit] = $value;
}

sub add_overlap {
    my ($hit, $dbh, $laps_current_hit, $clonename, $overlaps_clone) = @_;
    $hit->{Overlaps_info}->[$laps_current_hit]->{CLONENAME} = $clonename;
    $hit->{Overlaps_info}->[$laps_current_hit]->{OVERLAPS_CLONE} = $overlaps_clone;
}


sub change_priority_assigned {
    my ($hit, $dbh, $value1, $value2) = @_;
    $hit->{Priority_info}->[1]->{priority} = $value1;
    $hit->{Priority_info}->[1]->{remark} = $value2;
    
}

sub save_changes {
    my ($hit, $dbh, $old_hit, $sessionID, $prog, $who) = @_;

    my @problems = ();

    # Clone info
    ###############################
    # chromosome -> chromosomedict
    ###############################
       
    my ($chr_id_dict) = convert->chromosome2id_dict($dbh, $hit->{Clone_info}->{Chromosome}, $hit->{Clone_info}->{Speciesname});


#    warn "chr_id_dict $chr_id_dict $$chr_id_dict ... Chromosome $hit->{Clone_info}->{Chromosome} ... Speciesname $hit->{Clone_info}->{Speciesname}\n";


    #############################
    # seqreason -> seqreasondict
    #############################
    my ($reason_id_dict) = convert->seq_reason2id_dict($dbh, $hit->{Clone_info}->{Seq_reason});

    #####################
    # id_org -> orgtitle
    #####################
    my ($sequenced) = convert->org2id_dict($dbh, $hit->{Clone_info}->{Sequenced_by});
    my ($funded) = convert->org2id_dict($dbh, $hit->{Clone_info}->{Funded_by});

    ######
    # hsm
    ######
    my $hsm;
    if ($hit->{Clone_info}->{hsm} eq 'yes'){
	$hsm = 1;
    } else {
	$hsm = 0;
    }

    #############
    # clone_type
    #############
    my ($clone_type) = convert->clone_type2id_dict($dbh, $hit->{Clone_info}->{type});

    #####################################
    # A simple update of the clone table
    #####################################

    eval {
	my $statement = "
update clone
set 
CLONENAME = \'$hit->{Clone_info}->{Clonename}\', 
SPECIESNAME = \'$hit->{Clone_info}->{Speciesname}\', 
CHROMOSOME = \'$$chr_id_dict\', 
SUBREGION = \'$hit->{Clone_info}->{Subregion}\', 
SOURCENAME = \'$hit->{Clone_info}->{Sourcename}\', 
SEQUENCED_BY = \'$$sequenced\',
FUNDED_BY = \'$$funded\',
SEQ_REASON = \'$$reason_id_dict\', 
LIBRARYNAME = \'$hit->{Clone_info}->{Libraryname}\', 
REMARK = \'$hit->{Clone_info}->{Remark}\',
IS_HSM = \'$hsm\',
CLONE_TYPE = \'$$clone_type\'
where clonename = \'$hit->{Clone_info}->{Clonename}\'
";

#	warn "\n$statement\n";


	my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	$sth1->finish();
    };

    if ($@ ne ''){
	push @problems, $statement;
	push @problems, $@;
    }


    ###############################
    # (-) Handle any status change
    ###############################
    # Do we actually have a status-change >?<
    my $old_status = $old_hit->{Clone_info}->{Status};
    my $new_status = $hit->{Clone_info}->{Status};
#    warn "old_status -> $old_status \n";
#    warn "new_status -> $new_status \n";
    if ($new_status ne $old_status){
	##############################################
	# Set the old active status to be non current
	##############################################

	eval {
	    $s = "
update clone_status
set ISCURRENT = 0
where clonename = \'$hit->{Clone_info}->{Clonename}\'
and ISCURRENT = 1
";
	    $sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();
	};

	if ($@ ne ''){
	    push @problems, $s;
	    push @problems, $@;
	}

	################################################
	# Convert our new status description into an id
	################################################
	my $id_status = convert->clone_status2id_dict($dbh, $hit->{Clone_info}->{Status});

	###########################
	# ... and make a new entry 
	###########################
	eval {
	    $s = "
insert into clone_status (CLONENAME, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR)
values (\'$hit->{Clone_info}->{Clonename}\', \'$$id_status\', sysdate, 1, \'$$sessionID\', \'$prog\', \'$who\')
";
	$sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	$sth1->finish();
	};
	
	if ($@ ne ''){
	    push @problems, $s;
	    push @problems, $@;
	}
    }

    #------------------------------------
    
    ####################################
    # (-) Handle fingerprinting_comment
    ####################################
    # if its gone missing -> delete it
    # if its appeared -> insert it
    # if its changed -> update it
    my $old_comment = $old_hit->{Fingerprint_info}->[1];
    my $new_comment = $hit->{Fingerprint_info}->[1];

    my $statement;
    if ($old_comment ne '' && $new_comment eq ''){
	#delete
	$statement = "delete from fp_priority where clonename = \'$old_hit->{Clone_info}->{Clonename}\'";
	#warn $statement;
	eval {
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();
	};

    } elsif ($old_comment eq '' && $new_comment ne ''){
	#insert
	$statement = "insert into fp_priority(clonename, priority) values (\'$hit->{Clone_info}->{Clonename}\', \'$hit->{Fingerprint_info}->[1]\')";
	#warn $statement;
	eval {
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();
	};

    } elsif ($old_comment eq '' && $new_comment eq ''){
	#do nothing

    } else {
	#update
	$statement = "update fp_priority set priority = \'$hit->{Fingerprint_info}->[1]\' where clonename = \'$hit->{Clone_info}->{Clonename}\'";
	#warn $statement;
	eval {
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();
	};
    }

    if ($@ ne ''){
	push @problems, $s;
	push @problems, $@;
    }


    #------------------------------------
    


    #############################################
    # (-) Handle multiples of external name info
    #############################################

    ######################
    # Grab the first list
    ######################
    my @old_external_names = @{$old_hit->{External_info}};
    #######################
    # Grab the second list
    #######################
    my @new_external_names = @{$hit->{External_info}};

#    warn "old -> @old_external_names \n";
#    warn "new -> @new_external_names \n";

    ########################################################################
    # Go though the first list and see what is missing from the second list
    # -> DELETES
    ########################################################################
    my $next;
    my $next2;
    foreach $next (@old_external_names){
	my $seen = 0;
	foreach $next2 (@new_external_names){
#	    warn "Now comparing $next against $next2 \n";
	    if ($next2 eq $next){
		$seen = 1;
	    }
	}
	if ($seen == 0){

	    ############################################
	    # Delete the externalname entry in question
	    ############################################
	    eval {
		$s = "
delete 
from external_name 
where EXTERNALNAME = \'$next\' and CLONENAME = \'$hit->{Clone_info}->{Clonename}\'
";
		$sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
		$sth1->execute || die "ERROR:$DBI::errstr";
		$sth1->finish();    
	    };

	    if ($@ ne ''){
		push @problems, $s;
		push @problems, $@;
	    }
	}
    }
    #########################################################################
    # Go through the second list and see what is missing from the first list
    # -> INSERTS
    #########################################################################

#    warn "******************************************************************* \n";
#    warn "******************************************************************* \n";

    my @to_add;
    foreach $next2 (@new_external_names){
	my $seen = 0;
	foreach $next (@old_external_names){
#	    warn "Now comparing $next2 against $next \n";
	    if ($next2 eq $next){
		$seen = 1;
#		warn "HIT \n";
	    }
	}
	if ($seen == 0){
#	    warn "adding $next2 \n";
	    push @to_add, $next2;
	}
    }

#    warn "to_add -> @to_add \n";
    foreach $next (@to_add){

	##########################################
	# Insert the new externalname into the db
	##########################################
	eval {
	    $s = "
insert into external_name
values (\'$hit->{Clone_info}->{Clonename}\', \'$next\')
";
	    $sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();
	};
	if ($@ ne ''){
	    push @problems, $s;
	    push @problems, $@;
	}    
    }


    
    # ------------------------------------------------------------------------------------------------
    # ------------------------------------------------------------------------------------------------


    #############################################
    # (-) Handle multiples of clone_overlaps info
    #############################################

    ######################
    # Grab the first list
    ######################
    my @old_laps = @{$old_hit->{Overlaps_info}};
    my $array_count = ($#old_laps);

    #######################
    # Grab the second list
    #######################
    my @new_laps = @{$hit->{Overlaps_info}};
    my $new_array_count = ($#new_laps);

    #warn "In new list -----> $new_array_count\n";

    #################################################
    # ! NEW ! We must handle any NEW overlap entries
    #################################################
    # Identify the new ones >?< These will be any greater than $array_count !
    
    foreach my $t ( ($array_count+1) .. ($new_array_count) ){

	#warn "$hit->{Overlaps_info}->[$t]->{CLONENAME}\n";
	#warn "$hit->{Overlaps_info}->[$t]->{OVERLAPS_CLONE}\n";
	#warn "$hit->{Overlaps_info}->[$t]->{CONFIRMATION}\n";
	#warn "$hit->{Overlaps_info}->[$t]->{SIZE_BP}\n";
	#warn "$hit->{Overlaps_info}->[$t]->{VARIATION_CHECK}\n";
	#warn "$hit->{Overlaps_info}->[$t]->{OLR}\n";

	my $CONFIRMATION_id;
	if ($hit->{Overlaps_info}->[$t]->{CONFIRMATION} eq 'Not checked'){
	    $CONFIRMATION_id = '';
	} else {
	    $CONFIRMATION_id = convert->confirmation2id_dict($dbh, $hit->{Overlaps_info}->[$t]->{CONFIRMATION});
	    $CONFIRMATION_id = $$CONFIRMATION_id;
	}
	my $VARIATION_CHECK_id;
	if ($hit->{Overlaps_info}->[$t]->{VARIATION_CHECK} eq 'Not checked'){
	    $VARIATION_CHECK_id = '';
	} else {
	    $VARIATION_CHECK_id = convert->variation_check2id_dict($dbh, $hit->{Overlaps_info}->[$t]->{VARIATION_CHECK});
	    $VARIATION_CHECK_id = $$VARIATION_CHECK_id;
	}
	my $SIZE_BP_id;
	if ($hit->{Overlaps_info}->[$t]->{SIZE_BP} eq ''){
	    $SIZE_BP_id = '';
	} else {
	    $SIZE_BP_id = $hit->{Overlaps_info}->[$t]->{SIZE_BP};
	}
	
	my $REMARK_id;
	if ($hit->{Overlaps_info}->[$t]->{OLR} eq ''){
	    $REMARK_id = '';
	} else {
	    $REMARK_id = $hit->{Overlaps_info}->[$t]->{OLR};
	}

	eval {
	    $s = "
insert into clone_overlaps(CLONENAME, OVERLAPS_CLONE, CONFIRMATION, SIZE_BP, VARIATION_CHECK, REMARK)
values(\'$hit->{Overlaps_info}->[$t]->{CLONENAME}\', \'$hit->{Overlaps_info}->[$t]->{OVERLAPS_CLONE}\', \'$CONFIRMATION_id\', \'$SIZE_BP_id\', \'$VARIATION_CHECK_id\', \'$REMARK_id\')
";
	    $sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();    
	};
	if ($@ ne ''){
	    push @problems, $s;
	    push @problems, $@;
	}
	
    }
    # ---------------------------------------------------------------------- end of new bit


    ########################################################################
    # Go though the first list and see what is different in the second list
    # -> UPDATES
    # We need to compare CONFIRMATION, SIZE_BP and VARIATION_CHECK
    ########################################################################
    #my $next;
    foreach $next (1 .. $array_count){
	
	#warn "OLD --------------------------- NEW\n";
	#warn "$old_hit->{Overlaps_info}->[$next]->{CONFIRMATION} $hit->{Overlaps_info}->[$next]->{CONFIRMATION}";
	#warn "$old_hit->{Overlaps_info}->[$next]->{SIZE_BP} $hit->{Overlaps_info}->[$next]->{SIZE_BP}";
	#warn "$old_hit->{Overlaps_info}->[$next]->{VARIATION_CHECK} $hit->{Overlaps_info}->[$next]->{VARIATION_CHECK}";
	#warn "$old_hit->{Overlaps_info}->[$next]->{OLR} $hit->{Overlaps_info}->[$next]->{OLR}";

	if ( ($old_hit->{Overlaps_info}->[$next]->{CONFIRMATION} ne $hit->{Overlaps_info}->[$next]->{CONFIRMATION}) || ($old_hit->{Overlaps_info}->[$next]->{SIZE_BP} ne $hit->{Overlaps_info}->[$next]->{SIZE_BP}) || ($old_hit->{Overlaps_info}->[$next]->{VARIATION_CHECK} ne $hit->{Overlaps_info}->[$next]->{VARIATION_CHECK}) || ($old_hit->{Overlaps_info}->[$next]->{OLR} ne $hit->{Overlaps_info}->[$next]->{OLR}) ){

	    #######################################################################
	    # Need to convert $hit->{Overlaps_info}->[$next]->{CONFIRMATION}   and 
	    #                 $hit->{Overlaps_info}->[$next]->{VARIATION_CHECK}
	    # into id's or 'NULL's
            ######################################################################
	    my $CONFIRMATION_id;
	    if ($hit->{Overlaps_info}->[$next]->{CONFIRMATION} eq 'Not checked'){
		$CONFIRMATION_id = 'NULL';
	    } else {
		$CONFIRMATION_id = convert->confirmation2id_dict($dbh, $hit->{Overlaps_info}->[$next]->{CONFIRMATION});
		$CONFIRMATION_id = $$CONFIRMATION_id;
	    }
	    my $VARIATION_CHECK_id;
	    if ($hit->{Overlaps_info}->[$next]->{VARIATION_CHECK} eq 'Not checked'){
		$VARIATION_CHECK_id = 'NULL';
	    } else {
		$VARIATION_CHECK_id = convert->variation_check2id_dict($dbh, $hit->{Overlaps_info}->[$next]->{VARIATION_CHECK});
		$VARIATION_CHECK_id = $$VARIATION_CHECK_id;
	    }
	    my $SIZE_BP_id;
	    if ($hit->{Overlaps_info}->[$next]->{SIZE_BP} eq ''){
		$SIZE_BP_id = NULL;
	    } else {
		$SIZE_BP_id = $hit->{Overlaps_info}->[$next]->{SIZE_BP};
	    }

	    my $REMARK_id;
	    if ($hit->{Overlaps_info}->[$next]->{OLR} eq ''){
		$REMARK_id = 'NULL';
	    } else {
		$REMARK_id = $hit->{Overlaps_info}->[$next]->{OLR};
	    }

	 eval {
	     if ($REMARK_id ne 'NULL'){
		 $s = "
update clone_overlaps set confirmation = $CONFIRMATION_id, size_bp = $SIZE_BP_id, variation_check = $VARIATION_CHECK_id, remark = \'$REMARK_id\' where clonename = \'$hit->{Overlaps_info}->[$next]->{CLONENAME}\' and overlaps_clone = \'$hit->{Overlaps_info}->[$next]->{OVERLAPS_CLONE}\' 
";
	     } else {
		 $s = "
update clone_overlaps set confirmation = $CONFIRMATION_id, size_bp = $SIZE_BP_id, variation_check = $VARIATION_CHECK_id, remark = $REMARK_id where clonename = \'$hit->{Overlaps_info}->[$next]->{CLONENAME}\' and overlaps_clone = \'$hit->{Overlaps_info}->[$next]->{OVERLAPS_CLONE}\' 
";
	     }
	     $sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	     $sth1->execute || die "ERROR:$DBI::errstr";
	     $sth1->finish();    
	 };

	    if ($@ ne ''){
		push @problems, $s;
		push @problems, $@;
	    }
	}
    }
    push @problems, "End";
    return (@problems);
}



sub save_PRIORITY_changes {
    my ($hit, $dbh, $old_hit, $sessionID, $prog, $who) = @_;
    my @problems = ();
    ######################
    # Grab the first list
    ######################
    my $old_priority = $old_hit->{Priority_info}->[1]->{priority};
    my $old_remark = $old_hit->{Priority_info}->[1]->{remark};
    #######################
    # Grab the second list
    #######################
    my $new_priority = $hit->{Priority_info}->[1]->{priority};
    my $new_remark = $hit->{Priority_info}->[1]->{remark};

    #warn "old_priority -> $old_priority old_remark -> $old_remark\n";
    #warn "new_priority -> $new_priority new_remark -> $new_remark\n";

    if ( ($old_priority ne $new_priority) || ($old_remark ne $new_remark) ) {
	eval {

	    my $new_priority_id = convert->priority2id_dict($dbh, $new_priority);

	    my $s = "update clone_priority set is_current = 0 where clonename = \'$hit->{Clone_info}->{Clonename}\'";

	    #warn "$s\n";

	    my $sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();

	    $s = "insert into clone_priority (CLONENAME, ASSIGN_DATE, IS_CURRENT, PRIORITY, REMARK, OPERATOR) values (\'$hit->{Clone_info}->{Clonename}\', sysdate, 1, \'$$new_priority_id\', \'$new_remark\', \'$who\')";

	    #warn "$s\n";

	    $sth1 = $dbh->prepare($s) || die "ERROR:$DBI::errstr";
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $sth1->finish();    
	};
	
	if ($@ ne ''){
	    push @problems, $s;
	    push @problems, $@;
	}
    }
    
    push @problems, "End";
    return (@problems);
}

package clone_history;

sub lock_data {
    my ($self, $hit, $dbh) = @_;
    my $lock_fail = 0;
    eval {
	my $statement = "
select CLONENAME, STATUS, STATUSDATE, ISCURRENT, SESSIONID, PROGRAM, OPERATOR
from clone_status
where CLONENAME = \'$hit\'
for update nowait
";
#	warn "$statement\n";
	my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	$sth1->finish;
    };

    #####################
    # Could we do it >?<
    #####################
    if ($@ =~ /ORA-00054: resource busy and acquire with NOWAIT specified/){

	#############################
	# No :-( It's already locked
	#############################
	$lock_fail++;
    } 

    return($lock_fail);
}


1;






