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

Last change on this file since 364 was 364, checked in by Nick Burch, 14 years ago

Make a start on a geocoder (not qutie finished yet though)

  • Property svn:executable set to *
File size: 4.3 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 = $cgi->param("postcode");
68                ($outward,$inward) = ($postcode =~ /^(\w+\d+\w?)\s*(\d\w\w)$/);
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 =~ /^(\w+)\d/);
93                my $mlen = length($mpart);
94
95                ($easting,$northing,$matched,$pc) = 
96                                execute($area_matcher,$mlen,$mlen,$mpart,$mlen);
97        }
98
99        print "$easting $northing $matched $pc\n";
100
101}
102
103# No more requests to serve, so tidy up
104$dbh->disconnect;
105
106# Run a matcher query
107sub execute {
108        my $matcher = shift;
109        my @args = @_;
110
111        my ($easting,$northing,$matched,$pc);
112
113        $matcher->execute(@args);
114        while( my @row = $matcher->fetchrow_array ) {
115                ($easting,$northing,$matched,$pc) = @row;
116        }
117
118        return ($easting,$northing,$matched,$pc);
119}
120
121# Build our various matcher prepared statements
122sub build_matchers {
123        my $dbh = shift;
124
125        my $base_sql_a = "SELECT AVG(easting) AS easting, ".
126                         "AVG(northing) AS northing, COUNT(id) AS matched, ";
127        my $base_sql_b = " AS postcode ".
128                         "FROM postcodes ".
129                         "WHERE NOT deleted ";
130
131        my $full_sql = $base_sql_a . " outward || ' ' || inward " . $base_sql_b . 
132                   "AND outward = ? AND inward = ? ".
133                       "GROUP BY outward, inward";
134        my $outer1_sql = $base_sql_a . " outward || ' ' || substr(inward,1,1) || '##'".
135                       $base_sql_b . "AND outward = ? AND substr(inward,1,1) = ?".
136                       "GROUP BY outward, substr(inward,1,1)";
137        my $outer_sql = $base_sql_a . " outward || ' ###'". $base_sql_b . 
138                   "AND outward = ? GROUP BY outward";
139        my $area_sql = $base_sql_a . " substr(outward,1,?) " . $base_sql_b . 
140                       "AND substr(outward,1,?) = ? ".
141                       "GROUP BY substr(outward,1,?)";
142print $area_sql."\n";
143
144        my $full_matcher = $dbh->prepare($full_sql);
145        my $outer1_matcher = $dbh->prepare($outer1_sql);
146        my $outer_matcher = $dbh->prepare($outer_sql);
147        my $area_matcher = $dbh->prepare($area_sql);
148
149        return ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher);
150}
151
152# Helper routines
153sub print_err {
154    my $err = shift;
155    print header("text/plain", "400 $err");
156    print "Error: $err\n";
157}
158
159sub print_internal_err {
160    my $err = shift;
161    print header("text/plain", "500 $err");
162    print "Error: $err\n";
163}
Note: See TracBrowser for help on using the repository browser.