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

Last change on this file since 372 was 372, checked in by David Sheldon, 14 years ago

Allow searching with just the outward.

  • Property svn:executable set to *
File size: 5.4 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 js);
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) {
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        } elsif ($output eq "js") {
119                print header("text/javascript");
120        my ($e, $n) = (int($easting), int($northing));
121          if(defined $cgi->param("callback")) {
122          print ($cgi->param("callback") . "(");
123      }
124      print "{ pc: \"$pc\", e: $e, n: $n }";
125          if(defined $cgi->param("callback")) {
126          print ");";
127      }
128      print "\n";
129       
130    } else {
131                print header("text/plain");
132                print "# Easting,Northing,Matched Postcode\n";
133                print int($easting).",".int($northing).",'$pc'\n";
134        }
135}
136
137# No more requests to serve, so tidy up
138$dbh->disconnect;
139
140# Run a matcher query
141sub execute {
142        my $matcher = shift;
143        my @args = @_;
144
145        my ($easting,$northing,$matched,$pc);
146
147        $matcher->execute(@args);
148        while( my @row = $matcher->fetchrow_array ) {
149                ($easting,$northing,$matched,$pc) = @row;
150        }
151
152        return ($easting,$northing,$matched,$pc);
153}
154
155# Build our various matcher prepared statements
156sub build_matchers {
157        my $dbh = shift;
158
159        my $base_sql_a = "SELECT AVG(easting) AS easting, ".
160                         "AVG(northing) AS northing, COUNT(id) AS matched, ";
161        my $base_sql_b = " AS postcode ".
162                         "FROM postcodes ".
163                         "WHERE NOT deleted ";
164
165        my $full_sql = $base_sql_a . " outward || ' ' || inward " . $base_sql_b . 
166                   "AND outward = ? AND inward = ? ".
167                       "GROUP BY outward, inward";
168        my $outer1_sql = $base_sql_a . " outward || ' ' || substr(inward,1,1) || '##'".
169                       $base_sql_b . "AND outward = ? AND substr(inward,1,1) = ?".
170                       "GROUP BY outward, substr(inward,1,1)";
171        my $outer_sql = $base_sql_a . " outward || ' ###'". $base_sql_b . 
172                   "AND outward = ? GROUP BY outward";
173        my $area_sql = $base_sql_a . " ? || '' " . $base_sql_b . 
174                       "AND substr(outward,1,?) = ? ".
175                       "GROUP BY substr(outward,1,?)";
176
177        my $full_matcher = $dbh->prepare($full_sql);
178        my $outer1_matcher = $dbh->prepare($outer1_sql);
179        my $outer_matcher = $dbh->prepare($outer_sql);
180        my $area_matcher = $dbh->prepare($area_sql);
181
182        return ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher);
183}
184
185# Helper routines
186sub print_err {
187    my $err = shift;
188    print header("text/plain", "400 $err");
189    print "Error: $err\n";
190}
191
192sub print_internal_err {
193    my $err = shift;
194    print header("text/plain", "500 $err");
195    print "Error: $err\n";
196}
Note: See TracBrowser for help on using the repository browser.