#!/usr/bin/perl

# http://www.perlfect.com/articles/sockets.shtml

BEGIN {
    use FindBin qw($Bin); # warn 'BIN:'.$Bin;
    # set lib paths for app:
    use lib (
		"$Bin/../lib",
        '/home/raj/perl5/lib/perl5',
	);
}

use strict;
use warnings;

use IO::All;
use IO::Socket; 
use IO::Handle;

use LIMS::Local::ScriptHelpers;
use Data::Dumper;

my $tools = LIMS::Local::ScriptHelpers->new();
$tools->use_path("$Bin/..");  # for ScriptHelpers to find correct path to app root

my $cfg = $tools->get_settings; # warn Dumper $cfg; 

=begin # for testing with a datafile
my $src = '/home/raj/scripts/socket_logs/socket.out.2';
my @file = io($src)->chomp->slurp; # warn Dumper @file;
=cut

my $tbl = 'request_haematology';
my $log_file = "$Bin/../logs/lantronix.log";

my @fields = qw(
    pda wbc wbc_f rbc rbc_f hb hb_f hct hct_f mcv mcv_f mch mch_f mchc mchc_f
    plt plt_f lymph_percent lymph_percent_f mixed_percent mixed_percent_f
    neutr_percent neutr_percent_f lymph lymph_f mixed mixed_f neutr neutr_f    
);

my %SQL = (
#    request_id => q!select id from requests where request_number = ? and year = ?!,
    get_status => qq!select status from $tbl where lab_number = ?!,
);
    
# flush after every write
$| = 1;
open my $fh, '>>', $log_file or die $!;
$fh->autoflush(1);

#=begin # open a socket:
my $socket = IO::Socket::INET->new(
	LocalHost 	=> '163.160.171.164', # full IP address to accept external connections
	LocalPort 	=> 9001, 
	Proto 		=> 'tcp', 
	Listen 		=> 1, 
	ReuseAddr	=> 1 
) or die "Could not create socket: $!\n";

our ($r); # output from lantronix box

while ( my $client_socket = $socket->accept ) {
	# my $peer_addr = $client_socket->peerhost();
	# my $peer_port = $client_socket->peerport();
	# print "Accepted new client connection from $peer_addr, $peer_port\n";
    
	READ: # read in 131-char chunks:
	while ( $client_socket->read($r, 131) ) { # warn Dumper $r;
		# print $fh DateTime->now->datetime . "\n$r\n";
		my $data = parse_data($r); # warn Dumper $data; # returns hashref or 0
		if ($data) {
			my $ok = process_data($data); # method returns 1 on success
			next READ if $ok; 
		}
		do_log($r); # no $data or process_data() returns false
	}	
}

close $socket;
#=cut

=begin # for testing with datafile
ROW:
for (@file) {
	my $data = parse_data($_); # warn Dumper $data;
    next ROW unless $data; # returns hashref or 0    
	process_data($data);
}
=cut


sub parse_data {
	my $data = shift; # warn length $data;	
	
    my %h = (); # data hash to return
    
	my ($labno, @params) = $data =~ /
		D1U\d{16}        # year, month, day + sample ID padding (8 zeros)
		([\d-]{8})       # sample ID = 8 char, right-aligned eg 000012_1, 0012_100, 12_10000, etc
		(\w{6})          # PDA info
		\d               # RDW select || reserve
		([\d*]{4})(\d)   # wbc + flag
		([\d*]{4})(\d)   # rbc + flag
		([\d*]{4})(\d)   # hb + flag
		([\d*]{4})(\d)   # hct + flag
		([\d*]{4})(\d)   # mcv + flag
		([\d*]{4})(\d)   # mch + flag
		([\d*]{4})(\d)   # mchc + flag
		([\d*]{4})(\d)   # plt + flag
		([\d*]{4})(\d)   # lymph (%) + flag
		([\d*]{4})(\d)   # mixed (%) + flag
		([\d*]{4})(\d)   # neutr (%) + flag
		([\d*]{4})(\d)   # lymph (#) + flag
		([\d*]{4})(\d)   # mixed (#) + flag
		([\d*]{4})(\d)   # neutr (#) + flag
#		.*{5}            # rdw - don't need
#		.*{5}            # pdw - don't need
#		.*{5}            # mpv - don't need
#		.*{5}            # p-lrc - don't need
	/xo;
	
    return 0 unless $labno && @params;

    # split $labno on '-' (if exists):
    my ($yr, $request_number) = split '-', $labno;
    # check have both, and int $yr = 2-digits (eg 00012):
    return 0 unless $yr && $request_number && length(int $yr) == 2; # warn Dumper [$yr, $request_number];
    
    # create hash of data:
	@h{@fields} = @params; # warn Dumper \%h;
    
    # add lab number (yy_nnnnn format):
    $h{lab_number} = sprintf '%02d_%05d', $yr, $request_number;
	return \%h;
}

sub process_data {
	my $data = shift;
	
	my $lab_number = $data->{lab_number};

	my $dbix = get_dbix(); # get new dbix object
	
    # does request already have result:
    $dbix->query($SQL{get_status}, $lab_number)->into(my $status);
    
    if ($status) { # exists - can only over-write if not already verified:
        return 0 if $status eq 'verified'; # can't overwite here (delete in app)
        $dbix->delete($tbl, { lab_number => $lab_number }); # warn 'OVERWRITE';
    }
    # insert new data:
    $dbix->insert($tbl, $data);
	
	return 1;
}

sub do_log { # log with timestamp:
	my $data = shift;
    
	print $fh $tools->time_now->datetime . "\n$data\n";
    
	# leading char should be '02H' hex char; ord(02H) = 2, so chr(2) should re-encode for use in var:
	my $stx = chr(2); # warn Dumper $stx; - will be undef
    alert_admin($data) if $data !~ /^${stx}D1U/; # indicates possible data stream corruption
}

# return a new dbix object for each dataset - not using ScriptHelpers::get_dbix()
# to avoid cacheing db connection and MySQL timeout after >8hrs idle:
sub get_dbix {
    my $uid = $cfg->{db_user_id};
    my $pwd = $cfg->{db_password};
    my $db  = $cfg->{production_db};

    my $dsn = "dbi:mysql:$db";

    my $dbix = DBIx::Simple->connect($dsn, $uid, $pwd, { RaiseError => 1 });
    
    return $dbix;
}

sub alert_admin {
    my $data = shift;
    
	my $msg = join "\n", 'LANTRONIX POSSIBLE DATA CORRUPTION:', $data;
	$tools->mail_admin({ script => io($0)->filename, msg => $msg });
}

__END__
=begin
Now the socket is ready to receive incoming connections. To wait for a connection,
we use the accept() method which will return a new socket through which we can
communicate with the calling program. Information exchange is achieved by
reading/writing on the new socket. The socket can be treated like a regular
filehandle.
=cut

=begin
while (1) { # permanent
	# waiting for new client connection.
	my $client_socket = $socket->accept();

#	my $peer_address = $client_socket->peerhost();
#	my $peer_port = $client_socket->peerport();
#	print "Accepted New Client Connection From : $peer_address, $peer_port\n";

	# my $data = <$client_socket>;	
	# we can also read from socket through recv() in IO::Socket::INET
	$client_socket->read($data, 1024);
	print $data;
}
=cut