EVOLUTION-MANAGER

Edit File: LOC.pm

package Net::DNS::RR::LOC;

#
# $Id: LOC.pm 1075 2012-12-12 09:54:19Z willem $
#
use vars qw($VERSION);
$VERSION = (qw$LastChangedRevision: 1075 $)[1];

use base Net::DNS::RR;

=head1 NAME

Net::DNS::RR::LOC - DNS LOC resource record

=cut

use strict;
use integer;

use Carp;

sub decode_rdata {			## decode rdata from wire-format octet string
	my $self = shift;
	my ( $data, $offset ) = @_;

my $version = $self->{version} = unpack "\@$offset C", $$data;
	croak "LOC version $version not supported" unless $version == 0;
	@{$self}{qw(size hp vp latitude longitude altitude)} = unpack "\@$offset xC3N3", $$data;
}

sub encode_rdata {			## encode rdata as wire-format octet string
	my $self = shift;

return '' unless defined $self->{longitude};
	pack 'C4N3', @{$self}{qw(version size hp vp latitude longitude altitude)};
}

sub format_rdata {			## format rdata portion of RR string.
	my $self = shift;

return '' unless defined $self->{longitude};
	my @angular = ( $self->latitude, $self->longitude );
	my @linear = map { $self->$_ . 'm' } qw(altitude size hp vp);
	join ' ', @angular, @linear;
}

sub parse_rdata {			## populate RR from rdata in argument list
	my $self = shift;

my @lat;
	while ( scalar @_ ) {
		my $this = shift;
		push( @lat, $this );
		last if $this =~ /[NSns]/;
	}
	$self->latitude(@lat);

my @long;
	while ( scalar @_ ) {
		my $this = shift;
		push( @long, $this );
		last if $this =~ /[EWew]/;
	}
	$self->longitude(@long);

$self->$_( scalar @_ ? shift : () ) for qw(altitude size hp vp);
}

sub defaults() {			## specify RR attribute default values
	my $self = shift;

$self->version(0);
	$self->size(1);
	$self->hp(10000);
	$self->vp(10);
	$self->latitude(0);
	$self->longitude(0);
	$self->altitude(0);
}

