diff options
Diffstat (limited to 'lib/Travel/Status/DE/HAFAS')
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Journey.pm | 83 | ||||
-rw-r--r-- | lib/Travel/Status/DE/HAFAS/Polyline.pm | 96 |
2 files changed, 142 insertions, 37 deletions
diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm index 31675ba..da29804 100644 --- a/lib/Travel/Status/DE/HAFAS/Journey.pm +++ b/lib/Travel/Status/DE/HAFAS/Journey.pm @@ -29,26 +29,10 @@ sub new { my $journey = $opt{journey}; my $date = $journey->{date}; - my $time_s - = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeS' : 'dTimeS' }; - my $time_r - = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeR' : 'dTimeR' }; - my $datetime_s - = $hafas->{strptime_obj}->parse_datetime("${date}T${time_s}"); - my $datetime_r - = $time_r - ? $hafas->{strptime_obj}->parse_datetime("${date}T${time_r}") - : undef; - my $delay - = $datetime_r - ? ( $datetime_r->epoch - $datetime_s->epoch ) / 60 - : undef; my $destination = $journey->{dirTxt}; my $is_cancelled = $journey->{isCncl}; my $jid = $journey->{jid}; - my $platform = $journey->{stbStop}{dPlatfS}; - my $new_platform = $journey->{stbStop}{dPlatfR}; my $product = $prodL[ $journey->{prodX} ]; my $train = $product->{prodCtx}{name}; @@ -108,33 +92,58 @@ sub new { shift @stops; my $ref = { - sched_datetime => $datetime_s, - rt_datetime => $datetime_r, - datetime => $datetime_r // $datetime_s, - datetime_now => $hafas->{now}, - delay => $delay, - is_cancelled => $is_cancelled, - train => $train, - operator => $operator, - route_end => $destination, - platform => $platform, - new_platform => $new_platform, - messages => \@messages, - route => \@stops, + datetime_now => $hafas->{now}, + is_cancelled => $is_cancelled, + train => $train, + operator => $operator, + route_end => $destination, + messages => \@messages, + route => \@stops, }; bless( $ref, $obj ); - if ( $ref->{delay} ) { - $ref->{datetime} = $ref->{rt_datetime}; + if ( $journey->{stbStop} ) { + $ref->{platform} = $journey->{stbStop}{dPlatfS}; + $ref->{new_platform} = $journey->{stbStop}{dPlatfR}; + + my $time_s + = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeS' : 'dTimeS' }; + my $time_r + = $journey->{stbStop}{ $hafas->{arrivals} ? 'aTimeR' : 'dTimeR' }; + + my $datetime_s + = $hafas->{strptime_obj}->parse_datetime("${date}T${time_s}"); + my $datetime_r + = $time_r + ? $hafas->{strptime_obj}->parse_datetime("${date}T${time_r}") + : undef; + + my $delay + = $datetime_r + ? ( $datetime_r->epoch - $datetime_s->epoch ) / 60 + : undef; + + $ref->{sched_datetime} = $datetime_s; + $ref->{rt_datetime} = $datetime_r; + $ref->{datetime} = $datetime_r // $datetime_s; + $ref->{delay} = $delay; + + if ( $ref->{delay} ) { + $ref->{datetime} = $ref->{rt_datetime}; + } + else { + $ref->{datetime} = $ref->{sched_datetime}; + } + + $ref->{date} = $ref->{datetime}->strftime('%d.%m.%Y'); + $ref->{time} = $ref->{datetime}->strftime('%H:%M'); + $ref->{sched_date} = $ref->{sched_datetime}->strftime('%d.%m.%Y'); + $ref->{sched_time} = $ref->{sched_datetime}->strftime('%H:%M'); } - else { - $ref->{datetime} = $ref->{sched_datetime}; + if ( $opt{polyline} ) { + $ref->{polyline} = $opt{polyline}; } - $ref->{date} = $ref->{datetime}->strftime('%d.%m.%Y'); - $ref->{time} = $ref->{datetime}->strftime('%H:%M'); - $ref->{sched_date} = $ref->{sched_datetime}->strftime('%d.%m.%Y'); - $ref->{sched_time} = $ref->{sched_datetime}->strftime('%H:%M'); return $ref; } diff --git a/lib/Travel/Status/DE/HAFAS/Polyline.pm b/lib/Travel/Status/DE/HAFAS/Polyline.pm new file mode 100644 index 0000000..2d82912 --- /dev/null +++ b/lib/Travel/Status/DE/HAFAS/Polyline.pm @@ -0,0 +1,96 @@ +package Travel::Status::DE::HAFAS::Polyline; + +use strict; +use warnings; +use 5.014; + +# Adapted from code by Slaven Rezic +# +# Copyright (C) 2009,2010,2012,2017,2018 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: slaven@rezic.de +# WWW: http://www.rezic.de/eserte/ + +use parent 'Exporter'; +our @EXPORT_OK = qw(decode_polyline); +our $VERSION = '0.06'; + +# Translated this php script +# <http://unitstep.net/blog/2008/08/02/decoding-google-maps-encoded-polylines-using-php/> +# 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 ); + + # see last paragraph of "Integer Arithmetic" in perlop.pod + use integer; + + # 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 + } + ); + } + + return @points; +} + +1; |