source: subversion/applications/utils/revert/Delete.pm @ 30254

Last change on this file since 30254 was 30254, checked in by frederik, 6 years ago

support auto-removing references or referring objects

File size: 6.1 KB
Line 
1#!/usr/bin/perl
2
3# Delete.pm
4# ---------
5#
6# Deletes an object.
7#
8# Part of the "osmtools" suite of programs
9# Originally written by Frederik Ramm <frederik@remote.org>; public domain
10#
11
12
13package Delete;
14
15use strict;
16use warnings;
17
18use OsmApi;
19
20our $globalListOfDeletedStuff = {};
21
22# deletes one object
23#
24# parameters:
25#   $what: 'node', 'way', or 'relation'
26#   $id: object id
27#   $changeset: id of changeset to use for delete operation
28# return:
29#   success=1 failure=undef
30
31sub delete
32{
33    my ($what, $id, $changeset) = @_;
34    # this will try to remove not only the object but all its members
35    # e.g. remove a way plus nodes
36    my $recurse = 0;
37    # this will try to modify any object that contains the object-to-be-deleted
38    # by removing the object-to-be-deleted from it
39    my $remove_references = 0;
40    # this will delete all objects referencing the object-to-be-deleted.
41    my $cascade = 0;
42
43    my $xml = determine_delete_action($what, $id, $changeset, $recurse, 0);
44    return undef unless defined ($xml);
45
46    my $modify = "";
47    my $delete_cascade = "";
48    my $loop = 1;
49    while ($loop)
50    {
51        $loop = 0;
52        my $osc = <<EOF;
53<osmChange version='0.6'>
54<modify>
55$modify
56</modify>
57<delete>
58$delete_cascade
59</delete>
60<delete>
61$xml
62</delete>
63</osmChange>
64EOF
65        my $resp = OsmApi::post("changeset/$changeset/upload", $osc);
66        if (!$resp->is_success)
67        {
68            my $c = $resp->content();
69            print "$c\n";
70            if ($c =~ /(\S+) (\d+) (is )?still used by (\S+) ([0-9,]+)/ || $c =~ /The (\S+) (\d+) (is )?used in (\S+) ([0-9,]+)/)
71            {
72                if ($remove_references)
73                {
74                    my ($what2, $id2, $referer, $referer_ids) = (lc($1),$2,$4,$5);
75                    print STDERR "$what2 $id2 still used by $referer $referer_ids; removing it from there\n";
76                    $referer = $1 if ($referer =~ /(.*)s$/);
77                    foreach my $referer_id(split(/,/, $referer_ids))
78                    {
79                        my $obj = OsmApi::get("$referer/$referer_id");
80                        foreach (split(/\n/, $obj->content()))
81                        { 
82                            next if (/<\?xml/);
83                            next if (/<osm/);
84                            next if (/<\/osm/);
85                            next if (/<nd ref="$id2"/) && ($what2 eq "node");
86                            next if (/<member type="$what2" ref="$id2"/);
87                            s/changeset="\d+"/changeset="$changeset"/;
88                            $modify .= $_;
89                        }
90                    }
91                    $loop=1;
92                    print "--$modify--\n";
93                }
94                elsif ($cascade)
95                {
96                    my ($what2, $id2, $referer, $referer_ids) = (lc($1),$2,$4,$5);
97                    print STDERR "$what2 $id2 still used by $referer $referer_ids; removing those\n";
98                    $referer = $1 if ($referer =~ /(.*)s$/);
99                    foreach my $referer_id(split(/,/, $referer_ids))
100                    {
101                        my $obj = OsmApi::get("$referer/$referer_id");
102                        my $del;
103                        foreach (split(/\n/, $obj->content()))
104                        { 
105                            next if (/<\?xml/);
106                            next if (/<osm/);
107                            next if (/<\/osm/);
108                            next if (/<nd/);
109                            next if (/<tag/);
110                            next if (/<member/);
111                            s/changeset="\d+"/changeset="$changeset"/;
112                            $del .= $_;
113                        }
114                        $delete_cascade = $del.$delete_cascade;
115                    }
116                    $loop=1;
117                }
118            }
119            else
120            {
121                print STDERR "$what $id cannot be deleted: ".$resp->status_line."\n";
122                return undef;
123            }
124        }
125    }
126    return 1;
127}
128
129# the delete workhorse; finds out which XML to upload to the API to
130# delete an object.
131#
132# Parameters:
133# see sub delete.
134#
135# Returns:
136# undef on error, else the new XML to send to the API.
137# The XML has to
138# be wrapped in <osm>...</osm> or inside a <modify>...</modify>
139# in a changeset upload.
140
141sub determine_delete_action
142{
143    my ($what, $id, $changeset, $recursive, $indent) = @_;
144
145    my $copy=0;
146    my $out = "";
147    my $members = [];
148    my $version;
149    my $user;
150
151    my $resp = OsmApi::get("$what/$id");
152    if (!$resp->is_success)
153    {
154        print STDERR " "x$indent;
155        print STDERR "$what $id cannot be retrieved: ".$resp->status_line."\n";
156        return undef;
157    }
158
159    my $c = $resp->content();
160
161    foreach (split(/\n/, $resp->content()))
162    { 
163        if (/<$what/) 
164        { 
165            /\sid="([^"]+)"/ or die; 
166            die unless $id eq $1; 
167            /\sversion="([^"]+)"/ or die; 
168            $version = $1;
169            /user="([^"]+)/;
170            $user=$1;
171            $copy = 1;
172            $out = $_;
173            $out =~ s/">/"\/>/g;
174            $members = [];
175        } 
176        elsif ($copy) 
177        { 
178            $copy=0 if (/<\/$what/);
179            if (/<nd ref=.(\d+)/)
180            {
181                push(@$members, { type => "node", id => $1 });
182            }
183            elsif (/<member.*type=.(way|node|relation).*id=.(\d+)/)
184            {
185                push(@$members, { type => $1, id => $2 });
186            }
187        } 
188    }; 
189
190    print STDERR " "x$indent;
191    print STDERR "$what $id last modified by $user (version $version) - deleting\n",
192    $out =~ s/changeset="\d+"/changeset="$changeset"/;
193    if ($recursive && scalar(@$members))
194    {
195        print STDERR " "x$indent;
196        print STDERR "recursively deleting members of $what $id\n";
197        foreach (@$members)
198        {
199            if (!defined($globalListOfDeletedStuff->{$_->{type}.$_->{id}}))
200            {
201                my $ua = determine_delete_action($_->{type}, $_->{id}, $changeset, 1, $indent + 2);
202                $out = $out . $ua if defined($ua);
203                $globalListOfDeletedStuff->{$_->{type}.$_->{id}} = 1;
204            }
205        }
206    }
207    return $out;
208}
209
2101;
Note: See TracBrowser for help on using the repository browser.