source: subversion/sites/other/trapi/trpcs.pl @ 31161

Last change on this file since 31161 was 20398, checked in by deelkar, 10 years ago

add so called "ugly hack" to support replicate diffs. By Milenko

File size: 22.4 KB
Line 
1#!/usr/bin/perl
2# Copyright 2008 Blars Blarson.  Distributed under GPL version 2, see GPL-2
3
4# update trapi database based on gziped osm or osc files.
5# takes file names on stdin.
6# Updates timestamp and deletes the file if it is an osc file.
7
8use strict;
9use warnings;
10
11use constant VERBOSE => 15;             # verbosity
12use trapi;
13
14chdir TRAPIDIR or die "could not chdir ".TRAPIDIR.": $!";
15
16ptdbinit("+<");
17
18$| = 1;
19
20our (%togc, $cachecount);
21# garbage collect
22sub garbagecollect() {
23    our (%filecache, %whengc, $devnull);
24    my @togc = sort {($whengc{$a} // 0) <=> ($whengc{$b} // 0) ||
25         ($togc{$a} // 0) <=> ($togc{$b} // 0)} keys %togc;
26    my $todo = GCCOUNT;
27    while (my $ptn = shift @togc) {
28        # avoid tiles being used
29        next if (exists $filecache{$ptn."data"});
30        gcptn($ptn);
31        $whengc{$ptn} = $cachecount;
32        delete $togc{$ptn};
33        last unless (--$todo);
34    }
35    print "Tiles left to garbagecollect: ".scalar(@togc)."\n"
36        if (VERBOSE > 3 && scalar(@togc));
37}
38
39my $ignoretags = IGNORETAGS;
40my ($id, $lat, $lon, $x, $y, $ptn, $off, @tv, $tv);
41my ($nodes, $ways, $relations, $splits) = (0, 0, 0, 0);
42my $deletemode = 0;
43while (my $gz = <>) {
44    chomp $gz;
45    open OSC, "-|", "zcat", $gz
46        or die "Could not zcat $gz";
47   
48    # add/modify
49    while ($_ = <OSC>) {
50        if (/^\s*\<delete\b/) {
51            print "Delete mode\n" if (VERBOSE > 9);
52            $deletemode = 1;
53        } elsif (/^\s*\<\/delete\b/) {
54            print "End Delete mode\n" if (VERBOSE > 9);
55            $deletemode = 0;
56        } elsif (/^\s*\<create\b/) {
57            print "Create mode\n" if (VERBOSE > 9);
58            $deletemode = 0;
59        } elsif (/^\s*\<modify\b/) {
60            print "Modify mode\n" if (VERBOSE > 9);
61            $deletemode = 0;
62        } elsif ($deletemode) {
63            next;
64        } elsif (/^\s*\<node\s/) {
65            $nodes++;
66            @tv = ();
67            unless (/\/\>\s*$/) {
68                while (! /\<\/node\>/s) {
69                    $tv = <OSC>;
70                    $_ .= $tv;
71                    if ($tv =~ /\<tag\s+k\=\"([^\"]*)\"\s+v\=\"([^\"]*)\"/) {
72                        my $tag = $1;
73                        my $val = $2;
74                        push @tv, $tag, $val unless (IGNORETAGS && $tag =~ /$ignoretags/o);
75                    }
76                }
77            }
78            print "Node: $_" if (VERBOSE > 20);
79            ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
80            ($lat) = /\slat\=[\"\']?(-?\d+(?:\.\d+)?)[\"\']?\b/;
81            ($lon) = /\slon\=[\"\']?(-?\d+(?:\.\d+)?)[\"\']?\b/;
82            ($x, $y) = getTileNumber($lat, $lon, MAXZOOM);
83            $ptn = etoptn($x, $y);
84            print "id: $id lat: $lat lon: $lon x: $x y:$y\n" if (VERBOSE > 18);
85            my $oldptn = nodeptn($id);
86            my $nf = openptn($ptn, "nodes");
87            my ($uz, $ux, $uy) = fromptn($ptn);
88            if ($oldptn eq NOPTN) {
89                print "Creating new node $id in $uz $ux,$uy\n" if (VERBOSE > 11);
90                seek $nf, 0, 0;
91                my ($mt);
92                while (my ($n, $tlat, $tlon, $noff) = readnode($nf)) {
93                    last unless (defined $n);
94                    unless ($n) {
95                        $mt //= tell $nf;
96                        next;
97                    }
98                    next unless ($n == $id);
99                    $mt = tell $nf;
100                    last;
101                }
102                seek $nf, $mt-16, 0 if ($mt);
103                if (tell($nf) >= SPLIT) {
104                    if (splitptn($ptn)) {
105                        $splits++;
106                        delete $togc{$ptn};
107                        our %whengc;
108                        delete $whengc{$ptn};
109                        $ptn = etoptn($x, $y);
110                        $nf = openptn($ptn, "nodes");
111                        seek $nf, 0, 2;
112                    }
113                }
114            } elsif ($oldptn eq $ptn) {
115                print "Replacing node $id in tile $uz $ux,$uy\n" if (VERBOSE > 6);
116                seek $nf, 0, 0;
117                while (my ($n, $tlat, $tlon, $off) = readnode($nf)) {
118                    last unless (defined $n);
119                    if ($n == $id) {
120                        seek $nf, -16, 1;
121                        last;
122                    }
123                }
124            } else {
125                if (VERBOSE > 4) {
126                    my ($vz, $vx, $vy) = fromptn($oldptn);
127                    print "Moving node $id from $vz $vx,$vy to $uz $ux,$uy\n"
128                }
129                my $onf = openptn($oldptn, "nodes");
130                seek $onf, 0, 0;
131                while (my ($tn, $tlat, $tlon, $toff) = readnode($onf)) {
132                    last unless (defined $tn);
133                    if ($tn == $id) {
134                        seek $onf, -16, 1;
135                        printnode($onf, 0, 0, 0, 0);
136                        $togc{$oldptn} = $cachecount if ($toff);
137                        last;
138                    }
139                }
140                seek $nf, 0, 2;
141                my $owf = openptn($oldptn, "ways");
142                seek $owf, 0, 0;
143                my $odf = openptn($oldptn, "data");
144                my (%wtc, %ways);
145                while (my ($w, $woff) = readway($owf)) {
146                    last unless (defined $w);
147                    next if ($w == 0);
148                    if ($woff == 0) {
149                        my $wp = wayptn($w);
150                        $wtc{$wp} //= {};
151                        $wtc{$wp}->{$w} = 1;
152                    } else {
153                        seek $odf, $woff, 0;
154                        my @nodes = readwaynodes($odf);
155                        foreach my $n (@nodes) {
156                            next unless ($n == $id);
157                            $ways{$w} = 1;
158                            last;
159                        }
160                    }
161                }
162                my ($wp);
163                foreach $wp (keys %wtc) {
164                    next if ($wp eq $ptn);
165                    my %wh = %{$wtc{$wp}};
166                    $owf = openptn($wp, "ways");
167                    seek $owf, 0, 0;
168                    $odf = openptn($wp, "data");
169                    while (my ($w, $woff) = readway($owf)) {
170                        last unless (defined $w);
171                        next unless (exists $wh{$w});
172                        seek $odf, $woff, 0;
173                        my @nodes = readwaynodes($odf);
174                        foreach my $n (@nodes) {
175                            next unless ($n == $id);
176                            $ways{$w} = 1;
177                            last;
178                        }
179                    }
180                }
181                my $nwf = openptn($ptn, "ways");
182                seek $nwf, 0, 0;
183                while (my ($w, $woff) = readway($nwf)) {
184                    last unless (defined $w);
185                    next unless($w);
186                    $ways{$w} = 0 if (exists $ways{$w});
187                }
188                our %waycache;
189                foreach my $w (keys %ways) {
190                    if ($ways{$w}) {
191                        delete $waycache{$w};
192                        print "  adding way $w to $uz $ux,$uy\n"
193                            if (VERBOSE > 4);;
194                        printway($nwf, $w, 0);
195                    }
196                }
197                my $orf = openptn($oldptn, "relations");
198                $odf = openptn($oldptn, "data");
199                seek $orf, 0, 0;
200                my (%rtc, %rels);
201              rproc:    while (my ($r, $roff) = readrel($orf)) {
202                  last unless (defined $r);
203                  next unless ($r);
204                  if ($roff == 0) {
205                      my $rp = relationptn($r);
206                      $rtc{$rp} //= {};
207                      $rtc{$rp}->{$r} //= {};
208                  } else {
209                      seek $odf, $roff, 0;
210                      my @members = readmemb($odf);
211                      foreach my $m (@members) {
212                          my ($type, $mid, $role) = @$m;
213                          if ($type == NODE) {
214                              next unless ($mid == $id);
215                              $rels{$r} = 1;
216                              next rproc;
217                          } elsif ($type == WAY) {
218                              next unless (exists $ways{$mid});
219                              $rels{$r} = 1;
220                              next rproc;
221                          } elsif ($type == RELATION) {
222                              if (exists $rels{$mid}) {
223                                  $rels{$r} = 1;
224                                  next rproc;
225                              }
226                              my $rrp = relationptn($mid);
227                              $rtc{$rrp} //= {};
228                              $rtc{$rrp}->{$mid} //= {};
229                              $rtc{$rrp}->{$mid}->{$r} = 1;
230                          } else {
231                              die "Unknown relation $r type $type";
232                          }
233                      }
234                  }
235              }
236                my %rseen;
237                while (my @rt = keys %rtc) {
238                    foreach my $t (@rt) {
239                        my %x = %{$rtc{$t}};
240                        delete $rtc{$t};
241                        my $orf = openptn($t, "relations");
242                        seek $orf, 0, 0;
243                        my $odf = openptn($t, "data");
244                      rrtc: while (my ($r, $roff) = readrel($orf)) {
245                          last unless (defined $r);
246                          next unless ($r && $roff);
247                          next if (exists $rels{$r});
248                          next unless (exists $x{$r});
249                          $rseen{$r} = 1;
250                          seek $odf, $roff, 0;
251                          my @members = readmemb($odf);
252                          foreach my $m (@members) {
253                              my ($type, $mid, $role) = @$m;
254                              if ($type == NODE) {
255                                  next unless ($mid == $id);
256                                  $rels{$r} = 1;
257                                  foreach my $rr (keys %{$x{$r}}) {
258                                      $rels{$rr} = 1;
259                                  }
260                                  next rrtc;
261                              } elsif ($type == WAY) {
262                                  next unless (exists $ways{$mid});
263                                  $rels{$r} = 1;
264                                  foreach my $rr (keys %{$x{$r}}) {
265                                      $rels{$rr} = 1;
266                                  }
267                                  next rrtc;
268                              } elsif ($type == RELATION) {
269                                  if (exists $rels{$mid}) {
270                                      $rels{$r} = 1;
271                                      foreach my $rrr (keys %{$x{$r}}) {
272                                          $rels{$rrr} = 1;
273                                      }
274                                      next rrtc;
275                                  }
276                                  if ($rseen{$mid}) {
277                                      print "  seen relation $mid before\n"
278                                          if (VERBOSE > 99);
279                                      next;
280                                  }
281                                  my $rrp = relationptn($mid);
282                                  $rtc{$rrp} //= {};
283                                  $rtc{$rrp}->{$mid} //= {};
284                                  $rtc{$rrp}->{$mid}->{$r} = 1;
285                              } else {
286                                  die "unknown relation $r type $type";
287                              }
288                          }
289                      }
290                    }
291                }
292                my $nrf = openptn($ptn, "relations");
293                seek $nrf, 0, 0;
294                while (my ($r, $roff) = readrel($nrf)) {
295                    last unless (defined $r);
296                    next unless ($r);
297                    delete $rels{$r} if (exists $rels{$r});
298                }
299                foreach my $r (keys %rels) {
300                    print "  adding relation $r to z$uz $ux,$uy\n"
301                        if (VERBOSE > 4);
302                    printrel($nrf, $r, 0);
303                }
304            }
305            if (@tv) {
306                print "writing node $id tags\n" if (VERBOSE > 22);
307                my $nd = openptn($ptn, "data");
308                $togc{$ptn} = $cachecount;
309                seek $nd, 0, 2;
310                $off = tell $nd;
311                print "tags: ".scalar(@tv)." off: $off\n" if (VERBOSE > 24);
312                printtags($nd, \@tv, NODE);
313            } else {
314                $off = 0;
315            }
316            printnode($nf, $id, int($lat * CONV), int($lon * CONV), $off);
317            nodeptn($id, $ptn) if ($ptn ne $oldptn);
318        } elsif (/^\s*\<way\s+/) {
319            $ways++;
320            @tv = ();
321            my @nodes = ();
322            unless (/\/\>\s*$/) {
323                while (! /\<\/way\>/s) {
324                    $tv = <OSC>;
325                    $_ .= $tv;
326                    if ($tv =~ /\<nd\s+ref\=\"(\d+)\"/) {
327                        push @nodes, $1;
328                    } elsif ($tv =~ /\<tag\s+k\=\"([^\"]*)\"\s+v\=\"([^\"]*)\"/) {
329                        my $tag = $1;
330                        my $val = $2;
331                        push @tv, $tag, $val unless (IGNORETAGS && $tag =~ /$ignoretags/o);
332                    }
333                }
334            }
335            ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
336            print "Way: $_" if (VERBOSE > 19);
337            $ptn = wayptn($id);
338            our %waycache;
339            delete $waycache{$id};
340            unless (@nodes) {
341                print "Way $id has no nodes\n" if (VERBOSE > 2);
342                print "Way: $_" if (VERBOSE > 3);
343                if ($ptn ne NOPTN) {
344                    my $wf = openptn($ptn, "ways");
345                    seek $wf, 0, 0;
346                    while (my ($w, $off) = readway($wf)) {
347                        last unless (defined $w);
348                        next unless ($w == $id);
349                        seek $wf, -8, 1;
350                        printway($wf, 0, 0);
351                        my $wd = openptn($ptn, "data");
352                        $togc{$ptn} = $cachecount;
353                        seek $wd, $off, 0;
354                        my %ptns = ();
355                        my @nodes = readwaynodes($wd);
356                        foreach my $n (@nodes) {
357                            $ptns{nodeptn($n)}++;
358                        }
359                        delete $ptns{$ptn};
360                        foreach my $p (keys %ptns) {
361                            $wf = openptn($p, "ways");
362                            seek $wf, 0, 0;
363                            while (my ($w, $off) = readway($wf)) {
364                                last unless (defined $w);
365                                next unless ($w == $id);
366                                seek $wf, -8, 1;
367                                printway($wf, 0, 0);
368                                last;
369                            }
370                        }
371                        last;
372                    }
373                    wayptn($id, NOPTN);
374                }
375                next;
376            }
377            my $new = $ptn eq NOPTN;
378            my ($wf, $wd, %oldptns, %rtc, %ptns);
379            foreach my $node (@nodes) {
380                $ptns{nodeptn($node)}++;
381            }
382            if ($new) {
383                $ptn = nodeptn($nodes[0]);
384                $ptn = toptn(0,1,1) if ($ptn eq NOPTN);
385                if (VERBOSE > 4) {
386                    my ($uz, $ux, $uy) = fromptn($ptn);
387                    print "New way $id in tile $uz $ux,$uy\n";
388                }
389                $wf = openptn($ptn, "ways");
390                seek $wf, 0, 0;
391                while (my ($w, $off) = readway($wf)) {
392                    last unless (defined $w);
393                    next if ($w);
394                    seek $wf, -8, 1;
395                    last;
396                }
397                $wd = openptn($ptn, "data");
398                seek $wd, 0, 2;
399            } else {
400                if (VERBOSE > 4) {
401                    my ($uz, $ux, $uy) = fromptn($ptn);
402                    print "Update way $id in tile $uz $ux,$uy\n";
403                }
404                $wf = openptn($ptn, "ways");
405                seek $wf, 0, 0;
406                $off = undef;
407                while (my ($w, $woff) = readway($wf)) {
408                    last unless (defined $w);
409                    if ($w == $id) {
410                        seek $wf, -8, 1;
411                        $off = $woff if ($woff);
412                        last;
413                    }
414                }
415                $wd = openptn($ptn, "data");
416                $togc{$ptn} = $cachecount;
417                if (defined $off) {
418                    seek $wd, $off, 0;
419                    my @n = readwaynodes($wd);
420                    foreach my $node (@n) {
421                        $oldptns{nodeptn($node)}++;
422                    }
423                }
424                my $rf = openptn($ptn, "relations");
425                seek $rf, 0, 0;
426                while (my ($r, $roff) = readrel($rf)) {
427                    last unless (defined $r);
428                    next unless ($r);
429                    $rtc{$r} = 1;
430                }
431                unless ((exists $ptns{$ptn}) || ((exists $ptns{NOPTN}) && ($ptn eq toptn(0,1,1)))) {
432                    printway($wf, 0, 0);
433                    $ptn = nodeptn($nodes[0]);
434                    $ptn = toptn(0,1,1) if ($ptn eq NOPTN);
435                    if (VERBOSE > 4) {
436                        my ($uz, $ux, $uy) = fromptn($ptn);
437                        print "  moving to z$uz $ux,$uy\n";
438                    }
439                    $wf = openptn($ptn, "ways");
440                    seek $wf, 0, 0;
441                    my $mt;
442                    while (my ($w, $off) = readway($wf)) {
443                        last unless (defined $w);
444                        if ($w == 0) {
445                            $mt //= tell $wf;
446                            next;
447                        }
448                        next unless ($w == $id);
449                        $mt = tell $wf;
450                        last;
451                    }
452                    seek $wf, $mt-8, 0 if (defined $mt);
453                    $wd = openptn($ptn, "data");
454                    $togc{$ptn} = $cachecount;
455                    $new = 1;
456                }
457                seek $wd, 0, 2;
458            }
459            $off = tell $wd;
460            print "nodes: ".scalar(@nodes)." tags: ".scalar(@tv)." off: $off\n"
461                if (VERBOSE > 20);
462            printwaynodes($wd, \@nodes);
463            printtags($wd, \@tv, WAY);
464            printway($wf, $id, $off);
465            wayptn($id, $ptn) if($new);
466            my %rt;
467            foreach my $p (keys %ptns) {
468                if ($p ne $ptn && ! defined($oldptns{$p})) {
469                    if (VERBOSE > 4) {
470                        my ($uz, $ux, $uy) = fromptn($p);
471                        print "  adding to z$uz $ux,$uy\n";
472                    }
473                    my $pwf = openptn($p, "ways");
474                    seek $pwf, 0, 0;
475                    my ($mt);
476                    while (my ($w, $off) = readway($pwf)) {
477                        last unless (defined $w);
478                        unless ($w) {
479                            $mt //= tell $pwf;
480                            next;
481                        }
482                        next unless ($w == $id);
483                        $mt = tell $pwf;
484                        last;
485                    }
486                    seek $pwf, $mt-8, 0 if ($mt);
487                    printway($pwf, $id, 0);
488                    my $prf = openptn($p, "relations");
489                    seek $prf, 0, 0;
490                    my ($f);
491                    while (my ($r, $roff) = readrel($prf)) {
492                        last unless (defined $r);
493                        next unless ($r);
494                        if (exists $rtc{$r}) {
495                            $rtc{$r} = 0;
496                        }
497                    }
498                    foreach my $r (keys %rtc) {
499                        if ($rtc{$r}) {
500                            unless (exists $rt{$r}) {
501                                $rt{$r} = {reltiles([[3, $r]])};
502                            }
503                            if (exists $rt{$r}->{$p}) {
504                                seek $prf, 0, 2;
505                                printrel($prf, $r, 0);
506                            }
507                        } else {
508                            $rtc{$r} = 1;
509                        }
510                    }
511                }
512            }
513            foreach my $p (keys %oldptns) {
514                if ($p ne $ptn && ! defined($ptns{$p})) {
515                    my ($uz, $ux, $uy) = fromptn($p);
516                    print "  removing from z$uz $ux,$uy\n";
517                    my $pwf = openptn($p, "ways");
518                    seek $pwf, 0, 0;
519                    while (my ($w, $woff) = readway($pwf)) {
520                        last unless (defined $w);
521                        next unless ($w eq $id);
522                        seek $pwf, -8, 1;
523                        printway($pwf, 0, 0);
524                        last;
525                    }
526                }
527            }
528           
529        } elsif (/^\s*\<relation\s+/) {
530            $relations++;
531            @tv = ();
532            my @members = ();
533            unless (/\/\>\s*$/) {
534                while (! /\<\/relation\>/s) {
535                    $tv = <OSC>;
536                    $_ .= $tv;
537                    if ($tv =~ /\<member\s+type\=\"(\w+)\"\s+ref\=\"(\d+)\"(?:\s+role\=\"([^\"]*)\")?/) {
538                        push @members, [MEMBER->{$1}, $2, $3];
539                    } elsif ($tv =~ /\<tag\s+k\=\"([^\"]*)\"\s+v\=\"([^\"]*)\"/) {
540                        my $tag = $1;
541                        my $val = $2;
542                        push @tv, $tag, $val unless (IGNORETAGS && $tag =~ /$ignoretags/o);
543                    }
544                }
545            }
546            ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
547            print "Relation: $_" if (VERBOSE > 18);
548            $ptn = relationptn($id);
549            my (%oldtiles, %rtc, $rf);
550            my %tiles = reltiles(\@members);
551            if ($ptn eq NOPTN) {
552                $ptn = each %tiles;
553                unless($ptn) {
554                    print "Relation $id has no members\n" if (VERBOSE > 1);
555                    print "Relation: $_" if (VERBOSE > 3);
556                    next;
557                }
558                $ptn = toptn(0,1,1) if ($ptn eq NOPTN);
559                if (VERBOSE > 4) {
560                    my ($uz, $ux, $uy) = fromptn($ptn);
561                    print "New relation $id in z$uz $ux,$uy\n";
562                }
563                $rf = openptn($ptn, "relations");
564                seek $rf, 0, 2;
565            } else {
566                if (VERBOSE > 4) {
567                    my ($uz, $ux, $uy) = fromptn($ptn);
568                    print "Modify relation $id in z$uz $ux,$uy\n";
569                }
570                %oldtiles = reltiles([[3, $id]]);
571                $oldtiles{$ptn}++;
572                $rf = openptn($ptn, "relations");
573                my ($rp);
574                seek $rf, 0, 0;
575                while (my ($r, $off) = readrel($rf)) {
576                    last unless (defined $r);
577                    unless ($r) {
578                        $rp //= tell $rf;
579                        next;
580                    }
581                    if ($r == $id) {
582                        $rp = tell $rf;
583                    } else {
584                        $rtc{$r} = 1;
585                    }
586                }
587                seek $rf, $rp-8, 0 if ($rp);
588                unless ($tiles{$ptn}) {
589                    printrel($rf, 0, 0);
590                    $ptn = (each %tiles) // NOPTN;
591                    $ptn = toptn(0,1,1) if ($ptn eq NOPTN);
592                    if (VERBOSE > 4) {
593                        my ($uz, $ux, $uy) = fromptn($ptn);
594                        print "  moving to z$uz $ux,$uy\n";
595                    }
596                    $rf = openptn($ptn, "relations");
597                    seek $rf, 0, 0;
598                    $rp = undef;
599                    while (my ($r, $off) = readrel($rf)) {
600                        last unless (defined $r);
601                        unless ($r) {
602                            $rp //= tell $rf;
603                            next;
604                        }
605                        next unless ($r == $id);
606                        $rp = tell $rf;
607                        last;
608                    }
609                    seek $rf, $rp-8, 0 if ($rp);
610                }
611            }
612            my $rd = openptn($ptn, "data");
613            $togc{$ptn} = $cachecount;
614            seek $rd, 0, 2;
615            $off = tell $rd;
616            print "members: ".scalar(@members)." tags: ".scalar(@tv)." off: $off\n" if (VERBOSE > 19);
617            printmemb($rd, \@members);
618            printtags($rd, \@tv, RELATION);
619            printrel($rf, $id, $off);
620            relationptn($id, $ptn);
621            my %rt;
622            while (my $p = each %tiles) {
623                next if ($p eq $ptn);
624                next if (exists $oldtiles{$p});
625                if (VERBOSE > 4) {
626                    my ($vz, $vx, $vy) = fromptn($p);
627                    print "  also in z$vz $vx,$vy\n";
628                }
629                my $prf = openptn($p, "relations");
630                seek $prf, 0, 0;
631                my ($f, $mt);
632                while (my ($r, $roff) = readrel($prf)) {
633                    last unless (defined $r);
634                    unless ($r) {
635                        $mt //= tell $prf;
636                        next;
637                    }
638                    if ($r == $id) {
639                        $mt = tell $prf;
640                        last;
641                    }
642                    next unless (exists $rtc{$r});
643                    $rtc{$r} = 0;
644                }
645                seek $prf, $mt - 8, 0 if (defined $mt);
646                printrel($prf, $id, 0);
647                foreach my $r (keys %rtc) {
648                    if ($rtc{$r}) {
649                        unless (exists $rt{$r}) {
650                            $rt{$r} = {reltiles([[3, $r]])};
651                        }
652                        if (exists $rt{$r}->{$p}) {
653                            seek $prf, 0, 0;
654                            my ($mt);
655                            while (my ($rr, $rroff) = readrel($prf)) {
656                                last unless (defined $rr);
657                                unless ($rr) {
658                                    $mt //= tell $prf;
659                                    next;
660                                }
661                                next unless ($rr == $r);
662                                $mt = tell $prf;
663                                last;
664                            }
665                            seek $prf, $mt-8, 0 if ($mt);
666                            printrel($prf, $r, 0);
667                        }
668                    } else {
669                        $rtc{$r} = 1;
670                    }
671                }
672            }
673            while (my $p = each %oldtiles) {
674                next if ($p eq $ptn);
675                next if (exists $tiles{$p});
676                if (VERBOSE > 4) {
677                    my ($vz, $vx, $vy) = fromptn($p);
678                    print "  remove from z$vz $vx,$vy\n";
679                }
680                my $prf = openptn($p, "relations");
681                seek $prf, 0, 0;
682                while (my ($r, $roff) = readrel($prf)) {
683                    last unless (defined $r);
684                    next unless ($r == $id);
685                    seek $prf, -8, 1;
686                    printrel($prf, 0, 0);
687                    last;
688                }
689            }
690        }
691    }
692    close OSC;
693    open OSC, "-|", "zcat", $gz
694        or die "Could not zcat $gz";
695   
696    # delete relations
697    while ($_ = <OSC>) {
698        if (/^\s*\<delete\b/) {
699            print "Delete mode\n" if (VERBOSE > 9);
700            $deletemode = 1;
701        } elsif (/^\s*\<\/delete\b/) {
702            print "End Delete mode\n" if (VERBOSE > 9);
703            $deletemode = 0;
704        } elsif (/^\s*\<create\b/) {
705            print "Create mode\n" if (VERBOSE > 9);
706            $deletemode = 0;
707        } elsif (/^\s*\<modify\b/) {
708            print "Modify mode\n" if (VERBOSE > 9);
709            $deletemode = 0;
710        } elsif (!$deletemode) {
711            next;
712        } elsif (/^\s*\<relation\s+/) {
713            $relations++;
714            unless (/\/\>\s*$/) {
715                while (! /\<\/relation\>/s) {
716                    $tv = <OSC>;
717                    $_ .= $tv;
718                }
719            }
720            ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
721            print "Relation: $_" if (VERBOSE > 18);
722            $ptn = relationptn($id);
723            if ($ptn ne NOPTN) {
724                $togc{$ptn} = $cachecount;
725                my ($uz, $ux, $uy) = fromptn($ptn);
726                print "Delete relation $id from z$uz $ux,$uy\n"
727                    if (VERBOSE > 4);
728                my %tiles = reltiles([[3, $id]]);
729                $tiles{$ptn}++;
730                $tiles{toptn(0,1,1)}++ if ($tiles{NOPTN});
731                while (my $t = each %tiles) {
732                    my $rf = openptn($t, "relations");
733                    seek $rf, 0, 0;
734                    while (my ($r, $off) = readrel($rf)) {
735                        last unless (defined $r);
736                        next unless($r == $id);
737                        seek $rf, -8, 1;
738                        printrel($rf, 0, 0);
739                        last;
740                    }
741                }
742                relationptn($id, NOPTN);
743            } else {
744                print "Delete of nonexistant relation $id ignored\n"
745                    if (VERBOSE > 2);
746            }
747        }
748    }
749    close OSC;
750    open OSC, "-|", "zcat", $gz
751        or die "Could not zcat $gz";
752    # delete ways
753    while ($_ = <OSC>) {
754        if (/^\s*\<delete\b/) {
755            print "Delete mode\n" if (VERBOSE > 9);
756            $deletemode = 1;
757        } elsif (/^\s*\<\/delete\b/) {
758            print "End Delete mode\n" if (VERBOSE > 9);
759            $deletemode = 0;
760        } elsif (/^\s*\<create\b/) {
761            print "Create mode\n" if (VERBOSE > 9);
762            $deletemode = 0;
763        } elsif (/^\s*\<modify\b/) {
764            print "Modify mode\n" if (VERBOSE > 9);
765            $deletemode = 0;
766        } elsif (!$deletemode) {
767            next;
768        } elsif (/^\s*\<way\s+/) {
769            $ways++;
770            unless (/\/\>\s*$/) {
771                while (! /\<\/way\>/s) {
772                    $tv = <OSC>;
773                    $_ .= $tv;
774                }
775            }
776            ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
777            print "Way: $_" if (VERBOSE > 19);
778            our %waycache;
779            delete $waycache{$id};
780            $ptn = wayptn($id);
781            if ($ptn eq NOPTN) {
782                print "Delete of nonexistant way $id ignored\n"
783                    if (VERBOSE > 3);
784                next;
785            }
786            if (VERBOSE > 4) {
787                my ($uz, $ux, $uy) = fromptn($ptn);
788                print "Deleting way $id from z$uz $ux,$uy\n";
789            }
790            my $wf = openptn($ptn, "ways");
791            seek $wf, 0, 0;
792            while (my ($w, $off) = readway($wf)) {
793                last unless (defined $w);
794                next unless ($w == $id);
795                seek $wf, -8, 1;
796                printway($wf, 0, 0);
797                my $wd = openptn($ptn, "data");
798                $togc{$ptn} = $cachecount;
799                seek $wd, $off, 0;
800                my %ptns = ();
801                my @nodes = readwaynodes($wd);
802                foreach my $n (@nodes) {
803                    $ptns{nodeptn($n)}++;
804                }
805                delete $ptns{$ptn};
806                foreach my $p (keys %ptns) {
807                    $wf = openptn($p, "ways");
808                    seek $wf, 0, 0;
809                    while (my ($w, $off) = readway($wf)) {
810                        last unless (defined $w);
811                        next unless ($w == $id);
812                        seek $wf, -8, 1;
813                        printway($wf, 0, 0);
814                        last;
815                    }
816                }
817                last;
818            }
819            wayptn($id, NOPTN);
820        }
821    }
822    close OSC;
823    open OSC, "-|", "zcat", $gz
824        or die "Could not zcat $gz";
825    # delete nodes
826    while ($_ = <OSC>) {
827        if (/^\s*\<delete\b/) {
828            print "Delete mode\n" if (VERBOSE > 9);
829            $deletemode = 1;
830        } elsif (/^\s*\<\/delete\b/) {
831            print "End Delete mode\n" if (VERBOSE > 9);
832            $deletemode = 0;
833        } elsif (/^\s*\<create\b/) {
834            print "Create mode\n" if (VERBOSE > 9);
835            $deletemode = 0;
836        } elsif (/^\s*\<modify\b/) {
837            print "Modify mode\n" if (VERBOSE > 9);
838            $deletemode = 0;
839        } elsif (!$deletemode) {
840            next;
841        } elsif (/^\s*\<node\s/) {
842            $nodes++;
843            unless (/\/\>\s*$/) {
844                while (! /\<\/node\>/s) {
845                    $tv = <OSC>;
846                    $_ .= $tv;
847                }
848            }
849            print "Node: $_" if (VERBOSE > 20);
850            ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
851            $ptn = nodeptn($id);
852            if ($ptn eq NOPTN) {
853                print "Delete of missing node $id ignored\n"
854                    if (VERBOSE > 7);
855                next;
856            }
857            my $nf = openptn($ptn, "nodes");
858            seek $nf, 0, 0;
859            while (my ($n, $lat, $lon, $off) = readnode($nf)) {
860                last unless (defined $n);
861                next unless($n == $id);
862                if (VERBOSE > 9) {
863                    my ($uz, $ux, $uy) = fromptn($ptn);
864                    print "Deleting node $id from z$uz $ux,$uy\n";
865                }
866                seek $nf, -16, 1;
867                printnode($nf, 0, 0, 0, 0);
868                $togc{$ptn} = $cachecount if ($off);
869                last;
870            }
871            nodeptn($id, NOPTN);
872        }
873    }
874    close OSC;
875   
876    writecache();
877    if ($gz =~ /(?:^|\/)\d+\-(\d+)-(\d+)\.osc\.gz$/) {
878        open STAMP, ">", "timestamp" or die "Could not open timestamp";
879        print STAMP "$2\n";
880        close STAMP;
881        unlink $gz;
882    }
883    print "Processed $gz\n" if (VERBOSE > 0);
884    print "Nodes: $nodes Ways: $ways Relations: $relations Splits: $splits\n"
885        if (VERBOSE > 1);
886    cachestat() if (VERBOSE > 2);
887    garbagecollect() if (GCCOUNT);
888}
Note: See TracBrowser for help on using the repository browser.