source: subversion/applications/utils/import/and_import/planetosm-deleteby-tags.pl @ 4229

Last change on this file since 4229 was 4229, checked in by martinvoosterhout, 12 years ago

Commit the initial Makefile that successfully produces the OSM file listing
stuff to be deleted.

Also add the deleteby script.

  • Property svn:executable set to *
File size: 10.9 KB
Line 
1#!/usr/bin/perl
2# Takes a planet.osm, and creates an OSM that *deletes* just the bits that
3# have certain tags
4#
5# Requires several passes over the file, so can't work with a stream from
6#  STDIN. Normally run on an area excerpt, or data downloaded from the API
7#
8# For now, all configuration is done in the code. In future, we'll want to
9#  split this out into a rules file
10#
11#
12# Martijn van Oosterhout
13#     v0.01   18/08/2007
14# Based on planetosm-excerpt-tags.pl
15# Nick Burch
16#     v0.01   01/11/2006
17
18use strict;
19use warnings;
20
21
22###########################################################################
23#                BEGIN USER CONFIGURATION BLOCK                           #
24###########################################################################
25
26# With these, give a tag name, and optionally a tag value
27# If you only want to match on name, not value, put in undef for the value
28
29# We will get all Nodes required by Segments (and Ways)
30# We can optionally also get other Nodes, based on their tags
31# This list is the tags that identify nodes to be deleted.
32my @node_sel_tags = (
33        ['place',undef], 
34        ['railway','station'],
35);
36
37# We will get all Segments required by Ways
38# However, we don't care about segment tags here, this line is ignored.
39my @seg_sel_tags = ();
40
41# Specify which ways to get, based on their tags
42# These tags are the one that identify ways to be deleted
43my @way_sel_tags = (
44        ['railway','rail'],
45#       ['landuse',undef],
46        ['highway','motorway'],
47        ['highway','motorway_link'],
48        ['highway','trunk'],
49        ['highway','trunk_link'],
50        ['highway','primary'],
51        ['highway','primary_link'],
52        ['highway','secondary'],
53        ['highway','tertiary'],
54        ['highway','unclassified'],
55        ['highway','residential'],
56        ['highway','service'],
57#       ['waterway','river'],
58#       ['natural','coastline'], # Gives really huge .osm files
59);
60
61###########################################################################
62#               END OF USER CONFIGURATION BLOCK                           #
63###########################################################################
64
65
66
67BEGIN {
68    my $dir = $0;
69    $dir =~s,[^/]+/[^/]+$,,;
70    unshift(@INC,"$dir/perl_lib");
71
72    unshift(@INC,"../../perl_lib");
73    unshift(@INC,"$ENV{HOME}/svn.openstreetmap.org/utils/perl_lib");
74}
75
76my %deleted;
77
78use Getopt::Long;
79
80use Geo::OSM::Planet;
81use Pod::Usage;
82
83# We need Bit::Vector, as perl hashes can't handle the sort of data we need
84use Bit::Vector;
85
86our $man=0;
87our $help=0;
88my $bbox_opts='';
89
90my $VERBOSE;
91
92Getopt::Long::Configure('no_ignore_case');
93GetOptions ( 
94             'verbose+'         => \$VERBOSE,
95             'v+'               => \$VERBOSE,
96             'MAN'              => \$man, 
97             'man'              => \$man, 
98             'h|help|x'         => \$help, 
99             ) or pod2usage(1);
100
101pod2usage(1) if $help;
102pod2usage(-verbose=>2) if $man;
103
104
105# Grab the filename
106my $xml = shift||'';
107pod2usage(1) unless $xml;
108
109# Check we can load the file
110if($xml eq "-") {
111        die("Sorry, reading from stdin is not supported, as we have to make several passes\n");
112}
113unless( -f $xml) {
114        die("Planet.osm file '$xml' could not be found\n");
115}
116
117unless( -s $xml ) {
118    die " $xml has 0 size\n";
119}
120
121
122# We assume IDs to be up to 50 million
123my $wanted_nodes = Bit::Vector->new( 50 * 1000 * 1000 );
124my $wanted_segs = Bit::Vector->new( 50 * 1000 * 1000 );
125my $found_segs = Bit::Vector->new( 50 * 1000 * 1000 );
126
127# Sub to open xml
128sub openXML {
129        open(XML, "<$xml") or die("$!");
130        #open(XML, "<:utf8","$xml") or die("$!");
131}
132# Sub to close xml
133sub closeXML {
134        close XML;
135}
136
137# Sub to build sub to do tag matching
138sub buildTagMatcher {
139        my @rules = @_;
140        return sub {
141                my @tagsToTest = @_;
142                foreach my $tagToTest (@tagsToTest) {
143                        my ($name,$value) = @$tagToTest;
144                        foreach my $r (@rules) {
145                                my ($rname,$rvalue) = @$r;
146                                if($rvalue) {
147                                        # Check the rule name+value with the supplied name+value
148                                        if($rname eq $name && $rvalue eq $value) { return 1; }
149                                } else {
150                                        # Check the rule name with the supplied name
151                                        if($rname eq $name) { return 1; }
152                                }
153                        }
154                }
155                # No match on any of the tags
156                return 0;
157        };
158}
159
160# To print out a series of tags as xml
161sub printTags {
162        my @tags = @_;
163        foreach my $tagSet (@tags) {
164                print "    <tag k=\"$tagSet->[0]\" v=\"$tagSet->[1]\" />\n";
165        }
166}
167
168
169# Sub to process the file, against a bunch of helper subroutines
170my $pass = 0;
171sub processXML {
172        my ($nodeH, $segH, $wayH) = @_;
173        openXML();
174        $pass++;
175
176        # Process the file, giving tags to the helpers that like them
177
178        # Hold the main line, tags and segs of the tag
179        my $main_line;
180        my $main_type;
181        my $wanted;
182        my @tags;
183        my @segs;
184
185        my $startNewTag = sub{
186                $wanted = 0;
187                @tags = ();
188                @segs = ();
189        };
190
191        while(my $line = <XML>) {
192                if($line =~ /^\s*<node/) {
193                        $main_line = $line;
194                        $main_type = "node";
195                        &$startNewTag();
196                        unless($line =~ /\/>\s*$/) { next; }
197                }
198                elsif($line =~ /^\s*<segment/) {
199                        $main_line = $line;
200                        $main_type = "segment";
201                        &$startNewTag();
202                        unless($line =~ /\/>\s*$/) { next; }
203                }
204                elsif($line =~ /^\s*\<way/) {
205                        $main_line = $line;
206                        $main_type = "way";
207                        &$startNewTag();
208                        unless($line =~ /\/>\s*$/) { next; }
209                }
210
211                if($line =~ /^\s*\<tag/) {
212                        my ($name,$value) = ($line =~ /^\s*\<tag k=[\'\"](.*?)[\'\"] v=[\'\"](.*?)[\'\"]/);
213                        unless($name) { 
214                                unless($line =~ /k="\s*" v="\s*"/) {
215                                        warn "Invalid line '$line'"; 
216                                }
217                                next; 
218                        }
219                        my @tag = ($name,$value);
220                        push @tags, \@tag;
221                }
222                elsif($line =~ /^\s*\<seg /) {
223                        my ($id) = ($line =~ /^\s*\<seg id=[\'\"](\d+)[\'\"]/);
224                        unless($main_type eq "way") { warn "Got seg when in $main_type\n"; next; }
225                        unless($id) { warn "Invalid line '$line'"; next; }
226                        push @segs, $id;
227                }
228
229                # Do the decisions when closing tags - can be self closing
230                elsif($line =~ /^\s*<\/?node/) {
231                        my ($id,$lat,$long) = ($main_line =~ /^\s*<node id=['"](\d+)['"] lat=['"]?(\-?[\d\.]+)['"]? lon=['"]?(\-?[\d\.]+e?\-?\d*)['"]?/);
232
233                        unless($id) { warn "Invalid node line '$main_line'"; next; }
234                        unless($main_type eq "node") { warn "$main_type ended with $line"; next; }
235                        if($nodeH) {
236                                &$nodeH($id,$lat,$long,\@tags,$main_line,$line);
237                        }
238                }
239                elsif($line =~ /^\s*<\/?segment/) {
240                        my ($id,$from,$to) = ($main_line =~ /^\s*<segment id=['"](\d+)['"] from=['"](\d+)['"] to=['"](\d+)['"]/);
241
242                        unless($id) { warn "Invalid segment line '$main_line'"; next; }
243                        unless($main_type eq "segment") { warn "$main_type ended with $line"; next; }
244                        if($segH) {
245                                &$segH($id,$from,$to,\@tags,$main_line,$line);
246                        }
247                }
248                elsif($line =~ /^\s*\<\/?way/) {
249                        my ($id) = ($main_line =~ /^\s*\<way id=[\'\"](\d+)[\'\"]/);
250
251                        unless($id) { warn "Invalid way line '$main_line'"; next; }
252                        unless($main_type eq "way") { warn "$main_type ended with $line"; next; }
253                        if($wayH) {
254                                &$wayH($id,\@tags,\@segs,$main_line,$line);
255                        }
256                }
257                elsif($line =~ /^\s*\<\?xml/) {
258                        if($pass == 1) {
259                                print $line;
260                        }
261                }
262                elsif($line =~ /^\s*\<osm /) {
263                        if($pass == 1) {
264                                print $line;
265                        }
266                }
267                elsif($line =~ /^\s*\<\/osm\>/ ) {
268                        if($pass == 3) {
269                                print $line;
270                        }
271                }
272                else {
273                        print STDERR "Unknown line $line\n";
274                };
275        }
276
277        # All done
278        closeXML();
279}
280
281
282# First up, call for ways
283my $wayTagHelper = &buildTagMatcher(@way_sel_tags);
284processXML(undef,sub {
285        # Track segments used, so we can identify incomplete ways later
286        my ($id,$from,$to,$tagsRef,$main_line,$line) = @_;
287        $found_segs->Bit_On($id);
288  }, sub {
289        my ($id,$tagsRef,$segsRef,$main_line,$line) = @_;
290
291        # Test the tags, to see if we want this
292        if(&$wayTagHelper(@$tagsRef)) {
293                if( $id == 17901712 ) { print STDERR "Huh???!" }
294                # Bingo, matched
295                # Record the segments we want to get (also track completeness of way)
296                my $complete = 1;
297                foreach my $seg (@$segsRef) {
298                        if( not $found_segs->contains($seg) )
299                        { $complete = 0; last }
300                }
301
302                # Output
303                if( $complete )
304                {
305                        print qq(<way id="$id" action="delete" >\n);
306                        &printTags(@$tagsRef);
307                        print qq(</way>\n);
308                        $deleted{ways}++;
309                }
310                else
311                {
312                        my $a = $main_line;
313                        $a =~ s/way /way action="modify" /;
314                        print $a;
315                        foreach my $seg (@$segsRef) {
316                                if( not $found_segs->contains($seg) ) {
317                                        print "    <seg id=\"$seg\" />\n";
318                                }
319                        }
320                        &printTags(@$tagsRef);
321                        print $line;
322                }
323        } else {
324                # Want to keep this way, so mark segments used
325                foreach my $seg (@$segsRef) {
326                        $wanted_segs->Bit_On($seg);
327                }
328        }
329});
330
331# Now for segments
332my $segTagHelper = &buildTagMatcher(@seg_sel_tags);
333processXML(undef, sub {
334        my ($id,$from,$to,$tagsRef,$main_line,$line) = @_;
335        my $wanted = 0;
336
337        # Does a way want it?
338        if($wanted_segs->contains($id)) {
339                # A way wants it
340                $wanted = 1;
341        }
342
343        if(not $wanted) {
344                print qq(<segment id="$id" from="$from" to="$to" action="delete" >\n);
345                &printTags(@$tagsRef);
346                print qq(</segment>\n);
347                $deleted{segs}++;
348        } else {
349                # Record the nodes we want to keep
350                $wanted_nodes->Bit_On($from);
351                $wanted_nodes->Bit_On($to);
352        }
353}, undef);
354
355# Now for nodes
356my $nodeTagHelper = &buildTagMatcher(@node_sel_tags);
357processXML(sub {
358        my ($id,$lat,$long,$tagsRef,$main_line,$line) = @_;
359        my $wanted = 0;
360
361        return if($wanted_nodes->contains($id));
362
363        # Test the tags, to see if we don't want this
364        # This could presumably fail if the node is actually in use, but you can't win 'em all...
365        if(&$nodeTagHelper(@$tagsRef)) {
366                # Bingo, matched
367                print qq(<node id="$id" lat="$lat" lon="$long" action="delete"> -- not wanted\n);
368                &printTags(@$tagsRef);
369                print qq(</node>\n);
370                        $deleted{nodes}++;
371                return;
372        }
373
374        # Delete also not useful nodes, they just clutter the place up...
375        my $useful = 0;
376        foreach my $tag (@$tagsRef)
377        {
378          next if $tag->[0] =~ /^(created_by|source)$/;
379          $useful = 1;
380          last;
381        }
382        if(not $useful) {
383                        print qq(<node id="$id" lat="$lat" lon="$long" action="delete"> -- not useful\n);
384                        &printTags(@$tagsRef);
385                        print qq(</node>\n);
386                        $deleted{nodes}++;
387        }
388}, undef, undef);
389
390print STDERR "Deleted: nodes:$deleted{nodes}, segs:$deleted{segs}, ways:$deleted{ways}\n";
391
392# All done
393
394##################################################################
395# Usage/manual
396
397__END__
398
399=head1 NAME
400
401B<planetosm-deleteby-tags.pl>
402
403=head1 DESCRIPTION
404
405=head1 SYNOPSIS
406
407B<Common usages:>
408
409B<planetosm-deleteby-tags.pl> <planet.osm.xml> > output.osm
410
411parse a given planet.osm and output an OSM file that will delete any object
412with the given tags, as well as thus orphaned segments and ways.
413
414Note: As a sideeffect it will also delete any unwayed segments and nodes
415that don't have any useful tags.
416
417=head1 AUTHOR
418
419Martijn van Oosterhout
420
421based on script by Nick Burch
422
423=head1 COPYRIGHT
424
425GPL
426
427=head1 SEE ALSO
428
429http://www.openstreetmap.org/
430
431=cut
Note: See TracBrowser for help on using the repository browser.