package Submitfinentries;

# TODO - POD

####################
# Modules
####################

use strict;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = ('Exporter');
@EXPORT = qw(&start_submit);
use xml_primer_order;
use Mail::Mailer;


#####################
# Global module vars
#####################

# TODO - use statics ?
my $user_group = "kva, team58"; # TODO
my $error_group = "kva";        # TODO
#my $user_group = "kva";   # TODO
#my $error_group = "kva";  # TODO


my $se2;           # SqlEngine2 object
my $dbhTracking;   # DataBase handle for tracking
my $reduce_out = 1; # If defined - less output to STDERR


#####################
# Subroutines
#####################

sub start_submit {
    
    my %sender_details;
    my %primer_plate_data;
    my %primer_ord_data;
    my $mail;

    my $externalTubeOrders = undef; # Whether an external tube order has been made
    
    # 22 incoming parameters
    my (
	$dbh, 
	$project, 
	$D, 
	$DI, 
	$costcode, 
	$SECT,         # Why is this coming in ? # TODO
	$lastSECT, 
	$GRID_ROWS, 
	$who, 
	$teamname, 
	$species, 
	$currprojectchr, 
	$curr_finservice, 
	$ID_TEAM_FINSERV, 
	$session_id, 
	$id_role,
	$valid_adds, 
	$backwards, 
	$ext_primers, 
	$sub_go, 
	$cust_p, 
	$reseq) = @_;
    
    ########################
    # Set up for DB queries
    ########################
    &initDatabase($dbh);
    
    
    my $DATA = $$D;
    my $DATA_INFO = $$DI;
    
    unless (defined $ext_primers){
	$ext_primers = 0;
    }
    
    unless (defined $cust_p){
	$cust_p = 0;
    }
    unless (defined $reseq){
	$reseq = 0;
    }
    unless (defined $sub_go){
	$sub_go = 0;
    }
    
    # Reverse $valid_adds
    my $valid_adds2 = {};
    foreach my $n (keys %$valid_adds){
	my $e = $valid_adds->{$n};
	$valid_adds2->{"$e"} = $n;
    }


    ####################################
    # Look for new primers in the order
    ####################################
    my %new_oligos;       # List of new oligos; OligoName -> OligoSequence
    my %new_oligos_no_DP; # List of new oligos where the DPs are not available; OligoName -> OligoSequence
    # $count       - A count of the new oligos
    # $count_no_DP - A count of the new oligos that do not have the appro. DP available
    # $batch       - A count of how many rows have a non-blank template
    my ($errorCode, $errorMessage, $count, $count_no_DP, $batch) = &findNewPrimers(
										   $SECT,
										   $lastSECT,
										   $GRID_ROWS,
										   $DATA_INFO,
										   $DATA,
										   \%new_oligos,
										   \%new_oligos_no_DP,
										   );
    
    if ($errorCode){
	# Return out of start_submit sub back to package caller
	$se2->rollbackTransaction();
	return ($errorMessage);
    }


 
    ######################################################
    # If we need to make some new primer database entries
    ######################################################
    my %new_oligo_id;     # The new PRIMER IDs; OligoName -> id_primer (from seq_id_primer)
    if ($count > 0){ 

	my ($errorCode, $errorMessage) = &getNewPrimerIds(
							  \%new_oligos,
							  \%new_oligo_id,
							  );
	if ($errorCode){
	    # Return out of start_submit sub back to package caller
	    $se2->rollbackTransaction();
	    return ($errorMessage);
	}


	##################################################################
	# Make appropriate entries in the PRIMER and PRIMER_STATUS tables
	##################################################################
	my ($errorCode, $errorMessage) = &makePrimerEntries(
							    \%new_oligos,
							    \%new_oligo_id,
							    $project,
							    $costcode,
							    \%new_oligos_no_DP,
							    $ext_primers,
							    $session_id,
							    $who,
							    );
	
	# Return out of start_submit sub back to package caller
	if ($errorCode){
	    $se2->rollbackTransaction();
	    return ($errorMessage);
	}

	##########################################################################################################
	# If we are not taking the external primer route *OR* no rows specify a template
	# then we will need to compose an external tube order
	# ie. don't do this if  "We ARE taking the external primer route AND at least 1 row specifies a template"
	##########################################################################################################
	if ( ($ext_primers == 0) || ($batch == 0) ){
	    
	    
	    # There is no point making an external tube order if none of the DPs are available
	    unless ($count == $count_no_DP){ 
		
		# $purchase_prefix and $purchase_no are only used during external tube orders
		my ($errorCode, $errorMessage, $purchase_prefix, $purchase_no) = &getPurchaseInfo(
												  $teamname,
												  );
		if ($errorCode){
		    # Return out of start_submit sub back to package caller
		    $se2->rollbackTransaction();
		    return ($errorMessage);
		}
	


		my ($sender_details,
		    $primer_plate_data,
		    $primer_ord_data);
		
		($mail,
		 $sender_details,
		 $primer_plate_data,
		 $primer_ord_data) = &compose_mail_and_order(
							     $who,                 #1
							     $teamname,            #2
							     $costcode,            #3
							     $species,             #4
							     $project,             #5
							     $currprojectchr,      #6
							     $curr_finservice,     #7
							     $purchase_prefix,     #8
							     $purchase_no,         #9
							     \%new_oligos,         #10
							     \%new_oligos_no_DP,   #11
							     \%new_oligo_id);      #12
		
                %sender_details     = %$sender_details;
                %primer_plate_data  = %$primer_plate_data;
                %primer_ord_data    = %$primer_ord_data;
		
		#############################################################################
		# If no rows have a template - just an external tube order is required
		# If we are not using the external oligo plate ordering method we still need
		# to send a tube order externally
		#############################################################################
		my ($errorCode, $errorMessage) = &makeTubeOrder(     
								\%new_oligo_id,
								\%sender_details,
								\%primer_plate_data,
								\%primer_ord_data,
								$who,
								$mail,	
								);
		if ($errorCode){
		    # Return out of start_submit sub back to package caller
		    $se2->rollbackTransaction();
		    return ($errorMessage);
		}
		$externalTubeOrders = 1;

		
		if ($batch == 0){
		    # No more database entries are required
		    # Return out of start_submit sub back to package caller

		    return (
			    "ok", 
			    1      # send_mail TODO
			    );
		}
		
	    } # unless ($count == $count_no_DP){ 
	    
	} # if ( ($ext_primers == 0) || ($batch == 0) ){
	
    } # if ($count > 0){ # If we need to make some new primer database entries


    
    ####################################################################################
    # For requests which need a primer, get the id_primer (if we don't have it already)
    # We will need this to make the FINISH_REQUEST entries
    ####################################################################################
    my ($errorCode, $errorMessage) =&findIdPrimers(
						   $SECT,
						   $lastSECT,
						   $GRID_ROWS,
						   $DATA,
						   \%new_oligo_id,
						   $project,
						   );
    

    ######################################################################################################
    # Make the relevant database entries for FINISH_BATCH, FBATCH_STATUS, FINISH_REQUEST, FREQUEST_STATUS
    ######################################################################################################
    my ($errorCode, $errorMessage, $id_fbatch) = &makeRequestBatch(
								   $SECT,
								   $lastSECT,
								   $GRID_ROWS,
								   $DATA_INFO,
								   $DATA,
								   $backwards,
								   \%new_oligo_id,
								   $valid_adds2,
								   $sub_go,
								   $cust_p,
								   $reseq,
								   $project,
								   $id_role,
								   $ID_TEAM_FINSERV, 
								   $session_id,
								   $who,
								   );

    if ($errorCode){
	# Return out of start_submit sub back to package caller
	$se2->rollbackTransaction();
	return ($errorMessage);
    }

    
    # 1 is for send_mail
    # Return out of start_submit sub back to package caller
    return (
	    "ok", 
	    $externalTubeOrders, 
	    $id_fbatch
	    );
    

} # sub start_submit


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

