#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
function to email reports to:
1) location options:
* specific hospital department (eg Pinderfields/Haem)
* specific organisation department (eg Leeds/Haem)
* a hospital (all departments)
* an organisation (all departments)

2) request status options:
* new
* all

only using basic DBIx::Simple methods (hashes) so son't need Local::DB

how to deal with reports where a departmental contact exists, and a
hospital/organisation contact (do they also get the dept report?), and also a
CWT contact (usually needs all 'new' reports)

* can manually run script using --re-run flag to dispatch any unsent reports on
    same day: CENTRE=xxxx perl email_reports.pl --re-run >> ~/crons/cron.log 2>&1
--------------------------------------------------------------------------------
=cut

BEGIN {
	use lib '/home/raj/perl5/lib/perl5'; # *must* come before FindBin($Bin)
 	use FindBin qw($Bin); # warn $Bin; exit;
 	use lib ("$Bin/../../../lib", '/home/raj/perl-lib');
 	# override default db test:
 	$ENV{ROSEDB_DEVINIT} = "$Bin/../../../config/rosedb_devinit_prod.pl";
}

my($opt_d,$opt_t,$rerun);
use Getopt::Long;
GetOptions (
    "days|d=s"  => \$opt_d,  # string
    "testing|t" => \$opt_t,  # flag
    "re-run"    => \$rerun,  # flag
); # warn $opt_d; warn $opt_t; warn $rerun; exit;

# emails only 'service_email' addr in config, dumps history data to lims_test db:
my $JUST_TESTING = $opt_t || 0;

my $delta = $opt_d || 1; # warn $delta; # days ago (1 for production)

use IO::All;
use File::Slurp;
use Config::Auto;
use Modern::Perl;
use Data::Printer;
use SQL::Abstract::More;
use DateTime::Format::MySQL;

use LIMS::Local::Reports;
use LIMS::Local::ScriptHelpers;

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

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

my $sql_lib = $tools->sql_lib();
my $config  = $tools->config();
my $today   = $tools->time_now();
my $dbix    = $tools->dbix;
my $sqla    = SQL::Abstract::More->new;

my $date = $tools->date_subtract( days => $delta )->ymd; # warn $date;

# substitutes LIMS methods required by Role::RecordHandler:
my $lims = LIMS::Local::Reports->new({tools => $tools});
# localhost http address - for charts; is_print_request for tt formatting:
$lims->tt_params(
    app_url => 'http://localhost/hilis4',
	is_print_request => 1, # otherwise it loads guest view template by default
);

# load exemptions:
my $skip_reports = $tools->get_yaml_file('skip_email_reports') || {}; # hashref or 0

#===============================================================================
# get all requests authorised/modified yesterday as AoH:
# [request_id, status, referral_source_id, parent_organisation_id & department_id]
my @requests = do {
	my @cols = qw( r.id rr.status rs.id|referral_source_id|ref_src_id
		hd.id|department_code rs.parent_organisation_id|parent_id );
    my @rels = (
        'requests|r'                  => 'ris.request_id=r.id'               ,
        'request_initial_screen|ris'  => 'ris.screen_id=s.id'                ,
        'screens|s'                   => 'r.patient_case_id=pc.id'           ,
        'patient_case|pc'             => 'pc.referral_source_id=rs.id'       ,
        'referral_sources|rs'         => 'r.referrer_department_id=rd.id'    ,
		'referrer_department|rd'	  => 'rd.hospital_department_code=hd.id' ,
		'hospital_departments|hd'     => 'rr.request_id=r.id'				 ,
		'request_report_view|rr'	  => 'r.status_option_id=so.id'			 ,
		'status_options|so'           => '=>rt.request_id=r.id'              ,
		'request_trial|rt'			  => '=>rt.trial_id=ct.id'				 ,
		'clinical_trials|ct'
    );

    my @status = ( 'complete' );
    push @status, $tools->does_authorisation ? 'authorised' : 'reported';

	my %where = (
        'DATE(rr.updated_at)' => $date,
		'so.description'      => { -in => \@status },
	);
	# skip screened_as/presentation:
	if ( my $presentation = $skip_reports->{presentation} ) { # aref
		$where{'s.description'} = { -not_in => $presentation };
	}
	# skip clinical trials:
	if ( my $trials = $skip_reports->{clinical_trial} ) { # aref
		$where{'ct.trial_name'} = # needs an undef or lose all non-ct entries
			[ -or => { -not_in => $trials }, undef ];
	}

    my @args = (
		-columns => \@cols,
		-from    => [ -join => @rels ],
		-where   => \%where,
	);
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	 # $dbix->dump_query($sql, @bind); exit;
    $dbix->query($sql, @bind)->hashes; # AoH
}; # p \@requests;

#===============================================================================
# get list of report email contact details as AoH:
my @contacts = do {
	my @cols = qw(
		ec.display_name
		ec.referral_source_id|source_id
		rs.parent_organisation_id|parent_id
		ec.scope
		ec.department_id
		ec.contact_address
		ec.status
	);
    my @rels = (
        'email_contacts|ec'    =>   'ec.referral_source_id=rs.id',
        'referral_sources|rs'
	);
    my @args = (
		-columns  => \@cols,
		-from     => [ -join => @rels ],
		-where    => { 'ec.type' => 'report', 'ec.is_active' => 'yes' },
	); # p @args;
	my ($sql, @bind) = $sqla->select(@args); # p $sql; # p \@bind;
	  # $dbix->dump_query($sql, @bind); exit;
    $dbix->query($sql, @bind)->hashes; # AoH
}; # p \@contacts;

