package reprint_info;

use strict;
use Carp;
use WrapDBI;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = ('Exporter');
@EXPORT = qw(&reprint_info);


sub reprint_info {
    my ($db, $prefix, $type, $id_var) = @_;

    my ($date, $barcode, $owner, $suffix, $name, $project);

    my %possibles = (
		     "SO" => \&SO,
		     "BB" => \&BB,
		     "DP" => \&DP,   ### We now have 384 well DNA_PLATES which have a different sticker
		     "GP" => \&GP,
		     "LP" => \&LP,
		     "PC" => \&PC,
		     "DT" => \&DT,
		     "EP" => \&EP,
		     "DN" => \&DN,
		     );
    
    if (defined $possibles{$prefix}){


	##############################
	# A new db connection is made
	##############################
	my $dbh = WrapDBI->connect("$db", {RaiseError => 1});

	my $test_id;

	#############################################################
	# NOTE that the entity-type determines the subroutine called
	#############################################################
	($test_id, $date, $owner, $suffix, $name, $project) = &{$possibles{$prefix}}($dbh, $id_var);
	if (!defined $test_id || $test_id eq ''){
	    $dbh->disconnect();
	  Carp::croak "No database entry exists for $prefix ID $id_var.";
	}
	$dbh->disconnect();
	
    } else {
      Carp::croak "Sorry, I cannot yet re-print $prefix type barcodes. Contact Bug.";
    }

    # TYPE-1
   
    return ($date, $owner, $suffix, $name, $project);

}

#######################################
# Add entity specific subroutines here
#######################################

sub SO {

    ################################################################################
    # Note that 'and dna_plate.copy_type = 1' *currently* prevents printing of 384
    # plates as they are copy_type 3; these entities use different stickers
    ################################################################################

    my ($dbh, $id_var) = @_;
    my $statement = "
select distinct sp.id_sourceplate, sp.platename, to_char(sps.statusdate, 'DD-MON-YYYY'), 
sp.libraryname, sps.operator, vs.vectorname
from source_plate sp, sourceplate_status sps, library l, vectorsite vs
where sp.id_sourceplate = sps.id_sourceplate
and sp.libraryname = l.libraryname
and l.id_vectorsite = vs.id_vectorsite
and sps.status in (1, 2)  
and sp.id_sourceplate = ?
";
    my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth1->bind_param(1, $id_var);
    $sth1->execute || die "ERROR:$DBI::errstr";
    my ($id_sp, $name, $date, $libraryname, $operator, $vector) = $sth1->fetchrow();
    $sth1->finish();

    return($id_sp, $date, $operator, $vector, $name, $libraryname);
}


sub BB {
    my ($dbh, $id_var) = @_;
    my $statement = "
select distinct beckman_box.id_beckmanbox, beckman_box.name, 
to_char(bb_status.statusdate, 'DD-MON-YYYY'), ligation.clonename,
ligation.id_ligation
from beckman_box, bb_status, bb_map, subclone, ligation
where beckman_box.id_beckmanbox = bb_status.id_beckmanbox
and beckman_box.id_beckmanbox = bb_map.id_beckmanbox
and bb_map.id_subclone = subclone.id_subclone
and subclone.id_ligation = ligation.id_ligation
and beckman_box.id_beckmanbox = \'$id_var\'
and bb_status.status = 1
";
    my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth1->execute || die "ERROR:$DBI::errstr";
    my $owner;
    my $suffix;
    my ($id_bb, $name, $date, $project, $ligation) = $sth1->fetchrow();

    $suffix = $ligation;

    $sth1->finish();

    if ($project ne ''){
	$statement = "
select distinct project_owner.teamname
from project_owner, clone_project, clone
where project_owner.projectname = clone_project.projectname
and clone_project.clonename = clone.clonename
and clone.clonename = \'$project\'
and (project_owner.projectname, project_owner.owned_from) in (
        select po.projectname, max(po.owned_from)
        from project_owner po
        where po.owner_type = 2
        group by po.projectname
)
";
	$sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
	$sth1->execute || die "ERROR:$DBI::errstr";
	my $t;
	my @teams;
	my $count = 0;
	while ($t = $sth1->fetchrow()){
	    $count++;
	    push @teams, $t
	    }
	$sth1->finish();
	
	if ($count == 1){ $owner = $teams[0] };

    }

    return($id_bb, $date, $owner, $suffix, $name, $project);
}



