• Files
• Commits
• Log
• Graph
• Stats

#!/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
	};
}