• Files
• Commits
• Log
• Graph
• Stats

package LIMS::Controller::Result;

use Moose;
use MooseX::NonMoose;
BEGIN { extends 'LIMS::Base'; }

with (
	'LIMS::Controller::Roles::DataMap',
	'LIMS::Controller::Roles::DataFile',
    'LIMS::Controller::Roles::FormData', # validate_form_params()
	'LIMS::Controller::Roles::DataImport',
	'LIMS::Controller::Roles::RecordHandler',
	'LIMS::Controller::Roles::ResultHandler',
);
no Moose;

__PACKAGE__->meta->make_immutable; # don't need inline_constructor with MooseX::NonMoose;

# can't use __PACKAGE__->authz->authz_runmodes() - crashes on non-logged-in user
use Data::Dumper;
use Spreadsheet::WriteExcel::Simple;

#-------------------------------------------------------------------------------
sub default : StartRunmode {
    my $self = shift;

    # shouldn't be called here - redirect to /
    $self->redirect( $self->query->url );
}

#-------------------------------------------------------------------------------
sub load : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('modify_results');

    my $request_id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

    # attempt to fix "Can't use string ("0") as a HASH ref ... at ..." (now line #43)
	my $request_data = $self->get_single_request_data($request_id)
    || return $self->error("cannot load a request for id $request_id");

	# return to home page if record locked (direct url arrival) & not authorized:
	if ( $request_data->{is_locked} && ! $self->user_can('modify_results') ) {
		return $self->redirect( $self->query->url . '/search/=/' . $request_id );
	}

	# send $data to process_results_data() for template
	# adds 'all_results' & 'results_summary_opts' to $request_data:
	$self->process_raw_lab_test_data($request_data);

	{ # datafiles - load sub to save db lookup if not required:
        my $_self = $self; weaken $_self; # avoid circular ref inside callback
		my $load_data_files = sub {
			my $data_files = $_self->get_result_data_file($request_id);
			return @$data_files ? 1 : 0;
		};
		$self->tt_params( have_data_files => $load_data_files );
	}
	# get some data maps:
	my %data_map;
	{ # lab test data type map:
		my $lab_test_data_type_map = $self->lab_test_data_type_map;
		$data_map{lab_test_data_type} = $lab_test_data_type_map;
	}
	{ # lab test result options map:
		my $lab_test_result_options = $self->lab_test_result_options_map;
		$data_map{data_options} = $lab_test_result_options;
	}
    { # get list of tests requested - direct & via panels:
        my $results = $request_data->{all_results};
        my $requested_tests = $self->get_requested_tests($results);
        $data_map{requested_tests} = $requested_tests;
    }
    { # function to create drop-down from range eg (1..36)
        my $menu_function = sub {
            my $input = shift; # warn $input;
            my ($low,$high) = $input =~ /(\d+)\-(\d+)/; # warn $low; warn $high;
            return { low => $low, high => $high };
        };
        $self->tt_params( menu_function => $menu_function );
    }
	$self->tt_params( data_map => \%data_map );

	# $self->_debug_path('timer');
    return $self->render_view('result/default.tt', $request_data);
}

#-------------------------------------------------------------------------------
sub update : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('modify_results');

    my $request_id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

    # required = 1 hidden field so should never fail, so send to error mode:
    my $dfv = $self->check_rm('load', $self->validate('update_results') )
	|| return $self->error('required hidden field(s) not supplied to rm '
        . $self->get_current_runmode);

    my $data = $dfv->valid(); # $self->debug($data);

    # put request_id into $data:
    $data->{_request_id} = $request_id; # $self->debug($data);

    # auto-unlock record if it's a storage [dr]na request:
    if ( $self->query->param('storage_auto_unlock') ) {
        my $rtn = $self->model('Request')->auto_unlock($request_id);
        return $self->error($rtn) if $rtn;
    }

    my $rtn = $self->model('Result')->update_lab_test_requests($data);

	if ($rtn) {
		return $self->error($rtn);
	}
	else {
		$self->flash( info => $self->messages('action')->{edit_success});
		return $self->redirect( $self->query->url . '/result/=/' . $request_id );
	}
}

