#!/usr/bin/env perl

=begin -------------------------------------------------------------------------
NGIS data extraction to csv
usage: perl $0 [-tq]
* --query|q = output query to stdout
* --test|t = saves file locally, doesn't email
* --database|d = database
* --reqId 10 --reqId 100 --reqId 10000, etc

query for WGS where sample extracted in Genetics lab & processed at Illumina
    - will need adapting if/when arrangement extended to non-WGS samples
test name = wgs_referral (WGS Germline and Tumour), test_id depends on
    phenotype (AML/ALL/plasmacytoid, etc) from flow results summary or WGS
    'original diagnosis' test result

********************************************************************************
must have either a flow cytometry result summary (diagnostic/primary sample), or
'Original diagnosis (WGS)' result (Germline sample) available on the same day as
WGS Germline and Tumour test requested, or request is skipped
********************************************************************************

TODO: frequency of cron - assumed hourly
TODO: datetime_processing_complete is doing db query for dna extraction date in
    NGIS::get_processing_date - what result does csv file expect ?
=cut
#-------------------------------------------------------------------------------

# email addresses to send csv file:
my @recipients = qw(
    leedsth-tr.genomicspecimenreception@nhs.net
    leedsth-tr.dna@nhs.net
);
my $query_output = 0;  # --query|q - output sql queries to console
my $testing      = 0;  # --testing|t - saves file locally, doesn't email
my $database     = 'hilis4'; # --database|d to override
my @REQUEST_IDS  = (); # --request_id 1 --request_id 2, etc

my $log_action = 'dispatched WGS datafile'; # for request_history log

my @TEST_NAMES   = qw( wgs_referral ); # tests to trigger data transfer
my @null_fields  = qw(); # force fields to null if required (temporary measure)

use Getopt::Long;
GetOptions (
    "database|d=s" => \$database,       # str
    "testing|t"    => \$testing,        # flag
    "query|q"      => \$query_output,   # flag
    "reqId=i"      => \@REQUEST_IDS,    # int list (optional)
);

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

my $JUST_TESTING = $testing || 0;

use lib '/home/raj/perl5/lib/perl5';
use FindBin qw($Bin); # warn $Bin;

use IO::All;
use Text::CSV;
use File::Temp;
use Data::Printer;
use SQL::Abstract::More;

use lib $Bin . '/../../../lib';
use LIMS::Local::ScriptHelpers;
use LIMS::Local::NGIS;

use lib '/home/raj/perl-lib';
use Local::DB;

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

my $config = $tools->config();
my $today  = $tools->time_now;
my $dbix   = Local::DB->dbix({ dbname => $database }); # p $dbix;
$dbix->lc_columns = 0; # preserve mixed case on col names (now standardised)

# get NGIS object:
my $ngis = do {
    my %args = (
        dbix => $dbix, query_output => $query_output, test_mode => $JUST_TESTING
    );
    LIMS::Local::NGIS->new(%args);
}; # p $ngis;
$Local::DBIx::Simple::Result::NO_AUTO_DATE_INFLATION = 0; # force iso8601 datetime

#-------------------------------------------------------------------------------
my $filename = sprintf 'YNEGLH_HMDS_%s_dispatch.csv',
    $today->strftime('%Y%m%d_%H%M%S'); # warn $filename;

$ngis->set_t0(); # start timer for data processing

# need to supply our own injection_guard to override built-in sql injection
# attack prevention which detects ';' in GROUP_CONCAT, but we don't need one
# here as we have no user input:
my $sqla = SQL::Abstract::More->new( injection_guard => qr/^$/ );

my $query = do { # _get_main_query returns false if no request_id's to process
    my ($sql, @bind) = _get_main_query(\@REQUEST_IDS); # p $sql; p @bind;
    exit unless $sql;
    $dbix->query( $sql, @bind );
};
# get cols from query, except 'private' ones used for evaluations (eg _datetime_screened):
my @headers = grep $_ !~ /^_/, $query->columns; # p @headers;

# retrieve data from query:
my $data = $query->hashes; $ngis->runtimer('query runtime'); # p $data;

my $content; # container for csv output (live mode; bypassed in test mode)

# pre-process data to reconstitute (some) molecular panels and split (some)
# FISH panels, stores data inside $ngis object:
$ngis->preprocess_data($data);
# store col_headers & null_fields in ngis object for use in process_data():
$ngis->col_headers(\@headers);
$ngis->null_fields(\@null_fields);

