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

Last change on this file was 763, checked in by Nick Burch, 4 years ago

Fix for CGI modules in Perl 5.20, along the same lines as the Munin did in 9fabbe79671de2ab6b82c9319e69fb7f6878e921

  • Property svn:executable set to *
File size: 4.4 KB
Line 
1#!/usr/bin/perl
2#
3# Copyright (c) 2006 Dominic Hargreaves
4# Permission is hereby granted, free of charge, to any person obtaining a
5# copy of this software and associated documentation files (the "Software"),
6# to deal in the Software without restriction, including without limitation
7# the rights to use, copy, modify, merge, publish, distribute, sublicense,
8# and/or sell copies of the Software, and to permit persons to whom the
9# Software is furnished to do so, subject to the following conditions:
10#
11# The above copyright notice and this permission notice shall be included in
12# all copies or substantial portions of the Software.
13#
14# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
17# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20# IN THE SOFTWARE.
21#
22# Find postcodes that seem to be a long way from their friends
23
24# TODO: Make PostGreSQL temp tables + FastCGI play nicely together
25#       For now, we have a race condition related to the "temp" table
26
27use strict;
28use warnings;
29
30use CGI::Fast qw/:standard -debug/;
31
32# Find our private perl libraries
33use FindBin;
34use lib "$FindBin::Bin/../perllib";
35use NPEMap;
36
37sub print_err;
38
39# Set up database handler to try and make sure it's ready for the first
40# request
41# No point in handling errors here since they'll get handled by the request
42# handler
43my $dbh = setup_dbh();
44
45
46my $cgi;
47# Process incoming requests
48REQUEST: while ($cgi = new CGI::Fast) {
49
50    # In case the database went away, make sure we have a connection
51    unless ($dbh = setup_dbh()) {
52        print_internal_err('Error setting up database connection');
53        next REQUEST;
54    }
55
56    # Input validation
57        my $doing_outer1 = 0;
58    if (defined $cgi->param("outer1") || defined $cgi->param("outerone")) {
59        $doing_outer1 = 1;
60    }
61
62        # How big a distance before we flag it?
63        my $flag_distance = 100 * 1000;
64        if($doing_outer1) {
65                $flag_distance = 25 * 1000;
66        }
67
68        my $pcpart = "outward";
69        my $pcgroup = "outward";
70        if($doing_outer1) {
71                $pcpart = "outward || ' ' || substr(inward,1,1)";
72                $pcgroup = "outward, substr(inward,1,1)";
73        }
74
75        # Tidy up from another run, if required
76        my $checksql = "SELECT tablename FROM pg_tables WHERE tablename = 'averages'";
77        my @has_table = $dbh->selectrow_array($checksql);
78        if(@has_table) {
79                $dbh->do("DROP TABLE averages;");
80        }
81
82        # Get our sql
83        # First calculate the average
84        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 ";
85
86        # Then join to find problem ones
87        my $sql .= "SELECT postcodes.id, outward || ' ' || inward AS postcode, $pcpart AS pcpart, easting, northing, avg_easting, avg_northing, source, sources.name AS source_name ";
88        $sql .= "FROM postcodes ";
89        $sql .= "INNER JOIN averages ON ($pcpart = pcpart) ";
90        $sql .= "INNER JOIN sources ON (postcodes.source = sources.id) ";
91        $sql .= "WHERE NOT deleted AND (";
92        $sql .= "       abs(avg_easting-easting) > $flag_distance ";
93        $sql .= "       OR abs(avg_northing-northing) > $flag_distance ";
94        $sql .= ") ORDER BY (abs(avg_easting-easting)+abs(avg_northing-northing)) DESC, outward, inward ";
95
96        # Build the temp table
97    $dbh->do($prepsql);
98
99        # Do the query
100    my $sth = $dbh->prepare($sql);
101    if ($sth->execute()) {
102        print "Content-type: text/javascript\n\n";
103
104                print "// id, postcode, match part, easting, northing, avg easting, avg northing, source id, source\n";
105        while(my @row = $sth->fetchrow_array) {
106                        # Tidy up avg
107                        my $avg_e = int($row[5]);
108                        my $avg_n = int($row[6]);
109
110                        # Print
111                        print "addProblem($row[0],'$row[1]','$row[2]', $row[3], $row[4], $avg_e, $avg_n, $row[7], '$row[8]');\n";
112        }
113    } else {
114        print_internal_err("Database error retrieving data");
115    }
116
117        # Tidy up
118        @has_table = $dbh->selectrow_array($checksql);
119        if(@has_table) {
120                $dbh->do("DROP TABLE averages");
121        }
122}
123
124# No more requests to serve, so tidy up
125$dbh->disconnect;
126
127# Helper routines
128sub print_err {
129    my $err = shift;
130    print CGI::header("text/plain", "400 $err");
131    print "Error: $err\n";
132}
133
134sub print_internal_err {
135    my $err = shift;
136    print CGI::header("text/plain", "500 $err");
137    print "Error: $err\n";
138}
Note: See TracBrowser for help on using the repository browser.