#!/usr/bin/perl

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

use strict;
use warnings;

use Test::More;
use constant TESTS => 261;

use Data::Printer alias => 'ddp';

=begin: tests:
=cut

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

print_msg('Setting up');

my $mech = get_mech();

my $dbh;

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

warn $@ if $@;

my $dbix = get_dbix();

my $validation_profiles = get_validation_profiles(); # ddp $validation_profiles;

{ # create new HMRN parent:
    my %h = (
        parent_code => 'RR8',
        description => 'LTH',
        referral_type_id => 3,
    );
    $dbix->insert('parent_organisations', \%h) or die $dbix->error;
}
{ # create new HMRN source of new parent:
     $dbix->select('parent_organisations', 'id',
        { parent_code => 'RR8' })->into(my $id);
    my %h = (
        parent_organisation_id => $id,
        organisation_code      => 'RR813',
        referral_type_id       => 3,
        display_name           => 'SJUH',
    );
    $dbix->insert('referral_sources', \%h) or die $dbix->error;
}
{ # create hmrn permission:
    my %h = (
        function_name   => 'edit_clinical_data',
        function_detail =>'view & edit HMRN data',
    );
    $dbix->insert('user_functions', \%h);
}
{ # update user access permissions:
    $dbix->select('user_functions', 'id',
        { function_name => 'edit_clinical_data' })->into(my $id);
    $dbix->insert('user_group_function', { group_id => 1, function_id => $id });
}

do_hmrn_data();

print_msg('Log in');
do_login();

print_msg('Registering new patient');
# register new patient_case + request:
$mech->get_ok('/patient/select_patient/2');
{
    $mech->submit_form(
        fields => {
            unit_number => 2233,
            referral_source_id => 5,
        },
    );                                                        # print_and_exit();
    $mech->submit_form(
        fields => {
            request_number => 3,
            referrer_code => 'C9999998',
            specimen => 'PB',
        },
    );                                                       # print_and_exit();
    $mech->has_tag(
        h3 => 'New request successful',
    );
}
# screen it:
print_msg('Screening');
$mech->get_ok('/screen/do_initial_screen/3?screen_id=1;option_id=1');# print_and_exit();
# report it:
print_msg('Reporting');
$mech->get_ok('/report/=/3');                                 # print_and_exit();
{
    # test missing:
    my %report = (
        status  => 'default',
        confirm_outstanding_tests => 1,
        clinical_details => 'some details here',
        gross_description => 'gross description here',
        specimen_quality => 'adequate',
        diagnosis_id => 1,
    );
    $mech->form_name('reportForm');
    $mech->submit_form(fields => \%report);                   # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if is_spell_check_required();
    lacks_dfv_errors();                                       # print_and_exit();
}
# authorise it:
print_msg('Authorising');
{
    # manually change reporter's id:
    $dbix->update( 'request_history',
        { user_id => 2 }, { action => 'reported', request_id => 3 },
    );

    $mech->get_ok('/report/=/3?pre-authorisation-check=1');   # print_and_exit();
    $mech->form_name('reportForm');
    $mech->field( confirm_outstanding_tests => 1 );
    $mech->field( authorise => 1 );
    $mech->submit_form();                                     # print_and_exit();
    $mech->submit_form(form_name =>'reportForm') if is_spell_check_required();
    lacks_dfv_errors();                                       # print_and_exit();
}

# =========================== MAIN TESTS ========================================

# add some HMRN data:
my %precursor_values = (
		#Unique data: -----
		#..no unique data
		#Shared data: -----
        ecog => 1,
        wbc => 6.0,
        hb => 20.0,
        plts => 300,
        lymphs => 5.0,
        pcv => 65,
        neutrophils => 2.0,
        monocytes => 1.0,
);

my $precursor_required = $validation_profiles->hmrn_precursor->{required};

my %myeloid_values = ( # *** excluding fields shared with precursor **** :
		#Unique data: -----
        pcv => 60.0,
        epo => 'low',
        splenomegaly => 'Y',
        hepatomegaly => 'N',
        detection_spleen => 'both',
        detection_liver  => 'both',
		karyotype => 'good',
		cd34 => 12.0,
		transfusion => 'N',
		cytopenias => 1,
		#Shared data: -----
		ecog => 1,
		wbc => 6.0,
		hb => 20.0,
		pcv => 65.0,
		lymphs => 5.0,
		neutrophils => 2.0,
		monocytes => 1.0,
		plts => 300,
);
my $myeloid_required = $validation_profiles->hmrn_myeloid->{required};

my %lymphoid_values = (
		#Unique data: -----
		bm => 'N',
		sweats => 'N',
		fever => 'N',
		wt_loss => 'N',
		ct => 'N',
		binet => 'A',
		stage => 'I',
		ldh => 'low',
		#Shared data: -----
		ecog => 1,
        pcv => 65.0,
        monocytes => 1.0,
		wbc => 6.0,
        hb => 20.0,
        lymphs => 5.0,
		plts => 300,
		neutrophils => 2.0,
		paraprotein => 'IgA',
		albumin => '60',
		b2m => '45.0',
		pp_level => 60.0,
		igs	=> 'normal',
);

