#!/usr/bin/perl use strict; use warnings; BEGIN { use FindBin qw($RealBin); # warn $RealBin; use lib ( '/home/raj/perl5/lib/perl5', $RealBin . '/../../lib', ); # use CGI::Carp qw(fatalsToBrowser); # use for devel use CGI::HTMLError (trace => 1); # use in production } use CGI; use Template; use Data::Dumper; use DBIx::Simple; use HTML::FillInForm; use Data::FormValidator; use Data::FormValidator::Constraints qw(:closures); use LIMS::Model::Email; use LIMS::Local::Debug; # DEBUG() use LIMS::Local::Config; use Mail::Sendmail; my $config = LIMS::Local::Config->instance; my $dbix = DBIx::Simple->connect(@{ $config->{dbh_params} }); my $ADMIN = $config->{settings}->{admin_contact}; # template src: use constant TMPL_DIR => $RealBin . '/../../templates'; use constant TMPL => 'user/application_form.tt'; my $q = CGI->new(); # DEBUG($q); # get form submission params: my $vars = $q->Vars(); # DEBUG($vars); 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 }; } 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 }; } } } my $view = render_view($content); print $q->header(), $view; sub render_view { my $content = shift; { # 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 Registration (%s, %s)', uc $vars->{last_name}, ucfirst lc $vars->{first_name}; my %mail = ( config => $config->{settings}, message => $message_body, subject => $subject, ); # DEBUG(\%mail); my @recipients = ($ADMIN, $vars->{email}); for my $addr (@recipients) { $mail{recipient} = $addr; # DEBUG(\%mail); my $rtn = LIMS::Model::Email->send_message(\%mail); return $rtn if $rtn; } 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) ], }, constraint_methods => { email => email(), email2 => _check_emails_match(), }, msgs => { constraints => { email_mismatch => 'e-mail addresses do not match', }, }, } } sub _message_body { $vars->{contact} =~ s/\,//g; $vars->{contact} =~ s/\r\n/, /g; # remove orig. commas & new-lines my $message = qq!Confirmation of your HILIS registration details:\n\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} || $vars->{location}; $message .= sprintf "%12s: %s\n", 'Dept', $vars->{dept}; $message .= sprintf "%12s: %s\n", 'Position', $vars->{other_role} || $vars->{designation}; $message .= sprintf "%12s: %s\n", 'Address', $vars->{contact}; $message .= sprintf "%12s: %s\n", 'Telephone', $vars->{tel}; $message .= sprintf "%12s: %s\n", 'E-mail', $vars->{email}; $message .= qq!\n\nPlease contact $ADMIN should you require any further details.!; 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} eq $data->{email2}); # returns truth }; }