diff options
Diffstat (limited to 'lib/Travel/Status/DE/EFA')
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Departure.pm | 528 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Info.pm | 127 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Line.pm | 158 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Services.pm.PL | 147 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Stop.pm | 228 | ||||
| -rw-r--r-- | lib/Travel/Status/DE/EFA/Trip.pm | 375 |
6 files changed, 1563 insertions, 0 deletions
diff --git a/lib/Travel/Status/DE/EFA/Departure.pm b/lib/Travel/Status/DE/EFA/Departure.pm new file mode 100644 index 0000000..5570532 --- /dev/null +++ b/lib/Travel/Status/DE/EFA/Departure.pm @@ -0,0 +1,528 @@ +package Travel::Status::DE::EFA::Departure; + +use strict; +use warnings; +use 5.010; + +use DateTime; +use List::Util qw(any); +use Travel::Status::DE::EFA::Stop; + +use parent 'Class::Accessor'; + +our $VERSION = '3.15'; + +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_num train_type train_name train_no type) +); + +my @mot_mapping = qw{ + zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus + schnellbus seilbahn schiff ast sonstige +}; + +sub parse_departure { + my ( $self, $departure ) = @_; +} + +sub new { + my ( $obj, %conf ) = @_; + + my $departure = $conf{json}; + my ( $sched_dt, $real_dt ); + + if ( my $dt = $departure->{dateTime} ) { + $sched_dt = DateTime->new( + year => $dt->{year}, + month => $dt->{month}, + day => $dt->{day}, + hour => $dt->{hour}, + minute => $dt->{minute}, + second => $dt->{second} // 0, + time_zone => 'Europe/Berlin', + ); + } + + if ( my $dt = $departure->{realDateTime} ) { + $real_dt = DateTime->new( + year => $dt->{year}, + month => $dt->{month}, + day => $dt->{day}, + hour => $dt->{hour}, + minute => $dt->{minute}, + second => $dt->{second} // 0, + time_zone => 'Europe/Berlin', + ); + } + + my @hints + = map { $_->{content} } @{ $departure->{servingLine}{hints} // [] }; + + my $ref = { + strp_stopseq_s => $conf{strp_stopseq_s}, + strp_stopseq => $conf{strp_stopseq}, + rt_datetime => $real_dt, + platform => $departure->{platform}, + platform_name => $departure->{platformName}, + platform_type => $departure->{pointType}, + key => $departure->{servingLine}{key}, + stateless => $departure->{servingLine}{stateless}, + stop_id_num => $departure->{stopID}, + line => $departure->{servingLine}{symbol}, + train_type => $departure->{servingLine}{trainType}, + train_name => $departure->{servingLine}{trainName}, + train_no => $departure->{servingLine}{trainNum}, + origin => $departure->{servingLine}{directionFrom}, + destination => $departure->{servingLine}{direction}, + occupancy => $departure->{occupancy}, + countdown => $departure->{countdown}, + delay => $departure->{servingLine}{delay}, + sched_datetime => $sched_dt, + type => $departure->{servingLine}{name}, + mot => $departure->{servingLine}{motType}, + hints => \@hints, + }; + + if ( defined $ref->{delay} and $ref->{delay} eq '-9999' ) { + $ref->{delay} = 0; + $ref->{is_cancelled} = 1; + } + else { + $ref->{is_cancelled} = 0; + } + + $ref->{datetime} = $ref->{rt_datetime} // $ref->{sched_datetime}; + + bless( $ref, $obj ); + + if ( $departure->{prevStopSeq} ) { + $ref->{prev_route} = $ref->parse_route( $departure->{prevStopSeq}, + $departure->{stopID} ); + } + if ( $departure->{onwardStopSeq} ) { + $ref->{next_route} = $ref->parse_route( $departure->{onwardStopSeq}, + $departure->{stopID} ); + } + + return $ref; +} + +sub parse_route { + my ( $self, $stop_seq, $requested_id ) = @_; + my @ret; + + if ( not $stop_seq ) { + return \@ret; + } + + # Oh EFA, you so silly + if ( ref($stop_seq) eq 'HASH' ) { + + # For lines that start or terminate at the requested stop, onwardStopSeq / prevStopSeq includes the requested stop. + if ( $stop_seq->{ref}{id} eq $requested_id ) { + return \@ret; + } + $stop_seq = [$stop_seq]; + } + + for my $stop ( @{ $stop_seq // [] } ) { + my $ref = $stop->{ref}; + my ( $arr, $dep ); + + if ( $ref->{arrDateTimeSec} ) { + $arr = $self->{strp_stopseq_s} + ->parse_datetime( $ref->{arrDateTimeSec} ); + } + elsif ( $ref->{arrDateTime} ) { + $arr = $self->{strp_stopseq}->parse_datetime( $ref->{arrDateTime} ); + } + + if ( $ref->{depDateTimeSec} ) { + $dep = $self->{strp_stopseq_s} + ->parse_datetime( $ref->{depDateTimeSec} ); + } + elsif ( $ref->{depDateTime} ) { + $dep = $self->{strp_stopseq}->parse_datetime( $ref->{depDateTime} ); + } + + push( + @ret, + Travel::Status::DE::EFA::Stop->new( + sched_arr => $arr, + sched_dep => $dep, + arr_delay => $ref->{arrValid} ? $ref->{arrDelay} : undef, + dep_delay => $ref->{depValid} ? $ref->{depDelay} : undef, + id_num => $ref->{id}, + id_code => $ref->{gid}, + full_name => $stop->{name}, + place => $stop->{place}, + name => $stop->{nameWO}, + occupancy => $stop->{occupancy}, + platform => $ref->{platform} || $stop->{platformName} || undef, + ) + ); + } + + 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) = @_; + + return @{ $self->{hints} // [] }; +} + +sub mot_name { + my ($self) = @_; + + return $mot_mapping[ $self->{mot} ] // 'sonstige'; +} + +sub route_pre { + my ($self) = @_; + + return @{ $self->{prev_route} // [] }; +} + +sub route_post { + my ($self) = @_; + + return @{ $self->{next_route} // [] }; +} + +sub route_interesting { + my ( $self, $max_parts ) = @_; + + my @via = $self->route_post; + my ( @via_main, @via_show, $last_stop ); + $max_parts //= 3; + + for my $stop (@via) { + if ( + $stop->name =~ m{ Bf | Hbf | Flughafen | [Bb]ahnhof + | Krankenhaus | Klinik | (?: S $ ) }ox + ) + { + push( @via_main, $stop ); + } + } + $last_stop = pop(@via); + + if ( @via_main and $via_main[-1] == $last_stop ) { + pop(@via_main); + } + if ( @via and $via[-1] == $last_stop ) { + pop(@via); + } + + if ( @via_main and @via and $via[0] == $via_main[0] ) { + shift(@via_main); + } + + if ( @via < $max_parts ) { + @via_show = @via; + } + else { + if ( @via_main >= $max_parts ) { + @via_show = ( $via[0] ); + } + else { + @via_show = splice( @via, 0, $max_parts - @via_main ); + } + + while ( @via_show < $max_parts and @via_main ) { + my $stop = shift(@via_main); + if ( any { $_->name eq $stop->name } @via_show + or $stop->name eq $last_stop->name ) + { + next; + } + push( @via_show, $stop ); + } + } + + return @via_show; +} + +sub TO_JSON { + my ($self) = @_; + + # compute on-demand keys + $self->id; + + my $ret = { %{$self} }; + + delete $ret->{strp_stopseq}; + delete $ret->{strp_stopseq_s}; + + for my $k (qw(datetime rt_datetime sched_datetime)) { + if ( $ret->{$k} ) { + $ret->{$k} = $ret->{$k}->epoch; + } + } + + return $ret; +} + +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::EFA::Departure - Information about a single +departure received by Travel::Status::DE::EFA + +=head1 SYNOPSIS + + for my $departure ($status->results) { + printf( + "At %s: %s to %s from platform %d\n", + $departure->datetime->strftime('%H:%M'), $departure->line, + $departure->destination, $departure->platform + ); + } + +=head1 VERSION + +version 3.15 + +=head1 DESCRIPTION + +Travel::Status::DE::EFA::Departure describes a single departure as obtained by +Travel::Status::DE::EFA. It contains information about the time, platform, +line number and destination. + +=head1 METHODS + +=head2 ACCESSORS + +=over + +=item $departure->countdown + +Time in minutes from now until the tram/bus/train will depart, including +realtime data if available. + +If delay information is available, it is already included. + +=item $departure->datetime + +DateTime(3pm) object for departure date and time. Realtime data if available, +schedule data otherwise. + +=item $departure->delay + +Expected delay from scheduled departure time in minutes. A delay of 0 +indicates departure on time. undef when no realtime information is available. + +=item $departure->destination + +Destination name. + +=item $departure->hints + +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. + +=item $departure->key + +Key of this departure of the corresponding line. Unique for a given day when +combined with B<stateless>. + +=item $departure->line + +The name/number of the line. + +=item $departure->lineref + +Travel::Status::DE::EFA::Line(3pm) object describing the departing line in +detail. + +=item $departure->mot + +Returns the "mode of transport" number. This is usually an integer between 0 +and 11. + +=item $departure->mot_name + +Returns the "mode of transport", for instance "zug", "s-bahn", "tram" or +"sonstige". + +=item $departure->occupancy + +Returns expected occupancy, if available, undef otherwise. + +Occupancy values are passed from the backend as-is. Known values are +"MANY_SEATS" (low occupation), "FEW_SEATS" (high occupation), +"STANDING_ONLY" (very high occupation), and "FULL" (boarding not advised). + +=item $departure->origin + +Origin name. + +=item $departure->platform + +Departure platform number (may not be a number). + +=item $departure->platform_db + +true if the platform number is operated by DB ("Gleis x"), false ("Bstg. x") +otherwise. + +Unfortunately, there is no distinction between tram and bus platforms yet, +which may also have the same numbers. + +=item $departure->route_interesting + +List of up to three "interesting" stations served by this departure. Is a +subset of B<route_post>. Each station is a Travel::Status::DE::EFA::Stop(3pm) +object. + +=item $departure->route_pre + +List of stations the vehicle passed (or will have passed) before this stop. +Each station is a Travel::Status::DE::EFA::Stop(3pm) object. + +=item $departure->route_post + +List of stations the vehicle will pass after this stop. +Each station is a Travel::Status::DE::EFA::Stop(3pm) object. + +=item $departure->rt_datetime + +DateTime(3pm) object holding the departure date and time according to +realtime data. Undef if unknown / unavailable. + +=item $departure->sched_datetime + +DateTime(3pm) object holding the scheduled departure date and time. + +=item $departure->stateless + +Unique line identifier. + +=item $departure->train_type + +Train type, e.g. "ICE". Typically only defined for long-distance trains. + +=item $departure->train_name + +Train name, e.g. "ICE International" or "InterCityExpresS" or "Deichgraf". +Typically only defined for long-distance trains. + +=item $departure->train_no + +Train number. Only defined if departure is a train. + +=item $departure->type + +Type of the departure. Note that efa.vrr.de sometimes puts bogus data in this +field. See L</DEPARTURE TYPES>. + +=back + +=head2 INTERNAL + +=over + +=item $departure = Travel::Status::DE::EFA::Departure->new(I<%data>) + +Returns a new Travel::Status::DE::EFA::Departure object. You should not need to +call this. + +=item $departure->TO_JSON + +Allows the object data to be serialized to JSON. + +=back + +=head1 DEPARTURE TYPES + +The following are known so far: + +=over + +=item * Abellio-Zug + +=item * Bus + +=item * Eurocity + +=item * Intercity-Express + +=item * NE (NachtExpress / night bus) + +=item * Niederflurbus + +=item * R-Bahn (RE / RegionalExpress) + +=item * S-Bahn + +=item * SB (Schnellbus) + +=item * StraE<szlig>enbahn + +=item * U-Bahn + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +C<< $result->type >> may contain bogus data. This comes from the efa.vrr.de +interface. + +=head1 SEE ALSO + +Travel::Status::DE::EFA(3pm). + +=head1 AUTHOR + +Copyright (C) 2011-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. diff --git a/lib/Travel/Status/DE/EFA/Info.pm b/lib/Travel/Status/DE/EFA/Info.pm new file mode 100644 index 0000000..c4e7ce4 --- /dev/null +++ b/lib/Travel/Status/DE/EFA/Info.pm @@ -0,0 +1,127 @@ +package Travel::Status::DE::EFA::Info; + +use strict; +use warnings; +use 5.010; + +use parent 'Class::Accessor'; + +our $VERSION = '3.15'; + +Travel::Status::DE::EFA::Info->mk_ro_accessors( + qw(link_url link_text subject content subtitle additional_text)); + +sub new { + my ( $obj, %opt ) = @_; + + my $json = $opt{json}; + + my $ref = { + param => {}, + link_url => $json->{infoLinkURL}, + link_text => $json->{infoLinkText}, + subject => $json->{infoText}{subject}, + content => $json->{infoText}{content}, + subtitle => $json->{infoText}{subtitle}, + additional_text => $json->{infoText}{additionalText}, + }; + + for my $param ( @{ $json->{paramList} // [] } ) { + $ref->{param}{ $param->{name} } = $param->{value}; + } + + return bless( $ref, $obj ); +} + +sub TO_JSON { + my ($self) = @_; + + return { %{$self} }; +} + +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::EFA::Info - Information about a public transit stop + +=head1 SYNOPSIS + + if ( $info->subject and $info->subtitle ne $info->subject ) { + printf( "# %s\n%s\n", $info->subtitle, $info->subject ); + } + else { + printf( "# %s\n", $info->subtitle ); + } + +=head1 VERSION + +version 3.15 + +=head1 DESCRIPTION + +Travel::Status::DE::EFA::Info holds a single information message related to +a specific public transit stop. + +=head1 ACCESSORS + +All accessors may return undef. +Individual accessors may return identical strings. +Strings may contain HTML elements. + +=over + +=item $info->additional_text + +=item $info->content + +=item $info->link_url + +URL to a site related to this information message. +The site may or may not hold additional data. + +=item $info->link_text + +Text for linking to link_url. + +=item $info->param + +Hashref of parameters, e.g. C<< incidentDateTime >> (string describing the +date/time range during which this message is valid). + +=item $info->subject + +=item $info->subtitle + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +This module is a Work in Progress. +Its API may change between minor versions. + +=head1 SEE ALSO + +Travel::Status::DE::EFA(3pm). + +=head1 AUTHOR + +Copyright (C) 2024-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. diff --git a/lib/Travel/Status/DE/EFA/Line.pm b/lib/Travel/Status/DE/EFA/Line.pm new file mode 100644 index 0000000..888ea6b --- /dev/null +++ b/lib/Travel/Status/DE/EFA/Line.pm @@ -0,0 +1,158 @@ +package Travel::Status::DE::EFA::Line; + +use strict; +use warnings; +use 5.010; + +use parent 'Class::Accessor'; + +our $VERSION = '3.15'; + +Travel::Status::DE::EFA::Line->mk_ro_accessors( + qw(direction mot name number operator route type valid)); + +my @mot_mapping = qw{ + zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus + schnellbus seilbahn schiff ast sonstige +}; + +sub new { + my ( $obj, %conf ) = @_; + + my $ref = \%conf; + + return bless( $ref, $obj ); +} + +sub mot_name { + my ($self) = @_; + + return $mot_mapping[ $self->{mot} ] // 'sonstige'; +} + +sub TO_JSON { + my ($self) = @_; + + return { %{$self} }; +} + +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::EFA::Line - Information about a line departing at the +requested station + +=head1 SYNOPSIS + + for my $line ($status->lines) { + printf( + "line %s -> %s\nRoute: %s\nType %s, operator %s\nValid: %s\n\n", + $line->name, $line->direction, $line->route, + $line->type, $line->operator, $line->valid + ); + } + +=head1 VERSION + +version 3.15 + +=head1 DESCRIPTION + +Travel::Status::DE::EFA::Line describes a tram/bus/train line departing at the +stop requested by Travel::Status::DE::EFA. Note that it only covers one +direction, so in most cases, you get two Travel::Status::DE::EFA::Line objects +per actual line. + +=head1 METHODS + +=head2 ACCESSORS + +=over + +=item $line->direction + +Direction of the line. Name of either the destination stop or one on the way. + +=item $line->mot + +Returns the "mode of transport" number for this line. This is usually an +integer between 0 and 11. + +=item $line->mot_name + +Returns the "mode of transport" for this line, for instance "zug", "s-bahn", +"tram" or "sonstige". + +=item $line->name + +Name of the line, e.g. "U11", "SB15", "107". + +=item $line->operator + +Operator of the line, as in the local transit company responsible for it. +May be undefined. + +=item $line->route + +Partial route of the line (as string), usually start and destination with two +stops in between. May be undefined. + +Note that start means the actual start of the line, the stop requested by +Travel::Status::DE::EFA::Line may not even be included in this listing. + +=item $line->type + +Type of the line. Observed values so far are "Bus", "NE", "StraE<szlig>enbahn", +"U-Bahn". + +=item $line->valid + +When / how long above information is valid. + +=back + +=head2 INTERNAL + +=over + +=item $line = Travel::Status::DE::EFA::Line->new(I<%data>) + +Returns a new Travel::Status::DE::EFA::Line object. You should not need to +call this. + +=item $line->TO_JSON + +Allows the object data to be serialized to JSON. + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +The B<route> accessor returns a simple string, an array might be better suited. + +=head1 SEE ALSO + +Travel::Status::DE::EFA(3pm). + +=head1 AUTHOR + +Copyright (C) 2011-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. diff --git a/lib/Travel/Status/DE/EFA/Services.pm.PL b/lib/Travel/Status/DE/EFA/Services.pm.PL new file mode 100644 index 0000000..964c9be --- /dev/null +++ b/lib/Travel/Status/DE/EFA/Services.pm.PL @@ -0,0 +1,147 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use 5.014; +use utf8; +use Data::Dumper; +use Encode qw(encode); +use File::Slurp qw(read_file write_file); +use JSON; + +my $json = JSON->new->utf8; + +sub load_instance { + my ( $path, %opt ) = @_; + + 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 => { + area => $data->{coverage}{realtimeCoverage}{area}, + regions => $data->{coverage}{realtimeCoverage}{region} // [] + }, + ); + + return %ret; +} + +# GVH: 403 +# 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', + }, + bwegt => { load_instance('de/bwegt') }, + DING => { + url => 'https://www.ding.eu/ding3', + name => 'Donau-Iller Nahverkehrsverbund', + }, + KVV => { load_instance('de/kvv') }, + LinzAG => { + url => 'https://www.linzag.at/static', + name => 'Linz AG', + encoding => 'iso-8859-15', + }, + MVV => { load_instance('de/mvv') }, + NVBW => { + url => 'https://www.efa-bw.de/nvbw', + name => 'Nahverkehrsgesellschaft Baden-Württemberg', + }, + NWL => { + 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', + }, + VGN => + { load_instance( 'de/vgn', url => 'https://efa.vgn.de/vgnExt_oeffi' ) }, + VMV => { load_instance('de/vmv') }, + VRN => { + url => 'https://www.vrn.de/mngvrn/', + name => 'Verkehrsverbund Rhein-Neckar', + }, + VRR => { + load_instance( + 'de/vrr', + url => 'https://efa.vrr.de/vrr', + ), + }, + VRR2 => { load_instance('de/vrr') }, + VRR3 => { load_instance( 'de/vrr', url => 'https://efa.vrr.de/rbgstd3' ) }, + VVO => { + url => 'https://efa.vvo-online.de/VMSSL3', + name => 'Verkehrsverbund Oberelbe', + }, + VVS => { load_instance('de/vvs') }, + +); + +my $buf = <<'__EOF__'; +package Travel::Status::DE::EFA::Services; + +# vim:readonly +# This package has been automatically generated +# by lib/Travel/Status/DE/EFA/Services.pm.PL. +# Do not edit, changes will be lost. + +use strict; +use warnings; +use 5.014; +use utf8; + +our $VERSION = '3.15'; + +# Most of these have been adapted from +# <https://github.com/public-transport/transport-apis> and +# <https://github.com/public-transport/hafas-client/tree/main/p>. +# Many thanks to Jannis R / @derhuerst and all contributors for maintaining +# these resources. + +__EOF__ + +my $perlobj = Data::Dumper->new( [ \%efa_instance ], ['efa_instance'] ); + +$buf .= 'my ' . $perlobj->Sortkeys(1)->Indent(0)->Dump; + +$buf .= <<'__EOF__'; + +sub get_service_ids { + return sort keys %{$efa_instance}; +} + +sub get_service { + my ($service) = @_; + return $efa_instance->{$service}; +} + +sub get_service_ref { + return $efa_instance; +} + +sub get_service_map { + return %{$efa_instance}; +} + +1; +__EOF__ + +write_file( $ARGV[0], { binmode => ':utf8' }, $buf ); diff --git a/lib/Travel/Status/DE/EFA/Stop.pm b/lib/Travel/Status/DE/EFA/Stop.pm new file mode 100644 index 0000000..ef570eb --- /dev/null +++ b/lib/Travel/Status/DE/EFA/Stop.pm @@ -0,0 +1,228 @@ +package Travel::Status::DE::EFA::Stop; + +use strict; +use warnings; +use 5.010; + +use parent 'Class::Accessor'; + +our $VERSION = '3.15'; + +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 is_cancelled + place name full_name id_num id_code latlon + platform niveau) +); + +sub new { + my ( $obj, %conf ) = @_; + + my $ref = \%conf; + + if ( $ref->{sched_arr} and $ref->{arr_delay} and not $ref->{rt_arr} ) { + $ref->{rt_arr} + = $ref->{sched_arr}->clone->add( minutes => $ref->{arr_delay} ); + } + + if ( $ref->{sched_dep} and $ref->{dep_delay} and not $ref->{rt_dep} ) { + $ref->{rt_dep} + = $ref->{sched_dep}->clone->add( minutes => $ref->{dep_delay} ); + } + + $ref->{arr} //= $ref->{rt_arr} // $ref->{sched_arr}; + $ref->{dep} //= $ref->{rt_dep} // $ref->{sched_dep}; + + if ( $ref->{rt_arr} + and $ref->{sched_arr} + and not defined $ref->{arr_delay} ) + { + $ref->{arr_delay} + = $ref->{rt_arr}->subtract_datetime( $ref->{sched_arr} ) + ->in_units('minutes'); + } + + if ( $ref->{rt_dep} + and $ref->{sched_dep} + and not defined $ref->{dep_delay} ) + { + $ref->{dep_delay} + = $ref->{rt_dep}->subtract_datetime( $ref->{sched_dep} ) + ->in_units('minutes'); + } + + $ref->{delay} = $ref->{dep_delay} // $ref->{arr_delay}; + + return bless( $ref, $obj ); +} + +sub TO_JSON { + my ($self) = @_; + + my $ret = { %{$self} }; + + for my $k (qw(sched_arr rt_arr arr sched_dep rt_dep dep)) { + if ( $ret->{$k} ) { + $ret->{$k} = $ret->{$k}->epoch; + } + } + + return $ret; +} + +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::EFA::Stop - Information about a stop (station) contained +in a Travel::Status::DE::EFA::Result's route + +=head1 SYNOPSIS + + for my $stop ($departure->route_post) { + printf( + "%s -> %s : %40s %s\n", + $stop->arr ? $stop->arr->strftime('%H:%M') : q{--:--}, + $stop->dep ? $stop->dep->strftime('%H:%M') : q{--:--}, + $stop->name, $stop->platform + ); + } + +=head1 VERSION + +version 3.15 + +=head1 DESCRIPTION + +Travel::Status::DE::EFA::Stop describes a single stop of a departure's +route. It is solely based on the respective departure's schedule; +delays or changed platforms are not taken into account. + +=head1 METHODS + +=head2 ACCESSORS + +Most accessors return undef if the corresponding data is not available. + +=over + +=item $stop->sched_arr + +DateTime(3pm) object holding scheduled arrival date and time. + +=item $stop->rt_arr + +DateTime(3pm) object holding estimated (real-time) arrival date and time. + +=item $stop->arr + +DateTime(3pm) object holding arrival date and time. Real-time data if +available, schedule data otherwise. + +=item $stop->arr_delay + +Arrival delay in minutes. + +=item $stop->sched_dep + +DateTime(3pm) object holding scheduled departure date and time. + +=item $stop->rt_dep + +DateTime(3pm) object holding estimated (real-time) departure date and time. + +=item $stop->dep + +DateTime(3pm) object holding departure date and time. Real-time data if +available, schedule data otherwise. + +=item $stop->dep_delay + +Departure delay in minutes. + +=item $stop->delay + +Delay in minutes. Departure delya if available, arrival delay otherwise. + +=item $stop->distance_m + +Distance from request coordinates in meters. undef if the object has not +been obtained by means of a coord request. + +=item $stop->id_num + +Stop ID (numeric). + +=item $stop->id_code + +Stop ID (code). + +=item $stop->place + +Place or city name, for instance "Essen". + +=item $stop->full_name + +stop name with place or city prefix ("I<City> I<Stop>", for instance +"Essen RE<uuml>ttenscheider Stern"). + +=item $stop->name + +stop name without place or city prefix, for instance "RE<uuml>ttenscheider Stern". + +=item $stop->latlon + +Arrayref describing the stop's latitude and longitude in WGS84 coordinates. + +=item $stop->platform + +Platform name/number if available, empty string otherwise. + +=back + +=head2 INTERNAL + +=over + +=item $stop = Travel::Status::DE::EFA::Stop->new(I<%data>) + +Returns a new Travel::Status::DE::EFA::Stop object. You should not need to +call this. + +=item $stop->TO_JSON + +Allows the object data to be serialized to JSON. + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +This module is a Work in Progress. +Its API may change between minor versions. + +=head1 SEE ALSO + +Travel::Status::DE::EFA(3pm). + +=head1 AUTHOR + +Copyright (C) 2015-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. diff --git a/lib/Travel/Status/DE/EFA/Trip.pm b/lib/Travel/Status/DE/EFA/Trip.pm new file mode 100644 index 0000000..fbe2643 --- /dev/null +++ b/lib/Travel/Status/DE/EFA/Trip.pm @@ -0,0 +1,375 @@ +package Travel::Status::DE::EFA::Trip; + +use strict; +use warnings; +use 5.010; + +use DateTime::Format::Strptime; +use Travel::Status::DE::EFA::Stop; + +use parent 'Class::Accessor'; + +our $VERSION = '3.15'; + +Travel::Status::DE::EFA::Trip->mk_ro_accessors( + qw(operator product product_class name line number type id dest_name dest_id) +); + +sub new { + my ( $obj, %conf ) = @_; + + 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}, + number => $json->{properties}{trainNumber}, + type => $json->{properties}{trainType} // $json->{product}{name}, + id => $json->{id}, + dest_name => $json->{destination}{name}, + dest_id => $json->{destination}{id}, + route_raw => $json->{locationSequence} + // $conf{json}{leg}{stopSequence}, + strptime_obj => DateTime::Format::Strptime->new( + pattern => '%Y-%m-%dT%H:%M:%SZ', + time_zone => 'UTC' + ), + }; + if ( ref( $ref->{polyline_raw} ) eq 'ARRAY' + and @{ $ref->{polyline_raw} } == 1 ) + { + $ref->{polyline_raw} = $ref->{polyline_raw}[0]; + } + return bless( $ref, $obj ); +} + +sub polyline { + my ( $self, %opt ) = @_; + + 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; + }; + + # 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]; + my $dist = $distance->distance_metal( + $stop->{latlon}[0], + $stop->{latlon}[1], + $pl->{lat}, $pl->{lon} + ); + my $key = $route_i . ';' . $stop->{id_code}; + if ( not $min_dist{$key} + or $min_dist{$key}{dist} > $dist ) + { + $min_dist{$key} = { + dist => $dist, + index => $polyline_index, + }; + } + } + $route_i += 1; + } + $route_i = 0; + for my $stop ( $self->route ) { + 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; + } + } + + return @{ $self->{polyline} }; +} + +sub parse_dt { + my ( $self, $value ) = @_; + + if ($value) { + my $dt = $self->{strptime_obj}->parse_datetime($value); + if ($dt) { + return $dt->set_time_zone('Europe/Berlin'); + } + } + return undef; +} + +sub route { + my ($self) = @_; + + if ( $self->{route} ) { + return @{ $self->{route} }; + } + + for my $stop ( @{ $self->{route_raw} // [] } ) { + my $chain = $stop; + my ( $platform, $place, $name, $name_full, $id_num, $id_code ); + while ( $chain->{type} ) { + if ( $chain->{type} eq 'platform' ) { + $platform = $chain->{properties}{platformName} + // $chain->{properties}{platform}; + } + elsif ( $chain->{type} eq 'stop' ) { + $name = $chain->{disassembledName}; + $name_full = $chain->{name}; + $id_code = $chain->{id}; + $id_num = $chain->{properties}{stopId}; + } + elsif ( $chain->{type} eq 'locality' ) { + $place = $chain->{name}; + } + $chain = $chain->{parent}; + } + push( + @{ $self->{route} }, + Travel::Status::DE::EFA::Stop->new( + sched_arr => $self->parse_dt( $stop->{arrivalTimePlanned} ), + sched_dep => $self->parse_dt( $stop->{departureTimePlanned} ), + rt_arr => $self->parse_dt( $stop->{arrivalTimeEstimated} ), + rt_dep => $self->parse_dt( $stop->{departureTimeEstimated} ), + 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, + ) + ); + } + + delete $self->{route_raw}; + + return @{ $self->{route} // [] }; +} + +sub TO_JSON { + my ($self) = @_; + + # lazy loading + $self->route; + + # lazy loading + $self->polyline; + + my $ret = { %{$self} }; + + delete $ret->{strptime_obj}; + + return $ret; +} + +1; + +__END__ + +=head1 NAME + +Travel::Status::DE::EFA::Trip - Information about an individual public transit +trip + +=head1 SYNOPSIS + + printf( "%s %s -> %s\n", $trip->type, $trip->line // q{}, $trip->dest_name ); + for my $stop ( $trip->route ) { + ...; + } + +=head1 VERSION + +version 3.15 + +=head1 DESCRIPTION + +Travel::Status::DE::EFA::Trip describes a single trip / journey of a public +transport line. + +=head1 METHODS + +=head2 ACCESSORS + +Most accessors return undef if the corresponding data is not available. + +=over + +=item $trip->operator + +Operator name. + +=item $trip->product + +Product name. + +=item $trip->product_class + +Product class. + +=item $trip->name + +Trip or line name. + +=item $trip->line + +Line identifier. Note that this is not necessarily numeric. + +=item $trip->number + +Trip/journey number. + +=item $trip->type + +Transport / vehicle type, e.g. "RE" or "Bus". + +=item $trip->id + +Unique(?) trip ID + +=item $trip->dest_name + +Name of the trip's destination stop + +=item $trip->dest_id + +ID of the trip's destination stop + +=item $trip->route + +List of Travel::Status::DE::EFA::Stop(3pm) objects describing the route of this +trip. + +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 + +=over + +=item $trip = Travel::Status::DE::EFA::Trip->new(I<%data>) + +Returns a new Travel::Status::DE::EFA::Trip object. You should not need to +call this. + +=item $trip->TO_JSON + +Allows the object data to be serialized to JSON. + +=back + +=head1 DIAGNOSTICS + +None. + +=head1 DEPENDENCIES + +=over + +=item Class::Accessor(3pm) + +=item DateTime::Format::Strptime(3pm) + +=item Travel::Status::DE::EFA::Stop(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +This module is a Work in Progress. +Its API may change between minor versions. + +=head1 SEE ALSO + +Travel::Status::DE::EFA(3pm). + +=head1 AUTHOR + +Copyright (C) 2024-2025 Birte Kristina Friesel E<lt>derf@finalrewind.orgE<gt> + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. |