summaryrefslogtreecommitdiff
path: root/lib/Travel
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel')
-rw-r--r--lib/Travel/Status/DE/EFA.pm74
-rw-r--r--lib/Travel/Status/DE/EFA/Departure.pm40
-rw-r--r--lib/Travel/Status/DE/EFA/Info.pm6
-rw-r--r--lib/Travel/Status/DE/EFA/Line.pm6
-rw-r--r--lib/Travel/Status/DE/EFA/Services.pm.PL12
-rw-r--r--lib/Travel/Status/DE/EFA/Stop.pm19
-rw-r--r--lib/Travel/Status/DE/EFA/Trip.pm119
-rw-r--r--lib/Travel/Status/DE/VRR.pm6
8 files changed, 216 insertions, 66 deletions
diff --git a/lib/Travel/Status/DE/EFA.pm b/lib/Travel/Status/DE/EFA.pm
index f6f4151..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.04';
+our $VERSION = '3.13';
use Carp qw(confess cluck);
use DateTime;
@@ -45,7 +45,7 @@ sub new_p {
$self->check_for_ambiguous();
if ( $self->{errstr} ) {
- $promise->reject( $self->{errstr} );
+ $promise->reject( $self->{errstr}, $self );
return;
}
@@ -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;
}
}
@@ -441,7 +464,8 @@ sub stop {
place => $place,
full_name => $point->{name},
name => $point->{name} =~ s{\Q$place\E,? ?}{}r,
- id => $point->{stateless},
+ id_num => $point->{ref}{id},
+ id_code => $point->{ref}{gid},
);
return $self->{stop};
@@ -468,7 +492,8 @@ sub stops {
place => $stop->{place},
name => $stop->{name},
full_name => $stop->{nameWithPlace},
- id => $stop->{stopID},
+ id_num => $stop->{stopID},
+ id_code => $stop->{gid},
)
);
}
@@ -522,7 +547,7 @@ sub parse_line {
mot => $mode->{product},
operator => $mode->{diva}{operator},
identifier => $mode->{diva}{globalId},
- ,
+
);
}
@@ -557,7 +582,7 @@ sub results_coord {
full_name => $stop->{properties}{STOP_NAME_WITH_PLACE},
distance_m => $stop->{properties}{distance},
name => $stop->{name},
- id => $stop->{id},
+ id_code => $stop->{id},
)
);
}
@@ -588,8 +613,8 @@ sub results_stopfinder {
place => $stop->{ref}{place},
full_name => $stop->{name},
name => $stop->{object},
- id => $stop->{stateless},
- stop_id => $stop->{ref}{gid},
+ id_num => $stop->{ref}{id},
+ id_code => $stop->{ref}{gid},
)
);
}
@@ -603,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(
@@ -678,7 +708,7 @@ Travel::Status::DE::EFA - unofficial EFA departure monitor
=head1 VERSION
-version 3.04
+version 3.13
=head1 DESCRIPTION
@@ -769,8 +799,14 @@ Default: 10 seconds. Set to 0 or a negative value to disable it.
=item my $status_p = Travel::Status::DE::EFA->new_p(I<%opt>)
Returns a promise that resolves into a Travel::Status::DE::EFA instance
-($status) on success and rejects with an error message on failure. In addition
-to the arguments of B<new>, the following mandatory arguments must be set.
+($status) on success and rejects with an error message on failure. In case
+the error occured after construction of the Travel::Status::DE::EFA object
+(e.g. due to an ambiguous name/place parameter), the second argument of the
+rejected promise holds a Travel::Status::DE::EFA instance that can be used
+to query place/name candidates (see name_candidates and place_candidates).
+
+In addition to the arguments of B<new>, the following mandatory arguments must
+be set.
=over
@@ -902,7 +938,7 @@ efa-m(1), Travel::Status::DE::EFA::Departure(3pm).
=head1 AUTHOR
-Copyright (C) 2011-2024 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2011-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
=head1 LICENSE
diff --git a/lib/Travel/Status/DE/EFA/Departure.pm b/lib/Travel/Status/DE/EFA/Departure.pm
index 25bf4dc..ec17a12 100644
--- a/lib/Travel/Status/DE/EFA/Departure.pm
+++ b/lib/Travel/Status/DE/EFA/Departure.pm
@@ -10,12 +10,12 @@ use Travel::Status::DE::EFA::Stop;
use parent 'Class::Accessor';
-our $VERSION = '3.04';
+our $VERSION = '3.13';
Travel::Status::DE::EFA::Departure->mk_ro_accessors(
qw(countdown datetime delay destination is_cancelled key line lineref mot
occupancy operator origin platform platform_db platform_name rt_datetime
- sched_datetime stateless stop_id train_type train_name train_no type)
+ sched_datetime stateless stop_id_num train_type train_name train_no type)
);
my @mot_mapping = qw{
@@ -69,7 +69,7 @@ sub new {
platform_type => $departure->{pointType},
key => $departure->{servingLine}{key},
stateless => $departure->{servingLine}{stateless},
- stop_id => $departure->{stopID},
+ stop_id_num => $departure->{stopID},
line => $departure->{servingLine}{symbol},
train_type => $departure->{servingLine}{trainType},
train_name => $departure->{servingLine}{trainName},
@@ -154,7 +154,8 @@ sub parse_route {
sched_dep => $dep,
arr_delay => $ref->{arrValid} ? $ref->{arrDelay} : undef,
dep_delay => $ref->{depValid} ? $ref->{depDelay} : undef,
- id => $ref->{id},
+ id_num => $ref->{id},
+ id_code => $ref->{gid},
full_name => $stop->{name},
place => $stop->{place},
name => $stop->{nameWO},
@@ -167,6 +168,23 @@ sub parse_route {
return \@ret;
}
+sub id {
+ my ($self) = @_;
+
+ if ( $self->{id} ) {
+ return $self->{id};
+ }
+
+ return $self->{id} = sprintf( '%s@%d(%s)%d',
+ $self->stateless =~ s{ }{}gr,
+ scalar $self->route_pre ? ( $self->route_pre )[0]->id_num
+ : $self->stop_id_num,
+ ( 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 );
+}
+
sub hints {
my ($self) = @_;
@@ -248,6 +266,9 @@ sub route_interesting {
sub TO_JSON {
my ($self) = @_;
+ # compute on-demand keys
+ $self->id;
+
my $ret = { %{$self} };
delete $ret->{strp_stopseq};
@@ -283,7 +304,7 @@ departure received by Travel::Status::DE::EFA
=head1 VERSION
-version 3.04
+version 3.13
=head1 DESCRIPTION
@@ -324,6 +345,13 @@ Additional information related to the departure (list of strings). If
departures for an address were requested, this is the stop name, otherwise it
may be recent news related to the line's schedule.
+=item $departure->id
+
+Stringified unique(?) identifier of this departure; suitable for passing to
+Travel::Status::DE::EFA->new(stopseq) after decomposing it again.
+The returned string combines B<stateless>, B<stop_id_num> (or the ID of the first
+stop in B<route_pre>, if present), B<sched_datetime>, and B<key>.
+
=item $departure->is_cancelled
1 if the departure got cancelled, 0 otherwise.
@@ -493,7 +521,7 @@ Travel::Status::DE::EFA(3pm).
=head1 AUTHOR
-Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2011-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
=head1 LICENSE
diff --git a/lib/Travel/Status/DE/EFA/Info.pm b/lib/Travel/Status/DE/EFA/Info.pm
index 74a977b..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.04';
+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.04
+version 3.13
=head1 DESCRIPTION
@@ -120,7 +120,7 @@ Travel::Status::DE::EFA(3pm).
=head1 AUTHOR
-Copyright (C) 2024 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2024-2025 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 cded7f7..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.04';
+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.04
+version 3.13
=head1 DESCRIPTION
@@ -151,7 +151,7 @@ Travel::Status::DE::EFA(3pm).
=head1 AUTHOR
-Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2011-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
=head1 LICENSE
diff --git a/lib/Travel/Status/DE/EFA/Services.pm.PL b/lib/Travel/Status/DE/EFA/Services.pm.PL
index 1c9789d..81027d7 100644
--- a/lib/Travel/Status/DE/EFA/Services.pm.PL
+++ b/lib/Travel/Status/DE/EFA/Services.pm.PL
@@ -32,10 +32,13 @@ sub load_instance {
}
# GVH: 403
-# Rolph: 404
# 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 +63,11 @@ my %efa_instance = (
url => 'https://westfalenfahrplan.de/nwl-efa',
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.04';
+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 e5520b8..910111e 100644
--- a/lib/Travel/Status/DE/EFA/Stop.pm
+++ b/lib/Travel/Status/DE/EFA/Stop.pm
@@ -6,13 +6,13 @@ use 5.010;
use parent 'Class::Accessor';
-our $VERSION = '3.04';
+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
- place name full_name id stop_id latlon
+ 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.04
+version 3.13
=head1 DESCRIPTION
@@ -152,14 +152,13 @@ Delay in minutes. Departure delya if available, arrival delay otherwise.
Distance from request coordinates in meters. undef if the object has not
been obtained by means of a coord request.
-=item $stop->id
+=item $stop->id_num
-Stop ID.
+Stop ID (numeric).
-=item $stop->stop_id
+=item $stop->id_code
-The other kind of stop ID.
-Yes, EFA has two.
+Stop ID (code).
=item $stop->place
@@ -222,7 +221,7 @@ Travel::Status::DE::EFA(3pm).
=head1 AUTHOR
-Copyright (C) 2015-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2015-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
=head1 LICENSE
diff --git a/lib/Travel/Status/DE/EFA/Trip.pm b/lib/Travel/Status/DE/EFA/Trip.pm
index 6cd8b7f..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.04';
+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,12 +50,61 @@ sub new {
sub polyline {
my ( $self, %opt ) = @_;
- if ( $opt{fallback} and not @{ $self->{polyline} // [] } ) {
- # TODO add $_->{id} as well?
- return map { $_->{latlon} } $self->route;
+ if ( $self->{polyline} ) {
+ return @{ $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;
+ };
+
+ 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} };
}
sub parse_dt {
@@ -77,7 +128,7 @@ sub route {
for my $stop ( @{ $self->{route_raw} // [] } ) {
my $chain = $stop;
- my ( $platform, $place, $name, $name_full, $stop_id );
+ my ( $platform, $place, $name, $name_full, $id_num, $id_code );
while ( $chain->{type} ) {
if ( $chain->{type} eq 'platform' ) {
$platform = $chain->{properties}{platformName}
@@ -86,7 +137,8 @@ sub route {
elsif ( $chain->{type} eq 'stop' ) {
$name = $chain->{disassembledName};
$name_full = $chain->{name};
- $stop_id = $chain->{properties}{stopId};
+ $id_code = $chain->{id};
+ $id_num = $chain->{properties}{stopId};
}
elsif ( $chain->{type} eq 'locality' ) {
$place = $chain->{name};
@@ -100,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 => $stop->{id},
- stop_id => $stop_id,
+ 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,
)
);
}
@@ -123,6 +177,9 @@ sub TO_JSON {
# lazy loading
$self->route;
+ # lazy loading
+ $self->polyline;
+
my $ret = { %{$self} };
delete $ret->{strptime_obj};
@@ -148,7 +205,7 @@ trip
=head1 VERSION
-version 3.04
+version 3.13
=head1 DESCRIPTION
@@ -212,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
@@ -256,7 +335,7 @@ Travel::Status::DE::EFA(3pm).
=head1 AUTHOR
-Copyright (C) 2024 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2024-2025 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 79db4de..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.04';
+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.04
+version 3.13
=head1 DESCRIPTION
@@ -95,7 +95,7 @@ efa-m(1), Travel::Status::DE::EFA(3pm).
=head1 AUTHOR
-Copyright (C) 2013-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
+Copyright (C) 2013-2023 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt>
=head1 LICENSE
generated by cgit v1.2.3 (git 2.39.1) at 2025-07-01 07:07:39 +0000