summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Travel/Routing/DE/HAFAS.pm626
-rw-r--r--lib/Travel/Routing/DE/HAFAS/Connection.pm147
-rw-r--r--lib/Travel/Routing/DE/HAFAS/Connection/Section.pm115
-rw-r--r--lib/Travel/Routing/DE/HAFAS/Location.pm33
-rw-r--r--lib/Travel/Routing/DE/HAFAS/Utils.pm32
5 files changed, 953 insertions, 0 deletions
diff --git a/lib/Travel/Routing/DE/HAFAS.pm b/lib/Travel/Routing/DE/HAFAS.pm
new file mode 100644
index 0000000..aab45b3
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS.pm
@@ -0,0 +1,626 @@
+package Travel::Routing::DE::HAFAS;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+use utf8;
+
+use Carp qw(confess);
+use DateTime;
+use DateTime::Format::Strptime;
+use Digest::MD5 qw(md5_hex);
+use Encode qw(decode encode);
+use JSON;
+use LWP::UserAgent;
+use Travel::Routing::DE::HAFAS::Connection;
+use Travel::Routing::DE::HAFAS::Location;
+use Travel::Status::DE::HAFAS::Message;
+
+our $VERSION = '0.00';
+
+# {{{ Endpoint Definition
+
+my %hafas_instance = (
+ DB => {
+ stopfinder => 'https://reiseauskunft.bahn.de/bin/ajax-getstop.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]],
+ salt => 'bdI8UVj4' . '0K5fvxwf',
+ languages => [qw[de en fr es]],
+ request => {
+ client => {
+ id => 'DB',
+ v => '20100000',
+ type => 'IPH',
+ name => 'DB Navigator',
+ },
+ ext => 'DB.R21.12.a',
+ ver => '1.15',
+ auth => {
+ type => 'AID',
+ aid => 'n91dB8Z77' . 'MLdoR0K'
+ },
+ },
+ },
+ NAHSH => {
+ mgate => 'https://nah.sh.hafas.de/bin/mgate.exe',
+ stopfinder => 'https://nah.sh.hafas.de/bin/ajax-getstop.exe',
+ name => 'Nahverkehrsverbund Schleswig-Holstein',
+ productbits => [qw[ice ice ice regio s bus ferry u tram ondemand]],
+ request => {
+ client => {
+ id => 'NAHSH',
+ v => '3000700',
+ type => 'IPH',
+ name => 'NAHSHPROD',
+ },
+ ver => '1.16',
+ auth => {
+ type => 'AID',
+ aid => 'r0Ot9FLF' . 'NAFxijLW'
+ },
+ },
+ },
+ NASA => {
+ mgate => 'https://reiseauskunft.insa.de/bin/mgate.exe',
+ stopfinder => 'https://reiseauskunft.insa.de/bin/ajax-getstop.exe',
+ name => 'Nahverkehrsservice Sachsen-Anhalt',
+ productbits => [qw[ice ice regio regio regio tram bus ondemand]],
+ languages => [qw[de en]],
+ request => {
+ client => {
+ id => 'NASA',
+ v => '4000200',
+ type => 'IPH',
+ name => 'nasaPROD',
+ os => 'iPhone OS 13.1.2',
+ },
+ ver => '1.18',
+ auth => {
+ type => 'AID',
+ aid => 'nasa-' . 'apps',
+ },
+ lang => 'deu',
+ },
+ },
+ NVV => {
+ mgate => 'https://auskunft.nvv.de/auskunft/bin/app/mgate.exe',
+ stopfinder =>
+ 'https://auskunft.nvv.de/auskunft/bin/jp/ajax-getstop.exe',
+ name => 'Nordhessischer VerkehrsVerbund',
+ productbits =>
+ [qw[ice ic_ec regio s u tram bus bus ferry ondemand regio regio]],
+ request => {
+ client => {
+ id => 'NVV',
+ v => '5000300',
+ type => 'IPH',
+ name => 'NVVMobilPROD_APPSTORE',
+ os => 'iOS 13.1.2',
+ },
+ ext => 'NVV.6.0',
+ ver => '1.18',
+ auth => {
+ type => 'AID',
+ aid => 'Kt8eNOH7' . 'qjVeSxNA',
+ },
+ lang => 'deu',
+ },
+ },
+ 'ÖBB' => {
+ mgate => 'https://fahrplan.oebb.at/bin/mgate.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]],
+ request => {
+ client => {
+ id => 'OEBB',
+ v => '6030600',
+ type => 'IPH',
+ name => 'oebbPROD-ADHOC',
+ },
+ ver => '1.41',
+ auth => {
+ type => 'AID',
+ aid => 'OWDL4fE4' . 'ixNiPBBm',
+ },
+ lang => 'deu',
+ },
+ },
+ VBB => {
+ mgate => 'https://fahrinfo.vbb.de/bin/mgate.exe',
+ stopfinder => 'https://fahrinfo.vbb.de/bin/ajax-getstop.exe',
+ name => 'Verkehrsverbund Berlin-Brandenburg',
+ productbits => [qw[s u tram bus ferry ice regio]],
+ languages => [qw[de en]],
+ request => {
+ client => {
+ id => 'VBB',
+ type => 'WEB',
+ name => 'VBB WebApp',
+ l => 'vs_webapp_vbb',
+ },
+ ext => 'VBB.1',
+ ver => '1.33',
+ auth => {
+ type => 'AID',
+ aid => 'hafas-vb' . 'b-webapp',
+ },
+ lang => 'deu',
+ },
+ },
+ VBN => {
+ mgate => 'https://fahrplaner.vbn.de/bin/mgate.exe',
+ stopfinder => 'https://fahrplaner.vbn.de/hafas/ajax-getstop.exe',
+ name => 'Verkehrsverbund Bremen/Niedersachsen',
+ productbits => [qw[ice ice regio regio s bus ferry u tram ondemand]],
+ salt => 'SP31mBu' . 'fSyCLmNxp',
+ micmac => 1,
+ languages => [qw[de en]],
+ request => {
+ client => {
+ id => 'VBN',
+ v => '6000000',
+ type => 'IPH',
+ name => 'vbn',
+ },
+ ver => '1.42',
+ auth => {
+ type => 'AID',
+ aid => 'kaoxIXLn' . '03zCr2KR',
+ },
+ lang => 'deu',
+ },
+ },
+);
+
+# }}}
+# {{{ Constructors
+
+sub new {
+ my ( $obj, %conf ) = @_;
+ my $service = $conf{service};
+
+ my $ua = $conf{user_agent};
+
+ if ( not $ua ) {
+ my %lwp_options = %{ $conf{lwp_options} // { timeout => 10 } };
+ $ua = LWP::UserAgent->new(%lwp_options);
+ $ua->env_proxy;
+ }
+
+ if ( not( $conf{from_stop} and $conf{to_stop} ) ) {
+ confess('from_stop and to_stop must be specified');
+ }
+
+ if ( not defined $service ) {
+ $service = $conf{service} = 'DB';
+ }
+
+ if ( defined $service and not exists $hafas_instance{$service} ) {
+ confess("The service '$service' is not supported");
+ }
+
+ my $now = DateTime->now( time_zone => 'Europe/Berlin' );
+ my $self = {
+ active_service => $service,
+ cache => $conf{cache},
+ developer_mode => $conf{developer_mode},
+ exclusive_mots => $conf{exclusive_mots},
+ excluded_mots => $conf{excluded_mots},
+ messages => [],
+ results => [],
+ from_stop => $conf{from_stop},
+ to_stop => $conf{to_stop},
+ ua => $ua,
+ now => $now,
+ };
+
+ bless( $self, $obj );
+
+ my $req;
+
+ if (0) {
+ }
+ else {
+ my $date = ( $conf{datetime} // $now )->strftime('%Y%m%d');
+ my $time = ( $conf{datetime} // $now )->strftime('%H%M%S');
+
+ my ( $from_lid, $to_lid );
+ if ( $self->{from_stop} =~ m{ ^ [0-9]+ $ }x ) {
+ $from_lid = 'A=1@L=' . $self->{from_stop} . '@';
+ }
+ else {
+ $from_lid = 'A=1@O=' . $self->{from_stop} . '@';
+ }
+ if ( $self->{to_stop} =~ m{ ^ [0-9]+ $ }x ) {
+ $to_lid = 'A=1@L=' . $self->{to_stop} . '@';
+ }
+ else {
+ $to_lid = 'A=1@O=' . $self->{to_stop} . '@';
+ }
+
+ $req = {
+ svcReqL => [
+ {
+ meth => 'TripSearch',
+ req => {
+ depLocL => [ { lid => $from_lid } ],
+ arrLocL => [ { lid => $to_lid } ],
+ numF => 6,
+ maxChg => undef,
+ minChgTime => undef,
+ outFrwd => undef,
+ viaLocL => undef,
+ trfReq => {
+ cType => 'PK',
+ tvlrProf => [ { type => 'E' } ],
+ },
+ outDate => $date,
+ outTime => $time,
+ jnyFltrL => [
+ {
+ type => "PROD",
+ mode => "INC",
+ value => $self->mot_mask
+ }
+ ]
+ },
+ },
+ ],
+ %{ $hafas_instance{$service}{request} }
+ };
+ }
+
+ if ( $conf{language} ) {
+ $req->{lang} = $conf{language};
+ }
+
+ $self->{strptime_obj} //= DateTime::Format::Strptime->new(
+ pattern => '%Y%m%dT%H%M%S',
+ time_zone => 'Europe/Berlin',
+ );
+
+ my $json = $self->{json} = JSON->new->utf8;
+
+ # The JSON request is the cache key, so if we have a cache we must ensure
+ # that JSON serialization is deterministic.
+ if ( $self->{cache} ) {
+ $json->canonical;
+ }
+
+ $req = $json->encode($req);
+ $self->{post} = $req;
+
+ my $url = $conf{url} // $hafas_instance{$service}{mgate};
+
+ if ( my $salt = $hafas_instance{$service}{salt} ) {
+ if ( $hafas_instance{$service}{micmac} ) {
+ my $mic = md5_hex( $self->{post} );
+ my $mac = md5_hex( $mic . $salt );
+ $url .= "?mic=$mic&mac=$mac";
+ }
+ else {
+ $url .= '?checksum=' . md5_hex( $self->{post} . $salt );
+ }
+ }
+
+ if ( $conf{async} ) {
+ $self->{url} = $url;
+ return $self;
+ }
+
+ if ( $conf{json} ) {
+ $self->{raw_json} = $conf{json};
+ }
+ else {
+ if ( $self->{developer_mode} ) {
+ say "requesting $req from $url";
+ }
+
+ my ( $content, $error ) = $self->post_with_cache($url);
+
+ if ($error) {
+ $self->{errstr} = $error;
+ return $self;
+ }
+
+ if ( $self->{developer_mode} ) {
+ say decode( 'utf-8', $content );
+ }
+
+ $self->{raw_json} = $json->decode($content);
+ }
+
+ $self->check_mgate;
+ $self->parse_trips;
+
+ return $self;
+}
+
+sub new_p {
+ my ( $obj, %conf ) = @_;
+ my $promise = $conf{promise}->new;
+
+ if (
+ not( $conf{station}
+ or $conf{journey}
+ or $conf{geoSearch}
+ or $conf{locationSearch} )
+ )
+ {
+ return $promise->reject('station or journey flag must be passed');
+ }
+
+ my $self = $obj->new( %conf, async => 1 );
+ $self->{promise} = $conf{promise};
+
+ $self->post_with_cache_p( $self->{url} )->then(
+ sub {
+ my ($content) = @_;
+ $self->{raw_json} = $self->{json}->decode($content);
+ $self->check_mgate;
+ if ( $conf{journey} ) {
+ $self->parse_journey;
+ }
+ elsif ( $conf{geoSearch} or $conf{locationSearch} ) {
+ $self->parse_search;
+ }
+ else {
+ $self->parse_board;
+ }
+ if ( $self->errstr ) {
+ $promise->reject( $self->errstr, $self );
+ }
+ else {
+ $promise->resolve($self);
+ }
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $promise->reject($err);
+ return;
+ }
+ )->wait;
+
+ return $promise;
+}
+
+# }}}
+# {{{ Internal Helpers
+
+sub mot_mask {
+ my ($self) = @_;
+
+ my $service = $self->{active_service};
+ my $mot_mask = 2**@{ $hafas_instance{$service}{productbits} } - 1;
+
+ 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} );
+ }
+ }
+
+ return $mot_mask;
+}
+
+sub post_with_cache {
+ my ( $self, $url ) = @_;
+ my $cache = $self->{cache};
+
+ if ( $self->{developer_mode} ) {
+ say "POST $url";
+ }
+
+ if ($cache) {
+ my $content = $cache->thaw( $self->{post} );
+ if ($content) {
+ if ( $self->{developer_mode} ) {
+ say ' cache hit';
+ }
+ return ( ${$content}, undef );
+ }
+ }
+
+ if ( $self->{developer_mode} ) {
+ say ' cache miss';
+ }
+
+ my $reply = $self->{ua}->post(
+ $url,
+ 'Content-Type' => 'application/json',
+ Content => $self->{post}
+ );
+
+ if ( $reply->is_error ) {
+ return ( undef, $reply->status_line );
+ }
+ my $content = $reply->content;
+
+ if ($cache) {
+ say "freeeez";
+ $cache->freeze( $self->{post}, \$content );
+ }
+
+ return ( $content, undef );
+}
+
+sub post_with_cache_p {
+ my ( $self, $url ) = @_;
+ my $cache = $self->{cache};
+
+ if ( $self->{developer_mode} ) {
+ say "POST $url";
+ }
+
+ my $promise = $self->{promise}->new;
+
+ if ($cache) {
+ my $content = $cache->thaw( $self->{post} );
+ if ($content) {
+ if ( $self->{developer_mode} ) {
+ say ' cache hit';
+ }
+ return $promise->resolve( ${$content} );
+ }
+ }
+
+ if ( $self->{developer_mode} ) {
+ say ' cache miss';
+ }
+
+ $self->{ua}->post_p( $url, $self->{post} )->then(
+ sub {
+ my ($tx) = @_;
+ if ( my $err = $tx->error ) {
+ $promise->reject(
+ "POST $url returned HTTP $err->{code} $err->{message}");
+ return;
+ }
+ my $content = $tx->res->body;
+ if ($cache) {
+ $cache->freeze( $self->{post}, \$content );
+ }
+ $promise->resolve($content);
+ return;
+ }
+ )->catch(
+ sub {
+ my ($err) = @_;
+ $promise->reject($err);
+ return;
+ }
+ )->wait;
+
+ return $promise;
+}
+
+sub check_mgate {
+ my ($self) = @_;
+
+ if ( $self->{raw_json}{err} and $self->{raw_json}{err} ne 'OK' ) {
+ $self->{errstr} = $self->{raw_json}{errTxt}
+ // 'error code is ' . $self->{raw_json}{err};
+ $self->{errcode} = $self->{raw_json}{err};
+ }
+ elsif ( defined $self->{raw_json}{cInfo}{code}
+ and $self->{raw_json}{cInfo}{code} ne 'OK'
+ and $self->{raw_json}{cInfo}{code} ne 'VH' )
+ {
+ $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 parse_trips {
+ my ($self) = @_;
+
+ my @locL = map { Travel::Routing::DE::HAFAS::Location->new( loc => $_ ) }
+ @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
+
+ my @conL = @{ $self->{raw_json}{svcResL}[0]{res}{outConL} // [] };
+ for my $con (@conL) {
+ push(
+ @{ $self->{results} },
+ Travel::Routing::DE::HAFAS::Connection->new(
+ common => $self->{raw_json}{svcResL}[0]{res}{common},
+ locL => \@locL,
+ connection => $con,
+ hafas => $self,
+ )
+ );
+ }
+}
+
+sub add_message {
+ my ( $self, $json, $is_him ) = @_;
+
+ my $short = $json->{txtS};
+ my $text = $json->{txtN};
+ my $code = $json->{code};
+ my $prio = $json->{prio};
+
+ if ($is_him) {
+ $short = $json->{head};
+ $text = $json->{text};
+ $code = $json->{hid};
+ }
+
+ # Some backends use remL for operator information. We don't want that.
+ if ( $code eq 'OPERATOR' ) {
+ return;
+ }
+
+ for my $message ( @{ $self->{messages} } ) {
+ if ( $code eq $message->{code} and $text eq $message->{text} ) {
+ $message->{ref_count}++;
+ return $message;
+ }
+ }
+
+ my $message = Travel::Status::DE::HAFAS::Message->new(
+ short => $short,
+ text => $text,
+ code => $code,
+ prio => $prio,
+ is_him => $is_him,
+ ref_count => 1,
+ );
+ push( @{ $self->{messages} }, $message );
+ return $message;
+}
+
+# }}}
+# {{{ Public Functions
+
+sub errcode {
+ my ($self) = @_;
+
+ return $self->{errcode};
+}
+
+sub errstr {
+ my ($self) = @_;
+
+ return $self->{errstr};
+}
+
+sub messages {
+ my ($self) = @_;
+ return @{ $self->{messages} };
+}
+
+sub connections {
+ my ($self) = @_;
+ return @{ $self->{results} };
+}
+
+# }}}
diff --git a/lib/Travel/Routing/DE/HAFAS/Connection.pm b/lib/Travel/Routing/DE/HAFAS/Connection.pm
new file mode 100644
index 0000000..51e6f3e
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Connection.pm
@@ -0,0 +1,147 @@
+package Travel::Routing::DE::HAFAS::Connection;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+use DateTime::Duration;
+use Travel::Routing::DE::HAFAS::Utils;
+use Travel::Routing::DE::HAFAS::Connection::Section;
+
+our $VERSION = '0.00';
+
+Travel::Routing::DE::HAFAS::Connection->mk_ro_accessors(
+ qw(changes duration sched_dep rt_dep sched_arr rt_arr dep_datetime arr_datetime dep_platform arr_platform dep_loc arr_loc load)
+);
+
+# {{{ Constructor
+
+sub new {
+ my ( $obj, %opt ) = @_;
+
+ my $hafas = $opt{hafas};
+ my $connection = $opt{connection};
+ my $locs = $opt{locL};
+
+ # himL may only be present in departure monitor mode
+ my @remL = @{ $opt{common}{remL} // [] };
+ my @himL = @{ $opt{common}{himL} // [] };
+
+ my @msgL = @{ $connection->{msgL} // [] };
+ my @secL = @{ $connection->{secL} // [] };
+
+ my $date = $connection->{date};
+ my $duration = $connection->{dur};
+
+ $duration = DateTime::Duration->new(
+ hours => substr( $duration, 0, 2 ),
+ minutes => substr( $duration, 2, 2 ),
+ seconds => substr( $duration, 4, 2 ),
+ );
+
+ my @messages;
+ for my $msg (@msgL) {
+ if ( $msg->{type} eq 'REM' and defined $msg->{remX} ) {
+ push( @messages, $hafas->add_message( $remL[ $msg->{remX} ] ) );
+ }
+ elsif ( $msg->{type} eq 'HIM' and defined $msg->{himX} ) {
+ push( @messages, $hafas->add_message( $himL[ $msg->{himX} ], 1 ) );
+ }
+ else {
+ say "Unknown message type $msg->{type}";
+ }
+ }
+
+ my $strptime = DateTime::Format::Strptime->new(
+ pattern => '%Y%m%dT%H%M%S',
+ time_zone => 'Europe/Berlin'
+ );
+
+ my $sched_dep = $connection->{dep}{dTimeS};
+ my $rt_dep = $connection->{dep}{dTimeR};
+ my $sched_arr = $connection->{arr}{aTimeS};
+ my $rt_arr = $connection->{arr}{aTimeR};
+
+ for my $ts ( $sched_dep, $rt_dep, $sched_arr, $rt_arr ) {
+ if ($ts) {
+ $ts = handle_day_change(
+ date => $date,
+ time => $ts,
+ strp_obj => $strptime,
+ );
+ }
+ }
+
+ my @sections;
+ for my $sec (@secL) {
+ push(
+ @sections,
+ Travel::Routing::DE::HAFAS::Connection::Section->new(
+ common => $opt{common},
+ date => $date,
+ locL => $locs,
+ sec => $sec,
+ hafas => $hafas,
+ )
+ );
+ }
+
+ my $tco = {};
+ for my $tco_id ( @{ $connection->{dTrnCmpSX}{tcocX} // [] } ) {
+ my $tco_kv = $opt{common}{tcocL}[$tco_id];
+ $tco->{ $tco_kv->{c} } = $tco_kv->{r};
+ }
+
+ my $ref = {
+ duration => $duration,
+ changes => $connection->{chg},
+ sched_dep => $sched_dep,
+ rt_dep => $rt_dep,
+ sched_arr => $sched_arr,
+ rt_arr => $rt_arr,
+ dep_datetime => $rt_dep // $sched_dep,
+ arr_datetime => $rt_arr // $sched_arr,
+ dep_platform => $connection->{dep}{dPlatfR}
+ // $connection->{dep}{dPlatfS},
+ arr_platform => $connection->{arr}{aPlatfR}
+ // $connection->{arr}{aPlatfS},
+ dep_loc => $locs->[ $connection->{dep}{locX} ],
+ arr_loc => $locs->[ $connection->{arr}{locX} ],
+ load => $tco,
+ messages => \@messages,
+ sections => \@sections,
+ };
+
+ bless( $ref, $obj );
+
+ return $ref;
+}
+
+# }}}
+
+# {{{ Accessors
+
+sub messages {
+ my ($self) = @_;
+
+ if ( $self->{messages} ) {
+ return @{ $self->{messages} };
+ }
+ return;
+}
+
+sub sections {
+ my ($self) = @_;
+
+ if ( $self->{sections} ) {
+ return @{ $self->{sections} };
+ }
+ return;
+}
+
+# }}}
+
+1;
diff --git a/lib/Travel/Routing/DE/HAFAS/Connection/Section.pm b/lib/Travel/Routing/DE/HAFAS/Connection/Section.pm
new file mode 100644
index 0000000..6b85f1a
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Connection/Section.pm
@@ -0,0 +1,115 @@
+package Travel::Routing::DE::HAFAS::Connection::Section;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+use DateTime::Duration;
+use Travel::Routing::DE::HAFAS::Utils;
+
+our $VERSION = '0.00';
+
+Travel::Routing::DE::HAFAS::Connection::Section->mk_ro_accessors(
+ qw(type schep_dep rt_dep sched_arr rt_arr dep_datetime arr_datetime arr_delay dep_delay journey distance duration dep_loc arr_loc
+ operator id name category category_long class number line line_no load delay direction)
+);
+
+# {{{ Constructor
+
+sub new {
+ my ( $obj, %opt ) = @_;
+
+ my $hafas = $opt{hafas};
+ my $sec = $opt{sec};
+ my $date = $opt{date};
+ my $locs = $opt{locL};
+ my @prodL = @{ $opt{common}{prodL} // [] };
+
+ my $strptime = DateTime::Format::Strptime->new(
+ pattern => '%Y%m%dT%H%M%S',
+ time_zone => 'Europe/Berlin'
+ );
+
+ my $sched_dep = $sec->{dep}{dTimeS};
+ my $rt_dep = $sec->{dep}{dTimeR};
+ my $sched_arr = $sec->{arr}{aTimeS};
+ my $rt_arr = $sec->{arr}{aTimeR};
+
+ for my $ts ( $sched_dep, $rt_dep, $sched_arr, $rt_arr ) {
+ if ($ts) {
+ $ts = handle_day_change(
+ date => $date,
+ time => $ts,
+ strp_obj => $strptime,
+ );
+ }
+ }
+
+ my $ref = {
+ type => $sec->{type},
+ sched_dep => $sched_dep,
+ rt_dep => $rt_dep,
+ sched_arr => $sched_arr,
+ rt_arr => $rt_arr,
+ dep_datetime => $rt_dep // $sched_dep,
+ arr_datetime => $rt_arr // $sched_arr,
+ dep_loc => $locs->[ $sec->{dep}{locX} ],
+ arr_loc => $locs->[ $sec->{arr}{locX} ],
+ };
+
+ if ( $sched_dep and $rt_dep ) {
+ $ref->{dep_delay} = ( $rt_dep->epoch - $sched_dep->epoch ) / 60;
+ }
+
+ if ( $sched_arr and $rt_arr ) {
+ $ref->{arr_delay} = ( $rt_arr->epoch - $sched_arr->epoch ) / 60;
+ }
+
+ if ( $sec->{type} eq 'JNY' ) {
+
+ #operator id name type type_long class number line line_no load delay direction)
+ my $journey = $sec->{jny};
+ my $product = $prodL[ $journey->{prodX} ];
+ $ref->{id} = $journey->{jid};
+ $ref->{direction} = $journey->{dirTxt};
+ $ref->{name} = $product->{addName} // $product->{name};
+ $ref->{category} = $product->{prodCtx}{catOut};
+ $ref->{category_long} = $product->{prodCtx}{catOutL};
+ $ref->{class} = $product->{cls};
+ $ref->{number} = $product->{prodCtx}{num};
+ $ref->{line} = $ref->{name};
+ $ref->{line_no} = $product->{prodCtx}{line};
+
+ if ( $ref->{name}
+ and $ref->{category}
+ and $ref->{name} eq $ref->{category}
+ and $product->{nameS} )
+ {
+ $ref->{name} .= ' ' . $product->{nameS};
+ }
+ }
+ elsif ( $sec->{type} eq 'WALK' ) {
+ $ref->{distance} = $sec->{gis}{dist};
+ my $duration = $sec->{gis}{durS};
+ $ref->{duration} = DateTime::Duration->new(
+ hours => substr( $duration, 0, 2 ),
+ minutes => substr( $duration, 2, 2 ),
+ seconds => substr( $duration, 4, 2 ),
+ );
+ }
+
+ bless( $ref, $obj );
+
+ return $ref;
+}
+
+# }}}
+
+# {{{ Accessors
+
+# }}}
+
+1;
diff --git a/lib/Travel/Routing/DE/HAFAS/Location.pm b/lib/Travel/Routing/DE/HAFAS/Location.pm
new file mode 100644
index 0000000..170522c
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Location.pm
@@ -0,0 +1,33 @@
+package Travel::Routing::DE::HAFAS::Location;
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Class::Accessor';
+
+our $VERSION = '0.00';
+
+Travel::Routing::DE::HAFAS::Location->mk_ro_accessors(
+ qw(lid type name eva state coordinate));
+
+sub new {
+ my ( $obj, %opt ) = @_;
+
+ my $loc = $opt{loc};
+
+ my $ref = {
+ lid => $loc->{lid},
+ type => $loc->{type},
+ name => $loc->{name},
+ eva => 0 + $loc->{extId},
+ state => $loc->{state},
+ coordinate => $loc->{crd}
+ };
+
+ bless( $ref, $obj );
+
+ return $ref;
+}
+
+1;
diff --git a/lib/Travel/Routing/DE/HAFAS/Utils.pm b/lib/Travel/Routing/DE/HAFAS/Utils.pm
new file mode 100644
index 0000000..4b5bdb7
--- /dev/null
+++ b/lib/Travel/Routing/DE/HAFAS/Utils.pm
@@ -0,0 +1,32 @@
+package Travel::Routing::DE::HAFAS::Utils;
+
+# vim:foldmethod=marker
+
+use strict;
+use warnings;
+use 5.014;
+
+use parent 'Exporter';
+our @EXPORT = qw(handle_day_change);
+
+sub handle_day_change {
+ my (%opt) = @_;
+ my $datestr = $opt{date};
+ my $timestr = $opt{time};
+ my $offset_days = 0;
+
+ # timestr may include a day offset, resulting in DDHHMMSS
+ if ( length($timestr) == 8 ) {
+ $offset_days = substr( $timestr, 0, 2, q{} );
+ }
+
+ my $ts = $opt{strp_obj}->parse_datetime("${datestr}T${timestr}");
+
+ if ($offset_days) {
+ $ts->add( days => $offset_days );
+ }
+
+ return $ts;
+}
+
+1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-28 08:28:05 +0000