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

#!/usr/bin/perl
# Looks up a location for a given postcode, returning the closest we have,
#  and an idea of how accurate a match we found.
# Can return plain text, or XML
#
# TODO: Make me more generic, so I can work on the portal site
#
# Copyright (c) 2006 Dominic Hargreaves
# See accompanying file "LICENCE" for licence details

use strict;
use warnings;

use CGI::Fast qw/:standard -debug/;

# Find our private perl libraries
use FindBin;
use lib "$FindBin::Bin/../perllib";
use NPEMap;

sub print_err;

# Set up database handler to try and make sure it's ready for the first
# request
# No point in handling errors here since they'll get handled by the request
# handler
my $dbh = setup_dbh();

# Build our prepared statements
my ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
        &build_matchers($dbh);


my @outputs = qw(text xml);

my $cgi;
# Process incoming requests
REQUEST: while ($cgi = new CGI::Fast) {

    # In case the database went away, make sure we have a connection
    unless ($dbh = setup_dbh()) {
        print_internal_err('Error setting up database connection');
        next REQUEST;
    }
        # Ensure we still have prepared statements
        unless($full_matcher) {
                ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher) =
                        &build_matchers($dbh);
        }


        # What output format do they want?
        my $output = $outputs[0];
        if(defined $cgi->param("format")) {
                foreach my $possoutput (@outputs) {
                        if($possoutput eq $cgi->param("format")) {
                                $output = $possoutput;
                        }
                }
        }

        # What postcode were they asking about?
        my $postcode;
        my $outward;
        my $inward;
        if(defined $cgi->param("postcode")) {
                $postcode = uc($cgi->param("postcode"));
                ($outward,$inward) = ($postcode =~ /^([A-Z]+\d+[A-Z]?)\s*(\d[A-Z][A-Z])$/);
                unless($outward && $inward) {
                        print_err ("Invalid postcode '$postcode' supplied");
                        next REQUEST;
                }
        } else {
                print_err ("Required parameter 'postcode' not supplied");
                next REQUEST;
        }


        my ($easting,$northing,$matched,$pc);

        # Work out until we find a match
        ($easting,$northing,$matched,$pc) = execute($full_matcher,$outward,$inward);
        unless($matched) {
                ($easting,$northing,$matched,$pc) = 
                                execute($outer1_matcher,$outward,substr($inward,0,1));
        }
        unless($matched) {
                ($easting,$northing,$matched,$pc) = 
                                execute($outer_matcher,$outward);
        }
        unless($matched) {
                my ($mpart) = ($outward =~ /^([A-Z]+)\d/);
                my $mlen = length($mpart);

                ($easting,$northing,$matched,$pc) = 
                                execute($area_matcher,$mpart,$mlen,$mlen,$mpart,$mlen);

                unless($matched) {
                        print_err "Postcode area '$mpart' not found, postcode probably invalid";
                        next REQUEST;
                }
        }

        # Render
        if($output eq "xml") {
                print header("text/xml");
                print "<?xml version='1.0'?>\n";
                print "<geocoder>\n";
                print "  <request>\n";
                print "     <postcode>$postcode</postcode>\n";
                print "     <outward>$outward</outward>\n";
                print "     <inward>$inward</inward>\n";
                print "  </request>\n\n";
                print "  <easting>".int($easting)."</easting>\n";
                print "  <northing>".int($northing)."</northing>\n";
                print "  <postcode>$pc</postcode>\n";
                print "</geocoder>\n";
        } else {
                print header("text/plain");
                print "# Easting,Northing,Matched Postcode\n";
                print int($easting).",".int($northing).",'$pc'\n";
        }
}

# No more requests to serve, so tidy up
$dbh->disconnect;

# Run a matcher query
sub execute {
        my $matcher = shift;
        my @args = @_;

        my ($easting,$northing,$matched,$pc);

        $matcher->execute(@args);
        while( my @row = $matcher->fetchrow_array ) {
                ($easting,$northing,$matched,$pc) = @row;
        }

        return ($easting,$northing,$matched,$pc);
}

# Build our various matcher prepared statements
sub build_matchers {
        my $dbh = shift;

        my $base_sql_a = "SELECT AVG(easting) AS easting, ".
                         "AVG(northing) AS northing, COUNT(id) AS matched, ";
        my $base_sql_b = " AS postcode ".
                         "FROM postcodes ".
                         "WHERE NOT deleted ";

        my $full_sql = $base_sql_a . " outward || ' ' || inward " . $base_sql_b . 
                   "AND outward = ? AND inward = ? ".
                       "GROUP BY outward, inward";
        my $outer1_sql = $base_sql_a . " outward || ' ' || substr(inward,1,1) || '##'".
                       $base_sql_b . "AND outward = ? AND substr(inward,1,1) = ?".
                       "GROUP BY outward, substr(inward,1,1)";
        my $outer_sql = $base_sql_a . " outward || ' ###'". $base_sql_b . 
                   "AND outward = ? GROUP BY outward";
        my $area_sql = $base_sql_a . " substr(?,1,?) " . $base_sql_b . 
                       "AND substr(outward,1,?) = ? ".
                       "GROUP BY substr(outward,1,?)";

        my $full_matcher = $dbh->prepare($full_sql);
        my $outer1_matcher = $dbh->prepare($outer1_sql);
        my $outer_matcher = $dbh->prepare($outer_sql);
        my $area_matcher = $dbh->prepare($area_sql);

        return ($full_matcher,$outer1_matcher,$outer_matcher,$area_matcher);
}

# Helper routines
sub print_err {
    my $err = shift;
    print header("text/plain", "400 $err");
    print "Error: $err\n";
}

sub print_internal_err {
    my $err = shift;
    print header("text/plain", "500 $err");
    print "Error: $err\n";
}