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

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

Add a few lines to kill useless nodes that have been tagged incorrectly.

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