#!/usr/bin/perl
use strict;
use warnings;
use lib '/home/raj/perl5/lib/perl5';
use CGI;
use Template;
use Data::Dumper;
use Data::Printer alias => 'DEBUG'; # need to alias p() if using CGI
use DBIx::Simple;
use Mail::Sendmail;
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::Model::Email;
use LIMS::Local::Utils; # text_wrap
use LIMS::Local::Config;
my $q = CGI->new(); # DEBUG($q);
# get form submission params:
my $vars = $q->Vars(); # DEBUG($vars);
# set $ENV{CENTRE} if required, BEFORE getting config:
if ( $vars->{service} ) {
$ENV{CENTRE} = $vars->{service}; # other centres
}
my $config = LIMS::Local::Config->instance;
my $dbix = DBIx::Simple->connect(@{ $config->{dbh_params} });
my $SERVICE = $config->{settings}->{service_email};
my $ADMIN = $config->{settings}->{admin_contact};
# template src:
use constant TMPL_DIR => $RealBin . '/../../templates';
use constant TMPL => 'user/application_form.tt';
use vars qw($content);
# if submitted form:
if ($vars->{register}) {
my $dfv = _dfv();
my $dfv_profile = _dfv_profile(); # DEBUG($dfv_profile);
my $results = $dfv->check($q, $dfv_profile); # DEBUG($results);
if ( $results->has_invalid or $results->has_missing ) { # DEBUG($results);
$content = { errs => $results->msgs, vars => $vars };
}
# check email not used:
elsif ( _email_in_use() ) { # returns 1 if email addr registered
$content = { addr_in_use => 1, vars => $vars };
}
else { # no validation errors:
my $rtn = send_application();
if ($rtn) { # sendmail error:
$content = { vars => $vars, msg => $rtn, admin => $SERVICE };
}
else { # messages sent OK:
$content = { vars => $vars, send_success => 1, admin => $SERVICE };
}
}
}
sub _email_in_use {
my $db = $config->{settings}->{production_db};
my $tbl = join '.', $db, 'users';
return $dbix->select( $tbl, 1, { email => $vars->{email} } )->list;
}
my $view = render_view($content);
print $q->header(), $view;
sub render_view {
my $content = shift;
$content->{settings} = $config->{settings};
{ # user locations:
my $sql = q!select location_name from user_locations where active = 'yes'!;
my $user_locations = $dbix->query($sql)->flat;
$content->{user_locations} = $user_locations;
}
{ # user roles:
my $roles = $dbix->query('select distinct(designation) from users')->flat;
$content->{roles} = $roles;
}
# get TT object:
my $t = Template->new({ INCLUDE_PATH => TMPL_DIR });
my $template_output;
$t->process(TMPL, $content, \$template_output)
|| die "Template process failed: ", $t->error(), "\n";
my $output = HTML::FillInForm->fill( \$template_output, $vars );
return $output;
}
sub send_application {
my $message_body = _message_body();
$vars->{_email_msg} = $message_body;
my $subject = sprintf 'HILIS [%s] Registration (%s, %s)',
uc $vars->{service}, uc $vars->{last_name}, ucfirst lc $vars->{first_name};
my %mail = (
config => $config->{settings},
message => $message_body,
subject => $subject,
); # DEBUG(\%mail);
my @recipients = ($ADMIN, $SERVICE, $vars->{email});
my %seen;
for my $addr (@recipients) {
next if $seen{$addr}++; # in case service_email & admin_contact are the same
$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(last_name first_name contact email email2 tel dept) ],
optional => [ qw(location other_source role other_role)],
dependencies => {
location => { OTHER => 'other_source' }, # require 'other_source' if location == OTHER
designation => { OTHER => 'other_role' }, # require 'other_role' if designation == OTHER
},
require_some => { # require one from this group
location => [ 1, qw(location other_source) ],
role => [ 1, qw(designation other_role) ],
},
field_filters => {
first_name => _remove_spaces(),
last_name => _remove_spaces(),
},
constraint_methods => {
email => email(),
email2 => _check_emails_match(),
},
msgs => {
constraints => {
email_mismatch => 'e-mail addresses do not match',
},
},
}
}
sub _message_body {
my $str = $vars->{contact}; # ie departmental address
$str =~ s/\r\n/ /g; # convert new-lines to spaces
my @args = ("", "\t", $str); # free text - maybe loooong
my $addr = LIMS::Local::Utils::text_wrap(65, \@args);
my $divider = '-' x 75;
$vars->{other_source} ||= $vars->{location};
$vars->{other_role} ||= $vars->{designation};
my $message = "Your HILIS application has been submitted.\n\n";
$message .= "You should normally receive a response within 2 working days.\n\n";
$message .= "Please contact $SERVICE should you require any further details.\n\n";
$message .= $divider . "\n";
$message .= sprintf "%12s: %s\n", 'First Name', $vars->{first_name};
$message .= sprintf "%12s: %s\n", 'Last Name', $vars->{last_name};
$message .= sprintf "%12s: %s\n", 'Source', $vars->{other_source};
$message .= sprintf "%12s: %s\n", 'Dept', $vars->{dept};
$message .= sprintf "%12s: %s\n", 'Position', $vars->{other_role};
$message .= sprintf "%12s: %s\n", 'Address', $addr;
$message .= sprintf "%12s: %s\n", 'Telephone', $vars->{tel};
$message .= sprintf "%12s: %s\n", 'E-mail', $vars->{email};
$message .= sprintf "%12s: %s\n", 'Service', $vars->{service};
return $message;
}
sub _dfv {
my $defaults = $config->{dfv_defaults}; # DEBUG($defaults);
my $dfv = Data::FormValidator->new({}, $defaults);
return $dfv;
}
sub _check_emails_match {
return sub {
my $dfv = shift; # DEBUG($dfv);
$dfv->name_this('email_mismatch');
my $data = $dfv->get_filtered_data; # DEBUG($data);
return (
$data->{email} && $data->{email2} &&
$data->{email} eq $data->{email2}
); # returns truth
};
}
sub _remove_spaces {
return sub { my $str = shift; $str =~ s/\s+/\-/g; $str; }
}
