#!/usr/local/bin/perl
#######################################################################
# 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.                      #
#######################################################################

require Exporter;

use DBI;

@finch_view::ISA = qw(Exporter);
@finch_view::EXPORT = qw(view suffix_mapping project_oligo suffix2protocol get_suffix2protocol_hash suffix2id_seqchem);

package finch_view;

# DN1
#########################################################
#Allow the finisher to interogate oracle batch-entries  #
#########################################################
# Supply the module with $db_database, $db_user, $db_pass -> for db connection
# Supply                 $viewChoice                      -> for query type
# Supply                 $id_role                         -> who is asking ?
# Supply                 $currproject                     -> the current project
# Returns results in @dbcontents
# Returns 'Warn' in first index of @dbcontents if query is fruitless.
# $view_title is not used presently

sub view {

     
    my($db_database, $db_user, $db_pass, $viewChoice, $id_role, $currproject) = @_;

    #warn "---> $db_database, $db_user, $db_pass, $viewChoice, $id_role \n";


# Connect to Oracle
    my $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";

# Intitiate some stuff
    # - what the hell was I thinking here >?< (dn1)
    my @batch_list = '';
    my $batches = '';
    my $batch = '';
    my $num = 0;
    my @dbcontents ;
    my $view_title = '';
    my $statement = '';
    my $sth1 = '';
    my $sth2 = '';
    my $sth3 = '';
    my $sth4 = '';
    my $sth5 = '';
    my $sth6 = '';
    my $sth7 = '';
    my $statement2 = '';
    my $statement3 = '';
    my $statement4 = '';
    my $statement5 = '';
    my $statement6 = '';
    my $statement7 = '';
    my $RUN = '';
    my $PROJECTNAME = '';
    my $BATCHDATE = '';
    my $next_in = " ";
    my ($ID_FREQUEST,$ID_FBATCH,$PLATENAME,$ROWLETTER,$COLNUM,$SUFFIX,$ITERATION,$ID_PRIMER,$ID_LOADINGSAMPLE);
    my $STATUS = '';

###########################################################
# Get a list of valid batches depending on the query type #
###########################################################

    if ($viewChoice == 1) {	#
######################################
# View by batch, Today: $currproject #
######################################
	$view_title = "by batch, Today: $currproject.";
	# First we need to see what batch numbers have been submitted (all of them)
	$statement = "select unique id_fbatch from finish_batch where to_char(batchdate, \'yyyymmdd\') = to_char(sysdate, \'yyyymmdd\') and finisher = \'$id_role\' and projectname = \'$currproject\' ";
	$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	#print "$who has submitted the following batches... \n";
	while (($batches) = $sth1->fetchrow()) {
	    $batch_list[$num] = $batches;
	    #print "$batch_list[$num]   ";
	    $num++;
	}    
	$sth1->finish;
	if ($num == 0){
	    $next_in = "Warn";
	    push (@dbcontents,$next_in);
	    $dbh->disconnect;
	    return @dbcontents;
	}
    } elsif ( $viewChoice == 4) { #
########################
# View by batch, all   #
########################
	$view_title = "by batch for all submissions. All projects.";
	# First we need to see what batch numbers have been submitted (all of them)
	$statement = "select unique id_fbatch from finish_batch where finisher = \'$id_role\' ";
	$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	#print "$who has submitted the following batches... \n";
	while (($batches) = $sth1->fetchrow()) {
	    $batch_list[$num] = $batches;
	    #print "$batch_list[$num]   ";
	    $num++;
	}    
	$sth1->finish;
	if ($num == 0){
	    $next_in = "Warn";
	    push (@dbcontents,$next_in);
	    $dbh->disconnect;
	    return @dbcontents;
	}

    } elsif ( $viewChoice == 3) {#
######################################
# View by batch, all, $currproject   #
######################################
	$view_title = "by batch for all submissions. $currproject.";
	# First we need to see what batch numbers have been submitted (all of them)
	$statement = "select unique id_fbatch from finish_batch where finisher = \'$id_role\' and projectname = \'$currproject\' ";
	$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	#print "$who has submitted the following batches... \n";
	while (($batches) = $sth1->fetchrow()) {
	    $batch_list[$num] = $batches;
	    #print "$batch_list[$num]   ";
	    $num++;
	}    
	$sth1->finish;
	if ($num == 0){
	    $next_in = "Warn";
	    push (@dbcontents,$next_in);
	    $dbh->disconnect;
	    return @dbcontents;
	}

    } elsif ( $viewChoice == 2) {#
##########################
# View by batch, today   #
##########################
	$view_title = "by batch for today's submissions. All projects.";
	# NEW STATEMENT
	# Find out which batches have been submitted today by this person from finish_batch
	$statement = "select unique id_fbatch from finish_batch where to_char(batchdate, \'yyyymmdd\') = to_char(sysdate, \'yyyymmdd\') and finisher = \'$id_role\' ";
	$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	#print "$who has submitted the following batches today... \n"; ######### 
	while (($batches) = $sth1->fetchrow()) {
	    $batch_list[$num] = $batches;
	    #print "$batch_list[$num]   ";  #########
	    $num++;
	}
	$sth1->finish;
	#print "new num $num \n";
	if ($num == 0){
	    $next_in = "Warn";
	    push (@dbcontents,$next_in);
	    $dbh->disconnect;
	    return @dbcontents;
	}
    } 

#####################################################
# ...and then get the sample-info for these batches #
#####################################################

  
	foreach $batch(@batch_list) {
            # Go through each of today's batches -need to make a header-entry
	    # BATCH - PROJECT -DATE 
	    # What project is this batch for ?
	    $statement = "select projectname from finish_batch where id_fbatch = \'$batch\'";
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";  
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $PROJECTNAME = $sth1->fetchrow();
	    $sth1->finish;
	    
            # What date was this batch submitted ?
	    $statement = "select batchdate from finish_batch where id_fbatch = \'$batch\'";
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";  
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    $BATCHDATE = $sth1->fetchrow();
	    $sth1->finish;

	    ###################################################
	    # >!< finish_batch no longer contains fsname >!<
	    ###################################################
	    # Where was this batch submitted to ?
	    $statement = "select ID_TEAM_FINSERV from finish_batch where id_fbatch = \'$batch\'";
	    $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";  
	    $sth1->execute || die "ERROR:$DBI::errstr";
	    my $ID_TEAM_FINSERV = $sth1->fetchrow();
	    $sth1->finish;
	    #####################
	    #####################
	    $statement_x = "select FSNAME from team_finservice where ID_TEAM_FINSERV = \'$ID_TEAM_FINSERV\'";
	    $sthx = $dbh->prepare($statement_x) || die "ERROR:$DBI::errstr";  
	    $sthx->execute || die "ERROR:$DBI::errstr";
	    my $FSNAME = $sthx->fetchrow();
	    $sthx->finish;

	    $next_in = '';
	    push (@dbcontents,$next_in);
	    $next_in = "*************************************************************************************";
	    push (@dbcontents,$next_in);
	    $next_in = "Batch-no. $batch  Project $PROJECTNAME  Date-submitted $BATCHDATE  $ID_TEAM_FINSERV $FSNAME";
	    push (@dbcontents,$next_in);
	    $next_in = "*************************************************************************************";
	    push (@dbcontents,$next_in);


		# Other sample information retrieved
	        $statement = "select * from finish_request where id_fbatch = \'$batch\' order by id_seqchem, PLATENAME, ROWLETTER, COLNUM";
	    #warn "$statement \n";
       	        $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
		$sth1->execute || die "ERROR:$DBI::errstr";	
		while (($ID_FREQUEST,$ID_FBATCH,$PLATENAME,$ROWLETTER,$COLNUM,$ID_SEQCHEM,$ID_RUNTYPE,$ITERATION,$ID_PRIMER,$ID_LOADINGSAMPLE) = $sth1->fetchrow()) {

		    # Get the individual-sample's status
		    $statement2 = "select status from frequest_status where id_frequest = \'$ID_FREQUEST\' and iscurrent =1";
		    $sth2 = $dbh->prepare($statement2) || die "ERROR:$DBI::errstr";  
		    $sth2->execute || die "ERROR:$DBI::errstr";
		    $STATUS = $sth2->fetchrow();
		    $sth2->finish;

		    $statement3 = "select description from frequeststatusdict where id_dict = \'$STATUS\'";
		    $sth3 = $dbh->prepare($statement3) || die "ERROR:$DBI::errstr";  
		    $sth3->execute || die "ERROR:$DBI::errstr";
		    $STATUS = $sth3->fetchrow();
		    $sth3->finish;
		    if ($STATUS eq '') {
			$STATUS = 'Unknown';
		    }
		    # Need $SUFFIX from TABLE_SEQCHEM
		    $statement6 = "select suffix from SEQCHEM where id_seqchem = \'$ID_SEQCHEM\'";
		    $sth6 = $dbh->prepare($statement6) || die "ERROR:$DBI::errstr";  
		    $sth6->execute || die "ERROR:$DBI::errstr";
		    $SUFFIX = $sth6->fetchrow();
		    $sth6->finish;

                    # Need runtype_description from TABLE_RUNTYPE
		    if ($ID_RUNTYPE ne ''){
			$statement7 = "select description from RUNTYPE where id_runtype = \'$ID_RUNTYPE\'";
			$sth7 = $dbh->prepare($statement7) || die "ERROR:$DBI::errstr";  
			$sth7->execute || die "ERROR:$DBI::errstr";
			$RUN = $sth7->fetchrow();
			$sth7->finish;
		    } else {
			$RUN = 'No Preference';
		    }
		    
		    if ($ID_PRIMER ne ''){
			# get oligoname from id_primer
			$statement4 = "select primername from primer where id_primer = \'$ID_PRIMER\'";
			$sth4 = $dbh->prepare($statement4) || die "ERROR:$DBI::errstr";  
			$sth4->execute || die "ERROR:$DBI::errstr";	
			$OLIGONAME = $sth4->fetchrow();
			$sth4->finish;
			# get oligoseq from id_primer
			$statement5 = "select primerseq from primer where id_primer  = \'$ID_PRIMER\'";
			$sth5 = $dbh->prepare($statement5) || die "ERROR:$DBI::errstr";  
			$sth5->execute || die "ERROR:$DBI::errstr";	
			$OLIGOSEQ = $sth5->fetchrow();
			$sth5->finish;
			$next_in = "Status $STATUS $PLATENAME$ROWLETTER$COLNUM$SUFFIX$ITERATION$OLIGONAME $OLIGOSEQ $RUN";
			#warn "$next_in \n";
			push (@dbcontents,$next_in);
		    } else {
			$next_in = "Status $STATUS $PLATENAME$ROWLETTER$COLNUM$SUFFIX$ITERATION $RUN";
			#warn "$next_in \n";
			push (@dbcontents,$next_in);
		    }			
		}			
		$sth1->finish;
	    }
        
    $dbh->disconnect;
    
#################################################
# We must return something here ie. @dbcontents;#
#################################################
    return @dbcontents;
}				