sub getPurchaseInfo {
    my (
	$teamname,
	) = @_;

    # Obtain the purchase order number - There is 1 active purchase number which needs to be associated to the
    # prefix of the team in question (hence no join required on the 2x tables)
    my ($purchase_prefix, $purchase_no) = $se2->getRow('Submitfinentries::getPurchaseOrderDictInfo', [$teamname], $dbhTracking);
#    warn "Submitfinentries::getPurchaseOrderDictInfo returns\n"; # TODO
#    warn Data::Dumper::Dumper($purchase_prefix);                 # TODO
#    warn Data::Dumper::Dumper($purchase_no);                     # TODO

    return (0, "No errors", $purchase_prefix, $purchase_no);
    
}

sub getNewPrimerIds {
    my (
	$new_oligos,
	$new_oligo_id,
	
	) = @_;
    
    # We will need $count new id_primer values
    foreach my $primer (sort keys %$new_oligos){
	my $id = $se2->getRow('Submitfinentries::getIdPrimerSeq', [], $dbhTracking);
#	warn "Submitfinentries::getIdPrimerSeq returns\n"; # TODO
#	warn Data::Dumper::Dumper($id);                    # TODO
	$new_oligo_id->{$primer} = $id;                    # TODO
    }

    return (0, "No error");
}