sub DP {

    ################################################################################
    # Note that 'and dna_plate.copy_type = 1' *currently* prevents printing of 384
    # plates as they are copy_type 3; these entities use different stickers
    ################################################################################

    my ($dbh, $id_var) = @_;
#    my $statement = "
#select distinct dna_plate.id_dnaplate, beckman_box.name, to_char(dnaplate_status.statusdate, 'DD-MON-YYYY'), ligation.clonename, dnaplate_status.operator, dna_plate.team
#from dna_plate, dnaplate_map, bb_map, beckman_box, dnaplate_status, ligation, subclone
#where dna_plate.id_dnaplate = dnaplate_map.id_dnaplate
#and dnaplate_map.id_bbmap = bb_map.id_bbmap
#and bb_map.id_beckmanbox = beckman_box.id_beckmanbox
#and dna_plate.id_dnaplate = dnaplate_status.id_dnaplate
#and bb_map.id_subclone = subclone.id_subclone
#and subclone.id_ligation = ligation.id_ligation
#and dnaplate_status.status = 1
#and dna_plate.copy_type = 1
#and dna_plate.id_dnaplate = \'$id_var\'
#and beckman_box.is_original = 1
#";


    my $statement = "
select distinct dna_plate.id_dnaplate, beckman_box.name, to_char(dnaplate_status.statusdate, 'DD-MON-YYYY'), ligation.clonename, dnaplate_status.operator, dna_plate.team
from dna_plate, dnaplate_map, bb_map, beckman_box, dnaplate_status, ligation, subclone
where dna_plate.id_dnaplate = dnaplate_map.id_dnaplate
and dnaplate_map.id_bbmap = bb_map.id_bbmap
and bb_map.id_beckmanbox = beckman_box.id_beckmanbox
and dna_plate.id_dnaplate = dnaplate_status.id_dnaplate
and bb_map.id_subclone = subclone.id_subclone
and subclone.id_ligation = ligation.id_ligation
and dnaplate_status.status = 1
and dna_plate.id_dnaplate = \'$id_var\'
and beckman_box.is_original = 1
";






    my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth1->execute || die "ERROR:$DBI::errstr";
    my ($id_dna, $name, $date, $project, $suffix, $owner) = $sth1->fetchrow();
    $sth1->finish();

    return($id_dna, $date, $owner, $suffix, $name, $project);
}

sub GP {
    my ($dbh, $id_var) = @_;
    my $statement = "
select distinct dna_plate.id_dnaplate, beckman_box.name, to_char(dnaplate_status.statusdate, 'DD-MON-YYYY'), ligation.clonename, dnaplate_status.operator, dna_plate.team
from dna_plate, dnaplate_map, bb_map, beckman_box, dnaplate_status, ligation, subclone
where dna_plate.id_dnaplate = dnaplate_map.id_dnaplate
and dnaplate_map.id_bbmap = bb_map.id_bbmap
and bb_map.id_beckmanbox = beckman_box.id_beckmanbox
and dna_plate.id_dnaplate = dnaplate_status.id_dnaplate
and bb_map.id_subclone = subclone.id_subclone
and subclone.id_ligation = ligation.id_ligation
and dnaplate_status.status = 1
and dna_plate.copy_type = 2
and dna_plate.id_dnaplate = \'$id_var\'
and beckman_box.is_original = 1
";
    my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth1->execute || die "ERROR:$DBI::errstr";
    my ($id_dna, $name, $date, $project, $suffix, $owner) = $sth1->fetchrow();
    $sth1->finish();

    return($id_dna, $date, $owner, $suffix, $name, $project);
}

