#!/usr/bin/perl

use Test::WWW::Mechanize::CGIApp;
use Test::Builder::Tester;

use strict;
use warnings;

use DateTime;
use POSIX;

use Test::More tests => 40;
# use Test::More 'no_plan';

=begin # tests:
=cut

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

my $mech = get_mech();

my $dbh;

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

warn $@ if $@;

foreach( qw// ) {
    drop_and_recreate($_);
}

my $DATE = DateTime->now;

my $dbix = get_dbix();
# switch on section sign-out for all lab sections:
$dbix->update('lab_sections', { has_test_sign_out => 'yes'} );
# remove BMAT from request #1 to allow auto-auth:
$dbix->delete('request_specimen', { request_id => 1, specimen_id => 4 });
# add PB to request #2 to allow flow lab tests:
$dbix->insert('request_specimen', { request_id => 2, specimen_id => 1 });
# add request_external_ref to sample 2:
$dbix->insert('request_external_ref', { request_id => 2,
    external_reference => 'block reference here' });
# delete NHS number to force warning:
$dbix->update('patients', { nhs_number => undef }, { id => 1 });
# create guest user:
create_guest_user({ lname => 'guest', fname => 'a' });

do_login();

# screen request #1 as PNH - can auto-authorise:
$mech->get_ok('/screen/do_initial_screen/1?screen_id=2;option_id=1'); # print_and_exit();

# result request #1:
$mech->get_ok('/result/=/1');                                 # print_and_exit();
{ 
    $mech->form_name('flow_results');
    $mech->field( results_summary => 'flow results summary goes here' );
    $mech->tick('complete_all_tests', 1, 1);
    $mech->submit;                                              
    $mech->has_tag(
        p => 'INFO: results data update successful',
        'OK: results update success message',
    );
}                                                            # print_and_exit();

# report request #1:
$mech->get_ok('/report/=/1');                                #  print_and_exit();
{
    my %report = (
        status  => 'default',
        authorise => 1,
        diagnosis_id => 1,
        specimen_quality => 'adequate',
        comment => 'comment goes here',
        morphology => 'morphology description goes here',
        gross_description => 'gross description goes here',
        secondary_diagnosis_id => 2,
    );
    $mech->form_name('reportForm');
    $mech->submit_form(fields => \%report);
    $mech->submit_form(form_name => 'reportForm');            # print_and_exit();
}

# screen request #2 as AML:
$mech->get_ok('/screen/do_initial_screen/2?screen_id=1;option_id=1'); # print_and_exit();

# result request #1:
$mech->get_ok('/result/=/2');                                 # print_and_exit();
for ( qw/flow molecular/ ) { 
    $mech->form_name($_.'_results');
    $mech->field( results_summary => $_.' results summary goes here' );
    $mech->tick('complete_all_tests', 1, 1);
    $mech->submit;                                              
    $mech->has_tag(
        p => 'INFO: results data update successful',
        "OK: $_ results update success message",
    );
}                                                            # print_and_exit();

# report request #1:
$mech->get_ok('/report/=/2');                                #  print_and_exit();
{
    my %report = (
        status  => 'new',
        diagnosis_id => 2,
        comment => 'comment goes here',
        biopsy_site => 'lymph node',
        specimen_quality => 'adequate',
        gross_description => 'gross description goes here',
    );
    $mech->form_name('reportForm');
    $mech->submit_form(fields => \%report);
    $mech->submit_form(form_name => 'reportForm');            # print_and_exit();
}

# change user id (to guest, but ok for this purpose) so it can be authorised:
$dbix->update('request_history', { user_id => 2 },
    { request_id => 2, action => 'reported' });
# authorise - by-pass pre-auth check:
$mech->get_ok('/report/=/2?pre-authorisation-check=1');        # print_and_exit();
{
    $mech->form_name('reportForm');
    $mech->submit_form(fields => { authorise => 1 });
    $mech->submit_form(form_name => 'reportForm');            # print_and_exit();
}
do_logout();

# login as guest user:
$mech->submit_form(
    fields => { authen_username => 'a.guest', authen_password => 'guessed' },
);                                                           # print_and_exit();                        

# search for reported record #1:
$mech->get_ok('/search/=/1');                                 # print_and_exit();
{ # warn $mech->text; exit;
    my $date_format = $DATE->strftime('%a %d.%b.%Y');
    $mech->text_contains(
        'reported on a peripheral blood specimen',
        'OK: expected specimen details found',
    );                                                       # print_and_exit();
    {
        my $date_format # clone this or it changes original
            = $DATE->clone->subtract(days => 1)->strftime('%a %d.%b.%Y');
        $mech->text_contains(
            'taken ' . $date_format,
            'OK: expected specimen taken details found',
        );                                                    # print_and_exit();
    }
    {
        my $date_format = $DATE->strftime('%a %d.%b.%Y');
        $mech->text_contains(
            'received ' . $date_format,
            'OK: expected registration details found',
        );                                                    # print_and_exit();
    }
    $mech->text_contains(
        '1. RAEB [9983/3]',
        'OK: primary diagnosis found',
    );
    $mech->text_contains(
        '2. CLL [9823/3]',
        'OK: secondary diagnosis found',
    );
    $mech->content_lacks(
        'comment goes here',
        'OK: comment suppressed by diagnosis',
    );
    $mech->has_tag(
        pre => 'morphology description goes here',
        'OK: morphology description found',
    );
    $mech->has_tag(
        pre => 'flow results summary goes here',
        'OK: flow summary found',
    );
    # don't want to follow this as it will hit HMRN web-site, just see if it exists:
    { # warn $_->url for $mech->followable_links();
        my $i = grep { $_->url =~ '/hmrn/info' } $mech->followable_links(); # warn $i;
        is ($i, 2, 'OK: 2 HMRN links found'); # both diagnoses are ICDO3
    }
    $mech->has_tag(
        span => 'PLEASE USE THE NHS NUMBER',
        'OK: please use NHS number warning found',
    ); 
} # print_and_exit();

