#!/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.                      #
#######################################################################
# $Id: combi_pcr.pl,v 1.6 2003/06/20 16:33:05 kva Exp $

use strict;
use WrapDBI;
require 'badgerGetOpt.pl';
#use Data::Dumper;
#use Term::ReadKey;
use Log;

my $dbh;
my $prog = 'combi_pcr.pl';
my $project;

unless ($ENV{USER} eq "kva" || $ARGV[0] eq "-nolog"){
    &writeToBadgerLog();
}
 
##TEST FILE NAME IS ~kva/badger-bin/finch/combi_output.txt

#Command-line short cuts
my ($file,$finserv,$who);
my $opts = {
    
    "-file" => {
        "type" => "text",
        "var" => \$file,
        "help" => "Filename for the oligo list.",
	"def" => '',
    },
    
#    "-finserv" => {
#        "type" => "text",
#        "var" => \$finserv,
#        "help" => "Finservice ID",
#	"def" => '',
#    },
    
    "-who" => {
        "type" => "text",	
        "var" => \$who,
        "help" => "Specify user -DEBUGGING ONLY.",
	"def" => &user_who,
    }
};

&badgerGetOpt($prog,'',$opts) && die "Quit\n";
#Turn off the buffering
$|=1;

print "FILENAME IS - $file WHO $who\n";

