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

Last change on this file was 764, checked in by Dominic Hargreaves, 4 years ago

Fix more CGI::header issues (see previous commit)

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