#!/usr/bin/perl
####################################################
#
# Event Sign In
#
# Author: Kai Wetlesen
#
# Event Sign In originally started life as a fast
# hack to allow me to sign in upwards of 100 people
# to an event being hosted by a school club I am a
# part of. The idea is that this application will
# be useful for clubs and/or school organizations
# that host events wherein a student can earn
# course credit for attending. This helps cut down
# on attendance fraud and keep the event hosts in
# determining just how successful their event was
# and also determine what classes everyone came
# from. It's a simple CGI form that does a pull
# from a database, then inserts some matched data
# back in.
#
# The application is mostly customizable, and can
# be adapted for use in a corporate environment
# with some minor tweaks (naturally supplanting
# classes with departments/teams). Several parts
# of the application can be adjusted from a
# separate config file, which should be located
# in the cgi directory under conf/signin.conf
#
# This CGI application is licensed under LGPL v3.0
# http://www.gnu.org/licenses/lgpl.html
####################################################
use strict;
use CGI::Pretty qw(:standard);
use DBI;
use DBD::mysql;
use Time::Local;
$CGI::POST_MAX = 2048;
$CGI::DISABLE_UPLOADS = 1;
# We need to start by creating a CGI page object
# I just so happen to call it rq to stand for
# ReQuested page.
my $rq = CGI->new;
# Naturally this prints an HTML header
print $rq->header( {-charset=>'utf-8'} );
my $fn = "0"; #first name
my $ln = "0"; #last name
my $em = "0"; #email
my $ae = "0"; #alt email
my $fullname;
my %cfg;
my ( $cfgkey, $cfgval );
open CONF, "<conf/signin.conf" or Die("Could not open configuration file. $!");
while ( <CONF> )
{
next if /^\s*#/ or /^\s*$/;
chomp;
( $cfgkey, $cfgval ) = split /:/;
$cfgkey =~ s/^\s*//;
$cfgval =~ s/^\s*//;
$cfg{$cfgkey} = $cfgval;
}
# Check thru the configuration and make sure everything is set correctly
my $eventName = $cfg{"EventName"} or Die("Could not get event name. $!");
my $css = $cfg{"CSS"} or Die("No CSS style sheet configured. $!");
my $returnToURL = $cfg{"ReturnToURL"} or Die("Return to URL not specified. $!");
Die("No database specified in configuration file.\n") if !defined $cfg{"Database"};
Die("No database server specified in configuration file.\n") if !defined $cfg{"Server"};
Die("Credentials not found in configuration file.\n") if !defined $cfg{"Username"};
Die("Credentials not found in configuration file.\n") if !defined $cfg{"Password"};
# I perform the connection attempt here because
# this script is dead in the water should the
# connection fail to happen.
my $dbname = $cfg{"Database"};
my $server = $cfg{"Server"};
my $usernm = $cfg{"Username"};
my $passwd = $cfg{"Password"};
my $db = DBI->connect( "dbi:mysql:$dbname:$server:3306", $usernm, $passwd ) or Die("DB connect failed! $DBI::errstr");
# As closing time is optional, this isn't rigorously checked
my ( $graceTime, $offMin, $offHr, $offDay, $offMon, $offYear );
if ( defined $cfg{"RegClose"} )
{
( $offMon, $offDay, $offYear, $offHr, $offMin ) = split /\s+/,$cfg{"RegClose"};
# Default the grace time to 15 seconds if it's not given so that
# people have X number of seconds to register after the clock turns over
$graceTime = defined $cfg{"GraceTime"} ? $cfg{"GraceTime"} : 15;
$cfg{"RegClose"} = timelocal( $graceTime, $offMin, $offHr, $offDay, ($offMon-1), $offYear );
}
# Start off the header and load in the stylesheet
print $rq->start_html(-title => "$eventName - Sign-in",
-style => {
-src => $cfg{"CSS"},
-type => 'text/css',
-media => 'screen' },
-class=>'Body' );
print $rq->div( { class=>'Title' }, $eventName );
if ( defined $cfg{"RegClose"} and time() > $cfg{"RegClose"} )
# Again, check to see if close time is defined, because maybe the
# registration is always open! That'd be weird, but it's possible
{
print $rq->p( { class=>'subTitle centered' }, "Registration Closed" );
print $rq->p( {id=>'form_instructions'},
"Registration for this event has closed. If you still need to register
for this event, please speak with the event staff." );
print $rq->p( { class=>'centered' }, TimeString($cfg{"RegClose"} ) );
}
elsif ( $ENV{ 'REQUEST_METHOD' } eq "POST" ) # Process posted data
{
# the Check functions return "error" which is the name of a css class that does
# error highlighting. They return "0" (css class name?) if everything is okay
# Obviously if the parameter is undef, give it nothing to check.
# Each two-letter variable in this if segment represents the class with which
# the given form item will be displayed. It's also used for basic error checking.
$fn = checkName( $rq->param( "firstName" ) );
$ln = checkName( $rq->param( "lastName" ) );
$em = checkEmail( $rq->param( "email" ) );
$ae = $rq->param( "altemail" ) ? checkEmail( $rq->param( "altemail" ) ) : "0";
# NOTE: None of these functions can be used unless there is a POST event
# i.e. there has been data placed into the form and sent over.
# Check to see if the previous functions found any errors in the inputs
if ( $fn or $ln or $em or $ae )
{
PrintPageWithHighlightedErrors( $rq, $db, $fn, $ln, $em, $ae );
}
# Are they already registered? We want to prevent double registration.
elsif ( !($fullname = checkIfRegistered($rq->param("firstName")." ".$rq->param("lastName"), $db) ) )
{
PrintAlreadyRegistered( $rq, $eventName, $returnToURL );
}
else # No errors were found. Register the user and give them a nice confirmation
{
RegisterPerson( $rq, $db, $fullname, $returnToURL );
}
}
else # No data was posted. Print a form for the user to post some data with.
{
print $rq->div( { class=>'subTitle' }, "Sign In" );
print $rq->p( { id=>'form_instructions' },
"Please sign in to attend $eventName.
Fields marked with asterisks are <em>mandatory</em>.<br />
Registration closes on ", TimeString( $cfg{"RegClose"} )."!"
);
PrintForm( $rq, $db, $fn, $ln, $em, $ae );
}
# Being of course that this form generates valid HTML,
# show it off!
print $rq->p( {class=>"centered"},
$rq->a( {href=>"http://validator.w3.org/check?uri=referer"},
$rq->img( {src=>"http://www.w3.org/Icons/valid-xhtml10-blue",
alt=>"Valid XHTML 1.0 Transitional",
height=>"31",
width=>"88"}
)
)
);
$db->disconnect();
print $rq->end_html();
# This subroutine will print some cohesive error messages above the
# form so that users aren't left scratching their heads over why
# some particular form element was suddenly highlighted in red. Really
# though, they shouldn't be such dunces about it and just figure it
# out, but I'm not the BOFH
# Don't know what BOFH is? Google search it you idiot and stop reading
# my code. You aren't worthy.
#
# Receives: Page object, DB object, CSS errors
#
# Returns: Nothing. All data printed to page.
sub PrintPageWithHighlightedErrors
{
my ( $rq, $db, $fn, $ln, $em, $ae ) = @_;
print $rq->div( { class=>'subTitle' }, "Invalid Entry!" ),
$rq->p( { id=>'form_instructions' },
"There were errors found in your entry. They are highlighted in
red below. Correct these errors before submitting."
);
# The following three Ifs take any possible error and print an
# error description above so people know what to fix.
if ( $fn )
{ print $rq->div( {class=>"centered"}, "Invalid first name." ) }
if ( $fn or $ln )
{ print $rq->div( {class=>"centered"}, "Invalid last name." ) }
if ( $em or $ae )
{ print $rq->div( {class=>"centered"}, "Invalid email address. Emails must be in the correct format." ) }
print $rq->br();
# Of course we'll want to reprint the form with each
# erroneous field highlighted.
PrintForm( $rq, $db, $fn, $ln, $em, $ae );
}
# Obviously you don't want the same person to register and
# re-register over and over again. This would cloud up the
# database. This function does NOT actually do the check,
# see checkIfRegistered. This function prints a full-formatted
# message saying the person has already registered, then
# returns to a given URL
#
# Receives: Page object, return URL, event name
#
# Returns: Nothing, all printed to the page
sub PrintAlreadyRegistered
{
my ( $rq, $eventName, $returnToURL ) = @_;
# I think the following two prints are fairly self-evident
print $rq->div( { class=>'subTitle' }, "Already Signed In!" );
print $rq->p( {id=>'form_instructions'},
"You have already signed in for $eventName. If you
have received this message in error, please speak with the attendant." );
# Just prints the current time, that's all
print $rq->p( { class=>'centered' }, TimeString(time) );
# Create a small Javascript redirect and send user back to the given return URL
# returnToURL set in config file
print "<script type=\"text/JavaScript\">
<!--
setTimeout(\"location.href = '$returnToURL';\",4600);
-->
</script>";
}
# Obviously we need to enter some data into a database in order
# for this application to successfully complete its task. This
# completes that task. It simply interfaces with a given MySQL
# database and enters the queries with values in directly.
#
# Receives: Page object, DB object, formatted full name, return URL
#
# Returns: Nothing, function will die out here if there's an error.
#
# Note: All the data EXCEPT THE NAME is passed down thru the page object.
# Why? I'm lazy, and the name was already checked and formatted.
#
# Also note: This function will die out if any of the SQL inserts fail,
# which opens up the possiblility for a corruption. Keep a
# CLOSE EYE on all error messages that come up, but really
# if any one of the SQL statements fails you're boned anyway.
sub RegisterPerson
{
my ( $rq, $db, $fullname, $returnToURL ) = @_;
my $email = $rq->param( "email" );
my $altemail = $rq->param( "altemail" );
# Insert the student information first then retrieve autogen'ed studentID for use
# in the next row insertion.
my $sql = "INSERT INTO students ( name, email, altemail ) VALUES ( \"$fullname\", \"$email\", \"$altemail\" )";
my $newrequest = $db->prepare( $sql );
$newrequest->execute() or Die("Query failed. $DBI::errstr");
# Gets the studentID
$sql = "SELECT studentID FROM students WHERE name=\"$fullname\"";
$newrequest = $db->prepare( $sql );
$newrequest->execute() or Die("Query failed. $DBI::errstr");
my $res = $newrequest->fetchrow_arrayref();
my $studentID = $res->[0];
$sql = "SELECT classID FROM classes";
$newrequest = $db->prepare ( $sql );
$newrequest->execute() or Die("Query failed. $DBI::errstr");
my @results = @{$newrequest->fetchall_arrayref};
foreach ( @results )
{
if ( $rq->param("Class$_->[0]") )
{
$sql = "INSERT INTO students_and_classes ( classID, studentID ) VALUES ( $_->[0], $studentID )";
$newrequest = $db->prepare( $sql );
$newrequest->execute() or Die("Query failed. $DBI::errstr");
}
}
print $rq->div( { class=>'subTitle' }, "Registration Complete" );
print $rq->p( {id=>'form_instructions'},
"Thank you ".$rq->param('firstName').". We will send you a follow-up survey in the next
few days. <br /><br />We hope you enjoy the event!" );
print "<script type=\"text/JavaScript\">
<!--
setTimeout(\"location.href = '$returnToURL';\",3000);
-->
</script>";
}
# The PrintForm function depends on a few variables to
# be created prior to operation. It's primary task is
# to generate the form wherein the user will fill in
# their information to put into the database. In this
# application, that consists of their name, email, and
# also any classes they are taking.
#
# PrintForm also takes a set of CSS flags which are
# used to do the coloured error highlighting. These CSS
# flags should be set based according to your stylesheet
# but in my application the value "error" will pull up
# CSS class error, where OK will just match a null CSS
# class
#
# Input: CGI page object, DB connection object, CSS flags
#
# Output: None. All form output printed directly to HTML page.
sub PrintForm
{
my ($rq, $db, $fn, $ln, $em, $ae ) = @_;
my $form = $rq->Vars;
my $firstName = $form->{ "firstName" };
my $lastName = $form->{ "lastName" };
my $email = $form->{ "email" };
my $altemail = $form->{ "altemail" };
my $className = $form->{ "classname" };
# Naturally we want to retain values between page loads should
# the user screw up (which is almost guaranteed to happen.
$rq->param( $firstName, $lastName, $email, $altemail, $className );
print $rq->startform ( "POST", $rq->url(), "application/x-www-form-urlencoded" );
print $rq->table ( {-class=>'center_justified'},
$rq->Tr (
$rq->td( {class=>$fn}, "First Name:" ),
$rq->td( $rq->textfield('firstName'), "*" )
),
$rq->Tr (
$rq->td( {class=>$ln}, "Last Name:" ),
$rq->td( $rq->textfield('lastName'), "*" )
),
$rq->Tr (
$rq->td( $rq->br() ), $rq->td( " " )
),
$rq->Tr (
$rq->td( {class=>$em}, "Email address:" ),
$rq->td( $rq->textfield('email'), "*" )
),
$rq->Tr (
$rq->td( {class=>$ae}, "Alternate email:" ),
$rq->td( $rq->textfield('altemail') )
),
);
print $rq->table ( {class=>'center_justified'},
$rq->Tr (
$rq->td( {colspan=>3}, $rq->br() ),
),
$rq->Tr (
$rq->td( {colspan=>3}, "Please select any classes you are
taking from the checkboxes below:" )
),
getClassList($db)
);
print $rq->table ( {class=>'center_justified'},
$rq->Tr (
$rq->td( {colspan=>3}, $rq->br() ),
),
$rq->Tr (
$rq->td( {colspan=>'2', class=>'centered'} , $rq->submit("Register") ),
$rq->td( {colspan=>'2', class=>'centered'} , $rq->reset("Clear Form") )
),
$rq->Tr (
$rq->td( $rq->br() ),
$rq->td( " " )
)
);
print $rq->endform();
}
# Takes in a time value and then returns a formatted
# and printable timestring that can be printed to the
# user
#
# Input: Time Value
#
# Output: Formatted date and time string
sub TimeString
{
my $Time = shift;
my ( $min, $hr, $day, $mon, $year, $wday ) = (localtime($Time))[1..6];
my $ampm;
my @months = qw( January February March April May June July August September October November December );
my @days = qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday );
$ampm = $hr>12 ? "PM" : "AM";
$hr += $hr>12 ? -12 : 0;
$min = $min<10 ? "0$min" : "$min";
$year += 1900;
return "$days[$wday] $months[$mon] $day $year $hr:$min $ampm";
#print $rq->p( { class=>'centered' }, "$days[$wday] $months[$mon] $day $year $hour:$min $ampm" );
}
# Checks to see if the particular person has already
# signed in or not. Obviously we don't want the same
# person to register over and over again. Such would
# cloud up the database. Function will format name
# to match database. This return value should be used
# to enter into the database. Just sayin!
#
# Input: First and last name.
#
# Output: Formatted name to input into database
# Undefined if the name already exists
sub checkIfRegistered
{
my ( $name, $db ) = @_;
my ( $fullname, $sql, $newrequest, $res );
$name =~ s/^\s*//;
# I opted for a list here as people can have multiple
# words in their name as well, like "Taylor Harper"
# or "Mac Lane" for example. As is evident, every name
# will be inputted into the database as upper-case.
# Quite common convention really.
$fullname = join " ", ( map{ uc $_ } split /\s+/, $name );
$sql = "SELECT name FROM students WHERE name=\"$fullname\"";
$newrequest = $db->prepare( $sql );
$newrequest->execute() or Die("DB connect failed! $DBI::errstr");
$res = $newrequest->fetchrow_arrayref();
$name = $res->[0];
$newrequest->finish();
# If we picked a name out of the result set
# then they have already registered haven't
# they? :D
return $name ? "" : $fullname;
}
sub checkName
{
my ( $name ) = shift;
return "error" if $name !~ /^[- a-zA-Z]+$/ or $name =~ /^\s*$/;
return 0;
}
sub checkEmail
{
my ( $email ) = shift;
return "error" if $email !~ /^[^@]+\@[^@]+\..+$/;
return 0;
}
sub getClassList
{
my $db = shift;
my %classlist;
my %labels;
my @cell_elems;
my @row_elems;
my @form_elems;
my @niceClass;
my ( $instructor, $classID, $classname, $count );
my $sql = "SELECT classID, classname, instructor from classes";
my $classQuery = $db->prepare( $sql );
$classQuery->execute() or Die("Query execution failed\n$DBI::errstr");
foreach ( @{$classQuery->fetchall_arrayref()} )
{
$classlist{$_->[2]}{$_->[0]} = $_->[1];
}
#$_->[0] is holding classID, $_->[1] holds classname, and $_->[2] holds instructor;
foreach $instructor ( sort byInstructorLnFn keys %classlist )
{
push @cell_elems, $rq->h4( "$instructor" );
foreach $classID ( sort { $a <=> $b } keys %{$classlist{$instructor}} )
{
@niceClass = split /\-/, $classlist{$instructor}{$classID};
push @cell_elems,
$rq->checkbox( -name=>"Class$classID",
-checked=>0,
-value=>"$classID",
-label=>"$niceClass[0]"),
$rq->br(),
$niceClass[1],
$rq->br();
}
push @row_elems, $rq->td( {class=>'center_justified',style=>"padding: 10px 30px; vertical-align: top;"}, @cell_elems );
@cell_elems = ();
$count++;
if ( !($count % 3) ){ push @form_elems, $rq->Tr( @row_elems ); @row_elems = (); }
}
if ( @row_elems ) { push @form_elems, $rq->Tr( @row_elems ); @row_elems = (); }
return @form_elems;
}
sub byInstructorLnFn
{
$a =~s/^\s*//;
$b =~s/^\s*//;
my ( $firstNameA, $lastNameA ) = split/\s+/, $a;
my ( $firstNameB, $lastNameB ) = split/\s+/, $b;
$lastNameA cmp $lastNameB
or
$firstNameA cmp $firstNameB;
}
sub Die
{
my $err = shift;
print $err . "<br />Check program configuration file or contact the operator.";
# All error logs are going to come to this line. Do an error search with the error msg you got. :)
die $err;
}