# DN1
##############################################################
#Allow the finisher to view valid suffix -> protocol mapping #
##############################################################
# Supply the module with $db_database, $db_user, $db_pass -> for db connection
# Returns results in @dbcontents
# Returns 'Warn' in first index of @dbcontents if query is fruitless.

sub suffix_mapping {
    my $num = 0;
    my $name = '';
    my $seq = '';
    my @dbcontents = ();
    my $statement;
    my $sthsu;
    my $next_in;
    my($db_database, $db_user, $db_pass) = @_;
    my $suffix;
    my $description;
    my $protocol;

    # Connect to Oracle
    $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
    
    $view_title = "Valid suffix -> protocol mapping.";
    # Get information from seqsuffixdict
    $statement = "
select unique suffix, description, protocol
from seqchem 
where FINSERVICE = 1 
order by protocol
";

    $sthsu = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sthsu->execute || die "ERROR:$DBI::errstr";
    while (($suffix, $description, $protocol ) = $sthsu->fetchrow()) {
	my $next_in = "$protocol" . " <- $suffix" . "  $description";     
	push (@dbcontents,$next_in);
	$num++
    }
    $sthsu->finish;

    if ($num == 0){
	$next_in = "Warn";
	push (@dbcontents,$next_in);
	$dbh->disconnect;
	return @dbcontents;
    }
    $dbh->disconnect;
    return @dbcontents;
}

