summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Travel/Status/DE/HAFAS.pm164
-rw-r--r--lib/Travel/Status/DE/HAFAS/Journey.pm83
-rw-r--r--lib/Travel/Status/DE/HAFAS/Polyline.pm96
3 files changed, 257 insertions, 86 deletions
diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm
index 769ff39..9270d2a 100644
--- a/lib/Travel/Status/DE/HAFAS.pm
+++ b/lib/Travel/Status/DE/HAFAS.pm
@@ -17,6 +17,7 @@ use List::Util qw(any);
use LWP::UserAgent;
use POSIX qw(strftime);
use Travel::Status::DE::HAFAS::Message;
+use Travel::Status::DE::HAFAS::Polyline qw(decode_polyline);
use Travel::Status::DE::HAFAS::Journey;
use Travel::Status::DE::HAFAS::StopFinder;
@@ -186,7 +187,7 @@ sub new {
$ua->env_proxy;
}
- if ( not $conf{station} ) {
+ if ( not $conf{station} and not $conf{journey} ) {
confess('You need to specify a station');
}
@@ -215,56 +216,80 @@ sub new {
bless( $self, $obj );
- my $date = ( $conf{datetime} // $now )->strftime('%Y%m%d');
- my $time = ( $conf{datetime} // $now )->strftime('%H%M%S');
-
- my $lid;
- if ( $self->{station} =~ m{ ^ [0-9]+ $ }x ) {
- $lid = 'A=1@L=' . $self->{station} . '@';
+ my $req;
+
+ if ( $conf{journey} ) {
+ $req = {
+ svcReqL => [
+ {
+ meth => 'JourneyDetails',
+ req => {
+ jid => $conf{journey}{id},
+ name => $conf{journey}{name} // '0',
+ getPolyline => $conf{with_polyline} ? \1 : \0,
+ },
+ }
+ ],
+ %{ $hafas_instance{$service}{request} }
+ };
}
else {
- $lid = 'A=1@O=' . $self->{station} . '@';
- }
+ my $date = ( $conf{datetime} // $now )->strftime('%Y%m%d');
+ my $time = ( $conf{datetime} // $now )->strftime('%H%M%S');
- my $mot_mask = 2**@{ $hafas_instance{$service}{productbits} } - 1;
+ my $lid;
+ if ( $self->{station} =~ m{ ^ [0-9]+ $ }x ) {
+ $lid = 'A=1@L=' . $self->{station} . '@';
+ }
+ else {
+ $lid = 'A=1@O=' . $self->{station} . '@';
+ }
- my %mot_pos;
- for my $i ( 0 .. $#{ $hafas_instance{$service}{productbits} } ) {
- $mot_pos{ $hafas_instance{$service}{productbits}[$i] } = $i;
- }
+ my $mot_mask = 2**@{ $hafas_instance{$service}{productbits} } - 1;
- if ( my @mots = @{ $self->{exclusive_mots} // [] } ) {
- $mot_mask = 0;
- for my $mot (@mots) {
- $mot_mask |= 1 << $mot_pos{$mot};
+ my %mot_pos;
+ for my $i ( 0 .. $#{ $hafas_instance{$service}{productbits} } ) {
+ $mot_pos{ $hafas_instance{$service}{productbits}[$i] } = $i;
}
- }
- if ( my @mots = @{ $self->{excluded_mots} // [] } ) {
- for my $mot (@mots) {
- $mot_mask &= ~( 1 << $mot_pos{$mot} );
+ if ( my @mots = @{ $self->{exclusive_mots} // [] } ) {
+ $mot_mask = 0;
+ for my $mot (@mots) {
+ $mot_mask |= 1 << $mot_pos{$mot};
+ }
}
- }
- my $req = {
- svcReqL => [
- {
- req => {
- type => ( $conf{arrivals} ? 'ARR' : 'DEP' ),
- stbLoc => { lid => $lid },
- dirLoc => undef,
- maxJny => 30,
- date => $date,
- time => $time,
- dur => -1,
- jnyFltrL =>
- [ { type => "PROD", mode => "INC", value => $mot_mask } ]
- },
- meth => 'StationBoard'
+ if ( my @mots = @{ $self->{excluded_mots} // [] } ) {
+ for my $mot (@mots) {
+ $mot_mask &= ~( 1 << $mot_pos{$mot} );
}
- ],
- %{ $hafas_instance{$service}{request} }
- };
+ }
+
+ $req = {
+ svcReqL => [
+ {
+ meth => 'StationBoard',
+ req => {
+ type => ( $conf{arrivals} ? 'ARR' : 'DEP' ),
+ stbLoc => { lid => $lid },
+ dirLoc => undef,
+ maxJny => 30,
+ date => $date,
+ time => $time,
+ dur => -1,
+ jnyFltrL => [
+ {
+ type => "PROD",
+ mode => "INC",
+ value => $mot_mask
+ }
+ ]
+ },
+ },
+ ],
+ %{ $hafas_instance{$service}{request} }
+ };
+ }
my $json = $self->{json} = JSON->new->utf8;
@@ -318,7 +343,18 @@ sub new {
}
$self->check_mgate;
- $self->parse_mgate;
+
+ $self->{strptime_obj} //= DateTime::Format::Strptime->new(
+ pattern => '%Y%m%dT%H%M%S',
+ time_zone => 'Europe/Berlin',
+ );
+
+ if ( $conf{journey} ) {
+ $self->parse_journey;
+ }
+ else {
+ $self->parse_board;
+ }
return $self;
}
@@ -339,7 +375,7 @@ sub new_p {
my ($content) = @_;
$self->{raw_json} = $self->{json}->decode($content);
$self->check_mgate;
- $self->parse_mgate;
+ $self->parse_board;
$promise->resolve($self);
return;
}
@@ -549,19 +585,44 @@ sub messages {
return @{ $self->{messages} };
}
-sub parse_mgate {
+sub parse_journey {
my ($self) = @_;
- $self->{results} = [];
-
if ( $self->{errstr} ) {
return $self;
}
- $self->{strptime_obj} //= DateTime::Format::Strptime->new(
- pattern => '%Y%m%dT%H%M%S',
- time_zone => 'Europe/Berlin',
+ my @locL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
+ my $journey = $self->{raw_json}{svcResL}[0]{res}{journey};
+ my @polyline;
+
+ if ( $journey->{poly} ) {
+ @polyline = decode_polyline( $journey->{poly}{crdEncYX} );
+ for my $ref ( @{ $journey->{poly}{ppLocRefL} // [] } ) {
+ my $poly = $polyline[ $ref->{ppIdx} ];
+ my $loc = $locL[ $ref->{locX} ];
+
+ $poly->{name} = $loc->{name};
+ $poly->{eva} = $loc->{extId} + 0;
+ }
+ }
+
+ $self->{result} = Travel::Status::DE::HAFAS::Journey->new(
+ common => $self->{raw_json}{svcResL}[0]{res}{common},
+ journey => $journey,
+ polyline => \@polyline,
+ hafas => $self,
);
+}
+
+sub parse_board {
+ my ($self) = @_;
+
+ $self->{results} = [];
+
+ if ( $self->{errstr} ) {
+ return $self;
+ }
my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] };
@@ -583,6 +644,11 @@ sub results {
return @{ $self->{results} };
}
+sub result {
+ my ($self) = @_;
+ return $self->{result};
+}
+
# static
sub get_services {
my @services;
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;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-02 06:13:41 +0000