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

set auto_page => 1; # don't need routes for static tt returns (eg bcr-abl.tt)

hook before => sub {
    # convert 'u' & 'c' form params back to original username & centre -> session:
    initialise_session() if ! grep session->read($_), qw(username centre);

    my $vars = params; # p('environment:' . dancer_app->environment);
    p $vars if dancer_app->environment eq 'development';
    var app_version => $VERSION;
};

hook before_template => sub {
    # does not need session, vars, params, request or settings (automatic)
    my $tokens = shift; # $tokens->{env} = p %ENV;

    { # 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;

    if ($params->{bcr_abl_req}) {
        my $data = model()->get_previous_cml_monitoring($nhs_number);
        var cml_data  => $data;
        var min_delta => 90; # min days between requests
    }
    
    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; # p $vars;

    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); # p $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);

        { # 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 ('pass' var is false):    
    elsif ( my $errs = $result->{errs} ) { # return errs to input form: 
        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 };
};

# 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('unknown') ); # 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 _debug {
    local $_ = shift;
    io($debug)->append(Dumper $_);
}

sub _make_unique_id {
    my $vars = shift;
    my $now = DateTime->now->epoch;
    
    # id = datetime epoch + last_name + first initial:
    my $id = $now . uc( $vars->{last_name} . substr($vars->{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;