1 |
##################################################################
|
2 |
## EntitiesV3.pm - Wraps entities used by OSM ##
|
3 |
## By Martijn van Oosterhout <kleptog@svana.org> ##
|
4 |
## ##
|
5 |
## Package that wraps the entities used by OSM into Perl ##
|
6 |
## object, so they can be easily manipulated by various ##
|
7 |
## packages. ##
|
8 |
## ##
|
9 |
## Licence: LGPL ##
|
10 |
##################################################################
|
11 |
|
12 |
use XML::Writer;
|
13 |
use strict;
|
14 |
|
15 |
############################################################################
|
16 |
## Top level Entity type, parent of all types, includes stuff relating to ##
|
17 |
## tags and IDs which are shared by all entity types ##
|
18 |
############################################################################
|
19 |
package Geo::OSM::Entity;
|
20 |
use POSIX qw(strftime);
|
21 |
|
22 |
use Carp;
|
23 |
|
24 |
sub _new
|
25 |
{
|
26 |
bless {}, shift;
|
27 |
}
|
28 |
|
29 |
sub _get_writer
|
30 |
{
|
31 |
my($self,$res) = @_;
|
32 |
return new XML::Writer(OUTPUT => $res, NEWLINES => 0, ENCODING => 'utf-8');
|
33 |
}
|
34 |
|
35 |
sub add_tag
|
36 |
{
|
37 |
my($self, $k,$v) = @_;
|
38 |
push @{$self->{tags}}, $k, $v;
|
39 |
}
|
40 |
|
41 |
sub add_tags
|
42 |
{
|
43 |
my($self, @tags) = @_;
|
44 |
if( scalar(@tags)&1 )
|
45 |
{ croak "add_tags requires an even number of arguments" }
|
46 |
push @{$self->{tags}}, @tags;
|
47 |
}
|
48 |
|
49 |
sub set_tags
|
50 |
{
|
51 |
my($self,$tags) = @_;
|
52 |
if( ref($tags) eq "HASH" )
|
53 |
{ $self->{tags} = [%$tags] }
|
54 |
elsif( ref($tags) eq "ARRAY" )
|
55 |
{ $self->{tags} = [@$tags] }
|
56 |
else
|
57 |
{ croak "set_tags must be HASH or ARRAY" }
|
58 |
}
|
59 |
|
60 |
sub tags
|
61 |
{
|
62 |
my $self = shift;
|
63 |
return [@{$self->{tags}}]; # Return copy
|
64 |
}
|
65 |
|
66 |
sub tag_xml
|
67 |
{
|
68 |
my ($self,$writer) = @_;
|
69 |
my @a = @{$self->{tags}};
|
70 |
|
71 |
my $str = "";
|
72 |
|
73 |
while( my($k,$v) = splice @a, 0, 2 )
|
74 |
{
|
75 |
$writer->emptyTag( "tag", 'k' => $k, 'v' => $v );
|
76 |
}
|
77 |
}
|
78 |
|
79 |
our $_ID = -1;
|
80 |
|
81 |
sub set_id
|
82 |
{
|
83 |
my($self,$id) = @_;
|
84 |
|
85 |
if( not defined $id )
|
86 |
{ $id = $_ID-- }
|
87 |
$self->{id} = $id;
|
88 |
}
|
89 |
|
90 |
sub id
|
91 |
{
|
92 |
my $self = shift;
|
93 |
return $self->{id};
|
94 |
}
|
95 |
|
96 |
sub set_timestamp
|
97 |
{
|
98 |
my($self,$time) = @_;
|
99 |
if( defined $time )
|
100 |
{ $self->{timestamp} = $time }
|
101 |
else
|
102 |
{ $self->{timestamp} = strftime "%Y-%m-%dT%H:%M:%S+00:00", gmtime(time) }
|
103 |
}
|
104 |
|
105 |
sub timestamp
|
106 |
{
|
107 |
my $self = shift;
|
108 |
return $self->{timestamp};
|
109 |
}
|
110 |
|
111 |
sub full_xml
|
112 |
{
|
113 |
my $self = shift;
|
114 |
return qq(<?xml version="1.0"?>\n<osm version="0.5">\n).$self->xml()."</osm>\n";
|
115 |
}
|
116 |
|
117 |
package Geo::OSM::Way;
|
118 |
our @ISA = qw(Geo::OSM::Entity);
|
119 |
use Carp;
|
120 |
|
121 |
sub new
|
122 |
{
|
123 |
my($class, $attr, $tags, $nodes) = @_;
|
124 |
|
125 |
my $obj = bless $class->SUPER::_new(), $class;
|
126 |
|
127 |
$obj->set_tags($tags);
|
128 |
$obj->set_nodes($nodes);
|
129 |
$obj->set_id($attr->{id} );
|
130 |
$obj->set_timestamp( $attr->{timestamp} );
|
131 |
|
132 |
return $obj;
|
133 |
}
|
134 |
|
135 |
sub type { return "way" }
|
136 |
|
137 |
sub set_nodes
|
138 |
{
|
139 |
my($self,$nodes) = @_;
|
140 |
if( not defined $nodes )
|
141 |
{ $nodes = [] }
|
142 |
if( ref($nodes) ne "ARRAY" )
|
143 |
{ $nodes = [$nodes] }
|
144 |
if( scalar( grep { (ref($_) ne "")?$_->type ne "node":$_ !~ /^-?\d+/ } @$nodes ) )
|
145 |
{ croak "Expected array of nodes" }
|
146 |
$self->{nodes} = [map { ref($_)?$_->id:$_ } @$nodes];
|
147 |
}
|
148 |
|
149 |
sub nodes
|
150 |
{
|
151 |
my $self = shift;
|
152 |
return [@{$self->{nodes}}]; # Return a copy
|
153 |
}
|
154 |
|
155 |
sub xml
|
156 |
{
|
157 |
my $self = shift;
|
158 |
my $str = "";
|
159 |
my $writer = $self->_get_writer(\$str);
|
160 |
|
161 |
$writer->startTag( "way", id => $self->id, timestamp => $self->timestamp );
|
162 |
$self->tag_xml( $writer );
|
163 |
for my $node (@{$self->nodes})
|
164 |
{
|
165 |
$writer->emptyTag( "nd", ref => $node );
|
166 |
}
|
167 |
$writer->endTag( "way" );
|
168 |
$writer->end;
|
169 |
return $str;
|
170 |
}
|
171 |
|
172 |
sub map
|
173 |
{
|
174 |
my($self,$mapper) = @_;
|
175 |
my $incomplete = 0;
|
176 |
my ($new_id) = $mapper->map('way',$self->id); # Determine mapped ID
|
177 |
# It is ok for the new_id to be incomplete; it may be a create request
|
178 |
|
179 |
my @new_nodes = map { [ $mapper->map('node',$_) ] } @{$self->nodes};
|
180 |
map { $incomplete |= $_->[1] } @new_nodes;
|
181 |
# incomplete tracks if any of the segs are incomplete
|
182 |
|
183 |
my $new_ent = new Geo::OSM::Way( {id=>$new_id, timestamp=>$self->timestamp}, $self->tags, [map {$_->[0]} @new_nodes] );
|
184 |
return($new_ent,$incomplete);
|
185 |
}
|
186 |
|
187 |
package Geo::OSM::Relation::Member;
|
188 |
use Carp;
|
189 |
# Relation reference can be specified in several ways:
|
190 |
# { type => $type, ref => $id [ , role => $str ] }
|
191 |
# { ref => $obj [ , role => $str ] }
|
192 |
# [ $type, $id [,$role] ]
|
193 |
# [ $obj, [,$role] ]
|
194 |
sub new
|
195 |
{
|
196 |
my $class = shift;
|
197 |
my $arg = shift;
|
198 |
return $arg if ref($arg) eq $class; # Return if already object
|
199 |
if( ref($arg) eq "ARRAY" )
|
200 |
{
|
201 |
if( ref $arg->[0] )
|
202 |
{ $arg = { ref => $arg->[0], role => $arg->[1] } }
|
203 |
else
|
204 |
{ $arg = { type => $arg->[0], ref => $arg->[1], role => $arg->[2] } }
|
205 |
}
|
206 |
if( ref($arg) eq "HASH" )
|
207 |
{
|
208 |
if( ref $arg->{ref} )
|
209 |
{ $arg = [ $arg->{ref}->type, $arg->{ref}->id, $arg->{role} ] }
|
210 |
else
|
211 |
{ $arg = [ $arg->{type}, $arg->{ref}, $arg->{role} ] }
|
212 |
}
|
213 |
else
|
214 |
{ croak "Relation reference must be array or hash" }
|
215 |
croak "Bad type of member '$arg->[0]'"
|
216 |
unless $arg->[0] =~ /^(way|node|relation)$/;
|
217 |
croak "Bad member id '$arg->[1]'"
|
218 |
unless $arg->[1] =~ /^-?\d+$/;
|
219 |
$arg->[2] ||= "";
|
220 |
|
221 |
return bless $arg, $class;
|
222 |
}
|
223 |
|
224 |
sub member_type { shift->[0] }
|
225 |
sub ref { shift->[1] }
|
226 |
sub role { shift->[2] }
|
227 |
|
228 |
sub type { return "relation:member" }
|
229 |
|
230 |
sub _xml
|
231 |
{
|
232 |
my $self = shift;
|
233 |
my $writer = shift;
|
234 |
|
235 |
$writer->emptyTag( "member", type => $self->member_type, ref => $self->ref, role => $self->role );
|
236 |
}
|
237 |
|
238 |
sub map
|
239 |
{
|
240 |
my($self,$mapper) = @_;
|
241 |
my ($new_ref,$incomplete) = $mapper->map($self->member_type,$self->ref);
|
242 |
my $new_member = new Geo::OSM::Relation::Member( { type => $self->member_type, ref => $new_ref, role => $self->role } );
|
243 |
return($new_member,$incomplete);
|
244 |
}
|
245 |
|
246 |
package Geo::OSM::Relation;
|
247 |
our @ISA = qw(Geo::OSM::Entity);
|
248 |
|
249 |
sub new
|
250 |
{
|
251 |
my($class, $attr, $tags, $members) = @_;
|
252 |
|
253 |
my $obj = bless $class->SUPER::_new(), $class;
|
254 |
|
255 |
$obj->set_tags($tags);
|
256 |
$obj->set_members($members);
|
257 |
$obj->set_id($attr->{id} );
|
258 |
$obj->set_timestamp( $attr->{timestamp} );
|
259 |
|
260 |
return $obj;
|
261 |
}
|
262 |
|
263 |
sub set_members
|
264 |
{
|
265 |
my($self,$members) = @_;
|
266 |
if( not defined $members )
|
267 |
{ $members = [] }
|
268 |
if( ref($members) ne "ARRAY" )
|
269 |
{ $members = [$members] }
|
270 |
$self->{members} = [map { new Geo::OSM::Relation::Member($_) } @$members];
|
271 |
}
|
272 |
|
273 |
sub members
|
274 |
{
|
275 |
my $self = shift;
|
276 |
return [@{$self->{members}}];
|
277 |
}
|
278 |
|
279 |
sub type { return "relation" }
|
280 |
|
281 |
sub xml
|
282 |
{
|
283 |
my $self = shift;
|
284 |
my $str = "";
|
285 |
my $writer = $self->_get_writer(\$str);
|
286 |
|
287 |
$writer->startTag( "relation", id => $self->id, timestamp => $self->timestamp );
|
288 |
$self->tag_xml( $writer );
|
289 |
# Write members
|
290 |
foreach my $member (@{$self->{members}})
|
291 |
{ $member->_xml( $writer ) }
|
292 |
$writer->endTag( "relation" );
|
293 |
$writer->end;
|
294 |
return $str;
|
295 |
}
|
296 |
|
297 |
sub map
|
298 |
{
|
299 |
my($self,$mapper) = @_;
|
300 |
my $incomplete = 0;
|
301 |
|
302 |
my ($new_id) = $mapper->map('relation',$self->id);
|
303 |
my @new_members = map { [ $_->map($mapper) ] } @{$self->members};
|
304 |
map { $incomplete |= $_->[1] } @new_members;
|
305 |
# incomplete tracks if any of the members are incomplete
|
306 |
my $new_ent = new Geo::OSM::Relation( {id=>$new_id, timestamp=>$self->timestamp}, $self->tags, [map {$_->[0]} @new_members] );
|
307 |
return($new_ent,$incomplete);
|
308 |
}
|
309 |
|
310 |
package Geo::OSM::Node;
|
311 |
use Carp;
|
312 |
our @ISA = qw(Geo::OSM::Entity);
|
313 |
|
314 |
sub new
|
315 |
{
|
316 |
my($class, $attr, $tags) = @_;
|
317 |
|
318 |
my $obj = bless $class->SUPER::_new(), $class;
|
319 |
|
320 |
$obj->set_tags($tags);
|
321 |
$obj->set_id($attr->{id} );
|
322 |
$obj->set_timestamp( $attr->{timestamp} );
|
323 |
if( $attr->{lon} !~ /^[-+]?\d+(\.\d+)?([eE][+-]?\d+)?$/ or
|
324 |
$attr->{lat} !~ /^[-+]?\d+(\.\d+)?([eE][+-]?\d+)?$/ )
|
325 |
{
|
326 |
croak "Invalid lat,lon values ($attr->{lat},$attr->{lon})\n";
|
327 |
}
|
328 |
$obj->{lon} = $attr->{lon};
|
329 |
$obj->{lat} = $attr->{lat};
|
330 |
|
331 |
return $obj;
|
332 |
}
|
333 |
|
334 |
sub type { return "node" }
|
335 |
|
336 |
sub set_latlon
|
337 |
{
|
338 |
my($self,$lat,$lon) = @_;
|
339 |
$self->{lat} = $lat;
|
340 |
$self->{lon} = $lon;
|
341 |
}
|
342 |
|
343 |
sub lat
|
344 |
{
|
345 |
shift->{lat};
|
346 |
}
|
347 |
sub lon
|
348 |
{
|
349 |
shift->{lon};
|
350 |
}
|
351 |
|
352 |
sub xml
|
353 |
{
|
354 |
my $self = shift;
|
355 |
my $str = "";
|
356 |
my $writer = $self->_get_writer(\$str);
|
357 |
|
358 |
$writer->startTag( "node", id => $self->id, lat => $self->lat, lon => $self->lon, timestamp => $self->timestamp );
|
359 |
$self->tag_xml( $writer );
|
360 |
$writer->endTag( "node" );
|
361 |
$writer->end;
|
362 |
return $str;
|
363 |
}
|
364 |
|
365 |
sub map
|
366 |
{
|
367 |
my($self,$mapper) = @_;
|
368 |
my ($new_id) = $mapper->map('node',$self->id);
|
369 |
my $new_ent = new Geo::OSM::Node( {id=>$new_id, timestamp=>$self->timestamp, lat=>$self->lat, lon=>$self->lon}, $self->tags );
|
370 |
return($new_ent,0);
|
371 |
}
|
372 |
|
373 |
|
374 |
|
375 |
1;
|