package LIMS::Controller::Ajax;
use Moose;
BEGIN { extends 'LIMS::Base'; }
with 'LIMS::Controller::Roles::Aspell';
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
use IO::All;
use Data::Dumper;
use Regexp::Common;
use LIMS::Local::Utils;
use Data::FormValidator;
use FormValidator::Simple;
use CGI::Application::Plugin::JSON ':all';
# only uses dfv_msgs for errors, formatted as dfv-style in _format_as_dfv():
sub err_msg {
my $self = shift;
my $msg = shift;
return $self->messages('dfv_msgs')->{$msg};
}
# ------------------------------------------------------------------------------
# override base cgiapp_init, remove TT wrapper for templates:
sub cgiapp_init {
my $self = shift;
# get tt_config:
my $tt_config = $self->cfg('tt_config');
# delete wrapper option:
$tt_config->{TEMPLATE_OPTIONS}->{WRAPPER} = undef;
# load modified tt_config:
$self->tt_config( $tt_config );
# load rest of base cgiapp_init:
$self->SUPER::cgiapp_init;
}
# ------------------------------------------------------------------------------
# expects query string: /ajax?fname=do_ajax&args=<value>&<field_name>=<value> if
# <field_name> matches 'is_valid_' send query->vars to _validate_param(), otherwise
# to _db_lookup()
sub do_ajax : StartRunmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
# ajax query string has 3 params - fname, args & <field_name>
my $vars = $self->query->Vars; # $self->debug($vars);
# delete keys fname & args, leaving only <field_name>:
map delete $vars->{$_}, qw(fname args); # $self->debug($vars);
# if one (or more) Vars() = is_valid_*, needs validating
if ( grep $_ =~ /^is_valid_/, keys %$vars ) {
return $self->_validate_param($vars);
}
# else needs a db lookup to see if param exists:
else {
return $self->_db_lookup($vars);
}
}
# ------------------------------------------------------------------------------
sub get_email_addresses : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $param = $self->query->Vars(); # $self->debug($param);
my $addr = $self->model('Ajax')->get_email_addresses($param);
my $xml = $self->_format_as_xml({ type => 'email_addresses', data => $addr });
# set header type to xml:
$self->header_props(-type=>'text/xml');
return $xml;
}
# ------------------------------------------------------------------------------
sub seek_new_messages : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $tt = $self->query->param('tt'); # warn Dumper $tt;
return undef if grep $tt =~ /$_\.tt\Z/, qw(hello user_messages); # can already see them!!
my $username = $self->authen->username || return undef; # maybe not logged in
my $i = $self->model('User')->any_new_messages($username) || return undef;
return $self->tt_process('user/new_msg_alert.tt', { count => $i });
}
# ------------------------------------------------------------------------------
sub get_referral_sources : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
# string submitted from new clinician (as 'hospital') or new request (as 'location'):
my $location
= $self->query->param('location') || $self->query->param('hospital');
# hospital (optional):
my $hospital = $self->query->param('hospital') || 0;
# active only (optional):
my $active_only = $self->query->param('is_active') || 0;
return unless $location &&
length $location >= $self->cfg('settings')->{min_char_length};
my %args = (
location => $location,
active_only => $active_only,
# only want hospitals for new clinician entry
hospitals_only => $hospital,
);
my $sources = $self->model('Ajax')->get_referral_sources(\%args);
my $xml = $self->_format_as_xml({ type => 'sources', data => $sources });
# set header type to xml:
$self->header_props(-type=>'text/xml');
return $xml;
}
# ------------------------------------------------------------------------------
sub get_parent_organisations : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $organisation = $self->query->param('organisation');
return unless $organisation &&
length $organisation >= $self->cfg('settings')->{min_char_length};
my %args = (
organisation => $organisation,
);
my $organisations = $self->model('Ajax')->get_parent_organisations(\%args);
my $xml = $self->_format_as_xml({ type => 'parent_orgs', data => $organisations });
# set header type to xml:
$self->header_props(-type=>'text/xml');
return $xml;
}
# ------------------------------------------------------------------------------
sub get_practice_from_gp : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $gp_name = $self->query->param('name');
$gp_name =~ s/\,(\s+)?/ /g; # remove comma
return unless $gp_name && length $gp_name >= 3;
my $practices = $self->model('Ajax')->get_practice_by_practitioner($gp_name);
my $xml = $self->_format_as_xml({ type => 'practices', data => $practices });
# set header type to xml:
$self->header_props(-type=>'text/xml');
return $xml;
}
# ------------------------------------------------------------------------------
sub get_clinicians : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $param = $self->query->Vars(); # $self->debug($param);
# must be integer only:
return unless $param->{source_id} && $param->{source_id} =~ /^\d+$/;
my $referrers
= $self->model('Ajax')->get_clinicians_for_source($param);
my $xml = $self->_format_as_xml({ type => 'clinicians', data => $referrers });
# set header type to xml:
$self->header_props(-type=>'text/xml');
return $xml;
}
# ------------------------------------------------------------------------------
sub load_template : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
$self->query->param('template')
# TODO: this will load in iframe - might be better to just die():
|| return $self->error(q!no such query param 'template'!);
# create unique filename (username + time-based entity):
my $filename = join '.',
$self->authen->username, ( unpack "H*", pack "NS", time, $$ );
my $temp_file = join '/', $self->cfg->{tmpdir}, $filename; # warn Dumper $temp_file;
my $fh = $self->query->upload('template'); # CGI method
{ # create temp file:
my $buffer;
while ( read( $fh, $buffer, 16_384 ) ) {
io($temp_file)->append($buffer);
}
close $fh;
}
# read temp file into $contents:
my $contents = io($temp_file)->slurp;
# delete temp file:
io($temp_file)->unlink;
=begin # causes circular ref - why ??
$self->tt_params(
file_contents => $contents,
);
my $tt = $self->tt_process('result/template.tt');
# $self->debug($contents); $self->debug(${$tt}); # both same, so return $tt
return $tt;
=cut
return $contents;
}
# ------------------------------------------------------------------------------
sub add_word : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
# capture word and force lowercase:
my $word = lc $self->param('id'); # warn $word;
my $speller = $self->speller();
my $result = $speller->add_to_personal($word) ? 'OK' : $speller->errstr;
$speller->save_all_word_lists;
return $self->tt_process('report/speller_update.tt', { result => $result });
}
# ------------------------------------------------------------------------------
sub check_date_valid : Runmode { # jQuery validation ajax call
my $self = shift; $self->_debug_path($self->get_current_runmode);
# key is field name, which is variable (eg start_date => 1/1/1900)
my ($v, $date) = $self->query->Vars(); # warn Dumper [$v,$date];
return LIMS::Local::Utils::check_date($date); # true if valid date
}
# ------------------------------------------------------------------------------
# jQuery validationEngine.js ajax call - returns JSON:
sub jquery_check_value : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars(); # warn Dumper $vars;
my %validation_method = ( # methods must return true if valid:
first_appointment => sub { LIMS::Local::Utils::check_date(@_) },
diagnosed => sub { LIMS::Local::Utils::check_date(@_) },
deceased => sub { LIMS::Local::Utils::check_date(@_) },
mdt_date => sub { LIMS::Local::Utils::check_date(@_) },
palliative_care => sub { LIMS::Local::Utils::check_date(@_) },
post_code => sub { LIMS::Local::Utils::format_postcode(@_) },
);
my $value = $vars->{validateValue}; # warn $value;
my $field = $vars->{validateId};
my $validator = $validation_method{$field};
my $result = &$validator($value) ? 'true' : 'false';
# formats json return & resets header_type to text/html:
my $json = $self->_format_json($result, $vars); # warn Dumper $json;
return $json;
}
# ------------------------------------------------------------------------------
sub jquery_within_range : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars(); # warn Dumper $vars;
my ($field) = $vars->{validateId} =~ /\w+?_(.*)/; # warn $vars->{validateId};
my $value = $vars->{validateValue}; # warn Dumper [$field,$value];
my $d = $self->model('HMRN')->get_defaults_and_ranges($field); # warn Dumper $d;
my $result = (
( $value >= $d->{min_value} && $value <= $d->{max_value} )
|| grep $value == $_, ($d->{not_stated}, $d->{not_done})
) ? 'true' : 'false';
# formats json return & resets header_type to text/html:
my $json = $self->_format_json($result, $vars); # warn Dumper $json;
return $json;
}
# ------------------------------------------------------------------------------
# jQuery validationEngine.js ajax call for 'always pass' fields - returns JSON:
sub jquery_dummy_pass : Runmode {
my $self = shift; $self->_debug_path($self->get_current_runmode);
my $vars = $self->query->Vars();
return $self->_format_json('true', $vars);
}
# ------------------------------------------------------------------------------
sub _format_json {
my ($self, $result, $vars) = @_; $self->_debug_path();
my $err = $vars->{validateError}; # warn $err;
my $field = $vars->{validateId}; # warn $id;
my $json = $self->json_body({ jsonValidateReturn => [$field, $err, $result] } );
# validateEngine.js expects plain content from php, not json:
$self->header_add( type => 'text/html' ); # warn Dumper $json;
return $json;
}
# ------------------------------------------------------------------------------
sub _db_lookup {
my $self = shift; $self->_debug_path();
my $vars = shift; # $self->debug($vars);
my ($field_name, $val) = %$vars;
# create lookup table for $field_name to get class/method:
# if field_name is unique in db (eg group_detail), hash value
# is scalar (class/method), but for ambiguous field_names (eg name),
# hash value is arrayref of field_name & class/method:
my %index = (
# field_name LIMS::DB::class & ::Manager method
audit_options => [ qw(description audit_request_option) ],
consent_label => 'consent_option',
consent_name => 'consent_option',
data_type => [ qw(description lab_test_result_data_type) ],
detail => 'lab_section_status_option',
# diagnostic_category => [ qw(description diagnostic_categories) ], # plurals !!
diagnosis_change => [ qw(option_name diagnosis_change_option) ],
error_code => [ qw(code error_code) ],
# field_label => 'lab_test', # uses 3-col key so can't test
function_detail => 'user_function',
function_name => 'user_function',
group_detail => 'user_group',
group_label => 'user_group',
group_name => 'user_group',
location_name => 'user_location',
national_code => 'referrer',
new_diagnosis => [ qw(name diagnosis) ], # non-unique col name
option_label => 'additional_option',
option_name => 'additional_option',
organisation_code => 'referral_source',
parent_code => 'parent_organisation',
parent_description => [ qw(description parent_organisation) ],
ref_source_name => [ qw(display_name referral_source) ],
sample_code => 'specimen',
# screen_description => [ qw(description screen) ], # uses 2-col key so can't test
section_name => 'lab_section',
test_status_option => [ qw( description lab_test_status_option ) ],
trial_name => 'clinical_trial',
username => 'user',
);
my $class_name = $index{$field_name} # or die otherwise error msg ends up in span.ajax_error in tmpl
|| die "no field_name '$field_name' found in Ajax::do_ajax() index table";
# args for check_exists():
my %args = (
vars => $vars,
func => $class_name,
);
my $i = $self->model('Ajax')->check_exists(\%args); # DEBUG $i;
my $msg = $self->err_msg('not_unique');
return $i ? $self->_format_as_dfv($msg) : '';
}
# ------------------------------------------------------------------------------
sub _format_as_dfv {
my $self = shift; $self->_debug_path();
my $str = shift;
my $tmpl = $self->cfg->{dfv_defaults}->{msgs}->{format};
return sprintf $tmpl, $str;
}
# ------------------------------------------------------------------------------
sub _format_as_xml {
my $self = shift; $self->_debug_path();
my $args = shift; # warn Dumper $args;
my $data = $args->{data};
my $type = $args->{type};
my $q = $self->query;
my @rs;
my $html = q!<rs id="%s" info="%s">%s</rs>!;
# need to escape any chars like '&' ($q->escapeHTML) or output silently fails:
if ( $type eq 'clinicians') {
@rs = map {
sprintf $html,
$_->referrer->national_code,
$q->escapeHTML($_->hospital_department->display_name),
$_->referrer->name,
} @$data;
# add default unknown clinician code:
my $referral_type = $self->model('Referrer')->get_referral_type('clinician');
push @rs, sprintf $html,
$referral_type->default_unknown, 'Unknown department', 'Unknown clinician';
}
elsif ( $type eq 'sources') {
@rs = map {
sprintf $html,
$_->id,
$_->organisation_code,
$q->escapeHTML($_->display_name),
} @$data;
}
elsif ( $type eq 'parent_orgs') {
@rs = map {
sprintf $html,
$_->id,
$_->parent_code,
$q->escapeHTML($_->description),
} @$data;
}
elsif ( $type eq 'email_addresses') {
@rs = map {
sprintf $html,
$_->address,
'', # info - don't need it
$q->escapeHTML($_->address),
} @$data;
}
elsif ( $type eq 'practices') {
@rs = map {
my $display = sprintf '%s, %s [%s]', @$_;
sprintf $html,
'', # don't need these
'',
$q->escapeHTML($display),
} @$data;
}
my $results =
sprintf q!<?xml version="1.0" encoding="utf-8" ?><results>%s</results>!,
( join '', @rs );
return $results;
}
# ------------------------------------------------------------------------------
sub _validate_param {
my $self = shift; $self->_debug_path();
my $vars = shift; # $self->debug($vars);
# unit number:
if ( $vars->{unit_number} ) {
my %data = map {
$_ => $vars->{$_};
} qw(last_name first_name unit_number);
$data{nhs_number} = $vars->{is_valid_nhsno};
$data{dob} = join '-', map $vars->{'is_valid_'.$_}, qw(year month day);
my $valid = $self->model('PatientCase')->validate_patient_case(\%data);
}
# date fields (request_date or dob):
elsif (grep $_ =~ /^is_valid_date/, keys %$vars) {
my %date; # capture is_valid_date_* params, eg is_valid_date_dob_day, etc
while ( my ($param_name, $val) = each %$vars ) {
map {
$date{$_} = $val if $param_name =~ /$_/; # eg is_valid_date_dob_year =~ /year/
} qw(day month year);
} # warn Dumper \%date;
return $self->_validate_date_fields(\%date);
}
# request number:
elsif ( $vars->{is_valid_request_no} ) {
my $constraints = $self->validate('get_request_number_constraints');
my $messages = $self->validate('get_request_number_messages');
my $field_name = 'is_valid_request_no';
my $dfv_profile = {
required => $field_name,
constraint_methods => {
$field_name => $constraints,
},
msgs => $messages,
};
my $result = $self->_dfv_check($dfv_profile);
return $result;
}
# specimen:
elsif ( $vars->{is_valid_specimen} ) {
my $constraints = $self->validate('get_specimen_constraints');
my $field_name = 'is_valid_specimen';
my $dfv_profile = {
required => $field_name,
constraint_methods => {
$field_name => $constraints,
},
};
my $result = $self->_dfv_check($dfv_profile);
return $result;
}
# nhs number:
elsif ( defined $vars->{is_valid_nhsno} ) {
if ( my $nhs_no = $vars->{is_valid_nhsno} ) {
my $valid_nhs_no = LIMS::Local::Utils::check_nhsno( $nhs_no );
my $msg = $self->err_msg('invalid_entry');
return ! $valid_nhs_no ? $self->_format_as_dfv($msg) : 'OK';
}
}
# nhs number unique (and valid):
elsif ( defined $vars->{is_valid_and_unique_nhsno} ) {
if ( my $nhs_no = $vars->{is_valid_and_unique_nhsno} ) {
# returns true value if valid:
my $valid_nhs_no = LIMS::Local::Utils::check_nhsno( $nhs_no );
# returns true value if already exists:
my $nhs_number_exists
= $self->model('Patient')->check_patient_nhs_number_count($nhs_no);
if (! $valid_nhs_no) {
my $msg = $self->err_msg('invalid_entry');
return $self->_format_as_dfv($msg);
}
elsif ($nhs_number_exists ) {
my $msg = $self->err_msg('not_unique');
return $self->_format_as_dfv($msg);
}
else {
return 'OK';
}
}
}
# no idea what to do with it:
else {
return 'unknown input';
}
}
# ------------------------------------------------------------------------------
sub _validate_date_fields {
my $self = shift; $self->_debug_path();
my $date = shift; # hashref of year, month, day
return 'dd-mm-yyyy' if grep ! $date->{$_}, qw(year month day); # require all 3
{ # require 4-digit year:
my $msg = $self->err_msg('year_digits');
return $self->_format_as_dfv($msg) if length $date->{year} != 4;
}
{ # check date is valid:
my $result = FormValidator::Simple->check(
$date => [
{ date => [ qw(year month day) ] } => [ 'DATE' ],
]
);
if ($result->has_error) {
my $msg = $self->err_msg('invalid_date');
return $self->_format_as_dfv($msg);
}
}
{ # OK, now test for date in future:
my $dt = LIMS::Local::Utils::to_datetime($date); # warn Dumper $dt->datetime;
my $msg = $self->err_msg('future_date');
return $dt > DateTime->now ? $self->_format_as_dfv($msg) : 'OK';
}
}
# ------------------------------------------------------------------------------
# uses Data::FormValidator::check directly:
sub _dfv_check {
my $self = shift; $self->_debug_path();
my $profile = shift;
my $dfv_defaults = $self->cfg('dfv_defaults');
my $field_name = $profile->{required};
my $dfv = Data::FormValidator->new({}, $dfv_defaults)
->check($self->query, $profile); # $self->debug($dfv->msgs);
return $dfv->has_invalid ? $dfv->msgs->{'error_'.$field_name} : 'OK';
}
=begin # done in Request controller now:
# ------------------------------------------------------------------------------
sub get_practitioners {
my %args = (
object_class => 'GeneralPractitioner',
args_for_search => {
query => [
practice_code => $location->organisation_code,
name => { like => $self->query->param('referrer_name') . '%'},
],
sort_by => 'name',
},
);
my $referrers = $self->model('Base')->get_objects(\%args);
@rs = map {
sprintf q!<rs id="%s" info="%s">%s</rs>!,
$_->national_code,
$_->practice_code,
$_->name,
} @$referrers;
push @rs, q!<rs id="G9999998" info="">[ Unlisted GP ]</rs>!;
}
}
=cut
=begin
# ------------------------------------------------------------------------------
sub _get_referrers : Runmode {
my $self = shift;
my $source_id = $self->query->param('source_id');
# must be integer only:
return unless $source_id && $source_id =~ /^\d+$/;
my $location = $self->model('ReferralSource')->get_referral_source($source_id);
my %args;
if ( $location->location_type eq 'hospital' ) {
my @organisation_code_chars = split '', $location->organisation_code;
# take 1st 3 chars:
my $region_prefix = join '', @organisation_code_chars[0..2];
$args{args_for_search} = {
query => [ region_prefix => { like => $region_prefix . '%' } ],
with_objects => [ qw(clinician hospital_department) ],
sort_by => [ qw(clinician.surname clinician.initials) ],
};
$args{object_class} = 'ClinicianOrganisation';
}
else {
$args{args_for_search} = {
query => [ practice_code => $location->organisation_code ],
sort_by => 'name',
};
$args{object_class} = 'GeneralPractitioner';
}
my $referrers = $self->model('Base')->get_objects(\%args);
my $tmpl = $args{object_class} eq 'ClinicianOrganisation' ?
'clinicians_list' : 'practitioners_list';
$self->tt_process('referrer/'.$tmpl.'.tt', { referrers => $referrers });
}
=cut
1;
