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

Last change on this file since 27365 was 27365, checked in by frederik, 8 years ago

add content-type header for POST/PUT/DELETE to work around rails assumption that content will be url encoded if there's no content-type

  • Property svn:keywords set to Revision
File size: 3.2 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: 27365 $';
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 dummylog("PUT", $url, $body) if ($prefs->{dryrun});
79    my $req = HTTP::Request->new(PUT => $prefs->{apiurl}.$url);
80    $req->header("Content-type" => "text/xml");
81    $req->content($body) if defined($body);
82    my $resp = $ua->request($req);
83    debuglog($req, $resp) if ($prefs->{"debug"});
84    return $resp;
85}
86
87sub post
88{
89    my $url = shift;
90    my $body = shift;
91    return dummylog("POST", $url, $body) if ($prefs->{dryrun});
92    my $req = HTTP::Request->new(POST => $prefs->{apiurl}.$url);
93    $req->content($body) if defined($body);
94    $req->header("Content-type" => "text/xml");
95    my $resp = $ua->request($req);
96    debuglog($req, $resp) if ($prefs->{"debug"});
97    return $resp;
98}
99
100sub delete
101{
102    my $url = shift;
103    my $body = shift;
104    return dummylog("DELETE", $url, $body) if ($prefs->{dryrun});
105    my $req = HTTP::Request->new(DELETE => $prefs->{apiurl}.$url);
106    $req->header("Content-type" => "text/xml");
107    $req->content($body) if defined($body);
108    my $resp = $ua->request($req);
109    debuglog($req, $resp) if ($prefs->{"debug"});
110    return $resp;
111}
112
113sub debuglog
114{
115    my ($request, $response) = @_;
116    printf STDERR "%s %s... %s %s (%db)\n",
117        $request->method(), 
118        $request->uri(), 
119        $response->code(), 
120        $response->message(), 
121        length($response->content());
122}
123
124sub dummylog
125{
126    my ($method, $url, $body) = @_;
127    print STDERR "$method $url\n";
128    print STDERR "$body\n\n";
129    return $dummy;
130}
131sub set_timeout
132{
133    my $to = shift;
134    $ua->timeout($to);
135}
136
1371;
Note: See TracBrowser for help on using the repository browser.