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

Last change on this file since 430 was 430, checked in by Nick Burch, 13 years ago

Look up the sheets in use at zoom level 1

  • Property svn:executable set to *
File size: 4.6 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# See accompanying file "LICENCE" for licence details
9
10use strict;
11use warnings;
12
13use CGI::Fast qw/:standard -debug/;
14
15# Find our private perl libraries
16use FindBin;
17use lib "$FindBin::Bin/../perllib";
18use NPEMap::Config;
19use NPEMap;
20
21sub print_err;
22
23my @outputs = qw(text xml js);
24
25my $cgi;
26# Process incoming requests
27REQUEST: while ($cgi = new CGI::Fast) {
28        # What output format do they want?
29        my $output = $outputs[0];
30        if(defined $cgi->param("format")) {
31                foreach my $possoutput (@outputs) {
32                        if($possoutput eq $cgi->param("format")) {
33                                $output = $possoutput;
34                        }
35                }
36        }
37
38        # While tiles (well, easting and northing km values) do they want to
39        #  know about?
40        my @requests;
41        my %tiles;
42
43        # Tile easting and northings (km)
44        if(defined $cgi->param("tiles")) {
45                @requests = split(",", $cgi->param("tiles"));
46                foreach my $req (@requests) {
47                        my ($e,$n) = ($req =~ /^(\d+)x(\d+)$/);
48                        unless($e && $n) {
49                                print_err ("Invalid tile '$req' requested, must be of the form eastingxnorthing" );
50                                next REQUEST;
51                        }
52                        $tiles{$e}->{$n} = 1;
53                }
54        }
55        # Real easting and northings (m)
56        if(defined $cgi->param("locations")) {
57                @requests = split(",", $cgi->param("locations"));
58                foreach my $req (@requests) {
59                        my ($e,$n) = ($req =~ /^(\d+)x(\d+)$/);
60                        $e = int($e / 1000);
61                        $n = int($n / 1000);
62
63                        unless($e && $n) {
64                                print_err ("Invalid tile '$req' requested, must be of the form eastingxnorthing" );
65                                next REQUEST;
66                        }
67                        $tiles{$e}->{$n} = 1;
68                }
69        }
70        unless(keys %tiles) {
71                print_err ("No tiles requested. Supply a 'tiles' parameter, of the form eastingxnorthing,eastingxnorthing,....");
72                next REQUEST;
73        }
74
75        # Load the meta files (one per easting)
76        foreach my $easting (keys %tiles) {
77                my $meta = $tiledir."/meta1/".$easting.".txt";
78                if(-f $meta) {
79                        open(META, "<$meta");
80                        while(my $line = <META>) {
81                                if($line =~ /^\#/) { next; }
82
83                                chomp $line;
84                                my ($e,$n,$sheet,$year) = split(/,/, $line);
85
86                                # Do they want this one?
87                                if($tiles{$e}->{$n}) {
88                                        my %m;
89                                        $m{sheet} = $sheet;
90                                        $m{year} = $year;
91                                        $tiles{$e}->{$n} = \%m;
92                                }
93                        }
94                        close META;
95                }
96        }
97
98        # Make any we couldn't find have a blank hash
99        foreach my $easting (keys %tiles) {
100                foreach my $northing (sort keys %{$tiles{$easting}}) {
101                        unless(ref $tiles{$easting}->{$northing} eq "HASH") {
102                                my %m;
103                                $tiles{$easting}->{$northing} = \%m;
104                        }
105                }
106        }
107       
108
109        # Render
110        if($output eq "xml") {
111                print header("text/xml");
112                print "<?xml version='1.0'?>\n";
113                print "<metadata>\n";
114                foreach my $easting (sort keys %tiles) {
115                        foreach my $northing (sort keys %{$tiles{$easting}}) {
116                                print "  <result easting=\"$easting\" northing=\"$northing\"";
117                                if(keys %{$tiles{$easting}->{$northing}}) {
118                                        my %m = %{$tiles{$easting}->{$northing}};
119                                        print ">\n";
120                                        if($m{sheet}) {
121                                                print "    <sheet>$m{sheet}</sheet>\n";
122                                        }
123                                        if($m{year}) {
124                                                print "    <year>$m{year}</year>\n";
125                                        }
126                                        print "  </result>\n";
127                                } else {
128                                        print " />\n";
129                                }
130                        }
131                }
132                print "</metadata>\n";
133        } elsif ($output eq "js") {
134                print header("text/javascript");
135
136                if(defined $cgi->param("callback")) {
137                        print $cgi->param("callback") . "(";
138                }
139
140                print " { ";
141                my $count = 0;
142                foreach my $easting (sort keys %tiles) {
143                        foreach my $northing (sort keys %{$tiles{$easting}}) {
144                                if($count > 0) { print " , "; }
145
146                                my %m = %{$tiles{$easting}->{$northing}};
147                                print " \"${easting}x${northing}\":{ ";
148                                if(keys %m) {
149                                        print "easting:$easting, northing:$northing, sheet:\"$m{sheet}\", year:\"$m{year}\"";
150                                        $count++;
151                                }
152                                print " } ";
153                        }
154                }
155                print " } ";
156
157                if(defined $cgi->param("callback")) {
158                        print ");";
159                }
160                print "\n";
161    } else {
162                print header("text/plain");
163                print "# Easting,Northing,Sheet,Year\n";
164
165                foreach my $easting (sort keys %tiles) {
166                        foreach my $northing (sort keys %{$tiles{$easting}}) {
167                                print "$easting,$northing,";
168                                if(keys %{$tiles{$easting}->{$northing}}) {
169                                        print $tiles{$easting}->{$northing}->{sheet}.",";
170                                        print $tiles{$easting}->{$northing}->{year}."\n";
171                                } else {
172                                        print ",\n";
173                                }
174                        }
175                }
176        }
177}
178
179# No more requests to serve, so tidy up
180
181
182# Helper routines
183sub print_err {
184    my $err = shift;
185    print header("text/plain", "400 $err");
186    print "Error: $err\n";
187}
188
189sub print_internal_err {
190    my $err = shift;
191    print header("text/plain", "500 $err");
192    print "Error: $err\n";
193}
Note: See TracBrowser for help on using the repository browser.