#-------------------------------------------------------------------------------
sub preview_datafile : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $request_id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

	# get data file from requests' images dir - in arrayref format:
	my $data_file = $self->get_result_data_file($request_id);

	# check there's only 1 data file (will need to revise when parsing multiple files):
	if (! @$data_file || @$data_file > 1) {
		my $msg = @$data_file ? 'xs_data_files' : 'no_data_file';
		$self->flash( error => $self->messages('results')->{$msg} );
		return $self->redirect( $self->query->url . '/image/=/' . $request_id );
	}

	# extract data from datafile into arrayref:
	my $data = $self->get_datafile_contents($data_file->[0]); # deref @data_file
	unless (@$data) {
		$self->flash( error => $self->messages('results')->{empty_data} );
		$self->redirect( $self->query->url . '/image/=/' . $request_id );
	}

	$self->tt_params(
		request_id => $request_id,
		data 	   => $data,
		file 	   => @$data_file, # deref single arrayref
	);

	{ # provide callback function to load flow data PDF:
        my $_self = $self; weaken $_self; # or get circular refs inside the callbacks
        $self->tt_params(
            flow_plot => sub {
                my $file_type = shift; # warn $file_type; # eg PB_CMP.pdf
                my %args = ( request_id => $request_id, file_type => $file_type );
                my $f = $_self->get_file_by_filetype(\%args); # in C::Roles::DataFile
                return $f; # components to construct url link
            },
        );
    }

	{ # extract contents of datafile to object accessor to test integrity:
        $self->parse_data_file($data);
        if ( my $errs = $self->_check_datafile_integrity ) {
            my $msg = join '; ', @$errs;
            $self->tt_params( errs => $msg );
        }
        else {
            my $msg = $self->messages('results')->{data_matches};
            $self->tt_params( msg => $msg );
        }
    }

 	return $self->tt_process;
}

#-------------------------------------------------------------------------------
sub import_datafile : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);

    my $request_id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

	my $filename = $self->query->param('datafile')
	|| return $self->error('no filename passed to ' . $self->get_current_runmode);

	# extract contents of datafile to object accessor:
    my $data = $self->get_datafile_contents($filename);
	$self->parse_data_file($data);

    my $url = $self->query->url;

	# check internal datafile refs (filename & patient ids) match
    if ( my $errs = $self->_check_datafile_integrity ) { # already done in preview_datafile
        $self->flash( error => join '; ', @$errs );
        return $self->redirect( $url . '/image/=/' . $request_id );
    }
    else { # no point setting flash msg - already been verified & import sets success msg anyway
        # $self->flash( info => $self->messages('results')->{data_matches} );
    }

	# get flow data (as arrayref) from datafile, or redirect (flash set in sub):
	my $flow_data_result = $self->_get_flow_data_result()
	|| return $self->redirect( $url . '/image/=/' . $request_id );

	# create hash to hold data for db update:
	my %results_data = ( request_id => $request_id );

	# if lab_test sign_off required, need to get additional params:
	if ( my $lab_test_data = $self->get_lab_test_data() ) { # warn Dumper $lab_test_data;
        { # check required lab-test been requested or return error msg:
            my %args = (
                lab_test_data => $lab_test_data,
                request_id    => $request_id,
            );

            unless ( $self->check_lab_test_requested(\%args) ) {
                $self->_set_flash_msg('no_lab_test'); # set flash msg on failure
                return $self->redirect( $url . '/result/=/' . $request_id );
            }
        }

		# get 'acquired_by' user:
		my $acquired_by = $self->get_analysis_user(); # no need to check, it's next
		$lab_test_data->{acquired_by} = $acquired_by;

		# get 'user_id' value:
		my $user_id = $self->get_analysis_user_id($acquired_by)
		|| $self->_set_flash_msg('no_userid'); # set flash msg on failure

		# get 'date_acquired' value:
		my $date_acquired = $self->get_date_acquired()
		|| $self->_set_flash_msg('empty_acquired'); # set flash msg on failure

		# check both params, or redirect (flash msg already set on either failure):
		unless ($date_acquired && $user_id) {
			return $self->redirect( $url . '/image/=/' . $request_id );
		}

		$lab_test_data->{date_acquired} = $date_acquired;
		$lab_test_data->{acquisition_userid} = $user_id;

		$results_data{lab_test_data} = $lab_test_data;
	}

	{ # request_report data:
		my $report_data = $self->get_report_params(); # $self->debug($data);
		$results_data{report_data} = $report_data;
	}

	{ # request_result_summaries data:
		my $lab_section = $self->get_lab_section;
        my $results_summary = join "\n", @$flow_data_result;

		my %result_summary_data = (
			lab_section     => $lab_section,
			results_summary => $results_summary,
		); # $self->debug(\%result_summaries_data);
		$results_data{result_summary_data} = \%result_summary_data;
	}

    my $rtn = $self->model('Result')->import_results(\%results_data);

	if ($rtn) {
		return $self->error($rtn);
	}
	else {
		$self->flash( info => $self->messages('action')->{edit_success});
		return $self->redirect( $url . '/report/=/' . $request_id );
	}
}