# type of filehandle depends on live or test-mode:
my $fh = _get_filehandle();

my $csv = Text::CSV->new ({ binary => 1, auto_diag => 1, eol => $/ });
$csv->print($fh, \@headers);

# retrieve pre-processed data from $ngis:
my @ngis_data = @{$ngis->data}; # p @ngis_data; # AoH
for my $ref (@ngis_data) { # p $ref;
    my $row = process_data($ref); # p $row; # arrayref
    $csv->print($fh, $row);
}
# need to close $fh before $content becomes available (or it truncates at 1024
# chars; not necessary for test_mode because file persists after end of script):
close $fh or die $!;
$ngis->runtimer('completed data processing');

if ($JUST_TESTING) {
    say 'data saved to ' . $fh->filename; # $fh = File::Temp object
}
else { # transfer file by email:
    my %mail = (
        attachment => $content, # populated via $fh in live mode
        filename   => $filename,
        subject    => $filename,
        config     => $config,
    ); # p %mail;  exit;
    $tools->send_mail(\%mail, \@recipients);
    { # have to assume email success, log action to stop subsequent dispatches:
        my $service_user = $tools->get_server_user_details();
        for my $req (@ngis_data) { # p $req;
            my %h = (
                request_id => $req->{internal_request_id},
                user_id    => $service_user->{id},
                action     => $log_action,
            ); # p %h;
            $dbix->insert('request_history', \%h);
        }
    }
}

#===============================================================================
sub process_data {
    my $ref = shift; # p $ref; # href

    # DoB datetime to date:
    if ( my $dob = $ref->{patient_dob} ) {
        $ref->{patient_dob} = $dob->ymd;
    }

    $ref->{expected_sample_number} = 2; # always tumour + germline samples
    $ref->{order_submitted} = 0; # will be submitted elsewhere
    # primary sample; 0 = germline sample, 1 = diagnostic sample:
    # TODO: or could use sample_type_dispatched if opts not shared with diagnostic sample
    $ref->{primary_sample} = $ref->{_specimen_type} =~ /germline/ ? 0 : 1;
    # assume received & dispatched are the same, avoid 2 identical query lookups:
    $ref->{sample_type_received} = $ref->{sample_type_dispatched};
    # NGIS code for WGS (based on flow phenotype - AML/ALL):
    $ref->{test_id} = _get_ngis_code($ref);
    # replicating HMDS lab number as external sample ID:
    $ref->{external_sample_id} = $ref->{local_sample_id};

    $ref->{sample_date_sent} = $today->ymd; # assumes daily procedure

    # determine date lab-test requested (replaced by datetime_order_received):
    # $ref->{datetime_test_requested} = get_test_request_date($ref); # will need to be revived

    my $data = $ngis->finalise_data($ref); # p $data; # adds some new fields, sets others undef
    return $data;
}

#-------------------------------------------------------------------------------
sub _get_ngis_code { # regex on results_summary or original_diagnosis value:
    my $data = shift; # p $data;
    # germline samples use _original_diagnosis, others use _results_summary:
    my $phenotype = $data->{_results_summary} || $data->{_original_diagnosis}; # p $phenotype;
    return undef if ! $phenotype; # query should prevent this but jic

    if ( $phenotype =~ /acute myeloid/ ) {
        return 'M80.1';
    }
    elsif ( $phenotype =~ /acute lymphoblastic/i ) {
        return 'M91.1';
    }
    elsif ( $phenotype =~ /blastic plasmacytoid/i ) {
        return 'M90.1';
    }
    elsif ( $phenotype =~ /myelomonocytic/i ) {
        return 'M88.2';
    }
    elsif ( $phenotype =~ /acute leukaemia/i ) { # other AL
        return 'M89.1';
    }
    else { # TODO: need to improve this - NGIS code is mandatory
        warn "no NGIS code for $data->{local_sample_id}";
        return undef;
    }
}

