#!/usr/local/bin/perl5.6.1 -w
# $Id: BoxDataM.pm,v 1.3 2003/10/24 12:47:39 jx1 Exp $

package BoxDataM;

use strict;
use warnings;
use Carp qw(croak cluck carp);
use Class::Struct;
use sigtrap qw(die untrapped normal-signals
               stack-trace any error-signals);

use Cypher;
use sql_engine;
use Checkbarcode;

my $ABgenehost = "$ENV{'ABGENE_HOST'}"; #"ABgene38";
my $db = '2dbarcode';
my $user_role = 'DNA_collection';

use constant SQLLIB => 'Box.sql_lib';

####    object tester    ####
unless (caller)
{
    use BoxDataM;

#    my $host = "$ENV{'ABGENE_HOST'}"; #"ABgene38";
    my $ABData = BoxDataM->new( );
    $ABData->init($ABgenehost);

    my $host_ret = $ABData->BcReader()->{host};
    print "ABgene host name: $host_ret \n";

    $ABData -> read2DBox( ); #$host

    print $ABData -> BoxId;
    print "\n";

    my $t;
    foreach $t ( @{$ABData -> BoxContent()} )
    {
	print "@{$t}\n";
    }
    print "\n";
}


###################################
#                                 #
#        Object definition        #
#                                 #
###################################

struct BoxDataM =>
{
    BcReader => '$',
    BoxId => '$',
    BoxContent => '$', # ref to 2d array
    ForUpdate => '$',
    VLeader => '$',
    UserInfo => '$',
    QueryHandlr => '$',
}; 


####    public methods    #### 
sub init 
{
    my $self = shift; 
    my $host;

    if( @_ )
    {
	$host = shift;  # scalar - string
    }
    else
    {
	$host = $ABgenehost;
    }

    eval
    {
	$self -> BcReader( Cypher::new( host => $ABgenehost ) );
    };
    if( $@ )
    {
	croak "2D box scanner may be busy: $@\n";
    }

    my $vleader = $self->VLeader();
    if( defined $vleader )
    {
	$self -> UserInfo( $vleader->DataSource()->User() ); 
    }   

    #if( $^W )
    {
	my $user = $self -> UserInfo();
	print "User information: \n";
	print "UserId: ", $user->PersonId(), "\n";
	print "Team:   ", $user->Team(), "\n";
	print "RoleId: ", $user->RoleId(), "\n";
    }

    my $qhdlr = statements->new( "$db" );
#    $qhdlr->default_sql_lib_path( './' );
    $qhdlr->load_sql_lib( [SQLLIB."::all"] );
    $qhdlr->{debug} = 1 if( $^W );
print "sql prepared\n"; 
    $self->QueryHandlr( $qhdlr );

    my $is_new = 0;
    $self->ForUpdate({ isNew => 0,
		       data  => [] });

    #print "isNew: ", ref( $self->ForUpdate()->{isNew} ), "\n";
    #print "data for update: ", ref( $self->ForUpdate()->{data}), "\n";

    return $self;
}


sub read2DBox
{
    my $self = shift;
    
    my $bcReader = $self->BcReader();
    my $rackid;
    my $retval = '';

    $self->resetData();

    print "\n\nScan AB rack ... \n";
#    eval
#    { 
	#$rackid = $self -> BoxId( $bcReader->readRackId() );
    $rackid = $bcReader->readRackId();
#    };
    if( $rackid =~ /No/ )
    {
	#if( $^W )
	{
	    print "Rack on the scanner: $rackid\n";
	}
	
	croak "No barcode label on 2D box or scanner has been switched off.\n";
    }


    # translate rack id
    my $vres = Verifynumber( $rackid );
    if( $vres->{Process} eq 'Good' )
    {	
	print "box label ok. ", $vres->{Number}, "\n";
	$self -> BoxId( $vres->{Number} );  
	$retval = $vres->{Whole};
    }
    else
    {
	croak "Invalid barcode on 2D box.\n";
    }

    # read tubes in box
    my @tubes = split /\r\n/, $bcReader->readTubeIDs();  

    my $tubedata;
    foreach ( @tubes )
    {
	push @$tubedata, [ split /, /, $_ ] ; # split by ',' and a SPACE
    }

    # for debugging
#    foreach my $t (@$tubedata)
#    {
#	if( $t->[1] !~ /No Tube/ )
#	{
#	    print "$t->[1]: ";
#	    my @testc = unpack( "A1" x length($t->[1]),  $t->[1] );
#	    foreach (@testc)
#	    {
#		print ord($_), ' ';
#	    }
#	    print "\n";
#	}
#    }

#    foreach (@$tubedata)
#    {
#	print "@{$_}\n";
#    }

    $self -> BoxContent( $tubedata );
    my $data = $self -> BoxContent();
    print "data before database verification: \n";
    foreach my $line (@$data)
    {
	foreach (@$line)
	{
	    print $_, "\t";
	}
	print "\n";
    }

    $self->verifyBox();

    $data = $self -> BoxContent();
    print "data after database verification: \n";
    foreach my $line (@$data)
    {
	foreach (@$line)
	{
	    print $_, "\t";
	}
	print "\n";
    }
    return $retval
}


