1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | use DBI; |
---|
7 | use CGI::Fast qw/:standard -debug/; |
---|
8 | use Geo::Postcode; |
---|
9 | |
---|
10 | use vars qw($dbname $dbhost $dbuser $dbpass); |
---|
11 | |
---|
12 | sub print_err; |
---|
13 | sub setup_dbh; |
---|
14 | |
---|
15 | # Read in database config |
---|
16 | my $config = 'npemap.conf'; |
---|
17 | do $config or die "Can't read $config!\n"; |
---|
18 | |
---|
19 | # Set up database handler to try and make sure it's ready for the first |
---|
20 | # request |
---|
21 | # No point in handling errors here since they'll get handled by the request |
---|
22 | # handler |
---|
23 | my $dbh; |
---|
24 | setup_dbh(); |
---|
25 | |
---|
26 | |
---|
27 | my @fields = qw(easting northing postcode); |
---|
28 | my $returnBaseURL = 'http://www.npemap.org.uk'; |
---|
29 | |
---|
30 | my $cgi; |
---|
31 | # Process incoming requests |
---|
32 | REQUEST: while ($cgi = new CGI::Fast) { |
---|
33 | |
---|
34 | # If we're given return URL parameters, basic sanity check to stop |
---|
35 | # funny business |
---|
36 | |
---|
37 | my $returnlink = '<a href="/tiles/map.html?' .int($cgi->param('easting')/1000). ",".int($cgi->param('northing')/1000) . ',1">Go back</a>'; |
---|
38 | |
---|
39 | if (defined $cgi->param('returnX') and ($cgi->param('returnX') =~ /\d+/) and |
---|
40 | defined $cgi->param('returnY') and ($cgi->param('returnY') =~ /\d+/) ) { |
---|
41 | $returnlink = '<a href="' . $returnBaseURL . '/tiles/map.html?' . $cgi->param('returnX') . ',' . $cgi->param('returnY') . ',1">Go back to the map</a>'; |
---|
42 | } |
---|
43 | |
---|
44 | |
---|
45 | # In case the database went away, make sure we have a connection |
---|
46 | unless (setup_dbh()) { |
---|
47 | print_err('Error setting up database connection', $returnlink); |
---|
48 | next REQUEST; |
---|
49 | } |
---|
50 | |
---|
51 | my ($easting, $northing); |
---|
52 | |
---|
53 | # Input validation |
---|
54 | foreach my $field (@fields) { |
---|
55 | unless (defined $cgi->param($field)) { |
---|
56 | print_err ("Parameter '$field' missing", $returnlink); |
---|
57 | next REQUEST; |
---|
58 | } |
---|
59 | } |
---|
60 | |
---|
61 | # Is the Easting in a valid range? |
---|
62 | if (($cgi->param('easting') > 700000) or |
---|
63 | ($cgi->param('easting') < 0)) { |
---|
64 | print_err ("Parameter 'easting' must be an integer between 0 and 700,000", $returnlink); |
---|
65 | next REQUEST; |
---|
66 | } else { |
---|
67 | $easting = $cgi->param('easting'); |
---|
68 | } |
---|
69 | |
---|
70 | # Is the Northing in a valid range? |
---|
71 | if (($cgi->param('northing') > 1300000) or |
---|
72 | ($cgi->param('northing') < 0)) { |
---|
73 | print_err("Parameter 'northing' must be an integer between 0 and 1,300,000", $returnlink); |
---|
74 | next REQUEST; |
---|
75 | } else { |
---|
76 | $northing = $cgi->param('northing'); |
---|
77 | } |
---|
78 | |
---|
79 | my $sth; |
---|
80 | |
---|
81 | # Now validate the postcode input format |
---|
82 | my $raw_postcode = $cgi->param('postcode'); |
---|
83 | my $trimmed_postcode = $raw_postcode; |
---|
84 | $trimmed_postcode =~ s/^\s+//; |
---|
85 | $trimmed_postcode =~ s/\s+$//; |
---|
86 | my $postcode = Geo::Postcode->new($trimmed_postcode); |
---|
87 | my ($first, $second, $third, $fourth) = @{$postcode->fragments}; |
---|
88 | my ($outward, $inward); |
---|
89 | |
---|
90 | if ($postcode->valid) { |
---|
91 | # We have a complete postcode; input it straight into the database |
---|
92 | $outward = $first . $second; |
---|
93 | $inward = $third . $fourth; |
---|
94 | } elsif($postcode->valid_fragment) { |
---|
95 | # We have a valid fragment; let's build up what we can |
---|
96 | # We are guaranteed to have the first two |
---|
97 | $outward = $first . $second; |
---|
98 | $inward = ''; |
---|
99 | $inward .= $third if defined $third; |
---|
100 | $inward .= $fourth if defined $fourth; |
---|
101 | } else { |
---|
102 | print_err("The postcode format is not valid", $returnlink); |
---|
103 | next REQUEST; |
---|
104 | } |
---|
105 | |
---|
106 | # Check for a duplicate. |
---|
107 | # We want to collect duplicates from different IP addresses as a kind of |
---|
108 | # corroboration factor; this just catches accidental double-submission |
---|
109 | # really. |
---|
110 | $sth = $dbh->prepare('SELECT raw_postcode FROM postcodes WHERE raw_postcode = ? AND easting = ? AND northing = ? AND ip = ?'); |
---|
111 | unless ($sth->execute($raw_postcode, $easting, $northing, $ENV{'REMOTE_ADDR'})) { |
---|
112 | print_err('Database error when checking for duplicate data :(', $returnlink); |
---|
113 | next REQUEST; |
---|
114 | } |
---|
115 | |
---|
116 | if ($sth->rows) { |
---|
117 | print_err('You, or someone with the same IP address, have already submitted this postcode with these co-ordinates.', $returnlink); |
---|
118 | next REQUEST; |
---|
119 | } |
---|
120 | |
---|
121 | $sth = $dbh->prepare('INSERT INTO postcodes (outward, inward, raw_postcode, easting, northing, ip, source) VALUES (?, ?, ?, ?, ?, ?, 0)'); |
---|
122 | if ($sth->execute($outward, $inward, $raw_postcode, $easting, $northing, $ENV{'REMOTE_ADDR'})) { |
---|
123 | print "Content-type: text/html\n\n"; |
---|
124 | print "<html><head><title>Thank you</title></head>\n"; |
---|
125 | print "<body><p>Thank you for telling us where your post code is!</p>\n"; |
---|
126 | print "<p>$returnlink</p>\n"; |
---|
127 | print "</body></html>"; |
---|
128 | next REQUEST; |
---|
129 | } else { |
---|
130 | print STDERR "DB error: " . $dbh->errstr . "\n"; |
---|
131 | print_err("Database error when adding your data :(", $returnlink); |
---|
132 | next REQUEST; |
---|
133 | } |
---|
134 | } |
---|
135 | |
---|
136 | # No more requests to serve, so tidy up |
---|
137 | $dbh->disconnect; |
---|
138 | |
---|
139 | # Helper routines |
---|
140 | sub print_err($$) { |
---|
141 | my $err = shift; |
---|
142 | my $returnlink = shift; |
---|
143 | print "Content-type: text/html\n\n"; |
---|
144 | print "<html><head><title>Error submitting</title></head>\n"; |
---|
145 | print "<body><p>The following error occurred whilst submitting data:\n"; |
---|
146 | print CGI::escapeHTML($err); |
---|
147 | print "</p><p>Your input was:</p>\n<ul>"; |
---|
148 | foreach my $field (@fields) { |
---|
149 | my $param = $cgi->param($field) || ''; |
---|
150 | print "<li>$field: " . $param . "</li>\n"; |
---|
151 | } |
---|
152 | print "</ul>\n"; |
---|
153 | print "<p>$returnlink</p>\n"; |
---|
154 | print "</body></html>\n"; |
---|
155 | } |
---|
156 | |
---|
157 | sub setup_dbh { |
---|
158 | # $dbh is global |
---|
159 | my $data_source = "dbi:Pg:dbname=$dbname"; |
---|
160 | $data_source .= ";host=$dbhost" if $dbhost; |
---|
161 | return $dbh = DBI->connect_cached($data_source, $dbuser, $dbpass); |
---|
162 | } |
---|
163 | |
---|