/[zanavi_public1]/navit/navit/script/osm/Geo/OSM/APIClientV4.pm
ZANavi

Contents of /navit/navit/script/osm/Geo/OSM/APIClientV4.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (show annotations) (download)
Fri Oct 28 21:19:04 2011 UTC (12 years, 5 months ago) by zoff99
File size: 5077 byte(s)
import files
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;

   
Visit the ZANavi Wiki