#!/usr/local/bin/perl5.6.1 -w
#
# 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.
#
#
################################################
# The script generates an email of the list    #
# of plates that can be discarded and also     #
# updates the status in the database to        #
# expired for the primerplates, so that no     #
# more reorders can be generated from them     #
# as the plates are no longer needed.          #
# The list of files that are earmarked for     #
# displosal are those which are solely         #
# linked to projects that have passed the      #
# autofinishing status  of                     #
# 'Pending assignment into finishing team'.    #
#                                              #
# To execute the script use the command line   #
# bin_plates.pl -file <filename>               #
# Can be used with or without the -file switch #
# Without it it self generates a list and      #
# prompts the user as to wether they want to   #
# get rid of the list of plates the script     #
# has generated or they can use a list of      #
# their own.                                   #
#                                              #
# Author :- Karen Ambrose                      #
#                                              #
# SQL used for extracting primerplates         #
# and related project status's                 #
#                                              #
#                                              #
#                                              #
# select DISTINCT pps.id_primerplate,          #
# p.projectname, psd.description, 	       #
# pps.statusdate, 			       #
# NVL(a.pfp_project,'NO_PROJ') PFP, 	       #
# NVL(a.fpd_name,'NO_DESC') NAME	       #
# from 					       #
# (     				       #
# select distinct pfp.projectname pfp_project, #
# fpd.name fpd_name			       #
# from project_finishingprocess pfp,	       #
# finishingprocessdict fpd 		       #
# where pfp.iscurrent = 1		       #
# and pfp.process_type = fpd.id_dict	       #
# and fpd.is_prefin    = 1		       #
# and pfp.projectname in (                     #		     
# select distinct p.projectname		       #
# from primerplate_status pps,		       #
# primer_map pm,			       #
# primer p,				       #
# project_status ps,			       #
# projectstatusdict psd			       #
# where pps.id_primerplate = pm.id_primerplate #
# and pm.id_primer = p.id_primer	       #
# and p.projectname = ps.projectname	       #
# and ps.status = psd.id_dict		       #
# and pps.status in (2,5)		       #
# and pps.iscurrent = 1			       #
# and ps.iscurrent = 1			       #
# ) 					       #
# ) a,					       #
# primerplate_status pps,		       #
# primer_map pm,			       #
# primer p,				       #
# project_status ps,			       #
# projectstatusdict psd			       #
# where p.projectname = a.pfp_project (+)      #
# and pps.id_primerplate = pm.id_primerplate   #
# and pm.id_primer = p.id_primer	       #
# and p.projectname = ps.projectname	       #
# and ps.status = psd.id_dict		       #
# and pps.status in (2,5)		       #
# and pps.iscurrent = 1			       #
# and ps.iscurrent = 1			       #
# order by pps.id_primerplate, p.projectname;  #
#          				       #
#                                              # 
#                                              # 
################################################ 
#
# $Id: bin_plates.pl,v 1.18 2005/02/14 15:50:24 kva Exp $
#
#

BEGIN {
    unshift(@INC, "$ENV{'BADGER'}/bin");
    unshift(@INC, "."); 
}

use strict;
use WrapDBI;
use Checkbarcode;
use SDTable;
require 'badgerGetOpt.pl';
use Term::ReadKey;

my $program = $0;
my $file;
my $opts = {
    
    "-file" => {
        "type" => "text",
        "var" => \$file,
        "help" => "file location",
        "def" => 0,
    }
};
&badgerGetOpt($program,'',$opts) && die "Quit\n";
$|=1;

if ($file){
    print "FILE PARSED :- $file \n";
}

my @all;
my $count2=0;
my $db='finch';
my $dbh = WrapDBI->connect("$db", {RaiseError => 1});    
$dbh->{autocommit} = 0;