########################################
{

no integer;

my $datum_alt = 10000000;
	my $datum_loc = 0x80000000;

sub _decode_lat {
		my $msec = shift;
		return int( 0.5 + ( $msec - $datum_loc ) / 0.36 ) / 10000000 unless wantarray;
		use integer;
		my $abs = abs( $msec - $datum_loc );
		my $deg = int( $abs / 3600000 );
		my $min = int( $abs / 60000 ) % 60;
		no integer;
		my $sec = ( $abs % 60000 ) / 1000;
		return ( $deg, $min, $sec, ( $msec < $datum_loc ? 'S' : 'N' ) );
	}

sub _encode_lat {
		my @ang = scalar @_ > 1 ? (@_) : ( split /[\s\260'"]+/, shift || '0' );
		my $ang = ( 0 + shift @ang ) * 3600000;
		my $neg = pop(@ang) =~ /[SWsw]/ if scalar @ang;
		undef $neg if $ang < 0;
		$ang += ( @ang ? shift @ang : 0 ) * 60000;
		$ang += ( @ang ? shift @ang : 0 ) * 1000;
		return int( 0.5 + ( $neg ? $datum_loc - $ang : $datum_loc + $ang ) );
	}

sub _decode_alt {
		my $cm = (shift) - $datum_alt;
		return 0.01 * $cm;
	}

sub _encode_alt {
		( my $argument = shift || '0' ) =~ s/[Mm]$//;
		$argument += 0;
		return int( 0.5 + $datum_alt + 100 * $argument );
	}

my @power10 = ( 0.01, 0.1, 1, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8 );

sub _decode_prec {
		my $argument = shift;
		my $mantissa = $argument >> 4;
		return $mantissa * $power10[$argument & 0x0F];
	}

sub _encode_prec {
		( my $argument = shift || '0' ) =~ s/[Mm]$//;
		return 0x00 if $argument < 0.01;
		foreach my $exponent ( 0 .. 9 ) {
			next unless $argument < $power10[1 + $exponent];
			my $mantissa = int( 0.5 + $argument / $power10[$exponent] );
			return ( $mantissa & 0xF ) << 4 | $exponent;
		}
		return 0x99;
	}

}
########################################

sub latitude {
	my $self = shift;
	$self->{latitude} = _encode_lat(@_) if scalar @_;
	return _decode_lat( $self->{latitude} ) if defined wantarray;
}

sub longitude {
	my $self = shift;
	$self->{longitude} = _encode_lat(@_) if scalar @_;
	return undef unless defined wantarray;
	return _decode_lat( $self->{longitude} ) unless wantarray;
	my @long = map { s/N/E/; s/S/W/; $_ } _decode_lat( $self->{longitude} );
}

sub altitude {
	my $self = shift;
	$self->{altitude} = _encode_alt(shift) if scalar @_;
	_decode_alt( $self->{altitude} ) if defined wantarray;
}

sub size {
	my $self = shift;
	$self->{size} = _encode_prec(shift) if scalar @_;
	_decode_prec( $self->{size} ) if defined wantarray;
}

sub hp {
	my $self = shift;
	$self->{hp} = _encode_prec(shift) if scalar @_;
	_decode_prec( $self->{hp} ) if defined wantarray;
}

sub horiz_pre { &hp; }

sub vp {
	my $self = shift;
	$self->{vp} = _encode_prec(shift) if scalar @_;
	_decode_prec( $self->{vp} ) if defined wantarray;
}

sub vert_pre { &vp; }

sub latlon {
	my $self      = shift;
	my $latitude  = _decode_lat( $self->{latitude} );
	my $longitude = _decode_lat( $self->{longitude} );
	return ( $latitude, $longitude );
}

sub version {
	my $self = shift;

$self->{version} = shift if scalar @_;
	return 0 + ( $self->{version} || 0 );
}

1;
__END__

=head1 SYNOPSIS

use Net::DNS;
    $rr = new Net::DNS::RR('name LOC latitude longitude altitude size hp vp');

=head1 DESCRIPTION

DNS geographical location (LOC) resource records.

=head1 METHODS

The available methods are those inherited from the base class augmented
by the type-specific methods defined in this package.

Use of undocumented package features or direct access to internal data
structures is discouraged and could result in program termination or
other unpredictable behaviour.

=head2 latitude

$latitude = $rr->latitude;
    ($deg, $min, $sec, $ns ) = $rr->latitude;

$rr->latitude( 42.357990 );
    $rr->latitude( 42, 21, 28.764, 'N' );
    $rr->latitude( '42 21 28.764 N' );

When invoked in scalar context, latitude is returned in degrees,
a negative ordinate being south of the equator.

When invoked in list context, latitude is returned as a list of
separate degree, minute, and second values followed by N or S
as appropriate.

Optional replacement values may be represented as single value, list
or formatted string. Trailing zero values are optional.

=head2 longitude

$longitude = $rr->longitude;
    ($deg, $min, $sec, $ew ) = $rr->longitude;

$rr->latitude( 71.014338 );
    $rr->latitude( 71, 0, 51.617, 'W' );
    $rr->latitude( '71 0 51.617 W' );

When invoked in scalar context, longitude is returned in degrees,
a negative ordinate being west of the prime meridian.

When invoked in list context, longitude is returned as a list of
separate degree, minute, and second values followed by E or W
as appropriate.

=head2 altitude

$altitude = $rr->altitude;

Represents altitude, in metres, relative to the WGS 84 reference
spheroid used by GPS.

=head2 size

$size = $rr->size;

Represents the diameter, in metres, of a sphere enclosing the
described entity.

=head2 hp

$hp = $rr->hp;

Represents the horizontal precision of the data expressed as the
diameter, in metres, of the circle of error.

=head2 vp

$vp = $rr->vp;

Represents the vertical precision of the data expressed as the
total spread, in metres, of the distribution of possible values.

=head2 latlon

($lat, $lon) = $rr->latlon;

Returns the latitude and longitude coordinate pair as
signed floating-point degrees.

=head2 version

$version = $rr->version;

Version of LOC protocol.

=head1 COPYRIGHT

This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

L<perl>, L<Net::DNS>, L<Net::DNS::RR>, RFC1876

=cut