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

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

delete

File size: 3.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
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) = @_;
34    my $recurse = 0;
35
36    my $xml = determine_delete_action($what, $id, $changeset, $recurse, 0);
37    return undef unless defined ($xml);
38
39    my $resp = OsmApi::post("changeset/$changeset/upload", "<osmChange version='0.6'>\n<delete>\n$xml</delete></osmChange>");
40    if (!$resp->is_success)
41    {
42        print STDERR "$what $id cannot be deleted: ".$resp->status_line."\n";
43        return undef;
44    }
45    return 1;
46}
47
48# the delete workhorse; finds out which XML to upload to the API to
49# delete an object.
50#
51# Parameters:
52# see sub delete.
53#
54# Returns:
55# undef on error, else the new XML to send to the API.
56# The XML has to
57# be wrapped in <osm>...</osm> or inside a <modify>...</modify>
58# in a changeset upload.
59
60sub determine_delete_action
61{
62    my ($what, $id, $changeset, $recursive, $indent) = @_;
63
64    my $copy=0;
65    my $out = "";
66    my $members = [];
67    my $version;
68    my $user;
69
70    my $resp = OsmApi::get("$what/$id");
71    if (!$resp->is_success)
72    {
73        print STDERR " "x$indent;
74        print STDERR "$what $id cannot be retrieved: ".$resp->status_line."\n";
75        return undef;
76    }
77
78    foreach (split(/\n/, $resp->content()))
79    { 
80        if (/<$what/) 
81        { 
82            /\sid="([^"]+)"/ or die; 
83            die unless $id eq $1; 
84            /\sversion="([^"]+)"/ or die; 
85            $version = $1;
86            /user="([^"]+)/;
87            $user=$1;
88            $copy = 1;
89            $out = $_;
90            $out =~ s/">/"\/>/g;
91            $members = [];
92        } 
93        elsif ($copy) 
94        { 
95            $copy=0 if (/<\/$what/);
96            if (/<nd ref=.(\d+)/)
97            {
98                push(@$members, { type => "node", id => $1 });
99            }
100            elsif (/<member.*type=.(way|node|relation).*id=.(\d+)/)
101            {
102                push(@$members, { type => $1, id => $2 });
103            }
104        } 
105    }; 
106
107    print STDERR " "x$indent;
108    print STDERR "$what $id last modified by $user (version $version) - deleting\n",
109    $out =~ s/changeset="\d+"/changeset="$changeset"/;
110        if ($recursive && scalar(@$members))
111        {
112            print STDERR " "x$indent;
113            print STDERR "recursively deleting members of $what $id\n";
114            foreach (@$members)
115            {
116                if (!defined($globalListOfDeletedStuff->{$_->{type}.$_->{id}}))
117                {
118                    my $ua = determine_delete_action($_->{type}, $_->{id}, $changeset, 1, $indent + 2);
119                    $out = $ua . $out if defined($ua);
120                    $globalListOfDeletedStuff->{$_->{type}.$_->{id}} = 1;
121                }
122            }
123        }
124        return $out;
125}
126
1271;
Note: See TracBrowser for help on using the repository browser.