#!/usr/local/bin/perl5.004
#
#######################################################################
# 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.                      #
#######################################################################
 
BEGIN {
#    warn "Using local version of costcode entry ...\n";
};

# Author kva@sanger.ac.uk 

use strict;
use Tk;
require 'badgerGetOpt.pl';
use WrapDBI;
use finch2_general;
use NewBrowseEntry;

my $BITMAP_DIR = "$ENV{'BADGER'}/lib/finch/bitmaps";
my $prog = 'costcode';
$ENV{'DISPLAY'} || die "$prog: \$DISPLAY environment variable not set, Please set via 'ncd' or 'dis' command.\n";

# Fonts
my $title_f = "-adobe-helvetica-bold-r-normal--24-240-75-75-p-138-iso8859-1";
my $entry_f = "-adobe-helvetica-medium-r-normal--17-120-100-100-p-88-iso8859-1";
my $button_f = "-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso8859-1";
my $label_f = "-adobe-helvetica-bold-r-normal--14-100-100-100-p-82-iso8859-1";

#Command-line short cuts
my ($who,$team);
my $opts = {
    "-who" => {
        "type" => "text",	
        "var" => \$who,
        "help" => "Specify user -DEBUGGING ONLY.",
	"def" => &user_who,
    },

    "-team" => {
        "type" => "text",	
        "var" => \$team,
        "help" => "Specify team -DEBUGGING ONLY.",
	"def" => 0,
    }

};

&badgerGetOpt($prog,'',$opts) && die "Quit\n";

#Turn off the buffering
$|=1;

#Create the main window
my $mainWindow = MainWindow->new;
$mainWindow-> configure(-cursor  => 'hand2');
$mainWindow->wm('minsize', 500, 230); 
$mainWindow->wm('maxsize', 500, 230);
my $f = $mainWindow->Frame(-height => 230, -width => 500);
$f->pack();
$mainWindow->idletasks();
$mainWindow->packPropagate(0);
$f->packForget();

# DD
my $db = 'finch';
#my $db = 'trackingclone_apr2002';

my $dbh = WrapDBI->connect("$db", {RaiseError => 1});    
$dbh->{autocommit} = 0;
print STDOUT "costcode entry interface started...\n";


# Determine whether the user is logged on as the team-account first;
if (check->team_account($dbh, $who)){
    # This is a recognised team-account
    # ID_ROLE ? - who are we dealing with here ?
    my $user_acct = $who;
    $who = '';
    my $who_win = $mainWindow->Toplevel;
    $who_win->configure (-title => "Please provide information.");
    my $who_frame = $who_win->Frame();
    my $who_label = $who_frame->Label(-text => "You are logged in as the team account $user_acct.\nPlease give your personal login and hit return.", -font => $label_f);
    $who_label->pack(-side=> 'top');
    my $who_entry = $who_frame->Entry(-textvariable => \$who, -bg => 'honeydew2', -font => $entry_f);
    $who_entry->pack(-side => 'top');
    $who_entry->focusForce;
    $who_entry->bind ('<Return>' => sub { 
	$who_win->destroy;
    } );
    $who_entry->configure (-width => 50);
    $who_frame->pack;
    $who_frame->waitWindow;
}

#Find out id_person
my $id_person = get->id_person_from_person($dbh, $who);
unless ( defined $id_person){
    popup ("STOP", ["CONTACT BUG. You are not registered in Oracle's PERSON table. \n"]);
    die;
}

# Find out relevant id_role
# Note that this person could be a finisher for multiple teams
my ($id_role, $teamname) = get->id_person2id_role($dbh, $id_person, $mainWindow, $label_f);
unless ( (defined $id_role) && (defined $teamname) ){	
    popup ("STOP", ["CONTACT BUG. You are not registered in Oracle's TEAM_PERSON_ROLE table as a Finisher. \n"]);
    die;
}

if ($team){
    $teamname = $team;
}

my $deflist = &get_codes($dbh);


###########
# Graphics
###########

my $PROJ_COST = "project code";
my $first_frame = $mainWindow->Frame()->pack( -side => 'top');
$first_frame->Label( font => $title_f,
		     -text => "User is $who from TEAM $teamname.",
		     "-height" => 1)->pack(-side => 'left'
					   );

# Update frame
my $frame_b = $mainWindow->Frame()->pack(-side => 'top', -fill => 'x');
my $update_screen = $frame_b->ScrlListbox (-font => $button_f,
					   -bg => 'white',
					   -scrollbars => 'e',
					   -label => "Update",
					   -height => 3,
					   -width => 30
					   )->pack(-side => 'top', -fill => 'x');

my $fill1_frame = $mainWindow->Frame("-height" => 10)->pack(-side => 'top');

my $second_frame = $mainWindow->Frame()->pack(-side => 'top');