sub findNewPrimers {
    my (
	$SECT,
	$lastSECT,
	$GRID_ROWS,
	$DATA_INFO,
	$DATA,
	$new_oligos,
	$new_oligos_no_DP,
	
	) = @_;

    my $info;
    my $count = 0;
    my $count_no_DP = 0;
    my $batch = 0;
    my $r;
    
    foreach $SECT ( 1 .. ($lastSECT)) {
	for ($r=0;$r<$GRID_ROWS;$r++) {
	    
	    $info = $DATA_INFO->[$SECT]->[$r]->[0];
	    
	    my $oligo_name = $DATA->[$SECT]->[$r]->[2];
	    my $oligo_sequence = $DATA->[$SECT]->[$r]->[3];
	    my $template = $DATA->[$SECT]->[$r]->[0];
	    
	    if ( ($oligo_name ne '') && ($oligo_sequence ne '') ) {
		$count++;
		$new_oligos->{$oligo_name} = $oligo_sequence;
		if ($info =~ /xxx/){
		    $count_no_DP++;
		    $new_oligos_no_DP->{$oligo_name}++;
		}
	    }
	    
	    # It may be the case that an oligo order was attached to
	    # a request which had a missing template, *but* the oligo
	    # is also attached to another template which is ok. We
	    # would want to remove such an oligo from 
	    # %new_oligos_no_DP
	    if ( ($oligo_name ne '') && (defined $new_oligos_no_DP->{$oligo_name}) ) {
		unless ($info =~ /xxx/){
		    undef $new_oligos_no_DP->{$oligo_name};
		    $count_no_DP--;
		}
	    }

	    # The user may just be ordering oligos - count the number of rows which have a template
	    if ($template ne ''){
		$batch ++;
	    }
	}
    }

    return (0, "No error", $count, $count_no_DP, $batch);
}


sub findIdPrimers {
    my (
	$SECT,
	$lastSECT,
	$GRID_ROWS,
	$DATA,
	$new_oligo_id,
	$project,
	) = @_;

    my $r = 0;

    # Go through each row of each section
    # For requests which need a primer, get the id_primer (if we don't have it already)
    foreach $SECT ( 1 .. ($lastSECT)) {
	for ($r=0;$r<$GRID_ROWS;$r++) {
	    
	    # If we have an oligoName, try to retrieve an id_primer for the project in question
	    my $oligo_name = $DATA->[$SECT]->[$r]->[2];
	    if ($oligo_name ne ''){
		
		unless (defined $new_oligo_id->{$oligo_name}){
		    my ($pid) = $se2->getRow('Submitfinentries::getIdPrimer', [$oligo_name, $project], $dbhTracking);
#		    warn Data::Dumper::Dumper($pid);             # TODO
		    $new_oligo_id->{$oligo_name} = $pid;
		    
		}
	    }
	}
    }
    
    return (0, "No error");
}


