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

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

Support ie or grid=osie

  • Property svn:executable set to *
File size: 4.9 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        # Did they request the irish grid?
39        my $ie = 0;
40        if(defined $cgi->param('ie')) {
41                $ie = 1;
42        }
43        if(defined $cgi->param('grid') && ($cgi->param('grid') eq 'osie')) {
44                $ie = 1;
45        }
46
47        # While tiles (well, easting and northing km values) do they want to
48        #  know about?
49        my @requests;
50        my %tiles;
51
52        # Tile easting and northings (km)
53        if(defined $cgi->param("tiles")) {
54                @requests = split(",", $cgi->param("tiles"));
55                foreach my $req (@requests) {
56                        my ($e,$n) = ($req =~ /^(\d+)x(\d+)$/);
57                        unless($e && $n) {
58                                print_err ("Invalid tile '$req' requested, must be of the form eastingxnorthing" );
59                                next REQUEST;
60                        }
61                        $tiles{$e}->{$n} = 1;
62                }
63        }
64        # Real easting and northings (m)
65        if(defined $cgi->param("locations")) {
66                @requests = split(",", $cgi->param("locations"));
67                foreach my $req (@requests) {
68                        my ($e,$n) = ($req =~ /^(\d+)x(\d+)$/);
69                        $e = int($e / 1000);
70                        $n = int($n / 1000);
71
72                        unless($e && $n) {
73                                print_err ("Invalid tile '$req' requested, must be of the form eastingxnorthing" );
74                                next REQUEST;
75                        }
76                        $tiles{$e}->{$n} = 1;
77                }
78        }
79        unless(keys %tiles) {
80                print_err ("No tiles requested. Supply a 'tiles' parameter, of the form eastingxnorthing,eastingxnorthing,....");
81                next REQUEST;
82        }
83
84        # Load the meta files (one per easting)
85        foreach my $easting (keys %tiles) {
86                my $meta_dir = "/meta1/";
87                if($ie) { 
88                        $meta_dir = "/osie".$meta_dir;
89                } else {
90                        $meta_dir = "/osgb".$meta_dir;
91                }
92
93                my $meta = $tiledir.$meta_dir.$easting.".txt";
94                if(-f $meta) {
95                        open(META, "<$meta");
96                        while(my $line = <META>) {
97                                if($line =~ /^\#/) { next; }
98
99                                chomp $line;
100                                my ($e,$n,$sheet,$year) = split(/,/, $line);
101
102                                # Do they want this one?
103                                if($tiles{$e}->{$n}) {
104                                        my %m;
105                                        $m{sheet} = $sheet;
106                                        $m{year} = $year;
107                                        $tiles{$e}->{$n} = \%m;
108                                }
109                        }
110                        close META;
111                }
112        }
113
114        # Make any we couldn't find have a blank hash
115        foreach my $easting (keys %tiles) {
116                foreach my $northing (sort keys %{$tiles{$easting}}) {
117                        unless(ref $tiles{$easting}->{$northing} eq "HASH") {
118                                my %m;
119                                $tiles{$easting}->{$northing} = \%m;
120                        }
121                }
122        }
123       
124
125        # Render
126        if($output eq "xml") {
127                print header("text/xml");
128                print "<?xml version='1.0'?>\n";
129                print "<metadata>\n";
130                foreach my $easting (sort keys %tiles) {
131                        foreach my $northing (sort keys %{$tiles{$easting}}) {
132                                print "  <result easting=\"$easting\" northing=\"$northing\"";
133                                if(keys %{$tiles{$easting}->{$northing}}) {
134                                        my %m = %{$tiles{$easting}->{$northing}};
135                                        print ">\n";
136                                        if($m{sheet}) {
137                                                print "    <sheet>$m{sheet}</sheet>\n";
138                                        }
139                                        if($m{year}) {
140                                                print "    <year>$m{year}</year>\n";
141                                        }
142                                        print "  </result>\n";
143                                } else {
144                                        print " />\n";
145                                }
146                        }
147                }
148                print "</metadata>\n";
149        } elsif ($output eq "js") {
150                print header("text/javascript");
151
152                if(defined $cgi->param("callback")) {
153                        print $cgi->param("callback") . "(";
154                }
155
156                print " { ";
157                my $count = 0;
158                foreach my $easting (sort keys %tiles) {
159                        foreach my $northing (sort keys %{$tiles{$easting}}) {
160                                if($count > 0) { print " , "; }
161
162                                my %m = %{$tiles{$easting}->{$northing}};
163                                print " \"${easting}x${northing}\":{ ";
164                                if(keys %m) {
165                                        print "easting:$easting, northing:$northing, sheet:\"$m{sheet}\", year:\"$m{year}\"";
166                                }
167                                $count++;
168                                print " } ";
169                        }
170                }
171                print " } ";
172
173                if(defined $cgi->param("callback")) {
174                        print ");";
175                }
176                print "\n";
177    } else {
178                print header("text/plain");
179                print "# Easting,Northing,Sheet,Year\n";
180
181                foreach my $easting (sort keys %tiles) {
182                        foreach my $northing (sort keys %{$tiles{$easting}}) {
183                                print "$easting,$northing,";
184                                if(keys %{$tiles{$easting}->{$northing}}) {
185                                        print $tiles{$easting}->{$northing}->{sheet}.",";
186                                        print $tiles{$easting}->{$northing}->{year}."\n";
187                                } else {
188                                        print ",\n";
189                                }
190                        }
191                }
192        }
193}
194
195# No more requests to serve, so tidy up
196
197
198# Helper routines
199sub print_err {
200    my $err = shift;
201    print header("text/plain", "400 $err");
202    print "Error: $err\n";
203}
204
205sub print_internal_err {
206    my $err = shift;
207    print header("text/plain", "500 $err");
208    print "Error: $err\n";
209}
Note: See TracBrowser for help on using the repository browser.