diff options
-rw-r--r-- | Build.PL | 1 | ||||
-rw-r--r-- | COPYING | 2 | ||||
-rw-r--r-- | Changelog | 34 | ||||
-rw-r--r-- | README.md | 61 | ||||
-rwxr-xr-x | bin/efa-m | 165 | ||||
-rw-r--r-- | cpanfile | 13 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA.pm | 199 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Line.pm | 6 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Result.pm | 48 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Stop.pm | 31 | ||||
-rw-r--r-- | lib/Travel/Status/DE/VRR.pm | 11 | ||||
-rwxr-xr-x | scripts/check-efa-urls | 10 | ||||
-rwxr-xr-x | scripts/makedeb-docker-helper | 4 | ||||
-rw-r--r-- | t/20-vrr.t | 100 |
14 files changed, 400 insertions, 285 deletions
@@ -20,6 +20,7 @@ Module::Build->new( 'perl' => '5.10.1', 'Carp' => 0, 'Class::Accessor' => 0, + 'DateTime' => 0, 'Getopt::Long' => 0, 'List::Util' => 0, 'LWP::UserAgent' => 0, @@ -1,4 +1,4 @@ -Copyright (C) 2011-2014 Daniel Friesel <derf@finalrewind.org> +Copyright (C) 2011-2014 Birte Kristina Friesel <derf@finalrewind.org> All files in this distribution are licensed under the same terms as Perl itself. @@ -1,3 +1,37 @@ +Travel::Status::DE::VRR 2.00 - Sun Dec 03 2023 + + * New dependency: DateTime + * Result: Add datetime, sched_datetime, rt_datetime accessors. + * Result: Remove date, time, sched_date, sched_time accessors. + Use datetime->strftime('%H:%M') etc. instead. (BREAKING CHANGE) + * Stop: Add arr, dep accessors. + * Stop: Remove arr_date, arr_time, dep_date, dep_time accessors. + Use arr->strftime('%d.%m.%Y') etc. instead. (BREAKING CHANGE) + * efa-m: Remove --track-via option, its behaviour is now included in --via + (BREAKING CHANGE) + +Travel::Status::DE::VRR 1.24 - Sat Dec 02 2023 + + * EFA: Fix full_route creating route elements with invalid data + * efa-m: Fix -v / -V (as a consequence of the fix above) + +Travel::Status::DE::VRR 1.23 - Fri Nov 24 2023 + + * efa-m: Do not show free-text messages by default. Use the newly + introduced -Om option to show them + * efa-m: Show real-time departure rather than scheduled time + delay + * Result: Add train_type and train_name accessors + +Travel::Status::DE::VRR 1.22 - Sat Sep 02 2023 + + * Do not use now-deprecated smartmatch features + +Travel::Status::DE::VRR 1.21 - Sat Jul 22 2023 + + * Add service VRR3 + * Update service URLs for VVO, VRN + * Remove discontinued services SVV, TLEM, VBL, Verbundlinie, VOR + Travel::Status::DE::VRR 1.20 - Sun Mar 28 2021 * efa-m, EFA: Accept "stopID" stop type @@ -7,13 +7,10 @@ homepage](https://finalrewind.org/projects/Travel-Status-DE-VRR/) for details. ## Installation -efa-m is available as -[perl-travel-status-de-vrr-git](https://aur.archlinux.org/packages/perl-travel-status-de-vrr-git/) -in the archlinux User Repository (AUR). +You have five installation options: -For other distributions, you have four installation options: - -* Nightly `.deb` builds for Debian-based distributions +* `.deb` releases for Debian-based distributions +* finalrewind.org APT repository for Debian-based distributions * Installing the latest release from CPAN * Installation from source * Using a Docker image @@ -22,43 +19,61 @@ Except for Docker, __efa-m__ is available in your PATH after installation. You can run `efa-m --version` to verify this. Documentation is available via `man efa-m`. -### Nightly Builds for Debian +### Release Builds for Debian [lib.finalrewind.org/deb](https://lib.finalrewind.org/deb) provides Debian -packages of both development and release versions. Note that these are not part -of the official Debian repository and are not covered by its quality assurance -process. +packages of all release versions. Note that these are not part of the official +Debian repository and are not covered by its quality assurance process. To install the latest release, run: ``` wget https://lib.finalrewind.org/deb/libtravel-status-de-vrr-perl_latest_all.deb -sudo dpkg -i libtravel-status-de-vrr-perl_latest_all.deb -sudo apt --fix-broken install +sudo apt install ./libtravel-status-de-vrr-perl_latest_all.deb rm libtravel-status-de-vrr-perl_latest_all.deb ``` -For a (possibly broken) development snapshot of the Git master branch, run: +Uninstallation works as usual: ``` -wget https://lib.finalrewind.org/deb/libtravel-status-de-vrr-perl_dev_all.deb -sudo dpkg -i libtravel-status-de-vrr-perl_dev_all.deb -sudo apt --fix-broken install -rm libtravel-status-de-vrr-perl_dev_all.deb +sudo apt remove libtravel-status-de-vrr-perl ``` -Note that dpkg, unlike apt, does not automatically install missing -dependencies. If a dependency is not satisfied yet, `dpkg -i` will complain -about unmet dependencies and bail out. `apt --fix-broken install` installs -these dependencies and also silently finishes the Travel::Status::DE::VRR -installation. +### finalrewind.org APT repository -Uninstallation works as usual: +[lib.finalrewind.org/apt](https://lib.finalrewind.org/apt) provides an APT +repository with Debian packages of the latest release versions. Note that this +is not a Debian repository; it is operated under a best-effort SLA and if you +use it you will have to trust me not to screw up your system with bogus +packages. Also, note that the packages are not part of the official Debian +repository and are not covered by its quality assurance process. + +To set up the repository and install the latest Travel::Status::DE::VRR +release, run: + +``` +curl -s https://finalrewind.org/apt.asc | sudo tee /etc/apt/trusted.gpg.d/finalrewind.asc +echo 'deb https://lib.finalrewind.org/apt stable main' | sudo tee /etc/apt/sources.list.d/finalrewind.list +sudo apt update +sudo apt install libtravel-status-de-vrr-perl +``` + +Afterwards, `apt update` and `apt upgrade` will automatically install new +Travel::Status::DE::VRR releases. + +Uninstallation of Travel::Status::DE::VRR works as usual: ``` sudo apt remove libtravel-status-de-vrr-perl ``` +To remove the APT repository from your system, run: + +``` +sudo rm /etc/apt/trusted.gpg.d/finalrewind.asc \ + /etc/apt/sources.list.d/finalrewind.list +``` + ### Installation from CPAN Travel::Status::DE::VRR releases are published on the Comprehensive Perl @@ -4,25 +4,22 @@ use warnings; use 5.010; use utf8; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - -our $VERSION = '1.20'; +our $VERSION = '2.00'; binmode( STDOUT, ':encoding(utf-8)' ); -use Encode qw(decode); +use Encode qw(decode); use Getopt::Long qw(:config no_ignore_case bundling); -use List::Util qw(first max); +use List::Util qw(first max none); use Travel::Status::DE::EFA; my $efa_url = 'https://efa.vrr.de/vrr/XSLT_DM_REQUEST'; my $efa_encoding; -my ( $date, $time, $input_type, $list_lines, $offset, $relative_times ); -my ($full_routes); -my ( $filter_via, $track_via ); -my ( $timeout, $developer_mode ); -my ( @grep_lines, @grep_platforms, @grep_mots ); -my ( %edata, @edata_pre ); +my ( $date, $time, $input_type, $list_lines, $offset, $relative_times ); +my ( $full_routes, $filter_via ); +my ( $timeout, $developer_mode ); +my ( @grep_lines, @grep_platforms, @grep_mots ); +my ( %edata, @edata_pre ); my ( $list_services, $service, $discover_and_print, $discover ); my $efa; @@ -46,7 +43,7 @@ GetOptions( 'timeout=i' => \$timeout, 'u|efa-url=s' => \$efa_url, 'v|via=s' => \$filter_via, - 'V|track-via=s' => sub { $filter_via = $track_via = $_[1] }, + 'V|track-via=s' => \$filter_via, 'version' => \&show_version, 'devmode' => \$developer_mode, @@ -80,13 +77,12 @@ if ( $input =~ s{ ^ (?<type> address|poi|stop|stopID) : }{}x ) { } for my $efield (@edata_pre) { - given ($efield) { - when ('a') { $edata{route_after} = 1; $full_routes = 1 } - when ('b') { $edata{route_before} = 1; $full_routes = 1 } - when ('f') { $edata{fullroute} = 1; $full_routes = 1 } - when ('r') { $edata{route} = 1; $full_routes = 1 } - default { $edata{$efield} = 1 } - } + if ( $efield eq 'a' ) { $edata{route_after} = 1; $full_routes = 1 } + elsif ( $efield eq 'b' ) { $edata{route_before} = 1; $full_routes = 1 } + elsif ( $efield eq 'f' ) { $edata{fullroute} = 1; $full_routes = 1 } + elsif ( $efield eq 'r' ) { $edata{route} = 1; $full_routes = 1 } + elsif ( $efield eq 'm' ) { $edata{messages} = 1 } + else { $edata{$efield} = 1 } } if ($filter_via) { $full_routes = 1; @@ -94,7 +90,7 @@ if ($filter_via) { if ($service) { my $service_ref = first { lc( $_->{shortname} ) eq lc($service) } - Travel::Status::DE::EFA::get_efa_urls(); + Travel::Status::DE::EFA::get_efa_urls(); if ( not $service_ref ) { printf STDERR ( "Error: Unknown service '%s'. See 'efa-m --list' for a " @@ -149,6 +145,14 @@ sub show_version { exit 0; } +sub format_delay { + my ( $delay, $len ) = @_; + if ( $delay and $len ) { + return sprintf( "(%+${len}d)", $delay ); + } + return q{}; +} + sub format_route { my (@route) = @_; @@ -159,23 +163,35 @@ sub format_route { say 'BUG'; next; } - if ( not defined $stop->arr_time ) { - $output .= sprintf( " %5s %40s %s\n", - $stop->dep_time, $stop->name, $stop->platform, ); - } - elsif ( not defined $stop->dep_time ) { - $output .= sprintf( "%5s %40s %s\n", - $stop->arr_time, $stop->name, $stop->platform, ); + if ( defined $stop->arr and defined $stop->dep ) { + if ( $stop->arr->epoch == $stop->dep->epoch ) { + $output .= sprintf( + " %5s %40s %s\n", + $stop->arr->strftime('%H:%M'), + $stop->name, $stop->platform, + ); + } + else { + $output .= sprintf( + "%5s → %5s %40s %s\n", + $stop->arr->strftime('%H:%M'), + $stop->dep->strftime('%H:%M'), + $stop->name, $stop->platform, + ); + } } - elsif ( $stop->arr_time eq $stop->dep_time ) { - $output .= sprintf( " %5s %40s %s\n", - $stop->dep_time, $stop->name, $stop->platform, ); + elsif ( defined $stop->arr ) { + $output .= sprintf( + "%5s %40s %s\n", + $stop->arr->strftime('%H:%M'), + $stop->name, $stop->platform, + ); } - else { + elsif ( defined $stop->dep ) { $output .= sprintf( - "%5s → %5s %40s %s\n", - $stop->arr_time, $stop->dep_time, - $stop->name, $stop->platform, + " %5s %40s %s\n", + $stop->dep->strftime('%H:%M'), + $stop->name, $stop->platform, ); } } @@ -197,7 +213,7 @@ sub display_result { for my $line (@lines) { - if ( length( $line->[5] ) ) { + if ( $edata{messages} and length( $line->[5] ) ) { $line->[5] =~ tr{\n\x0d}{ }s; chomp $line->[5]; print "\n"; @@ -224,13 +240,13 @@ sub show_lines { for my $l ( $efa->lines ) { - if ( ( @grep_lines and not( $l->name ~~ \@grep_lines ) ) - or ( @grep_mots and not( $l->mot_name ~~ \@grep_mots ) ) ) + if ( ( @grep_lines and none { $l->name eq $_ } @grep_lines ) + or ( @grep_mots and none { $l->mot_name eq $_ } @grep_mots ) ) { next; } - if ( @grep_mots and not( $l->mot_name ~~ \@grep_mots ) ) { + if ( @grep_mots and none { $l->mot_name eq $_ } @grep_mots ) { next; } @@ -247,6 +263,17 @@ sub show_lines { sub show_results { my @output; + my $delay_len = 0; + my $delay_fmt = 0; + for my $d ( $efa->results ) { + if ( $d->delay ) { + $delay_len = max( $delay_len, length( $d->delay ) + 1 ); + } + } + if ($delay_len) { + $delay_fmt = $delay_len + 3; + } + for my $d ( $efa->results ) { my @output_line; @@ -254,7 +281,7 @@ sub show_results { my $dtime = ( $relative_times ? sprintf( '%2d min', $d->countdown ) - : $d->sched_time + : $d->datetime->strftime('%H:%M') ); if ( $d->platform_db ) { @@ -262,10 +289,10 @@ sub show_results { } if ( - ( @grep_lines and not( $d->line ~~ \@grep_lines ) ) - or ( @grep_mots and not( $d->mot_name ~~ \@grep_mots ) ) + ( @grep_lines and none { $d->line eq $_ } @grep_lines ) + or ( @grep_mots and none { $d->mot_name eq $_ } @grep_mots ) or ( @grep_platforms - and not( $platform ~~ \@grep_platforms ) ) + and none { $platform eq $_ } @grep_platforms ) or ( $offset and $d->countdown < $offset ) or ( $filter_via and @@ -280,24 +307,27 @@ sub show_results { next; } else { - $dtime .= ' CANCELED'; + $dtime = '--:--'; } } - elsif ($track_via) { + elsif ($filter_via) { my $via = first { $_->name =~ m{$filter_via}io } $d->route_post; - $dtime .= ' → ' . $via->arr_time; + $dtime + .= ' → ' + . $via->arr->clone->add( minutes => $d->delay // 0 ) + ->strftime('%H:%M'); } if ( $d->delay ) { - if ($relative_times) { - $dtime .= ' (+' . $d->delay . ')'; - } - else { - $dtime .= ' +' . $d->delay; - } + $dtime .= ' ' . format_delay( $d->delay, $delay_len ); + } + + my $line = $d->line; + if ( length($line) > 10 and $d->train_type and $d->train_no ) { + $line = $d->train_type . ' ' . $d->train_no; } @output_line - = ( $dtime, $platform, $d->line, q{}, $d->destination, $d->info ); + = ( $dtime, $platform, $line, q{}, $d->destination, $d->info ); if ( $edata{route} ) { $output_line[3] @@ -396,7 +426,7 @@ B<efa-m> [B<-Lr>] [B<-d> I<dd.mm.yyyy>] [B<-t> I<hh:mm>] =head1 VERSION -version 1.20 +version 2.00 =head1 DESCRIPTION @@ -513,6 +543,12 @@ Show up to three stops between the requested station and the departure's destination. B<efa-m> tries to display the three most important stops, however these are heuristically determined and may not be optimal. +=item m / messages + +Show free-text messages associated with individual departures. These can +include generic information such is bicycle transportation options or Wi-Fi +availability, delay reasons, and more. + =back =item B<-p>, B<--platform> I<platforms> @@ -549,15 +585,10 @@ value to disable it. =item B<-v>, B<--via> I<station> -Only show trains serving I<station> after the requseted stop. I<station> -is matched against the "I<city> I<stop>" fields in each line's route. -Regular expressions are also supported. - -=item B<-V>, B<--track-via> I<station> - -Lik B<--via>: Only show trains serving I<station> after the requseted stop. -Also, show the arrival time at I<station> after the departure time at the -current stop. +Only show trains serving I<station> after the requseted stop, and show the +arrival time at I<station> after the departure time at the current stop. +I<station> is matched against the "I<city> I<stop>" fields in each line's +route. Regular expressions are also supported. =item B<--version> @@ -597,9 +628,17 @@ choose the appropriate EFA URL for these by itself. In these cases, you should find an appropriate EFA service using the B<-D>/B<--discover> option and then use B<-s> I<service> when making requests. +=over + +=item * EFA does not provide real-time data for the routes of requested +departures. Hence, B<--via> estimates the arrival time from scheduled +departure and departure delay + +=back + =head1 AUTHOR -Copyright (C) 2011-2020 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..7f75d31 --- /dev/null +++ b/cpanfile @@ -0,0 +1,13 @@ +requires 'Carp'; +requires 'Class::Accessor'; +requires 'DateTime'; +requires 'Getopt::Long'; +requires 'List::Util'; +requires 'LWP::UserAgent'; +requires 'LWP::Protocol::https'; +requires 'XML::LibXML'; + +on test => sub { + requires 'File::Slurp'; + requires 'Test::More'; +}; diff --git a/lib/Travel/Status/DE/EFA.pm b/lib/Travel/Status/DE/EFA.pm index 681b8b1..56a870d 100644 --- a/lib/Travel/Status/DE/EFA.pm +++ b/lib/Travel/Status/DE/EFA.pm @@ -5,11 +5,10 @@ use warnings; use 5.010; use utf8; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - -our $VERSION = '1.20'; +our $VERSION = '2.00'; use Carp qw(confess cluck); +use DateTime; use Encode qw(encode); use Travel::Status::DE::EFA::Line; use Travel::Status::DE::EFA::Result; @@ -34,7 +33,9 @@ sub new { if ( not( $opt{name} ) ) { confess('You must specify a name'); } - if ( $opt{type} and not( $opt{type} ~~ [qw[stop stopID address poi]] ) ) { + if ( $opt{type} + and not( $opt{type} =~ m{ ^ (?: stop stopID address poi ) $ }x ) ) + { confess('type must be stop, stopID, address, or poi'); } @@ -194,33 +195,6 @@ sub place_candidates { return; } -sub sprintf_date { - my ($e) = @_; - - if ( $e->getAttribute('day') == -1 ) { - return; - } - - return sprintf( '%02d.%02d.%d', - $e->getAttribute('day'), - $e->getAttribute('month'), - $e->getAttribute('year'), - ); -} - -sub sprintf_time { - my ($e) = @_; - - if ( $e->getAttribute('minute') == -1 ) { - return; - } - - return sprintf( '%02d:%02d', - $e->getAttribute('hour'), - $e->getAttribute('minute'), - ); -} - sub check_for_ambiguous { my ($self) = @_; @@ -332,7 +306,7 @@ sub lines { my $type = $e_info->getAttribute('name'); my $mot = $e->getAttribute('motType'); my $route = ( $e_route ? $e_route->textContent : undef ); - my $operator = ( $e_oper ? $e_oper->textContent : undef ); + my $operator = ( $e_oper ? $e_oper->textContent : undef ); my $identifier = $e->getAttribute('stateless'); push( @@ -368,17 +342,45 @@ sub parse_route { my @dates = $e->findnodes($xp_routepoint_date); my @times = $e->findnodes($xp_routepoint_time); + my ( $arr, $dep ); + # note that the first stop has an arrival node with an invalid # timestamp and the terminal stop has a departure node with an - # invalid timestamp. sprintf_{date,time} return undef in these - # cases. + # invalid timestamp. + + if ( $dates[0] and $times[0] and $dates[0]->getAttribute('day') != -1 ) + { + $arr = DateTime->new( + year => $dates[0]->getAttribute('year'), + month => $dates[0]->getAttribute('month'), + day => $dates[0]->getAttribute('day'), + hour => $times[0]->getAttribute('hour'), + minute => $times[0]->getAttribute('minute'), + second => $times[0]->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } + + if ( $dates[-1] + and $times[-1] + and $dates[-1]->getAttribute('day') != -1 ) + { + $dep = DateTime->new( + year => $dates[-1]->getAttribute('year'), + month => $dates[-1]->getAttribute('month'), + day => $dates[-1]->getAttribute('day'), + hour => $times[-1]->getAttribute('hour'), + minute => $times[-1]->getAttribute('minute'), + second => $times[-1]->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } + push( @ret, Travel::Status::DE::EFA::Stop->new( - arr_date => sprintf_date( $dates[0] ), - arr_time => sprintf_time( $times[0] ), - dep_date => sprintf_date( $dates[-1] ), - dep_time => sprintf_time( $times[-1] ), + arr => $arr, + dep => $dep, name => $e->getAttribute('name'), name_suf => $e->getAttribute('nameWO'), platform => $e->getAttribute('platformName'), @@ -432,17 +434,39 @@ sub results { next; } - my $date = sprintf_date($e_date); - my $time = sprintf_time($e_time); + my ( $sched_dt, $real_dt ); + + if ( $e_date and $e_time and $e_date->getAttribute('day') != -1 ) { + $sched_dt = DateTime->new( + year => $e_date->getAttribute('year'), + month => $e_date->getAttribute('month'), + day => $e_date->getAttribute('day'), + hour => $e_time->getAttribute('hour'), + minute => $e_time->getAttribute('minute'), + second => $e_time->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } - my $rdate = $e_rdate ? sprintf_date($e_rdate) : $date; - my $rtime = $e_rtime ? sprintf_time($e_rtime) : $time; + if ( $e_rdate and $e_rtime and $e_rdate->getAttribute('day') != -1 ) { + $real_dt = DateTime->new( + year => $e_rdate->getAttribute('year'), + month => $e_rdate->getAttribute('month'), + day => $e_rdate->getAttribute('day'), + hour => $e_rtime->getAttribute('hour'), + minute => $e_rtime->getAttribute('minute'), + second => $e_rtime->getAttribute('second') // 0, + time_zone => 'Europe/Berlin' + ); + } my $platform = $e->getAttribute('platform'); my $platform_name = $e->getAttribute('platformName'); my $countdown = $e->getAttribute('countdown'); my $occupancy = $e->getAttribute('occupancy'); my $line = $e_line->getAttribute('number'); + my $train_type = $e_line->getAttribute('trainType'); + my $train_name = $e_line->getAttribute('trainName'); my $train_no = $e_line->getAttribute('trainNum'); my $dest = $e_line->getAttribute('direction'); my $info = $e_info->textContent; @@ -494,26 +518,26 @@ sub results { push( @results, Travel::Status::DE::EFA::Result->new( - date => $rdate, - time => $rtime, - platform => $platform, - platform_db => $platform_is_db, - platform_name => $platform_name, - key => $key, - lineref => $line_obj[0] // undef, - line => $line, - train_no => $train_no, - destination => $dest, - occupancy => $occupancy, - countdown => $countdown, - info => $info, - delay => $delay, - sched_date => $date, - sched_time => $time, - type => $type, - mot => $mot, - prev_route => \@prev_route, - next_route => \@next_route, + rt_datetime => $real_dt, + platform => $platform, + platform_db => $platform_is_db, + platform_name => $platform_name, + key => $key, + lineref => $line_obj[0] // undef, + line => $line, + train_type => $train_type, + train_name => $train_name, + train_no => $train_no, + destination => $dest, + occupancy => $occupancy, + countdown => $countdown, + info => $info, + delay => $delay, + sched_datetime => $sched_dt, + type => $type, + mot => $mot, + prev_route => \@prev_route, + next_route => \@next_route, ) ); } @@ -563,39 +587,11 @@ sub get_efa_urls { name => 'Nahverkehrsgesellschaft Baden-Württemberg', shortname => 'NVBW', }, - - # HTTPS not supported - { - url => 'http://efa.svv-info.at/sbs/XSLT_DM_REQUEST', - name => 'Salzburger Verkehrsverbund', - shortname => 'SVV', - }, - - # HTTPS: invalid certificate - { - url => 'http://www.travelineeastmidlands.co.uk/em/XSLT_DM_REQUEST', - name => 'Traveline East Midlands', - shortname => 'TLEM', - }, { url => 'https://efa.vagfr.de/vagfr3/XSLT_DM_REQUEST', name => 'Freiburger Verkehrs AG', shortname => 'VAG', }, - - # HTTPS: unsupported protocol - { - url => 'http://mobil.vbl.ch/vblmobil/XML_DM_REQUEST', - name => 'Verkehrsbetriebe Luzern', - shortname => 'VBL', - }, - - # HTTPS not supported - { - url => 'http://fahrplan.verbundlinie.at/stv/XSLT_DM_REQUEST', - name => 'Verkehrsverbund Steiermark', - shortname => 'Verbundlinie', - }, { url => 'https://efa.vgn.de/vgnExt_oeffi/XML_DM_REQUEST', name => 'Verkehrsverbund Grossraum Nuernberg', @@ -609,15 +605,7 @@ sub get_efa_urls { shortname => 'VMV', }, { - url => 'https://efa.vor.at/wvb/XSLT_DM_REQUEST', - name => 'Verkehrsverbund Ost-Region', - shortname => 'VOR', - encoding => 'iso-8859-15', - }, - - # HTTPS not supported - { - url => 'http://fahrplanauskunft.vrn.de/vrn/XML_DM_REQUEST', + url => 'https://www.vrn.de/mngvrn//XML_DM_REQUEST', name => 'Verkehrsverbund Rhein-Neckar', shortname => 'VRN', }, @@ -636,10 +624,8 @@ sub get_efa_urls { name => 'Verkehrsverbund Rhein-Ruhr (alternative alternative)', shortname => 'VRR3', }, - - # HTTPS not supported { - url => 'http://efa.vvo-online.de:8080/dvb/XSLT_DM_REQUEST', + url => 'https://efa.vvo-online.de/VMSSL3/XSLT_DM_REQUEST', name => 'Verkehrsverbund Oberelbe', shortname => 'VVO', }, @@ -672,13 +658,14 @@ Travel::Status::DE::EFA - unofficial EFA departure monitor for my $d ($status->results) { printf( "%s %-8s %-5s %s\n", - $d->time, $d->platform_name, $d->line, $d->destination + $d->datetime->strftime('%H:%M'), + $d->platform_name, $d->line, $d->destination ); } =head1 VERSION -version 1.20 +version 2.00 =head1 DESCRIPTION @@ -804,6 +791,8 @@ None. =item * Class::Accessor(3pm) +=item * DateTime(3pm) + =item * LWP::UserAgent(3pm) =item * XML::LibXML(3pm) @@ -820,7 +809,7 @@ efa-m(1), Travel::Status::DE::EFA::Result(3pm). =head1 AUTHOR -Copyright (C) 2011-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/EFA/Line.pm b/lib/Travel/Status/DE/EFA/Line.pm index f5537fc..565ca53 100644 --- a/lib/Travel/Status/DE/EFA/Line.pm +++ b/lib/Travel/Status/DE/EFA/Line.pm @@ -6,7 +6,7 @@ use 5.010; use parent 'Class::Accessor'; -our $VERSION = '1.20'; +our $VERSION = '2.00'; Travel::Status::DE::EFA::Line->mk_ro_accessors( qw(direction mot name operator route type valid)); @@ -57,7 +57,7 @@ requested station =head1 VERSION -version 1.20 +version 2.00 =head1 DESCRIPTION @@ -151,7 +151,7 @@ Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2011-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/EFA/Result.pm b/lib/Travel/Status/DE/EFA/Result.pm index 5b07f97..ee1eafd 100644 --- a/lib/Travel/Status/DE/EFA/Result.pm +++ b/lib/Travel/Status/DE/EFA/Result.pm @@ -4,15 +4,14 @@ use strict; use warnings; use 5.010; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - use parent 'Class::Accessor'; -our $VERSION = '1.20'; +our $VERSION = '2.00'; Travel::Status::DE::EFA::Result->mk_ro_accessors( - qw(countdown date delay destination is_cancelled info key line lineref - mot occupancy operator platform platform_db platform_name sched_date sched_time time train_no type) + qw(countdown datetime delay destination is_cancelled info key line lineref + mot occupancy operator platform platform_db platform_name rt_datetime + sched_datetime train_type train_name train_no type) ); my @mot_mapping = qw{ @@ -33,6 +32,8 @@ sub new { $ref->{is_cancelled} = 0; } + $ref->{datetime} = $ref->{rt_datetime} // $ref->{sched_datetime}; + return bless( $ref, $obj ); } @@ -128,14 +129,14 @@ departure received by Travel::Status::DE::EFA for my $departure ($status->results) { printf( "At %s: %s to %s from platform %d\n", - $departure->time, $departure->line, $departure->destination, - $departure->platform + $departure->datetime->strftime('%H:%M'), $departure->line, + $departure->destination, $departure->platform ); } =head1 VERSION -version 1.20 +version 2.00 =head1 DESCRIPTION @@ -147,20 +148,19 @@ line number and destination. =head2 ACCESSORS -"Actual" in the description means that the delay (if available) is already -included in the calculation, "Scheduled" means it isn't. - =over =item $departure->countdown -Actual time in minutes from now until the tram/bus/train will depart. +Time in minutes from now until the tram/bus/train will depart, including +realtime data if available. If delay information is available, it is already included. -=item $departure->date +=item $departure->datetime -Actual departure date (DD.MM.YYYY). +DateTime(3pm) object for departure date and time. Realtime data if available, +schedule data otherwise. =item $departure->delay @@ -244,17 +244,23 @@ Each station is a Travel::Status::DE::EFA::Stop(3pm) object. List of stations the vehicle will pass after this stop. Each station is a Travel::Status::DE::EFA::Stop(3pm) object. -=item $departure->sched_date +=item $departure->rt_datetime + +DateTime(3pm) object holding the departure date and time according to +realtime data. Undef if unknown / unavailable. + +=item $departure->sched_datetime -Scheduled departure date (DD.MM.YYYY). +DateTime(3pm) object holding the scheduled departure date and time. -=item $departure->sched_time +=item $departure->train_type -Scheduled departure time (HH:MM). +Train type, e.g. "ICE". Typically only defined for long-distance trains. -=item $departure->time +=item $departure->train_name -Actual departure time (HH:MM). +Train name, e.g. "ICE International" or "InterCityExpresS" or "Deichgraf". +Typically only defined for long-distance trains. =item $departure->train_no @@ -335,7 +341,7 @@ Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2011-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/EFA/Stop.pm b/lib/Travel/Status/DE/EFA/Stop.pm index 4acc235..d313b9c 100644 --- a/lib/Travel/Status/DE/EFA/Stop.pm +++ b/lib/Travel/Status/DE/EFA/Stop.pm @@ -4,14 +4,12 @@ use strict; use warnings; use 5.010; -no if $] >= 5.018, warnings => 'experimental::smartmatch'; - use parent 'Class::Accessor'; -our $VERSION = '1.20'; +our $VERSION = '2.00'; Travel::Status::DE::EFA::Stop->mk_ro_accessors( - qw(arr_date arr_time dep_date dep_time name name_suf platform)); + qw(arr dep name name_suf platform)); sub new { my ( $obj, %conf ) = @_; @@ -41,14 +39,15 @@ in a Travel::Status::DE::EFA::Result's route for my $stop ($departure->route_post) { printf( "%s -> %s : %40s %s\n", - $stop->arr_time // q{ }, $stop->dep_time // q{ }, + $stop->arr ? $stop->arr->strftime('%H:%M') : q{--:--}, + $stop->dep ? $stop->dep->strftime('%H:%M') : q{--:--}, $stop->name, $stop->platform ); } =head1 VERSION -version 1.20 +version 2.00 =head1 DESCRIPTION @@ -62,21 +61,15 @@ delays or changed platforms are not taken into account. =over -=item $stop->arr_date - -arrival date (DD.MM.YYYY). undef if this is the first scheduled stop. - -=item $stop->arr_time - -arrival time (HH:MM). undef if this is the first scheduled stop. - -=item $stop->dep_date +=item $stop->arr -departure date (DD.MM.YYYY). undef if this is the final scehduled stop. +DateTime(3pm) object holding arrival date and time. undef if this is the +first scheduled stop. -=item $stop->dep_time +=item $stop->dep -departure time (HH:MM). undef if this is the final scehduled stop. +DateTime(3pm) object holding departure date and time. undef if this is the +final scheduled stop. =item $stop->name @@ -130,7 +123,7 @@ Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2015-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm index ee4a9fe..e6124bf 100644 --- a/lib/Travel/Status/DE/VRR.pm +++ b/lib/Travel/Status/DE/VRR.pm @@ -4,9 +4,7 @@ use strict; use warnings; use 5.010; -no if $] >= 5.018, warnings => "experimental::smartmatch"; - -our $VERSION = '1.20'; +our $VERSION = '2.00'; use parent 'Travel::Status::DE::EFA'; @@ -37,14 +35,15 @@ Travel::Status::DE::VRR - unofficial VRR departure monitor. for my $d ($status->results) { printf( "%s %d %-5s %s\n", - $d->time, $d->platform, $d->line, $d->destination + $d->datetime->strftime('%H:%M'), + $d->platform, $d->line, $d->destination ); } =head1 VERSION -version 1.20 +version 2.00 =head1 DESCRIPTION @@ -96,7 +95,7 @@ efa-m(1), Travel::Status::DE::EFA(3pm). =head1 AUTHOR -Copyright (C) 2013-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2013-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/scripts/check-efa-urls b/scripts/check-efa-urls index 6ae1473..95314c0 100755 --- a/scripts/check-efa-urls +++ b/scripts/check-efa-urls @@ -5,26 +5,22 @@ export PERL5LIB=lib checks="BSVG Braunschweig Hbf DING Ulm Hbf KVV Karlsruhe Hbf -LinzAG Linz Hbf +LinzAG Linz/Donau Hbf MVV München Hackerbrücke NVBW Stuttgart Hbf (A.-Klett-Pl.) -SVV Salzburg Hbf -TLEM London Waterloo East VAG Schallstadt Bf -VBL Luzern Bf -Verbundlinie Graz Hbf VGN Nürnberg Hbf VMV Schwerin Hbf -VOR Wien Hbf VRN Mannheim Hbf VRR Essen Hbf VRR2 Essen Hbf +VRR3 Essen Hbf VVO Dresden Hbf VVS Stuttgart Schwabstraße" echo $checks | while read service name place; do echo -n "${service} ... " - if bin/efa-m -s $service $name $place > /dev/null; then + if perl -Ilib bin/efa-m -s $service $name $place > /dev/null; then echo OK fi done diff --git a/scripts/makedeb-docker-helper b/scripts/makedeb-docker-helper index c249efd..ac9d639 100755 --- a/scripts/makedeb-docker-helper +++ b/scripts/makedeb-docker-helper @@ -8,8 +8,8 @@ export APT_LISTCHANGES_FRONTEND=none apt-get update apt-get -y install \ apt-file dh-make-perl libmodule-build-perl \ - libclass-accessor-perl libexception-class-perl libfile-slurp-perl \ - libwww-perl libxml-libxml-perl \ + libclass-accessor-perl libdatetime-perl libexception-class-perl \ + libfile-slurp-perl libwww-perl libxml-libxml-perl \ libtest-compile-perl libtest-pod-perl \ libtest-fatal-perl libtest-simple-perl @@ -4,7 +4,7 @@ use warnings; use 5.010; use utf8; -use Encode qw(decode); +use Encode qw(decode); use File::Slurp qw(slurp); use Test::More tests => 113; @@ -15,53 +15,83 @@ require_ok('Travel::Status::DE::VRR'); my $xml = slurp('t/in/essen_hb.xml'); -my $status = Travel::Status::DE::VRR->new_from_xml(xml => $xml); +my $status = Travel::Status::DE::VRR->new_from_xml( xml => $xml ); -isa_ok($status, 'Travel::Status::DE::EFA'); -can_ok($status, qw(errstr results)); +isa_ok( $status, 'Travel::Status::DE::EFA' ); +can_ok( $status, qw(errstr results) ); -is($status->errstr, undef, 'no error'); -is_deeply([$status->identified_data], [qw[Essen Hauptbahnhof]], 'identified_data'); +is( $status->errstr, undef, 'no error' ); +is_deeply( [ $status->identified_data ], + [qw[Essen Hauptbahnhof]], 'identified_data' ); my @results = $status->results; for my $result (@results) { - isa_ok($result, 'Travel::Status::DE::EFA::Result'); - can_ok($result, qw(date destination info line time type platform)); + isa_ok( $result, 'Travel::Status::DE::EFA::Result' ); + can_ok( $result, + qw(datetime destination info line type platform sched_datetime) ); } -is($results[0]->destination, 'Düsseldorf Hbf', 'first result: destination ok'); -is($results[0]->info, 'Bordrestaurant', 'first result: no info'); -is($results[0]->line, 'ICE 946 Intercity-Express', 'first result: line ok'); -is($results[0]->date, '16.11.2011', 'first result: real date ok'); -is($results[0]->time, '09:40', 'first result: real time ok'); -is($results[0]->delay, 4, 'first result: delay 4'); -is($results[0]->sched_date, '16.11.2011', 'first result: scheduled date ok'); -is($results[0]->sched_time, '09:36', 'first result: scheduled time ok'); -is($results[0]->mot_name, 'zug', 'first result: mot_name ok'); +is( $results[0]->destination, 'Düsseldorf Hbf', + 'first result: destination ok' ); +is( $results[0]->info, 'Bordrestaurant', 'first result: no info' ); +is( $results[0]->line, 'ICE 946 Intercity-Express', 'first result: line ok' ); +is( $results[0]->datetime->strftime('%d.%m.%Y'), + '16.11.2011', 'first result: real date ok' ); +is( $results[0]->datetime->strftime('%H:%M'), + '09:40', 'first result: real time ok' ); +is( $results[0]->delay, 4, 'first result: delay 4' ); +is( $results[0]->sched_datetime->strftime('%d.%m.%Y'), + '16.11.2011', 'first result: scheduled date ok' ); +is( $results[0]->sched_datetime->strftime('%H:%M'), + '09:36', 'first result: scheduled time ok' ); +is( $results[0]->mot_name, 'zug', 'first result: mot_name ok' ); + #is($results[0]->platform, '1', 'first result: platform ok'); #is($results[0]->platform_db, 1, 'first result: platform_db ok'); -is($results[3]->destination, 'Mülheim Heißen Kirche', 'fourth result: destination ok'); -is($results[3]->info, 'Ab (H) Heißen Kirche, Umstieg in den SEV Ri. Mülheim Hbf.', 'fourth result: no info'); -is($results[3]->line, '18', 'fourth result: line ok'); -is($results[3]->date, '16.11.2011', 'fourth result: real date ok'); -is($results[3]->time, '09:39', 'fourth result: real time ok'); -is($results[3]->delay, undef, 'fourth result: delay undef'); -is($results[3]->sched_date, '16.11.2011', 'fourth result: scheduled date ok'); -is($results[3]->sched_time, '09:39', 'fourth result: scheduled time ok'); -is($results[3]->mot_name, 'u-bahn', 'fourth result: mot_name ok'); +is( + $results[3]->destination, + 'Mülheim Heißen Kirche', + 'fourth result: destination ok' +); +is( + $results[3]->info, + 'Ab (H) Heißen Kirche, Umstieg in den SEV Ri. Mülheim Hbf.', + 'fourth result: no info' +); +is( $results[3]->line, '18', 'fourth result: line ok' ); +is( $results[3]->datetime->strftime('%d.%m.%Y'), + '16.11.2011', 'fourth result: real date ok' ); +is( $results[3]->datetime->strftime('%H:%M'), + '09:39', 'fourth result: real time ok' ); +is( $results[3]->delay, undef, 'fourth result: delay undef' ); +is( $results[3]->sched_datetime->strftime('%d.%m.%Y'), + '16.11.2011', 'fourth result: scheduled date ok' ); +is( $results[3]->sched_datetime->strftime('%H:%M'), + '09:39', 'fourth result: scheduled time ok' ); +is( $results[3]->mot_name, 'u-bahn', 'fourth result: mot_name ok' ); + #is($results[3]->platform, '2', 'fourth result: platform ok'); #is($results[3]->platform_db, 0, 'fourth result: platform_db ok'); -is($results[-1]->destination, 'Hamm (Westf)', 'last result: destination ok'); -is($results[-1]->info, 'Fahrradmitnahme begrenzt möglich', 'last result: info ok'); -is($results[-1]->delay, 12, 'last result: delay 12'); -is($results[-1]->line, 'RE1', 'last result: line ok'); -is($results[-1]->date, '16.11.2011', 'last result: date ok'); -is($results[-1]->time, '10:05', 'last result: time ok'); -is($results[-1]->sched_date, '16.11.2011', 'first result: scheduled date ok'); -is($results[-1]->sched_time, '09:53', 'last result: scheduled time ok'); -is($results[-1]->mot_name, 'zug', 'last result: mot_name ok'); +is( $results[-1]->destination, 'Hamm (Westf)', 'last result: destination ok' ); +is( + $results[-1]->info, + 'Fahrradmitnahme begrenzt möglich', + 'last result: info ok' +); +is( $results[-1]->delay, 12, 'last result: delay 12' ); +is( $results[-1]->line, 'RE1', 'last result: line ok' ); +is( $results[-1]->datetime->strftime('%d.%m.%Y'), + '16.11.2011', 'last result: date ok' ); +is( $results[-1]->datetime->strftime('%H:%M'), '10:05', + 'last result: time ok' ); +is( $results[-1]->sched_datetime->strftime('%d.%m.%Y'), + '16.11.2011', 'first result: scheduled date ok' ); +is( $results[-1]->sched_datetime->strftime('%H:%M'), + '09:53', 'last result: scheduled time ok' ); +is( $results[-1]->mot_name, 'zug', 'last result: mot_name ok' ); + #is($results[-1]->platform, '6', 'last result: platform ok'); #is($results[-1]->platform_db, 1, 'last result: platform ok'); |