sub makeRequestBatch {

    my (
	$SECT,
	$lastSECT,
	$GRID_ROWS,
	$DATA_INFO,
	$DATA,
	$backwards,
	$new_oligo_id,
	$valid_adds2,
	$sub_go,
	$cust_p,
	$reseq,
	$project,
	$id_role,
	$ID_TEAM_FINSERV, 
	$session_id,
	$who, 
	
	) = @_;
    

    # Retrieve a new id for our finish batch
    my $id_fbatch = $se2->getRow('Submitfinentries::getIdFbatch', [], $dbhTracking);
    warn Data::Dumper::Dumper($id_fbatch);
    
    
    # Make a new finish_batch entry
    my ($id_auto, $primers_picked, $reseqs_picked);
    if ($sub_go > 0){
	$id_auto = $sub_go;
	$primers_picked = $cust_p;
	$reseqs_picked = $reseq;
    } else {
	$id_auto = "";
	$primers_picked = "";
	$reseqs_picked = "";
    }
    
    eval {
	my $rowCount = $se2->do('Submitfinentries::makeFinishBatch',
				[
				 $id_fbatch, 
				 $project, 
				 $id_role, 
				 $ID_TEAM_FINSERV, 
				 $id_auto, 
				 $primers_picked, 
				 $reseqs_picked
				 ], $dbhTracking);
    };
    if ($@){
	return (1, $@);
    }


    # Make a new fbatch_status entry
    eval {
	my $rowCount = $se2->do('Submitfinentries::makeFinishBatchStatus',
				[
				 $id_fbatch, 
				 1, # 'Created'
				 1, 
				 $session_id, 
				 'Submitfinentries.pm_Feb2007',
				 $who, 
				 ], $dbhTracking);
    };
    if ($@){
	return (1, $@);
    }
    

    # Go through each row of each section
    my $r;
    my $info;


    foreach $SECT ( 1 .. ($lastSECT) ) {
	for ($r=0;$r<$GRID_ROWS;$r++) {
	    
	    $info              = $DATA_INFO->[$SECT]->[$r]->[0];
	    
	    my $template       = $DATA->[$SECT]->[$r]->[0];
	    my $suff           = $DATA->[$SECT]->[$r]->[1];
	    my $oligo_name     = $DATA->[$SECT]->[$r]->[2];
	    my $oligo_sequence = $DATA->[$SECT]->[$r]->[3];
	    my $id_scsp        = $DATA->[$SECT]->[$r]->[6];
	    my $id_seqchem = $backwards->{$id_scsp};
	    my $add            = $DATA->[$SECT]->[$r]->[7];
	    my $prevFrequest   = $DATA->[$SECT]->[$r]->[9];

	    if ($template eq ''){ 
		next; 
	    }
	    
	    # Split template up
	    my ($plate, $row, $col) = $template  =~ /^(\S+)([a-p])(\d{1,2}$)/ ; # Screws up emacs tabbing ? TODO
								   
	    # Split suffix up
	    my $suffix = substr $suff, 0, 3;
	    my $iteration = substr $suff, 3;

	    #te:16bM178N11-1a1       su:q2k  pr:1530 se:     ru:0    it:     id:123  ad:     fr:7087635
	    #te:16bM178N11-1a2       su:q2k  pr:1530 se:     ru:0    it:     id:123  ad:     fr:7087636
	    #te:16bM178N11-1a3       su:p2k  pr:1530 se:     ru:0    it:     id:121  ad:     fr:7087637
	    #te:16bM178N11-1a4       su:q2k  pr:1530 se:     ru:0    it:     id:123  ad:     fr:7087638

	    warn "te:$template\tsu:$suffix\tpr:$oligo_name\tse:$oligo_sequence\tit:$iteration\tid:$id_scsp\tad:$add\tfr:$prevFrequest\n"; # TODO
	    
	    
	    # Get a new finish_request.id_frequest
	    my ($id_frequest) = $se2->getRow('Submitfinentries::getIdFrequest', [], $dbhTracking);
#	    warn Data::Dumper::Dumper($id_frequest);             # TODO
	    
	    
	    
	    # Make a new finish_request								  
	    my ($id_seqchemBind,
		$iterationBind,
		$id_primerBind,
		$id_additiveBind,
		$prevFrequestBind,
		);
								   
	    if ($id_seqchem eq ''){			
		$id_seqchemBind = ''
		} else {
		    $id_seqchemBind = $id_seqchem;
		}
	    
	    if ($iteration eq ''){			
		$iterationBind = '';
	    } else {
		$iterationBind = $iteration;
	    }
	    
	    if ($oligo_name eq ''){			
		$id_primerBind = '';
	    } else {
		$id_primerBind = $new_oligo_id->{$oligo_name};
	    }
	    
	    if ($add eq ''){	
		$id_additiveBind = '';
	    } else {
		$id_additiveBind = $valid_adds2->{$add};
	    }


	    if ($prevFrequest eq ''){			
		$prevFrequestBind = '';
	    } else {
		$prevFrequestBind = $prevFrequest;
	    }

	    eval {
		my $rowCount = $se2->do('Submitfinentries::makeFinishRequest',
					[
					 $id_frequest,      #1
					 $id_fbatch,        #2
					 $plate,            #3
					 $row,              #4
					 $col,              #5
					 $id_seqchemBind,   #6
					 $iterationBind,    #7
					 $id_primerBind,    #8
					 $id_scsp,          #9
					 $id_additiveBind,  #10
					 $prevFrequestBind, #11
					 ], $dbhTracking);
	    };
	    if ($@){
		return (1, $@);
	    }
	    
	    
	    # Make a new frequest_status - 
	    # Nb, A different status for requests which dont have the appro. DP available
	    my $fin_status;			
	    if ($info =~ /xxx/){
		$fin_status = 6; # Pending DP
	    } else {
		$fin_status = 1; # DP Created
	    }
	    
	    eval {
		my $rowCount = $se2->do('Submitfinentries::makeFrequestStatus',
					[
					 $id_frequest,
					 $fin_status,
					 1,
					 $session_id,
					 'Submitfinentries.pm_Feb2007',
					 $who
					 ], $dbhTracking);

	    };
	    
	    
	    if ($@){
		return (1, $@);
	    }
	    
	}
    }

    return (0, "No error", $id_fbatch);
 }



