source: trunk/npemap.org.uk/cgi/geocoder.fcgi @ 594

Last change on this file since 594 was 594, checked in by Nick Burch, 12 years ago

Improved detection of no results on postcode matches

  • Property svn:executable set to *
File size: 11.2 KB
Line 
1#!/usr/bin/perl
2# Looks up a location for a given postcode, returning the closest we have,
3#  and an idea of how accurate a match we found.
4# Looks up the nearest postcode for a given location, optionally returning
5#  the several nearest (rather than just the nearest)
6# Looks up the nearest postcode area for a given location, optionally
7#  returning the several nearest (rather than just the nearest)
8#
9# Can return plain text, JS, JS callback, or XML
10#
11# TODO: Make me more generic, so I can work on the portal site
12#
13# Copyright (c) 2006 Dominic Hargreaves, Nick Burch and David Sheldon
14# See accompanying file "LICENCE" for licence details
15
16use strict;
17use warnings;
18
19use CGI::Fast qw/:standard -debug/;
20
21# Find our private perl libraries
22use FindBin;
23use lib "$FindBin::Bin/../perllib";
24use NPEMap;
25use NPEMap::GeoConverter;
26
27sub print_err;
28
29# Set up database handler to try and make sure it's ready for the first
30# request
31# No point in handling errors here since they'll get handled by the request
32# handler
33my $dbh = setup_dbh();
34
35# Build our prepared statements:
36#   Postcode to location matchers
37my ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
38        &build_ptl_matchers($dbh);
39#   Location to postcode matcher
40my $postcode_matcher = &build_ltp_matcher($dbh);
41#   Location to area code matchers
42my $pc_area_matcher = &build_lta_matcher($dbh);
43
44
45my @outputs = qw(text xml js);
46
47my $cgi;
48# Process incoming requests
49REQUEST: while ($cgi = new CGI::Fast) {
50
51    # In case the database went away, make sure we have a connection
52    unless ($dbh = setup_dbh()) {
53        print_internal_err('Error setting up database connection');
54        next REQUEST;
55    }
56        # Ensure we still have prepared statements
57        unless($full_matcher) {
58                ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
59                        &build_ptl_matchers($dbh);
60        }
61        unless($postcode_matcher) {
62                $postcode_matcher = &build_ltp_matcher($dbh);
63        }
64        unless($pc_area_matcher) {
65                $pc_area_matcher = &build_lta_matcher($dbh);
66        }
67
68
69        # What output format do they want?
70        my $output = $outputs[0];
71        if(defined $cgi->param("format")) {
72                foreach my $possoutput (@outputs) {
73                        if($possoutput eq $cgi->param("format")) {
74                                $output = $possoutput;
75                        }
76                }
77        }
78
79        # How many results did they want?
80        # (Not all searches support more than one result)
81        my $limit_results = 1;
82        if(defined $cgi->param("results")) {
83                $limit_results = $cgi->param("results");
84                unless($limit_results =~ /^\d+$/) {
85                        print_err ("Invalid maximum number of results '$limit_results' supplied");
86                        next REQUEST;
87                }
88        }
89
90
91        # Did they want to do postcode -> location, or location -> postcode?
92        my %request;
93        my @results;
94
95        # What postcode were they asking about?
96        if(defined $cgi->param("postcode") && $cgi->param("postcode")) {
97                $limit_results = 1;
98                $request{type} = "location";
99
100                $request{postcode} = uc($cgi->param("postcode"));
101                ($request{outward},$request{inward}) = 
102                                ($request{postcode} =~ /^([A-Z]+\d+[A-Z]?)\s*(\d[A-Z][A-Z])?$/);
103
104                unless($request{outward}) {
105                        print_err ("Invalid postcode '".$request{postcode}."' supplied");
106                        next REQUEST;
107                }
108        } elsif(defined $cgi->param("easting") && $cgi->param("easting") && 
109                defined $cgi->param("northing") && $cgi->param("northing")) {
110                $request{type} = "postcode";
111                $request{easting} = $cgi->param("easting");
112                $request{northing} = $cgi->param("northing");
113
114                if( (defined $cgi->param("area") && $cgi->param("area")) ||
115                    (defined $cgi->param("areas") && $cgi->param("areas")) ) {
116                        $request{type} = "area";
117                }
118
119                unless($request{easting} =~ /^\d+$/) {
120                        print_err ("Invalid easting '".$request{easting}."' supplied");
121                        next REQUEST;
122                }
123                unless($request{northing} =~ /^\d+$/) {
124                        print_err ("Invalid northing '".$request{northing}."' supplied");
125                        next REQUEST;
126                }
127        } else {
128                print_err ("You must either supply the parameter 'postcode', or the two parameters 'easting' and 'northing'");
129                next REQUEST;
130        }
131
132
133        # Find what the user was after
134        if($request{type} eq "area") {
135                @results = execute_lt($pc_area_matcher, $request{easting}, $request{northing}, $limit_results);
136        }
137        elsif($request{type} eq "postcode") {
138                @results = execute_lt($postcode_matcher, $request{easting}, $request{northing}, $limit_results);
139        }
140        else {
141                my ($easting,$northing,$matched,$pc);
142                my ($outward,$inward) = ($request{outward},$request{inward});
143
144                # Work out until we find a match
145                ($easting,$northing,$matched,$pc) = execute_ptl($full_matcher,$outward,$inward);
146
147                # Ensure the search worked, and the db isn't broken
148                unless(defined $easting) {
149                        warn("Search failed to execute, is the database server down?");
150                        ($full_matcher,$postcode_matcher,$pc_area_matcher) = (undef,undef,undef);
151                        print_internal_err('Error setting up database connection');
152                        next REQUEST;
153                }
154
155                # Keep looking for a match
156                unless($matched) {
157                        ($easting,$northing,$matched,$pc) = 
158                                        execute_ptl($outer1_matcher,$outward,substr($inward,0,1));
159                }
160                unless($matched) {
161                        ($easting,$northing,$matched,$pc) = 
162                                        execute_ptl($outer_matcher,$outward);
163                }
164                unless($matched) {
165                        my ($mpart) = ($outward =~ /^([A-Z]+)\d/);
166                        my $mlen = length($mpart);
167
168                        ($easting,$northing,$matched,$pc) = 
169                                        execute_ptl($area_matcher,$mpart,$mlen,$mpart,$mlen);
170
171                        unless($matched) {
172                                print_err "Postcode area '$mpart' not found, postcode probably invalid";
173                                next REQUEST;
174                        }
175                }
176
177                # Save the results
178                my %res;
179                $res{easting} = $easting;
180                $res{northing} = $northing;
181                $res{matched} = $matched;
182                $res{postcode} = $pc;
183                push @results, \%res;
184        }
185
186
187        # Format the easting and northing, if we have them
188        foreach my $res (@results) {
189                if($res->{easting}) {
190                        $res->{ieasting} = int($res->{easting});
191                }
192                if($res->{northing}) {
193                        $res->{inorthing} = int($res->{northing});
194                }
195        }
196
197        # Generate the lat and long, if we had easting and northings
198        foreach my $res (@results) {
199                if($res->{easting} && $res->{northing}) {
200                        ($res->{lat},$res->{long}) = 
201                                eastingNorthingToLatLong($res->{easting},$res->{northing});
202                }       
203        }
204
205        # Render
206        if($output eq "xml") {
207                print header("text/xml");
208                print "<?xml version='1.0'?>\n";
209                print "<geocoder>\n";
210                print "  <request>\n";
211                if($request{postcode}) {
212                        print "     <postcode>$request{postcode}</postcode>\n";
213                        print "     <outward>$request{outward}</outward>\n";
214                        print "     <inward>$request{inward}</inward>\n";
215                } else {
216                        print "     <easting>$request{easting}</easting>\n";
217                        print "     <northing>$request{northing}</northing>\n";
218                }
219                print "  </request>\n\n";
220
221                foreach my $res (@results) {
222                        if(scalar @results > 1) {
223                                print "  <result>\n";
224                        }
225                        print "    <easting>".$res->{ieasting}."</easting>\n";
226                        print "    <northing>".$res->{inorthing}."</northing>\n";
227                        print "    <postcode>$res->{postcode}</postcode>\n";
228                        print "     <latitude>$res->{lat}</latitude>\n";
229                        print "     <longitude>$res->{long}</longitude>\n";
230                        if(scalar @results > 1) {
231                                print "  </result>\n";
232                        }
233                }
234
235                print "</geocoder>\n";
236        } elsif ($output eq "js") {
237                print header("text/javascript");
238
239                if(defined $cgi->param("callback")) {
240                        print $cgi->param("callback") . "(";
241                }
242                # TODO:
243                #  make me play nicely if there are several results
244                #  (need to do some array magic probably)
245                foreach my $res (@results) {
246                        print "{ \"pc\": \"$res->{postcode}\", \"e\": $res->{ieasting}, \"n\": $res->{inorthing}, \"lat\": $res->{lat}, \"lng\": $res->{long} }";
247                }
248                if(defined $cgi->param("callback")) {
249                        print ");";
250                }
251                print "\n";
252    } else {
253                print header("text/plain");
254                print "# Easting,Northing,Matched Postcode,Latitude,Longitude\n";
255
256                foreach my $res (@results) {
257                        print $res->{ieasting}.",".$res->{inorthing}.",'".$res->{postcode}."',".$res->{lat}.",".$res->{long}."\n";
258                }
259        }
260}
261
262# No more requests to serve, so tidy up
263$dbh->disconnect;
264
265# Run a postcode to location matcher
266sub execute_ptl {
267        my $matcher = shift;
268        my @args = @_;
269
270        my ($easting,$northing,$matched,$pc) = (0,0,0,'');
271
272        my $res = $matcher->execute(@args);
273        # Should have got something back, unless it's broken
274        unless(defined $res) {
275                warn("Nothing received from execute, is the connection open?");
276                return undef;
277        }
278
279        while( my @row = $matcher->fetchrow_array ) {
280                ($easting,$northing,$matched,$pc) = @row;
281        }
282
283        return ($easting,$northing,$matched,$pc);
284}
285
286# Run a location to postcode/area matcher
287sub execute_lt {
288        my $matcher = shift;
289        my @args = @_;
290
291        my @results;
292
293        my $res = $matcher->execute(@args);
294        # Should have got something back, unless it's broken
295        unless(defined $res) {
296                warn("Nothing received from execute, is the connection open?");
297                return undef;
298        }
299
300        while( my @row = $matcher->fetchrow_array ) {
301                my %res = (
302                        outward  => $row[0],
303                        inward   => $row[1],
304                        easting  => $row[2],
305                        northing => $row[3]
306                );
307
308                if($res{inward}) {
309                        $res{postcode} = $res{outward}." ".$res{inward};
310                } else {
311                        $res{postcode} = $res{outward};
312                }
313
314                push @results, \%res;
315        }
316
317        return @results;
318}
319
320
321# Build our various matcher prepared statements
322
323# Postcode to Location matchers
324sub build_ptl_matchers {
325        my $dbh = shift;
326
327        my $base_sql_a = "SELECT AVG(easting) AS easting, ".
328                         "AVG(northing) AS northing, COUNT(id) AS matched, ";
329        my $base_sql_b = " AS postcode ".
330                         "FROM postcodes ".
331                         "WHERE NOT deleted ";
332
333        my $full_sql = $base_sql_a . " outward || ' ' || inward " . $base_sql_b . 
334                   "AND outward = ? AND inward = ? ".
335                       "GROUP BY outward, inward";
336        my $outer1_sql = $base_sql_a . " outward || ' ' || substr(inward,1,1) || '##'".
337                       $base_sql_b . "AND outward = ? AND substr(inward,1,1) = ?".
338                       "GROUP BY outward, substr(inward,1,1)";
339        my $outer_sql = $base_sql_a . " outward || ' ###'". $base_sql_b . 
340                   "AND outward = ? GROUP BY outward";
341        my $area_sql = $base_sql_a . " ? || '' " . $base_sql_b . 
342                       "AND substr(outward,1,?) = ? ".
343                       "GROUP BY substr(outward,1,?)";
344
345        my $full_matcher = $dbh->prepare($full_sql);
346        my $outer1_matcher = $dbh->prepare($outer1_sql);
347        my $outer_matcher = $dbh->prepare($outer_sql);
348        my $area_matcher = $dbh->prepare($area_sql);
349
350        return ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher);
351}
352
353# Location to Postcode matcher
354sub build_ltp_matcher {
355        my $dbh = shift;
356
357        my $sql = "SELECT outward, inward, easting, northing ".
358                  "FROM postcodes ".
359                  "WHERE inward IS NOT NULL AND inward <> '' ".
360                  "ORDER BY ( ".
361                  "   POW(easting - ?, 2) + POW(northing - ?, 2) ".
362                  ") LIMIT ? ";
363
364        my $matcher = $dbh->prepare($sql);
365        return $matcher;
366}
367
368# Location to nearby postcode areas matcher
369sub build_lta_matcher {
370        my $dbh = shift;
371
372        my $sql = "SELECT outward, '' AS inward, avg_e AS easting, avg_n AS northing ".
373                  "FROM ( ".
374                  "   SELECT outward, ".
375                  "          AVG(easting) AS avg_e, ".
376                  "          AVG(northing) AS avg_n ".
377                  "   FROM postcodes ".
378                  "   GROUP BY outward ".
379                  ") AS areas ".
380                  "ORDER BY ( ".
381                  "   POW(avg_e - ?, 2) + POW(avg_n - ?, 2) ".
382                  ") LIMIT ? ";
383
384        my $matcher = $dbh->prepare($sql);
385        return $matcher;
386}
387
388
389# Helper routines
390sub print_err {
391    my $err = shift;
392    print header("text/plain", "400 $err");
393    print "Error: $err\n";
394}
395
396sub print_internal_err {
397    my $err = shift;
398    print header("text/plain", "500 $err");
399    print "Error: $err\n";
400}
Note: See TracBrowser for help on using the repository browser.