my $lymphoid_required = $validation_profiles->hmrn_lymphoid->{required};

my %plasmacell_values = (
		#Unique data: -----
		bence_jones => 'both',
		serum_flc => 'both',
		bone_disease => 'equivocal',
		bone_lesions => 'multiple',
		mri => 'N',
		skeletal_survey => 'N',
		serum_kappa => 40.0,
		serum_lambda => 45.0,
		kappa_lambda_ratio => 50.0,
		creatinine => 55,
		calcium => 65.0,
		#Shared data: -----
		paraprotein => 'IgA',
		igs	=> 'normal',
		ecog => 1,
		plts => 300,
		neutrophils => 2.0,
		monocytes => 1.0,
		pp_level => 60,
		b2m => '45',
		hb => 20.0,
		albumin => '60',
		wbc => 6.0,
		pcv => 65.0,
		lymphs => 5.0,
);

my $plasmacell_required = $validation_profiles->hmrn_plasmacell->{required};

{ # tests to add full data to each category, one at a time,
  # after adding the data category, test deleting it

	clear_params_for_request(3);         # clear all existing parameters
	$mech->get_ok('/hmrn_data/=/3');     # open the data entry page

	my %category_parm_values = (
		precursor  => \%precursor_values,
		myeloid    => \%myeloid_values,
		lymphoid   => \%lymphoid_values,
		plasmacell => \%plasmacell_values,
	);

	while (my ($category_name, $params_vals_ref) = each(%category_parm_values)) {

		print_msg("TEST - Adding full data to $category_name");

		$mech->form_name( $category_name );
		$mech->submit_form( fields => $params_vals_ref );
		test_edited_msg( $category_name );

		print_msg("TEST - Params all exist for $category_name");
		my @params = get_params_for_category( $category_name );
		test_form_has_param_values( $category_name, \@params);

		# test delete category
		print_msg("TEST - Deleting params from  $category_name");
		test_delete_category_simple($category_name);
		test_form_ismissing_param_values($category_name, \@params);
	}
}

{ # testing deleting precursor category, warning against deleting unique data from
  # the myloid category that shares data with it.

	print_msg("Prepare to test deleteing shared data - clear data now");
	clear_params_for_request(3);      # clear all existing parameters

	{	# populate myloid category, which also populates precursor category
	    # due to shared data
		print_msg("TEST - Submit full myeloid data");
		$mech->form_name('myeloid');
		$mech->submit_form(fields => \%myeloid_values);
		test_edited_msg('myeloid');
	}

	print_msg("TEST - Try to delete precursor section with shared data in myeloid");
	$mech->get_ok('/hmrn_data/delete_section_data/3/precursor');   # print_and_exit;
	{ # warn $mech->text;
		$mech->text_contains(
			'deleting data items from the PRECURSOR section will also remove them from other sections',
			'OK: warning 1 located',
		);
		$mech->text_contains(
			'sections highlighted in red also contain additional (non-shared) data ',
			'OK: warning 2 located',
		);
	}

	# provide confirmation:
	{
		print_msg("Provide delete confirmation");
		$mech->tick(confirm_delete => 1);
		$mech->submit();                                         # print_and_exit();

		print_msg("TEST - Delete confirmed");
		test_deleted_msg('precursor');
	}

	{ # check all precursor data gone and non-shared still exists:

		# precursor fields:
		print_msg("TEST - Ensure all precursor data has gone");
		$mech->form_name('precursor');
		my @precursor_params = get_params_for_category('precursor'); # p \@precursor_params;
		for my $param(@precursor_params) { # p [ $param, $mech->value($param) ];
			my $result = $mech->value($param) ? 1 : 0; # just need existance
			is($result, 0, "OK: precursors.$param value deleted");
		}

		# myeloid fields:
		print_msg("TEST - Ensure all myloid data shared with precursor data has gone");
		$mech->form_name('myeloid');
		for my $param(@precursor_params) { # p [ $param, $mech->value($param) ];
			my $result = $mech->value($param) ? 1 : 0; # just need existance
			is($result, 0, "OK: shared myeloid.$param value deleted");
		}
		print_msg("TEST - Ensure all myloid's unique data has been retained");
		my @myeloid_params = get_params_for_category('myeloid'); # p \@myeloid_params; # didn't add all
		for my $param(@myeloid_params) {
			next if (grep {$_ eq $param} @precursor_params);  # skip precursor parametets
			my $result = $mech->value($param) ? 1 : 0; # just need existance
			is($result, 1, "OK: unique myeloid.$param value retained");
		}
	}
}

{ # test required values

	print_msg("TEST - Test submitting with each required field missing");
	test_form_required_values('precursor',  \%precursor_values,  $precursor_required);
	test_form_required_values('myeloid',    \%myeloid_values,    $myeloid_required);
	test_form_required_values('lymphoid',   \%lymphoid_values,   $lymphoid_required);
	test_form_required_values('plasmacell', \%plasmacell_values, $plasmacell_required);
}


#####################################################
##   IN PROGRESS                                    #
#####################################################

