#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
uploads activity data to ftp server
usage: $0 [-t] [-m <months ago>], -t = test mode (skips file upload)
set DEBUG_ON env param to see debug output (eg hts_myeloid logic)
--------------------------------------------------------------------------------
=cut

use Getopt::Std;
getopts('m:t'); # months, testing
our($opt_m,$opt_t); # warn $opt_m; exit;

use strict;
use warnings;
use feature 'say';

#===============================================================================
my @recipients = qw(douglas raj hmds.secure);
my $duration   = $opt_m || 1; # months ago
#===============================================================================

my $JUST_TESTING = $opt_t || 0; # skips ftp, sets /tmp dir for data file, emails just raj

use lib '/home/raj/perl5/lib/perl5'; # do this before $Bin
use IO::All;
use Data::Dumper;
use Data::Printer;
use IO::Compress::Gzip qw(gzip $GzipError);

use FindBin qw($Bin); # warn $Bin;
use lib "$Bin/../../../lib";
use LIMS::Local::Billing;
use LIMS::Local::ScriptHelpers;

my $cfg_file = "$Bin/../lib/settings.cfg";
my $settings = Config::Auto::parse($cfg_file); # p $settings;

my $tools = LIMS::Local::ScriptHelpers->new();
$tools->test_only($JUST_TESTING);

# get tools from LIMS::Local::ScriptHelpers:
my $sql_lib = $tools->sql_lib();
my $config  = $tools->config();
my $dbix    = $tools->dbix();

# apply_local_rules() & parse_data() moved to LIMS::Local::Billing:
my $llb = LIMS::Local::Billing->new( settings => $settings );

my $date  = $tools->date_subtract(months => $duration);
my $month = $date->month_name;

my $filename = $tools->script_filename;

my $query = $sql_lib->retr('activity_data'); # p $query;

# data NOT required in activity data:
my $skip_orgs = $settings->{skip_organisation_codes}; # p $skip_orgs;
my $skip_samples = $settings->{skip_sample_types}; # p $skip_samples;

# get list of request ids from private hospitals:
my $private_patients = _get_private_patients_map(); # p $private_patients;
$llb->private_patients($private_patients);

# get list of request ids with BMA/BMAT sample:
my $bone_marrow_requests = _get_bone_marrow_requests_map(); # p $bone_marrow_map;
$llb->bone_marrow_requests($bone_marrow_requests);

# local network locations:
my @local_network_locations = _get_local_network_locations(); # p @local_network_locations;
# skipped organisation codes => source name map:
my $organisation_name = _get_skipped_locations(); # p $organisation_name;

my %log = (
	unsourced => [], # initialise to avoid possible undef value error later
	failed    => [],
);

my $result = $dbix->query($query, $duration, $duration); # needs duration twice

ROW:
while (my $vars = $result->hash) { # p $vars; next;
        # next unless grep $vars->{request_number} == $_,
        #    (760, 761, 881, 890, 1299, 1608, 2733, 3361, ); # p $vars;
        # next if $vars->{presentation} eq 'HTS myeloid only';
    my $request_id = $vars->{id}; # p $request_id; # next unless $request_id == 363079;
    my $org_code   = $vars->{organisation_code};
    my $lab_no     = join '/', $vars->{request_number}, ($vars->{year} - 2000);

    # log & skip unknown referral_source:
    if ( grep $org_code eq $_, @$skip_orgs ) {
        my %h = (
            labno  => $lab_no,
            source => $organisation_name->{$org_code},
        );
        $h{trial} = $vars->{trial_name} if $vars->{trial_name};
        push @{ $log{unsourced} }, \%h;
        next ROW;
    }
    # skip sample types:
	next ROW if grep $vars->{sample_code} eq $_, @$skip_samples;

    # log failures (unknown clinicians for non-study requests):
    if ( $vars->{referrer_code} =~ /9999998\Z/ && $vars->{category} ne 'ST' ) {
        next ROW if $log{seen}{$request_id}++; # duplicates if request has >1 specimen
        push @{ $log{failed} }, $lab_no;
        my $location = $vars->{display_name};
        $log{unknown}{$location}++;
    }

    { # get lab-tests:
        my $lab_tests = _get_lab_tests($request_id);
        $vars->{request_lab_tests} = $lab_tests;
    }

    $llb->set_initial_charge_code($vars); # 01, 02, ST, etc

    # to test hts_myeloid requests:
#next ROW unless grep $_ eq 'hts_myeloid', @{ $vars->{request_lab_tests} };

    # apply any local billing rules before upload:
    $llb->apply_local_rules($vars);

    # generate data row:
    my $data = $llb->parse_data($vars);
    $llb->add_row($data);
}

my $cfg = $settings->{activity_data_server};

my $local_filename = sprintf '%s/hmds.dat', $JUST_TESTING
	? '/tmp' # override path for testing
	: $cfg->{path_to_datafile};

