diff options
-rw-r--r-- | Build.PL | 5 | ||||
-rw-r--r-- | COPYING | 2 | ||||
-rw-r--r-- | Changelog | 55 | ||||
-rwxr-xr-x | bin/efa-m | 101 | ||||
m--------- | ext/transport-apis | 0 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA.pm | 74 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Departure.pm | 40 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Info.pm | 6 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Line.pm | 6 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Services.pm.PL | 12 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Stop.pm | 19 | ||||
-rw-r--r-- | lib/Travel/Status/DE/EFA/Trip.pm | 119 | ||||
-rw-r--r-- | lib/Travel/Status/DE/VRR.pm | 6 | ||||
-rwxr-xr-x | scripts/check-efa-urls | 4 | ||||
-rw-r--r-- | t/21-vrr-ambig.t | 8 | ||||
-rwxr-xr-x | xt/00-compile-pm.t | 8 | ||||
-rwxr-xr-x | xt/01-compile-pl.t | 8 |
17 files changed, 366 insertions, 107 deletions
@@ -9,13 +9,16 @@ Module::Build->new( build_requires => { 'File::Slurp' => 0, 'Test::More' => 0, - 'Test::Pod' => 0, }, configure_requires => { 'Module::Build' => 0.40, }, module_name => 'Travel::Status::DE::VRR', license => 'perl', + recommends => { + 'Cache::File' => 0, + 'GIS::Distance' => 0, + }, requires => { 'perl' => '5.10.1', 'Carp' => 0, @@ -1,4 +1,4 @@ -Copyright (C) 2011-2014 Birte Kristina Friesel <derf@finalrewind.org> +Copyright (C) 2011-2025 Birte Kristina Friesel <derf@finalrewind.org> All files in this distribution are licensed under the same terms as Perl itself. @@ -1,3 +1,58 @@ +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 + * Add "Rolph" service definition + +Travel::Status::DE::VRR 3.06 - Sun Jan 05 2025 + + * EFA APIs know two types of stop IDs: numbers and codes. This module now + consistently refers to numeric stop IDs as "id_num" and stop ID codes as + "id_code". + * Departure: Rename ->stop_id to ->stop_id_num + * Stop: Rename ->id to ->id_num + * Stop: Rename ->stop_id to ->id_code + * Departure: Add ->id accessor. + +Travel::Status::DE::VRR 3.05 - Mon Dec 30 2024 + + * efa-m: add --raw-json option + * EFA stopFinder: add special handling for #results == 1 + Travel::Status::DE::VRR 3.04 - Sun Dec 22 2024 * EFA: Add NWL service definition @@ -4,7 +4,7 @@ use warnings; use 5.010; use utf8; -our $VERSION = '3.04'; +our $VERSION = '3.13'; binmode( STDOUT, ':encoding(utf-8)' ); @@ -19,7 +19,7 @@ my $efa_url; my $efa_encoding; my $use_cache = 1; my $cache; -my $json_output; +my ( $json_output, $raw_json_output ); my ( $date, $time, $input_type, $list_lines, $offset, $relative_times ); my ( $full_routes, $filter_via, $show_jid ); my ( $timeout, $developer_mode ); @@ -60,6 +60,7 @@ GetOptions( 'V|track-via=s' => \$filter_via, 'cache!' => \$use_cache, 'json' => \$json_output, + 'raw-json' => \$raw_json_output, 'devmode' => \$developer_mode, 'version' => \&show_version, @@ -98,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 ) { @@ -185,7 +189,7 @@ sub new_efa { sub show_help { my ($code) = @_; - print "Usage: efa-m [-d <dd.mm.yyyy>] [-t <hh:mm>] [place] <station>\n" + print "Usage: efa-m [-d <dd.mm.yyyy>] [-t <hh:mm>] <stop>\n" . "See also: man efa-m\n"; exit $code; @@ -232,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", @@ -321,7 +331,7 @@ sub show_coord { printf( "%5.1f km %-${max_len}s %s\n", $stop->distance_m * 1e-3, - $stop->full_name, $stop->id + $stop->full_name, $stop->id_code ); } } @@ -329,7 +339,8 @@ sub show_coord { sub show_stopfinder { my $max_len = max map { length( $_->full_name ) } $efa->results; for my $stop ( $efa->results ) { - printf( "%-${max_len}s %s\n", $stop->full_name, $stop->id ); + printf( "%-${max_len}s %s %s\n", + $stop->full_name, $stop->id_num, $stop->id_code ); } } @@ -345,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; @@ -352,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 @@ -482,11 +506,7 @@ sub show_results { @output_line = ( $dtime, $platform, $line, q{}, $d->destination, $d ); if ($show_jid) { - $output_line[2] .= sprintf( ' %s@%d(%s)%d', - $d->stateless =~ s{ }{}gr, - scalar $d->route_pre ? ( $d->route_pre )[0]->id : $d->stop_id, - $d->sched_datetime->strftime('%Y%m%d'), - $d->key ); + $output_line[2] .= ' ' . $d->id; } if ( $edata{route} ) { @@ -557,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; @@ -575,6 +599,9 @@ if ($json_output) { say JSON->new->convert_blessed->encode( [ $efa->results ] ); } } +elsif ($raw_json_output) { + say JSON->new->convert_blessed->encode( $efa->{response} ); +} elsif ($coord) { show_coord(); } @@ -609,7 +636,7 @@ B<efa-m> [B<-s> I<service>] I<tripid> =head1 VERSION -version 3.04 +version 3.13 =head1 DESCRIPTION @@ -621,8 +648,8 @@ The operating mode depends on the contents of its mandatory argument. =head2 Departure Monitor (I<name>) -Shows departures it I<name> or I<city> I<name>. For each departure, -B<efa-m> shows +Shows departures at I<name> or I<city> I<name>; I<name> may also be a stop ID +number or code. For each departure, B<efa-m> shows =over @@ -640,10 +667,10 @@ B<efa-m> shows =back -If I<city> is specified, I<name> refers to a location within I<city>. Otherwise, -I<name> must be self-contained. I.e., both C<< efa Essen Hbf >> and -C<< efa "Essen Hbf" >> are valid. Note, however, than C<< efa E Hbf >> works, -but C<< efa "E Hbf" >> does not. +If I<city> is specified, I<name> refers to a location within I<city>. +Otherwise, I<name> must be self-contained. I.e., both C<< efa-m Essen Hbf >> +and C<< efa-m "Essen Hbf" >> are valid. Note, however, than C<< efa-m E Hbf >> +works, but C<< efa-m "E Hbf" >> does not. By default, I<name> refers to a stop, this can be changed by specifying I<type>. Supported types are B<address> and B<poi> (point of interest). @@ -651,11 +678,13 @@ I<type>. Supported types are B<address> and B<poi> (point of interest). =head2 Location Search (B<?>I<query>|I<lat>B<:>I<lon>) List stops that match I<query> or that are located in the vicinity of -I<lat>B<:>I<lon> geocoordinates. +I<lat>B<:>I<lon> geocoordinates. In addition to stop names, the output also +includes stop ID codes (both modes) and numbers (only available in I<query> +mode). =head2 Trip Details (I<JourneyID>) -List trip information as well as arrival and departure time, name, and platform +List trip information including arrival and departure time, name, and platform of each stop on the trip's route. =head1 OPTIONS @@ -663,13 +692,12 @@ of each stop on the trip's route. Values in brackets indicate options that only apply to the corresponding operating mode(s). - =over =item B<-A>, B<--auto-url>, B<--discover-and-print> (monitor) -Probe all known EFA entry points for the specified stop. Print the first -result which was not an error. +Probe all known EFA services for the specified stop. Print the first result +which was not an error. Note that this may take a while and will not necessarily return the best result. Also, using thi option by default is not recommended, as it puts EFA @@ -682,8 +710,8 @@ May also be specified as I<dd.mm.> =item B<-D>, B<--discover> (monitor) -Probe all known EFA entry points for the specified stop. Print the URLs and -names of all entry points which did not return an error. +Probe all known EFA services for the specified stop. Print the URLs and names +of all services which did not return an error. =item B<-j>, B<--with-jid> (monitor) @@ -778,6 +806,11 @@ availability, delay reasons, and more. Only show departures at I<platforms> (comma-separated list, option may be repeated). Note that the C<< Bstg. >> / C<< Gleis >> prefix must be omitted. +=item B<--raw-json> + +Print unprocessed EFA response as JSON and exit. +Useful for debugging and development purposes. + =item B<-r>, B<--relative> (monitor) Show relative departure times in minutes (i.e. the time difference between @@ -786,7 +819,7 @@ already included. =item B<-s>, B<--service> I<name> -Short name of the EFA entry point. See Travel::Status::DE::EFA(3pm) and the +Short name of the EFA service. See Travel::Status::DE::EFA(3pm) and the B<--list> option for a list of services. =item B<-t>, B<--time> I<hh:mm> (monitor) @@ -851,7 +884,7 @@ departure and departure delay =head1 AUTHOR -Copyright (C) 2011-2023 by Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> +Copyright (C) 2011-2023 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> =head1 LICENSE diff --git a/ext/transport-apis b/ext/transport-apis -Subproject d6e354679a91485e3f125497882213a41dfb2a2 +Subproject ef57e8b8158653b4f5f400fff109a417e9117c5 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 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' ); diff --git a/xt/00-compile-pm.t b/xt/00-compile-pm.t new file mode 100755 index 0000000..2476ab2 --- /dev/null +++ b/xt/00-compile-pm.t @@ -0,0 +1,8 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.010; +use Test::More; +use Test::Compile; + +all_pm_files_ok(); diff --git a/xt/01-compile-pl.t b/xt/01-compile-pl.t new file mode 100755 index 0000000..f130ac4 --- /dev/null +++ b/xt/01-compile-pl.t @@ -0,0 +1,8 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.010; +use Test::More; +use Test::Compile; + +all_pl_files_ok(); |