#!/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; use LIMS::Local::ScriptHelpers; my $config = LIMS::Local::Config->instance; my $tools = LIMS::Local::ScriptHelpers->new; my $dbix = $tools->dbix; my $SERVICE = $config->{settings}->{service_email}; 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 $username = uc $vars->{username}; my $subject = "HILIS RfC [$username]"; my %mail = ( config => $config->{settings}, message => $message_body, subject => $subject, ); # _debug(\%mail); return 0; # 'some reason for mail failure'; my @recipients = ($ADMIN); # $vars->{email} # add service email if different to admin address: push @recipients, $SERVICE if $SERVICE ne $ADMIN; $dbix->select('users', 'email', { username => $username} )->into(my $cc); if ($cc) { push @recipients, $cc; } else { warn "no email address for $username"; } 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 status) ], } } sub _message_body { my $vars = shift; my $content = sprintf "Date: %s\nUsername: %s [%s]\nReason: %s\nStatus: %s\n\n" . "Details: %s\n", $today->dmy, uc $vars->{username}, map $vars->{$_}, qw/centre reason status 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;