#if (-z $file || !$finserv){
if (-z $file){
    die;
    
##find out if the file is no bytes in length
} else {
    
    
#    my $db = 'trackingclone1';
    my $db = 'reports';
    $dbh = WrapDBI->connect("$db", {RaiseError => 1}) || die print "Connection with database failed: $DBI::errstr";
    
#    #An id for this session on the application
#    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";
    
    ##get the role id for the person.
    my $role_stat = "select id_role,teamname from team_person_role where roletype = 'Finishing' and id_person in (select id_person from person where email = ?)";
    my $sth_role = $dbh->prepare($role_stat);
    $sth_role->bind_param(1,$who);
    $sth_role->execute() || die "ERROR:$DBI::errstr\n";
    my ($role,$team) = $sth_role->fetchrow();
    print "Role is $role and team is $team<<\n";
    $sth_role->finish;
 
    #get the contents of the file
    my @file_contents;
    open(FH,"< $file") or die "$!";
    @file_contents=<FH>;
    while(<FH>){
        @file_contents=<FH>;
    }
    close(FH);
    
    ##check that the project is has been owned by the team in question.
    $project = $file_contents[0];
    $project=~ s/\s+//g;
    $team=~ s/\s+//g;
    #print ">>PROJECTNAME - $project<<\n";
    my $statement = "select distinct a.projectname 
from project a, project_owner b 
where a.projectname = b.projectname
and b.teamname = ? 
and a.projectname = ?";
    my $sth_1=$dbh->prepare($statement);
    $sth_1->bind_param(1,$team); 
    $sth_1->bind_param(2,$project);
    $sth_1->execute || die "ERROR:$DBI::errstr\n";
    my $exists = $sth_1->fetchrow();
    if ($exists){
        print "PROJECT EXISTS $exists\n";
    }
    $sth_1->finish();
    
    if (!$exists){
        print "The project is either not in oracle or has never been owned by your team.\n";
        print "Change the ownership of the project and retry.\n";
        die;
    }
    
    
    ##NOTE
    ##need to ensure that the primer list
    ##does not contain duplicate primer names.
    my @unique_list;
    my %seen;
    my $check=0;
    foreach my $entry (@file_contents){
        $check++;
        next if $check==1;
        unless ($entry=~ /^\s+$/){
            my @info = split (/\s+/,$entry);
            my $primername = $info[1];
            #print "PRIMER IS - $primername\n";
            push(@unique_list,$primername) unless $seen{$primername}++;
        }
    }
    
    my %PRIM_HASH;
    my %HHASH;
    my %VHASH;
    my $count=0;
    
    my $check_primer = "select primername, id_primer 
from primer 
where primername = ? 
and projectname = ?";
    my $sth_2=$dbh->prepare($check_primer); 
    
    my $error_count=0;
    foreach my $fc (@unique_list){
        $count++;
        $fc=~ s/\s+//;
        
        $sth_2->bind_param(1,$fc);
        $sth_2->bind_param(2,$project);
        $sth_2->execute || die "ERROR:$DBI::errstr\n";
        my ($primer_exists,$ID_PRIMER) = $sth_2->fetchrow();
        
        if ($primer_exists){
            print "PRIMER EXISTS - $primer_exists\n";
            $HHASH{$count}=$fc;
            $VHASH{$count}=$fc;
            $PRIM_HASH{$fc}=$ID_PRIMER;
            print "LINE $count $fc\n";
        } else {
            $error_count++;
            print "PRIMER NOT FOUND IN DATABASE FOR - $fc\n";
            
        }
        
    }
    $sth_2->finish();
    
    if ($error_count >0){
        print "Some primers weren't found in the database. Either remove them from the list or enter them into the database.\n";
        die;
    }
    
#    print STDOUT "-------------------HHASH---\n";
#    print STDOUT Data::Dumper::Dumper(\%HHASH);
#    print STDOUT "----------------------\n";
#    print STDOUT "-------------------VHASH---\n";
#    print STDOUT Data::Dumper::Dumper(\%VHASH);
#    print STDOUT "----------------------\n";
#    print STDOUT "-------------------PHASH---\n";
#    print STDOUT Data::Dumper::Dumper(\%PRIM_HASH);
#    print STDOUT "----------------------\n";

    #Print the information to an outputfile
    #same name as the original file with OUTPUT extension
    my $outputfile = $file.'_OUTPUT';
    open(OUTPUT,"> $outputfile") or die "$!";
    
    print OUTPUT "\n\n";
    print OUTPUT "COMBINATORIAL PCR PRODUCTS\n\n";
    
    my %final_list;    
    
    my $final_count=0;
    foreach my $v_keys (sort {sensibly($a, $b)} keys %VHASH){
        foreach my $h_keys (sort {sensibly($a, $b)} keys %HHASH){
            unless (($h_keys == $v_keys) || ($v_keys>$h_keys)){
                $final_count++;
                #print $project."_(".$h_keys.")".$HHASH{$h_keys}."_(".$v_keys.")".$VHASH{$v_keys}."\n";
                my $combi_name = "G".$project."_".$HHASH{$h_keys}."_".$VHASH{$v_keys};
                #my $len = length($combi_name);
                #if ($len>14){
                #    $combi_name=&check_length($combi_name);
                #}
                print OUTPUT "PRODUCT $final_count - $combi_name ($h_keys/$v_keys)\n";
                $final_list{$final_count}=$combi_name;
            }
        }
    }
    
    print OUTPUT "\nTotal number of potential products - $final_count.\n";    
    close(OUTPUT);
    

    ##EXTRA BIT TO BE USED WHEN THE SCRIPT IS EXTENDED TO PLACE THE INFORMATION
    ##DIRECTLY INTO THE DATABASE.
#    print STDOUT "-------------------FINAL LIST---\n";
#    print STDOUT Data::Dumper::Dumper(\%final_list);
#    print STDOUT "----------------------\n";
#  
#
#    # Check the user is happy with the output...
#    ReadMode('cbreak');
#    warn "\n\n Continue y|n ?\n";
#    while (1){
#        my $char = ReadKey(0);
#        if ($char eq 'y'){ last; } else { die; }
#    }
#    ReadMode('normal'); 
#    
#    ##ONCE THAT HAS BEEN CHECKED THEN PROCEED
#    ##TO ENTER THE INFORMATION INTO THE DATABASE.
#    ##pcrproduct, pcrbatch, pcrproduct_status
#    ##information known :- projectname, source, primers1/2, template_name. type, is_combinatorial set to 1.
#
#    my $batch_ID;
#    
#    eval {
#        
#        my $stat_1 = "select SEQ_PCRBATCH.nextval from dual";
#        my $sth_1 = $dbh->prepare($stat_1);
#        $sth_1->execute || die "ERROR:$DBI::errstr\n";
#        $batch_ID = $sth_1->fetchrow();
#        $sth_1->finish();
#        
#        print "BATCH IS $batch_ID, finservice = $finserv and role is $role\n";
#        my $stat_2 = "insert into pcr_batch VALUES (?,sysdate,?,?)";
#        my $sth_2 = $dbh->prepare($stat_2);
#        $sth_2->bind_param(1,$batch_ID);
#        $sth_2->bind_param(2,$role);
#        $sth_2->bind_param(3,$finserv);
#        $sth_2->execute || die "ERROR:$DBI::errstr\n";
#        $sth_2->finish();
#        
#        
#        my $stat_3 = "select SEQ_PCRPRODUCT.nextval from dual";
#        my $sth_3 = $dbh->prepare($stat_3);
#        
#        my $temp_check = "select count(pcr_template_name) from pcr_product where pcr_template_name like ?";
#        my $sth_tmpchk = $dbh->prepare($temp_check) || die "ERROR:$DBI::errstr";
#        
#        my $stat_4 = "insert into pcr_product (ID_PCRPRODUCT,ID_PCRBATCH,LOOKUP_TYPE,PCR_TEMPLATE_NAME,DNA_SOURCE,PRIMER_1,PRIMER_2,IS_COMBINATORIAL) values (?,?,3,?,?,?,?,1)";
#        my $sth_4 = $dbh->prepare($stat_4);
#        
#        my $stat_5 = "insert into pcrproduct_status (ID_PCRPRODUCT,STATUS,STATUSDATE,ISCURRENT,SESSIONID,OPERATOR,PROGRAM) values (?,1,sysdate,1,?,?,?)"; 
#        my $sth_5 = $dbh->prepare($stat_5);
#        
#        
#        foreach my $f_keys (sort {sensibly($a, $b)} keys %final_list){
#            $sth_3->execute() || die "ERROR:$DBI::errstr\n";
#            my $product_id = $sth_3->fetchrow();
#            
#            
#            my $template = $final_list{$f_keys};
#            $template =~ /\w+\_(\w+)\_(\w+)/;
#            my $primername1 = $1;
#            my $primer1_id = $PRIM_HASH{$primername1};
#            print "primer 1 - $primername1, $primer1_id\n";
#            my $primername2 = $2;
#            my $primer2_id = $PRIM_HASH{$primername2};
#            print "primer 2 - $primername2, $primer2_id\n";
#            
#
#            #check that the pcr_template isn't already in
#            #the database.
#            my $newcontents = $template.'-'.'%';
#            $sth_tmpchk->bind_param(1,$newcontents);
#            $sth_tmpchk->execute || die "ERROR:$DBI::errstr";
#            my $tmp_count =$sth_tmpchk->fetchrow();
#            my $inc_contents;
#            if ($tmp_count){
#                my $inc_count = $tmp_count+1;
#                $inc_contents = $template.'-'.$inc_count;
#            } else {
#                $inc_contents = $template.'-'.'1';
#            }
#            
#            print "new templatename = $inc_contents\n";
#
#            ##check the uniqueness in the column.
#            $sth_4->bind_param(1,$product_id); 
#            $sth_4->bind_param(2,$batch_ID);
#            $sth_4->bind_param(3,$inc_contents);
#            $sth_4->bind_param(4,$project); 
#            $sth_4->bind_param(5,$primer1_id); 
#            $sth_4->bind_param(6,$primer2_id); 
#            $sth_4->execute || die "ERROR:$DBI::errstr\n";
#            
#            $sth_5->bind_param(1,$product_id);
#            $sth_5->bind_param(2,$session_id);
#            $sth_5->bind_param(3,$who);
#            $sth_5->bind_param(4,$prog);
#            $sth_5->execute || die "ERROR:$DBI::errstr\n";
#            
#        }
#        
#        $sth_3->finish();
#        $sth_tmpchk->finish();
#        $sth_4->finish();
#        $sth_5->finish();
#        
#        
#    };
#    if ($@){
#        print "Error detected, the entries will be rolled back, contact bug!!!\n";
#        $dbh->rollback();
#        die;
#        
#    } else {
#        print "No errors detected the entries have been entered into the database\n";
#        print "The samples have been attached to batch $batch_ID and submitted to be grouped\n";
#        $dbh->commit();
#    }
    
    
}



