#!/usr/bin/perl

use Test::WWW::Mechanize::CGIApp;

use strict;
use warnings;

use DateTime;
use POSIX;

#use Test::More 'no_plan';
use Test::More tests => 115;
use Test::Builder::Tester;

=begin # tests:
1) retrieve patient & submit valid request
2) select same patient & register new unit number for same location
3) new request - duplicate labno
4) new request - invalid specimen
5) new request - missing referrer_code
6) retrieve request history for new record
7) submit new request for unknown GP
8) submit new request for unknown clinician
9) delete record
10) re-create record - test for original request.id
11) check lab-test automatically requested by sample type
12) amend record to doi & register new record without doi - check for warning
=cut

BEGIN {
    require 't/test-lib.pl';
}

my $mech = get_mech();

my $dbh;

eval {
    $dbh = get_dbh() or die 'no database handle recieved from get_dbh';
};

warn $@ if $@;

my $cfg = get_config(); # warn Dumper $cfg->{settings};

foreach( qw/requests request_specimen request_specimen_detail/ ) {
    drop_and_recreate($_);
}

#{
#    $dbh->do( q!ALTER TABLE `request_specimen`
#        ADD CONSTRAINT `request_specimen_ibfk_1` FOREIGN KEY (`request_id`)
#        REFERENCES `requests` (`id`) ON DELETE CASCADE! );
#}

do_login();

$mech->get_ok('/register'); # print_and_exit();

my $last_name = 'green';

$mech->submit_form(
    fields => {
        name => $last_name,
    },
);                                                           # print_and_exit();

$mech->follow_link_ok(
    # {n => 8}, "Logout $_ via eighth link on page",
    { url_regex => qr/select/i, },
    'select patient using link',
);                                                           # print_and_exit();

$mech->follow_link_ok(
    # {n => 8}, "Logout $_ via eighth link on page",
    { url_regex => qr/new/i, },
    'select case using link',
);                                                            # print_and_exit();

$mech->submit_form(
    fields => {
        request_number => 1,
        specimen => 'pb',
        referrer_code => 'G1234567',
    },
);                                                            # print_and_exit();

$mech->content_contains(
    q!New request successful!,
    'OK: new request entered successfully',
);                                                            # print_and_exit();

{
    my $i=0;
    foreach (qw/PB 1111111111 01.Feb.1940 1011 GREEN/, 'Black DE', 'The Surgery, Newtown, NT1 1NT' ) {
        $i++;
        $mech->content_like(
            qr(<input type="text" value="$_"\s+readonly="readonly" />),
            "OK: new request field [$i] detected",
        );
    }
}

# follow 'next' link to add new record:
$mech->follow_link_ok(
    # {n => 8}, "Logout $_ via eighth link on page",
    { url_regex => qr(localhost/register)i, },
    'select "next" using link',
);                             # print_and_exit();

$mech->content_contains(
    q!Search For Patient Details!,
    'OK: new reqest page loaded',
);

# select same patient as previous:
$mech->submit_form(
    fields => {
        name => $last_name,
    },
);                               # print_and_exit();

$mech->follow_link_ok(
    # {n => 8}, "Logout $_ via eighth link on page",
    { url_regex => qr/select/i, },
    'select patient using link',
);                                # print_and_exit();

# register new location / unit number:
$mech->submit_form(
    fields => {
        unit_number => 123456,
        referral_source_id => 1,
    },
);                         # print $fh $mech->content; exit;

{
    my $i=0;
    foreach (qw/1111111111 01.Feb.1940 GREEN 123456/ ) {
        $i++;
        $mech->content_contains(
            qq!<td>$_</td>!,
            "OK: submitted field [$i] detected",
        );
    }                           # print_and_exit();
}

SKIP: {
    skip('only applicable if autoincrement_requests off',2)
        if $cfg->{settings}->{autoincrement_requests};

    # submit duplicate labno:
    $mech->submit_form(
        fields => {
            request_number => 1,
            specimen => 'PB',
        },
    );                          # print_and_exit();

    has_dfv_errors();
    has_duplicate();
};

# correct duplicate labno, but submit invalid specimen:
$mech->submit_form(
    fields => {
        request_number => 2,
        specimen => 'BMTA',
    },
);                                                           #  print_and_exit();

has_dfv_errors();
has_invalid();
has_missing();

