File Coverage

blib/lib/Algorithm/GooglePolylineEncoding.pm

Criterion	Covered	Total	%
statement	74	74	100.0
branch	10	10	100.0
condition			n/a
subroutine	8	8	100.0
pod	4	4	100.0
total	96	96	100.0

# -*- perl -*-

#
# Author: Slaven Rezic
#
# Copyright (C) 2009,2010,2012,2017 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: [e-mail]
# WWW:  http://www.rezic.de/eserte/
#

package Algorithm::GooglePolylineEncoding;

use 5.006; # sprintf("%b")

use strict;
use vars qw($VERSION);
$VERSION = '0.05';

sub encode_number {
#   1. Take the initial signed value:
#      -179.9832104
    my $number = shift;
#   2. Take the decimal value and multiply it by 1e5, rounding the result:
#      -17998321
    $number = int($number * 1e5 + ($number < 0 ? -0.5 : 0.5));
    # Don't do this before rounding. Negativeness may change if for example
    # using very small negative numbers.
    my $is_negative = $number < 0;
#   3. Convert the decimal value to binary. Note that a negative value must be calculated using its two's complement by inverting the binary value and adding one to the result:
#      00000001 00010010 10100001 11110001
#      11111110 11101101 01011110 00001110
#      11111110 11101101 01011110 00001111
    # nothing to do here, we don't calculate with binary strings...
#   4. Left-shift the binary value one bit:
#      11111101 11011010 10111100 00011110
    $number <<= 1;
    $number &= 0xffffffff; # to assure 32 bit
#   5. If the original decimal value is negative, invert this encoding:
#      00000010 00100101 01000011 11100001
    if ($is_negative) {
        $number = (~$number);
        $number &= 0xffffffff;
    }
#   6. Break the binary value out into 5-bit chunks (starting from the right hand side):
#      00001 00010 01010 10000 11111 00001
    my $bin = sprintf '%b', $number;
    $bin = '0'x(5-length($bin)%5) . $bin if length($bin)%5 != 0; # pad
    my @chunks;
    my $revbin = reverse $bin;
    push @chunks, scalar reverse($1) while $revbin =~ m{(.....)}g;
#   7. Place the 5-bit chunks into reverse order:
#      00001 11111 10000 01010 00010 00001
    # It's already reversed
#   8. OR each value with 0x20 if another bit chunk follows:
#      100001 111111 110000 101010 100010 000001
    @chunks = ((map { oct("0b$_") | 0x20 } @chunks[0 .. $#chunks-1]), oct("0b".$chunks[-1])); # and also decode to decimal on the fly
#   9. Convert each value to decimal:
#      33 63 48 42 34 1
    # Done above
#  10. Add 63 to each value:
#      96 126 111 105 97 64
    @chunks = map { $_+63 } @chunks;
#  11. Convert each value to its ASCII equivalent:
#      `~oia@
    @chunks = map { chr } @chunks;
    join '', @chunks;
}

sub encode_polyline {
    my(@path) = @_;
    my @res;
    my($curr_lat_e5,$curr_lon_e5) = (0,0);
    for my $lat_lon (@path) {
	my($lat_e5,$lon_e5) = map { sprintf("%.0f", $_*1e5) } ($lat_lon->{lat}, $lat_lon->{lon});
        my $deltay = ($lat_e5 - $curr_lat_e5) / 1e5;
        my $deltax = ($lon_e5 - $curr_lon_e5) / 1e5;
        push @res, encode_number($deltay), encode_number($deltax);
        ($curr_lat_e5,$curr_lon_e5) = ($lat_e5,$lon_e5);
    }
    join '', @res;
}

sub encode_level {
#   1. Take the initial unsigned value:
#      174
    my $number = shift;
#   2. Convert the decimal value to a binary value:
#      10101110
    my $bin = sprintf '%b', $number;
#   3. Break the binary value out into 5-bit chunks (starting from the right hand side):
#      101 01110
    $bin = '0'x(5-length($bin)%5) . $bin if length($bin)%5 != 0; # pad
    my @chunks;
    my $revbin = reverse $bin;
    push @chunks, scalar reverse($1) while $revbin =~ m{(.....)}g;
#   4. Place the 5-bit chunks into reverse order:
#      01110 101
    # It's already reversed
#   5. OR each value with 0x20 if another bit chunk follows:
#      101110 00101
    @chunks = ((map { oct("0b$_") | 0x20 } @chunks[0 .. $#chunks-1]), oct("0b".$chunks[-1])); # and also decode to decimal on the fly
#   6. Convert each value to decimal:
#      46 5
    # Done above
#   7. Add 63 to each value:
#      109 68
    @chunks = map { $_+63 } @chunks;
#   8. Convert each value to its ASCII equivalent:
#      mD
    @chunks = map { chr } @chunks;
    join '', @chunks;
}

# Translated this php script
#
# to perl
sub decode_polyline {
    my($encoded) = @_;

    my $length = length $encoded;
    my $index = 0;
    my @points;
    my $lat = 0;
    my $lng = 0;

    while ($index < $length) {
	# The encoded polyline consists of a latitude value followed
	# by a longitude value. They should always come in pairs. Read
	# the latitude value first.
	for my $val (\$lat, \$lng) {
	    my $shift = 0;
	    my $result = 0;
	    # Temporary variable to hold each ASCII byte.
	    my $b;
	    do {
		# The `ord(substr($encoded, $index++))` statement returns
		# the ASCII code for the character at $index. Subtract 63
		# to get the original value. (63 was added to ensure
		# proper ASCII characters are displayed in the encoded
		# polyline string, which is `human` readable)
		$b = ord(substr($encoded, $index++, 1)) - 63;

		# AND the bits of the byte with 0x1f to get the original
		# 5-bit `chunk. Then left shift the bits by the required
		# amount, which increases by 5 bits each time. OR the
		# value into $results, which sums up the individual 5-bit
		# chunks into the original value. Since the 5-bit chunks
		# were reversed in order during encoding, reading them in
		# this way ensures proper summation.
		$result |= ($b & 0x1f) << $shift;
		$shift += 5;
	    }
		# Continue while the read byte is >= 0x20 since the last
		# `chunk` was not OR'd with 0x20 during the conversion
		# process. (Signals the end)
		while ($b >= 0x20);

	    use integer; # see last paragraph of "Integer Arithmetic" in perlop.pod

	    # Check if negative, and convert. (All negative values have the last bit
	    # set)
	    my $dtmp = (($result & 1) ? ~($result >> 1) : ($result >> 1));

	    # Compute actual latitude (resp. longitude) since value is
	    # offset from previous value.
	    $$val += $dtmp;
	}

	# The actual latitude and longitude values were multiplied by
	# 1e5 before encoding so that they could be converted to a 32-bit
	# integer representation. (With a decimal accuracy of 5 places)
	# Convert back to original values.
	push @points, {lat => $lat * 1e-5, lon => $lng * 1e-5};
    }

    @points;
}

1;

__END__