| 1 | #!/usr/bin/perl |
|---|
| 2 | # |
|---|
| 3 | # See accompanying file "LICENCE" for licence details |
|---|
| 4 | |
|---|
| 5 | use strict; |
|---|
| 6 | use warnings; |
|---|
| 7 | |
|---|
| 8 | use DBI; |
|---|
| 9 | use CGI::Fast qw/:standard -debug/; |
|---|
| 10 | use Email::Valid; |
|---|
| 11 | |
|---|
| 12 | use vars qw($dbname $dbhost $dbuser $dbpass); |
|---|
| 13 | |
|---|
| 14 | sub print_err; |
|---|
| 15 | sub setup_dbh; |
|---|
| 16 | |
|---|
| 17 | # Read in database config |
|---|
| 18 | my $config = 'npemap.conf'; |
|---|
| 19 | do $config or die "Can't read $config!\n"; |
|---|
| 20 | |
|---|
| 21 | my $returnlink='<a href="/">Go back</a>'; |
|---|
| 22 | |
|---|
| 23 | # Set up database handler to try and make sure it's ready for the first |
|---|
| 24 | # request |
|---|
| 25 | # No point in handling errors here since they'll get handled by the request |
|---|
| 26 | # handler |
|---|
| 27 | my $dbh; |
|---|
| 28 | setup_dbh(); |
|---|
| 29 | |
|---|
| 30 | my $cgi; |
|---|
| 31 | # Process incoming requests |
|---|
| 32 | REQUEST: while ($cgi = new CGI::Fast) { |
|---|
| 33 | |
|---|
| 34 | # In case the database went away, make sure we have a connection |
|---|
| 35 | unless (setup_dbh()) { |
|---|
| 36 | print_err('Error setting up database connection', $returnlink); |
|---|
| 37 | next REQUEST; |
|---|
| 38 | } |
|---|
| 39 | |
|---|
| 40 | # Input validation |
|---|
| 41 | unless (defined $cgi->param('email')) { |
|---|
| 42 | print_err ("Email address not supplied", $returnlink); |
|---|
| 43 | next REQUEST; |
|---|
| 44 | } |
|---|
| 45 | |
|---|
| 46 | unless(Email::Valid->address($cgi->param('email'))) { |
|---|
| 47 | print_err ("Sorry, your email address doesn't seem to be valid", $returnlink); |
|---|
| 48 | next REQUEST; |
|---|
| 49 | } |
|---|
| 50 | |
|---|
| 51 | unless (defined $cgi->param('scotland') or defined $cgi->param('northernireland')) { |
|---|
| 52 | print_err ("Interest in neither Scotland nor Northern Ireland shown", $returnlink); |
|---|
| 53 | next REQUEST; |
|---|
| 54 | } |
|---|
| 55 | |
|---|
| 56 | # Check that the email address doesn't already exist in our interest DB |
|---|
| 57 | my $sth = $dbh->prepare('SELECT email FROM interest WHERE email = ?'); |
|---|
| 58 | unless ($sth->execute($cgi->param('email'))) { |
|---|
| 59 | print_err('Database error', $returnlink); |
|---|
| 60 | next REQUEST; |
|---|
| 61 | } |
|---|
| 62 | |
|---|
| 63 | if ($sth->rows) { |
|---|
| 64 | print_err('We already have a record of your interest. Please email us if you wish to change or remove this.', $returnlink); |
|---|
| 65 | next REQUEST; |
|---|
| 66 | } |
|---|
| 67 | |
|---|
| 68 | my $scotland = 'f'; |
|---|
| 69 | my $northernireland = 'f'; |
|---|
| 70 | if (defined $cgi->param('scotland')) { |
|---|
| 71 | $scotland = 't'; |
|---|
| 72 | } |
|---|
| 73 | if (defined $cgi->param('northernireland')) { |
|---|
| 74 | $northernireland = 't'; |
|---|
| 75 | } |
|---|
| 76 | |
|---|
| 77 | $sth = $dbh->prepare('INSERT INTO interest (email, scotland, northernireland, ip) VALUES (?, ?, ?, ?)'); |
|---|
| 78 | if ($sth->execute($cgi->param('email'), $scotland, $northernireland, $ENV{'REMOTE_ADDR'})) { |
|---|
| 79 | print "Content-type: text/html\n\n"; |
|---|
| 80 | print "<html><head><title>Thank you</title></head>\n"; |
|---|
| 81 | print "<body><p>Thank you for showing an interest in future plans!</p>\n"; |
|---|
| 82 | print "<p>$returnlink</p>\n"; |
|---|
| 83 | print "</body></html>"; |
|---|
| 84 | next REQUEST; |
|---|
| 85 | } else { |
|---|
| 86 | print_err("Database error when adding your data :(", $returnlink); |
|---|
| 87 | next REQUEST; |
|---|
| 88 | } |
|---|
| 89 | } |
|---|
| 90 | |
|---|
| 91 | # No more requests to serve, so tidy up |
|---|
| 92 | $dbh->disconnect; |
|---|
| 93 | |
|---|
| 94 | # Helper routines |
|---|
| 95 | sub print_err($$) { |
|---|
| 96 | my $err = shift; |
|---|
| 97 | my $returnlink = shift; |
|---|
| 98 | print "Content-type: text/html\n\n"; |
|---|
| 99 | print "<html><head><title>Error submitting</title></head>\n"; |
|---|
| 100 | print "<body><p>The following error occurred whilst submitting data:\n"; |
|---|
| 101 | print CGI::escapeHTML($err); |
|---|
| 102 | print "</p><p>$returnlink</p>\n"; |
|---|
| 103 | print "</body></html>\n"; |
|---|
| 104 | } |
|---|
| 105 | |
|---|
| 106 | sub setup_dbh { |
|---|
| 107 | # $dbh is global |
|---|
| 108 | my $data_source = "dbi:Pg:dbname=$dbname"; |
|---|
| 109 | $data_source .= ";host=$dbhost" if $dbhost; |
|---|
| 110 | return $dbh = DBI->connect_cached($data_source, $dbuser, $dbpass); |
|---|
| 111 | } |
|---|
| 112 | |
|---|
