• Files
• Commits
• Log
• Graph
• Stats

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} and not $ENV{SQL_TRACE};

# 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');

    # initialise new session if query params 'c' & 'u' supplied (new url request):
    initialise_session() if grep query_parameters->get($_), qw(c u);
    # initialise new session if we don't already have 'centre' & 'username' eg dev server:
    initialise_session() if ! grep session->read($_), qw(username centre);
    # supply curent username to query logger:
    $Local::QueryLogger::CurrentUsername = session->read('username');

#    my $path = request->path; # debug $path;
#    my $static = $path =~ m{\.html$|^/(javascripts|css|fonts|js|svg|image)/};
#    debug "Static URL got past proxy server: $path\n" if $static;

    my $vars = params; # warn 'environment:' . dancer_app->environment;
    p $vars if 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 autocomplete:
        my $uri = uri_for('/ajax/jquery_location'); # shouldn't need ajax prefix
        $tokens->{uri_for_autocomplete_location} = $uri;
    }
    { # referrer autocomplete:
        my $uri = uri_for('/ajax/jquery_referrer'); # shouldn't need ajax prefix
        $tokens->{uri_for_autocomplete_referrer} = $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);

    { # required fields from validation profile:
        my $fields = $dfv->required_fields($params); # p $fields; # href
        var required_fields => $fields;
    }
    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 ); # warn Dumper \@args;
    my $validator = RequestForm::Validate->new(@args);

    { # required fields from validation profile in case we go back to request form:
        my $fields = $validator->required_fields($params); # p $fields; # href
        var required_fields => $fields;
    }

    # $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:
            my $user = session->read('user')
                or send_error( 'no user retrieved from session' );
            $data->{user_id} = $user->{id};
        }
        # 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 grep app->environment eq $_, qw(development test);

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

# initialise_session() called when a) no session exists, or b) have 'c' and/or 'u'
# query params; converts 'u' & 'c' 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;

    # must always supply either session 'centre' or 'c' param, unless development
    # server 1st request:
    unless ($vars->{c}) { # warn 'here'; # if no session, and no 'c' query param
        # to get here means either original url was invalid or development server:
        send_error( # terminate with complaint
            'access is via HILIS "home" page only', 403
         ) unless app->environment eq 'development';
        # set centre = leeds for dev:
        $vars->{c} = LIMS::Local::Utils::encrypt('leeds', $key)
        || send_error( q!cannot encrypt encoded string "leeds"! ); # unlikely to fail
    }
    # allowed to have empty 'u' param if request form accessed outside HILIS
    unless ($vars->{u}) { # warn 'here'; # if no session and no 'u' query param
        # supply 'unknown' as user param:
        $vars->{u} = LIMS::Local::Utils::encrypt('unknown', $key)
        || send_error( q!cannot encrypt encoded string "unknown"! ); # unlikely to fail
    } # p $vars;

    { # centre & remote_addr:
        my $centre = LIMS::Local::Utils::decrypt($vars->{c}, $key)
        || send_error( qq!cannot decrypt encoded string "$vars->{c}"! );
        session ip_addr => request->remote_address; # for non-logged-in users
        session centre  => $centre; # p $centre;
    }
    { # username & userId:
        my $username = LIMS::Local::Utils::decrypt($vars->{u}, $key)
        || send_error( qq!cannot decrypt encoded string "$vars->{u}"! );
        session username => $username; # p $username;

        my $user = model()->get_user($username); # p $user;
        session user => $user;
    } # p session;
}

# model is a RequestForm::DB object, stored in D2 var 'db':
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;