# correct invalid specimen & missing referrer_code:
$mech->submit_form(
    fields => {
        request_number => 2,
        specimen => 'PB',
        referrer_code => 'C1234567',
        external_reference => 'AB/1234',
        error_code_id => 1,
        _referrer => 'Brown, CC', # ajax function in form
    },
);                                           # print_and_exit();

{
    my $i=0;
    my @fields = ( qw/PB 1111111111 01.Feb.1940 GREEN 123456 AB\/1234/,
        'Newtown General Infirmary', 'Brown, CC' );

    foreach ( @fields ) {
        $i++;
        $mech->content_like(
            qr(<input type="text" value="$_"\s+readonly="readonly" />),
            "OK: new request field [$i] detected",
        );
    }
}                           # print_and_exit();

# test history:
$mech->get_ok('/search');  # print_and_exit();

$mech->submit_form(
    fields => {
        lab_number => 2,
    },
);                                                            # print_and_exit();

$mech->content_contains(
    'Record not screened',
    'OK: record loaded & not screened',
);

$mech->follow_link_ok(
    # {n => 8}, "Logout $_ via eighth link on page",
    { url_regex => qr(history)i, },
    'select "history" link',
);                                                          # print_and_exit();

$mech->content_contains(
    'Request history',
    'OK: request history page loaded',
);

$mech->has_tag(
    td => 'registered',
    'OK: registration history action detected',
);

$mech->has_tag(
    td => 'recorded error code A',
    'OK: error code history action detected',
);

# access new request for case_number.id = 1 direct:
$mech->get_ok('/request/add_new/1');     # print_and_exit();

$mech->content_contains(
    '&raquo; Request &raquo; New',
    'OK: new request page loaded',
);

$mech->content_contains(
    'The Surgery, Newtown',
    'OK: expected patient_case data loaded',
);

# select unknown GP:
$mech->submit_form(
    fields => {
        request_number => 3,
        specimen => 'PB',
        referrer_code => 'G9999998',
    },
);                         # print_and_exit();

$mech->content_contains(
    q!value="Unknown"!,
    'OK: value "unknown" detected',
);

# access new request for case_number.id = 3 direct:
$mech->get_ok('/request/add_new/3');   # print_and_exit();

$mech->content_contains(
    '&raquo; Request &raquo; New',
    'OK: new request page loaded',
);

$mech->content_contains(
    'Newtown General Infirmary',
    'OK: expected patient_case data loaded',
);

# select unknown clinician:
$mech->submit_form(
    fields => {
        request_number => 4,
        specimen => 'PB',
        referrer_code => 'C9999998',
    },
);                          # print_and_exit();

# can't verify unknown clinician from request summary, so do search on request no:
$mech->get_ok('/search'); # print_and_exit();
{
    $mech->submit_form(
        fields => {
            lab_number => 4,
        },
    );                           # print_and_exit();

    my $yr = DateTime->now->strftime('%y');

    $mech->has_tag(
        td => 'Newtown General Infirmary',
        'OK: expected content returned',
    );
    $mech->has_tag(
        span => 'Unknown',
        'OK: expected content returned',
    );

    $mech->content_like(
        qr(\w4/$yr), # department prefix = \w
        'OK: expected request number returned',
    );
}