#{ # test ranges and defaults
#
#	print_msg("TEST (IN PROGRESS) - Test myeloid ranges...");
#
#	my $category = 'myeloid';
#	my %modified_values = %myeloid_values;
#
#	my $sql =  "SELECT p.param_name, dr.min_value, dr.max_value,
#					  dr.not_stated, dr.not_done
#			    FROM category_parameter cp
#					JOIN categories c ON cp.category_id=c.id
#					JOIN defaults_and_ranges dr ON cp.parameter_id=dr.param_id
#					JOIN parameters p ON cp.parameter_id=p.id
#				WHERE c.category=?;";
#
#	clear_params_for_request(3);         # clear all existing parameters
#	$mech->get_ok('/hmrn_data/=/3');     # open the data entry page
#
#
#	for my $range_hashref ( $dbix->query($sql, $category)->hashes ) {
#
#p $range_hashref;
#
#		my $param_has_range = $range_hashref->{param_name};       # parameter in this category that has a range
#		my $original_value = $modified_values{$param_has_range};  # keep orignal value for this param to reset it later
#		my $range_string = "[" . $range_hashref->{min_value} . " to " . $range_hashref->{max_value} . "]";
#
#		# Modify value to be 0.1 under the minimum acceptable value and submit
#		$modified_values{$param_has_range} = $range_hashref->{min_value} - 0.1;
#
#		$mech->form_name($category);
#		$mech->submit_form(fields => \%modified_values);
#		$mech->content_contains('FORM FAILED VALIDATION',
#							"OK: $modified_values{$param_has_range} out of range "
#							. "$range_string for $category.$param_has_range");  #may need to edit this to check for something different
####		test_edited_msg($category);
#
#		# reset to original value after finished testing this param
#		$modified_values{$param_has_range} = $original_value;
#
#	}
#
#}

#####################################################
##   END OF 'IN PROGRESS'                           #
#####################################################

done_testing(TESTS);

print_msg("END");

sub test_form_required_values {
	# Checkes each required field in a form to make sure we get a validation error if it's not there.
    my($category_name, $values_href, $req_params_aref) = @_ ;

	clear_params_for_request(3);         # clear all existing parameters
	$mech->get_ok('/hmrn_data/=/3');     # open the data entry page

	my %modified_values = %$values_href;

	for my $req_param (@$req_params_aref) {

		$modified_values{$req_param} = undef;

		$mech->form_name($category_name);
		$mech->submit_form(fields => \%modified_values);

		$mech->content_contains('FORM FAILED VALIDATION',
								"OK: form validation failed for missing $category_name.$req_param",);
		# reset modified value
		$modified_values{$req_param} = $values_href->{$req_param};
	}

}

sub test_delete_category_simple {
	#deletes a category using the delete URL, doesn't check for confirmation messages
	my $category = shift;

	$mech->get_ok("/hmrn_data/delete_section_data/3/$category");   # print_and_exit;
	$mech->tick(confirm_delete => 1);
    $mech->submit();
	test_deleted_msg($category);
}

sub test_deleted_msg {
    my $deleted_category = shift;

    my $msg = get_messages('action')->{delete_success};
    $mech->has_tag_like(
        p => qr(INFO: $msg),
        "OK: delete $deleted_category action succeeded",
    );
}

sub test_edited_msg {
    my $edited_category = shift;

    my $msg = get_messages('action')->{edit_success};
    $mech->has_tag_like(
        p => qr(INFO: $msg),
        "OK: edit $edited_category action succeeded",
    );
}

sub test_form_has_param_values {
	# Tests if a given array of params have values in the given form
    my($form_name, $param_aref) = @_ ;

	$mech->form_name($form_name);
    for my $param(@$param_aref) {
        my $result = $mech->value($param) ? 1 : 0; # just need existance
        is($result, 1, "OK: $form_name.$param value loaded");
    }
}

sub test_form_ismissing_param_values {
	# Tests if a given array of params have values in the given form
    my($form_name, $param_aref) = @_ ;

	$mech->form_name($form_name);
    for my $param(@$param_aref) {
        my $result = $mech->value($param) ? 1 : 0; # just need existance
        is($result, 0, "OK: $form_name.$param has no value");
    }
}

sub clear_params_for_request {    # JD - Clears the parameters for a given request
	my $request_id = shift;

    my $sql = q!select patient_id from patient_case pc join requests r on
	            r.patient_case_id = pc.id where r.id = ?!;
	$dbix->query($sql, $request_id)->into(my $patient_id);
    $dbix->delete('hmrn_test.patient_params', { patient_id => $patient_id });
}

sub get_params_for_category {
    my $category = shift;

    my $sql = q!select param_name from hmrn_test.parameters p join
        hmrn_test.category_parameter cp on cp.parameter_id = p.id join
        hmrn_test.categories c on cp.category_id = c.id where c.category = ?!;
    my @params = $dbix->query($sql, $category)->flat; # \p @params;
    return wantarray ? @params : \@params;
}

# Prints out a message
sub print_msg {
	my $msg = shift;
	print  "\n" . '-' x 10 . ' ' . $msg . "\n";
}