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

Last change on this file since 300 was 300, checked in by Dominic Hargreaves, 13 years ago

More cleanups

  • Property svn:executable set to *
File size: 3.4 KB
Line 
1#!/usr/bin/perl
2#
3# Copyright (c) 2006 Dominic Hargreaves
4# See accompanying file "LICENCE" for licence details
5#
6# Find postcodes that seem to be a long way from their friends
7
8# TODO: Make PostGreSQL temp tables + FastCGI play nicely together
9#       For now, we have a race condition related to the "temp" table
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
30my $cgi;
31# Process incoming requests
32REQUEST: while ($cgi = new CGI::Fast) {
33
34    # In case the database went away, make sure we have a connection
35    unless ($dbh = setup_dbh()) {
36        print_internal_err('Error setting up database connection');
37        next REQUEST;
38    }
39
40    # Input validation
41        my $doing_outer1 = 0;
42    if (defined $cgi->param("outer1") || defined $cgi->param("outerone")) {
43        $doing_outer1 = 1;
44    }
45
46        # How big a distance before we flag it?
47        # 10km / 10km
48        my $flag_distance = 100 * 1000;
49        if($doing_outer1) {
50                $flag_distance = 10 * 1000;
51        }
52
53        my $pcpart = "outward";
54        my $pcgroup = "outward";
55        if($doing_outer1) {
56                $pcpart = "outward || ' ' || substr(inward,1,1)";
57                $pcgroup = "outward, substr(inward,1,1)";
58        }
59
60        # Tidy up from another run, if required
61        my $checksql = "SELECT tablename FROM pg_tables WHERE tablename = 'averages'";
62        my @has_table = $dbh->selectrow_array($checksql);
63        if(@has_table) {
64                $dbh->do("DROP TABLE averages;");
65        }
66
67        # Get our sql
68        # First calculate the average
69        my $prepsql .= "SELECT $pcpart AS pcpart, AVG(easting) AS avg_easting, AVG(northing) AS avg_northing INTO TEMP TABLE averages FROM postcodes WHERE NOT deleted GROUP BY $pcgroup ";
70
71        # Then join to find problem ones
72        my $sql .= "SELECT postcodes.id, outward || ' ' || inward AS postcode, $pcpart AS pcpart, easting, northing, avg_easting, avg_northing, source, sources.name AS source_name ";
73        $sql .= "FROM postcodes ";
74        $sql .= "INNER JOIN averages ON ($pcpart = pcpart) ";
75        $sql .= "INNER JOIN sources ON (postcodes.source = sources.id) ";
76        $sql .= "WHERE NOT deleted AND (";
77        $sql .= "       abs(avg_easting-easting) > $flag_distance ";
78        $sql .= "       OR abs(avg_northing-northing) > $flag_distance ";
79        $sql .= ") ORDER BY outward, inward ";
80
81        # Build the temp table
82    $dbh->do($prepsql);
83
84        # Do the query
85    my $sth = $dbh->prepare($sql);
86    if ($sth->execute()) {
87        print "Content-type: text/javascript\n\n";
88
89                print "// id, postcode, match part, easting, northing, avg easting, avg northing, source id, source\n";
90        while(my @row = $sth->fetchrow_array) {
91                        # Tidy up avg
92                        my $avg_e = int($row[5]);
93                        my $avg_n = int($row[6]);
94
95                        # Print
96                        print "addProblem($row[0],'$row[1]','$row[2]', $row[3], $row[4], $avg_e, $avg_n, $row[7], '$row[8]');\n";
97        }
98    } else {
99        print_internal_err("Database error retrieving data");
100    }
101
102        # Tidy up
103        @has_table = $dbh->selectrow_array($checksql);
104        if(@has_table) {
105                $dbh->do("DROP TABLE averages");
106        }
107}
108
109# No more requests to serve, so tidy up
110$dbh->disconnect;
111
112# Helper routines
113sub print_err {
114    my $err = shift;
115    print header("text/plain", "400 $err");
116    print "Error: $err\n";
117}
118
119sub print_internal_err {
120    my $err = shift;
121    print header("text/plain", "500 $err");
122    print "Error: $err\n";
123}
Note: See TracBrowser for help on using the repository browser.