source: subversion/sites/other/trapi/map @ 12298

Revision 12298, 9.0 KB checked in by blarson, 5 years ago (diff)

Tiled Read-only API

Serves osm data optimized for tiles@home.

Line 
1#!/usr/bin/perl
2# Copyright 2008 Blars Blarson.  Distributed under GPL version 2, see GPL-2
3
4use strict;
5use warnings;
6
7use constant VERBOSE => 0;              # verbosity
8use constant MAXTILESPERREQ => 100;     # largest request in tiles
9use constant TOOLD => 1500;             # how old database can get before refusing
10use ptdb;
11use CGI::Fast qw(:standard);
12use CGI::Carp;
13use Time::Local;
14
15chdir TRAPIDIR or die "could not chdir ".TRAPIDIR.": $!";
16
17ptdbinit("<");
18
19my ($ptn, $n, $tn, $lat, $lon, $off, $key, $val, $w, $tw, $tr);
20
21my $oldstamp = "";
22my $stamptime = 0;
23
24while (my $query = new CGI::Fast) {
25
26    open STAMP, "<", "timestamp" or die "Could not open timestamp: $!";
27    my $stamp = <STAMP>;
28    close STAMP;
29    chomp $stamp;
30    if ($stamp ne $oldstamp) {
31        my @t = $stamp =~ /^(\d{4})(\d\d)(\d\d)(\d\d)?(\d\d)?/;
32        $stamptime = timegm(0, $t[4]//0, $t[3]//0, $t[2], $t[1]-1, $t[0]-1900);
33        closeall;
34        ptdbinit("<");
35        $oldstamp = $stamp;
36    }
37    if (($stamptime + TOOLD) < time) {
38        print $query->header(-status=>('503 stale database '.$stamp));
39        next;
40    }
41
42    my (%pw, %pn, %pr, %tiles);
43    my ($bbs, $bbw, $bbn, $bbe);
44   
45    if ($query->param('bbox') =~ /^(-?\d+(?:\.\d*)?)\,(-?\d+(?:\.\d*)?)\,(-?\d+(?:\.\d*)?)\,(-?\d+(?:\.\d*)?)$/) {
46# print "WSEN: $1, $2, $3, $4\n";
47        my ($west,$south) = getTileNumber($2,$1,MAXZOOM);
48        my ($east,$north) = getTileNumber($4,$3,MAXZOOM);
49# print "WSEN: $west, $south, $east, $north\n";
50        my ($x, $y);
51        for($y=$north; $y <= $south; $y++) {
52            for($x=$west; $x <= $east; $x++) {
53                $tiles{etoptn($x,$y)} = 1;
54            }
55        }
56        ($bbs, $bbw, undef, undef) = Project($west, $south, MAXZOOM);
57        (undef, undef, $bbn, $bbe) = Project($east, $north, MAXZOOM);
58    } elsif (path_info =~ /node\/(\d+)\b/) {
59        my $node = $1;
60        $pn{nodeptn($node)} = {$node => 1};
61    } elsif (path_info =~ /way\/(\d+)\b/) {
62        my $way = $1;
63        $pw{wayptn($way)} = {$way => 1};
64    } elsif (path_info =~ /relation\/(\d+)\b/) {
65        my $rel = $1;
66        $pr{relationptn($rel)} = {$rel => 1};
67    } else {
68        print $query->header(-status=>'400 Unknown/malformed request');
69        print path_info;
70        next;
71    }
72   
73    if ((scalar keys %tiles) > MAXTILESPERREQ) {
74        print $query->header(-status=>"413 Request too large");
75        next;
76    }
77   
78    print $query->header(-type=>'text/xml', -charset=>'utf8');
79    print "<?xml version='1.0' encoding='UTF-8'?>\n";
80    print "<osm version=\"0.5\" generator=\"Trapi 0.0\">\n";
81    if ($bbs) {
82        print "<bound box=\"$bbs,$bbw,$bbn,$bbe\" origin=\"http://www.openstreetmap.org/api/0.5\"/>\n";
83    }
84   
85    foreach $ptn (keys %tiles) {
86        my $nd = openptn($ptn, "<", "data");
87        my $wf = openptn($ptn, "<", "ways");
88        my $rf = openptn($ptn, "<", "relations");
89       
90# first we go through the ways, looking for ones stored remotely or with nodes
91# not in the tile
92        seek $wf, 0, 0;
93        while (read $wf, $w, 8) {
94            ($tw, $off) = unpack "NN", $w;
95            next unless($tw);
96            if ($off == 0) {
97                # way stored remotly
98                $w = wayptn($tw);
99# print "Remote way $tw\n";
100                unless (exists $tiles{$w}) {
101                    unless (defined $pw{$w}) {
102                        $pw{$w} = {};
103                    }
104                    ${$pw{$w}}{$tw} = 1;
105                }
106            } else {
107                seek $nd, $off, 0;
108                while(read $nd, $n, 4) {
109                    ($tn) = unpack "N", $n;
110                    last unless ($tn);
111                    $n = nodeptn($tn);
112                    unless (exists $tiles{$n}) {
113                        # node stored remotly
114                        unless (defined $pn{$n}) {
115                            $pn{$n} = {};
116                        }
117                        ${$pn{$n}}{$tn} = 1;
118                    }
119                }
120            }
121        }
122        seek $rf, 0, 0;
123        while (read $rf, $w, 8) {
124            ($tr, $off) = unpack "NN", $w;
125            next unless($tr);
126            if ($off == 0) {
127                my $r = relationptn($tr);
128                unless (exists $tiles{$r}) {
129                    unless (defined $pr{$r}) {
130                        $pr{$r} = {};
131                    }
132                    ${$pr{$r}}{$tr} = 1;
133                }
134            }
135        }
136    }
137   
138# now we go through the remote ways, looking for nodes and ways not in the tile
139    foreach my $tp (keys %pw) {
140        my $pwf = openptn($tp, "<", "ways");
141        my $pd = openptn($tp, "<", "data");
142        seek $pwf, 0, 0;
143        while (read $pwf, $w, 8) {
144            ($tw, $off) = unpack "NN", $w;
145            next unless($tw);
146            if (exists ${$pw{$tp}}{$tw}) {
147                seek $pd, $off, 0;
148                while(read $pd, $n, 4) {
149                    ($tn) = unpack "N", $n;
150                    last unless ($tn);
151                    $n = nodeptn($tn);
152                    unless (exists $tiles{$n}) {
153                        # node stored remotly
154                        unless (defined $pn{$n}) {
155                            $pn{$n} = {};
156                        }
157                        ${$pn{$n}}{$tn} = 1;
158                    }
159                }
160            }
161        }
162    }
163   
164# print nodes in the tile
165    foreach $ptn (keys %tiles) {
166        my $nf = openptn($ptn, "<", "nodes");
167        my $nd = openptn($ptn, "<", "data");
168       
169        my ($z, $x, $y) = fromptn($ptn);
170        print "<!-- nodes from z$z $x $y -->\n";
171        seek $nf, 0, 0;
172        while (read $nf, $n, 16) {
173            ($tn, $lat, $lon, $off) = unpack "NN!N!N", $n;
174            next unless($tn);
175            $lat /= CONV;
176            $lon /= CONV;
177            print "<node id=\"$tn\" lat=\"$lat\" lon=\"$lon\" ";
178            if ($off == 0) {
179                print "/>\n";
180            } else {
181                print ">\n";
182                seek $nd, $off, 0;
183                while ($key = gets $nd) {
184                    $val = gets $nd;
185                    print "  <tag k=\"$key\" v=\"$val\"/>\n";
186                }
187                print "</node>\n";
188            }
189        }
190    }
191   
192# print the nodes used by ways
193   
194    foreach my $tp (keys %pn) {
195        my ($tz, $tx, $ty) = fromptn($tp);
196        print "<!-- some nodes from z$tz $tx $ty -->\n";
197        my $pnf = openptn($tp, "<", "nodes");
198        my $pd = openptn($tp, "<", "data");
199        seek $pnf, 0, 0;
200        while(read $pnf, $n, 16) {
201            ($tn, $lat, $lon, $off) = unpack "NN!N!N", $n;
202            next unless($tn);
203            if (exists ${$pn{$tp}}{$tn}) {
204                $lat /= 10000000;
205                $lon /= 10000000;
206                print "<node id=\"$tn\" lat=\"$lat\" lon=\"$lon\" ";
207                if ($off == 0) {
208                    print "/>\n";
209                } else {
210                    print ">\n";
211                    seek $pd, $off, 0;
212                    while ($key = gets $pd) {
213                        $val = gets $pd;
214                        print "  <tag k=\"$key\" v=\"$val\"/>\n";
215                    }
216                    print "</node>\n";
217                }
218            }
219        }
220    }
221   
222# print ways
223    foreach $ptn (keys %tiles) {
224        my $nd = openptn($ptn, "<", "data");
225        my $wf = openptn($ptn, "<", "ways");
226       
227        my ($z, $x, $y) = fromptn($ptn);
228        print "<!-- ways from z$z $x $y -->\n";
229        seek $wf, 0, 0;
230        while(read $wf, $w, 8) {
231            ($tw, $off) = unpack "NN", $w;
232            next unless ($tw);
233            next unless ($off);
234            print "<way id=\"$tw\">\n";
235            seek $nd, $off, 0;
236            while (read $nd, $w, 4) {
237                ($tn) = unpack "N", $w;
238                last if($tn == 0);
239                print "  <nd ref=\"$tn\"/>\n";
240            }
241            while ($key = gets $nd) {
242                $val = gets $nd;
243                print "  <tag k=\"$key\" v=\"$val\"/>\n";
244            }
245            print "</way>\n";
246        }
247    }
248   
249    foreach my $tp (keys %pw) {
250        my ($tz, $tx, $ty) = fromptn($tp);
251        print "<!-- some ways from z$tz $tx $ty -->\n";
252        my $pwf = openptn($tp, "<", "ways");
253        my $pd = openptn($tp, "<", "data");
254        seek $pwf, 0, 0;
255        while (read $pwf, $w, 8) {
256            ($tw, $off) = unpack "NN", $w;
257            next unless($tw);
258            if ($off && exists ${$pw{$tp}}{$tw}) {
259                print "<way id=\"$tw\">\n";
260                seek $pd, $off, 0;
261                while(read $pd, $n, 4) {
262                    ($tn) = unpack "N", $n;
263                    last unless ($tn);
264                    print "  <nd ref=\"$tn\"/>\n";
265                }
266                while ($key = gets $pd) {
267                    $val = gets $pd;
268                    print "  <tag k=\"$key\" v=\"$val\"/>\n";
269                }
270                print "</way>\n";
271            }
272        }
273    }
274   
275# print relations
276   
277    foreach $ptn (keys %tiles) {
278        my $nd = openptn($ptn, "<", "data");
279        my $rf = openptn($ptn, "<", "relations");
280       
281        my ($z, $x, $y) = fromptn($ptn);
282        print "<!-- relations from z$z $x $y -->\n";
283        seek $rf, 0, 0;
284        while (read $rf, $w, 8) {
285            ($tr, $off) = unpack "NN", $w;
286            next unless ($tr);
287            next unless ($off);
288            print "<relation id=\"$tr\">\n";
289            seek $nd, $off, 0;
290            while (read $nd, $w, 4) {
291                ($tn) = unpack "N", $w;
292                last unless ($tn);
293                my $role = gets($nd);
294                print "  <member type=\"node\" ref=\"$tn\" role=\"$role\"/>\n";
295            }
296            while (read $nd, $w, 4) {
297                ($tw) = unpack "N", $w;
298                last unless ($tw);
299                my $role = gets($nd);
300                print "  <member type=\"way\" ref=\"$tw\" role=\"$role\"/>\n";
301            }
302            while (read $nd, $w, 4) {
303                ($tw) = unpack "N", $w;
304                last unless ($tw);
305                my $role = gets($nd);
306                print "  <member type=\"relation\" ref=\"$tw\" role=\"$role\"/>\n";
307            }
308            while ($key = gets $nd) {
309                $val = gets $nd;
310                print "  <tag k=\"$key\" v=\"$val\"/>\n";
311            }
312            print "</relation>\n";
313        }
314    }
315   
316    foreach my $tp (keys %pr) {
317        my ($tz, $tx, $ty) = fromptn($tp);
318        print "<!-- some relations from z$tz $tx $ty -->\n";
319        my $prf = openptn($tp, "<", "relations");
320        my $pd = openptn($tp, "<", "data");
321        seek $prf, 0, 0;
322        while (read $prf, $w, 8) {
323            ($tr, $off) = unpack "NN", $w;
324            next unless($tr);
325            if ($off && exists ${$pr{$tp}}{$tr}) {
326                print "<relation id=\"$tr\">\n";
327                seek $pd, $off, 0;
328                while (read $pd, $w, 4) {
329                    ($tn) = unpack "N", $w;
330                    last unless ($tn);
331                    my $role = gets($pd);
332                    print "  <member type=\"node\" ref=\"$tn\" role=\"$role\"/>\n";
333                }
334                while (read $pd, $w, 4) {
335                    ($tw) = unpack "N", $w;
336                    last unless ($tw);
337                    my $role = gets($pd);
338                    print "  <member type=\"way\" ref=\"$tw\" role=\"$role\"/>\n";
339                }
340                while (read $pd, $w, 4) {
341                    ($tw) = unpack "N", $w;
342                    last unless ($tw);
343                    my $role = gets($pd);
344                    print "  <member type=\"relation\" ref=\"$tw\" role=\"$role\"/>\n";
345                }
346                while ($key = gets $pd) {
347                    $val = gets $pd;
348                    print "  <tag k=\"$key\" v=\"$val\"/>\n";
349                }
350                print "</relation>\n";
351            }
352        }
353    }
354   
355    print "</osm>\n";
356    $| = 1;
357    $| = 0;
358}
Note: See TracBrowser for help on using the repository browser.