#! /usr/local/bin/perl -wc

=head1 NAME

ExoSeqDB.pm - Database API for ExoSeq

=head1 DESCRIPTION

API to abstract database access to SNP for ExoSeq.

Rather a small API at the moment.

=head1 AUTHOR

mca with dn1, seh

=cut

package ExoSeqDB;
use strict;
use sql_engine;
use Checkbarcode;
use constant VERSION => (qw$Revision: 1.1 $)[1];

sub new {
  my $proto = shift;

  my %args = @_;
  my $db_name     = delete $args{-database} || 'snp';
  my $sqllib_path = delete $args{-default_sql_lib_path}; # undef = use the default
  die "Unknown args (", keys %args, ") for new ExoSeqDB" if scalar keys %args;

  my $class = ref($proto) || $proto;
  my $self = bless {}, $class;

  $self->{db_name} = $db_name;
  $self->{STATEMENTS} = statements->new($db_name);
  $self->_STATEMENTS->default_sql_lib_path($sqllib_path) if defined $sqllib_path;

  return $self;
}

# public wrapper function...  calls to this should be cleaned up, in theory
sub legacy_STATEMENTS { return $_[0]->_STATEMENTS }

# package's private sql_engine accessor
sub _STATEMENTS { return $_[0]->{STATEMENTS} }


# Check the given scanned ID.
# Return a hashref (keys: forename, surname, id_role, email, teamname) on success
#   or a scalar error message
sub db_check_user {
    my $self = shift;
    my $scanned = shift;

    #### check barcode sensible
    my $hash_return = Verifynumber($scanned, "ID");
    if ($hash_return->{Process} ne 'Good'){
	return "ERROR not a personal identifier";
    }
    my $id_person = $hash_return->{Number};

    my ($person) = eval{
	$self->_STATEMENTS->get('ExoSeq.sql_lib::get_person', ['ExoSeq', $id_person]);
    };
    if ($@ ne ''){
	return "DATABASE ERROR: $@";
    }
    elsif($person->[0]->[0]){
	my %person;
	@person{qw( forename surname id_role email teamname )} = @{ $person->[0] };
	return \%person;
    }
    else{
	return "You not registered to use this interface";
    }
}


# Check the given plate is 96 well EP, "Recieved" or "Created".
# Return arrayref containing relevant info, or scalar error message
sub db_check_plate {
    my $self = shift;
    my $scanned = shift;
    my $pre = shift; # "EP"
    my $get_priority = shift; # bool, should we read plate priority?

    my $hash_return = Verifynumber($scanned, $pre);
    if ($hash_return->{Process} ne 'Good') {
	return "ERROR: $scanned is not a suitable barcode for a STS plate";
    }
    my $id_sts_plate  = $hash_return->{Number};

    my $ols;
    my $priority = '-';
    my ($plate_type, $team);
    eval {
	# Query returns oligoname(s) in 1st + last well of specified plate,
	# provided it is 96 well with current status 'Recieved' or 'Created'.
	$ols =  $self->_STATEMENTS->get('ExoSeq.sql_lib::get_first_last', [$id_sts_plate]);
	# cols: oligoname, id_map, id_order

	if ($get_priority) {
	    # XXX: slow query
	    my $urgency = $self->_STATEMENTS->get('ExoSeq.sql_lib::find_plate_urgency', [$id_sts_plate]);
	    # Likely to return multiple rows.  We finish reading on the last,
	    # gives us the highest priority oligo on the plate.
	    foreach my $l (@{$urgency}) {
		$priority = $l->[1];
	    }
	}

	# DUP: from ExoSeq_STSarray's update_db
	my $typ = $self->_STATEMENTS->get('ExoSeq.sql_lib::get_oligoplate_det2', [$id_sts_plate]);
	($plate_type, $team) = @{ $typ->[0] };
    };

    if ($@) {
	return "Database ERROR: $@";
    }

    unless (defined $ols->[0]->[0] &&
	    defined $ols->[1]->[0] &&
	    defined $ols->[0]->[2] ) {
	return "ERROR: STS plate $id_sts_plate is not valid for processing";
    }

    # If we have scanned a mix plate, we should get back 4x records
    # If we have scanned a 'Sense' or 'Antisense' plate then we should get back 2x records
    # (unless H12 happens to be empty, e.g. some t35 plates)

    my $no_ret = scalar @$ols;
    my ($a1, $h12);
    if (grep { $plate_type == $_ } (1,2, 6,7, 10,11)) {
	# sense or anti; dilution sense or anti; aliquot sense or anti
	$a1  = $ols->[0]->[0];
	$h12 = $ols->[1]->[0];
	if ($no_ret != 2) {
	    return "STS plate $id_sts_plate: Inappropriate number of oligo records ($no_ret, expected 2)";
	}
    } elsif (grep { $plate_type == $_ } (3, 13)) {
	# mix; aliquot mix
	$a1  = "$ols->[0]->[0] + $ols->[1]->[0]";
	if ($no_ret != 4) {
	    warn "*** Mix plate $id_sts_plate is not full?  Platetrack may not accept it.\n";
	    # not much point failing the plate; this has been allowed in the past
	    $h12 = "";
	} else {
	    $h12 = "$ols->[2]->[0] + $ols->[3]->[0]";
	}
    } else {
	# This may catch cases that used to be allowed...
	return "ERROR: Sorry, I cannot handle plate_type = $plate_type.  Please ask for support.";
    }
    # Just because we allowed it here doesn't mean the script will accept it!
    # That said, adding to what is allowed here may make dependent scripts look dumb in places.


    # Fields (visible, invisible)
    #   ['Old Plate ID ', 'Oligo A1', 'Oligo H12', 'New Plate ID', 'Urgency']
    #   id_order@a1, oligoplate.plate_type
    return [ $id_sts_plate, $a1, $h12, undef, $priority,
	     $ols->[0]->[2], $plate_type ];
}