# delete record:
$mech->get_ok('/search/do_search?lab_number=3'); 		      # print_and_exit();
{
    # need to setup FK's this test:
    my $dbh  = get_dbh();
    my $dbix = get_dbix();

    my @non_cascade_tables = qw(history phone_log lab_test_history);

    my @cascade_tables = qw(audit consent diagnosis_history error_code external_ref
        initial_screen lab_test_results lab_test_status option report_detail
        result_summaries specimen trial);

    foreach(@cascade_tables) {
        my $table = 'request_' . $_;
        my $fk    = $table . '_ibfk_1';

        $dbh->do( qq!ALTER TABLE `$table` ADD CONSTRAINT `$fk` FOREIGN KEY (`request_id`)
            REFERENCES `requests` (`id`) ON DELETE CASCADE! );
    }

    { # add some data to tables with fk to request.id:
        $dbix->insert('request_audit', { request_id => 3, audit_request_option_id => 1});
        $dbix->insert('request_consent', { request_id => 3, consent_id => 1, status => 'yes'});
        $dbix->insert('request_error_code', { request_id => 3, error_code_id => 1});
        $dbix->insert('request_external_ref', { request_id => 3, external_reference => 'AB12'});
        $dbix->insert('request_initial_screen', { request_id => 3, screen_id => 1});
        $dbix->insert('request_lab_test_results', { request_id => 3, lab_test_id => 1, result => 'foo'});
        $dbix->insert('request_lab_test_status', { request_id => 3, lab_test_id => 2, status_option_id => 1});
        $dbix->insert('request_option', { request_id => 3, option_id => 1});
        $dbix->insert('request_report_detail', { request_id => 3, comment => 'foo',
            clinical_details => 'foo', diagnosis_id => 1});
        $dbix->insert('request_diagnosis_history', { request_id => 3, diagnosis_id => 2, option_id => 1, user_id => 1});
        $dbix->insert('request_lab_test_history', { request_id => 3, action => 'foo', user_id => 1});
        $dbix->insert('request_trial', { request_id => 3, trial_id => 1});
        $dbix->insert('request_phone_log', { request_id => 3, user_id => 1, contact => 'foo',
            status => 'inbound', details => 'foo'});
        $dbix->insert('request_result_summaries', { request_id => 3, lab_section_id => 1,
            results_summary => 'foo'});
    }

    # check data exists:
    foreach ( sort (@cascade_tables, @non_cascade_tables) ) {
        my $tbl = 'request_' . $_;
        is( $dbix->query(qq!select 1 from `$tbl` where `request_id` = ?!, 3)->list,
            1, "OK: $tbl contains expected request data" );
    }

    $mech->has_tag_like(
        td => qr(GREEN, Alan),
        'OK: expected record found',
    );

    # test for absence of re-registered record patient (below):
    test_out( 'not ok 1 - foo' );
    test_fail( +1 );
    $mech->has_tag_like( td => qr(BROWN, Stan), 'foo' );
    test_test( 'OK: expected record found' );
    # test for absence of re-registered record specimen type:
    test_out( 'not ok 1 - foo' );
    test_fail( +1 );
    $mech->has_tag( td => 'LU', 'foo' );
    test_test( 'OK: expected record found' );

    $mech->follow_link_ok(
        # {n => 8}, "Logout $_ via eighth link on page",
        { url_regex => qr(request/delete_request), },
        'follow delete link',
    );                              					      # print_and_exit();

	my %delete = (
		reason => 'inappropriate request',
		confirm_delete => 1,
	);

	$mech->submit_form(fields => \%delete);                   # print_and_exit();
    lacks_dfv_errors();										  #	print_and_exit();

    $mech->has_tag(
        p => 'INFO: record deleted',
        'OK: delete success message detected'
    );

    # repeat search for lab_number:
    $mech->get_ok('/search/do_search?lab_number=3'); 		  # print_and_exit();

    $mech->has_tag(
        p => get_messages('search')->{no_records_found},
        'OK: failed to find deleted record',
    );                                                        # print_and_exit();

    # check table status & remove FK's:
    # data should be deleted from these (coz ON DELETE CASCADE set):
    foreach my $t(sort @cascade_tables) {
        my $tbl = 'request_' . $t;
        my $fk    = $tbl . '_ibfk_1';

        isnt( $dbix->query(qq!select 1 from `$tbl` where `request_id` = ?!, 3)->list,
            1, "OK: expected request data deleted from $tbl" );

        $dbh->do( qq!ALTER TABLE `$tbl` DROP FOREIGN KEY `$fk`! );
    }
    # data should still be in these:
    foreach my $t(sort @non_cascade_tables) {
        my $tbl = 'request_' . $t;

        is( $dbix->query(qq!select 1 from `$tbl` where `request_id` = ?!, 3)->list,
            1, "OK: $tbl still contains expected request data" );
    }
} # print_and_exit();

