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

Last change on this file since 29411 was 17936, checked in by frederik, 10 years ago

add capability to remove an object that is to be deleted from a referring object (i.e. you delete a node and it is automatically removed from a way or relation that uses this node, instead of the delete failing with "precondition failed")

File size: 4.4 KB
RevLine 
[16875]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
11package Delete;
12
13use strict;
14use warnings;
15
16use OsmApi;
17
18our $globalListOfDeletedStuff = {};
19
20# deletes one object
21#
22# fails if the object is not deleted
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) = @_;
[17936]34    # this will try to remove not only the object but all its members
35    # e.g. remove a way plus nodes
[16875]36    my $recurse = 0;
[17936]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;
[16875]40
41    my $xml = determine_delete_action($what, $id, $changeset, $recurse, 0);
42    return undef unless defined ($xml);
43
[17936]44    my $modify = "";
45    my $loop = 1;
46    while ($loop)
[16875]47    {
[17936]48        $loop = 0;
49        my $osc = <<EOF;
50<osmChange version='0.6'>
51<modify>
52$modify
53</modify>
54<delete>
55$xml
56</delete>
57</osmChange>
58EOF
59        my $resp = OsmApi::post("changeset/$changeset/upload", "<osmChange version='0.6'>\n<modify>\n$modify\n</modify>\n<delete>\n$xml</delete></osmChange>");
60        if (!$resp->is_success)
61        {
62            my $c = $resp->content();
63            if ($remove_references && ($c =~ /still used by (\S+) (\d+)/))
64            {
65                print STDERR "$what $id still used by $1 $2; removing it from there\n";
66                my $obj = OsmApi::get("$1/$2");
67                foreach (split(/\n/, $obj->content()))
68                { 
69                    next if (/<\?xml/);
70                    next if (/<osm/);
71                    next if (/<\/osm/);
72                    next if (/<nd ref="$id"/) && ($what eq "node");
73                    next if (/<member type="$what" ref="$id"/);
74                    s/changeset="\d+"/changeset="$changeset"/;
75                    $modify .= $_;
76                }
77                $loop=1;
78            }
79            else
80            {
81                print STDERR "$what $id cannot be deleted: ".$resp->status_line."\n";
82                return undef;
83            }
84        }
[16875]85    }
86    return 1;
87}
88
89# the delete workhorse; finds out which XML to upload to the API to
90# delete an object.
91#
92# Parameters:
93# see sub delete.
94#
95# Returns:
96# undef on error, else the new XML to send to the API.
97# The XML has to
98# be wrapped in <osm>...</osm> or inside a <modify>...</modify>
99# in a changeset upload.
100
101sub determine_delete_action
102{
103    my ($what, $id, $changeset, $recursive, $indent) = @_;
104
105    my $copy=0;
106    my $out = "";
107    my $members = [];
108    my $version;
109    my $user;
110
111    my $resp = OsmApi::get("$what/$id");
112    if (!$resp->is_success)
113    {
114        print STDERR " "x$indent;
115        print STDERR "$what $id cannot be retrieved: ".$resp->status_line."\n";
116        return undef;
117    }
118
119    foreach (split(/\n/, $resp->content()))
120    { 
121        if (/<$what/) 
122        { 
123            /\sid="([^"]+)"/ or die; 
124            die unless $id eq $1; 
125            /\sversion="([^"]+)"/ or die; 
126            $version = $1;
127            /user="([^"]+)/;
128            $user=$1;
129            $copy = 1;
130            $out = $_;
[17936]131            $out =~ s/">/"\/>/g;
[16875]132            $members = [];
133        } 
134        elsif ($copy) 
135        { 
136            $copy=0 if (/<\/$what/);
137            if (/<nd ref=.(\d+)/)
138            {
139                push(@$members, { type => "node", id => $1 });
140            }
141            elsif (/<member.*type=.(way|node|relation).*id=.(\d+)/)
142            {
143                push(@$members, { type => $1, id => $2 });
144            }
145        } 
146    }; 
147
148    print STDERR " "x$indent;
149    print STDERR "$what $id last modified by $user (version $version) - deleting\n",
150    $out =~ s/changeset="\d+"/changeset="$changeset"/;
[17936]151    if ($recursive && scalar(@$members))
152    {
153        print STDERR " "x$indent;
154        print STDERR "recursively deleting members of $what $id\n";
155        foreach (@$members)
[16875]156        {
[17936]157            if (!defined($globalListOfDeletedStuff->{$_->{type}.$_->{id}}))
[16875]158            {
[17936]159                my $ua = determine_delete_action($_->{type}, $_->{id}, $changeset, 1, $indent + 2);
160                $out = $ua . $out if defined($ua);
161                $globalListOfDeletedStuff->{$_->{type}.$_->{id}} = 1;
[16875]162            }
163        }
[17936]164    }
165    return $out;
[16875]166}
167
1681;
Note: See TracBrowser for help on using the repository browser.