sub makeTubeOrder {
    
    my (
	$new_oligo_id,
	$sender_details,
	$primer_plate_data,
	$primer_ord_data,
	$who,
	$mail,
	) = @_;


    eval {
	foreach my $oligoName (keys %$new_oligo_id){
	    my $id_primer = $new_oligo_id->{$oligoName};
	    my $id_order  = $sender_details->{'Order_ID'};
	    my $rowCount = $se2->do('Submitfinentries::makeExtFinPrimerOrder',
				    [$id_primer, $id_order], $dbhTracking);
	}
    };
    if ($@){
	return (1, $@);
    }
    
    my $return_error = &create_order(
				     $sender_details,
				     $primer_plate_data,
				     $primer_ord_data,
				     0
				     );

    unless ($return_error == 0){
	my ($errors) = 
	    &handle_mail(
			 "PROBLEM :Oligo_orders", 
			 $error_group,            
			 $who,                    
			 $mail,                   
			 $return_error            
			 );
	if ($errors){
	    return (1, $errors);
	}
    }
    
    my ($errors) = 
	&handle_mail(
		     "Oligo_orders",      # TODO
		     "$who, $user_group", 
		     $who,                
		     $mail,               
		     );
    
    if ($errors){
	return (1, $errors);
    }
    
}