sub LP {
    my ($dbh, $id_var) = @_;
    my $statement = "
select distinct loadingplate.id_loadingplate, loadingplate.platename, to_char(loadingplate_status.statusdate, 'DD-MON-YYYY'), loadingplate.suffix || loadingplate.iteration, loadingplate.team, loadingsample.id_scsp, seqprotocol.name
from loadingplate, loadingplate_status, loadingsample, seqchem_seqprotocol, seqprotocol
where
loadingsample.id_scsp = seqchem_seqprotocol.id_scsp
and seqchem_seqprotocol.id_protocol = seqprotocol.id_protocol
and loadingplate.id_loadingplate = loadingsample.id_loadingplate
and loadingplate.id_loadingplate = loadingplate_status.id_loadingplate
and loadingplate_status.status = 1
and loadingplate.id_loadingplate = \'$id_var\'
";
    my $sth1 = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sth1->execute || die "ERROR:$DBI::errstr";
    my ($id_lp, $name, $date, $suffix, $owner, $id_scsp, $protocol) = $sth1->fetchrow();
    $sth1->finish();

    return () if !defined $id_lp;
    $protocol =~ /^(\w+)-/;
    my $project = "$id_scsp" . " $1";
    return($id_lp, $date, $owner, $suffix, $name, $project); 

}


#########################################################################################################
########################################## NEW ENTITIES IN SNP  #########################################
#########################################################################################################
sub  PC	 {

    #### PCR plate in snp for exon reseq etc
    
    my ($dbh, $id_var) = @_;
    my $get_pcr_sth = $dbh->prepare(qq[ select distinct
					PCRPLATE_STATUS.ID_PCRPLATE,
					to_char(PCRPLATE_STATUS.STATUS_DATE, 'DD-MON-YYYY'), 
					PERSON.EMAIL,
					PCR_PLATE.TEAM,
					OLIGO_ORDER.OLIGONAME,
					INDIVIDUAL.CLONENAME,
					PCRPLATE_STATUS.PROGRAM
					from 
					PERSON, 
					TEAM_PERSON_ROLE,
					PCRPLATE_STATUS,
					DNA_WELL,
					DNA_TUBE,
					INDIVIDUAL,
					PCR_PLATE,
					PCR_WELL,
					ORDER_WELL,
					OLIGO_ORDER
					where
					PCRPLATE_STATUS.ID_PCRPLATE = ?
					and PCRPLATE_STATUS.STATUS  = ?
					and PCRPLATE_STATUS.IS_CURRENT = ?
					and PCR_PLATE.ID_PCRPLATE = PCRPLATE_STATUS.ID_PCRPLATE
					and TEAM_PERSON_ROLE.ID_ROLE = PCRPLATE_STATUS.ID_ROLE
					and TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON 
					and PCR_WELL.ID_PCRPLATE = PCRPLATE_STATUS.ID_PCRPLATE
					and PCR_WELL.ID_MAP = ?
					and  ORDER_WELL.ID_WELL = PCR_WELL.ID_WELL
					and  OLIGO_ORDER.ID_OO = ORDER_WELL.ID_OO 
					and  DNA_WELL.ID_DNAWELL = PCR_WELL.ID_DNAWELL
					and  DNA_WELL.ID_CONTENT = DNA_TUBE.ID_DNATUBE
					and  DNA_TUBE.ID_IND = INDIVIDUAL.ID_IND
					]);

    my $project; 
    my $suffix = "";
    $get_pcr_sth->execute($id_var, 1, 1,97);
# will only see 384 well PC, but that's OK because only CGP make 96, and they don't use this
    my ($id_pcr, $date, $owner, $team, $oligo, $dna,$prog) = $get_pcr_sth->fetchrow();
    return () if !defined $id_pcr;

    if(	$prog =~ /ExoSeq/){
	 #### nasty - better way???
	$project = "ExoSeq PCR";
    }
    else{
	$project = " PCR";
    }
    #### name is a combination of A1 STS and A1 DNA
    chop($oligo);
   my  $name = "$oligo $dna";

    return($id_pcr, $date, $owner, $suffix, $name, $project);
}



