package RequestForm::Validate;
# hides DFV internals from caller - returns hashref with keys depending on pass/fail:
# success: pass => 1 + optional data hashref
# failure: pass => 0 + error messages
use RequestForm::Class; # provides Moo, Local::MooX::Types & LIMS::Local::Debug::p
with 'RequestForm::Role::PDS';
has settings => ( is => 'ro', isa => HashReference, required => 1 );
has session => ( is => 'ro', isa => Object, required => 1 );
use Data::FormValidator;
use Data::FormValidator::Constraints qw(:closures);
use LIMS::Local::Utils;
sub validate_form { # returns href, keys = pass (1 or 0) & data OR errs
my $self = shift;
my $vars = shift; # p $vars;
my $defaults = _dfv_defaults();
my $dfv = Data::FormValidator->new({}, $defaults);
my $dfv_profile = $self->_dfv_profile($vars); # p $dfv_profile;
my $results = $dfv->check($vars, $dfv_profile); # p $results;
my %h = ( pass => $results->success ); # true if passed
if ( $results->has_invalid or $results->has_missing ) { # p $results;
$h{errs} = $results->msgs;
}
else {
my $data = $results->valid; # p $data;
# create dob as DateTime from day, month & year vals & delete original vals:
my @date_fields = qw(year month day);
# send $data to_datetime() - method needs a day, month & year hashref entry
$data->{dob} = LIMS::Local::Utils::to_datetime($data); # p $data->{dob};
delete $data->{$_} for @date_fields; # p $data;
$h{data} = $data;
# get result of PDS lookup (unless set to skip):
unless ( $vars->{_skip_pds} ) {
$h{pds_result} = $self->patient_demographic_service($data);
}
}
return \%h;
}
sub validate_nhs_number { # returns hashref containing errs (fail) or pass keys
my $self = shift;
my $vars = shift;
my $defaults = _dfv_defaults();
my $dfv = Data::FormValidator->new({}, $defaults);
my $dfv_profile = $self->_nhs_number_profile();
my $results = $dfv->check($vars, $dfv_profile); # p $results;
return ( $results->has_invalid or $results->has_missing )
? { pass => 0, errs => $results->msgs }
: { pass => 1, data => scalar ($results->valid) }; # want valid() as hashref
}
sub _nhs_number_profile {
my $self = shift;
return {
required => 'nhs_number',
constraint_methods => {
nhs_number => _check_nhs_number(),
},
field_filters => {
nhs_number => 'digit', # remove spaces & non-digits
},
}
}
sub _dfv_profile {
my ($self, $vars) = @_; # p $vars;
my $validation_params = $self->settings->{validation};
my $required = $validation_params->{required};
push @$required, $vars->{bcr_abl_req} # different required params:
? qw(diagnosis_date phase line_num)
: qw(clinical_details);
my $optional = $validation_params->{optional};
push @$optional, $vars->{bcr_abl_req}
? qw(other_tx)
: qw();
my %profile = (
required => $required,
optional => $optional,
field_filters => {
last_name => 'uc',
first_name => 'lc',
location => 'lc',
referrer => 'lc',
nhs_number => 'digit', # remove spaces & non-digits
month => sub { # ensure zero-padded:
my $var = shift;
# check numeric or get fatal err if var = 'month' eg M$BDB
return ($var =~ /\d+/)
? sprintf '%02d', $var
: $var;
},
},
dependencies => {
reason_required => 'reason', # cml monitoring request < min duration
},
constraint_methods => {
nhs_number => _check_nhs_number(),
year => _check_date(), # or any required date field
},
msgs => {
constraints => { },
},
);
# one of treatment_date or first_line_date if bcr-abl request:
$profile{require_some} = { # require one from this group
treatment => [ 1, qw(treatment_date first_line_date) ],
} if $vars->{bcr_abl_req};
return \%profile;
}
sub _dfv_defaults {
return {
missing_optional_valid => 1,
filters => 'trim', # trims white space either side of field param
msgs => {
any_errors => 'dfv_errors', # default err__
format => '<div class="dfv-err text-lowercase">%s</div>',
},
};
}
sub _check_nhs_number {
return sub {
my $dfv = shift; # p $dfv;
my $nhs_number = shift || return 0; # p 'NHSNo:'.$nhs_number;
# check_nhsno() return true if valid:
my $is_valid = LIMS::Local::Utils::check_nhsno( $nhs_number ); # p $is_valid;
return $is_valid;
};
}
sub _check_date {
return sub {
my $dfv = shift; # p $dfv;
my $data = $dfv->get_filtered_data; # p $data;
return 0 if grep {! $data->{$_} } qw(day month year);
my $date = join '/', @{$data}{qw/day month year/}; # p $date;
my $is_valid = LIMS::Local::Utils::check_date($date); # p $is_valid;
return $is_valid;
};
}
1;