summaryrefslogtreecommitdiff
path: root/lib/Travel/Status
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Travel/Status')
-rw-r--r--lib/Travel/Status/DE/EFA.pm68
-rw-r--r--lib/Travel/Status/DE/EFA/Departure.pm14
-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.PL31
-rw-r--r--lib/Travel/Status/DE/EFA/Stop.pm6
-rw-r--r--lib/Travel/Status/DE/EFA/Trip.pm67
-rw-r--r--lib/Travel/Status/DE/VRR.pm4
8 files changed, 143 insertions, 55 deletions
diff --git a/lib/Travel/Status/DE/EFA.pm b/lib/Travel/Status/DE/EFA.pm
index 29dbf5b..7edb8e8 100644
--- a/lib/Travel/Status/DE/EFA.pm
+++ b/lib/Travel/Status/DE/EFA.pm
@@ -5,12 +5,13 @@ use warnings;
use 5.010;
use utf8;
-our $VERSION = '3.09';
+our $VERSION = '3.18';
use Carp qw(confess cluck);
use DateTime;
use DateTime::Format::Strptime;
use Encode qw(encode);
+use IO::Socket::SSL;
use JSON;
use Travel::Status::DE::EFA::Departure;
use Travel::Status::DE::EFA::Info;
@@ -19,6 +20,7 @@ use Travel::Status::DE::EFA::Services;
use Travel::Status::DE::EFA::Stop;
use Travel::Status::DE::EFA::Trip;
use LWP::UserAgent;
+use URI::Escape qw(uri_escape);
sub new_p {
my ( $class, %opt ) = @_;
@@ -42,7 +44,8 @@ sub new_p {
say $self->{json}->pretty->encode( $self->{response} );
}
- $self->check_for_ambiguous();
+ $self->check_for_ambiguous;
+ $self->check_for_error;
if ( $self->{errstr} ) {
$promise->reject( $self->{errstr}, $self );
@@ -54,7 +57,7 @@ sub new_p {
}
)->catch(
sub {
- my ($err) = @_;
+ my ( $err, $self ) = @_;
$promise->reject($err);
return;
}
@@ -66,6 +69,8 @@ sub new_p {
sub new {
my ( $class, %opt ) = @_;
+ my $encoding = 'UTF-8';
+ my $tls_insecure = 0;
$opt{timeout} //= 10;
if ( $opt{timeout} <= 0 ) {
delete $opt{timeout};
@@ -105,6 +110,12 @@ sub new {
$opt{efa_url} .= '/XML_DM_REQUEST';
}
$opt{time_zone} //= $service->{time_zone};
+ if ( not $service->{tls_verify} ) {
+ $tls_insecure = 1;
+ }
+ if ( $service->{encoding} ) {
+ $encoding = $service->{encoding};
+ }
}
}
@@ -160,6 +171,7 @@ sub new {
developer_mode => $opt{developer_mode},
efa_url => $opt{efa_url},
service => $opt{service},
+ tls_insecure => $tls_insecure,
strp_stopseq => DateTime::Format::Strptime->new(
pattern => '%Y%m%d %H:%M',
time_zone => $opt{time_zone},
@@ -206,6 +218,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',
@@ -224,14 +237,16 @@ sub new {
itdDateYear => $dt->year,
itdTimeHour => $dt->hour,
itdTimeMinute => $dt->minute,
- name_dm => encode( 'UTF-8', $opt{name} ),
+ name_dm =>
+ uri_escape( encode( $encoding, $opt{name} ), '^A-Za-z0-9-._~ ' ),
};
}
if ( $opt{place} ) {
$self->{post}{placeInfo_dm} = 'invalid';
$self->{post}{placeState_dm} = 'empty';
- $self->{post}{place_dm} = encode( 'UTF-8', $opt{place} );
+ $self->{post}{place_dm}
+ = uri_escape( encode( $encoding, $opt{place} ), '^A-Za-z0-9-._~ ' );
}
if ( $opt{full_routes} ) {
@@ -247,6 +262,12 @@ sub new {
}
else {
my %lwp_options = %{ $opt{lwp_options} // { timeout => 10 } };
+ if ($tls_insecure) {
+ $lwp_options{ssl_opts}{SSL_verify_mode}
+ = IO::Socket::SSL::SSL_VERIFY_NONE;
+ $lwp_options{ssl_opts}{verify_hostname} = 0;
+ }
+
$self->{ua} = LWP::UserAgent->new(%lwp_options);
$self->{ua}->env_proxy;
}
@@ -284,7 +305,8 @@ sub new {
say $self->{json}->pretty->encode( $self->{response} );
}
- $self->check_for_ambiguous();
+ $self->check_for_ambiguous;
+ $self->check_for_error;
return $self;
}
@@ -351,6 +373,10 @@ sub post_with_cache_p {
say ' cache miss';
}
+ if ( $self->{tls_insecure} ) {
+ $self->{ua}->insecure(1);
+ }
+
$self->{ua}->post_p( $url, form => $self->{post} )->then(
sub {
my ($tx) = @_;
@@ -401,6 +427,23 @@ sub place_candidates {
return;
}
+sub check_for_error {
+ my ($self) = @_;
+
+ my $json = $self->{response};
+
+ my %kv;
+ for my $m ( @{ $json->{dm}{message} // [] } ) {
+ $kv{ $m->{name} } = $m->{value};
+ }
+
+ if ( $kv{error} ) {
+ $self->{errstr} = "Backend error: $kv{error}";
+ }
+
+ return;
+}
+
sub check_for_ambiguous {
my ($self) = @_;
@@ -627,6 +670,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(
@@ -702,7 +750,7 @@ Travel::Status::DE::EFA - unofficial EFA departure monitor
=head1 VERSION
-version 3.09
+version 3.18
=head1 DESCRIPTION
@@ -766,12 +814,6 @@ B<stop> (stop/station name).
Request departures for the date/time specified by I<DateTime object>.
Default: now.
-=item B<efa_encoding> => I<encoding>
-
-Some EFA servers do not correctly specify their response encoding. If you
-observe encoding issues, you can manually specify it here. Example:
-iso-8859-15.
-
=item B<full_routes> => B<0>|B<1>
If true: Request full routes for all departures from the backend. This
diff --git a/lib/Travel/Status/DE/EFA/Departure.pm b/lib/Travel/Status/DE/EFA/Departure.pm
index 93b8c0c..9527a58 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.09';
+our $VERSION = '3.18';
Travel::Status::DE::EFA::Departure->mk_ro_accessors(
qw(countdown datetime delay destination is_cancelled key line lineref mot
@@ -70,7 +70,8 @@ sub new {
key => $departure->{servingLine}{key},
stateless => $departure->{servingLine}{stateless},
stop_id_num => $departure->{stopID},
- line => $departure->{servingLine}{symbol},
+ line => $departure->{servingLine}{symbol}
+ || $departure->{servingLine}{number},
train_type => $departure->{servingLine}{trainType},
train_name => $departure->{servingLine}{trainName},
train_no => $departure->{servingLine}{trainNum},
@@ -177,10 +178,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 +305,7 @@ departure received by Travel::Status::DE::EFA
=head1 VERSION
-version 3.09
+version 3.18
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Info.pm b/lib/Travel/Status/DE/EFA/Info.pm
index 9c5e009..a2328dd 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.09';
+our $VERSION = '3.18';
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.09
+version 3.18
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Line.pm b/lib/Travel/Status/DE/EFA/Line.pm
index dff9db0..180e6b5 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.09';
+our $VERSION = '3.18';
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.09
+version 3.18
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Services.pm.PL b/lib/Travel/Status/DE/EFA/Services.pm.PL
index 5fc12d4..84701f5 100644
--- a/lib/Travel/Status/DE/EFA/Services.pm.PL
+++ b/lib/Travel/Status/DE/EFA/Services.pm.PL
@@ -17,12 +17,13 @@ sub load_instance {
my $data = $json->decode(
scalar read_file("ext/transport-apis/data/${path}-efa.json") );
my %ret = (
- name => $opt{name} // $data->{name} =~ s{ *[(][^)]+[)]}{}r,
- homepage => $data->{attribution}{homepage},
- url => $opt{url} // $data->{options}{endpoint} =~ s{ / $ }{}rx,
- time_zone => $data->{timezone},
- languages => $data->{supportedLanguages},
- coverage => {
+ name => $opt{name} // $data->{name} =~ s{ *[(][^)]+[)]}{}r,
+ homepage => $data->{attribution}{homepage},
+ url => $opt{url} // $data->{options}{endpoint} =~ s{ / $ }{}rx,
+ time_zone => $data->{timezone},
+ languages => $data->{supportedLanguages},
+ tls_verify => $opt{tls_verify} // 1,
+ coverage => {
area => $data->{coverage}{realtimeCoverage}{area},
regions => $data->{coverage}{realtimeCoverage}{region} // []
},
@@ -35,6 +36,15 @@ sub load_instance {
# VRT: Encoding issues
# VVSt: NXDOMAIN
my %efa_instance = (
+ AVV => {
+ url => 'https://fahrtauskunft.avv-augsburg.de/efa',
+ name => 'Augsburger Verkehrs- & Tarifverbund',
+ tls_verify => 0,
+ },
+ BEG => {
+ url => 'https://bahnland-bayern.de/efa',
+ name => 'Bayerische Eisenbahngesellschaft',
+ },
BSVG => {
url => 'https://bsvg.efa.de/bsvagstd',
name => 'Braunschweiger Verkehrs-GmbH',
@@ -46,9 +56,8 @@ my %efa_instance = (
},
KVV => { load_instance('de/kvv') },
LinzAG => {
- url => 'https://www.linzag.at/static',
- name => 'Linz AG',
- encoding => 'iso-8859-15',
+ url => 'https://www.linzag.at/static',
+ name => 'Linz AG',
},
MVV => { load_instance('de/mvv') },
NVBW => {
@@ -60,7 +69,7 @@ my %efa_instance = (
name => 'Nahverkehr Westfalen-Lippe',
},
Rolph => { load_instance('de/rolph') },
- RVV => {
+ RVV => {
url => 'https://efa.rvv.de/efa',
name => 'Regensburger Verkehrsverbund',
},
@@ -104,7 +113,7 @@ use warnings;
use 5.014;
use utf8;
-our $VERSION = '3.09';
+our $VERSION = '3.18';
# 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 2860ff5..4111984 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.09';
+our $VERSION = '3.18';
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.09
+version 3.18
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/EFA/Trip.pm b/lib/Travel/Status/DE/EFA/Trip.pm
index 848c630..115d21d 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.09';
+our $VERSION = '3.18';
Travel::Status::DE::EFA::Trip->mk_ro_accessors(
qw(operator product product_class name line number type id dest_name dest_id)
@@ -20,13 +20,15 @@ sub new {
my $json = $conf{json}{transportation} // $conf{json}{leg}{transportation};
+ #say $json->{disassembledName} . ' <-> ' . $json->{number};
+
my $ref = {
operator => $json->{operator}{name},
product => $json->{product}{name},
product_class => $json->{product}{class},
polyline_raw => $conf{json}{leg}{coords},
name => $json->{name},
- line => $json->{disassembledName},
+ line => $json->{disassembledName} // $json->{number},
number => $json->{properties}{trainNumber},
type => $json->{properties}{trainType} // $json->{product}{name},
id => $json->{id},
@@ -76,8 +78,19 @@ sub polyline {
$distance = GIS::Distance->new;
};
+ # Ggf. sollte die Abbildung andersrum laufen: Im zweiten Schritt durch die
+ # Polyline iterieren und Stops zuordnen (d.h. polyline_i als Key); bei
+ # Bedarf Polyline-Indexe duplizieren. Lässt sich wunderbar an der Linie
+ # 101/106 in Essen testen (3x Helenenstr, davon 2x am Anfang und 1x
+ # mittendrin).
+
if ($distance) {
my %min_dist;
+
+ # A single trip may pass the same stop multiple times, meaning that
+ # stop IDs alone are not guaranteed to be unique. So we need to use a
+ # stop's index in the trip's route as key in addition to the stop's ID.
+ my $route_i = 0;
for my $stop ( $self->route ) {
for my $polyline_index ( 0 .. $#{ $self->{polyline} } ) {
my $pl = $self->{polyline}[$polyline_index];
@@ -86,21 +99,41 @@ sub polyline {
$stop->{latlon}[1],
$pl->{lat}, $pl->{lon}
);
- if ( not $min_dist{ $stop->{id_code} }
- or $min_dist{ $stop->{id_code} }{dist} > $dist )
+ my $key = $route_i . ';' . $stop->{id_code};
+ if ( not $min_dist{$key}
+ or $min_dist{$key}{dist} > $dist )
{
- $min_dist{ $stop->{id_code} } = {
+ $min_dist{$key} = {
dist => $dist,
index => $polyline_index,
};
}
}
+ $route_i += 1;
}
+ $route_i = 0;
for my $stop ( $self->route ) {
- if ( $min_dist{ $stop->{id_code} } ) {
- $self->{polyline}[ $min_dist{ $stop->{id_code} }{index} ]{stop}
+ my $key = $route_i . ';' . $stop->{id_code};
+ if ( $min_dist{$key} ) {
+ if ( defined $self->{polyline}[ $min_dist{$key}{index} ]{stop} )
+ {
+ warn(
+"$key: overwriting stop ref at $min_dist{$key}{index} with $key"
+ );
+
+ # XXX experimental and untested
+ # one polyline entry maps to multiple stops → duplicate it; insert $stop after the already-present entry
+ #$min_dist{$key}{index} += 1;
+ #splice(
+ # @{ $self->{polyline} },
+ # $min_dist{$key}{index},
+ # 0, { %{ $self->{polyline}[ $min_dist{$key}{index} ] } }
+ #);
+ }
+ $self->{polyline}[ $min_dist{$key}{index} ]{stop}
= $stop;
}
+ $route_i += 1;
}
}
@@ -152,14 +185,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,
)
);
}
@@ -203,7 +238,7 @@ trip
=head1 VERSION
-version 3.09
+version 3.18
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/VRR.pm b/lib/Travel/Status/DE/VRR.pm
index d52944c..3ff2cc6 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.09';
+our $VERSION = '3.18';
use parent 'Travel::Status::DE::EFA';
@@ -43,7 +43,7 @@ Travel::Status::DE::VRR - unofficial VRR departure monitor.
=head1 VERSION
-version 3.09
+version 3.18
=head1 DESCRIPTION
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-23 22:57:32 +0000