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

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

Add sql for location->postcode. Still need to add code to call it though

  • Property svn:executable set to *
File size: 6.1 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
36
37
38my @outputs = qw(text xml js);
39
40my $cgi;
41# Process incoming requests
42REQUEST: while ($cgi = new CGI::Fast) {
43
44    # In case the database went away, make sure we have a connection
45    unless ($dbh = setup_dbh()) {
46        print_internal_err('Error setting up database connection');
47        next REQUEST;
48    }
49        # Ensure we still have prepared statements
50        unless($full_matcher) {
51                ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
52                        &build_ptl_matchers($dbh);
53        }
54        unless($postcode_matcher) {
55                $postcode_matcher = &build_ltp_matcher($dbh);
56        }
57
58
59        # What output format do they want?
60        my $output = $outputs[0];
61        if(defined $cgi->param("format")) {
62                foreach my $possoutput (@outputs) {
63                        if($possoutput eq $cgi->param("format")) {
64                                $output = $possoutput;
65                        }
66                }
67        }
68
69        # Did they want to do postcode -> location, or location -> postcode?
70
71        # What postcode were they asking about?
72        my $postcode;
73        my $outward;
74        my $inward;
75        if(defined $cgi->param("postcode")) {
76                $postcode = uc($cgi->param("postcode"));
77                ($outward,$inward) = ($postcode =~ /^([A-Z]+\d+[A-Z]?)\s*(\d[A-Z][A-Z])?$/);
78                unless($outward) {
79                        print_err ("Invalid postcode '$postcode' supplied");
80                        next REQUEST;
81                }
82        } else {
83                print_err ("Required parameter 'postcode' not supplied");
84                next REQUEST;
85        }
86
87
88        my ($easting,$northing,$matched,$pc);
89
90        # Work out until we find a match
91        ($easting,$northing,$matched,$pc) = execute($full_matcher,$outward,$inward);
92        unless($matched) {
93                ($easting,$northing,$matched,$pc) = 
94                                execute($outer1_matcher,$outward,substr($inward,0,1));
95        }
96        unless($matched) {
97                ($easting,$northing,$matched,$pc) = 
98                                execute($outer_matcher,$outward);
99        }
100        unless($matched) {
101                my ($mpart) = ($outward =~ /^([A-Z]+)\d/);
102                my $mlen = length($mpart);
103
104                ($easting,$northing,$matched,$pc) = 
105                                execute($area_matcher,$mpart,$mlen,$mpart,$mlen);
106
107                unless($matched) {
108                        print_err "Postcode area '$mpart' not found, postcode probably invalid";
109                        next REQUEST;
110                }
111        }
112
113        # Render
114        if($output eq "xml") {
115                print header("text/xml");
116                print "<?xml version='1.0'?>\n";
117                print "<geocoder>\n";
118                print "  <request>\n";
119                print "     <postcode>$postcode</postcode>\n";
120                print "     <outward>$outward</outward>\n";
121                print "     <inward>$inward</inward>\n";
122                print "  </request>\n\n";
123                print "  <easting>".int($easting)."</easting>\n";
124                print "  <northing>".int($northing)."</northing>\n";
125                print "  <postcode>$pc</postcode>\n";
126                print "</geocoder>\n";
127        } elsif ($output eq "js") {
128                print header("text/javascript");
129        my ($e, $n) = (int($easting), int($northing));
130          if(defined $cgi->param("callback")) {
131          print ($cgi->param("callback") . "(");
132      }
133      print "{ pc: \"$pc\", e: $e, n: $n }";
134          if(defined $cgi->param("callback")) {
135          print ");";
136      }
137      print "\n";
138       
139    } else {
140                print header("text/plain");
141                print "# Easting,Northing,Matched Postcode\n";
142                print int($easting).",".int($northing).",'$pc'\n";
143        }
144}
145
146# No more requests to serve, so tidy up
147$dbh->disconnect;
148
149# Run a matcher query
150sub execute {
151        my $matcher = shift;
152        my @args = @_;
153
154        my ($easting,$northing,$matched,$pc);
155
156        $matcher->execute(@args);
157        while( my @row = $matcher->fetchrow_array ) {
158                ($easting,$northing,$matched,$pc) = @row;
159        }
160
161        return ($easting,$northing,$matched,$pc);
162}
163
164# Build our various matcher prepared statements
165
166# Postcode to Location matchers
167sub build_ptl_matchers {
168        my $dbh = shift;
169
170        my $base_sql_a = "SELECT AVG(easting) AS easting, ".
171                         "AVG(northing) AS northing, COUNT(id) AS matched, ";
172        my $base_sql_b = " AS postcode ".
173                         "FROM postcodes ".
174                         "WHERE NOT deleted ";
175
176        my $full_sql = $base_sql_a . " outward || ' ' || inward " . $base_sql_b . 
177                   "AND outward = ? AND inward = ? ".
178                       "GROUP BY outward, inward";
179        my $outer1_sql = $base_sql_a . " outward || ' ' || substr(inward,1,1) || '##'".
180                       $base_sql_b . "AND outward = ? AND substr(inward,1,1) = ?".
181                       "GROUP BY outward, substr(inward,1,1)";
182        my $outer_sql = $base_sql_a . " outward || ' ###'". $base_sql_b . 
183                   "AND outward = ? GROUP BY outward";
184        my $area_sql = $base_sql_a . " ? || '' " . $base_sql_b . 
185                       "AND substr(outward,1,?) = ? ".
186                       "GROUP BY substr(outward,1,?)";
187
188        my $full_matcher = $dbh->prepare($full_sql);
189        my $outer1_matcher = $dbh->prepare($outer1_sql);
190        my $outer_matcher = $dbh->prepare($outer_sql);
191        my $area_matcher = $dbh->prepare($area_sql);
192
193        return ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher);
194}
195
196# Location to Postcode matcher
197sub build_ltp_matcher {
198        my $dbh = shift;
199
200        my $sql = "SELECT outward, inward, easting, northing ".
201                  "FROM postcodes ".
202                  "WHERE inward IS NOT NULL AND inward <> '' ".
203                  "ORDER BY ( ".
204                  "   POW(easting - ?, 2) + POW(northing - ?, 2) ".
205                  ") LIMIT ? ";
206
207        my $matcher = $dbh->prepare($sql);
208        return $matcher;
209}
210
211# Helper routines
212sub print_err {
213    my $err = shift;
214    print header("text/plain", "400 $err");
215    print "Error: $err\n";
216}
217
218sub print_internal_err {
219    my $err = shift;
220    print header("text/plain", "500 $err");
221    print "Error: $err\n";
222}
Note: See TracBrowser for help on using the repository browser.