if (! $file){
    
    print "No file supplied\n";
    
    my %HOLDER;
#enter sql for getting list of plate ID's
    my $stat1 = "select id_primerplate 
from primerplate_status 
where status in (2,5)
and iscurrent = 1
order by id_primerplate";
    
    my $sth1 = $dbh->prepare($stat1) || die "ERROR:$DBI::errstr";
    $sth1->execute || die "ERROR:$DBI::errstr";
    my $id;
    my $count=0;
    while($id=$sth1->fetchrow()){
        $count++;
        $HOLDER{$id}=$count;
    }
    $sth1->finish;
    
#enter sql for those ID'S that aren't at the removal point.
    my $stat2 = "
select DISTINCT pps.id_primerplate	       
from 					       
( select distinct pfp.projectname pfp_project, 
  fpd.name fpd_name			       
  from project_finishingprocess pfp,	       
  finishingprocessdict fpd 		       
  where pfp.iscurrent = 1       
  and pfp.process_type = fpd.id_dict	       
  and fpd.is_prefin    = 1		       
  and pfp.projectname in (select distinct p.projectname		       
                          from primerplate_status pps,		       
                          primer_map pm,			       
                          primer p,				       
                          project_status ps,			       
                          projectstatusdict psd			       
                          where pps.id_primerplate = pm.id_primerplate 
                          and pm.id_primer = p.id_primer	       
                          and p.projectname = ps.projectname	       
                          and ps.status = psd.id_dict		       
                          and pps.status in (2,5)			       
                          and pps.iscurrent = 1	
                          and ps.iscurrent = 1			       
                          ) 					       
  ) a,
    primerplate_status pps,		       
    primer_map pm,			       
    primer p,				       
    project_status ps,			       
    projectstatusdict psd			       
    where p.projectname = a.pfp_project (+)      
    and pps.id_primerplate = pm.id_primerplate   
    and pm.id_primer = p.id_primer	       
    and p.projectname = ps.projectname	       
    and ps.status = psd.id_dict		       
    and pps.status in (2,5)			       
    and pps.iscurrent = 1	
    and ps.projectname not in (select projectname from project_finishingprocess where process_type = 21)
    and ps.iscurrent = 1			       
    order by pps.id_primerplate
    ";

my %H2;
my $sth2 = $dbh->prepare($stat2) || die "ERROR:$DBI::errstr";
$sth2->execute || die "ERROR:$DBI::errstr";
my $id2;
while($id2=$sth2->fetchrow()){
    $H2{$id2}='1';
}
$sth2->finish;

$count=0;
foreach my $keys (sort keys %HOLDER){
$count++;
#print "$count $keys";
#print "  match" if $H2{$keys};
#print "\n";
unless($H2{$keys}){
push @all,$keys;
}
}

$count2=0;
foreach my $rem (sort {$a<=>$b} @all){
$count2++;
print ">>$count2 - $rem<<\n";
}

}

unless ($file){
print "\nThere are $count2 plates that can be disposed of, do you want to continue? (y/n)";
while (1){
            my $char = ReadKey(0);
            if ($char eq 'y'){ last; } else { die; }
        }
        ReadMode('normal');

}

my %BARCODEINFO;
my ($barcode, $human);
#my $send_to = 'kva';
my $send_to = 'sanger@europe.sial.com,team58g,kva';
my $who;

$program=~ s/\.\///g;

unless (scalar(@all)>0){

if (-e $file) {
    open(FH, "< $file") or die "Couldn't open $file for reading : $!\n";
    
    while (<FH>){
        @all = <FH>;
    }
    close(FH);
    
} else {
    print "File cannot be accessed as it dosen't exist!!\n";
    die;
}

}

my $statement_id = "select seq_session.nextval from dual";
my $sth_id = $dbh->prepare($statement_id) || die "ERROR:$DBI::errstr";
$sth_id->execute || die "ERROR:$DBI::errstr";
my $session_id = $sth_id->fetchrow();
$sth_id->finish;
#print ">>SESSION ID :- $session_id<<\n";

$who=&user_who;
#print ">>WHO IS IT? $who<<\n";

my $stat1 = "update primerplate_status set iscurrent = 0 where id_primerplate = ? and iscurrent =1";
my $sth_1 = $dbh->prepare($stat1) || die "ERROR:$DBI::errstr";

my $stat2 = "insert into primerplate_status values (?,3,sysdate,1,?,?,?)";
my $sth_2 = $dbh->prepare($stat2) || die "ERROR:$DBI::errstr";

my $count = 0;
foreach my $displate (@all){
    $displate =~ s/\s+//g;
    unless ($displate eq ''){
	$count++;
	print ">>Plate $count:- primerplate ID $displate<<\n";
	($barcode, $human) = Calculatebarcode('PP',$displate);
	print ">>$barcode $human<<\n";
	$BARCODEINFO{$barcode} = $human;
	
	$sth_1->bind_param(1,$displate);
	$sth_1->execute || die "ERROR:$DBI::errstr";
       
	$sth_2->bind_param(1,$displate);
	$sth_2->bind_param(2,$session_id);
	$sth_2->bind_param(3,$program);
	$sth_2->bind_param(4,$who);
	$sth_2->execute || die "ERROR:$DBI::errstr";
	
    }
    
}

$dbh->commit();


my @r_cs;
my $table1 = SDTable->new('format' => 'gaudy');
$table1->set('title'=> "Stockplates for disposal", 'titles' => ["PlateNumber", "PlateID"]);

foreach my $bci (sort keys %BARCODEINFO){
    my @cs=("$bci","$BARCODEINFO{$bci}");
    push (@r_cs, \@cs);
}

foreach my $rc (@r_cs){
    $table1->add(@$rc);
}


open(MAIL, "| sendmail $send_to") || die "Cant open pipe to sendmail";
print MAIL "To: $send_to\n";
print MAIL "From: ftp-primer\n";
print MAIL "Subject: Primerplates to be disposed.\n";
print MAIL "Below are $count primerplates that have been earmarked for disposal from Sigma's storage, these will be labelled as expired in the database, so no more reorders will be permitted against these plates.\n\n";
print MAIL $table1->format();
print MAIL "\n";
print MAIL "\n\nRegards Team58g & Karen (dn1g)\n\n";
close MAIL;

$sth_1->finish();
$sth_2->finish();

sub user_who {
    #Who is using the finisher's-interface ?
    my $who = getpwuid $>;
    return $who;
}



END {
    if ($dbh){
        eval {
            $dbh->rollback();
            $dbh->disconnect();
        }
    }
};