# DN1
#############################
# View oligos for a project #
#############################
# Supply the module with $db_database, $db_user, $db_pass -> for db connection
# Supply $currproject                                     -> this project     
# Returns results in @dbcontents
# Returns 'Warn' in first index of @dbcontents if query is fruitless.

sub project_oligo {
    my $num = 0;
    my $name = '';
    my $seq = '';
    my @dbcontents = ();
    my $statement;
    my $sthol;
    my $next_in;
    my($db_database, $db_user, $db_pass, $currproject) = @_;
    $view_title = "Oligo orders for $currproject.";

# Connect to Oracle
    $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
    
    # Find out which oligos and sequences have been submitted for this project
    #print  "select PRIMERNAME, PRIMERSEQ from primer where PROJECTNAME = \'$currproject\' order by PRIMERNAME \n";
    $statement = "select PRIMERNAME, PRIMERSEQ from primer where PROJECTNAME = \'$currproject\' order by PRIMERNAME";
    $sthol = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sthol->execute || die "ERROR:$DBI::errstr";
    while (($name, $seq ) = $sthol->fetchrow()) {
	my $next_in = "$name". "     $seq";
	push (@dbcontents,$next_in);
	$num++
    }
    $sthol->finish;
    if ($num == 0){
	$next_in = "Warn";
	push (@dbcontents,$next_in);
	$dbh->disconnect;
	return @dbcontents;
    }
    $dbh->disconnect;
    return @dbcontents;

}

