summaryrefslogtreecommitdiff
path: root/lib/Travel/Status
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status')
-rw-r--r--lib/Travel/Status/DE/HAFAS.pm335
-rw-r--r--lib/Travel/Status/DE/HAFAS/Result.pm41
2 files changed, 286 insertions, 90 deletions
diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm
index 839a599..2c2b6b5 100644
--- a/lib/Travel/Status/DE/HAFAS.pm
+++ b/lib/Travel/Status/DE/HAFAS.pm
@@ -10,6 +10,9 @@ no if $] >= 5.018, warnings => 'experimental::smartmatch';
use Carp qw(confess);
use DateTime;
use DateTime::Format::Strptime;
+use Digest::MD5 qw(md5_hex);
+use Encode qw(decode encode);
+use JSON;
use List::Util qw(any);
use LWP::UserAgent;
use POSIX qw(strftime);
@@ -33,9 +36,24 @@ my %hafas_instance = (
stopfinder => 'https://reiseauskunft.bahn.de/bin/ajax-getstop.exe',
trainsearch => 'https://reiseauskunft.bahn.de/bin/trainsearch.exe',
traininfo => 'https://reiseauskunft.bahn.de/bin/traininfo.exe',
+ mgate => 'https://reiseauskunft.bahn.de/bin/mgate.exe',
name => 'Deutsche Bahn',
- productbits =>
- [qw[ice ic_ec d regio s bus ferry u tram ondemand x x x x]],
+ productbits => [qw[ice ic_ec d regio s bus ferry u tram ondemand]],
+ salt => 'bdI8UVj4' . '0K5fvxwf',
+ request => {
+ client => {
+ id => 'DB',
+ v => '20100000',
+ type => 'IPH',
+ name => 'DB Navigator',
+ },
+ ext => 'DB.R21.12.a',
+ ver => '1.15',
+ auth => {
+ type => 'AID',
+ aid => 'n91dB8Z77MLdoR0K'
+ },
+ },
},
NAHSH => {
url => 'https://nah.sh.hafas.de/bin/stboard.exe',
@@ -50,17 +68,17 @@ my %hafas_instance = (
productbits => [qw[ice ice regio regio regio tram bus ondemand]],
},
NVV => {
- url => 'https://auskunft.nvv.de/auskunft/bin/jp/stboard.exe',
+ url => 'https://auskunft.nvv.de/auskunft/bin/jp/stboard.exe',
stopfinder =>
'https://auskunft.nvv.de/auskunft/bin/jp/ajax-getstop.exe',
- name => 'Nordhessischer VerkehrsVerbund',
+ name => 'Nordhessischer VerkehrsVerbund',
productbits =>
[qw[ice ic_ec regio s u tram bus bus ferry ondemand regio regio]],
},
'ÖBB' => {
- url => 'https://fahrplan.oebb.at/bin/stboard.exe',
- stopfinder => 'https://fahrplan.oebb.at/bin/ajax-getstop.exe',
- name => 'Österreichische Bundesbahnen',
+ url => 'https://fahrplan.oebb.at/bin/stboard.exe',
+ stopfinder => 'https://fahrplan.oebb.at/bin/ajax-getstop.exe',
+ name => 'Österreichische Bundesbahnen',
productbits =>
[qw[ice ice ice regio regio s bus ferry u tram ice ondemand ice]],
},
@@ -94,11 +112,6 @@ my %hafas_instance = (
sub new {
my ( $obj, %conf ) = @_;
-
- my $date = $conf{date} // strftime( '%d.%m.%Y', localtime(time) );
- my $time = $conf{time} // strftime( '%H:%M', localtime(time) );
- my $lang = $conf{language} // 'd';
- my $mode = $conf{mode} // 'dep';
my $service = $conf{service};
my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };
@@ -107,14 +120,12 @@ sub new {
$ua->env_proxy;
- my $reply;
-
if ( not $conf{station} ) {
confess('You need to specify a station');
}
if ( not defined $service and not defined $conf{url} ) {
- $service = 'DB';
+ $service = $conf{service} = 'DB';
}
if ( defined $service and not exists $hafas_instance{$service} ) {
@@ -123,6 +134,7 @@ sub new {
my $ref = {
active_service => $service,
+ arrivals => $conf{arrivals},
developer_mode => $conf{developer_mode},
exclusive_mots => $conf{exclusive_mots},
excluded_mots => $conf{excluded_mots},
@@ -130,41 +142,172 @@ sub new {
results => [],
station => $conf{station},
ua => $ua,
- post => {
- input => $conf{station},
- date => $date,
- time => $time,
- start => 'yes', # value doesn't matter, just needs to be set
- boardType => $mode,
- L => 'vs_java3',
- },
+ now => DateTime->now( time_zone => 'Europe/Berlin' ),
};
bless( $ref, $obj );
- $ref->set_productfilter;
+ if ( $hafas_instance{$service}{mgate} ) {
+ return $ref->new_mgate(%conf);
+ }
+ return $ref->new_legacy(%conf);
+}
+
+sub new_mgate {
+ my ( $self, %conf ) = @_;
+ my $json = JSON->new->utf8;
+ my $service = $conf{service};
+
+ my $now = $self->{now};
+ 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} . '@';
+ }
+ else {
+ $lid = 'A=1@O=' . $self->{station} . '@';
+ }
+
+ my $mot_mask = 1023;
+
+ my %mot_pos;
+ for my $i ( 0 .. $#{ $hafas_instance{$service}{productbits} } ) {
+ $mot_pos{ $hafas_instance{$service}{productbits}[$i] } = $i;
+ }
+
+ if ( my @mots = @{ $self->{exclusive_mots} // [] } ) {
+ $mot_mask = 0;
+ for my $mot (@mots) {
+ $mot_mask |= 1 << $mot_pos{$mot};
+ }
+ }
+
+ if ( my @mots = @{ $self->{excluded_mots} // [] } ) {
+ 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'
+ }
+ ],
+ client => {
+ id => 'DB',
+ v => '20100000',
+ type => 'IPH',
+ name => 'DB Navigator'
+ },
+ ext => 'DB.R21.12.a',
+ ver => '1.15',
+ auth => {
+ type => 'AID',
+ 'aid' => 'n91dB8Z77MLdoR0K'
+ }
+ };
+
+ $req = $json->encode($req);
+ $self->{post} = $req;
+
+ my $url = $conf{url} // $hafas_instance{$service}{mgate};
+
+ if ( my $salt = $hafas_instance{$service}{salt} ) {
+ $url .= '?checksum=' . md5_hex( $self->{post} . $salt );
+ }
+
+ if ( $conf{json} ) {
+ $self->{raw_json} = $conf{json};
+ }
+ else {
+ if ( $self->{developer_mode} ) {
+ say "requesting $req from $url";
+ }
+
+ my $reply = $self->{ua}->post(
+ $url,
+ 'Content-Type' => 'application/json',
+ Content => $self->{post}
+ );
+ if ( $reply->is_error ) {
+ $self->{errstr} = $reply->status_line;
+ return $self;
+ }
+
+ if ( $self->{developer_mode} ) {
+ say decode( 'utf-8', $reply->content );
+ }
+
+ $self->{raw_json} = $json->decode( $reply->content );
+ }
+
+ $self->check_mgate;
+ $self->parse_mgate;
+
+ return $self;
+}
+
+sub new_legacy {
+ my ( $self, %conf ) = @_;
+
+ my $now = $self->{now};
+ my $date = ( $conf{datetime} // $now )->strftime('%d.%m.%Y');
+ my $time = ( $conf{datetime} // $now )->strftime('%H:%M');
+ my $mode = $conf{arrivals} ? 'arr' : 'dep';
+ my $lang = 'd';
+ my $service = $conf{service};
+
+ $self->{post} = {
+ input => $conf{station},
+ date => $date,
+ time => $time,
+ start => 'yes', # value doesn't matter, just needs to be set
+ boardType => $mode,
+ L => 'vs_java3',
+ };
+
+ $self->set_productfilter;
my $url = ( $conf{url} // $hafas_instance{$service}{url} ) . "/${lang}n";
if ( $conf{xml} ) {
- $ref->{raw_xml} = $conf{xml};
+
+ # used for testing
+ $self->{raw_xml} = $conf{xml};
}
else {
- $reply = $ua->post( $url, $ref->{post} );
+ if ( $self->{developer_mode} ) {
+ say "requesting from $url";
+ }
+ my $reply = $self->{ua}->post( $url, $self->{post} );
if ( $reply->is_error ) {
- $ref->{errstr} = $reply->status_line;
- return $ref;
+ $self->{errstr} = $reply->status_line;
+ return $self;
}
- $ref->{raw_xml} = $reply->content;
+ $self->{raw_xml} = $reply->content;
}
# the interface often does not return valid XML (but it's close!)
- if ( substr( $ref->{raw_xml}, 0, 5 ) ne '<?xml' ) {
- $ref->{raw_xml}
+ if ( substr( $self->{raw_xml}, 0, 5 ) ne '<?xml' ) {
+ $self->{raw_xml}
= '<?xml version="1.0" encoding="iso-8859-15"?><wrap>'
- . $ref->{raw_xml}
+ . $self->{raw_xml}
. '</wrap>';
}
@@ -172,7 +315,7 @@ sub new {
# Returns invalid XML with tags inside HIMMessage's lead attribute.
# Fix this.
- $ref->{raw_xml}
+ $self->{raw_xml}
=~ s{ lead = " \K ( [^"]+ ) }{ $1 =~ s{ < [^>]+ > }{}grx }egx;
}
@@ -180,23 +323,23 @@ sub new {
# errors in delay="...") when setting the language to dutch/italian.
# No, I don't know why.
- eval { $ref->{tree} = XML::LibXML->load_xml( string => $ref->{raw_xml} ) };
+ eval { $self->{tree} = XML::LibXML->load_xml( string => $self->{raw_xml} ) };
if ( my $err = $@ ) {
- if ( $ref->{developer_mode} ) {
- say $ref->{raw_xml};
+ if ( $self->{developer_mode} ) {
+ say $self->{raw_xml};
}
- $ref->{errstr} = "Backend returned invalid XML: $err";
- return $ref;
+ $self->{errstr} = "Backend returned invalid XML: $err";
+ return $self;
}
- if ( $ref->{developer_mode} ) {
- say $ref->{tree}->toString(1);
+ if ( $self->{developer_mode} ) {
+ say $self->{tree}->toString(1);
}
- $ref->check_input_error;
- $ref->prepare_results;
- return $ref;
+ $self->check_input_error;
+ $self->prepare_results;
+ return $self;
}
sub set_productfilter {
@@ -254,7 +397,26 @@ sub check_input_error {
$self->{errcode} = $err->getAttribute('code');
}
- return;
+ return $self;
+}
+
+sub check_mgate {
+ my ($self) = @_;
+
+ if ( $self->{raw_json}{cInfo}{code} ne 'OK' ) {
+ $self->{errstr} = 'cInfo code is ' . $self->{raw_json}{cInfo}{code};
+ $self->{errcode} = $self->{raw_json}{cInfo}{code};
+ }
+ elsif ( @{ $self->{raw_json}{svcResL} // [] } == 0 ) {
+ $self->{errstr} = 'svcResL is empty';
+ }
+ elsif ( $self->{raw_json}{svcResL}[0]{err} ne 'OK' ) {
+ $self->{errstr}
+ = 'svcResL[0].err is ' . $self->{raw_json}{svcResL}[0]{err};
+ $self->{errcode} = $self->{raw_json}{svcResL}[0]{err};
+ }
+
+ return $self;
}
sub errcode {
@@ -289,7 +451,7 @@ sub similar_stops {
$self->{errstr} = $err;
return;
}
- return $sf->results;
+ return $self->results;
}
return;
}
@@ -333,9 +495,6 @@ sub prepare_results {
$self->{results} = [];
- $self->{datetime_now} //= DateTime->now(
- time_zone => 'Europe/Berlin',
- );
$self->{strptime_obj} //= DateTime::Format::Strptime->new(
pattern => '%d.%m.%YT%H:%M',
time_zone => 'Europe/Berlin',
@@ -388,13 +547,11 @@ sub prepare_results {
push(
@{ $self->{results} },
Travel::Status::DE::HAFAS::Result->new(
- sched_date => $date,
sched_datetime => $datetime,
- datetime_now => $self->{datetime_now},
+ datetime_now => $self->{now},
raw_delay => $delay,
raw_e_delay => $e_delay,
messages => \@messages,
- sched_time => $time,
train => $train,
operator => $operator,
route_end => $dest,
@@ -404,6 +561,74 @@ sub prepare_results {
)
);
}
+ return $self;
+}
+
+sub parse_mgate {
+ 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 @prodL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{prodL} // [] };
+ my @opL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{opL} // [] };
+ my @icoL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{icoL} // [] };
+ my @jnyL = @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] };
+
+ for my $result (@jnyL) {
+ my $date = $result->{date};
+ my $time_s
+ = $result->{stbStop}{ $self->{arrivals} ? 'aTimeS' : 'dTimeS' };
+ my $time_r
+ = $result->{stbStop}{ $self->{arrivals} ? 'aTimeR' : 'dTimeR' };
+ my $datetime_s
+ = $self->{strptime_obj}->parse_datetime("${date}T${time_s}");
+ my $datetime_r
+ = $time_r
+ ? $self->{strptime_obj}->parse_datetime("${date}T${time_r}")
+ : undef;
+ my $delay
+ = $datetime_r
+ ? ( $datetime_r->epoch - $datetime_s->epoch ) / 60
+ : undef;
+
+ my $destination = $result->{dirTxt};
+ my $is_cancelled = $result->{isCncl};
+ my $jid = $result->{jid};
+ my $platform = $result->{stbStop}{dPlatfS};
+ my $new_platform = $result->{stbStop}{dPlatfR};
+
+ my $product = $prodL[ $result->{prodX} ];
+ my $train = $product->{prodCtx}{name};
+ my $train_type = $product->{prodCtx}{catOutS};
+ my $line_no = $product->{prodCtx}{line};
+
+ push(
+ @{ $self->{results} },
+ Travel::Status::DE::HAFAS::Result->new(
+ sched_datetime => $datetime_s,
+ rt_datetime => $datetime_r,
+ datetime => $datetime_r // $datetime_s,
+ datetime_now => $self->{now},
+ delay => $delay,
+ is_cancelled => $is_cancelled,
+ train => $train,
+ route_end => $destination,
+ platform => $platform,
+ new_platform => $new_platform,
+ )
+ );
+ }
+ return $self;
}
sub results {
@@ -505,9 +730,9 @@ Supported I<opts> are:
The station or stop to report for, e.g. "Essen HBf" or
"Alfredusbad, Essen (Ruhr)". Mandatory.
-=item B<date> => I<dd>.I<mm>.I<yyyy>
+=item B<datetime> => I<DateTime object>
-Date to report for. Defaults to the current day.
+Date and time to report for. Defaults to now.
=item B<excluded_mots> => [I<mot1>, I<mot2>, ...]
@@ -547,10 +772,6 @@ Request results from I<service>, defaults to "DB".
See B<get_services> (and C<< hafas-m --list >>) for a list of supported
services.
-=item B<time> => I<hh>:I<mm>
-
-Time to report for. Defaults to now.
-
=item B<url> => I<url>
Request results from I<url>, defaults to the one belonging to B<service>.
diff --git a/lib/Travel/Status/DE/HAFAS/Result.pm b/lib/Travel/Status/DE/HAFAS/Result.pm
index 71f9d1e..1fc13ce 100644
--- a/lib/Travel/Status/DE/HAFAS/Result.pm
+++ b/lib/Travel/Status/DE/HAFAS/Result.pm
@@ -11,8 +11,8 @@ use parent 'Class::Accessor';
our $VERSION = '3.01';
Travel::Status::DE::HAFAS::Result->mk_ro_accessors(
- qw(sched_date date sched_datetime datetime info operator raw_e_delay
- raw_delay sched_time time train route_end)
+ qw(sched_date date sched_datetime datetime info is_cancelled operator delay
+ sched_time time train route_end)
);
sub new {
@@ -21,17 +21,16 @@ sub new {
my $ref = \%conf;
bless( $ref, $obj );
- if ( my $delay = $ref->delay ) {
- $ref->{datetime}
- = $ref->{sched_datetime}->clone->add( minutes => $delay );
- $ref->{date} = $ref->{datetime}->strftime('%d.%m.%Y');
- $ref->{time} = $ref->{datetime}->strftime('%H:%M');
+ if ( $ref->{delay} ) {
+ $ref->{datetime} = $ref->{rt_datetime};
}
else {
$ref->{datetime} = $ref->{sched_datetime};
- $ref->{date} = $ref->{sched_date};
- $ref->{time} = $ref->{sched_time};
}
+ $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;
}
@@ -56,21 +55,6 @@ sub countdown_sec {
return $self->{countdown_sec};
}
-sub delay {
- my ($self) = @_;
-
- if ( defined $self->{raw_e_delay} ) {
- return $self->{raw_e_delay};
- }
- if ( defined $self->{raw_delay}
- and $self->{raw_delay} ne q{-}
- and $self->{raw_delay} ne 'cancel' )
- {
- return $self->{raw_delay};
- }
- return;
-}
-
sub destination {
my ($self) = @_;
@@ -83,15 +67,6 @@ sub line {
return $self->{train};
}
-sub is_cancelled {
- my ($self) = @_;
-
- if ( $self->{raw_delay} and $self->{raw_delay} eq 'cancel' ) {
- return 1;
- }
- return 0;
-}
-
sub is_changed_platform {
my ($self) = @_;