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

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

Add the --output optio, to switch between JOSM change output and planetdiff
output.

  • 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.
31my @node_sel_tags = (
32        ['place',undef], 
33        ['railway','station'],
34);
35
36# We will get all Segments required by Ways
37# However, we don't care about segment tags here, this line is ignored.
38my @seg_sel_tags = ();
39
40# Specify which ways to get, based on their tags
41# These tags are the one that identify ways to be deleted
42my @way_sel_tags = (
43        ['railway','rail'],
44#       ['landuse',undef],
45        ['highway','motorway'],
46        ['highway','motorway_link'],
47        ['highway','trunk'],
48        ['highway','trunk_link'],
49        ['highway','primary'],
50        ['highway','primary_link'],
51        ['highway','secondary'],
52        ['highway','tertiary'],
53        ['highway','unclassified'],
54        ['highway','residential'],
55        ['highway','service'],
56#       ['waterway','river'],
57#       ['natural','coastline'], # Gives really huge .osm files
58);
59
60###########################################################################
61#               END OF USER CONFIGURATION BLOCK                           #
62###########################################################################
63
64
65
66BEGIN {
67    my $dir = $0;
68    $dir =~s,[^/]+/[^/]+$,,;
69    unshift(@INC,"$dir/perl_lib");
70
71    unshift(@INC,"../../perl_lib");
72    unshift(@INC,"$ENV{HOME}/svn.openstreetmap.org/utils/perl_lib");
73}
74
75my %deleted;
76
77use Getopt::Long;
78
79use Geo::OSM::Planet;
80use Pod::Usage;
81
82# We need Bit::Vector, as perl hashes can't handle the sort of data we need
83use Bit::Vector;
84
85our $man=0;
86our $help=0;
87our $output = "josm";
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             'o|output=s'         => \$output,
100             ) or pod2usage(1);
101
102pod2usage(1) if $help;
103pod2usage(-verbose=>2) if $man;
104
105if( $output !~ /^(josm|diff)$/ )
106{
107    die "Output must be either --output=josm or --output=diff\n";
108}
109
110# Grab the filename
111my $xml = shift||'';
112pod2usage(1) unless $xml;
113
114# Check we can load the file
115if($xml eq "-") {
116        die("Sorry, reading from stdin is not supported, as we have to make several passes\n");
117}
118unless( -f $xml) {
119        die("Planet.osm file '$xml' could not be found\n");
120}
121
122unless( -s $xml ) {
123    die " $xml has 0 size\n";
124}
125
126
127# We assume IDs to be up to 50 million
128my $wanted_nodes = Bit::Vector->new( 50 * 1000 * 1000 );
129my $wanted_segs = Bit::Vector->new( 50 * 1000 * 1000 );
130my $found_segs = Bit::Vector->new( 50 * 1000 * 1000 );
131
132# Sub to open xml
133sub openXML {
134        open(XML, "<$xml") or die("$!");
135        #open(XML, "<:utf8","$xml") or die("$!");
136}
137# Sub to close xml
138sub closeXML {
139        close XML;
140}
141
142# Sub to build sub to do tag matching
143sub buildTagMatcher {
144        my @rules = @_;
145        return sub {
146                my @tagsToTest = @_;
147                foreach my $tagToTest (@tagsToTest) {
148                        my ($name,$value) = @$tagToTest;
149                        foreach my $r (@rules) {
150                                my ($rname,$rvalue) = @$r;
151                                if($rvalue) {
152                                        # Check the rule name+value with the supplied name+value
153                                        if($rname eq $name && $rvalue eq $value) { return 1; }
154                                } else {
155                                        # Check the rule name with the supplied name
156                                        if($rname eq $name) { return 1; }
157                                }
158                        }
159                }
160                # No match on any of the tags
161                return 0;
162        };
163}
164
165# To print out a series of tags as xml
166sub printTags {
167        my @tags = @_;
168        foreach my $tagSet (@tags) {
169                print "    <tag k=\"$tagSet->[0]\" v=\"$tagSet->[1]\" />\n";
170        }
171}
172
173
174# Sub to process the file, against a bunch of helper subroutines
175my $pass = 0;
176sub processXML {
177        my ($nodeH, $segH, $wayH) = @_;
178        openXML();
179        $pass++;
180
181        # Process the file, giving tags to the helpers that like them
182
183        # Hold the main line, tags and segs of the tag
184        my $main_line;
185        my $main_type;
186        my $wanted;
187        my @tags;
188        my @segs;
189
190        my $startNewTag = sub{
191                $wanted = 0;
192                @tags = ();
193                @segs = ();
194        };
195
196        while(my $line = <XML>) {
197                if($line =~ /^\s*<node/) {
198                        $main_line = $line;
199                        $main_type = "node";
200                        &$startNewTag();
201                        unless($line =~ /\/>\s*$/) { next; }
202                }
203                elsif($line =~ /^\s*<segment/) {
204                        $main_line = $line;
205                        $main_type = "segment";
206                        &$startNewTag();
207                        unless($line =~ /\/>\s*$/) { next; }
208                }
209                elsif($line =~ /^\s*\<way/) {
210                        $main_line = $line;
211                        $main_type = "way";
212                        &$startNewTag();
213                        unless($line =~ /\/>\s*$/) { next; }
214                }
215
216                if($line =~ /^\s*\<tag/) {
217                        my ($name,$value) = ($line =~ /^\s*\<tag k=[\'\"](.*?)[\'\"] v=[\'\"](.*?)[\'\"]/);
218                        unless($name) { 
219                                unless($line =~ /k="\s*" v="\s*"/) {
220                                        warn "Invalid line '$line'"; 
221                                }
222                                next; 
223                        }
224                        my @tag = ($name,$value);
225                        push @tags, \@tag;
226                }
227                elsif($line =~ /^\s*\<seg /) {
228                        my ($id) = ($line =~ /^\s*\<seg id=[\'\"](\d+)[\'\"]/);
229                        unless($main_type eq "way") { warn "Got seg when in $main_type\n"; next; }
230                        unless($id) { warn "Invalid line '$line'"; next; }
231                        push @segs, $id;
232                }
233
234                # Do the decisions when closing tags - can be self closing
235                elsif($line =~ /^\s*<\/?node/) {
236                        my ($id,$lat,$long) = ($main_line =~ /^\s*<node id=['"](\d+)['"] lat=['"]?(\-?[\d\.]+)['"]? lon=['"]?(\-?[\d\.]+e?\-?\d*)['"]?/);
237
238                        unless($id) { warn "Invalid node line '$main_line'"; next; }
239                        unless($main_type eq "node") { warn "$main_type ended with $line"; next; }
240                        if($nodeH) {
241                                &$nodeH($id,$lat,$long,\@tags,$main_line,$line);
242                        }
243                }
244                elsif($line =~ /^\s*<\/?segment/) {
245                        my ($id,$from,$to) = ($main_line =~ /^\s*<segment id=['"](\d+)['"] from=['"](\d+)['"] to=['"](\d+)['"]/);
246
247                        unless($id) { warn "Invalid segment line '$main_line'"; next; }
248                        unless($main_type eq "segment") { warn "$main_type ended with $line"; next; }
249                        if($segH) {
250                                &$segH($id,$from,$to,\@tags,$main_line,$line);
251                        }
252                }
253                elsif($line =~ /^\s*\<\/?way/) {
254                        my ($id) = ($main_line =~ /^\s*\<way id=[\'\"](\d+)[\'\"]/);
255
256                        unless($id) { warn "Invalid way line '$main_line'"; next; }
257                        unless($main_type eq "way") { warn "$main_type ended with $line"; next; }
258                        if($wayH) {
259                                &$wayH($id,\@tags,\@segs,$main_line,$line);
260                        }
261                }
262                elsif($line =~ /^\s*\<\?xml/) {
263                        if($pass == 1) {
264                                print $line;
265                        }
266                }
267                elsif($line =~ /^\s*\<osm /) {
268                        if($pass == 1) {
269                          if( $output eq "josm" )
270                          {
271                              print $line;
272                          }
273                          else
274                          {
275                              print qq(<planetdiff version="0.1" generator="OpenStreetMap planetdiff">\n);
276                          }
277                        }
278                }
279                elsif($line =~ /^\s*\<\/osm\>/ ) {
280                        if($pass == 3) {
281                          if( $output eq "josm" )
282                          {
283                              print $line;
284                          }
285                          else
286                          {
287                              print qq(</planetdiff>\n);
288                          }
289                        }
290                }
291                else {
292                        print STDERR "Unknown line $line\n";
293                };
294        }
295
296        # All done
297        closeXML();
298}
299
300
301# First up, call for ways
302my $wayTagHelper = &buildTagMatcher(@way_sel_tags);
303processXML(undef,sub {
304        # Track segments used, so we can identify incomplete ways later
305        my ($id,$from,$to,$tagsRef,$main_line,$line) = @_;
306        $found_segs->Bit_On($id);
307  }, sub {
308        my ($id,$tagsRef,$segsRef,$main_line,$line) = @_;
309
310        # Test the tags, to see if we want this
311        if(&$wayTagHelper(@$tagsRef)) {
312                # Bingo, matched
313                # Record the segments we want to get (also track completeness of way)
314                my $complete = 1;
315                foreach my $seg (@$segsRef) {
316                        if( not $found_segs->contains($seg) )
317                        { $complete = 0; last }
318                }
319
320                # Output
321                if( $output eq "josm" )
322                {
323                    if( $complete )
324                    {
325                            print qq(<way id="$id" action="delete" >\n);
326                            &printTags(@$tagsRef);
327                            print qq(</way>\n);
328                            $deleted{ways}++;
329                    }
330                    else
331                    {
332                            my $a = $main_line;
333                            $a =~ s/way /way action="modify" /;
334                            print $a;
335                            foreach my $seg (@$segsRef) {
336                                    if( not $found_segs->contains($seg) ) {
337                                            print "    <seg id=\"$seg\" />\n";
338                                    }
339                            }
340                            &printTags(@$tagsRef);
341                            print $line;
342                    }
343                }
344                else  # output = diff
345                {
346                    print qq(<delete>\n);
347                    print $main_line;
348                    foreach my $seg (@$segsRef) {
349                        print qq(    <seg id="$seg" />\n);
350                    }
351                    &printTags(@$tagsRef);
352                    print $line, qq(</delete>\n);
353                    if( not $complete )
354                    {
355                        print qq(<add>\n);
356                        print $main_line;
357                        foreach my $seg (@$segsRef) {
358                            if( not $found_segs->contains($seg) ) {
359                                    print qq(    <seg id="$seg" />\n);
360                            }
361                        }
362                        &printTags(@$tagsRef);
363                        print $line, qq(</add>\n);
364                    }
365                    else
366                    {
367                        $deleted{ways}++;
368                    }
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>\n), $main_line;
398                }
399                &printTags(@$tagsRef);
400                if( $line ne $main_line )
401                {
402                    print $line;
403                }
404                if( $output eq "diff" )
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>\n), $main_line;
435                }
436                &printTags(@$tagsRef);
437                if( $line ne $main_line )
438                {
439                    print $line;
440                }
441                if( $output eq "diff" )
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)$/;
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>\n), $main_line;
463                }
464                &printTags(@$tagsRef);
465                if( $line ne $main_line )
466                {
467                    print $line;
468                }
469                if( $output eq "diff" )
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.