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