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

Last change on this file was 763, checked in by Nick Burch, 6 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#
22use strict;
23use warnings;
24
25use CGI::Fast qw/:standard -debug/;
26
27# Find our private perl libraries
28use FindBin;
29use lib "$FindBin::Bin/../perllib";
30use NPEMap;
31
32sub print_err;
33
34# Set up database handler to try and make sure it's ready for the first
35# request
36# No point in handling errors here since they'll get handled by the request
37# handler
38my $dbh = setup_dbh();
39
40
41my @fields = qw(mineasting minnorthing maxeasting maxnorthing);
42my $max_distance = 50000; # in metres
43
44my %grid_max = (
45        easting  => { 'gb' => 700000, 'ie' => 400000 },
46        northing => { 'gb' => 1300000, 'ie' => 500000 },
47);
48
49my $cgi;
50# Process incoming requests
51REQUEST: while ($cgi = new CGI::Fast) {
52
53    # In case the database went away, make sure we have a connection
54    unless ($dbh = setup_dbh()) {
55        print_internal_err('Error setting up database connection');
56        next REQUEST;
57    }
58
59        # Did they request the irish grid?
60        my $grid = 'gb';
61        my $ie = 0;
62        if(defined $cgi->param('ie')) {
63                $grid = 'ie';
64                $ie = 1;
65        }
66        if(defined $cgi->param('grid') && ($cgi->param('grid') eq 'osie')) {
67                $grid = 'ie';
68                $ie = 1;
69        }
70
71    # Input validation
72    foreach my $field (@fields) {
73        unless (defined $cgi->param($field)) {
74            print_err ("Parameter '$field' missing");
75            next REQUEST;
76        }
77    }
78
79    # Are the Eastings in a valid range?
80    foreach (qw(mineasting maxeasting)) {
81        if (($cgi->param($_) > $grid_max{'easting'}->{$grid}) or
82            ($cgi->param($_) < 0)) {
83            print_err ("Parameter '$_' must be an integer between 0 and ".($grid_max{'easting'}->{$grid}/1000).",000");
84            next REQUEST;
85        }
86    }
87
88    # Are the Northings in a valid range?
89        # (Channel islands stop at -87,000)
90    foreach (qw(minnorthing maxnorthing)) {
91        if (($cgi->param($_) > $grid_max{'northing'}->{$grid}) or
92            ($cgi->param($_) < -87000)) {
93            print_err("Parameter '$_' must be an integer between -87,000 and ".($grid_max{'northing'}->{$grid}/1000).",000");
94            next REQUEST;
95        }
96    }
97   
98    # Is the box too big?
99    if (($cgi->param('maxeasting') - $cgi->param('mineasting') > $max_distance) or ($cgi->param('maxnorthing') - $cgi->param('minnorthing') > $max_distance)) {
100        print_err("The requested box is too large");
101        next REQUEST;
102    }
103
104        my ($e,$n) = ("easting","northing");
105        if($ie) { ($e,$n) = ("ie_easting","ie_northing"); }
106    my $sth = $dbh->prepare("SELECT outward || ' ' || inward AS postcode, $e, $n,id,source FROM postcodes WHERE $e BETWEEN ? AND ? AND $n BETWEEN ? AND ? AND NOT deleted");
107   
108    if ($sth->execute($cgi->param('mineasting'), $cgi->param('maxeasting'), $cgi->param('minnorthing'), $cgi->param('maxnorthing'))) {
109        print "Content-type: text/javascript\n\n";
110
111        while(my @row = $sth->fetchrow_array) {
112                        my ($postcode,$easting,$northing,$id,$source) = @row;
113            print "addMarker('$postcode', $easting, $northing, [$id, $source]);\n";
114        }
115        print "completeMarkers();\n";
116    } else {
117        print_internal_err("Database error retrieving data");
118    }
119
120}
121
122# No more requests to serve, so tidy up
123$dbh->disconnect;
124
125# Helper routines
126sub print_err {
127    my $err = shift;
128    print CGI::header("text/plain", "400 $err");
129    print "Error: $err\n";
130}
131
132sub print_internal_err {
133    my $err = shift;
134    print CGI::header("text/plain", "500 $err");
135    print "Error: $err\n";
136}
Note: See TracBrowser for help on using the repository browser.