source: trunk/npemap.org.uk/cgi/get-meta.fcgi @ 676

Last change on this file since 676 was 676, checked in by Nick Burch, 11 years ago

Legend support in meta

  • Property svn:executable set to *
File size: 6.0 KB
Line 
1#!/usr/bin/perl
2# Looks up the meta information on a number of tiles (expressed as
3#  eastingxnorthing), including sheet number and publication year.
4#
5# Can return plain text, JS, JS callback, or XML
6#
7# Copyright (c) 2006 Dominic Hargreaves, Nick Burch and David Sheldon
8# Permission is hereby granted, free of charge, to any person obtaining a
9# copy of this software and associated documentation files (the "Software"),
10# to deal in the Software without restriction, including without limitation
11# the rights to use, copy, modify, merge, publish, distribute, sublicense,
12# and/or sell copies of the Software, and to permit persons to whom the
13# Software is furnished to do so, subject to the following conditions:
14#
15# The above copyright notice and this permission notice shall be included in
16# all copies or substantial portions of the Software.
17#
18# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
19# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
20# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
21# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
22# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
23# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
24# IN THE SOFTWARE.
25#
26use strict;
27use warnings;
28
29use CGI::Fast qw/:standard -debug/;
30
31# Find our private perl libraries
32use FindBin;
33use lib "$FindBin::Bin/../perllib";
34use NPEMap::Config;
35use NPEMap;
36
37sub print_err;
38
39my @outputs = qw(text xml js);
40
41my $cgi;
42# Process incoming requests
43REQUEST: while ($cgi = new CGI::Fast) {
44        # What output format do they want?
45        my $output = $outputs[0];
46        if(defined $cgi->param("format")) {
47                foreach my $possoutput (@outputs) {
48                        if($possoutput eq $cgi->param("format")) {
49                                $output = $possoutput;
50                        }
51                }
52        }
53
54        # Did they request the irish grid?
55        my $ie = 0;
56        if(defined $cgi->param('ie')) {
57                $ie = 1;
58        }
59        if(defined $cgi->param('grid') && ($cgi->param('grid') eq 'osie')) {
60                $ie = 1;
61        }
62
63        # While tiles (well, easting and northing km values) do they want to
64        #  know about?
65        my @requests;
66        my %tiles;
67
68        # Tile easting and northings (km)
69        if(defined $cgi->param("tiles")) {
70                @requests = split(",", $cgi->param("tiles"));
71                foreach my $req (@requests) {
72                        my ($e,$n) = ($req =~ /^(\d+)x(\-?\d+)$/);
73                        unless($e && $n) {
74                                print_err ("Invalid tile '$req' requested, must be of the form eastingxnorthing" );
75                                next REQUEST;
76                        }
77                        $tiles{$e}->{$n} = 1;
78                }
79        }
80        # Real easting and northings (m)
81        if(defined $cgi->param("locations")) {
82                @requests = split(",", $cgi->param("locations"));
83                foreach my $req (@requests) {
84                        my ($e,$n) = ($req =~ /^(\d+)x(\-?\d+)$/);
85                        $e = int($e / 1000);
86                        $n = int($n / 1000);
87
88                        unless($e && $n) {
89                                print_err ("Invalid tile '$req' requested, must be of the form eastingxnorthing" );
90                                next REQUEST;
91                        }
92                        $tiles{$e}->{$n} = 1;
93                }
94        }
95        unless(keys %tiles) {
96                print_err ("No tiles requested. Supply a 'tiles' parameter, of the form eastingxnorthing,eastingxnorthing,....");
97                next REQUEST;
98        }
99
100        # Load the meta files (one per easting)
101        foreach my $easting (keys %tiles) {
102                my $meta_dir = "/meta1/";
103                if($ie) { 
104                        $meta_dir = "/osie".$meta_dir;
105                } else {
106                        $meta_dir = "/osgb".$meta_dir;
107                }
108
109                my $meta = $tiledir.$meta_dir.$easting.".txt";
110                if(-f $meta) {
111                        open(META, "<$meta");
112                        while(my $line = <META>) {
113                                if($line =~ /^\#/) { next; }
114
115                                chomp $line;
116                                my ($e,$n,$sheet,$year,$legend) = split(/,/, $line);
117
118                                # Do they want this one?
119                                if($tiles{$e}->{$n}) {
120                                        my %m;
121                                        $m{sheet} = $sheet;
122                                        $m{year} = $year;
123                                        $m{legend} = $legend;
124                                        $tiles{$e}->{$n} = \%m;
125                                }
126                        }
127                        close META;
128                }
129        }
130
131        # Make any we couldn't find have a blank hash
132        foreach my $easting (keys %tiles) {
133                foreach my $northing (sort keys %{$tiles{$easting}}) {
134                        unless(ref $tiles{$easting}->{$northing} eq "HASH") {
135                                my %m;
136                                $tiles{$easting}->{$northing} = \%m;
137                        }
138                }
139        }
140       
141
142        # Render
143        if($output eq "xml") {
144                print header("text/xml");
145                print "<?xml version='1.0'?>\n";
146                print "<metadata>\n";
147                foreach my $easting (sort keys %tiles) {
148                        foreach my $northing (sort keys %{$tiles{$easting}}) {
149                                print "  <result easting=\"$easting\" northing=\"$northing\"";
150                                if(keys %{$tiles{$easting}->{$northing}}) {
151                                        my %m = %{$tiles{$easting}->{$northing}};
152                                        print ">\n";
153                                        if($m{sheet}) {
154                                                print "    <sheet>$m{sheet}</sheet>\n";
155                                        }
156                                        if($m{year}) {
157                                                print "    <year>$m{year}</year>\n";
158                                        }
159                                        if($m{legend}) {
160                                                print "    <legend>$m{legend}</legend>\n";
161                                        }
162                                        print "  </result>\n";
163                                } else {
164                                        print " />\n";
165                                }
166                        }
167                }
168                print "</metadata>\n";
169        } elsif ($output eq "js") {
170                print header("text/javascript");
171
172                if(defined $cgi->param("callback")) {
173                        print $cgi->param("callback") . "(";
174                }
175
176                print " { ";
177                my $count = 0;
178                foreach my $easting (sort keys %tiles) {
179                        foreach my $northing (sort keys %{$tiles{$easting}}) {
180                                if($count > 0) { print " , "; }
181
182                                my %m = %{$tiles{$easting}->{$northing}};
183                                print " \"${easting}x${northing}\":{ ";
184                                if(keys %m) {
185                                        print "easting:$easting, northing:$northing, sheet:\"$m{sheet}\", year:\"$m{year}\", legend:\"$m{legend}\"";
186                                }
187                                $count++;
188                                print " } ";
189                        }
190                }
191                print " } ";
192
193                if(defined $cgi->param("callback")) {
194                        print ");";
195                }
196                print "\n";
197    } else {
198                print header("text/plain");
199                print "# Easting,Northing,Sheet,Year,Legend\n";
200
201                foreach my $easting (sort keys %tiles) {
202                        foreach my $northing (sort keys %{$tiles{$easting}}) {
203                                print "$easting,$northing,";
204                                if(keys %{$tiles{$easting}->{$northing}}) {
205                                        print $tiles{$easting}->{$northing}->{sheet}.",";
206                                        print $tiles{$easting}->{$northing}->{year}.",";
207                                        print $tiles{$easting}->{$northing}->{legend}."\n";
208                                } else {
209                                        print ",\n";
210                                }
211                        }
212                }
213        }
214}
215
216# No more requests to serve, so tidy up
217
218
219# Helper routines
220sub print_err {
221    my $err = shift;
222    print header("text/plain", "400 $err");
223    print "Error: $err\n";
224}
225
226sub print_internal_err {
227    my $err = shift;
228    print header("text/plain", "500 $err");
229    print "Error: $err\n";
230}
Note: See TracBrowser for help on using the repository browser.