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

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

Do the area lookup a bit cleaner

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