#!/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 $ADMIN = $config->{settings}->{admin_contact}; my $COPY_TO = $config->{settings}->{email_from}; # 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 => $ADMIN }; } else { # messages sent OK: $content = { vars => $vars, send_success => 1, admin => $ADMIN }; } } } 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(); 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, $COPY_TO, $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(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 $ADMIN 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; } }