From fd1ff5ad10e530661f59e3218dbf8ea97cfe4112 Mon Sep 17 00:00:00 2001 From: Birte Kristina Friesel Date: Tue, 31 Oct 2023 22:39:22 +0100 Subject: initial commit --- lib/Travel/Routing/DE/HAFAS.pm | 626 ++++++++++++++++++++++ lib/Travel/Routing/DE/HAFAS/Connection.pm | 147 +++++ lib/Travel/Routing/DE/HAFAS/Connection/Section.pm | 115 ++++ lib/Travel/Routing/DE/HAFAS/Location.pm | 33 ++ lib/Travel/Routing/DE/HAFAS/Utils.pm | 32 ++ 5 files changed, 953 insertions(+) create mode 100644 lib/Travel/Routing/DE/HAFAS.pm create mode 100644 lib/Travel/Routing/DE/HAFAS/Connection.pm create mode 100644 lib/Travel/Routing/DE/HAFAS/Connection/Section.pm create mode 100644 lib/Travel/Routing/DE/HAFAS/Location.pm create mode 100644 lib/Travel/Routing/DE/HAFAS/Utils.pm (limited to 'lib/Travel') 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; -- cgit v1.2.3