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

Last change on this file since 404 was 404, checked in by Nick Burch, 14 years ago

Update API docs, and an associated tweak to the geocoder

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