package RequestForm; =begin urls: '/bcr_abl' => 'BCR-ABL monitoring' '/' => standard HMDS request form =cut use Dancer2; use RequestForm::DB; use RequestForm::PDF; use RequestForm::Class; use RequestForm::BarCode; use RequestForm::Validate; use RequestForm::Validate::Ajax; use FindBin qw($RealBin); # warn $RealBin; use Data::Dumper; use Path::Tiny; use DateTime; use IO::All; use Git; my $repo = path($RealBin, '..', '.git')->realpath; # warn $repo; use constant REPO => Git->repository( Directory => $repo ); our $VERSION = _app_version(); # warn $VERSION; sub _app_version { REPO->command_oneline('rev-list', 'HEAD', '--count') } my $debug = path($RealBin, '..', 'debug.txt')->realpath; use constant MIN_DELTA => 90; # min days between requests without needing reason set auto_page => 1; # don't need routes for static tt returns (eg bcr-abl.tt) # disable sql_trace if test script (needs explicit export SQL_TRACE=1 if req'd): set enable_sql_trace => 0 if $ENV{HARNESS_VERSION}; # need to catch "Exception caught in 'core.app.before_request' filter: Hook error" # for 500.tt handling - doesn't currently: #hook init_error => sub { warn 'here' }; #hook before_error => sub { warn 'here' }; #hook after_error => sub { warn 'here' }; #hook on_route_exception => sub { warn 'here' }; hook before => sub { # enable querylogger 1st if configured: $ENV{SQL_TRACE} = setting('enable_sql_trace'); # convert 'u' & 'c' form params back to original username & centre -> session: initialise_session() if ! grep session->read($_), qw(username centre); $Local::QueryLogger::CurrentUsername = session->read('username'); my $vars = params; # p('environment:' . dancer_app->environment); p $vars if dancer_app->environment eq 'development'; }; hook before_template => sub { # don't use 'vars' in here or custom error handling breaks (ie 500.tt) # does not need session, vars, params, request or settings (automatic) my $tokens = shift; # $tokens->{env} = p %ENV; $tokens->{app_version} = $VERSION; { # referral source autosuggest: my $uri = uri_for('/ajax/autosuggest_location'); # shouldn't need ajax prefix $tokens->{uri_for_autosuggest_location} = $uri; } { # nhs number ajax validation: my $uri = uri_for('/ajax/validate_nhs_number'); # shouldn't need ajax prefix $tokens->{uri_for_nhs_number_validation} = $uri; } }; # default Dancer2 app index page: get '/index' => sub { template 'index', {}, { layout => 'index' } }; # default route to auto-load initial search form: get '/' => sub { forward '/search_form' }; # re-submitted search form - redirect to search form page: get '/search' => sub { forward '/search_form' }; # submitted an nhs number to search for: post '/search' => sub { my $params = params; # p $params; # $validation = hashref of keys: pass (success) or errs (failed): my $dfv = RequestForm::Validate->new(session => session, settings => config); my $validation = $dfv->validate_nhs_number($params); # p $validation; # href if ( my $errs = $validation->{errs} ) { # return errs to input form: my $tmpl = $params->{bcr_abl_req} ? 'bcr_abl' : 'search_form'; # warn $tmpl; return template $tmpl, { errs => $errs }; } my $nhs_number = $validation->{data}->{nhs_number}; # p $nhs_number; my $data = model()->search_patient($nhs_number) || {}; # p $data; get_cml_data_for($nhs_number) if $params->{bcr_abl_req}; # defines vars cml_data & min_delta if ( my $dob = $data->{dob} ) { # add year, month (as int) & day elements: @{$data}{qw/year month day/} = map { int($_) } split '-', $dob; # eg 1966, 5, 2 } # put $data into $params to automatically update params() for tt; grep %data # keys so we don't clobber $vars->{nhsno} if search_patient() returns empty: $params->{$_} = $data->{$_} for grep $data->{$_}, keys %$data; var found_patient => ( keys %$data ? 'yes' : 'no' ); # will be true if patient found in db template 'request_form'; }; # submitted completed request form: post '/' => sub { my $params = params; # warn Dumper $params; my @args = ( settings => config, session => session ); my $validator = RequestForm::Validate->new(@args); # $result = hashref of keys: pass (1 or 0), and data (pass) or errs (fail): my $result = $validator->validate_form($params); # p $result; # href # if $result 'pass' is true, save params to db & return PDF to print: if ( $result->{pass} ) { # no validation errors my $data = $result->{data}; # p $data; # ie $dfv->valid my $pds = $result->{pds_result}; # p $pds; # generate_pdf param created in tt if PDS returns SMSP-0000 or _skip_pds # param submitted: unless ( $params->{generate_pdf} ) { return template 'request_form', { pds => $pds }; } { # generate unique ref for db: my $unique_id = _make_unique_id($data); # warn Dumper $unique_id; $data->{id} = $unique_id; } # add user.id from session: $data->{user_id} = session->read('userId'); # save data to db: model()->save_params($data); model()->bcr_abl_monitoring($data) if $params->{bcr_abl_req}; { # generate barcode for printed form: my $id = $data->{id}; my $o = RequestForm::BarCode->new(reference => $id); $data->{barcode} = $o->create_2d_barcode; # returns html table $data->{qrcode} = $o->create_3d_barcode; # returns html table } { # set headers & return PDF form for user to print & send: my $content = template 'pdf_form', { data => $data }, { layout => 'pdf' }; # override default 'main' layout return $content if dancer_app->environment eq 'development'; my $pdf = RequestForm::PDF->new(content => $content)->render; header 'Content-Type' => 'application/pdf'; return $pdf; } } # validation failed (ie 'pass' var is false): elsif ( my $errs = $result->{errs} ) { # return errs to input form: if ( $params->{bcr_abl_req} ) { # get nhs_number from params ($result->{data} = undef as validation failed): my $nhs_number = param('nhs_number'); # warn $nhs_number; get_cml_data_for($nhs_number); # defines vars cml_data & min_delta } return template 'request_form', { errs => $errs }; } # should never get here: else { send_error( 'validation did not return expected data structure', 500 ); } }; get '/gitlog' => sub { my @args = ( '--pretty=format:"%ad :: %s"', '--date=relative' ); my @revs = REPO->command('log', @args ); template 'gitlog', { log => \@revs }; }; # /test/error: prefix '/test' => sub { get '/error' => sub { send_error('test error message') }; }; # converts 'u' & 'c' token form params back to original username & centre: sub initialise_session { my $key = LIMS::Local::Utils::today->ymd; # so url only valid on same day my $vars = params; # p $vars; # if requested without passing 'c' & 'u' params: if ( grep { ! param $_ } qw(c u) ) { # warn 'here'; send_error( # terminate with complaint unless development env: 'some required params are missing, access is via HILIS only', 403 ) unless setting('environment'); # supply default c & u params: my $enc = sub { LIMS::Local::Utils::encrypt(shift, $key) }; @{$vars}{'c','u'} = ( &$enc('leeds'), &$enc('devel') ); # p $vars; } { # centre: my $centre = LIMS::Local::Utils::decrypt($vars->{c}, $key); session centre => $centre; # p $centre; } { # username & userId: my $username = LIMS::Local::Utils::decrypt($vars->{u}, $key); session username => $username; # p $username; my $user_id = model()->get_userid($username); session userId => $user_id; } # p session; } sub model { if ( ! var 'db' ) { # ie if >1 call per request cycle my $centre = session->read('centre'); # p $centre; var db => RequestForm::DB->new(dbname => $centre); } return var 'db'; } sub get_cml_data_for { my $nhs_number = shift; my $data = model()->get_previous_cml_monitoring($nhs_number); var cml_data => $data; var min_delta => MIN_DELTA; # min days between requests } sub _debug { local $_ = shift; io($debug)->append(Dumper $_); } sub _make_unique_id { my $vars = shift; my $now = DateTime->now->epoch; my $first_name = $vars->{first_name}; my $last_name = $vars->{last_name}; # remove non-alphanumeric chars (aposptophe, hyphen, etc): $last_name =~ s/\W//g; # warn $last_name; # id = datetime epoch + last_name + first initial: my $id = $now . uc( $last_name . substr($first_name, 0, 1) ); return $id; } sub _build_db { my $centre = session->read('centre'); # p $centre; my $db = RequestForm::DB->new(dbname => $centre); return $db; } true;