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

Last change on this file since 31161 was 23319, checked in by pa94, 10 years ago

added "reload_outer_ways" feature

File size: 14.1 KB
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
8
9use trapi;
10use CGI::Fast qw(:standard);
11use CGI::Carp;
12use Time::Local;
13
14our $die;
15
16chdir TRAPIDIR or die "could not chdir ".TRAPIDIR.": $!";
17$SIG{TERM} = sub {$die = 1};
18
19ptdbinit("<");
20
21my ($ptn, $n, $tn, $lat, $lon, $off, $key, $val, $w, $tw, $tr);
22
23my $oldstamp = "";
24my $stamptime = 0;
25
26while (my $query = new CGI::Fast) {
27    open STAMP, "<", "timestamp" or die "Could not open timestamp: $!";
28    my $stamp = <STAMP>;
29    close STAMP;
30    chomp $stamp;
31    if ($stamp ne $oldstamp) {
32        my @t = $stamp =~ /^(\d{4})(\d\d)(\d\d)(\d\d)?(\d\d)?/;
33        $stamptime = timegm(0, $t[4]//0, $t[3]//0, $t[2], $t[1]-1, $t[0]-1900);
34        closeall;
35        ptdbinit("<");
36        $oldstamp = $stamp;
37    }
38    if (($stamptime + TOOLD) < time) {
39        print $query->header(-status=>('503 stale database '.$stamp));
40        last if ($die);
41        next;
42    }
43
44    my (%pw, %pn, %pr, %tiles);
45    my ($bbs, $bbw, $bbn, $bbe);
46   
47    if ($query->param('bbox') =~ /^(-?\d+(?:\.\d*)?)\,(-?\d+(?:\.\d*)?)\,(-?\d+(?:\.\d*)?)\,(-?\d+(?:\.\d*)?)$/) {
48# print "WSEN: $1, $2, $3, $4\n";
49        my ($west,$south) = getTileNumber($2,$1,MAXZOOM);
50        my ($east,$north) = getTileNumber($4,$3,MAXZOOM);
51# print "WSEN: $west, $south, $east, $north\n";
52        my ($x, $y);
53        for($y=$north; $y <= $south; $y++) {
54            for($x=$west; $x <= $east; $x++) {
55                $tiles{etoptn($x,$y)} = 1;
56            }
57        }
58        ($bbs, $bbw, undef, undef) = Project($west, $south, MAXZOOM);
59        (undef, undef, $bbn, $bbe) = Project($east, $north, MAXZOOM);
60    } elsif ($query->param('node') =~ /^(\d+)$/) {
61        my $node = $1;
62        $pn{nodeptn($node)} = {$node => 1};
63    } elsif ($query->param('way') =~ /^(\d+)$/) {
64        my $way = $1;
65        $pw{wayptn($way)} = {$way => 1};
66    } elsif ($query->param('relation') =~ /^(\d+)$/) {
67        my $rel = $1;
68        $pr{relationptn($rel)} = {$rel => 1};
69    } elsif ($query->param('tile') =~ /^(\d+),(\d+),(\d+)$/) {
70        my ($z,$x,$y) = ($1,$2,$3);
71        if ($z >= MAXZOOM) {
72            my $zdiff = $z - MAXZOOM;
73            $x >>= $zdiff;
74            $y >>= $zdiff;
75            $tiles{etoptn($x, $y)} = 1;
76            ($bbs, $bbw, $bbn, $bbe) = Project($x, $y, MAXZOOM);
77        } else {
78            ($bbs, $bbw, $bbn, $bbe) = Project($x, $y, $z);
79            my $zdiff = MAXZOOM - $z;
80            $x <<= $zdiff;
81            $y <<= $zdiff;
82            my $n = (1<< $zdiff) - 1;
83            foreach my $xx (0 .. $n) {
84                foreach my $yy (0 .. $n) {
85                    $tiles{etoptn($x+$xx,$y+$yy)} = 1;
86                }
87            }
88        }
89    } elsif (path_info =~ /node\/(\d+)\b/) {
90        my $node = $1;
91        $pn{nodeptn($node)} = {$node => 1};
92    } elsif (path_info =~ /way\/(\d+)\b/) {
93        my $way = $1;
94        $pw{wayptn($way)} = {$way => 1};
95    } elsif (path_info =~ /relation\/(\d+)\b/) {
96        my $rel = $1;
97        $pr{relationptn($rel)} = {$rel => 1};
98    } else {
99        print $query->header(-status=>'400 Unknown/malformed request');
100        print path_info;
101        next;
102    }
103   
104    if ((scalar keys %tiles) > MAXTILESPERREQ) {
105        print $query->header(-status=>"413 Request too large");
106        next;
107    }
108   
109    print $query->header(-type=>'text/xml', -charset=>'utf8');
110    print "<?xml version='1.0' encoding='UTF-8'?>\n";
111    print "<osm version=\"0.6\" generator=\"Trapi 0.3\">\n";
112    if (defined $bbs) {
113#       print "<bound box=\"$bbs,$bbw,$bbn,$bbe\" origin=\"http://www.openstreetmap.org/api/0.6\"/>\n";
114        print "<bounds minlat=\"$bbs\" minlon=\"$bbw\" maxlat=\"$bbn\" maxlon=\"$bbe\" origin=\"http://www.openstreetmap.org/api/0.6\"/>\n";
115    }
116
117    # reload outer ways
118    if ($query->param('reload_outer_ways') eq '1')
119    {
120        my $debug_outer= 1; # 0, 1 or 2 (0: quiet,  1: some debug output,  2: full debug output)
121        print "<!-- reload_outer_ways -->\n" if ($debug_outer>0);
122        printf("<!-- %s   %s -->\n", join("&", map { $_ . "=" . $query->param($_) } $query->param()), scalar gmtime() ) if ($debug_outer>0);
123        if ($debug_outer>1)
124        {
125            foreach my $ptn (sort {
126                # sorting tiles...
127                my ($za, $xa, $ya)= fromptn($a);
128                my ($zb, $xb, $yb)= fromptn($b);
129                my $xa12= $xa/(1<<($za-12));
130                my $ya12= $ya/(1<<($za-12));
131                my $xb12= $xb/(1<<($zb-12));
132                my $yb12= $yb/(1<<($zb-12));
133                if ($xa12==$xb12) { return $ya12 <=> $yb12; }
134                else { return $xa12<=>$xb12; }
135            } keys %tiles)
136            {
137                my ($z, $x, $y)= fromptn($ptn);
138                printf("<!-- TILE %s    %7.2f  %7.2f -->\n", join(",", fromptn($ptn)), $x/(1<<($z-12)), $y/(1<<($z-12)) );
139            }
140        }
141       
142        my %rels= ();
143        foreach $ptn (keys %tiles) {
144            my $nd = openptn($ptn, "data");
145            my $rf = openptn($ptn, "relations");
146               
147            my ($z, $x, $y) = fromptn($ptn);
148            print "<!-- PASS1: searching for relations in zxy=$z $x $y-->\n" if ($debug_outer>1); 
149            seek $rf, 0, 0;
150            while (my ($tr, $off) = readrel($rf)) {
151                last unless (defined $tr);
152                my $r = relationptn($tr);
153                printf ("<!-- PASS1: found relation $tr: it is in %s-->\n", join(",", fromptn($r)) ) if ($debug_outer>1);
154                                           
155                $rels{$r} //= {};
156                $rels{$r}->{$tr}= 1;
157            }
158        }
159       
160        foreach my $tp (keys %rels)
161        {
162            my $nd = openptn($tp, "data");
163            my $rf = openptn($tp, "relations");
164               
165            my ($z, $x, $y) = fromptn($tp);
166            printf "<!-- PASS2: searching for relations in zxy=$z $x $y-->\n" if ($debug_outer>1); 
167                   
168            seek $rf, 0, 0;
169            while (my ($tr, $off) = readrel($rf)) {
170                last unless (defined $tr);
171                my $r = relationptn($tr);
172                printf ("<!-- PASS2: found relation $tr in %s -->\n", join(",", fromptn($r)) ) if ($debug_outer>1);
173                next unless ($tr && $off);
174                printf "<!-- PASS2: $tr $off -->\n" if ($debug_outer>1);
175                if ($rels{$tp}->{$tr}) {
176                    printf "<!-- PASS2: HIT $tr -->\n" if ($debug_outer>1);
177
178                    seek $nd, $off, 0;
179                    my @members = readmemb($nd);
180
181                    my $multipolygon= 0;                   
182                    my $exclude= 0;                   
183                    my @tv = readtags($nd, RELATION);
184                    while (my $key = shift(@tv)) {
185                        $val = shift(@tv) // '';
186                        $multipolygon= 1 if ( $key eq "type" && $val eq "multipolygon" );
187                        if ( ( ($key eq "boundary") && ($val eq "region" || $val eq "administrative") ) ||   # boundary=region, boundary=administrative
188                             $key eq "land_area"   )                                                         # land_area=*
189                        {
190                            $exclude= 1;
191                            last;
192                        }
193                    }
194
195                    if ($multipolygon && !$exclude) {                   
196                        foreach my $m (@members) {
197                            my ($type, $mid, $role) = @$m;
198                            if ( ($role eq "outer") && ($type==WAY) ) {
199                                my $wayptn= wayptn($mid);
200                                my $in= exists($tiles{$wayptn}); # is it "in", i.e. will it be loaded later anyway?
201                                printf ("<!-- PASS2: OUTER : $mid   %d   %s-->\n", $in, join(",", fromptn($wayptn)) ) if ($debug_outer>1);
202                                unless ($in) { # not "in" -> reload
203                                    $pw{$wayptn} //= {};
204                                    $pw{$wayptn}->{$mid} = 1;
205                                    printf ("<!-- PASS2: added outer way $mid for relation $tr  -->\n") if ($debug_outer>0);
206                                }
207                            }
208                        }
209                    }
210                    else {
211                        printf "<!-- PASS2: relation $tr has not been examined -->\n" if ($debug_outer>1);
212                    }
213                }
214                else {
215                    printf "<!-- PASS2: MISS $tr -->\n" if ($debug_outer>1);
216                }
217            } # while
218        } # for
219    } # if ($query->param('reload_outer_ways') eq '1')
220   
221    foreach $ptn (keys %tiles) {
222        my $nd = openptn($ptn, "data");
223        my $wf = openptn($ptn, "ways");
224        my $rf = openptn($ptn, "relations");
225       
226# first we go through the ways and relations, looking for ones stored remotely
227# or ways nodes not in the tile
228        seek $wf, 0, 0;
229        while (my ($tw, $off) = readway($wf)) {
230            last unless(defined $tw);
231            next unless($tw);
232            if ($off == 0) {
233                # way stored remotly
234                $w = wayptn($tw);
235                unless (exists $tiles{$w}) {
236                    $pw{$w} //= {};
237                    $pw{$w}->{$tw} = 1;
238                }
239            } else {
240                seek $nd, $off, 0;
241                my @nodes = readwaynodes($nd);
242                foreach my $tn (@nodes) {
243                    $n = nodeptn($tn);
244                    unless (exists $tiles{$n}) {
245                        # node stored remotly
246                        $pn{$n} //= {};
247                        $pn{$n}->{$tn} = 1;
248                    }
249                }
250            }
251        }
252        seek $rf, 0, 0;
253        while (my ($tr, $off) = readrel($rf)) {
254            last unless(defined $tr);
255            next unless($tr);
256            if ($off == 0) {
257                my $r = relationptn($tr);
258                unless (exists $tiles{$r}) {
259                    $pr{$r} //= {};
260                    $pr{$r}->{$tr} = 1;
261                }
262            }
263        }
264    }
265   
266# now we go through the remote ways, looking for nodes not in the tile
267    foreach my $tp (keys %pw) {
268        my $pwf = openptn($tp, "ways");
269        my $pd = openptn($tp, "data");
270        seek $pwf, 0, 0;
271        while (my ($tw, $off) = readway($pwf)) {
272            last unless(defined $tw);
273            next unless($tw);
274            if (exists $pw{$tp}->{$tw}) {
275                seek $pd, $off, 0;
276                my @nodes = readwaynodes($pd);
277                foreach my $tn (@nodes) {
278                    $n = nodeptn($tn);
279                    unless (exists $tiles{$n}) {
280                        # node stored remotly
281                        $pn{$n} //= {};
282                        $pn{$n}->{$tn} = 1;
283                    }
284                }
285            }
286        }
287    }
288   
289# print nodes in the tile
290    foreach $ptn (keys %tiles) {
291        my $nf = openptn($ptn, "nodes");
292        my $nd = openptn($ptn, "data");
293       
294        my ($z, $x, $y) = fromptn($ptn);
295        print "<!-- nodes from z$z $x $y -->\n";
296        seek $nf, 0, 0;
297        while (my ($tn, $lat, $lon, $off) = readnode($nf)) {
298            last unless(defined $tn);
299            next unless($tn);
300            $lat /= CONV;
301            $lon /= CONV;
302            print "<node id=\"$tn\" lat=\"$lat\" lon=\"$lon\" ";
303            if ($off == 0) {
304                print "/>\n";
305            } else {
306                print ">\n";
307                seek $nd, $off, 0;
308                my @tv = readtags($nd, NODE);
309                while (my $key = shift(@tv)) {
310                    my $val = shift(@tv) // '';
311                    print "  <tag k=\"$key\" v=\"$val\"/>\n";
312                }
313                print "</node>\n";
314            }
315        }
316    }
317   
318# print the nodes used by ways
319   
320    foreach my $tp (keys %pn) {
321        my ($tz, $tx, $ty) = fromptn($tp);
322        print "<!-- some nodes from z$tz $tx $ty -->\n";
323        my $pnf = openptn($tp, "nodes");
324        my $pd = openptn($tp, "data");
325        seek $pnf, 0, 0;
326        while(my ($tn, $lat, $lon, $off) = readnode($pnf)) {
327            last unless(defined $tn);
328            next unless($tn);
329            if (exists $pn{$tp}->{$tn}) {
330                $lat /= CONV;
331                $lon /= CONV;
332                print "<node id=\"$tn\" lat=\"$lat\" lon=\"$lon\" ";
333                if ($off == 0) {
334                    print "/>\n";
335                } else {
336                    print ">\n";
337                    seek $pd, $off, 0;
338                    my @tv = readtags($pd, NODE);
339                    while (my $key = shift(@tv)) {
340                        $val = shift(@tv) // '';
341                        print "  <tag k=\"$key\" v=\"$val\"/>\n";
342                    }
343                    print "</node>\n";
344                }
345            }
346        }
347    }
348   
349# print ways
350    foreach $ptn (keys %tiles) {
351        my $nd = openptn($ptn, "data");
352        my $wf = openptn($ptn, "ways");
353       
354        my ($z, $x, $y) = fromptn($ptn);
355        print "<!-- ways from z$z $x $y -->\n";
356        seek $wf, 0, 0;
357        while(my ($tw, $off) = readway($wf)) {
358            last unless (defined $tw);
359            next unless ($tw && $off);
360            print "<way id=\"$tw\">\n";
361            seek $nd, $off, 0;
362            my @nodes = readwaynodes($nd);
363            foreach my $tn (@nodes) {
364                print "  <nd ref=\"$tn\"/>\n";
365            }
366            my @tv = readtags($nd, WAY);
367            while (my $key = shift(@tv)) {
368                $val = shift(@tv) // '';
369                print "  <tag k=\"$key\" v=\"$val\"/>\n";
370            }
371            print "</way>\n";
372        }
373    }
374   
375    foreach my $tp (keys %pw) {
376        my ($tz, $tx, $ty) = fromptn($tp);
377        print "<!-- some ways from z$tz $tx $ty -->\n";
378        my $pwf = openptn($tp, "ways");
379        my $pd = openptn($tp, "data");
380        seek $pwf, 0, 0;
381        while (my ($tw, $off) = readway($pwf)) {
382            last unless (defined $tw);
383            next unless($tw);
384            if ($off && exists $pw{$tp}->{$tw}) {
385                print "<way id=\"$tw\">\n";
386                seek $pd, $off, 0;
387                my @nodes = readwaynodes($pd);
388                foreach my $tn (@nodes) {
389                    print "  <nd ref=\"$tn\"/>\n";
390                }
391                my @tv = readtags($pd, WAY);
392                while(my $key = shift(@tv)) {
393                    $val = shift(@tv) // '';
394                    print "  <tag k=\"$key\" v=\"$val\"/>\n";
395                }
396                print "</way>\n";
397            }
398        }
399    }
400   
401# print relations
402   
403    foreach $ptn (keys %tiles) {
404        my $nd = openptn($ptn, "data");
405        my $rf = openptn($ptn, "relations");
406       
407        my ($z, $x, $y) = fromptn($ptn);
408        print "<!-- relations from z$z $x $y -->\n";
409        seek $rf, 0, 0;
410        while (my ($tr, $off) = readrel($rf)) {
411            last unless (defined $tr);
412            next unless ($tr && $off);
413            print "<relation id=\"$tr\">\n";
414            seek $nd, $off, 0;
415            my @members = readmemb($nd);
416            foreach my $m (@members) {
417                my ($type, $mid, $role) = @$m;
418                print "  <member type=\"".(MEMBERTYPE)[$type]."\" ref=\"$mid\" role=\"$role\"/>\n";
419            }
420            my @tv = readtags($nd, RELATION);
421            while (my $key = shift(@tv)) {
422                $val = shift(@tv) // '';
423                print "  <tag k=\"$key\" v=\"$val\"/>\n";
424            }
425            print "</relation>\n";
426        }
427    }
428   
429    foreach my $tp (keys %pr) {
430        my ($tz, $tx, $ty) = fromptn($tp);
431        print "<!-- some relations from z$tz $tx $ty -->\n";
432        my $prf = openptn($tp, "relations");
433        my $pd = openptn($tp, "data");
434        seek $prf, 0, 0;
435        while (my ($tr, $off) = readrel($prf)) {
436            last unless (defined $tr);
437            next unless($tr);
438            if ($off && exists $pr{$tp}->{$tr}) {
439                print "<relation id=\"$tr\">\n";
440                seek $pd, $off, 0;
441                my @members = readmemb($pd);
442                foreach my $m (@members) {
443                    my ($type, $mid, $role) = @$m;
444                    print "  <member type=\"".(MEMBERTYPE)[$type]."\" ref=\"$mid\" role=\"$role\"/>\n";
445                }
446                my @tv = readtags($pd, RELATION);
447                while (my $key = shift(@tv)) {
448                    $val = shift(@tv) // '';
449                    print "  <tag k=\"$key\" v=\"$val\"/>\n";
450                }
451                print "</relation>\n";
452            }
453        }
454    }
455   
456    print "</osm>\n";
457    $| = 1;
458    $| = 0;
459    last if ($die);
460}
Note: See TracBrowser for help on using the repository browser.