sub get_suffix2protocol_hash {
    my($db_database, $db_user, $db_pass) = @_;
    my $statement;		
    my $sth;
    my ($suffix,$protocol);
    my %protocol = ();

    # Connect to Oracle
    $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
    
    # Get information from seqsuffixdict
    $statement = "select suffix, protocol from seqchem";
    $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    while (($suffix,$protocol) = $sth->fetchrow()) {
	$protocol{$suffix} = "$protocol";
    }
    $sth->finish;

    $dbh->disconnect;
    return (\%protocol);
}


# DN1
###################################################
# Get data-structures for suffix:protocol mapping #
###################################################
# Supply the module with $db_database, $db_user, $db_pass -> for db connection
# returns \@suffix_list_array and \%protocol_list;
# We need to make and return the following (examples) from the database... 

#my $suffix_list_array = 
    #[[".p1", ".s1"],		    # 0-S1
     #[".p1l", ".s1l"],		    # 1-S1L
     #[".p1t", ".s1t"],		    # 2-S1T
     #[".p1lt", ".s1lt"],	    # 3-S1LT
     #[".r1"],			    # 4-R1
     #[".r1l"],			    # 5-R1L
     #[".r1t"],			    # 6-R1T
     #[".r1lt"],		    # 7-R1LT
     #[".q1"],			    # 8-Q1
     #[".q1l"],			    # 9-Q1L
     #[".q1t"],			    # 10-Q1T
     #[".q1lt"],		    # 11-Q1LT
     #[".p2t", ".s2t", ".q2t"],	    # 12-S2T
     #[".p2lt", ".s2lt", ".q2lt"],  # 13-S2LT
     #[".r2t"],			    # 14-R2T
     #[".r2lt"],		    # 15-R2LT
     #[".s1ll"]			    # 16-LICOR
     #];

# And...