sub verifyBox
{
    my $family = shift;
    my $boxdata = $family->BoxContent();
    my $boxid = $family->BoxId();
    my $dbqh = $family->QueryHandlr();
    my $updateData = $family->ForUpdate()->{data};

    print "'$updateData': ", ref($updateData), "\n";
    
    # check if box recorded before
    my $qrslt = $dbqh -> get( SQLLIB.'::exists_box', [$boxid] );
    print "for box $boxid, query box returned: ", scalar @{$qrslt}, "\n";

    my $hastube;
    my ($abid, $row, $col);

    if( !(scalar @{$qrslt}) )
    {
	# new box -
	# go through each box position in scanned data
	print "new box -\n";
	$family->ForUpdate()->{isNew} = 1;

	foreach my $pos ( @{$boxdata} )
	{
	    $abid = $pos->[1];

	    if( $abid =~ /AB/ )
	    {
		($row, $col) = unpack( "A1 A2", $pos->[0] );
		$row = lc( $row );
		$col *= 1;

		$hastube = $dbqh->get( SQLLIB.'::exists_tube', [$abid] );
		if( scalar @{$hastube} )
		{
		    # tube exists in db, good one
		    push @{$pos}, ($hastube->[0]->[0].'_'.$hastube->[0]->[1], '', 'NEW');

		    my $n = scalar @{$pos} - 1;
		    my $comment_ref;
		    $comment_ref->{comment} = \$pos->[ $n-1 ];
		    $comment_ref->{mark} = \$pos->[ $n ];

		    push @{$updateData}, [$abid, $row, $col, $boxid, $comment_ref];
		}
		else # fresh tube, should not be in box
		{
		    push @{$pos}, ( '', 'No record', 'X' );
		}
	    }
	    elsif( $abid =~ /No Read/ )
	    {
		push @{$pos}, ( '', 'Cannot read', 'X' );
	    }
	    else
	    {
		push @{$pos}, ( '', '', '' );
	    }
	}
    }
    else 
    {
	# box already recorded 
	$family->ForUpdate()->{isNew} = 0;

	# go through each box position
	my ($pos_scn, $pos_dbs);
	for( my $i=0; $i<(scalar @{$boxdata}); $i++) #; my $pos ( @{$boxdata} )
	{
	    $pos_scn = $boxdata->[$i];
	    $pos_dbs   = $qrslt->[$i];

	    $abid = $pos_scn->[1];

	    $row = $pos_dbs->[0];
	    $col = $pos_dbs->[1];
	    
	    if( $abid =~/No Read/ )
	    {
		# tube cannot be read -- serious
		push @{$pos_scn}, ('Cannot read', $pos_dbs->[2], 'X' );
	    }
	    elsif( $abid =~/No Tube/ )
	    {
		# empty box position
		if( $pos_dbs->[2] )
		{
		    # tube has been moved
		    #print "tube has been moved\n";
		    push @{$pos_scn}, ('Tube removed', $pos_dbs->[2], 'M' );
		    my $n = scalar @{$pos_scn} - 1;
		    my $comment_ref;
		    $comment_ref->{comment} = \$pos_scn->[ $n-1 ];
		    $comment_ref->{mark} = \$pos_scn->[ $n ];
		    push @{$updateData}, [ '', $row, $col, $boxid, $comment_ref];
		}
		else
		{
		    #print "empty box position\n";
		    push @{$pos_scn}, ('', '', '' );
		}
	    }
	    elsif( $abid =~ /AB/ )
	    {
		$hastube = $dbqh->get( SQLLIB.'::exists_tube', [$abid] );
		if( scalar @{$hastube} )
		{
		    # tube exists in db, good one
		    # put content data for view
		    push @{$pos_scn}, $hastube->[0]->[0].'_'.$hastube->[0]->[1];

		    if( $pos_dbs->[2] )
		    {
			# db record is not null
		    
			if( $pos_dbs->[2] eq $abid )
			{
			    push @{$pos_scn}, 'OK', '';
			}
			else
			{
			    push @{$pos_scn}, $pos_dbs->[2], 'M';
			    my $n = scalar @{$pos_scn} - 1;
			    my $comment_ref;
			    $comment_ref->{comment} = \$pos_scn->[ $n-1 ];
			    $comment_ref->{mark} = \$pos_scn->[ $n ];

			    push @{$updateData}, [ $abid, $row, $col, $boxid, $comment_ref ];
			}
		    }
		    else
		    {
			# db record is null
			push @{$pos_scn}, 'new insert', 'NEW';
			my $n = scalar @{$pos_scn} - 1;
			my $comment_ref;
			$comment_ref->{comment} = \$pos_scn->[ $n-1 ];
			$comment_ref->{mark} = \$pos_scn->[ $n ];
			push @{$updateData}, [ $abid, $row, $col, $boxid, $comment_ref ];
		    }
		}
		else
		{
		    push @{$pos_scn}, ('', 'No record', 'X' );
		}
	    }
	    else
	    {
		# very odd tube read
		# got to break
		croak "What sort of AB tube is this!!";
	    }
	}
	
    }
    # go through all 

    print "isNewBox: ", $family->ForUpdate()->{isNew}, "\n";
    print "--- Data for DB update, ", scalar (@{$family->ForUpdate()->{data}}), " record ---\n";
    foreach my $line (@{$family->ForUpdate()->{data}})
    {
	foreach (@{$line})
	{
	    print $_, "\t";
	}
	print "\n";
    }
    
}


