File Coverage

blib/lib/Geo/LocaPoint.pm

Criterion	Covered	Total	%
statement	67	68	98.5
branch	11	16	68.7
condition	4	6	66.6
subroutine	15	15	100.0
pod	8	8	100.0
total	105	113	92.9

package Geo::LocaPoint;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.0.4');
use vars qw(@ISA @EXPORT @EXPORT_OK);
use Exporter;
@ISA = qw(Exporter);
@EXPORT      = qw(latlng2locapoint locapoint2latlng);
@EXPORT_OK   = qw(latlng2locaporterbase locaporterbase2latlng);

use Math::Round qw(nhimult);

my @devider = (1757600,67600,6760,260,10,1);

# Internal methods

sub int2code {
    my ($value,$count,$precision,$islocapo) = @_;
    my $this = int($value / $devider[$count]);
    my $low = $value % $devider[$count];
    $this = pack "C", 65 + $this if (!$islocapo || ($count % 3 != 2));
    if ($count < $precision - 1) {
        $this .= int2code($low,$count+1,$precision,$islocapo);
    }
    return $this;
}

sub code2int {
    my ($value,$count) = @_;
    my $this = substr($value,0,1);
    my $low = substr($value,1);
    $this = unpack("C",$this) - 65 if ($this =~ /^[A-Z]$/);
    $this *= $devider[$count];
    if ($low ne '') {
        $this += code2int($low,$count+1);
    }
    return $this;
}

sub latlng2code {
    my ($lat,$lng,$precision,$islocapo) = @_;

    $lat = int(($lat + 90) * 2284880 / 9);
    $lng = int(($lng + 180) *1142440 / 9);

    foreach ($lat,$lng) {
        while (($_ < 0) || ($_ > 45697599)) {
            $_ = $_ < 0 ? $_ + 45697600 : $_ - 45697600;
        }
        $_ = int2code($_,0,$precision,$islocapo);
    }

    return ($lat,$lng);
}

sub code2latlng {
    my ($lat,$lng) = @_;

    foreach ($lat,$lng) {
        $_ = code2int($_,0);
    }

    $lat = nhimult(.000001,$lat * 9 / 2284880 - 90);
    $lng = nhimult(.000001,$lng * 9 / 1142440 - 180);

    return ($lat,$lng);
}

# Export methods

sub latlng2locapoint {
    my ($lat,$lng) = @_;

    ($lat,$lng) = latlng2code($lat,$lng,6,1);

    my $locapo = sprintf("%s.%s.%s.%s",substr($lat,0,3),substr($lng,0,3),substr($lat,3,3),substr($lng,3,3));
    return $locapo;
}

sub locapoint2latlng {
    my $locapo = shift;

    $locapo =~ /^([A-Z][A-Z][0-9])\.([A-Z][A-Z][0-9])\.([A-Z][A-Z][0-9])\.([A-Z][A-Z][0-9])$/ or croak "Argument $locapo is not locapoint!!";
    my $lat = $1.$3;
    my $lng = $2.$4;

    return code2latlng($lat,$lng);
}

sub latlng2locaporterbase {
    my ($lat,$lng,$precision) = @_;

    ($lat,$lng) = latlng2code($lat,$lng,$precision);
    $lng        = lc($lng);

    return wantarray ? ($lat, $lng) : $lat.$lng;
}

sub locaporterbase2latlng {
    my ($lat,$lng) = @_;

    unless (defined($lng)) {
        ($lat,$lng) = $lat =~ /^([A-Z]+)([a-z]+)$/;
    }

    $lng = uc($lng);

    return code2latlng($lat,$lng);
}

1; # Magic true value required at end of module
__END__