sub makePrimerEntries {
    # Make entries in tables PRIMER and PRIMER_STATUS

    my (
	$new_oligos,
	$new_oligo_id,
	$project,
	$costcode,
	$new_oligos_no_DP,
	$ext_primers,
	$session_id,
	$who,
	)= @_;
    
    foreach my $primer (sort keys %$new_oligos){
	my $pn = $primer;
	my $ps = $new_oligos->{$primer};
	my $pi = $new_oligo_id->{$primer};
	
	eval {
	    my $rowCount = $se2->do('Submitfinentries::makePrimer',
				    [$pi, $pn, $project, $ps, $costcode], $dbhTracking);
		
	    my $program_remark;
	    my $status;
	    
	    if (defined $new_oligos_no_DP->{$primer}){
		# 'Pending DP'
		$status = 7;
		$program_remark = 'Submitfinentries.pm_F07';
	    } elsif ($ext_primers == 1){
		# 'Submitted on plate'
		$status = 6;
		$program_remark = 'Submitfinentries.pm_F07';
	    } else {
		# 'Submitted'
		# Note that this will be for external tube orders, hence ->EXT has been added
		# to the project_remark for monitoring purposes
		$status = 1;
		$program_remark = 'Submitfinentries.pm_F07->EXT';
	    }

	    my $rowCount = $se2->do('Submitfinentries::makePrimerStatus',
				    [$pi, $status, 1, $session_id, $program_remark, $who], $dbhTracking);
	    
	};
	
	if ($@){
	    return (1, $@);
	}
    }
    
}



sub initDatabase {
    ($dbhTracking) = @_;
    warn "inside initDatabase - dbh - $dbhTracking\n";

    eval {
	
	# Make a SqlEngine object
	$se2 = new SqlEngine2();
	$se2->beginTransaction($dbhTracking);
	
	my $i;
	warn "Sql libs need to be in here somewhere...\n" unless ($reduce_out);
	unless ($reduce_out){
	    printf "%d %s\n", $i++, $_ for @INC;
	}

	# Load a SQL library
	$se2->loadSqlLib(['Submitfinentries']);
	
	# If we have been supplied with a db handle - see if we can do something with it
	unless (UNIVERSAL::isa($dbhTracking, "DBI::db")){
	    my $ref = ref $dbhTracking;
	    die "dbh supplied to initDatabase does not look correct ! $ref\n";
	}
	
	my $user = $se2->getRow('Submitfinentries::getUser', [], $dbhTracking);
	warn "Submitfinentries::getUser returns\n";
	warn Data::Dumper::Dumper($user) unless ($reduce_out);
	
    };
    if ($@) {
	die "Issues encountered initiating SqlEngine2\n$@";
    }
    
}


