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