#!/usr/bin/perl

use Time::HiRes qw(gettimeofday tv_interval);
use SQL::Abstract::Plugin::InsertMulti;
use IPC::System::Simple qw(system);
use Test::WWW::Mechanize::CGIApp;
use WWW::Mechanize::TreeBuilder;
use Data::Printer;
use Test::More;

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

use lib 't/lib'; # loads t/lib/LIMS/DB/Outreach files in place of lib/LIMS/DB/Outreach

=begin # tests:

=cut

use constant TESTS => 63;

BEGIN { # need to copy LIMS/DB/Outreach files and substitute db name:
    my $t0 = [gettimeofday];
    # make new directory t/lib/LIMS/DB/Outreach:
    system( 'mkdir', '-p', 't/lib/LIMS/DB/Outreach' );
    # copy files from lib/LIMS/DB/Outreach (needs to be all 1 command for shell + wild-card):
    system( 'cp lib/LIMS/DB/Outreach/*.pm t/lib/LIMS/DB/Outreach/' );
    # substitute 'outreach' -> 'outreach_test' for all files in new directory
    # (x27 is hex for apostrophe, otherwise needs ugly escaping; make warnings
    # fatal so that process dies before any tests can run):
    system( q!perl -mwarnings=FATAL,all -pi -e \
        's/(schema\s*=>\s*\x27outreach)/$1_test/' \
        t/lib/LIMS/DB/Outreach/*.pm! );
    # check all files in t/lib/LIMS/DB/Outreach have substitution, or die (0777
    # is impossible hex char so line-sep changes to undef so whole file is read):
    system(q!perl -0777 -ne '/outreach_test/ or die' t/lib/LIMS/DB/Outreach/*.pm!);
    say sprintf 'copied Outreach DB: %.2f sec', tv_interval $t0, [gettimeofday];
    require 't/test-lib.pl';
    say sprintf 'finished: %.2f sec', tv_interval $t0, [gettimeofday];
}

my $dbix = get_dbix();
my $mech = get_mech();
WWW::Mechanize::TreeBuilder->meta->apply($mech);

# need to see if 'require_spell_check' is required:
my $spell_check_required = is_spell_check_required(); # warn $spell_check_required;

$dbix->dbh->do( qq!TRUNCATE TABLE outreach_test.$_! ) for qw(
    request_followup
    request_pack_dispatch
);

{ # new db entries:
    # new specimen:
    $dbix->insert('specimens',
        { sample_code => 'CMP', description => 'Outreach' });
    # new screen category:
    $dbix->insert('screen_category', { name => 'outreach', is_active => 'yes'});
    my $category_id = get_last_insert_id('screen_category');
    # new screen:
    $dbix->insert('screens',
        { description => 'Outreach', category_id => $category_id, active => 'yes' });
    # new test:
    $dbix->insert('lab_tests',
        { test_name => 'outreach', field_label => 'Outreach', test_type=> 'panel',
        lab_section_id => 1, has_results => 'no' });
    # new screen_lab_test:
    my $screen_id = get_last_insert_id('screens');
    my $test_id   = get_last_insert_id('lab_tests');
    $dbix->insert('screen_lab_test',
        { screen_id => $screen_id, lab_test_id => $test_id });
    # patient demographics:
    $dbix->insert('patient_demographics', { patient_id => 2, # patient for req #3
        address => '1 The Drive', post_code => 'AB1 2CD', gp_id => 2,
        practice_id => 2, status => 'alive' });
    # check test data exists, or create it:
    my $tbl = 'outreach_test.followup_options';
    unless ( $dbix->select( $tbl, 'COUNT(*)')->list ) {
        my @data = (
            [ 'zero_month',         'immediately',      1 ],
            [ 'one_month',          'one month',        2 ],
            [ 'six_week',           'six weeks',        3 ],
            [ 'twenty_four_month',  'two years',        4 ],
            [ 'clinic_return',      'return to clinic', 5 ],
            [ 'other',              'other',            6 ],
        );
        my @cols = qw( `option` label position ); # option is mysql keyword
        my ($stmt, @bind) = SQL::Abstract->new
            ->insert_multi( $tbl, \@cols, \@data ); # p $stmt; p @bind;
        $dbix->query($stmt, @bind);
    }
}

do_login();

my $today = DateTime->today;

# check future pack dispatches worklist (should be none:
$mech->get_ok('/local_worklist?function_name=outreach_packs_future');
$mech->has_tag(
    p => 'No Outreach pack dispatches due in future',
    'OK: no future pack dispatches'
);                                                           # print_and_exit();

$mech->get_ok('/request/add_new/2');                         # print_and_exit();
$mech->submit_form(
    fields => {
        request_number => 3,
        specimen => 'pb,cmp',
        referrer_code => 'C1234567',
    },
);                                                            # print_and_exit();
$mech->content_contains(
    q!New request successful!,
    'OK: new request entered successfully',
);

$mech->get_ok('/search/=/3');                                # print_and_exit();
$mech->text_contains(
    q!Screened as Outreach!,
    'OK: screened as expected',
);                                                          # print_and_exit();

$mech->follow_link_ok(
    # {n => 8}, "Logout $_ via eighth link on page",
    { url_regex => qr(outreach)i, },
    'select "outreach" link',
);                                                           # print_and_exit();
$mech->text_contains(
    q!Report table!,
    'OK: report page loaded',
);
$mech->form_name('reportForm');

is( $mech->value('clinical_details'), 'Outreach monitoring',
   'OK: request details loaded');
# minimal fields required:
my %fields = ( # changed for Deb9, needs to submit_form as (fields => \%fields)
    followup_option_id => 3, # six weeks
    specimen_quality   => 'adequate',
    diagnosis_id       => 2,
    authorise          => 1,
);
$mech->submit_form(fields => \%fields);                     #  print_and_exit();
$mech->form_name('reportForm');
 # changed for Deb9, needs to re-submit form with args:
$mech->submit_form(fields => \%fields) if $spell_check_required;
{
    my $msg = get_messages('action')->{edit_success};
    $mech->has_tag_like(
        p => qr($msg),
        'OK: record updated successfully',
    );                                                       # print_and_exit();
}
$mech->get_ok('/report/outreach/3');                         # print_and_exit();
$mech->form_name('reportForm');
is( $mech->value('followup_option_id', 1), 3, 'OK: expected followup option');
{ # expected pack dispatch due date:
    my $date = $today->clone->add(weeks => 6)->subtract(days => 14); # p $date;
    is( $mech->look_down(id => 'pack_due')->attr('value'),
        $date->strftime('%d.%b.%Y'),
        'OK: expected pack dispatch due date'
    );                                                       # print_and_exit();
}

# check future pack dispatches worklist (has request):
$mech->get_ok('/local_worklist?function_name=outreach_packs_future');
$mech->has_tag(
    h3 => 'Outreach pack dispatches due in future',
    'OK: worklist loaded'
);
$mech->has_tag(
    td => 2222222222,
    'OK: patient listed in future pack dispatches worklist'
);                                                           # print_and_exit();

# edit followup option (requires edit_outreach_data permission):
$mech->get_ok('/outreach/edit_followup/3');                  # print_and_exit();
$mech->content_contains('Permission Denied', 'OK: expected permission denied');
{  # new user permission:
    $dbix->insert('user_functions',
        { function_name => 'edit_outreach_data', active => 'yes',
          function_detail => 'edit_outreach_data' });
    my $user_function_id = get_last_insert_id('user_functions');
    $dbix->insert('user_group_function',
        { group_id => 1, function_id => $user_function_id });
}
# logout and back in again for permission change:
do_logout();
do_login();
$mech->get_ok('/outreach/edit_followup/3');                  # print_and_exit();
$mech->content_contains('Edit Outreach follow-up', 'OK: function now allowed');
$mech->form_name('followup');
$mech->field(followup_option_id => 4); # two years
$mech->submit;                                               # print_and_exit();
{ # expected pack dispatch due date:
    my $date = $today->clone->add(years => 2)->subtract(days => 14); # p $date;
    is( $mech->look_down(id => 'pack_due')->attr('value'),
        $date->strftime('%d.%b.%Y'),
        'OK: expected new pack dispatch due date'
    );                                                       # print_and_exit();
}
# history:
$mech->get_ok('/history/=/3');                               # print_and_exit();
$mech->text_contains('from six weeks to two years', 'OK: history log');
# check 'clinic returns' worklist:
$mech->get_ok('/local_worklist?function_name=outreach_clinic_returns');
$mech->has_tag(
    h3 => 'Outreach clinic returns without appointment dates',
    'OK: worklist loaded'
);
$mech->has_tag(
    p => 'None',
    'OK: patient not listed in clinic returns worklist'
);                                                           # print_and_exit();

# return to clinic:
$mech->get_ok('/outreach/edit_followup/3');                  # print_and_exit();
$mech->form_name('followup');
$mech->field(followup_option_id => 5); # return to clinic
$mech->submit;                                               # print_and_exit();
is( $mech->look_down(id => 'pack_due')->attr('value'), '01.Jan.1999',
    'OK: default date for no pack dispatch'
);
# history:
$mech->get_ok('/history/=/3');                               # print_and_exit();
$mech->text_contains('from two years to return to clinic', 'OK: history log');
# check 'clinic returns' worklist (has request):
$mech->get_ok('/local_worklist?function_name=outreach_clinic_returns');
$mech->has_tag(
    h3 => 'Outreach clinic returns without appointment dates',
    'OK: worklist loaded'
);
$mech->has_tag(
    td => 2222222222,
    'OK: patient listed in clinic returns worklist'
);                                                           # print_and_exit();

# followup option = other:
$mech->get_ok('/outreach/edit_followup/3');                  # print_and_exit();
$mech->form_name('followup');
$mech->field(followup_option_id => 6); # other
$mech->submit;                                               # print_and_exit();
is( $mech->look_down(id => 'pack_due')->attr('value'), '01.Jan.1999',
    'OK: default date for no pack dispatch'
);                                                           # print_and_exit();
# history:
$mech->get_ok('/history/=/3');                               # print_and_exit();
$mech->text_contains('from return to clinic to other', 'OK: history log');

# check 'pack dispatch' worklist (request should not be listed):
$mech->get_ok('/local_worklist?function_name=outreach_pack_dispatch');
$mech->has_tag(
    p => 'No Outreach pack dispatches due',
    'OK: patient not listed in pack dispatches worklist'
);                                                           # print_and_exit();

# return immediately:
$mech->get_ok('/outreach/edit_followup/3');                  # print_and_exit();
$mech->form_name('followup');
$mech->field(followup_option_id => 1); # immediately
$mech->submit;                                               # print_and_exit();
{ # expected pack dispatch due date:
    my $date = $today->clone->subtract(days => 14); # p $date;
    is( $mech->look_down(id => 'pack_due')->attr('value'),
        $date->strftime('%d.%b.%Y'),
        'OK: expected new pack dispatch due date'
    );                                                       # print_and_exit();
}
# history:
$mech->get_ok('/history/=/3');                               # print_and_exit();
$mech->text_contains('from other to immediately', 'OK: history log');
# check 'pack dispatch' worklist (has request):
$mech->get_ok('/local_worklist?function_name=outreach_pack_dispatch');
$mech->has_tag(
    h3 => 'Outreach pack dispatches',
    'OK: worklist loaded'
);
$mech->has_tag(
    td => 2222222222,
    'OK: patient listed in pack dispatches worklist'
);                                                           # print_and_exit();
# record pack dispatch:
$mech->tick('request_id', 3);
$mech->submit_form();                                        # print_and_exit();

# check history:
$mech->get_ok('/history/=/3');                               # print_and_exit();
$mech->text_contains('dispatched CMP pack', 'OK: history log');

# check report for pack sent & return due dates:
$mech->get_ok('/report/outreach/3');                         # print_and_exit();
{ # pack sent date (today):
    is( $mech->look_down(id => 'pack_sent')->attr('value'),
        $today->strftime('%a %d.%b.%Y'),
        'OK: expected pack dispatch date'
    );                                                       # print_and_exit();
}
{ # expected return due date (40 days after dispatch):
    my $date = $today->clone->add(days => 40); # p $date;
    is( $mech->look_down(id => 'return_due')->attr('value'),
        $date->strftime('%a %d.%b.%Y'),
        'OK: expected pack return date'
    );                                                       # print_and_exit();
}
# check 'pack dispatch' worklist again (request should not be listed):
$mech->get_ok('/local_worklist?function_name=outreach_pack_dispatch');
$mech->has_tag(
    p => 'No Outreach pack dispatches due',
    'OK: patient not listed in pack dispatches worklist'
);                                                           # print_and_exit();

done_testing(TESTS);