my @rows = $llb->get_all_rows; # p @rows;
my $content = join "\n", sort by_lab_number_and_specimen_type @rows;
$content > io($local_filename);

unless ($JUST_TESTING) {
	my %args = (
		local_filename  => $local_filename,
		remote_filename => $cfg->{remote_filename},
		server_addr     => $cfg->{remote_address},
		username        => $cfg->{username},
		password        => $cfg->{password},
	);

    # ftp file (returns str on failure, undef on success):
    my $rtn = $tools->ftp_file(\%args);

    if ($rtn) {
        $tools->mail_admin({ script => $0, msg => $rtn });
        die "$0 - $rtn\n"; # dump to logs
    }
    print "$filename reports data for $month successfully uploaded\n"; # for cron log
    # archive activity data file:
    archive_data_file();
}

my @no_referrer_src = map "$_: $log{unknown}{$_}",
    reverse sort { $log{unknown}{$a} <=> $log{unknown}{$b} }
    keys %{ $log{unknown} };

# calculate some vars for email message:
my $total_requests   = scalar @rows;
my $number_unsourced = scalar @{ $log{unsourced} };
my $number_failed    = scalar @{ $log{failed} };
my $percent_failed   = eval { 100 * $number_failed / $total_requests };
my $no_referrer_reqs = join "\n\t", @{ $log{failed} };
my $no_referrer_src  = join "\n\t", @no_referrer_src;

my $unsourced_labnos = get_unsourced_requests($log{unsourced});

# send emails to recipients:
my $message
    = sprintf qq!Activity data file created successfully (%s entries).\n\n!
    . qq!Unknown/unwanted source: %s\n\t%s\n\n!
    . qq!Unknown referrer: %s (%.2f%%)\n\t%s\n\n!
    . qq!Sources for unknown referrer:\n\t%s!,
        $total_requests,
        $number_unsourced,
        $unsourced_labnos,
        $number_failed,
        $percent_failed || 0,
        $no_referrer_reqs,
        $no_referrer_src; # print $message . "\n"; # exit;

my %mail = (
	config  => $config,
	message => $message,
	subject => 'Activity data for month ' . $month,
); # p %mail; exit;

$tools->send_mail(\%mail, \@recipients);

sub get_unsourced_requests {
    my $data = shift; # arrayref of hashrefs (labno & trial)

    my @d = map {
        sprintf '%s %s [%s]',
            $_->{labno},
            $_->{source},
            $_->{trial} || 'WILL NOT BE BILLED';
    } @$data;
    return join "\n\t", @d;
}

sub archive_data_file {
    my $data_file = $cfg->{path_to_datafile} . '/hmds.dat';
    # make sure it exists:
    if (-e $data_file) {
        my $o = io($data_file);

        my $input  = $o->name; # p $input;
        # compress and archive:
        my $output = sprintf '%s/%s_%02d_hmds.dat.gz',
            $cfg->{path_to_datafile}, $date->year, $date->month;

        my $status = gzip $input => $output, Minimal => 1 # avoids full path info
            or warn "$0 - gzip failed: $GzipError\n";

        $o->unlink; # archived if has data, deleted anyway
    }
}

sub by_lab_number_and_specimen_type { # sort by sample type so diff files easier to compare
    # p $a; p $b;
    my ($labNum_a, $sampleType_a) = (split '\|', $a)[1, 12];
    my ($labNum_b, $sampleType_b) = (split '\|', $b)[1, 12];

    my ($reqNum_a, $yr_a) = $labNum_a =~ m!H(\d+)/(\d{2})!;
    my ($reqNum_b, $yr_b) = $labNum_b =~ m!H(\d+)/(\d{2})!;

    return $yr_a <=> $yr_b
        || $reqNum_a <=> $reqNum_b
        || $sampleType_a cmp $sampleType_b;
}

sub _get_lab_tests {
    my $request_id = shift; # p $request_id;

    my $sql = $sql_lib->retr('activity_request_lab_tests');
    my $ref = $dbix->query($sql, $request_id)->flat; # aref
    return $ref;
}

sub _get_bone_marrow_requests_map {
    my $sql = $sql_lib->retr('activity_bone_marrow_requests');
	my $map = $dbix->query($sql, $duration, $duration)->map;
	return $map;
}

sub _get_private_patients_map {
    my $sql = $sql_lib->retr('activity_private_patients');
	my $map = $dbix->query($sql, $duration, $duration)->map;
	return $map;
}

sub _get_skipped_locations {
    my $map = $dbix->select( 'referral_sources',
        [ 'organisation_code', 'display_name' ],
        { organisation_code => { -in => $skip_orgs } },
    )->map;
    return $map;
}

sub _get_local_network_locations {
    my $lnl = $dbix->select('local_network_locations', 'parent_id')->flat;
    return @$lnl;
}
