File Coverage

blib/lib/Travel/Status/DE/HAFAS/Polyline.pm
Criterion Covered Total %
statement 14 33 42.4
branch 0 2 0.0
condition n/a
subroutine 5 6 83.3
pod 0 1 0.0
total 19 42 45.2


line stmt bran cond sub pod time code
1             package Travel::Status::DE::HAFAS::Polyline;
2              
3 1     1   8 use strict;
  1         3  
  1         30  
4 1     1   6 use warnings;
  1         2  
  1         23  
5 1     1   16 use 5.014;
  1         4  
6              
7             # Adapted from code by Slaven Rezic
8             #
9             # Copyright (C) 2009,2010,2012,2017,2018 Slaven Rezic. All rights reserved.
10             # This package is free software; you can redistribute it and/or
11             # modify it under the same terms as Perl itself.
12             #
13             # Mail: slaven@rezic.de
14             # WWW: http://www.rezic.de/eserte/
15              
16 1     1   6 use parent 'Exporter';
  1         2  
  1         15  
17             our @EXPORT_OK = qw(decode_polyline);
18              
19             our $VERSION = '4.15';
20              
21             # Translated this php script
22             # <http://unitstep.net/blog/2008/08/02/decoding-google-maps-encoded-polylines-using-php/>
23             # to perl
24             sub decode_polyline {
25 0     0 0   my ($encoded) = @_;
26              
27 0           my $length = length $encoded;
28 0           my $index = 0;
29 0           my @points;
30 0           my $lat = 0;
31 0           my $lng = 0;
32              
33 0           while ( $index < $length ) {
34              
35             # The encoded polyline consists of a latitude value followed
36             # by a longitude value. They should always come in pairs. Read
37             # the latitude value first.
38 0           for my $val ( \$lat, \$lng ) {
39 0           my $shift = 0;
40 0           my $result = 0;
41              
42             # Temporary variable to hold each ASCII byte.
43 0           my $b;
44 0           do {
45             # The `ord(substr($encoded, $index++))` statement returns
46             # the ASCII code for the character at $index. Subtract 63
47             # to get the original value. (63 was added to ensure
48             # proper ASCII characters are displayed in the encoded
49             # polyline string, which is `human` readable)
50 0           $b = ord( substr( $encoded, $index++, 1 ) ) - 63;
51              
52             # AND the bits of the byte with 0x1f to get the original
53             # 5-bit `chunk. Then left shift the bits by the required
54             # amount, which increases by 5 bits each time. OR the
55             # value into $results, which sums up the individual 5-bit
56             # chunks into the original value. Since the 5-bit chunks
57             # were reversed in order during encoding, reading them in
58             # this way ensures proper summation.
59 0           $result |= ( $b & 0x1f ) << $shift;
60 0           $shift += 5;
61             }
62              
63             # Continue while the read byte is >= 0x20 since the last
64             # `chunk` was not OR'd with 0x20 during the conversion
65             # process. (Signals the end)
66             while ( $b >= 0x20 );
67              
68             # see last paragraph of "Integer Arithmetic" in perlop.pod
69 1     1   203 use integer;
  1         2  
  1         9  
70              
71             # Check if negative, and convert. (All negative values have the last bit
72             # set)
73 0 0         my $dtmp
74             = ( ( $result & 1 ) ? ~( $result >> 1 ) : ( $result >> 1 ) );
75              
76             # Compute actual latitude (resp. longitude) since value is
77             # offset from previous value.
78 0           $$val += $dtmp;
79             }
80              
81             # The actual latitude and longitude values were multiplied by
82             # 1e5 before encoding so that they could be converted to a 32-bit
83             # integer representation. (With a decimal accuracy of 5 places)
84             # Convert back to original values.
85             push(
86 0           @points,
87             {
88             lat => $lat * 1e-5,
89             lon => $lng * 1e-5
90             }
91             );
92             }
93              
94 0           return @points;
95             }
96              
97             1;