#-------------------------------------------------------------------------------
sub _get_main_query { # p $_[0]; # optional aref of request_id's
    # get request_id's from command-line, or from _get_requests() query, or
    # return undef (triggers script exit):
    my $request_ids = shift;
    unless (@$request_ids) {
        my ($sql, @bind) = _get_requests(); # p $sql; p @bind;
        $request_ids = $dbix->query( $sql, @bind )->column; # p $request_ids ;
    };
    return undef if ! @$request_ids; # p $request_ids; exit;

    my $cols = _main_query_cols(); # these keep changing
    my @rels = (                                'requests|r'                   ,
        q{r.patient_case_id=pc.id}           => 'patient_case|pc'              ,
        q{pc.patient_id=p.id}                => 'patients|p'                   ,
        q{pc.referral_source_id=rs.id}       => 'referral_sources|rs'          ,
        q{r.referrer_department_id=rd.id}    => 'referrer_department|rd'       ,
        q{rd.hospital_department_code=hd.id} => 'hospital_departments|hd'      ,
        q{rd.referrer_id=ref.id}		     => 'referrers|ref'                ,
        q{ts.request_id=r.id}                => 'request_lab_test_status|ts'   ,
        q{ts.lab_test_id=lt.id}              => 'lab_tests|lt'                 ,
        q{lt.lab_section_id=ls1.id}          => 'lab_sections|ls1'             ,
        q{tr.request_id=r.id}                => 'request_lab_test_results|tr'  ,
        q{tr.lab_test_id=lt2.id}             => 'lab_tests|lt2'                ,
        q{rsp.request_id=r.id}               => 'request_specimen|rsp'         ,
        q{rsp.specimen_id=s.id}              => 'specimens|s'                  ,
      # left joins:
        q{=>rrs.request_id=r.id}             => 'request_result_summaries|rrs' ,
        q{=>rrs.lab_section_id=ls2.id}       => 'lab_sections|ls2'             ,
        q{=>pd.patient_id=p.id}              => 'patient_demographics|pd'      ,
        q{=>rst.request_id=r.id}             => 'request_storage|rst'          ,
        q{=>rst.rack_id=sr.id}               => 'storage_racks|sr'             ,
        q{=>rer.request_id=r.id}             => 'request_external_ref|rer'     ,
        q{=>ro.request_id=r.id}              => 'request_option|ro'            ,
        q{=>ro.option_id=ao.id}              => 'additional_options|ao'        ,
        # will not be available if request not reported when file generated:
        q{=>rrv.request_id=r.id}             => 'request_report_view|rrv'      ,
        q{=>rsd.request_id=r.id}             => 'request_specimen_detail|rsd'  ,
    );

    my %where = (
        'ls1.section_name'  => 'Whole genome sequencing',
        'lt.test_name'      => { -in => \@TEST_NAMES },
        'r.id'              => { -in => $request_ids },
        '-or' => [
            { # section_name = 'Flow cytometry' AND flow results summary exists
                'ls2.section_name' => 'Flow cytometry',
                'rrs.results_summary' => { '!=' => undef },
            },
            { # sample_code = 'WGS' AND original_diagnosis result exists
                's.sample_code' => 'WGS',
                'tr.result'     => => { '!=' => undef },
            },
        ],
    );
    my @args = (
		-columns  => $cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
        -group_by => 'r.id', # for group_concat on specimen
        -order_by => 'r.id',
    #    -limit => 5,
    #    -offset => 350,
    ); # p @args;
    my ($sql, @bind) = $sqla->select(@args); # p $sql; p \@bind;
        $dbix->dump_query($sql, @bind) if $query_output; # exit;
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub _get_requests {
# query is for test_name = wgs_referral & csv not already dispatched
    my $cols = 'DISTINCT(r.id)'; # multiple rh entries (screened, reported, etc)
    my @rels = (                                'requests|r'                   ,
        q{ts.request_id=r.id}                => 'request_lab_test_status|ts'   ,
        q{ts.lab_test_id=lt.id}              => 'lab_tests|lt'                 ,
      # left joins:
        q{=>rh.request_id=r.id}              => 'request_history|rh'           ,
     );

    my %where = (
        'lt.test_name'   => { -in => \@TEST_NAMES },
        #'DATE(ts.time)'  => $today->ymd,
        -or => [
            'rh.action' => undef, # required if no rh entry
            'rh.action' => { -not_rlike => $log_action },
        ],
    );
    my @args = (
		-columns  => $cols,
		-from     => [ -join => @rels ],
		-where    => \%where,
    ); # p @args;
    my ($sql, @bind) = $sqla->select(@args); # p $sql; p \@bind;
        $dbix->dump_query($sql, @bind) if $query_output; # exit;
    return ($sql, @bind);
}

#-------------------------------------------------------------------------------
sub _main_query_cols {
    my $local_lab_name = $ngis->local_lab_name; # p $local_lab_name;

    my @cols = (
        'CONCAT("H", r.request_number, "/",  r.year - 2000)|local_sample_id',
        'NULL|local_sample_id_sub',
        'NULL|local_dna_number',
        'NULL|local_dna_number_sub',
        'p.id|internal_patient_id',
        'r.id|internal_request_id',
        qq!"$local_lab_name"|booking_laboratory!,
        qq!"YNEGLH Leeds Shire"|processing_laboratory!, # for WGS
        qq!"Illumina"|testing_laboratory!,              # for WGS
        'NULL|ped_number',
        'p.first_name|patient_first_name',
        'p.last_name|patient_last_name',
        'p.dob|patient_dob',
        'p.gender|patient_sex',
        'p.nhs_number',
        'pd.address|patient_address',
        'NULL|patient_district_of_residence',
        'NULL|patient_county',
        'NULL|patient_city',
        'pd.post_code|patient_postcode',
        'NULL|patient_country',
        'ref.national_code|referrer_unique_code',
        'NULL|referrer_email',
        'NULL|referrer_telephone',
        'NULL|referrer_title',
        q!SUBSTRING_INDEX(ref.name, ' ', -1)|referrer_first_name!,
        q!LEFT(ref.name, CHAR_LENGTH(ref.name) - LOCATE(' ', REVERSE(ref.name)))
            AS referrer_last_name!,
        'hd.display_name|referrer_specialty',   # required spelling !!
        'rs.display_name|referring_facility_name',
        'NULL|referrer_address',
        'NULL|referrer_city',
        'NULL|referrer_district',
        'NULL|referrer_county',
        'NULL|referrer_postcode',
        'NULL|referrer_country',
        'rs.organisation_code|referring_facility_ods_code',
        'NULLIF( pc.unit_number, "UNKNOWN")|unit_number', # NULL if a = b
        'NULL|other_unit_number',
        'IFNULL(rrv.clinical_details, "DiagnosticTest")|referral_reason', # a or b
        q!"Routine"|test_priority!,
        'NULL|test_id', # NGIS test id, will depend on diagnosis (AML vs ALL)
        'lt.field_label|test_name', # needs to match test directory
        'NULL|ngis_id', # NGIS order number
        'NULL|external_sample_id', # rer.external_reference - using HMDS lab-num now
        'NULL|external_patient_id',
        'NULL|sample_type_received', # set later, same as sample_type_dispatched
        'rsd.specimen_date|datetime_sample_collected',  # datetime
        'r.created_at|datetime_sample_received',        # datetime
        'r.created_at|datetime_order_received',         # datetime
        'NULL|datetime_processing_complete',            # set later
        'rsd.specimen_quality|sample_condition',        # not available at upload
        q!MAX( CASE WHEN ao.option_name = 'doi'
            THEN 'yes' ELSE 'no' END ) AS infection_risk!,
        'NULL|sample_transfer_request_comments',
        q!MAX( CASE WHEN lt2.test_name = 'sample_type' THEN tr.result END )
            AS sample_type_dispatched!,
        # WGS samples are whole (BM or PB) so will never have DNA vol, conc, etc
        'IF( rst.volume, "ul", NULL )|sample_units',
        'rst.volume|sample_amount',
        q!IF( rst.concentration < 9999, rst.concentration, NULL )
            AS dna_concentration!,
        'NULL|sample_date_sent',
        'rst.vialId|sample_tube_id',
        'sr.plateId|sample_rack_id',
        'NULL|sample_courier',
        'NULL|sample_courier_ref',
        'NULL|expected_sample_number',
        'NULL|order_submitted',
        'NULL|primary_sample',

    # fields used for data processing only (underscored for omission in @headers):
        'lt.test_name|_test_name',
        'ls1.section_name|_section_name', # WGS
        'rrs.results_summary|_results_summary',
        # to test for germline sample, superfluous if using sample_type_dispatched:
        'GROUP_CONCAT(DISTINCT(s.description))|_specimen_type',
        q!MAX( CASE WHEN lt2.test_name = 'original_diagnosis' THEN tr.result
            END ) AS _original_diagnosis!,
    );
    return wantarray ? @cols : \@cols;
}

#-------------------------------------------------------------------------------
sub _get_filehandle {
    my $fh;
    if ($JUST_TESTING) { # create a temp file:
        $fh = File::Temp->new(SUFFIX => '.csv'); # create new fh to tmpfile in /tmp dir
        $fh->unlink_on_destroy(0);
    }
    else { # open filehandle to a reference to a variable:
        open $fh, ">:encoding(utf8)", \$content or die $!;
    }
    return $fh;
}