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

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

Some highway types do apply to nodes, so don't just blindly delete them all

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