# Create new oligoplate, fill wells with specified contents, make 'Created' status.
# Returns new id_oligoplate, will die if something fails.
sub create_oligoplate {
    my ($self,
	$plate_type, $id_order, $format, $team,
	$session, $id_role, $prog,
	@wells, # list of [ rowcol_map.id_map, order_well.id_oo, order_well.id_oo ... ]
	) = @_;

    my $STATEMENTS = $self->_STATEMENTS;

    my $new_id_oligoplate = $STATEMENTS->get('ExoSeq.sql_lib::next_oligoplate')->[0]->[0];

    $STATEMENTS->do('ExoSeq.sql_lib::insert_oligoplate',
		    [ $new_id_oligoplate, $plate_type, $id_order, $format, $team ]);

    for (my $i=0; $i<@wells; $i++) {
	# $i is just an index, not guaranteed to relate to well number or anything

	my $id_well  = $STATEMENTS->get('ExoSeq.sql_lib::next_oligowell');
	$id_well = $id_well->[0]->[0];

	my ($pos, @id_oo) = @{ $wells[$i] };

	$STATEMENTS->do('ExoSeq.sql_lib::insert_oligoplatewell',
			[$id_well, $pos, $new_id_oligoplate ]);

	# warn "inserting orderwell $id_well, ", (join " & ", @id_oo), "\n";

	# We need to make 2x entries if this is a mixed oligoplate
	# (likely 1 or 2, but in general "some")
	foreach my $id_oo (@id_oo) {
	    $STATEMENTS->do('ExoSeq.sql_lib::insert_orderwell',
			    [ $id_oo, $id_well ]);
	}
    }

    ################# Give plate 'Created' Status #################
    $STATEMENTS->do('ExoSeq.sql_lib::insert_oligoplatestatus',
		    [$new_id_oligoplate,
		     4,		# status
		     1,		# is_current
		     $id_role,
		     $session,
		     $prog
		    ]);
    return $new_id_oligoplate;
}


# Return list of suitable other-sense plates for the one given,
# or () if there are none,
# or die if an error occurs.
# XXX: Slow.  Could be speeded up by running one find_othersense_oligoplate and then getting id_oo for all wells on those plates, checking them directly.  That's more code though.
sub mixer_findpaired {
    my ($self, $id_oligoplate, $well_count) = (shift, shift, shift);

    # DUP: from update_db
    my %sts;
    my $sts = $self->_STATEMENTS->get('ExoSeq.sql_lib::get_stswells', [$id_oligoplate]);
    #         [ [ id_map, id_oo ] x (wells * oligos_per_well) ]
    foreach my $s (@$sts){
	push(@{$sts{$s->[0]}}, $s->[1]);
    }

    my %plates; # key = id_oligoplate, value = wells found to contain matching othersense oligo
    foreach my $id_map (keys %sts) {
	# For each well's oligo, find the plates which have the othersense in the same position
	my @id_oo = @{ $sts{$id_map }};
	if (@id_oo == 0) {
	    $well_count --;
	    next;
	} elsif (@id_oo > 1) {
	    die "Found multiple oligos (id_oo=@id_oo) in a non-mix plate";
	}

	my $oo = $self->_STATEMENTS->get('ExoSeq.sql_lib::find_othersense_oligoplate', [ $id_oo[0], $id_map ]);
	foreach my $r (@$oo) {
	    $plates{$r->[0]} ++;
	}

	# warn " find_othersense_oligoplate($id_oo[0] \@ $id_map) =\n";
	# foreach my $r (@$oo) {
	#     warn "   -> [", (join ", ", @$r), "]\n";
	# }
    }
    die "Plate appears to be empty" if $well_count < 1;

    # Ignore plates that don't match all over
    foreach my $plate (keys %plates) {
	next if $plates{$plate} >= $well_count;
	warn "Plate STS $plate has only $plates{$plate}/$well_count opposite sense - ignoring\n";
	delete $plates{$plate};
    }

    return sort { $a <=> $b } keys %plates;
}


1;
