summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Build.PL4
-rw-r--r--Changelog35
-rwxr-xr-xbin/efa-m46
-rw-r--r--lib/Travel/Status/DE/EFA.pm46
-rw-r--r--lib/Travel/Status/DE/EFA/Departure.pm11
-rw-r--r--lib/Travel/Status/DE/EFA/Info.pm4
-rw-r--r--lib/Travel/Status/DE/EFA/Line.pm4
-rw-r--r--lib/Travel/Status/DE/EFA/Services.pm.PL10
-rw-r--r--lib/Travel/Status/DE/EFA/Stop.pm6
-rw-r--r--lib/Travel/Status/DE/EFA/Trip.pm111
-rw-r--r--lib/Travel/Status/DE/VRR.pm4
-rwxr-xr-xscripts/check-efa-urls4
-rw-r--r--t/21-vrr-ambig.t8
13 files changed, 237 insertions, 56 deletions
diff --git a/Build.PL b/Build.PL
index a5b2b85..a5eeab4 100644
--- a/Build.PL
+++ b/Build.PL
@@ -15,6 +15,10 @@ Module::Build->new(
},
module_name => 'Travel::Status::DE::VRR',
license => 'perl',
+ recommends => {
+ 'Cache::File' => 0,
+ 'GIS::Distance' => 0,
+ },
requires => {
'perl' => '5.10.1',
'Carp' => 0,
diff --git a/Changelog b/Changelog
index b18076f..69a5783 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,38 @@
+Travel::Status::DE::VRR 3.13 - Thu Jun 19 2025
+
+ * EFA->new_p: Return $self in case of error so that clients can access
+ place_candidates and name_candidates. This behaviour was already
+ documented, but not implemented.
+
+Travel::Status::DE::VRR 3.12 - Wed Jun 18 2025
+
+ * Departure->id: Include the scheduled departure time. This fixes cases
+ where the trip details (stopseq) endpoint would randomly return
+ yesterday's details or no usable data at all.
+ * efa-m: Trip detail mode now only accepts trip IDs obtained from v3.12+
+
+Travel::Status::DE::VRR 3.11 - Mon Jun 16 2025
+
+ * efa-m: Show occupancy in trip details
+ * Trip->route: Provide occupancy data
+
+Travel::Status::DE::VRR 3.10 - Sun Jun 15 2025
+
+ * Stop: Add is_cancelled accessor
+ * Add BEG, RVV service definitions
+ * Breaking change: $efa->name_candidates and $efa->place_candidates now
+ return lists of Travel::Status::DE::EFA::Stop objects rather than
+ just strings.
+
+Travel::Status::DE::VRR 3.09 - Sun Mar 23 2025
+
+ * Trip: Add polyline accessor
+
+Travel::Status::DE::VRR 3.08 - Sat Feb 08 2025
+
+ * EFA->new_p: Return $efa instance in rejected promise if it was
+ rejected after parsing (e.g. due to ambiguous name/place parameter)
+
Travel::Status::DE::VRR 3.07 - Mon Jan 27 2025
* Departure: Fix ->id accessor
diff --git a/bin/efa-m b/bin/efa-m
index c11cec1..0f7fb44 100755
--- a/bin/efa-m
+++ b/bin/efa-m
@@ -4,7 +4,7 @@ use warnings;
use 5.010;
use utf8;
-our $VERSION = '3.07';
+our $VERSION = '3.13';
binmode( STDOUT, ':encoding(utf-8)' );
@@ -99,12 +99,15 @@ if ($use_cache) {
my ( $place, $input, $coord, $stopseq, $stopfinder );
if ( @ARGV == 1 ) {
- if ( $ARGV[0] =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^)]*) [)] (.*) $ }x ) {
+ if ( $ARGV[0]
+ =~ m{ ^ ([^@]*) @ ([^@]*) [(] ([^T]*) T ([^)]*) [)] (.*) $ }x )
+ {
$stopseq = {
stateless => $1,
stop_id => $2,
date => $3,
- key => $4
+ time => $4,
+ key => $5
};
}
elsif ( $ARGV[0] =~ m{ ^ [?] (?<name> .*) $ }x ) {
@@ -233,7 +236,13 @@ sub format_route {
if ( $stop->delay ) {
$delay = sprintf( '(%+3d)', $stop->delay );
}
- if ( defined $stop->arr and defined $stop->dep ) {
+ if ( $stop->is_cancelled ) {
+ $output .= sprintf(
+ " --:-- %s %s %35s %s\n",
+ $delay, $occupancy, $stop->full_name, $stop->platform // q{},
+ );
+ }
+ elsif ( defined $stop->arr and defined $stop->dep ) {
if ( $stop->arr->epoch == $stop->dep->epoch ) {
$output .= sprintf(
" %5s %s %s %35s %s\n",
@@ -347,6 +356,7 @@ sub show_stopseq {
);
say q{};
+ my $occupancy_len = 0;
my $delay_len = 0;
my $inner_delay_len = 0;
my $max_delay = max map { abs( $_->delay // 0 ) } $trip->route;
@@ -354,16 +364,28 @@ sub show_stopseq {
$inner_delay_len = length($max_delay) + 1;
$delay_len = length( sprintf( '(%+d)', $max_delay ) ) + 1;
}
+ if ( first { $_->occupancy } $trip->route ) {
+ $occupancy_len = 2;
+ }
+
+ if ( first { $_->is_cancelled } $trip->route and $delay_len < 3 ) {
+ $delay_len = 3;
+ }
for my $stop ( $trip->route ) {
printf(
- "%s → %s%${delay_len}s %s (%s) %s\n",
+ "%s → %s%${delay_len}s %-${occupancy_len}s%s (%s) %s\n",
$stop->arr ? $stop->arr->strftime('%H:%M')
: q{ },
$stop->dep ? $stop->dep->strftime('%H:%M')
: q{ },
- $stop->delay ? sprintf( " (%+${inner_delay_len}d)", $stop->delay )
- : q{},
+ $stop->is_cancelled ? 'XX'
+ : (
+ $stop->delay
+ ? sprintf( " (%+${inner_delay_len}d)", $stop->delay )
+ : q{}
+ ),
+ $stop->occupancy ? format_occupancy( $stop->occupancy ) : q{},
$stop->full_name,
$stop->niveau,
$stop->platform
@@ -555,11 +577,15 @@ if ( my $err = $efa->errstr ) {
if ( $efa->place_candidates ) {
say 'You might want to try one of the following places:';
- say join( "\n", $efa->place_candidates );
+ for my $candidate ( $efa->place_candidates ) {
+ printf( "%d %s\n", $candidate->id_num, $candidate->name );
+ }
}
elsif ( $efa->name_candidates ) {
say 'You might want to try one of the following names:';
- say join( "\n", $efa->name_candidates );
+ for my $candidate ( $efa->name_candidates ) {
+ printf( "%d %s\n", $candidate->id_num, $candidate->name );
+ }
}
exit 2;
@@ -610,7 +636,7 @@ B<efa-m> [B<-s> I<service>] I<tripid>
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA.pm b/lib/Travel/Status/DE/EFA.pm
index 5d47565..be08b9a 100644
--- a/lib/Travel/Status/DE/EFA.pm
+++ b/lib/Travel/Status/DE/EFA.pm
@@ -5,7 +5,7 @@ use warnings;
use 5.010;
use utf8;
-our $VERSION = '3.07';
+our $VERSION = '3.13';
use Carp qw(confess cluck);
use DateTime;
@@ -54,7 +54,7 @@ sub new_p {
}
)->catch(
sub {
- my ($err) = @_;
+ my ( $err, $self ) = @_;
$promise->reject($err);
return;
}
@@ -206,6 +206,7 @@ sub new {
stop => $opt{stopseq}{stop_id},
tripCode => $opt{stopseq}{key},
date => $opt{stopseq}{date},
+ time => $opt{stopseq}{time},
coordOutputFormat => 'WGS84[DD.DDDDD]',
outputFormat => 'rapidJson',
useRealtime => '1',
@@ -412,15 +413,37 @@ sub check_for_ambiguous {
for my $m ( @{ $json->{dm}{message} // [] } ) {
if ( $m->{name} eq 'error' and $m->{value} eq 'name list' ) {
- $self->{errstr} = "ambiguous name parameter";
- $self->{name_candidates}
- = [ map { $_->{name} } @{ $json->{dm}{points} // [] } ];
+ $self->{errstr} = "ambiguous name parameter";
+ $self->{name_candidates} = [];
+ for my $point ( @{ $json->{dm}{points} // [] } ) {
+ my $place = $point->{ref}{place};
+ push(
+ @{ $self->{name_candidates} },
+ Travel::Status::DE::EFA::Stop->new(
+ place => $place,
+ full_name => $point->{name},
+ name => $point->{name} =~ s{\Q$place\E,? ?}{}r,
+ id_num => $point->{ref}{id},
+ )
+ );
+ }
return;
}
if ( $m->{name} eq 'error' and $m->{value} eq 'place list' ) {
- $self->{errstr} = "ambiguous name parameter";
- $self->{place_candidates}
- = [ map { $_->{name} } @{ $json->{dm}{points} // [] } ];
+ $self->{errstr} = "ambiguous name parameter";
+ $self->{place_candidates} = [];
+ for my $point ( @{ $json->{dm}{points} // [] } ) {
+ my $place = $point->{ref}{place};
+ push(
+ @{ $self->{place_candidates} },
+ Travel::Status::DE::EFA::Stop->new(
+ place => $place,
+ full_name => $point->{name},
+ name => $point->{name} =~ s{\Q$place\E,? ?}{}r,
+ id_num => $point->{ref}{id},
+ )
+ );
+ }
return;
}
}
@@ -605,6 +628,11 @@ sub results_dm {
my ($self) = @_;
my $json = $self->{response};
+ # Oh EFA, you so silly
+ if ( $json->{departureList} and ref( $json->{departureList} ) eq 'HASH' ) {
+ $json->{departureList} = [ $json->{departureList}{departure} ];
+ }
+
my @results;
for my $departure ( @{ $json->{departureList} // [] } ) {
push(
@@ -680,7 +708,7 @@ Travel::Status::DE::EFA - unofficial EFA departure monitor
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Departure.pm b/lib/Travel/Status/DE/EFA/Departure.pm
index 6dfe717..ec17a12 100644
--- a/lib/Travel/Status/DE/EFA/Departure.pm
+++ b/lib/Travel/Status/DE/EFA/Departure.pm
@@ -10,7 +10,7 @@ use Travel::Status::DE::EFA::Stop;
use parent 'Class::Accessor';
-our $VERSION = '3.07';
+our $VERSION = '3.13';
Travel::Status::DE::EFA::Departure->mk_ro_accessors(
qw(countdown datetime delay destination is_cancelled key line lineref mot
@@ -177,10 +177,11 @@ sub id {
return $self->{id} = sprintf( '%s@%d(%s)%d',
$self->stateless =~ s{ }{}gr,
- scalar $self->route_pre
- ? ( $self->route_pre )[0]->id_num
+ scalar $self->route_pre ? ( $self->route_pre )[0]->id_num
: $self->stop_id_num,
- $self->sched_datetime->strftime('%Y%m%d'),
+ ( scalar $self->route_pre and ( $self->route_pre )[0]->sched_dep )
+ ? ( $self->route_pre )[0]->sched_dep->strftime('%Y%m%dT%H:%M')
+ : $self->sched_datetime->strftime('%Y%m%dT%H:%M'),
$self->key );
}
@@ -303,7 +304,7 @@ departure received by Travel::Status::DE::EFA
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Info.pm b/lib/Travel/Status/DE/EFA/Info.pm
index 076b162..424c9f1 100644
--- a/lib/Travel/Status/DE/EFA/Info.pm
+++ b/lib/Travel/Status/DE/EFA/Info.pm
@@ -6,7 +6,7 @@ use 5.010;
use parent 'Class::Accessor';
-our $VERSION = '3.07';
+our $VERSION = '3.13';
Travel::Status::DE::EFA::Info->mk_ro_accessors(
qw(link_url link_text subject content subtitle additional_text));
@@ -58,7 +58,7 @@ Travel::Status::DE::EFA::Info - Information about a public transit stop
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Line.pm b/lib/Travel/Status/DE/EFA/Line.pm
index b4e7186..061c904 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 = '3.07';
+our $VERSION = '3.13';
Travel::Status::DE::EFA::Line->mk_ro_accessors(
qw(direction mot name number operator route type valid));
@@ -57,7 +57,7 @@ requested station
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Services.pm.PL b/lib/Travel/Status/DE/EFA/Services.pm.PL
index 1a22338..81027d7 100644
--- a/lib/Travel/Status/DE/EFA/Services.pm.PL
+++ b/lib/Travel/Status/DE/EFA/Services.pm.PL
@@ -35,6 +35,10 @@ sub load_instance {
# VRT: Encoding issues
# VVSt: NXDOMAIN
my %efa_instance = (
+ BEG => {
+ url => 'https://bahnland-bayern.de/efa',
+ name => 'Bayerische Eisenbahngesellschaft',
+ },
BSVG => {
url => 'https://bsvg.efa.de/bsvagstd',
name => 'Braunschweiger Verkehrs-GmbH',
@@ -60,6 +64,10 @@ my %efa_instance = (
name => 'Nahverkehr Westfalen-Lippe',
},
Rolph => { load_instance('de/rolph') },
+ RVV => {
+ url => 'https://efa.rvv.de/efa',
+ name => 'Regensburger Verkehrsverbund',
+ },
VAG => {
url => 'https://efa.vagfr.de/vagfr3',
name => 'Freiburger Verkehrs AG',
@@ -100,7 +108,7 @@ use warnings;
use 5.014;
use utf8;
-our $VERSION = '3.07';
+our $VERSION = '3.13';
# Most of these have been adapted from
# <https://github.com/public-transport/transport-apis> and
diff --git a/lib/Travel/Status/DE/EFA/Stop.pm b/lib/Travel/Status/DE/EFA/Stop.pm
index 30806a0..910111e 100644
--- a/lib/Travel/Status/DE/EFA/Stop.pm
+++ b/lib/Travel/Status/DE/EFA/Stop.pm
@@ -6,12 +6,12 @@ use 5.010;
use parent 'Class::Accessor';
-our $VERSION = '3.07';
+our $VERSION = '3.13';
Travel::Status::DE::EFA::Stop->mk_ro_accessors(
qw(sched_arr rt_arr arr arr_delay
sched_dep rt_dep dep dep_delay
- occupancy delay distance_m
+ occupancy delay distance_m is_cancelled
place name full_name id_num id_code latlon
platform niveau)
);
@@ -93,7 +93,7 @@ in a Travel::Status::DE::EFA::Result's route
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Trip.pm b/lib/Travel/Status/DE/EFA/Trip.pm
index 9d53487..5b86695 100644
--- a/lib/Travel/Status/DE/EFA/Trip.pm
+++ b/lib/Travel/Status/DE/EFA/Trip.pm
@@ -9,7 +9,7 @@ use Travel::Status::DE::EFA::Stop;
use parent 'Class::Accessor';
-our $VERSION = '3.07';
+our $VERSION = '3.13';
Travel::Status::DE::EFA::Trip->mk_ro_accessors(
qw(operator product product_class name line number type id dest_name dest_id)
@@ -24,7 +24,7 @@ sub new {
operator => $json->{operator}{name},
product => $json->{product}{name},
product_class => $json->{product}{class},
- polyline => $json->{coords},
+ polyline_raw => $conf{json}{leg}{coords},
name => $json->{name},
line => $json->{disassembledName},
number => $json->{properties}{trainNumber},
@@ -39,8 +39,10 @@ sub new {
time_zone => 'UTC'
),
};
- if ( ref( $ref->{polyline} ) eq 'ARRAY' and @{ $ref->{polyline} } == 1 ) {
- $ref->{polyline} = $ref->{polyline}[0];
+ if ( ref( $ref->{polyline_raw} ) eq 'ARRAY'
+ and @{ $ref->{polyline_raw} } == 1 )
+ {
+ $ref->{polyline_raw} = $ref->{polyline_raw}[0];
}
return bless( $ref, $obj );
}
@@ -48,13 +50,61 @@ sub new {
sub polyline {
my ( $self, %opt ) = @_;
- if ( $opt{fallback} and not @{ $self->{polyline} // [] } ) {
+ if ( $self->{polyline} ) {
+ return @{ $self->{polyline} };
+ }
+
+ if ( not @{ $self->{polyline_raw} // [] } ) {
+ if ( $opt{fallback} ) {
+ return map {
+ {
+ lat => $_->{latlon}[0],
+ lon => $_->{latlon}[1],
+ stop => $_,
+ }
+ } $self->route;
+ }
+ return;
+ }
+
+ $self->{polyline} = [ map { { lat => $_->[0], lon => $_->[1] } }
+ @{ $self->{polyline_raw} } ];
+ my $distance;
+
+ eval {
+ require GIS::Distance;
+ $distance = GIS::Distance->new;
+ };
- # TODO add $_->{id} as well?
- return map { $_->{latlon} } $self->route;
+ if ($distance) {
+ my %min_dist;
+ for my $stop ( $self->route ) {
+ for my $polyline_index ( 0 .. $#{ $self->{polyline} } ) {
+ my $pl = $self->{polyline}[$polyline_index];
+ my $dist = $distance->distance_metal(
+ $stop->{latlon}[0],
+ $stop->{latlon}[1],
+ $pl->{lat}, $pl->{lon}
+ );
+ if ( not $min_dist{ $stop->{id_code} }
+ or $min_dist{ $stop->{id_code} }{dist} > $dist )
+ {
+ $min_dist{ $stop->{id_code} } = {
+ dist => $dist,
+ index => $polyline_index,
+ };
+ }
+ }
+ }
+ for my $stop ( $self->route ) {
+ if ( $min_dist{ $stop->{id_code} } ) {
+ $self->{polyline}[ $min_dist{ $stop->{id_code} }{index} ]{stop}
+ = $stop;
+ }
+ }
}
- return @{ $self->{polyline} // [] };
+ return @{ $self->{polyline} };
}
sub parse_dt {
@@ -102,14 +152,16 @@ sub route {
sched_dep => $self->parse_dt( $stop->{departureTimePlanned} ),
rt_arr => $self->parse_dt( $stop->{arrivalTimeEstimated} ),
rt_dep => $self->parse_dt( $stop->{departureTimeEstimated} ),
- latlon => $stop->{coord},
- full_name => $name_full,
- name => $name,
- place => $place,
- niveau => $stop->{niveau},
- platform => $platform,
- id_code => $id_code,
- id_num => $id_num,
+ occupancy => $stop->{properties}{occupancy},
+ is_cancelled => $stop->{isCancelled},
+ latlon => $stop->{coord},
+ full_name => $name_full,
+ name => $name,
+ place => $place,
+ niveau => $stop->{niveau},
+ platform => $platform,
+ id_code => $id_code,
+ id_num => $id_num,
)
);
}
@@ -125,6 +177,9 @@ sub TO_JSON {
# lazy loading
$self->route;
+ # lazy loading
+ $self->polyline;
+
my $ret = { %{$self} };
delete $ret->{strptime_obj};
@@ -150,7 +205,7 @@ trip
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
@@ -214,6 +269,28 @@ Note: The EFA API requires a stop to be specified when requesting trip details.
The stops returned by this accessor appear to be limited to stops after the
requested stop; earlier ones may be missing.
+=item $journey->polyline(I<%opt>)
+
+List of geocoordinates that describe the trips's route.
+Each list entry is a hash with the following keys.
+
+=over
+
+=item * lon (longitude)
+
+=item * lat (latitude)
+
+=item * stop (Stop object for this location, if any. undef otherwise)
+
+=back
+
+Note that stop is not provided by the backend and instead inferred by this
+module.
+
+If the backend does not provide geocoordinates and this accessor was called
+with B< fallback > set to a true value, it returns the list of stop coordinates
+instead. Otherwise, it returns an empty list.
+
=back
=head2 INTERNAL
diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm
index ee21593..6782523 100644
--- a/lib/Travel/Status/DE/VRR.pm
+++ b/lib/Travel/Status/DE/VRR.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use 5.010;
-our $VERSION = '3.07';
+our $VERSION = '3.13';
use parent 'Travel::Status::DE::EFA';
@@ -43,7 +43,7 @@ Travel::Status::DE::VRR - unofficial VRR departure monitor.
=head1 VERSION
-version 3.07
+version 3.13
=head1 DESCRIPTION
diff --git a/scripts/check-efa-urls b/scripts/check-efa-urls
index 95314c0..3cb8a35 100755
--- a/scripts/check-efa-urls
+++ b/scripts/check-efa-urls
@@ -2,12 +2,14 @@
export PERL5LIB=lib
-checks="BSVG Braunschweig Hbf
+checks="BEG Dachau Dachau Bahnhof
+BSVG Braunschweig Hbf
DING Ulm Hbf
KVV Karlsruhe Hbf
LinzAG Linz/Donau Hbf
MVV München Hackerbrücke
NVBW Stuttgart Hbf (A.-Klett-Pl.)
+RVV Regensburg Hbf
VAG Schallstadt Bf
VGN Nürnberg Hbf
VMV Schwerin Hbf
diff --git a/t/21-vrr-ambig.t b/t/21-vrr-ambig.t
index a201d52..de03b30 100644
--- a/t/21-vrr-ambig.t
+++ b/t/21-vrr-ambig.t
@@ -27,11 +27,11 @@ is( $status->errstr, 'ambiguous name parameter', 'errstr ok' );
is_deeply( [ $status->place_candidates ], [], 'place candidates ok' );
is_deeply(
- [ $status->name_candidates ],
+ [ map { $_->id_num . ' ' . $_->full_name } $status->name_candidates ],
[
- 'Essen, Alfred-Krupp-Schule',
- 'Essen, Alfredbrücke',
- 'Essen, Alfredusbad'
+ '20009114 Essen, Alfred-Krupp-Schule',
+ '20009113 Essen, Alfredbrücke',
+ '20009115 Essen, Alfredusbad',
],
'name candidates ok'
);
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-04 10:47:23 +0000