##SUBROUTINES

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


sub sensibly {
    my ($aa, $bb) = @_;
    my ($a_lhs, $b_lhs);
    
    return $aa cmp $bb if $aa eq "" or $bb eq "";
    $aa =~ s/^(\D+|\d+)//;
    $a_lhs = lc($1);
    
    $bb =~ s/^(\D+|\d+)//;
    $b_lhs = lc($1);
    
    if ($a_lhs =~ /^[0-9]/ and $b_lhs =~ /^[0-9]/) {
        if ($a_lhs == $b_lhs) {
            return sensibly($aa, $bb);
        } else {
            return $a_lhs <=> $b_lhs;
        }
    } else {
        if ($a_lhs eq $b_lhs) {
            return sensibly($aa, $bb);
        } else {
            return $a_lhs cmp $b_lhs;
        }
    }
}


sub check_length {
    
    my($pcr_temp)=@_;
    
    ##SECTION TO MONITOR THE LENGTH OF THE GENERATED TEMPLATE.
    ##14 characters is used as the boundary because this 
    ##takes into account the iteration,suffix,possible primername
    ##well info and unique number added onto the end of each template
    ##name which will generate the entry in SEQREAD which has a 
    ##max length of 30 characters.
    
    my $len = length($pcr_temp);
    print "Template name $pcr_temp is longer than 14 characters this will be shortened, automatically.\n";
    my ($one,$two,$three);
    ($one,$two,$three)=$pcr_temp=~ /(\S+)\_(\S+)\_(\S+)/;
    my $rem =($len-14);
    $rem = '-'.$rem;
    #print "The rem is $rem\n";
    substr($one,$rem)="";
    #print "new one - $one\n";
    $pcr_temp=$one.'_'.$two.'_'.$three;
    #print "new pcr template name in $pcr_temp\n";
    
    return($pcr_temp);
    
}