sub recordBoxData
{
    my $self = shift;
    my $dbqh = $self->QueryHandlr();
    my $user = $self->UserInfo();
    my $vleader = $self->VLeader();
#    my $boxdata = $self->BoxContent();
#    my $boxid = $self->BoxId();

    if( $self->ForUpdate()->{isNew} )
    {
	print "This is a new box ...\n";
	eval 
	{
	    print "create_new_box \n";
	    $dbqh->do( SQLLIB.'::create_new_box',
		       [$self->BoxId(), $user->Team()] );

	    print "record_new_box_status\n";
	    $dbqh->do( SQLLIB.'::record_new_box_status',
		       [$user->RoleId()] );
	    
	    print "create_new_box_contents\n";
	    $dbqh->do( SQLLIB.'::create_new_box_contents' );
	};
	if( $@ )
	{
	    # rollback, warn, and continue.	    
	    $dbqh->{DBH}->rollback();
	    warn "$@. CONTACT BUG!!!\n";
	}
#	else
#	{
#	    $dbqh->{DBH}->commit();
#	    print "database update committed.\n";
#	}  
# should not commit yet
  
    } # end of new box

    # do the following to update box contents, box new or not
    my $updateData = $self->ForUpdate()->{data};
    my $fullupdate = 1;

    print "updating box contents, ", scalar @{$updateData}, " records ...\n" ;
        
    foreach my $line ( @{$updateData} )
    {
	eval 
	{
	    $dbqh->do( SQLLIB.'::update_box_contents',
		       [ $line->[0], $line->[1], $line->[2], $line->[3] ] );
	               # what about $line[ 0 .. 3 ] ?
 	};		
	if( $@ )
	{
	    # warn, continue	    
	    #
	    #$vleader->updateWarning( "Failed to update database for $line->[0]$line->[1] $line->[2]",
	    #$@ );
	    warn $@;
	    ${$line->[scalar @{$line} - 1]->{comment}} = 'db update failed';
	    ${$line->[scalar @{$line} - 1]->{mark}} = 'X';
	    $fullupdate = 0;
	}
	else
	{
	    #${$line->[scalar @{$line} - 1]} = 'db update ok';
	    #print "odd one \t", ref($line->[scalar @{$line} - 1]), "\n";
	    print "$line->[0]\t$line->[1]\t$line->[2]\t$line->[3]\t$line->[4]\n";
	    #@{$line->[scalar @{$line} - 1]} = ['db update ok', 'OK'];
	    ${$line->[scalar @{$line} - 1]->{comment}} = 'db update ok';
	    ${$line->[scalar @{$line} - 1]->{mark}} = 'OK';
	}  
    }

    if( $fullupdate )
    {
	$dbqh->{DBH}->commit();

	# reset update data
	$self -> resetData();
	$vleader->updateMessage( "Database successfully updated." );
    }
    else
    {
	$dbqh->{DBH}->rollback();
	$vleader->updateWarning( "Not all data related to this box can be updated. CONTACT BUG !!!" );
    }
}


sub resetData
{
    my $self = shift;

    $self->ForUpdate({ isNew => 0,
		       data  => [] });
    
    return;
}


sub DESTROY
{
    my $self = shift;
    
    my $reader = $self->BcReader();
    if( defined $reader )
    {
	$reader->delete();
	#$self->BcReader(undef());
    }
    
    my $qryh = $self->QueryHandlr();
    if( defined $qryh )
    {
	$qryh->{DBH}->rollback();
	$qryh -> end();
    }
    
    return;
}

1;  # just to keep perl happy