# ------------------------------------------------------------------------------
sub accept_haem_data : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('modify_results');

	my $lab_number = $self->param('id')
	|| return $self->error('no lab_number passed to ' . $self->get_current_runmode);

	my $function = $self->query->param('func'); # optional
	my $request_id = $self->query->param('id'); # optional

    my %args = (
        lab_number => $lab_number,
        request_id => $request_id,
    );
	my $rtn = $self->model('Result')->accept_haematology_data(\%args);

	if ($rtn) { # indicates error
		return $self->error($rtn);
	}
	else {
        my $target = $function
            ? $function . '/=/' . $request_id # eg screen/=/1
            : 'local_worklist?function_name=haem_data';
		$self->flash( info => $self->messages('action')->{edit_success} );
		return $self->redirect( join '/', $self->query->url, $target );
	}
}

# ------------------------------------------------------------------------------
sub delete_haem_data : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);

	return $self->forbidden() unless $self->user_can('modify_results');

	my $lab_number = $self->param('id')
	|| return $self->error('no lab_number passed to ' . $self->get_current_runmode);

	my $function = $self->query->param('func'); # optional
	my $request_id = $self->query->param('id'); # optional

    # need confirmation to delete record:
    if ( $self->query->param('confirm_delete') ) { # warn $lab_number;
        my %args = (
            lab_number => $lab_number,
            request_id => $request_id,
        );
        my $rtn = $self->model('Result')->delete_haematology_data(\%args);
        return $self->error($rtn) if $rtn;

        my $target = $function
            ? $function . '/=/' . $request_id # eg screen/=/1
            : 'local_worklist?function_name=haem_data';
        # set flash success & redirect:
        $self->flash( info => $self->messages('action')->{delete_success} );
		return $self->redirect( join '/', $self->query->url, $target );
    }
    else { # just return tt for confirmation:
        return $self->tt_process();
    }
}

#-------------------------------------------------------------------------------
sub data_entry : Runmode {
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	return $self->forbidden() unless $self->user_can('modify_results');

    my $request_id = $self->param('id')
    || return $self->error('no id passed to ' . $self->get_current_runmode);

    # required = 2 hidden fields so should never fail, so send to error mode:
    my $dfv = $self->check_rm('load', $self->validate('results_data_entry') )
	|| return $self->error('required hidden field(s) not supplied to rm '
        . $self->get_current_runmode);

    my $data = $dfv->valid();
    $data->{_request_id} = $request_id; # $self->debug($data);

	# add test results data:
    my $lab_test_results = $self->_get_test_results_data_map; # warn Dumper $lab_test_results;
    $data->{lab_test_results} = $lab_test_results;  # $self->debug($data);

    { # test results validation:
        my $data_type_map = $self->lab_test_data_type_map; # warn Dumper $data_type_map;
        my $lab_tests_map = $self->lab_tests_map; # warn Dumper $lab_tests_map;
        my %validation_failures;
        TEST:
        while ( my ($test_id, $result) = each %{ $lab_test_results } ) {
            next TEST unless defined $result; # maybe not submitted
                # warn Dumper [$test_id, $result];
            my $data_type = $data_type_map->{$test_id}->{data_type}->{type}; # warn $data_type;
            my %h = (
                data_type => $data_type,
                test_id   => $test_id,
            );
            # validate result if validator for data type exists (returns 0 otherwise):
            if ( my $ref = $self->validate_results_data_entry(\%h) ) { # warn Dumper $ref;
                next TEST if $ref->{pass}; # warn Dumper $ref;
                # OK, so it failed:
                my $test_name = $lab_tests_map->{$test_id}; # warn $test_name;
                # my @err_msgs  = @{ $ref->{errs} }; # warn Dumper \@err_msgs; # aref
                my @err_msgs = map "$test_name [$result]: $_",
                    $self->all_results_errors; # set in Roles::FormData
                $validation_failures{$test_id} = \@err_msgs;
            } # warn Dumper \%validation_failures;
        }
        if ( %validation_failures ) { # warn Dumper \%validation_failures;
            # each key/value pair is a test_id => aref of err_msgs
            my @msgs = map @{ $validation_failures{$_} },
                keys %validation_failures; # warn Dumper \@msgs;
            $self->stash( error_msg =>\@msgs ); # for status.tt
            $self->tt_params( validation_failures => \%validation_failures );

            my $section_name = $self->query->param('_section_name');
            $self->tt_params( section_with_result_errors => $section_name );

            my $html = $self->forward('load'); # warn Dumper $html; warn Dumper $self->query;
            # have to delete query params _section_id & _section_name or they persist:
            my $vars = $self->query->Vars(); # warn Dumper $vars;
            delete $vars->{$_} for qw(_section_id _section_name); # warn Dumper $vars;
            return $self->fill_form($html, $vars); # retains submitted params (minus above 2)
        }
    }

	# get (optional) config file for auto_reportable requests:
	if ( my $cfg = $self->get_yaml_file('auto_reportable') ) {
		$data->{auto_reportable_config} = $cfg;
	}
    { # if config allows auto-completion of lab-test status (genomics):
        $data->{test_status_complete}
            = $self->cfg('settings')->{status_complete_on_result_entry};
    }
	my $rtn = $self->model('Result')->update_request_lab_test_results($data);

	if ($rtn) {
		return $self->error($rtn);
	}
	else {
		$self->flash( info => $self->messages('results')->{update_success} );
		return $self->redirect( $self->query->url . '/result/=/'.$request_id );
	}
}