sub compose_mail_and_order {

    # This routine composes an oligo order email and 
    # creates the hashes required by xml_primer_order.pm

    my (
	$who,                 #1
	$teamname,            #2
	$costcode,            #3
	$species,             #4
	$project,             #5
	$currprojectchr,      #6
	$curr_finservice,     #7
	$purchase_prefix,     #8
	$purchase_no,         #9
	$oligo_info,          #10   The list of the new oligos
	$dont_order,          #11   The list of oligos where the DPs are not available
	$order_ref            #12   OligoName -> id_primer  (New oligos required)
	) = @_;


    # Generate the email message
    my @mail;
    push @mail, "Your oligo order has been placed externally. \n";
    push @mail, "Please contact team58 with any queries. \n"; 
    push @mail, "\n";
    push @mail, "An oligo order from $who in team $teamname. \n"; 
    push @mail, "\n";
    push @mail, "The cost-code for this submission is - $costcode.\n";
    push @mail, "Species of project is - $species\n";
    push @mail, "Chromosome of project is - $currprojectchr\n";
    push @mail, "Destination - $curr_finservice\n";
    push @mail, "\n";


    # Information required to generate the XML order file
    my (
	$purchase_order,
	$id_primer,
	);
    

    # TODO - these look like statics - THEY ARE!
    my $secret = 'sanger finishing';
    my $supplier = 'sigma';
    my $priority = 1;
    my $account = '5513901004';
    my $default_sender = 'ftp-primer@sanger.ac.uk';
    my $file_type = 'SIGMA_HTTPS_LIVE';
    my $recipient = 'team58';
    
    my %primer_ord_data;  # Collects details for each new oligo to order
    my $primer_count = 0; # A count of the number of oligos to order


    # Go through the list of new oligos and generate an order
    foreach my $oligoName (sort keys %$oligo_info){
	
	unless (defined $dont_order->{$oligoName}){ # Ignore oligos where the DPs are not available
            $primer_count++;
            if ($primer_count == 1){ 
                $id_primer = $order_ref->{$oligoName}; # Find the id_primer for the first new primer on the list
            }

            $oligoName=~ s/\s+//g;
            $oligo_info->{$oligoName}=~ s/\s+//g;
	    
            my $primer_name = "$project" . "." . "$oligoName";
            my $primer_seq = $oligo_info->{$oligoName};
	    my $order = "$project" . "." . "$oligoName\n$oligo_info->{$oligoName}\n";
	    push @mail, $order;

            $primer_ord_data{$primer_count}{'OligoName'}          = $primer_name;
            $primer_ord_data{$primer_count}{'OligoSequence'}      = $primer_seq;
            $primer_ord_data{$primer_count}{'OligoScale'}         = '0.025';
            $primer_ord_data{$primer_count}{'OligoPurification'}  = 'DST';
            $primer_ord_data{$primer_count}{'OligoNotes'}         = '[ALIQUOT-72HR]';
            $primer_ord_data{$primer_count}{'OligoWells'}         = 1;
	}
    }
    
    $purchase_order = $purchase_no . '.' . $id_primer;
    
    my %primer_plate_data;
    $primer_plate_data{'StockPlateNumber'}    = 'NONE';
    $primer_plate_data{'StockPlateID'}        = 'NONE';
    $primer_plate_data{'WorkingPlateNumber'}  = 'NONE';
    $primer_plate_data{'WorkingPlateID'}      = 'NONE';
    $primer_plate_data{'OrderDate'}           = '';
    $primer_plate_data{'Comment1'}            = $teamname;
    $primer_plate_data{'Comment2'}            = $id_primer;
    $primer_plate_data{'Comment3'}            = '';
    $primer_plate_data{'OligoCount'}          = $primer_count;

    
    my %sender_details;
    $costcode =~ s/\.//g;
    $costcode =~ s/\-//g;
    $sender_details{'Sender'}             = $recipient; #person to receive reply emails.
    $sender_details{'Orderer'}            = $who; #person who placed the original order. 
    $sender_details{'Order_ID'}           = $id_primer;
    $sender_details{'Team'}               = $teamname;
    $sender_details{'Account'}            = $account;
    $sender_details{'PO_Prefix'}          = $purchase_prefix;
    $sender_details{'Purchase_Order'}     = $purchase_order;
    $sender_details{'Secret_Passphrase'}  = $secret;
    $sender_details{'Supplier'}           = $supplier;
    $sender_details{'Priority'}           = $priority;
    $sender_details{'FileName'}           = 'FIN' . $id_primer;
    $sender_details{'Default_Sender'}     = $default_sender;
    $sender_details{'File_Type'}          = $file_type;

    my $output_filename = $sender_details{'FileName'}.'.xml';

    push @mail, "\n(Output file:$output_filename)\n";


#    print STDOUT Data::Dumper::Dumper(\@mail); # TODO

    return (
	    \@mail,
	    \%sender_details,
	    \%primer_plate_data,
	    \%primer_ord_data
	    );

}



sub handle_mail {
    my (
	$subject,        # The subject of the mail
	$to,             # Who the mail is being sent to 
	$who,            # The user sending the email
	$mail,           # The mail message
	$error_message   # An additional error message
	) = @_;
    
#    $to = "kva"; # TODO -remove

    unless ( (defined $subject) && (defined $to) && (defined $who) && (defined $mail) ) {
	return ("Error calling handle_mail!");
    }
    
    eval {        
	my $mailer = Mail::Mailer->new("sendmail");
	$mailer->open(
		      { From      => "$who",
			To        => "$to",
			Subject   => "$subject"
			}
		      )
	    or die "Can't open: $!\n";

	if ($error_message){
	    print $mailer "ERROR RAISED : $error_message\n";
	}

	foreach my $t (@$mail){
	    print $mailer $t;
	}
	
	close($mailer);
    };
   
    if ($@){
	my $ret = "Problems sending email: ". "$@";
	return ($ret);
    }

}




1;


__END__







