1 |
##################################################################
|
2 |
## APIClientV4.pm - General Perl client for the API ##
|
3 |
## By Martijn van Oosterhout <kleptog@svana.org> ##
|
4 |
## ##
|
5 |
## Currently only supports uploading. Note the package actually ##
|
6 |
## creates a package named Geo::OSM::APIClient so upgrades to ##
|
7 |
## later versions will be easier. ##
|
8 |
## Licence: LGPL ##
|
9 |
##################################################################
|
10 |
|
11 |
use LWP::UserAgent;
|
12 |
use strict;
|
13 |
|
14 |
package Geo::OSM::APIClient;
|
15 |
use Geo::OSM::OsmReaderV3;
|
16 |
use MIME::Base64;
|
17 |
use HTTP::Request;
|
18 |
use Carp;
|
19 |
use Encode;
|
20 |
use POSIX qw(sigprocmask);
|
21 |
|
22 |
sub new
|
23 |
{
|
24 |
my( $class, %attr ) = @_;
|
25 |
|
26 |
my $obj = bless {}, $class;
|
27 |
|
28 |
my $url = $attr{api};
|
29 |
if( not defined $url )
|
30 |
{
|
31 |
croak "Did not specify aip url";
|
32 |
}
|
33 |
|
34 |
$url =~ s,/$,,; # Strip trailing slash
|
35 |
$obj->{url} = $url;
|
36 |
$obj->{client} = new LWP::UserAgent(agent => 'Geo::OSM::APIClientV4', timeout => 1200);
|
37 |
|
38 |
if( defined $attr{username} and defined $attr{password} )
|
39 |
{
|
40 |
if( $obj->{url} =~ m,http://([\w.]+)/, )
|
41 |
{
|
42 |
$obj->{client}->credentials( "$1:80", "Web Password", $attr{username}, $attr{password} );
|
43 |
}
|
44 |
my $encoded = MIME::Base64::encode_base64("$attr{username}:$attr{password}","");
|
45 |
$obj->{client}->default_header( "Authorization", "Basic $encoded" );
|
46 |
}
|
47 |
|
48 |
$obj->{reader} = init Geo::OSM::OsmReader( sub { _process($obj,@_) } );
|
49 |
return $obj;
|
50 |
}
|
51 |
|
52 |
# This is the callback from the parser. If checks if the buffer is defined.
|
53 |
# If the buffer is an array, append the new object. If the buffer is a proc,
|
54 |
# call it.
|
55 |
sub _process
|
56 |
{
|
57 |
my($obj,$ent) = @_;
|
58 |
if( not defined $obj->{buffer} )
|
59 |
{ die "Internal error: Received object with buffer" }
|
60 |
if( ref $obj->{buffer} eq "ARRAY" )
|
61 |
{ push @{$obj->{buffer}}, $ent; return }
|
62 |
if( ref $obj->{buffer} eq "CODE" )
|
63 |
{ $obj->{buffer}->($ent); return }
|
64 |
die "Internal error: don't know what to do with buffer $obj->{buffer}";
|
65 |
}
|
66 |
|
67 |
# Utility function to handle the temporary blocking of signals in a way that
|
68 |
# works with exception handling.
|
69 |
sub _with_blocked_sigs(&)
|
70 |
{
|
71 |
my $ss = new POSIX::SigSet( &POSIX::SIGINT );
|
72 |
my $func = shift;
|
73 |
my $os = new POSIX::SigSet;
|
74 |
sigprocmask( &POSIX::SIG_BLOCK, $ss, $os );
|
75 |
my $ret = eval { &$func };
|
76 |
sigprocmask( &POSIX::SIG_SETMASK, $os );
|
77 |
die $@ if $@;
|
78 |
return $ret;
|
79 |
}
|
80 |
|
81 |
sub _request
|
82 |
{
|
83 |
my $self = shift;
|
84 |
my $req = shift;
|
85 |
return _with_blocked_sigs { $self->{client}->request($req) };
|
86 |
}
|
87 |
|
88 |
sub last_error_code
|
89 |
{
|
90 |
return shift->{last_error}->code;
|
91 |
}
|
92 |
|
93 |
sub last_error_message
|
94 |
{
|
95 |
return shift->{last_error}->message;
|
96 |
}
|
97 |
|
98 |
sub create
|
99 |
{
|
100 |
my( $self, $ent ) = @_;
|
101 |
my $oldid = $ent->id;
|
102 |
$ent->set_id(0);
|
103 |
my $content = encode("utf-8", $ent->full_xml);
|
104 |
$ent->set_id($oldid);
|
105 |
my $req = new HTTP::Request PUT => $self->{url}."/".$ent->type()."/create";
|
106 |
$req->content($content);
|
107 |
|
108 |
# print $req->as_string;
|
109 |
|
110 |
my $res = $self->_request($req);
|
111 |
|
112 |
# print $res->as_string;
|
113 |
|
114 |
if( $res->code == 200 )
|
115 |
{
|
116 |
return $res->content
|
117 |
}
|
118 |
|
119 |
$self->{last_error} = $res;
|
120 |
return undef;
|
121 |
}
|
122 |
|
123 |
sub modify
|
124 |
{
|
125 |
my( $self, $ent ) = @_;
|
126 |
my $content = encode("utf-8", $ent->full_xml);
|
127 |
my $req = new HTTP::Request PUT => $self->{url}."/".$ent->type()."/".$ent->id();
|
128 |
$req->content($content);
|
129 |
|
130 |
# print $req->as_string;
|
131 |
|
132 |
my $res = $self->_request($req);
|
133 |
|
134 |
return $ent->id() if $res->code == 200;
|
135 |
$self->{last_error} = $res;
|
136 |
return undef;
|
137 |
}
|
138 |
|
139 |
sub delete
|
140 |
{
|
141 |
my( $self, $ent ) = @_;
|
142 |
my $content = encode("utf-8", $ent->full_xml);
|
143 |
my $req = new HTTP::Request DELETE => $self->{url}."/".$ent->type()."/".$ent->id();
|
144 |
# $req->content($content);
|
145 |
|
146 |
# print $req->as_string;
|
147 |
|
148 |
my $res = $self->_request($req);
|
149 |
|
150 |
return $ent->id() if $res->code == 200;
|
151 |
$self->{last_error} = $res;
|
152 |
return undef;
|
153 |
}
|
154 |
|
155 |
sub get($$)
|
156 |
{
|
157 |
my $self = shift;
|
158 |
my $type = shift;
|
159 |
my $id = shift;
|
160 |
|
161 |
my $req = new HTTP::Request GET => $self->{url}."/$type/$id";
|
162 |
|
163 |
my $res = $self->_request($req);
|
164 |
|
165 |
if( $res->code != 200 )
|
166 |
{
|
167 |
$self->{last_error} = $res;
|
168 |
return undef;
|
169 |
}
|
170 |
|
171 |
my @res;
|
172 |
$self->{buffer} = \@res;
|
173 |
$self->{reader}->parse($res->content);
|
174 |
undef $self->{buffer};
|
175 |
if( scalar(@res) != 1 )
|
176 |
{
|
177 |
die "Unexpected response for get_$type [".$res->content()."]\n";
|
178 |
}
|
179 |
|
180 |
return $res[0];
|
181 |
}
|
182 |
|
183 |
sub get_node($)
|
184 |
{
|
185 |
my $self = shift;
|
186 |
return $self->get("node",shift);
|
187 |
}
|
188 |
|
189 |
sub get_way($)
|
190 |
{
|
191 |
my $self = shift;
|
192 |
return $self->get("way",shift);
|
193 |
}
|
194 |
|
195 |
sub get_segment($)
|
196 |
{
|
197 |
my $self = shift;
|
198 |
return $self->get("segment",shift);
|
199 |
}
|
200 |
|
201 |
|
202 |
sub map($$$$)
|
203 |
{
|
204 |
my $self = shift;
|
205 |
my @bbox = @_;
|
206 |
|
207 |
my $req = new HTTP::Request GET => $self->{url}."/map?bbox=$bbox[0],$bbox[1],$bbox[2],$bbox[3]";
|
208 |
|
209 |
my $res = $self->_request($req);
|
210 |
|
211 |
if( $res->code != 200 )
|
212 |
{
|
213 |
$self->{last_error} = $res;
|
214 |
return undef;
|
215 |
}
|
216 |
|
217 |
my @res;
|
218 |
$self->{buffer} = \@res;
|
219 |
$self->{reader}->parse($res->content);
|
220 |
undef $self->{buffer};
|
221 |
|
222 |
return \@res;
|
223 |
}
|
224 |
|
225 |
|
226 |
1;
|