#######################################
# NOTE that DT entities are TYPE 2
# P/N 44-A4130 CILS white polyester 2
# 5 x 19 mm and 10 mm circular label
#######################################
sub DT	 {

    ####  DNA tube in snp for exon reseq etc
    require "/usr/local/badger/bin/Checkbarcode.pm";  ###
    my ($dbh, $id_var) = @_;

    ### dna tubes are first labelled when they arrive or when they are created => 2 status to check
    my $get_dnatube_sth = $dbh->prepare(qq[ select distinct
					    DNATUBE_STATUS.ID_DNATUBE,
					    to_char(DNATUBE_STATUS.STATUS_DATE, 'DD-MON-YYYY'), 
					    PERSON.EMAIL,
					    DNA_TUBE.TEAM,
					    INDIVIDUAL.CLONENAME
					    from 
					    PERSON, 
					    TEAM_PERSON_ROLE,
					    DNATUBE_STATUS,
					    DNA_TUBE,
					    INDIVIDUAL
					    where
					    DNATUBE_STATUS.ID_DNATUBE = ?
					    and DNATUBE_STATUS.STATUS  in ( 1, 2)
					    and DNATUBE_STATUS.IS_CURRENT = ?
					    and TEAM_PERSON_ROLE.ID_ROLE = DNATUBE_STATUS.ID_ROLE
					    and TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON 
					    and  DNA_TUBE.ID_DNATUBE = DNATUBE_STATUS.ID_DNATUBE
					    and  DNA_TUBE.ID_IND = INDIVIDUAL.ID_IND
					    ]);
   
    my $suffix = "";
    ##### TUBE LABELS - info in fields not standard
    $get_dnatube_sth->execute($id_var,1);
    my ($id, $date, $owner, $team, $dna) = $get_dnatube_sth->fetchrow();   
    ####### probs using this normally...
    my ($pp,$hr) = Checkbarcode::Calculatebarcode('DT',$id);  ## Project is hr
    ## owner & name are dna name - fir lid and wrap round
    
    return($id, $date, $dna, $suffix, $dna, $hr);
}


sub EP	 {

    ####  externally synthesize oligo plate (or dilution of) in snp 
    
    my ($dbh, $id_var) = @_;

    ### dna tubes are first labelled when they arrive or when they are created => 2 status to check
    my $get_oligoplate_sth = $dbh->prepare(qq[ select distinct
					       OLIGOPLATE_STATUS.ID_OLIGOPLATE,
					       to_char(OLIGOPLATE_STATUS.STATUS_DATE, 'DD-MON-YYYY'), 
					       PERSON.EMAIL,
					       OLIGO_ORDER.OLIGONAME,
					       OLIGOPLATE_STATUS.PROGRAM
					       from 
					       PERSON, 
					       TEAM_PERSON_ROLE,
					       OLIGOPLATE_STATUS,
					       OLIGOPLATE_WELL,
					       ORDER_WELL,
					       OLIGO_ORDER
					       where
					       OLIGOPLATE_STATUS.ID_OLIGOPLATE = ?
					       and  OLIGOPLATE_STATUS.STATUS  in (1, 2, 4)
					       and  OLIGOPLATE_STATUS.IS_CURRENT = ?
					       and  TEAM_PERSON_ROLE.ID_ROLE = OLIGOPLATE_STATUS.ID_ROLE
					       and  TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON 
					       and  OLIGOPLATE_WELL.ID_OLIGOPLATE = OLIGOPLATE_STATUS.ID_OLIGOPLATE
					       and  OLIGOPLATE_WELL.ID_MAP in (1,96)
					       and  ORDER_WELL.ID_WELL = OLIGOPLATE_WELL.ID_WELL
					       and  OLIGO_ORDER.ID_OO = ORDER_WELL.ID_OO 
					       ]);
   
    my $suffix = "";
    my $project= "";
    my $name ;
    $get_oligoplate_sth->execute($id_var,1);
    my $res = $get_oligoplate_sth->fetchall_arrayref();
    
    #### name is a combination of A1 STS and H12 STS
    if(defined $res->[3]->[3]){
	#### mix plate
	$name = "$res->[0]->[3] $res->[3]->[3]";
    }
    else{
	$name = "$res->[0]->[3] $res->[1]->[3]";
    }
    if(	$res->[0]->[4] =~ /ExoSeq/){
	#### nasty - better way???
	$project = "ExoSeq STS";
    }
    else{
	$project = " PCR";
    }

    #### correct to get one S one A
    return($res->[0]->[0], $res->[0]->[1], $res->[0]->[2], $suffix, $name, $project);
}




