source: trunk/npemap.org.uk/cgi/get-distant-postcodes.fcgi @ 199

#!/usr/bin/perl
#
# Copyright (c) 2006 Dominic Hargreaves
# See accompanying file "LICENCE" for licence details
#
# Find postcodes that seem to be a long way from their friends

use strict;
use warnings;

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

use vars qw($dbname $dbhost $dbuser $dbpass);

sub print_err;
sub setup_dbh;

# Read in database config
my $config = 'npemap.conf';
do $config or die "Can't read $config!\n";


# 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();


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

    # In case the database went away, make sure we have a connection
    unless (setup_dbh()) {
        print_internal_err('Error setting up database connection');
        next REQUEST;
    }

    # Input validation
        my $doing_outer1 = 0;
    if (defined $cgi->param("outer1") || defined $cgi->param("outerone")) {
        $doing_outer1 = 1;
    }

        # How big a distance before we flag it?
        # 10km / 10km
        my $flag_distance = 100 * 1000;
        if($doing_outer1) {
                $flag_distance = 10 * 1000;
        }

        my $pcpart = "outward";
        my $pcgroup = "outward";
        if($doing_outer1) {
                $pcpart = "outward || substr(inward,1,1)";
                $pcgroup = "outward, substr(inward,1,1)";
        }

        # Tidy up from another run, if required
        my $checksql = "SELECT tablename FROM pg_tables WHERE tablename = 'averages'";
        my @has_table = $dbh->selectrow_array($checksql);
        if(@has_table) {
                $dbh->do("DROP TABLE averages;");
        }

        # Get our sql
        # First calculate the average
        my $prepsql .= "SELECT $pcpart AS pcpart, AVG(easting) AS avg_easting, AVG(northing) AS avg_northing INTO TEMP TABLE averages FROM postcodes GROUP BY $pcgroup ";

        # Then join to find problem ones
        my $sql .= "SELECT id, outward || ' ' || inward AS postcode, $pcpart AS pcpart, easting, northing, avg_easting, avg_northing FROM postcodes ";
        $sql .= "INNER JOIN averages ON ($pcpart = pcpart) ";
        $sql .= "WHERE abs(avg_easting-easting) > $flag_distance ";
        $sql .= "OR abs(avg_northing-northing) > $flag_distance ";
        $sql .= "ORDER BY outward, inward ";

        # Build the temp table
    $dbh->do($prepsql);

        # Do the query
    my $sth = $dbh->prepare($sql);
    if ($sth->execute()) {
        print "Content-type: text/javascript\n\n";

                print "// id, postcode, match part, easting, northing, avg easting, avg northing\n";
        while(my @row = $sth->fetchrow_array) {
                        # Tidy up avg
                        my $avg_e = int($row[5]);
                        my $avg_n = int($row[6]);

                        # Print
                        print "addProblem($row[0],'$row[1]','$row[2]', $row[3], $row[4], $avg_e, $avg_n);\n";
        }
    } else {
        print_internal_err("Database error retrieving data");
    }

        # Tidy up
        @has_table = $dbh->selectrow_array($checksql);
        if(@has_table) {
                $dbh->do("DROP TABLE averages");
        }
}

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

# 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";
}

sub setup_dbh {
    # $dbh is global
    my $data_source = "dbi:Pg:dbname=$dbname";
    $data_source .= ";host=$dbhost" if $dbhost;
    return $dbh = DBI->connect_cached($data_source, $dbuser, $dbpass);
}