# search for reported record #2:
$mech->get_ok('/search/=/2');                                 # print_and_exit();
{ # warn $mech->text; exit;
    $mech->text_contains(
        'reported on a lymph node specimen',
        'OK: expected biopsy details found',
    );                                                        # print_and_exit();
    $mech->text_contains(
        'block reference here',
        'OK: expected block reference details found',
    );                                                        # print_and_exit();
    $mech->text_contains(
        'of adequate quality',
        'OK: expected specimen quality details found',
    );                                                        # print_and_exit();
    {
        my $date_format # clone this or it changes original
            = $DATE->clone->subtract(days => 1)->strftime('%a %d.%b.%Y');
        $mech->text_contains(
            'taken ' . $date_format,
            'OK: expected specimen taken details found',
        );                                                    # print_and_exit();
    }
    {
        my $date_format = $DATE->strftime('%a %d.%b.%Y');
        $mech->text_contains(
            'received ' . $date_format,
            'OK: expected registration details found',
        );                                                    # print_and_exit();
    }
    $mech->has_tag(
        span => 'CLL',
        'OK: primary diagnosis found',
    );
    $mech->has_tag(
        p => 'comment goes here',
        'OK: comment found',
    );
    $mech->content_lacks( # didn't supply it
        'morphology description',
        'OK: no morphology description',
    );
    $mech->content_contains(
        'this is a NEW diagnosis',
        'OK: new diagnosis text found',
    );
    $mech->has_tag(
        pre => 'molecular results summary goes here',
        'OK: molecular summary found',
    );
    $mech->has_tag(
        pre => 'flow results summary goes here',
        'OK: flow summary found',
    );
}  # print_and_exit();

{ # check links (skip HMRN) - logout link causes logout so so last:
    my @links = $mech->find_all_links( url_regex => qr{localhost}); # not a name or css
        # warn Dumper $_->url for @links;
        # warn Dumper grep $_->url !~ 'hmrn', @links;
    # print_record link will throw wkhtmltodpf QPixmap error if no x-server running:
    $mech->links_ok( [ grep $_->url !~ 'hmrn|print', @links ], 'OK: nav links checked' );
}

=begin # uncomment to generate long phrases for result summary & comment:
do_login(); # login as lab user:

{ # cosmetic views - word-wrapping on long passages:
    $mech->get_ok('/result/=/2');                              # print_and_exit();
    # flow result:
    my $str = q!Lymphoid cells identified with strong CD45 expression and low !
    . q!side scatter properties were gated and account for approx. 22% of marrow !
    . q!events. The lymphoid comprise 34% T cells (CD2+,CD3+), 5% NK cells !
    . q!(CD2+,CD3-,CD56+) and 58% B cells (CD19+,CD20+,CD22+,CD79B+). The B cells !
    . q!express CD38 and are Kappa light chain restricted. CD5, CD10, and CD23 !
    . qq!antigens are negative.\n\nIn addition, approx. 1-2% of marrow events are !
    . q!plasma cells(strong CD38, weak CD45) which lack CD19.!;
    
    $mech->form_name('flow_results');
    $mech->submit_form(fields => { results_summary => $str }); # print_and_exit();
}

{ 
    $mech->get_ok('/report/=/2');                              # print_and_exit();
    # morphology:
    my $str = q!Excellent bone marrow aspirate which is mildly hypercellular and !
    . qq!shows trilineage haematopoiesis with 22% atypical lymphocytes.\n!
    . q!Findings suggest bone marrow infiltration with a low grade NHL best in !
    . q!keeping with lymphoplasmacytic. Note cohesive islands of cells with !
    . q!blastic appearence and blue nucleoli very suggestive of metastatic !
    . qq!carcinoma (note history of metastaic prostate carcinoma).!;
    
    $mech->form_name('reportForm');
    $mech->submit_form(fields => { morphology => $str }); 
    $mech->submit_form(form_name => 'reportForm');            # print_and_exit();
}

# login as guest user:
do_logout();
$mech->submit_form(
    fields => { authen_username => 'a.guest', authen_password => 'guessed' },
);                                                           # print_and_exit();                        
{    
    $mech->get_ok('/search/=/2');                             print_and_exit();
}
=cut