#disconnection from the database.
END {
    if ($dbh){
        eval {
            $dbh->rollback();
            $dbh->disconnect();
        }
    }
};



__END__

=head1 NAME

 combi_pcr.pl

=head1 SYNOPSIS

 combi_pcr.pl [args] -file <FILENAME>

=head1 DESCRIPTION

The script generates a list of combinations for possible pcr products from a project and a 
list of primers. Using the rules associated with the generation of combinatorial pcr's.
The script is to be run with the -file argument, which will use the information in the 
file to generate the combinations. The file is to be made with the projectname at the top, 
followed by the list of primernames to be used e.g

DICTY6
1       3194
2       3195
3       3196
4       3197
5       3198
6       3199

Running the script checks that the project was owned by the team in question, and that the primers
are present within oracle. Any found not to be present, will be ommitted from the list of primers 
to generate the combinations of the possible pcr product list. An output file is generated in the 
directory the file is run which bears the same name as the file used to originally run the script, 
but has an '_OUTPUT' extension.


=head1 AUTHOR

 Karen Ambrose

=head1 HISTORY

 # $Log: combi_pcr.pl,v $
% Revision 1.6  2003/06/20  16:33:05  kva
% Added the check length subroutine, but have inactivated it for the moment.
%
% Revision 1.5  2003/06/19  08:41:17  kva
% Added the logging information to the script.
%
% Revision 1.4  2003/06/17  11:10:28  kva
% *** empty log message ***
%
% Revision 1.3  2003/06/17  11:01:18  kva
% *** empty log message ***
%
% Revision 1.2  2003/06/17  10:31:32  kva
% *** empty log message ***
%
% Revision 1.1  2003/06/17  10:18:30  kva
% Initial revision
%

=cut