#-------------------------------------------------------------------------------
sub export_test_results : Runmode {
	my $self = shift; $self->_debug_path();

	my $lab_sections
		= $self->model('LabSection')->get_lab_sections_with_test_results;
	my $sub_categories = $self->model('Diagnosis')->get_diagnostic_categories;

	$self->tt_params(
		sections => $lab_sections,
		sub_cats => $sub_categories,
	);
	return $self->tt_process();
}

#-------------------------------------------------------------------------------
sub do_export_test_results : Runmode {
	my $self = shift; $self->_debug_path();

    my %vars = $self->query->Vars(); # warn Dumper \%vars; # must be hash context

    # category_id can be a list, need to 'unflatten' then convert to arrayref:
    if ( $vars{category_id} ) {
		my @ids = split "\0", $vars{category_id}; # var(s) joined by NULL character
        $vars{category_id} = \@ids; # only works if vars is hash, not hashref
    } # warn Dumper \%vars;

	my $section_id = $vars{section_id} # need at least lab-section:
	|| return $self->forward('export_test_results');

    my $data = $self->model('Result')->get_section_lab_test_results(\%vars)
	|| do {
		$self->flash( info => $self->messages('results')->{no_test_results} );
		return $self->forward('export_test_results');
	};

    my $xl = Spreadsheet::WriteExcel::Simple->new;

    my $headers = $data->{headers};
    $xl->write_bold_row($headers);

    my $results = $data->{results};
    $xl->write_row($_) for @$results;

	my $section =
		$self->model('LabSection')->get_lab_section($section_id)->section_name;
	$section =~ s/\s/\-/g; # spaces => hyphens
	my $formatter = DateTime::Format::Strptime->new( pattern => '%y%m%d-%H%M' );
	my $filename = sprintf '%s-results-%s.xls',
		lc $section, LIMS::Local::Utils::time_now({ formatter => $formatter });

    # set header:
    $self->header_props(
        -type => 'application/excel',
        -attachment => $filename,
        -expires => 'now'
    );
    return $xl->data; # or $xl->save("filename.xls");
}

#-------------------------------------------------------------------------------
# check internal datafile refs (filename & patient ids) match
# return errs arrayref on error, or 0:
sub _check_datafile_integrity {
	my $self = shift; $self->_debug_path();

	# check_datafile_integrity() returns names of any errors:
	if ( my $error_names = $self->check_datafile_integrity() ) {
		my @errs = map $self->messages('results')->{$_}, @$error_names;
        return \@errs;
	}
    else {
       return 0;
    }
}

#-------------------------------------------------------------------------------
# data passed from form fields as lab_test_id_(\d)
sub _get_test_results_data_map {
	my $self = shift; $self->_debug_path();

	my $params = $self->query->Vars; # can't use $dfv->valid for dynamic params
    my $trim   = sub { LIMS::Local::Utils::trim(@_) }; # remove leading/trailing spaces

	my %map;
	while ( my($param, $value) = each %$params ) { # warn Dumper [$param, $value];
		# look for param lab_test_id_(\d):
		my ($lab_test_id) = $param =~ /lab_test_id_(\d+)/; # don't do '|| next' here
		next unless $lab_test_id; # warn Dumper [$lab_test_id, $value];
        # trim leading/trailing spaces from result (patch 16/10/2017 for Genomics results)
		$map{$lab_test_id} = $trim->($value); # &$trim($value) - use modern syntax !!
	} # $self->debug(\%map);
	return \%map;
}

#-------------------------------------------------------------------------------
sub _get_flow_data_result {
	my $self = shift; $self->_debug_path();

    my $result = $self->get_datafile_results(); # arrayref

	if ( @$result ) {
		return $result;
	}
	else {
		$self->flash( error => $self->messages('results')->{empty_result} );
		return 0;
	}
}

#-------------------------------------------------------------------------------
sub _set_flash_msg {
	my $self = shift; $self->_debug_path();
	my $msg  = shift;

	$self->flash( error => $self->messages('results')->{$msg} );
	return 0; # IMPORTANT - return value is captured by caller
}

1;