• Files
• Commits
• Log
• Graph
• Stats

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;
	
	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 get_referral_sources : Runmode {
    my $self = shift;

	# 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;
	
    return unless $location &&
		length $location >= $self->cfg('settings')->{min_char_length};

    my %args = (
		location => $location,
		# 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;
	
    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_clinicians : Runmode {
    my $self = shift;

	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 result_template : Runmode {
    my $self = shift; $self->_debug_path($self->get_current_runmode);   

    $self->query->param('report_template')
	# TODO: this will load in iframe - might be better to just die():
    || return $self->error('no such query param report_template');

    my $fh = $self->query->upload('report_template'); # CGI method

    my $temp_file = $self->cfg->{path_to_app_root} . '/static/temp.txt';
       
    { # write to file:
        # Write contents to temp file:
        my $buffer;
        while ( read( $fh, $buffer, 16_384 ) ) {
            io($temp_file)->append($buffer);
        } 
    }
    
    my $contents = io($temp_file)->slurp;

    io($temp_file)->unlink; # or it gets appended to on each successive upload

    $self->tt_params(
        file_contents => $contents,
    );
    
    return $self->tt_process('result/template.tt');
}

# ------------------------------------------------------------------------------
sub add_word : Runmode {
	my $self = shift;
	
	# 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_date_valid : Runmode { 
	my $self = shift; $self->_debug_path($self->get_current_runmode);
	
	# key is field name, which is variable (eg start_date => 1/1/1900)
	my $vars = $self->query->Vars(); # warn Dumper $vars; 
	
	my $date = $vars->{validateValue}; # warn $date;
	
	my $result = LIMS::Local::Utils::check_date($date) # true if valid date
		? 'true' 
		: 'false';
	
	# formats json return & resets header_type to text/html:
	my $json = $self->_format_json($result, $vars); # warn Dumper $json; 
	return $json;
}

# ------------------------------------------------------------------------------
sub _format_json {
	my ($self, $result, $vars) = @_;
	
	my $err = $vars->{validateError}; # warn $err;
	my $id  = $vars->{validateId};    # warn $id;

	my $json = $self->json_body({ jsonValidateReturn => [$id, $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;
    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',
        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) ],
        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;
	my $str  = shift;

	my $tmpl = $self->cfg->{dfv_defaults}->{msgs}->{format};
	
	return sprintf $tmpl, $str;
}

# ------------------------------------------------------------------------------
sub _format_as_xml {
    my $self = shift;
    my $args = shift;

	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;
	}
	
    my $results =
        sprintf q!<?xml version="1.0" encoding="utf-8" ?><results>%s</results>!,
			( join '', @rs );

    return $results;
}

# ------------------------------------------------------------------------------
sub _validate_param {
    my $self = shift;
    my $vars = shift; # $self->debug($vars);
	
    # $vars->{unit_number} = validate patient details:
    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);
    }

    # if date, needs to be valid & in past:
    elsif (grep $_ =~ /^is_valid_(day|month|year)/, keys %$vars) {
        # using onChange on each element, so need all 3 to test:
        return 'dd-mm-yyyy' if grep ! $self->query->param('is_valid_'.$_),
            qw(day month year);
        
		{ # require 4-digit year:
			my $msg = $self->err_msg('year_digits');
			return $self->_format_as_dfv($msg)
				if length $vars->{is_valid_year} != 4;
		}		
		{ # check date is valid:
			my $result = FormValidator::Simple->check(
				$self->query => [
					{ date => [ qw(is_valid_year is_valid_month is_valid_day) ] }
						=> [ 'DATE' ]
				]
			);

			my $msg = $self->err_msg('invalid_date');
			return $self->_format_as_dfv($msg) if $result->has_error;
		}
		{ # OK, now test for date in future:			
			my $dt = DateTime->new(
				year  => $self->query->param('is_valid_year'),
				month => $self->query->param('is_valid_month'),
				day   => $self->query->param('is_valid_day'),
			); # warn Dumper $dt;
	
			my $msg = $self->err_msg('future_date');
			return $dt > DateTime->now ? $self->_format_as_dfv($msg) : 'OK';
		}
    }

	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;
	}

    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;
	}

    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';
		}
    }

    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';
			}
		}
    }

    else {
        return 'unknown input';
    }

}

# ------------------------------------------------------------------------------
# uses Data::FormValidator::check directly:
sub _dfv_check {
    my $self    = shift;
    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;