my $team_entry = $second_frame->Entry(-font => $title_f, 
				      -bg => 'honeydew2', 
				      -width => 5, 
				      -textvariable => \$teamname, 
				      -state => 'disabled')->pack(-side => 'left');

my $proj_cost = $second_frame->BrowseEntry(-width => 15,
					   -font => $button_f,
					   -variable => \$PROJ_COST,
					   -state => 'active'
					   )->pack(-side => 'left');

$proj_cost->insert('end',@{$deflist});
my $pc = $proj_cost->Subwidget("entry")->Subwidget("entry");
$pc->configure(-bg => 'honeydew2');

my $value = '7060';
my $normal = $second_frame->Entry(-font => $title_f, 
				 -bg => 'honeydew2', 
				 -width => 5, 
				 -textvariable => \$value, 
				 -state => 'disabled')->pack(-side => 'left');

my $fill2_frame = $mainWindow->Frame("-height" => 10)->pack(-side => 'top');

my $third_frame = $mainWindow->Frame(-relief=>'groove', -borderwidth=>'4')->pack( -side => 'top', -expand=>1);

my $updateButton = $third_frame->Button(-font => $button_f, 
					-text => 'Update',
					-width => 10,
					-command => sub {
					    $proj_cost->delete(0,'end'); 
					    $deflist = &get_codes($dbh);
					    $proj_cost->insert('end',@{$deflist});
					    })->pack(-side => 'left');

my $submitButton = $third_frame->Button(-font => $button_f, 
					-text => 'Submit',
					-width => 10,
					-command => sub { 
					    if ($PROJ_COST=~ /\D+/){
						&update("Cost project field contains illegal characters.");
					    } else {
						&costcode_sub($dbh,$teamname,$PROJ_COST,$value);
						$PROJ_COST='';
						&update("Done.");
					    } 
					})->pack(-side => 'left');

my $exitButton = $third_frame->Button(-font => $button_f, 
				      -text => 'Close',
				      -width => 10,
				      -command => sub { 
					  exit; 
				      })->pack(-side => 'left');

&update("Select or insert a project code for your team.");

MainLoop();

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


sub get_codes {
    my($dbh)=@_;

#    print ">>here in get_codes subroutine<<\n";

    my $statement = "select distinct COST_PROJECT from costcode where cost_project != 0"; 
    my $sthcost = $dbh->prepare($statement) || die "ERROR:$DBI::errstr";
    $sthcost->execute || die "ERROR:$DBI::errstr";
    my $C;
    my @cost;
    while($C = $sthcost->fetchrow()){
#	print ">>code $C<<\n";
        push @cost,$C;
    }
    $sthcost->finish();
    return (\@cost);

}

sub costcode_sub{
    my($dbh,$teamname,$PROJ_COST,$value)=@_;
    
    $PROJ_COST=~ s/^0+// unless $PROJ_COST=~ /^00$/;
    
    my $check =$PROJ_COST;
    if ($check=~ /^(0)0$/){
	$check=~ s/$1//;
    }
    
    my $stat1 = "select id_costcode from costcode where cost_team = ? and cost_project = ? and cost_category = ?";
    my $sth1 = $dbh->prepare($stat1) || die "ERROR:$DBI::errstr";
    $sth1->execute($teamname,$check,$value) || die "ERROR:$DBI::errstr";
    my $id_cost = $sth1->fetchrow();
    $sth1->finish();
    if ($id_cost) {
	&update("Costcode $id_cost is already present in the database.");
	return();
    } else {
	if ($PROJ_COST < 10){
	    $PROJ_COST= "0" . "$PROJ_COST";
	}
	my $newid_costcode = $teamname.'-'.$PROJ_COST.'-'.$value;
	eval {
	    my $stat2 = "insert into costcode values (?,?,?,'Oligos (Internal)',?,1,1)";
	    my $sth2 = $dbh->prepare($stat2) || die "ERROR:$DBI::errstr";
	    $sth2->bind_param(1,$teamname);
	    $sth2->bind_param(2,$check);
	    $sth2->bind_param(3,$value);
	    $sth2->bind_param(4,$newid_costcode);
	    $sth2->execute() || die "ERROR:$DBI::errstr";
	    $sth2->finish();
	};
	if ($@){
	    $dbh->rollback();
	    &update("Problem was encountered - $@.");
	} else {
	    $dbh->commit();
	    &update("New costcode $newid_costcode has been entered into");
	    &update("the database for team $teamname.");
	    &update("Entry has been commited to the database.");
	    my $file = "/nfs/disk54/badger/logs/costcode_entry.log";
	    system ("/bin/echo `/bin/date` $db $who $teamname $PROJ_COST >> $file");
	}
	return();
    }
    
    
}

sub update {
    my (@update_contents)=@_;
    $update_screen->insert('end', @update_contents);
    $update_screen->see('end'); 
    $update_screen->pack(-side => 'left', -expand => 1, -fill => 'both');
}


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


__END__
