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

Last change on this file since 31161 was 13790, checked in by blarson, 11 years ago

Fairly major rewrite and cleanup, with common tag comression.

File size: 4.5 KB
Line 
1#!/usr/bin/perl
2# Copyright 2008, 2009 Blars Blarson.  Distributed under GPL version 2, see GPL-2
3
4use strict;
5use warnings;
6
7use constant VERBOSE => 5;              # verbosity
8use trapi;
9
10chdir TRAPIDIR or die "could not chdir ".TRAPIDIR.": $!";
11
12ptdbinit("+<");
13
14
15my $ignoretags = IGNORETAGS;
16
17my ($id, $lat, $lon, $x, $y, $ptn, $off, @tv, $tv);
18my ($nodes, $ways, $relations, $splits) = 0 x 4;
19while ($_ = <>) {
20    if (/^\s*\<node\s/) {
21        $nodes++;
22        @tv = ();
23        unless (/\/\>\s*$/) {
24            while (! /\<\/node\>/s) {
25                $tv = <>;
26                $_ .= $tv;
27                if ($tv =~ /\<tag\s+k\=\"([^\"]*)\"\s+v\=\"([^\"]*)\"/) {
28                    my $tag = $1;
29                    my $val = $2;
30                    push @tv, $tag, $val unless (IGNORETAGS && $tag =~ /$ignoretags/o);
31                }
32            }
33        }
34        print "Node: $_" if (VERBOSE > 20);
35        ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
36        ($lat) = /\slat\=[\"\']?(-?\d+(?:\.\d+)?)[\"\']?\b/;
37        ($lon) = /\slon\=[\"\']?(-?\d+(?:\.\d+)?)[\"\']?\b/;
38        ($x, $y) = getTileNumber($lat, $lon, MAXZOOM);
39        $ptn = etoptn($x, $y);
40        print "id: $id lat: $lat lon: $lon x: $x y:$y\n" if (VERBOSE > 18);
41        my $nf = openptn($ptn, "nodes");
42        seek $nf, 0, 2;
43        if (tell($nf) >= SPLIT) {
44            if(splitptn($ptn)) {
45                $splits++;
46                $ptn = etoptn($x, $y);
47                $nf = openptn($ptn, "nodes");
48                seek $nf, 0, 2;
49            }
50        }
51        if (@tv) {
52            my $nd = openptn($ptn, "data");
53            seek $nd, 0, 2;
54            $off = tell $nd;
55            print "tags: ".scalar(@tv)." off: $off\n" if (VERBOSE > 19);
56            printtags($nd, \@tv, NODE);
57        } else {
58            $off = 0;
59        }
60        printnode($nf, $id, int($lat * CONV), int($lon * CONV), $off);
61        nodeptn($id, $ptn);
62    } elsif (/^\s*\<way\s+/) {
63        $ways++;
64        @tv = ();
65        my @nodes = ();
66        unless (/\/\>\s*$/) {
67            while (! /\<\/way\>/s) {
68                $tv = <>;
69                $_ .= $tv;
70                if ($tv =~ /\<nd\s+ref\=\"(\d+)\"/) {
71                    push @nodes, $1;
72                } elsif ($tv =~ /\<tag\s+k\=\"([^\"]*)\"\s+v\=\"([^\"]*)\"/) {
73                    my $tag = $1;
74                    my $val = $2;
75                    push @tv, $tag, $val unless (IGNORETAGS && $tag =~ /$ignoretags/o);
76                }
77            }
78        }
79        ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
80        print "Way: $_" if (VERBOSE > 20);
81        unless (@nodes) {
82            print "Way $id has no nodes\n" if (VERBOSE > 0);
83            print "Way: $_" if (VERBOSE > 1);
84            next;
85        }
86        $ptn = nodeptn($nodes[0]);
87        $ptn = toptn(0,1,1) if ($ptn eq NOPTN);
88        my $wf = openptn($ptn, "ways");
89        seek $wf, 0, 2;
90        my $wd = openptn($ptn, "data");
91        seek $wd, 0, 2;
92        $off = tell $wd;
93        print "nodes: ".scalar(@nodes)." tags: ".scalar(@tv)." off: $off\n"
94            if (VERBOSE > 19);
95        my %ptns = ();
96        foreach my $n (@nodes) {
97            $ptns{nodeptn($n)}++;
98        }
99        printwaynodes($wd, \@nodes);
100        printtags($wd, \@tv, WAY);
101        if (VERBOSE > 4) {
102            my ($uz, $ux, $uy) = fromptn($ptn);
103            print "Way $id in z$uz $ux,$uy\n";
104        }
105        printway($wf, $id, $off);
106        wayptn($id, $ptn);
107        delete $ptns{$ptn};
108        foreach my $p (keys %ptns) {
109            if (VERBOSE > 4) {
110                my ($vz, $vx, $vy) = fromptn($p);
111                print "  also in z$vz $vx,$vy\n";
112            }
113            my $pwf = openptn($p, "ways");
114            seek $pwf, 0, 2;
115            printway($pwf, $id, 0);
116        }
117    } elsif (/^\s*\<relation\s+/) {
118        $relations++;
119        @tv = ();
120        my @members = ();
121        unless (/\/\>\s*$/) {
122            while (! /\<\/relation\>/s) {
123                $tv = <>;
124                $_ .= $tv;
125                if ($tv =~ /\<member\s+type\=\"(\w+)\"\s+ref\=\"(\d+)\"(?:\s+role\=\"([^\"]*)\")?/) {
126                    push @members, [MEMBER->{$1}, $2, $3];
127                } elsif ($tv =~ /\<tag\s+k\=\"([^\"]*)\"\s+v\=\"([^\"]*)\"/) {
128                    my $tag = $1;
129                    my $val = $2;
130                    push @tv, $tag, $val unless (IGNORETAGS && $tag =~ /$ignoretags/o);
131                }
132            }
133        }
134        ($id) = /\sid\=[\"\']?(\d+)[\"\']?\b/;
135        print "Relation: $_" if (VERBOSE > 20);
136        my %tiles = reltiles(\@members);
137        $ptn = each %tiles;
138        unless (defined $ptn) {
139            print "Relation $id has no members\n" if (VERBOSE > 0);
140            print "Relation: $_" if (VERBOSE > 2);
141            next;
142        }
143        $ptn = toptn(0,1,1) if ($ptn eq NOPTN);
144        my $rf = openptn($ptn, "relations");
145        seek $rf, 0, 2;
146        my $rd = openptn($ptn, "data");
147        seek $rd, 0, 2;
148        $off = tell $rd;
149        print "members: ".scalar(@members)." tags: ".scalar(@tv)." off: $off\n" if (VERBOSE > 19);
150        printmemb($rd, \@members);
151        printtags($rd, \@tv, RELATION);
152        if (VERBOSE > 4) {
153            my ($uz, $ux, $uy) = fromptn($ptn);
154            print "Relation $id in z$uz $ux,$uy\n";
155        }
156        printrel($rf, $id, $off);
157        relationptn($id, $ptn);
158        while (my $p = each %tiles) {
159            next if ($p eq $ptn);
160            if (VERBOSE > 4) {
161                my ($vz, $vx, $vy) = fromptn($p);
162                print "  also in z$vz $vx,$vy\n";
163            }
164            my $prf = openptn($p, "relations");
165            seek $prf, 0, 2;
166            printrel($prf, $id, 0);
167        }
168    }
169}
170
171print "Nodes: $nodes Ways: $ways Relations: $relations Splits: $splits\n"
172    if (VERBOSE > 1);
173cachestat() if (VERBOSE > 2);
Note: See TracBrowser for help on using the repository browser.