File Coverage

blib/lib/Geo/Hash.pm

Criterion	Covered	Total	%
statement	50	51	98.0
branch	9	12	75.0
condition	3	6	50.0
subroutine	11	11	100.0
pod	5	5	100.0
total	78	85	91.7

package Geo::Hash;

use warnings;
use strict;
use Carp;

=head1 NAME

Geo::Hash - Encode / decode geohash.org locations.

=head1 VERSION

This document describes Geo::Hash version 0.02

=cut

our $VERSION = '0.02';

=head1 SYNOPSIS

    use Geo::Hash;

    my $gh = Geo::Hash->new;
    my $hash = $gh->encode( $lat, $lon );
    my ( $lat, $lon ) = $gh->decode( $hash );

=head1 DESCRIPTION

Geohash is a latitude/longitude geocode system invented by Gustavo
Niemeyer when writing the web service at geohash.org, and put into the
public domain.

This module encodes and decodes geohash locations.

See L and L
for more information.

=head1 INTERFACE

=head2 C<< new >>

Create a new Geo::Hash object.

    my $gh = Geo::Hash->new;

=cut

sub new { bless {}, shift }

my @ENC = qw(
  0 1 2 3 4 5 6 7 8 9 b c d e f g h j k m n p q r s t u v w x y z
);

my %DEC = map { $ENC[$_] => $_ } 0 .. $#ENC;

sub _mid {
    my ( $ar, $wh ) = @_;
    return ( $ar->[$wh][0] + $ar->[$wh][1] ) / 2;
}

# The number of bits necessary to represent the specified number of
# decimal digits
sub _d2b { int( shift() * 3.32192809488736 + 1 ) }

sub _bits_for_number {
    my $n = shift;
    return 0 unless $n =~ s/.*\.//;
    return _d2b( length $n );
}

=head2 C<< precision >>

Infer a suitable precision (number of character in hash) for a given
lat, lon pair.

    my $prec = $gh->precision( $lat, $lon );

=cut

sub precision {
    my ( $self, $lat, $lon ) = @_;
    my $lab = _bits_for_number( $lat ) + 8;
    my $lob = _bits_for_number( $lon ) + 9;
    return int( ( ( $lab > $lob ? $lab : $lob ) + 1 ) / 2.5 );
}

=head2 C<< encode >>

Encode a lat, long pair into a geohash.

    my $hash = $gh->encode( $lat, $lon );

You may optionally supply the length of the desired geohash:

    # Very precise
    my $hash = $gh->encode( $lat, $lon, 10 );

If the precision argument is omitted C will be used to
provide a default.

=cut

sub encode {
    croak "encode needs two or three arguments"
      unless @_ >= 3 && @_ <= 4;
    my ( $self, @pos ) = splice @_, 0, 3;
    my $prec = shift || $self->precision( @pos );
    my $int  = [ [ 90, -90 ], [ 180, -180 ] ];
    my $flip = 1;
    my @enc  = ();
    while ( @enc < $prec ) {
        my $bits = 0;
        for ( 0 .. 4 ) {
            my $mid = _mid( $int, $flip );
            my $bit = $pos[$flip] >= $mid ? 1 : 0;
            $bits = ( ( $bits << 1 ) | $bit );
            $int->[$flip][$bit] = $mid;
            $flip ^= 1;
        }
        push @enc, $ENC[$bits];
    }
    return join '', @enc;
}

=head2 C<< decode_to_interval >>

Like C but instead of returning a pair of coordinates returns
the interval for each coordinate. This gives some indication of how
precisely the original hash specified the location.

The return value is a pair of array refs. Each referred to array
contains the upper and lower bounds for each coordinate.

    my ( $lat_range, $lon_range ) = $gh->decode_to_interval( $hash );
    # $lat_range and $lon_range are references to two element arrays

=cut

sub decode_to_interval {
    croak "Needs one argument"
      unless @_ == 2;
    my ( $self, $hash ) = @_;

    my $int = [ [ 90, -90 ], [ 180, -180 ] ];
    my $flip = 1;

    for my $ch ( split //, $hash ) {
        if ( defined( my $bits = $DEC{$ch} ) ) {
            for ( 0 .. 4 ) {
                $int->[$flip][ ( $bits & 16 ) >> 4 ]
                  = _mid( $int, $flip );
                $flip ^= 1;
                $bits <<= 1;
            }
        }
        else {
            croak "Bad character '$ch' in hash '$hash'";
        }
    }

    return @$int;
}

=head2 C<< decode >>

Decode a geohash into a lat, long pair.

    my ( $lat, $lon ) = $gh->decode( $hash );

=cut

sub decode {
    my @int = shift->decode_to_interval( @_ );
    return map { _mid( \@int, $_ ) } 0 .. 1;
}

1;
__END__