my %reports; # hash of contact addresses => [ request.ids ]

my @request_cols = qw( id status ref_src_id department_code parent_id );
my @contact_cols
	= qw( scope contact_address parent_id department_id source_id status );

# for each contact address, assign any matching request ids from $requests
# involves looping through each request for each contact (but very fast):
for my $contact (@contacts) {
	my ($scope, $email, $parent_id, $department_id, $location_id, $want_status)
		= @{$contact}{@contact_cols};

	REQ:
	for my $req (@requests) {
		my ($req_id, $req_status, $req_refsrc_id, $req_department_code,
			$req_parent_id)	= @{$req}{@request_cols};

		# first deal with request status (requires new diagnoses or not):
		if ( $want_status eq 'new' ) {
			next REQ unless $req_status eq 'new';
		}
		# next deal with contacts for specific departments:
		if ( $department_id ) { # 823, 824, etc
			next REQ unless $req_department_code == $department_id;
		}
		# contact 'scope' is either hospital or organisation:
		if ( $scope eq 'hospital' ) {
			next REQ unless $req_refsrc_id == $location_id;
		}
		else { # scope = 'organisation'
			next REQ unless $req_parent_id == $parent_id;
		}
        if ($rerun) { # manual command using --re-run flag
            # has report already been sent today?
            my $dispatched = $dbix->select('request_dispatch_log', 1,
                {
                    'DATE(time)' => $today->ymd,
                    request_id   => $req_id,
                    recipient    => $email,
                })->list;
            next REQ if $dispatched;
        }
		# now have required combination of hospital/organisation + optional dept:
			# my $label = join '::', $email, $contact->{display_name}; # for debug use only
			# push @{ $reports{$label} }, $req_id;
		push @{ $reports{$email} }, $req_id;
	}
} # p \%reports; exit;

=begin #========================================================================
# for testing using known requests:
%reports = ( 'hmds.lth@nhs.net' => [
#   307257 # NEQAS request - anonymised patient
#   308979 # PenENRICH trial - unknown referrer
#   309256 # Imatinib chart
    308502 # Outreach
  ]);
#===============================================================================
=cut

# common vars for email message:
my %mail = ( config => $config );

# now get pdf's as in-memory object for each contact - may involve compiling
# some reports more than once but alternative is save to disk and clean up after
while ( my ($email, $ref) = each %reports ) { # aref of request_id's
	REQ:
	for my $req_id (@$ref) {
		my $pdf = $lims->format_report($req_id); # L::C::Roles::RecordHandler
        # $pdf > io("$Bin/$req_id.pdf"); warn 'for test only'; next REQ;
		$mail{attachment} = $pdf;

		# retrieve request data object stashed in Recordhandler::_format_report():
		my $data = $lims->stash->{request_data};

		{ # add subject line:
			my $referrer_department = $data->referrer_department;

			my $subject = sprintf 'HMDS Report for %s / %s',
				$referrer_department->hospital_department->display_name, # speciality
				$referrer_department->referrer->name; # referrer
            # doesn't work properly if unknown clinician - uses referrer_department.id 31116:
            if ( $subject =~ /Unknown clinician/ ) { # "Unknown/Other / Unknown clinician"
                $subject = 'HMDS Report [referrer unknown]'
            }
			$mail{subject} = $subject;
		}
		{ # add filename:
			my $filename = sprintf '%02d_%05d.pdf',
				$data->year - 2000,
				$data->request_number;
			$mail{filename} = $filename;
		} # p \%mail;
        # send report to recipient:
        $mail{recipient} = $email; # p \%mail;
        dispatch_report({ request_id => $req_id, message => \%mail });
	}
}

sub dispatch_report {
    my $args = shift;

    my $request_id = $args->{request_id};
    my $message    = $args->{message};

    # substitute recipient address here if $JUST_TESTING (L::L::Mail doesn't any more):
    if ($JUST_TESTING) {
        my $safe_address = $config->{service_email};
        die "unsafe recipient address $safe_address"
            unless $safe_address =~ /\@nhs.net\Z/;
        $message->{recipient} = $safe_address;
    }

    my $result = LIMS::Model::Email->send_message($message); # Return::Value
    my $centre = $ENV{CENTRE} || 'leeds';

	if ( $result->type eq 'success' ) {
        my $recipient = $message->{recipient};
        my $filename  = $message->{filename};

        my $str = $result->string; # rs = 'message sent'; can't substitute direct on rs, so:
        $str =~ s/message/$filename [$centre]/i; # str = eg '12_01234.pdf [uclh] sent'

        printf "%s %s to %s\n", $tools->script_filename, $str, $recipient;

        my %data = (
            request_id => $request_id,
            recipient  => $recipient,
        );

        # log details in request_dispatch_log & request_history tables:
        unless ($JUST_TESTING) {
            my $rtn = $lims->model('Request')->update_request_dispatch_log(\%data);
            warn "Error in $0: $rtn" if $rtn;
        }
        else { # manual input into lims_test db:
            $dbix->insert('lims_test.request_dispatch_log', \%data);

            my $service_user = $tools->get_server_user_details();
            $data{user_id} = $service_user->{id};

            $data{action} = 'dispatched report to ' . $recipient;
            delete $data{recipient};
            $dbix->insert('lims_test.request_history', \%data);
        }
    }
	else {
		warn $result->string;
        $tools->mail_admin({ script => $0, msg => $result->string });
	}
}