#!/usr/bin/perl

use strict;
use warnings;

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

use IO::All;
use IO::Socket;
use IO::Handle;
use Data::Dumper;
use Daemon::Control;
use LIMS::Local::ScriptHelpers;

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;

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 = (
    get_status => qq!select status from $tbl where lab_number = ?!,
    has_result => qq!SELECT 1 FROM $tbl WHERE lab_number = ? AND status = 'verified'!,
);

# flush after every write
$| = 1;
open my $fh, '>>', $log_file or die $!;
$fh->autoflush(1);

my %args = (
    name         => 'lantronix',
#    lsb_start   => '$syslog $remote_fs',
#    lsb_stop    => '$syslog',
    lsb_sdesc    => 'Lantronix daemon',
    lsb_desc     => 'Controls the lantronix socket',
    path         => "$Bin/lantronix.pl",
    program      => \&open_socket,
    program_args => [ ],
    pid_file     => '/var/run/lantronix/lantronix.pid',
    stderr_file  => '/var/run/lantronix/lantronix.out',
    stdout_file  => '/var/run/lantronix/lantronix.out',
    fork         => 2,
);

Daemon::Control->new(\%args)->run;

sub open_socket {
    # 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;
}

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

=begin # to activate when request_haem table has new primary key
    # return if request already has verified result - will need to delete in app to over-write:
    return 0 if $dbix->query($SQL{has_result}, $lab_number)->list;
    # insert new data (can have multiple entries until verification):
    $dbix->insert($tbl, $data);
	return 1;
=cut

    # does request already have a 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__
# init.d script:
if [ -x /home/raj/apps/HILIS4/script/lantronix.pl ];
then
    /home/raj/apps/HILIS4/script/lantronix.pl $1
else
    echo "Required program /home/raj/apps/HILIS4/script/lantronix.pl not found!"
    exit 1;
fi