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

Last change on this file since 402 was 402, checked in by Nick Burch, 15 years ago

Add in the sql for the nearby areas, but no code to use it (yet)

  • Property svn:executable set to *
File size: 6.7 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# Can return plain text, or XML
5#
6# TODO: Make me more generic, so I can work on the portal site
7#
8# Copyright (c) 2006 Dominic Hargreaves
9# See accompanying file "LICENCE" for licence details
10
11use strict;
12use warnings;
13
14use CGI::Fast qw/:standard -debug/;
15
16# Find our private perl libraries
17use FindBin;
18use lib "$FindBin::Bin/../perllib";
19use NPEMap;
20
21sub print_err;
22
23# Set up database handler to try and make sure it's ready for the first
24# request
25# No point in handling errors here since they'll get handled by the request
26# handler
27my $dbh = setup_dbh();
28
29# Build our prepared statements:
30#   Postcode to location matchers
31my ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
32        &build_ptl_matchers($dbh);
33#   Location to postcode matcher
34my $postcode_matcher = &build_ltp_matcher($dbh);
35#   Location to area code matchers
36my $pc_area_matcher = &build_lta_matcher($dbh);
37
38
39my @outputs = qw(text xml js);
40
41my $cgi;
42# Process incoming requests
43REQUEST: while ($cgi = new CGI::Fast) {
44
45    # In case the database went away, make sure we have a connection
46    unless ($dbh = setup_dbh()) {
47        print_internal_err('Error setting up database connection');
48        next REQUEST;
49    }
50        # Ensure we still have prepared statements
51        unless($full_matcher) {
52                ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
53                        &build_ptl_matchers($dbh);
54        }
55        unless($postcode_matcher) {
56                $postcode_matcher = &build_ltp_matcher($dbh);
57        }
58        unless($pc_area_matcher) {
59                $pc_area_matcher = &build_lta_matcher($dbh);
60        }
61
62
63        # What output format do they want?
64        my $output = $outputs[0];
65        if(defined $cgi->param("format")) {
66                foreach my $possoutput (@outputs) {
67                        if($possoutput eq $cgi->param("format")) {
68                                $output = $possoutput;
69                        }
70                }
71        }
72
73        # Did they want to do postcode -> location, or location -> postcode?
74
75        # What postcode were they asking about?
76        my $postcode;
77        my $outward;
78        my $inward;
79        if(defined $cgi->param("postcode")) {
80                $postcode = uc($cgi->param("postcode"));
81                ($outward,$inward) = ($postcode =~ /^([A-Z]+\d+[A-Z]?)\s*(\d[A-Z][A-Z])?$/);
82                unless($outward) {
83                        print_err ("Invalid postcode '$postcode' supplied");
84                        next REQUEST;
85                }
86        } else {
87                print_err ("Required parameter 'postcode' not supplied");
88                next REQUEST;
89        }
90
91
92        my ($easting,$northing,$matched,$pc);
93
94        # Work out until we find a match
95        ($easting,$northing,$matched,$pc) = execute($full_matcher,$outward,$inward);
96        unless($matched) {
97                ($easting,$northing,$matched,$pc) = 
98                                execute($outer1_matcher,$outward,substr($inward,0,1));
99        }
100        unless($matched) {
101                ($easting,$northing,$matched,$pc) = 
102                                execute($outer_matcher,$outward);
103        }
104        unless($matched) {
105                my ($mpart) = ($outward =~ /^([A-Z]+)\d/);
106                my $mlen = length($mpart);
107
108                ($easting,$northing,$matched,$pc) = 
109                                execute($area_matcher,$mpart,$mlen,$mpart,$mlen);
110
111                unless($matched) {
112                        print_err "Postcode area '$mpart' not found, postcode probably invalid";
113                        next REQUEST;
114                }
115        }
116
117        # Render
118        if($output eq "xml") {
119                print header("text/xml");
120                print "<?xml version='1.0'?>\n";
121                print "<geocoder>\n";
122                print "  <request>\n";
123                print "     <postcode>$postcode</postcode>\n";
124                print "     <outward>$outward</outward>\n";
125                print "     <inward>$inward</inward>\n";
126                print "  </request>\n\n";
127                print "  <easting>".int($easting)."</easting>\n";
128                print "  <northing>".int($northing)."</northing>\n";
129                print "  <postcode>$pc</postcode>\n";
130                print "</geocoder>\n";
131        } elsif ($output eq "js") {
132                print header("text/javascript");
133        my ($e, $n) = (int($easting), int($northing));
134          if(defined $cgi->param("callback")) {
135          print $cgi->param("callback") . "(";
136      }
137      print "{ pc: \"$pc\", e: $e, n: $n }";
138          if(defined $cgi->param("callback")) {
139          print ");";
140      }
141      print "\n";
142       
143    } else {
144                print header("text/plain");
145                print "# Easting,Northing,Matched Postcode\n";
146                print int($easting).",".int($northing).",'$pc'\n";
147        }
148}
149
150# No more requests to serve, so tidy up
151$dbh->disconnect;
152
153# Run a matcher query
154sub execute {
155        my $matcher = shift;
156        my @args = @_;
157
158        my ($easting,$northing,$matched,$pc);
159
160        $matcher->execute(@args);
161        while( my @row = $matcher->fetchrow_array ) {
162                ($easting,$northing,$matched,$pc) = @row;
163        }
164
165        return ($easting,$northing,$matched,$pc);
166}
167
168# Build our various matcher prepared statements
169
170# Postcode to Location matchers
171sub build_ptl_matchers {
172        my $dbh = shift;
173
174        my $base_sql_a = "SELECT AVG(easting) AS easting, ".
175                         "AVG(northing) AS northing, COUNT(id) AS matched, ";
176        my $base_sql_b = " AS postcode ".
177                         "FROM postcodes ".
178                         "WHERE NOT deleted ";
179
180        my $full_sql = $base_sql_a . " outward || ' ' || inward " . $base_sql_b . 
181                   "AND outward = ? AND inward = ? ".
182                       "GROUP BY outward, inward";
183        my $outer1_sql = $base_sql_a . " outward || ' ' || substr(inward,1,1) || '##'".
184                       $base_sql_b . "AND outward = ? AND substr(inward,1,1) = ?".
185                       "GROUP BY outward, substr(inward,1,1)";
186        my $outer_sql = $base_sql_a . " outward || ' ###'". $base_sql_b . 
187                   "AND outward = ? GROUP BY outward";
188        my $area_sql = $base_sql_a . " ? || '' " . $base_sql_b . 
189                       "AND substr(outward,1,?) = ? ".
190                       "GROUP BY substr(outward,1,?)";
191
192        my $full_matcher = $dbh->prepare($full_sql);
193        my $outer1_matcher = $dbh->prepare($outer1_sql);
194        my $outer_matcher = $dbh->prepare($outer_sql);
195        my $area_matcher = $dbh->prepare($area_sql);
196
197        return ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher);
198}
199
200# Location to Postcode matcher
201sub build_ltp_matcher {
202        my $dbh = shift;
203
204        my $sql = "SELECT outward, inward, easting, northing ".
205                  "FROM postcodes ".
206                  "WHERE inward IS NOT NULL AND inward <> '' ".
207                  "ORDER BY ( ".
208                  "   POW(easting - ?, 2) + POW(northing - ?, 2) ".
209                  ") LIMIT ? ";
210
211        my $matcher = $dbh->prepare($sql);
212        return $matcher;
213}
214
215# Location to nearby postcode areas matcher
216sub build_lta_matcher {
217        my $dbh = shift;
218
219        my $sql = "SELECT outward, avg_e AS easting, avg_n AS northing ".
220                  "FROM ( ".
221                  "   SELECT outward, ".
222                  "          AVG(easting) AS avg_e, ".
223                  "          AVG(northing) AS avg_n ".
224                  "   FROM postcodes ".
225                  "   GROUP BY outward ".
226                  ") AS areas ".
227                  "ORDER BY ( ".
228                  "   POW(avg_e - ?, 2) + POW(avg_n - ?, 2) ".
229                  ") LIMIT ? ";
230
231        my $matcher = $dbh->prepare($sql);
232        return $matcher;
233}
234
235
236# Helper routines
237sub print_err {
238    my $err = shift;
239    print header("text/plain", "400 $err");
240    print "Error: $err\n";
241}
242
243sub print_internal_err {
244    my $err = shift;
245    print header("text/plain", "500 $err");
246    print "Error: $err\n";
247}
Note: See TracBrowser for help on using the repository browser.