1package Net::DNS::RR::LOC;
2#
3# $Id: LOC.pm 388 2005-06-22 10:06:05Z olaf $
4#
5use strict;
6BEGIN {
7    eval { require bytes; }
8}
9use vars qw(
10        @ISA $VERSION @poweroften $reference_alt
11        $reference_latlon $conv_sec $conv_min $conv_deg
12        $default_min $default_sec $default_size
13        $default_horiz_pre $default_vert_pre
14);
15
16@ISA     = qw(Net::DNS::RR);
17$VERSION = (qw$LastChangedRevision: 388 $)[1];
18
19# Powers of 10 from 0 to 9 (used to speed up calculations).
20@poweroften = (1, 10, 100, 1_000, 10_000, 100_000, 1_000_000,
21               10_000_000, 100_000_000, 1_000_000_000);
22
23# Reference altitude in centimeters (see RFC 1876).
24$reference_alt = 100_000 * 100;
25
26# Reference lat/lon (see RFC 1876).
27$reference_latlon = 2**31;
28
29# Conversions to/from thousandths of a degree.
30$conv_sec = 1000;
31$conv_min = 60 * $conv_sec;
32$conv_deg = 60 * $conv_min;
33
34# Defaults (from RFC 1876, Section 3).
35$default_min       = 0;
36$default_sec       = 0;
37$default_size      = 1;
38$default_horiz_pre = 10_000;
39$default_vert_pre  = 10;
40
41sub new {
42	my ($class, $self, $data, $offset) = @_;
43
44	if ($self->{"rdlength"} > 0) {
45		my ($version) = unpack("\@$offset C", $$data);
46		++$offset;
47
48		$self->{"version"} = $version;
49
50		if ($version == 0) {
51			my ($size) = unpack("\@$offset C", $$data);
52			$size = precsize_ntoval($size);
53			++$offset;
54
55			my ($horiz_pre) = unpack("\@$offset C", $$data);
56			$horiz_pre = precsize_ntoval($horiz_pre);
57			++$offset;
58
59			my ($vert_pre) = unpack("\@$offset C", $$data);
60			$vert_pre = precsize_ntoval($vert_pre);
61			++$offset;
62
63			my ($latitude) = unpack("\@$offset N", $$data);
64			$offset += Net::DNS::INT32SZ();
65
66			my ($longitude) = unpack("\@$offset N", $$data);
67			$offset += Net::DNS::INT32SZ();
68
69			my ($altitude) = unpack("\@$offset N", $$data);
70			$offset += Net::DNS::INT32SZ();
71
72			$self->{"size"}      = $size;
73			$self->{"horiz_pre"} = $horiz_pre;
74			$self->{"vert_pre"}  = $vert_pre;
75			$self->{"latitude"}  = $latitude;
76			$self->{"longitude"} = $longitude;
77			$self->{"altitude"}  = $altitude;
78		}
79		else {
80			# What to do for unsupported versions?
81		}
82	}
83
84	return bless $self, $class;
85}
86
87sub new_from_string {
88	my ($class, $self, $string) = @_;
89
90	if ($string &&
91	    $string =~ /^ (\d+) \s+		# deg lat
92			  ((\d+) \s+)?		# min lat
93			  (([\d.]+) \s+)?	# sec lat
94			  (N|S) \s+		# hem lat
95			  (\d+) \s+		# deg lon
96			  ((\d+) \s+)?		# min lon
97			  (([\d.]+) \s+)?	# sec lon
98			  (E|W) \s+		# hem lon
99			  (-?[\d.]+) m? 	# altitude
100			  (\s+ ([\d.]+) m?)?	# size
101			  (\s+ ([\d.]+) m?)?	# horiz precision
102			  (\s+ ([\d.]+) m?)? 	# vert precision
103		       /ix) {
104
105		# What to do for other versions?
106		my $version = 0;
107
108		my ($latdeg, $latmin, $latsec, $lathem) = ($1, $3, $5, $6);
109		my ($londeg, $lonmin, $lonsec, $lonhem) = ($7, $9, $11, $12);
110		my ($alt, $size, $horiz_pre, $vert_pre) = ($13, $15, $17, $19);
111
112		$latmin    = $default_min       unless $latmin;
113		$latsec    = $default_sec       unless $latsec;
114		$lathem    = uc($lathem);
115
116		$lonmin    = $default_min       unless $lonmin;
117		$lonsec    = $default_sec       unless $lonsec;
118		$lonhem    = uc($lonhem);
119
120		$size      = $default_size      unless $size;
121		$horiz_pre = $default_horiz_pre unless $horiz_pre;
122		$vert_pre  = $default_vert_pre  unless $vert_pre;
123
124		$self->{"version"}   = $version;
125		$self->{"size"}      = $size * 100;
126		$self->{"horiz_pre"} = $horiz_pre * 100;
127		$self->{"vert_pre"}  = $vert_pre * 100;
128		$self->{"latitude"}  = dms2latlon($latdeg, $latmin, $latsec,
129						  $lathem);
130		$self->{"longitude"} = dms2latlon($londeg, $lonmin, $lonsec,
131						  $lonhem);
132		$self->{"altitude"}  = $alt * 100 + $reference_alt;
133	}
134
135	return bless $self, $class;
136}
137
138sub rdatastr {
139	my $self = shift;
140	my $rdatastr;
141
142	if (exists $self->{"version"}) {
143		if ($self->{"version"} == 0) {
144			my $lat       = $self->{"latitude"};
145			my $lon       = $self->{"longitude"};
146			my $altitude  = $self->{"altitude"};
147			my $size      = $self->{"size"};
148			my $horiz_pre = $self->{"horiz_pre"};
149			my $vert_pre  = $self->{"vert_pre"};
150
151			$altitude   = ($altitude - $reference_alt) / 100;
152			$size      /= 100;
153			$horiz_pre /= 100;
154			$vert_pre  /= 100;
155
156			$rdatastr = latlon2dms($lat, "NS")       . " " .
157			            latlon2dms($lon, "EW")       . " " .
158			            sprintf("%.2fm", $altitude)  . " " .
159			            sprintf("%.2fm", $size)      . " " .
160			            sprintf("%.2fm", $horiz_pre) . " " .
161			            sprintf("%.2fm", $vert_pre);
162		} else {
163			$rdatastr = "; version " . $self->{"version"} . " not supported";
164		}
165	} else {
166		$rdatastr = '';
167	}
168
169	return $rdatastr;
170}
171
172sub rr_rdata {
173	my $self = shift;
174	my $rdata = "";
175
176	if (exists $self->{"version"}) {
177		$rdata .= pack("C", $self->{"version"});
178		if ($self->{"version"} == 0) {
179			$rdata .= pack("C3", precsize_valton($self->{"size"}),
180					     precsize_valton($self->{"horiz_pre"}),
181					     precsize_valton($self->{"vert_pre"}));
182			$rdata .= pack("N3", $self->{"latitude"},
183					     $self->{"longitude"},
184					     $self->{"altitude"});
185		}
186		else {
187			# What to do for other versions?
188		}
189	}
190
191	return $rdata;
192}
193
194sub precsize_ntoval {
195	my $prec = shift;
196
197	my $mantissa = (($prec >> 4) & 0x0f) % 10;
198	my $exponent = ($prec & 0x0f) % 10;
199	return $mantissa * $poweroften[$exponent];
200}
201
202sub precsize_valton {
203	my $val = shift;
204
205	my $exponent = 0;
206	while ($val >= 10) {
207		$val /= 10;
208		++$exponent;
209	}
210	return (int($val) << 4) | ($exponent & 0x0f);
211}
212
213sub latlon2dms {
214	my ($rawmsec, $hems) = @_;
215
216	# Tried to use modulus here, but Perl dumped core if
217	# the value was >= 2**31.
218
219	my ($abs, $deg, $min, $sec, $msec, $hem);
220
221	$abs  = abs($rawmsec - $reference_latlon);
222	$deg  = int($abs / $conv_deg);
223	$abs  -= $deg * $conv_deg;
224	$min  = int($abs / $conv_min);
225	$abs -= $min * $conv_min;
226	$sec  = int($abs / $conv_sec);
227	$abs -= $sec * $conv_sec;
228	$msec = $abs;
229
230	$hem = substr($hems, ($rawmsec >= $reference_latlon ? 0 : 1), 1);
231
232	return sprintf("%d %02d %02d.%03d %s", $deg, $min, $sec, $msec, $hem);
233}
234
235sub dms2latlon {
236	my ($deg, $min, $sec, $hem) = @_;
237	my ($retval);
238
239	$retval = ($deg * $conv_deg) + ($min * $conv_min) + ($sec * $conv_sec);
240	$retval = -$retval if ($hem eq "S") || ($hem eq "W");
241	$retval += $reference_latlon;
242	return $retval;
243}
244
245sub latlon {
246	my $self = shift;
247	my ($retlat, $retlon);
248
249	if ($self->{"version"} == 0) {
250		$retlat = latlon2deg($self->{"latitude"});
251		$retlon = latlon2deg($self->{"longitude"});
252	}
253	else {
254		$retlat = $retlon = undef;
255	}
256
257	return ($retlat, $retlon);
258}
259
260sub latlon2deg {
261	my $rawmsec = shift;
262	my $deg;
263
264	$deg = ($rawmsec - $reference_latlon) / $conv_deg;
265	return $deg;
266}
267
2681;
269__END__
270
271=head1 NAME
272
273Net::DNS::RR::LOC - DNS LOC resource record
274
275=head1 SYNOPSIS
276
277C<use Net::DNS::RR>;
278
279=head1 DESCRIPTION
280
281Class for DNS Location (LOC) resource records.  See RFC 1876 for
282details.
283
284=head1 METHODS
285
286=head2 version
287
288    print "version = ", $rr->version, "\n";
289
290Returns the version number of the representation; programs should
291always check this.  C<Net::DNS> currently supports only version 0.
292
293=head2 size
294
295    print "size = ", $rr->size, "\n";
296
297Returns the diameter of a sphere enclosing the described entity,
298in centimeters.
299
300=head2 horiz_pre
301
302    print "horiz_pre = ", $rr->horiz_pre, "\n";
303
304Returns the horizontal precision of the data, in centimeters.
305
306=head2 vert_pre
307
308    print "vert_pre = ", $rr->vert_pre, "\n";
309
310Returns the vertical precision of the data, in centimeters.
311
312=head2 latitude
313
314    print "latitude = ", $rr->latitude, "\n";
315
316Returns the latitude of the center of the sphere described by
317the C<size> method, in thousandths of a second of arc.  2**31
318represents the equator; numbers above that are north latitude.
319
320=head2 longitude
321
322    print "longitude = ", $rr->longitude, "\n";
323
324Returns the longitude of the center of the sphere described by
325the C<size> method, in thousandths of a second of arc.  2**31
326represents the prime meridian; numbers above that are east
327longitude.
328
329=head2 latlon
330
331    ($lat, $lon) = $rr->latlon;
332    system("xearth", "-pos", "fixed $lat $lon");
333
334Returns the latitude and longitude as floating-point degrees.
335Positive numbers represent north latitude or east longitude;
336negative numbers represent south latitude or west longitude.
337
338=head2 altitude
339
340    print "altitude = ", $rr->altitude, "\n";
341
342Returns the altitude of the center of the sphere described by
343the C<size> method, in centimeters, from a base of 100,000m
344below the WGS 84 reference spheroid used by GPS.
345
346=head1 COPYRIGHT
347
348Copyright (c) 1997-2002 Michael Fuhr.
349
350Portions Copyright (c) 2002-2004 Chris Reinhardt.
351
352All rights reserved.  This program is free software; you may redistribute
353it and/or modify it under the same terms as Perl itself.
354Some of the code and documentation is based on RFC 1876 and on code
355contributed by Christopher Davis.
356
357=head1 SEE ALSO
358
359L<perl(1)>, L<Net::DNS>, L<Net::DNS::Resolver>, L<Net::DNS::Packet>,
360L<Net::DNS::Header>, L<Net::DNS::Question>, L<Net::DNS::RR>,
361RFC 1876
362
363=cut
364