• Files
• Commits
• Log
• Graph
• Stats

#!/usr/bin/env perl
 
#-------------------------------------------------------------------------------
# request-for-change web form
# tkn contains encrypted username in initial request from HILIS:
# script/cgi/rfc.cgi?tkn=53616c7465645f5f20173747fa72204e6e03635dcfa0ffb9
#-------------------------------------------------------------------------------

package RequestForChange;

use lib '/home/raj/perl5/lib/perl5';
use Web::Simple; # imports strict & warnings so don't repeat or it breaks

use IO::All;
use Template;
use Path::Tiny;
use Data::Dumper;
use HTML::FillInForm;
use Data::FormValidator;
use Data::FormValidator::Constraints qw(:closures);

# use CGI::Carp qw(fatalsToBrowser); # use for devel
use CGI::HTMLError (trace => 1); # use in production

use FindBin qw($RealBin); # warn $RealBin;
use lib $RealBin . '/../../lib';
use LIMS::Local::Config;
use LIMS::Model::Email;
use LIMS::Local::Utils;

my $config = LIMS::Local::Config->instance;

my $ADMIN = $config->{settings}->{admin_contact};
my $debug = path($RealBin, 'debug.txt')->realpath;
io($debug)->print(); # reset

# template src:
use constant TMPL_DIR => path($RealBin, '..', '..', 'templates')->realpath;
use constant TMPL => 'user/rfc.tt';

my $today = LIMS::Local::Utils::today;

sub dispatch_request {
    # just return empty form to fill in:
    sub (GET + ?:tkn=) { # collect query param as hashref { tkn => 'foo' }
        my ($self, $tkn) = @_; # _debug($tkn);
        [ 200, [ 'Content-type', 'text/html' ], [ $self->render_view($tkn) ] ]
    },
    sub (POST + %*) { # collect all body params as hashref
        my ($self, $params) = @_; # _debug($params);
        [ 200, [ 'Content-type', 'text/html' ], [ $self->process($params) ] ]
    },
    sub () {
        [ 405, [ 'Content-type', 'text/plain' ], [ 'Method not allowed' ] ]
    }
}

# if submitted form:
sub process {
    my ($self, $vars) = @_; # _debug($vars);
    
    my $dfv = _dfv();
    my $dfv_profile = _dfv_profile(); # DEBUG($dfv_profile);
    my $results = $dfv->check($vars, $dfv_profile); # DEBUG($results);

    if ( $results->has_invalid or $results->has_missing ) { # DEBUG($results);
        $vars->{errs} = $results->msgs;
    }
    else { # no validation errors:
        my $rtn = $self->send_application($vars);
        if ($rtn) { # sendmail error:
            $vars->{msg} = $rtn;
        }
        else { # messages sent OK:
            $vars->{send_success} = 1;
        }
    }
    return $self->render_view($vars);
}

sub render_view {
    my ($self, $vars) = @_; # _debug($vars);
    
    # tkn contains encrypted username in initial request from HILIS:
    if ( my $tkn = $vars->{tkn} ) { # DEBUG $tkn;
        my $key = $today->ymd; # so url only valid on same day
        my $username = LIMS::Local::Utils::decrypt($tkn, $key);
        $vars->{username} = $username;
    }
    # add settings to $vars:
	$vars->{settings} = $config->{settings}; _debug($vars);

    # get TT object:
    my $t = Template->new({ INCLUDE_PATH => TMPL_DIR }); 
    
    my $template_output;
    $t->process(TMPL, $vars, \$template_output)
    || die "Template process failed: ", $t->error(), "\n";

    my $output = HTML::FillInForm->fill( \$template_output, $vars );
    return $output;
}

sub send_application {
    my ($self, $vars) = @_;
    
    my $message_body = _message_body($vars);

    my $subject = 'HILIS RfC';
    
	my %mail = (		
		config  => $config->{settings},
		message => $message_body,
		subject => $subject,
	); # _debug(\%mail); return 0; # 'some reason for mail failure';

    my @recipients = ($ADMIN); # $vars->{email}

    for my $addr (@recipients) {
        $mail{recipient} = $addr; # DEBUG(\%mail);
        my $rtn = LIMS::Model::Email->send_message(\%mail); # returns Return::Value object
        return $rtn->string if $rtn->type ne 'success';
    }
    return 0; # messages sent OK
}

sub _dfv_profile {
    return {
        required => [ qw(username centre reason details) ],
    }
}

sub _message_body {
    my $vars = shift;

    my $content = sprintf "Date: %s\nUsername: %s [%s]\nReason: %s\n\n"
    . "Details: %s\n", $today->dmy, uc $vars->{username},
        map $vars->{$_}, qw/centre reason details/;
    return $content;
}

sub _dfv {
    my $defaults = $config->{dfv_defaults}; # DEBUG($defaults);    
    my $dfv = Data::FormValidator->new({}, $defaults);
    return $dfv;
}

sub _debug {
    my $obj = shift;
    io($debug)->append(Dumper $obj);
}

RequestForChange->run_if_script;