source: subversion/applications/utils/revert/OsmApi.pm @ 14945

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

first version of perl tools for undo/revert

  • Property svn:keywords set to Revision
File size: 2.8 KB
Line 
1#!/usr/bin/perl
2
3# OsmApi.pm
4# ---------
5#
6# Implements OSM API connectivity
7#
8# Part of the "osmtools" suite of programs
9# Originally written by Frederik Ramm <frederik@remote.org>; public domain
10
11package OsmApi;
12
13use strict;
14use warnings;
15use LWP::UserAgent;
16
17our $prefs;
18our $ua;
19our $dummy;
20
21BEGIN
22{
23
24    $prefs = { "dryrun" => 1 };
25
26    open (PREFS, $ENV{HOME}."/.osmtoolsrc") or die "cannot open ". $ENV{HOME}."/.osmtoolsrc";
27    while(<PREFS>)
28    {
29        if (/^(\S+)\s*=\s*(\S*)/)
30        {
31            $prefs->{$1} = $2;
32        }
33    }
34    close (PREFS);
35
36    foreach my $required("username","password","apiurl")
37    {
38        die $ENV{HOME}."/.osmtoolsrc does not have $required" unless defined($prefs->{$required});
39    }
40
41    if (!defined($prefs->{instance}))
42    {
43        $prefs->{instance} = sprintf "%010x", $$ * rand(100000000);
44        open(PREFS, ">>".$ENV{HOME}."/.osmtoolsrc");
45        printf PREFS "instance=".$prefs->{instance};
46        close(PREFS);
47    }
48
49    $prefs->{apiurl} =~ m!https?://([^/]+)/!;
50    my $host = $1;
51    $host .= ":80" unless ($host =~ /:/);
52    $ua = LWP::UserAgent->new;
53    $ua->credentials($host, "Web Password", $prefs->{username}, $prefs->{password});
54    my $revision = '$Revision:$';
55    my $revno = 0;
56    $revno = $1 if ($revision =~ /:\s*(\d+)/);
57    $ua->agent("osmtools/$revno ($^O, ".$prefs->{instance}.")");
58    $ua->timeout(600);
59
60    $prefs->{debug} = $prefs->{dryrun} unless (defined($prefs->{debug}));
61
62    $dummy = HTTP::Response->new(200);
63}
64
65sub get
66{
67    my $url = shift;
68    my $req = HTTP::Request->new(GET => $prefs->{apiurl}.$url);
69    my $resp = $ua->request($req);
70    debuglog($req, $resp) if ($prefs->{"debug"});
71    return($resp);
72}
73
74sub put
75{
76    my $url = shift;
77    my $body = shift;
78    return $dummy if ($prefs->{dryrun});
79    my $req = HTTP::Request->new(PUT => $prefs->{apiurl}.$url);
80    $req->content($body) if defined($body);
81    my $resp = $ua->request($req);
82    debuglog($req, $resp) if ($prefs->{"debug"});
83    return $resp;
84}
85
86sub post
87{
88    my $url = shift;
89    my $body = shift;
90    return $dummy if ($prefs->{dryrun});
91    my $req = HTTP::Request->new(POST => $prefs->{apiurl}.$url);
92    $req->content($body) if defined($body);
93    my $resp = $ua->request($req);
94    debuglog($req, $resp) if ($prefs->{"debug"});
95    return $resp;
96}
97
98sub delete
99{
100    my $url = shift;
101    my $body = shift;
102    return $dummy if ($prefs->{dryrun});
103    my $req = HTTP::Request->new(DELETE => $prefs->{apiurl}.$url);
104    my $resp = $ua->request($req);
105    debuglog($req, $resp) if ($prefs->{"debug"});
106    return $resp;
107}
108
109sub debuglog
110{
111    my ($request, $response) = @_;
112    printf STDERR "%s %s... %s %s (%db)\n",
113        $request->method(), 
114        $request->uri(), 
115        $response->code(), 
116        $response->message(), 
117        length($response->content());
118}
119
1201;
Note: See TracBrowser for help on using the repository browser.