# re-register deleted record:
$mech->get_ok('/patient/select_patient/2');                    # print_and_exit();
{
    $mech->has_tag(
        td => 'BROWN',
        'OK: expected record found',
    );

    $mech->follow_link_ok(
        # {n => 8}, "Logout $_ via eighth link on page",
        { url_regex => qr(request/add_new/2), },
        'follow delete link',
    );                              					      # print_and_exit();

    $mech->has_tag(
        td => 'BROWN',
        'OK: expected record found',
    );

    my $yesterday = DateTime->now->subtract(days => 1);

    $mech->submit_form(
        fields => {
            request_number => 3,
            specimen => 'BMAT',
            referrer_code => 'G1234567',
            _referrer => 'Black, DE', # ajax function in form
            # add specimen taken date:
            year   => $yesterday->year,
            month  => 13, # invalid
            day    => ( sprintf '%02d', $yesterday->day    ),
            minute => ( sprintf '%02d', $yesterday->minute ),
            hour   => ( sprintf '%02d', $yesterday->hour   ),
        },
    );                                                        # print_and_exit();

    $mech->content_contains(
        dfv_format('invalid_datetime'),
        'OK: invalid date detected',
    );

    $mech->field( month => sprintf '%02d', $yesterday->month );
    $mech->submit;                                            # print_and_exit();

    { # check specimen taken date:
        my $taken = $yesterday->strftime('%d.%m.%Y @ %H:%M');
        $mech->content_like(
            qr(<input type="text" value="$taken"\s+readonly="readonly" />),
            'OK: specimen taken date found',
        );                                                   # print_and_exit();
    }

    # auto-incrementing requests prevents re-use of deleted request_no:
    my $lab_number = $cfg->{settings}->{autoincrement_requests} ? 5 : 3;

    $mech->get_ok('/search/do_search?lab_number='.$lab_number); # print_and_exit();

    $mech->has_tag_like(
        td => qr(BROWN, Stan),
        'OK: expected record found',
    );

    { # check display of specimen age:
        my $taken = $yesterday->strftime('%a %d.%b.%Y @ %H:%M');
        $mech->content_like(
            qr(taken $taken \[1 days old\]),
            'OK: expected specimen age displayed',
        );                                                     # print_and_exit();
    }

    # test for absence of original name:
    test_out( 'not ok 1 - foo' );
    test_fail( +1 );
    $mech->has_tag_like( td => qr(GREEN, Alan), 'foo' );
    test_test( 'OK: expected record found' );

    # test for new specimen type:
    $mech->has_tag(
        span => 'BMAT',
        'OK: expected specimen type found',
    );                                                       # print_and_exit();

    # check 'AUTO' test been automatically requested by specimen code (BMAT):
    $mech->content_like(
        qr(<span class="test_name">AUTO:</span>\s+<span class="grey">\[pending\]</span>),
        'OK: expected lab test automatically requested',
    );

    # test for absence of original specimen type:
    test_out( 'not ok 1 - foo' );
    test_fail( +1 );
    $mech->has_tag_like( td => qr(PB), 'foo' ); # has_tag_like in case PB not deleted
    test_test( 'OK: expected record found' );

=begin # not reusing original request_id now
    # prove new request.id is same as old request.id:
    my $dbix = get_dbix();
    my $new_request_id
        = $dbix->query('select id from requests where request_number = ?',3)->list;

    is( $new_request_id, 3, 'OK: got expected new request_id' );

    # get history:
    $mech->get_ok('/history/=/3');                             # print_and_exit();

    $mech->has_tag_like(
        td => qr{deleted record H3/\d{2} \(id: 3\) \[reason: inappropriate request\]},
        'OK: expected history output found',
    );
=cut
}

{ # amend record to doi:
    $mech->get_ok('/request/edit_request/1');                  # print_and_exit();
    $mech->submit_form(
        fields => {
            error_code_id => 1,
            doi => 1,
        },
    );                                                        # print_and_exit();

    my $msg = sprintf get_messages('request_edit')->{edit_success}, 1;
    $msg =~ s/([\(\)])/\\$1/g; # need to escape parens or qr fails

    $mech->has_tag_like(
        p => qr(INFO: $msg),
        'OK: edit action succeeded',
    );
    $mech->get_ok('/history/=/1');                             # print_and_exit();
    $mech->content_contains(
        q!new request option 'doi'!,
        'OK: expected history entry found',
    );
}

{ # register new record on previous DOI without DOI:
    $mech->get_ok('/request/add_new/1');                       # print_and_exit();
    $mech->submit_form(
        fields => {
            request_number => 5,
            specimen => 'pb',
            referrer_code => 'G1234567',
        },
    );                                                        # print_and_exit();
    $mech->get_ok('/search/=/6');                             # print_and_exit();
    $mech->content_contains(
        get_messages('patient')->{biohazard},
        'OK: expected history entry found',
    );
}

do_logout();