sub DN  {

####  DNA plate in snp for exon reseq etc
    
    my ($dbh, $id_var) = @_;

    
#    my $get_dnaplate_sth = $dbh->prepare(qq[ select distinct
#					     DNAPLATE_STATUS.ID_DNAPLATE,
#					     to_char(DNAPLATE_STATUS.STATUS_DATE, 'DD-MON-YYYY'), 
#					     PERSON.EMAIL,
#					     DNA_PLATE.TEAM,
#					     INDIVIDUAL.CLONENAME,
#					     DNAPLATE_STATUS.PROGRAM
#					     from 
#					     PERSON, 
#					     TEAM_PERSON_ROLE,
#					     DNAPLATE_STATUS,
#					     DNA_PLATE,
#					     DNA_WELL,
#					     DNA_TUBE,
#					     INDIVIDUAL
#					     where
#					     DNAPLATE_STATUS.ID_DNAPLATE = ?
#					     and DNAPLATE_STATUS.STATUS  =1
#					     and DNAPLATE_STATUS.IS_CURRENT = 1
#					     and TEAM_PERSON_ROLE.ID_ROLE = DNAPLATE_STATUS.ID_ROLE
#					     and TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON 
#					     and  DNA_PLATE.ID_DNAPLATE = DNAPLATE_STATUS.ID_DNAPLATE
#					     and  DNA_WELL.ID_DNAPLATE = DNA_PLATE.ID_DNAPLATE 
#					     and  DNA_WELL.ID_MAP = 97
#					     and  DNA_WELL.ID_CONTENT =  DNA_TUBE.ID_DNATUBE
#					     and  DNA_TUBE.ID_IND = INDIVIDUAL.ID_IND
#					     ]);
    my $get_dnaplate_sth = $dbh->prepare(qq[ select distinct
					     DNAPLATE_STATUS.ID_DNAPLATE,
					     to_char(DNAPLATE_STATUS.STATUS_DATE, 'DD-MON-YYYY'), 
					     PERSON.EMAIL,
					     DNA_PLATE.TEAM,
					     NVL(INDIVIDUAL.CLONENAME,'UNKNOWN'),
					     DNAPLATE_STATUS.PROGRAM
					     from 
					     PERSON, 
					     TEAM_PERSON_ROLE,
					     DNAPLATE_STATUS,
					     DNA_PLATE,
					     DNA_WELL,
					     DNA_TUBE,
					     INDIVIDUAL
					     where
					     DNAPLATE_STATUS.ID_DNAPLATE = ?
					     and DNAPLATE_STATUS.IS_CURRENT = 1
					     and TEAM_PERSON_ROLE.ID_ROLE = DNAPLATE_STATUS.ID_ROLE
					     and TEAM_PERSON_ROLE.ID_PERSON = PERSON.ID_PERSON 
					     and  DNA_PLATE.ID_DNAPLATE = DNAPLATE_STATUS.ID_DNAPLATE
					     and  DNA_WELL.ID_DNAPLATE = DNA_PLATE.ID_DNAPLATE 
					     and  DNA_WELL.ID_MAP in (1,97)
					     and  DNA_WELL.ID_CONTENT =  DNA_TUBE.ID_DNATUBE (+)
					     and  DNA_TUBE.ID_IND = INDIVIDUAL.ID_IND (+)
					     ]);
   
    
    $get_dnaplate_sth->execute($id_var);
    my ($id, $date, $owner, $team, $dna,$prog) = $get_dnaplate_sth->fetchrow();

    my $suffix = "";
    my $project;
    if(	$prog =~ /ExoSeq/){
	#### nasty - better way???
	$project = "ExoSeq DNA";
    }
    else{
	$project = " DNA";
    }
    
    return($id, $date, $owner,  $suffix, $dna, $project);
    
}
1;



