summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.github/workflows/perl.yml8
-rw-r--r--Changelog13
-rwxr-xr-xbin/hafas-m171
-rw-r--r--lib/Travel/Status/DE/DeutscheBahn.pm4
-rw-r--r--lib/Travel/Status/DE/HAFAS.pm69
-rw-r--r--lib/Travel/Status/DE/HAFAS/Journey.pm4
-rw-r--r--lib/Travel/Status/DE/HAFAS/Location.pm4
-rw-r--r--lib/Travel/Status/DE/HAFAS/Message.pm4
-rw-r--r--lib/Travel/Status/DE/HAFAS/Polyline.pm2
-rw-r--r--lib/Travel/Status/DE/HAFAS/Product.pm4
-rw-r--r--lib/Travel/Status/DE/HAFAS/Services.pm.PL2
-rw-r--r--lib/Travel/Status/DE/HAFAS/Stop.pm4
-rw-r--r--lib/Travel/Status/DE/HAFAS/StopFinder.pm4
13 files changed, 150 insertions, 143 deletions
diff --git a/.github/workflows/perl.yml b/.github/workflows/perl.yml
index 792826f..93b81aa 100644
--- a/.github/workflows/perl.yml
+++ b/.github/workflows/perl.yml
@@ -16,7 +16,7 @@ jobs:
strategy:
matrix:
perl-version:
- - '5.20'
+ - '5.30'
- 'latest'
- 'threaded'
@@ -25,9 +25,15 @@ jobs:
steps:
- uses: actions/checkout@v2
+ with:
+ submodules: recursive
- name: perl -V
run: perl -V
- name: Install Dependencies
run: curl -sL https://raw.githubusercontent.com/skaji/cpm/master/cpm | perl - install -g --show-build-log-on-failure
+ - name: Prepare Build
+ run: perl Build.PL
+ - name: build
+ run: ./Build
- name: Run Tests
run: prove -l t
diff --git a/Changelog b/Changelog
index 99b5416..7da0d3e 100644
--- a/Changelog
+++ b/Changelog
@@ -1,3 +1,16 @@
+Travel::Status::DE::DeutscheBahn 6.13 - Tue Dec 03 2024
+
+ * HAFAS->station: correctly identify referenced stations in non-DB backends
+
+Travel::Status::DE::DeutscheBahn 6.12 - Mon Dec 02 2024
+
+ * Do not cache upstream CGI_NO_SERVER and CGI_READ_FAILED errors. These
+ are typically temporary.
+
+Travel::Status::DE::DeutscheBahn 6.11 - Fri Oct 11 2024
+
+ * HAFAS: Add mobiliteit service definition
+
Travel::Status::DE::DeutscheBahn 6.10 - Sat Sep 28 2024
* HAFAS: Hardcode request seconds to 00 to improve caching
diff --git a/bin/hafas-m b/bin/hafas-m
index 1858ac7..e62dfec 100755
--- a/bin/hafas-m
+++ b/bin/hafas-m
@@ -3,7 +3,7 @@ use strict;
use warnings;
use 5.014;
-our $VERSION = '6.10';
+our $VERSION = '6.13';
use utf8;
use DateTime;
@@ -412,13 +412,11 @@ if ( $opt{geoSearch} ) {
$result->eva, $result->name
);
}
- exit 0;
}
elsif ( $opt{locationSearch} ) {
for my $result ( $status->results ) {
printf( "%8d %s\n", $result->eva, $result->name );
}
- exit 0;
}
elsif ( $opt{journey} ) {
my $result = $status->result;
@@ -597,104 +595,104 @@ elsif ( $opt{journey} ) {
printf( "(%d) %s\n", $msg->{id}, $msg->text );
}
}
- exit 0;
}
+else {
+ my @results = map { $_->[1] }
+ sort { $a->[0] <=> $b->[0] }
+ map { [ $_->datetime->epoch, $_ ] } $status->results;
-my @results = map { $_->[1] }
- sort { $a->[0] <=> $b->[0] }
- map { [ $_->datetime->epoch, $_ ] } $status->results;
-
-if ($via) {
- @results = grep { journey_has_via( $_, $via ) } @results;
-}
-
-my $delay_len = 0;
-my $occupancy_len = 0;
-my $offset_len = 0;
-for my $d (@results) {
- if ( $d->delay ) {
- $delay_len = max( $delay_len, length( $d->delay ) + 1 );
- }
- if ( $d->load and ( $d->load->{FIRST} or $d->load->{SECOND} ) ) {
- $occupancy_len = 2;
+ if ($via) {
+ @results = grep { journey_has_via( $_, $via ) } @results;
}
- if ( $d->tz_offset ) {
- $offset_len = 1;
+
+ my $delay_len = 0;
+ my $occupancy_len = 0;
+ my $offset_len = 0;
+ for my $d (@results) {
+ if ( $d->delay ) {
+ $delay_len = max( $delay_len, length( $d->delay ) + 1 );
+ }
+ if ( $d->load and ( $d->load->{FIRST} or $d->load->{SECOND} ) ) {
+ $occupancy_len = 2;
+ }
+ if ( $d->tz_offset ) {
+ $offset_len = 1;
+ }
}
-}
-my $message_id = 1;
-for my $m ( $status->messages ) {
- if ( $m->ref_count > 0 ) {
- $m->{id} = $message_id++;
+ my $message_id = 1;
+ for my $m ( $status->messages ) {
+ if ( $m->ref_count > 0 ) {
+ $m->{id} = $message_id++;
+ }
}
-}
-for my $d (@results) {
+ for my $d (@results) {
- my $info_line = q{};
+ my $info_line = q{};
- for my $message ( $d->messages ) {
- if ( $message->ref_count > 0 ) {
- $message->{show} = 1;
- $info_line = sprintf( '(%d) %s', $message->{id}, $info_line );
+ for my $message ( $d->messages ) {
+ if ( $message->ref_count > 0 ) {
+ $message->{show} = 1;
+ $info_line = sprintf( '(%d) %s', $message->{id}, $info_line );
+ }
}
- }
-
- if ( $d->load ) {
- $info_line
- = display_occupancy( $d->load->{FIRST} )
- . display_occupancy( $d->load->{SECOND} ) . ' '
- . $info_line;
- }
- if ($show_jid) {
- $info_line = $d->id . ' ' . $info_line;
- }
+ if ( $d->load ) {
+ $info_line
+ = display_occupancy( $d->load->{FIRST} )
+ . display_occupancy( $d->load->{SECOND} ) . ' '
+ . $info_line;
+ }
- my $entry = [
- ( $d->is_cancelled ? '--:--' : $d->datetime->strftime('%H:%M') )
- . ( $d->tz_offset ? q{*} : ( q{ } x $offset_len ) ),
- $d->is_cancelled
- ? q{}
- : format_delay( $d->delay, $delay_len ),
- $d->name,
- $d->route_end,
- ( $d->platform // q{} ) . ( $d->is_changed_platform ? ' !' : q{} ),
- $info_line,
- $d
- ];
+ if ($show_jid) {
+ $info_line = $d->id . ' ' . $info_line;
+ }
- if ($via) {
- my $stop = journey_has_via( $d, $via );
+ my $entry = [
+ ( $d->is_cancelled ? '--:--' : $d->datetime->strftime('%H:%M') )
+ . ( $d->tz_offset ? q{*} : ( q{ } x $offset_len ) ),
+ $d->is_cancelled
+ ? q{}
+ : format_delay( $d->delay, $delay_len ),
+ $d->name,
+ $d->route_end,
+ ( $d->platform // q{} ) . ( $d->is_changed_platform ? ' !' : q{} ),
+ $info_line,
+ $d
+ ];
+
+ if ($via) {
+ my $stop = journey_has_via( $d, $via );
+
+ # HAFAS does not provide real-time data for route entries, so we have to guesstimate the arrival time
+ $entry->[0] .= ' → '
+ . (
+ $stop->arr_cancelled
+ ? '--:--'
+ : $stop->arr->clone->add( minutes => $d->delay // 0 )
+ ->strftime('%H:%M')
+ );
+ }
- # HAFAS does not provide real-time data for route entries, so we have to guesstimate the arrival time
- $entry->[0] .= ' → '
- . (
- $stop->arr_cancelled
- ? '--:--'
- : $stop->arr->clone->add( minutes => $d->delay // 0 )
- ->strftime('%H:%M')
- );
+ push( @output, $entry, );
}
- push( @output, $entry, );
-}
-
-display_result(@output);
+ display_result(@output);
-if ($offset_len) {
- printf( "\n* reported for %s; local time differs\n",
- $status->get_active_service->{time_zone} // 'Europe/Berlin' );
-}
+ if ($offset_len) {
+ printf( "\n* reported for %s; local time differs\n",
+ $status->get_active_service->{time_zone} // 'Europe/Berlin' );
+ }
-for my $m ( $status->messages ) {
- if ( $m->ref_count > 0 and $m->{show} ) {
- if ( $m->short and $m->text ) {
- printf( "\n# (%d) %s\n# %s\n", $m->{id}, $m->short, $m->text );
- }
- elsif ( $m->short or $m->text ) {
- printf( "\n# (%d) %s\n", $m->{id}, $m->text || $m->short );
+ for my $m ( $status->messages ) {
+ if ( $m->ref_count > 0 and $m->{show} ) {
+ if ( $m->short and $m->text ) {
+ printf( "\n# (%d) %s\n# %s\n", $m->{id}, $m->short, $m->text );
+ }
+ elsif ( $m->short or $m->text ) {
+ printf( "\n# (%d) %s\n", $m->{id}, $m->text || $m->short );
+ }
}
}
}
@@ -716,7 +714,7 @@ B<hafas-m> [B<-s> I<service>] [B<-l> I<language>] B<!>I<query>|I<journeyID>
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
@@ -777,8 +775,8 @@ Europe/Berlin). If a stop's local time differs, it is also provided.
=head1 OPTIONS
-Values in brackets indicate options that only apply to the indicated operating
-mode(s).
+Values in brackets indicate options that only apply to the corresponding
+operating mode(s).
=over
@@ -888,6 +886,7 @@ None.
=over
=item * The non-default services (anything other than DB) are not well-tested.
+Unlike DB, many of those do not return routes for stationboard entries.
=item * HAFAS does not provide real-time data for routes of stationboard
entries. Hence, B<--via> estimates the arrival time from scheduled
diff --git a/lib/Travel/Status/DE/DeutscheBahn.pm b/lib/Travel/Status/DE/DeutscheBahn.pm
index 38cdd02..905df12 100644
--- a/lib/Travel/Status/DE/DeutscheBahn.pm
+++ b/lib/Travel/Status/DE/DeutscheBahn.pm
@@ -6,7 +6,7 @@ use 5.014;
use parent 'Travel::Status::DE::HAFAS';
-our $VERSION = '6.10';
+our $VERSION = '6.13';
sub new {
my ( $class, %opt ) = @_;
@@ -49,7 +49,7 @@ monitor operated by Deutsche Bahn
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/HAFAS.pm b/lib/Travel/Status/DE/HAFAS.pm
index a465a8f..5c7cc0c 100644
--- a/lib/Travel/Status/DE/HAFAS.pm
+++ b/lib/Travel/Status/DE/HAFAS.pm
@@ -22,7 +22,7 @@ use Travel::Status::DE::HAFAS::Product;
use Travel::Status::DE::HAFAS::Services;
use Travel::Status::DE::HAFAS::StopFinder;
-our $VERSION = '6.10';
+our $VERSION = '6.13';
# {{{ Endpoint Definition
@@ -406,7 +406,9 @@ sub post_with_cache {
if ($cache) {
my $content = $cache->thaw( $self->{post} );
- if ($content) {
+ if ( $content
+ and not $content =~ m{ CGI_NO_SERVER | CGI_READ_FAILED }x )
+ {
if ( $self->{developer_mode} ) {
say ' cache hit';
}
@@ -764,49 +766,38 @@ sub station {
return $self->{station_info};
}
- # no need to use Location instances here
- my @locL = @{ $self->{raw_json}{svcResL}[0]{res}{common}{locL} // [] };
-
- my %prefc_by_loc;
+ my %eva_count;
+ my %name_count;
+ my %eva_by_name;
- if ( $self->{active_service} and $self->{active_service} eq 'ÖBB' ) {
- for my $jny ( @{ $self->{raw_json}{svcResL}[0]{res}{jnyL} // [] } ) {
- if ( defined $jny->{stbStop}{locX} ) {
- $prefc_by_loc{ $jny->{stbStop}{locX} } += 1;
- }
- }
- }
- else {
- for my $i ( 0 .. $#locL ) {
- my $loc = $locL[$i];
- if ( $loc->{pRefL} ) {
- $prefc_by_loc{$i} = $#{ $loc->{pRefL} };
- }
- }
+ for my $result ( $self->results ) {
+ $eva_count{ $result->station_eva } += 1;
+ $name_count{ $result->station } += 1;
+ $eva_by_name{ $result->station_eva } = $result->station;
}
- my @prefcounts = sort { $b->[1] <=> $a->[1] }
- map { [ $_, $prefc_by_loc{$_} ] } keys %prefc_by_loc;
+ my @most_frequent_evas = map { $_->[0] } sort { $b->[1] <=> $a->[1] }
+ map { [ $_, $eva_count{$_} ] } keys %eva_count;
- if ( not @prefcounts ) {
- $self->{station_info} = {};
- return $self->{station_info};
- }
+ my @most_frequent_names = map { $_->[0] } sort { $b->[1] <=> $a->[1] }
+ map { [ $_, $name_count{$_} ] } keys %name_count;
- my $loc = $locL[ $prefcounts[0][0] ];
+ my @shortest_names = map { $_->[0] } sort { $a->[1] <=> $b->[1] }
+ map { [ $_, length($_) ] } keys %name_count;
- if ($loc) {
- $self->{station_info} = {
- name => $loc->{name},
- eva => $loc->{extId},
- names => [ map { $locL[ $_->[0] ]{name} } @prefcounts ],
- evas => [ map { $locL[ $_->[0] ]{extId} } @prefcounts ],
- };
- }
- else {
+ if ( not @shortest_names ) {
$self->{station_info} = {};
+ return $self->{station_info};
}
+ # The shortest name is typically the most helpful one, e.g. "Wien Hbf" vs. "Wien Hbf Süd (Sonnwendgasse)"
+ $self->{station_info} = {
+ name => $shortest_names[0],
+ eva => $eva_by_name{ $shortest_names[0] },
+ names => \@most_frequent_names,
+ evas => \@most_frequent_evas,
+ };
+
return $self->{station_info};
}
@@ -890,7 +881,7 @@ monitors
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
@@ -1083,7 +1074,7 @@ Returns a list of Travel::Status::DE::HAFAS::Message(3pm) objects with service
messages. Each message belongs to at least one arrival/departure (station,
journey) or to at least stop alongside its route (journey).
-=item $status->station
+=item $status->station (station)
Returns a hashref describing the departure stations in all requested journeys.
The hashref contains four entries: B<names> (station names), B<name> (most
@@ -1094,8 +1085,6 @@ Note that the most common name and ID may be different from the station for
which departures were requested, as HAFAS uses different identifiers for train
stations, bus stops, and other modes of transit even if they are interlinked.
-Not available in journey mode.
-
=item $status->similar_stops
Returns a list of hashrefs describing stops whose name is similar to the one
diff --git a/lib/Travel/Status/DE/HAFAS/Journey.pm b/lib/Travel/Status/DE/HAFAS/Journey.pm
index 1c1539c..27cdc50 100644
--- a/lib/Travel/Status/DE/HAFAS/Journey.pm
+++ b/lib/Travel/Status/DE/HAFAS/Journey.pm
@@ -11,7 +11,7 @@ use DateTime::Format::Strptime;
use List::Util qw(any uniq);
use Travel::Status::DE::HAFAS::Stop;
-our $VERSION = '6.10';
+our $VERSION = '6.13';
Travel::Status::DE::HAFAS::Journey->mk_ro_accessors(
qw(datetime sched_datetime rt_datetime tz_offset
@@ -437,7 +437,7 @@ journey received by Travel::Status::DE::HAFAS
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/HAFAS/Location.pm b/lib/Travel/Status/DE/HAFAS/Location.pm
index 96279ee..1603e46 100644
--- a/lib/Travel/Status/DE/HAFAS/Location.pm
+++ b/lib/Travel/Status/DE/HAFAS/Location.pm
@@ -6,7 +6,7 @@ use 5.014;
use parent 'Class::Accessor';
-our $VERSION = '6.10';
+our $VERSION = '6.13';
Travel::Status::DE::HAFAS::Location->mk_ro_accessors(
qw(lid type name eva state lat lon distance_m weight));
@@ -57,7 +57,7 @@ Travel::Status::DE::HAFAS::Location - A single public transit location
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/HAFAS/Message.pm b/lib/Travel/Status/DE/HAFAS/Message.pm
index 4e98c03..66c25d3 100644
--- a/lib/Travel/Status/DE/HAFAS/Message.pm
+++ b/lib/Travel/Status/DE/HAFAS/Message.pm
@@ -6,7 +6,7 @@ use 5.014;
use parent 'Class::Accessor';
-our $VERSION = '6.10';
+our $VERSION = '6.13';
Travel::Status::DE::HAFAS::Message->mk_ro_accessors(
qw(short type text code prio is_him ref_count));
@@ -69,7 +69,7 @@ Travel::Status::DE::HAFAS::Message - An arrival/departure-related message.
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/HAFAS/Polyline.pm b/lib/Travel/Status/DE/HAFAS/Polyline.pm
index 005d2ee..b1ace58 100644
--- a/lib/Travel/Status/DE/HAFAS/Polyline.pm
+++ b/lib/Travel/Status/DE/HAFAS/Polyline.pm
@@ -16,7 +16,7 @@ use 5.014;
use parent 'Exporter';
our @EXPORT_OK = qw(decode_polyline);
-our $VERSION = '6.10';
+our $VERSION = '6.13';
# Translated this php script
# <http://unitstep.net/blog/2008/08/02/decoding-google-maps-encoded-polylines-using-php/>
diff --git a/lib/Travel/Status/DE/HAFAS/Product.pm b/lib/Travel/Status/DE/HAFAS/Product.pm
index 14d5e7b..29399e8 100644
--- a/lib/Travel/Status/DE/HAFAS/Product.pm
+++ b/lib/Travel/Status/DE/HAFAS/Product.pm
@@ -8,7 +8,7 @@ use 5.014;
use parent 'Class::Accessor';
-our $VERSION = '6.10';
+our $VERSION = '6.13';
Travel::Status::DE::HAFAS::Product->mk_ro_accessors(
qw(class line_id line_no name number type type_long operator));
@@ -105,7 +105,7 @@ associated with a journey.
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/HAFAS/Services.pm.PL b/lib/Travel/Status/DE/HAFAS/Services.pm.PL
index 75c9baa..3ceee61 100644
--- a/lib/Travel/Status/DE/HAFAS/Services.pm.PL
+++ b/lib/Travel/Status/DE/HAFAS/Services.pm.PL
@@ -231,7 +231,7 @@ use warnings;
use 5.014;
use utf8;
-our $VERSION = '6.10';
+our $VERSION = '6.13';
# Most of these have been adapted from
# <https://github.com/public-transport/transport-apis> and
diff --git a/lib/Travel/Status/DE/HAFAS/Stop.pm b/lib/Travel/Status/DE/HAFAS/Stop.pm
index 23e710a..53f5bd3 100644
--- a/lib/Travel/Status/DE/HAFAS/Stop.pm
+++ b/lib/Travel/Status/DE/HAFAS/Stop.pm
@@ -8,7 +8,7 @@ use 5.014;
use parent 'Class::Accessor';
-our $VERSION = '6.10';
+our $VERSION = '6.13';
Travel::Status::DE::HAFAS::Stop->mk_ro_accessors(
qw(loc
@@ -227,7 +227,7 @@ Travel::Status::DE::HAFAS::Stop - Information about a HAFAS stop.
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
diff --git a/lib/Travel/Status/DE/HAFAS/StopFinder.pm b/lib/Travel/Status/DE/HAFAS/StopFinder.pm
index 2f6e871..07ddda1 100644
--- a/lib/Travel/Status/DE/HAFAS/StopFinder.pm
+++ b/lib/Travel/Status/DE/HAFAS/StopFinder.pm
@@ -10,7 +10,7 @@ use Encode qw(decode);
use JSON;
use LWP::UserAgent;
-our $VERSION = '6.10';
+our $VERSION = '6.13';
# {{{ Constructors
@@ -180,7 +180,7 @@ finder services
=head1 VERSION
-version 6.10
+version 6.13
=head1 DESCRIPTION
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-03 17:12:40 +0000