From f3beaf2d9eb789a6f745d4606d2e95bbb5ad29ae Mon Sep 17 00:00:00 2001 From: Daniel Friesel Date: Sun, 2 Oct 2022 19:39:29 +0200 Subject: DB: Switch to mgate.exe API --- lib/Travel/Status/DE/HAFAS.pm | 335 +++++++++++++++++++++++++++++------ lib/Travel/Status/DE/HAFAS/Result.pm | 41 +---- 2 files changed, 286 insertions(+), 90 deletions(-) (limited to 'lib/Travel/Status/DE') 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 '{raw_xml} + if ( substr( $self->{raw_xml}, 0, 5 ) ne '{raw_xml} = '' - . $ref->{raw_xml} + . $self->{raw_xml} . ''; } @@ -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 are: The station or stop to report for, e.g. "Essen HBf" or "Alfredusbad, Essen (Ruhr)". Mandatory. -=item B => I
.I.I +=item B => I -Date to report for. Defaults to the current day. +Date and time to report for. Defaults to now. =item B => [I, I, ...] @@ -547,10 +772,6 @@ Request results from I, defaults to "DB". See B (and C<< hafas-m --list >>) for a list of supported services. -=item B