#my $protocol_list ={
    #'0' => "S1",
    #'1' => "S1L",
    #'2' => "S1T",
    #'3' => "S1LT",
    #'4' => "R1",
    #'5' => "R1L",
    #'6' => "R1T",
    #'7' => "R1LT",
    #'8' => "Q1",
    #'9' => "Q1L",
    #'10' => "Q1T",
    #'11' => "Q1LT",
    #'12' => "S2T",
    #'13' => "S2LT",
    #'14' => "R2T",
    #'15' => "R2LT",
    #'16' => "LICOR"
    #};

sub suffix2protocol {
    my $statement;		
    my $sth;
    my $protocol;
    my $next_in;
    my $num = 0;
    my %protocol_list = ();
    my($db_database, $db_user, $db_pass) = @_;
    my $index;
    # Connect to Oracle
    $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
    
    # Get information from seqsuffixdict
    $statement = "select unique protocol from seqchem order by protocol";
    $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    while ($protocol = $sth->fetchrow()) {
	# individually populate our protocol-hash
	$protocol_list{$num} = "$protocol";
	$num++
    }
    $sth->finish;
    # we need to know how many 'pairs' are in $protocol_hashref->
    my @protocol_list = keys(%protocol_list );
    my $pronumber = @protocol_list;
    #print "Number of pairs in our hash are ---> $pronumber \n";
    foreach $index (0 .. $pronumber-1){
	my @suffix_list;
        #pull out the suffix for each protocol
	#warn "Index -> $index \n";
	#warn "$protocol_list{$index} \n";
	my $protocol = $protocol_list{$index};
	#warn "select unique suffix from seqchem where protocol = \'$protocol\' order by suffix; \n";
	$statement = "select unique suffix from seqchem where protocol = \'$protocol\' order by suffix";
	$sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth->execute || die "ERROR:$DBI::errstr";
	while ($suffix = $sth->fetchrow()) {
	    # individually populate our protocol-hash
	    #warn "suffix -> $suffix \n";
	    push (@suffix_list, $suffix);
	    #warn @suffix_list;
	}
	push (@suffix_list_array, \@suffix_list);
    }
    $sth->finish;

    #################################################### 
    # Some code to check what's in our data-structures #
    ####################################################

    #foreach $protocol (0 .. $pronumber-1){
    # Test our data-structures
    #for $key (keys %protocol_list) {
	#warn "$protocol => $protocol_list{$protocol} \n";
	#we need to know how many elements are present in $suffix_list_array->[$key] ?
	#my $sufnumber = @{$suffix_list_array->[$key]};
	#warn "$protocol $suffix_list_array[$protocol] @{$suffix_list_array[$protocol]}\n";
	#my $sufnumber = @{$suffix_list_array[$protocol]};
	#warn "...has  $sufnumber suffix entries. \n";
	#foreach $suffix (0 .. $sufnumber-1){
	    #warn "$suffix_list_array[$protocol]->[$suffix] \n";
	#}
    #}
    	
    $dbh->disconnect;
    return (\@suffix_list_array, \%protocol_list);
}

sub suffix2id_seqchem {
    my($db_database, $db_user, $db_pass) = @_;
    my $statement;		
    my $sth;
    my ($suffix,$id_seqchem);
    my %suffix2id_seqchem = ();
    # Connect to Oracle
    $dbh = DBI->connect( $db_database, $db_user, $db_pass, 'Oracle') || die "ERROR: Could not connect to database: $DBI::errstr\n";
    # Get information from seqchem
    $statement = "select suffix, id_seqchem from seqchem where westpav = 1";
    $sth = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth->execute || die "ERROR:$DBI::errstr";
    while (($suffix,$id_seqchem) = $sth->fetchrow()) {
	#warn "key -> $suffix value -> $id_seqchem \n";
	$suffix2id_seqchem{$suffix} = "$id_seqchem";
    }
    $sth->finish;

    $dbh->disconnect;
    return (\%suffix2id_seqchem);
}

1;

