From 78b9b451b2da03a3d3261247bbbdde2f8195919d Mon Sep 17 00:00:00 2001 From: networkException Date: Fri, 18 Apr 2025 13:33:55 +0200 Subject: Initial version of Travel::Status::MOTIS This patch contains the initial implementation of Travel::Status::MOTIS, an interface to MOTIS routing services for departures, trips and stop search based on Travel::Status::DE::DBRIS. While MOTIS' focus is on intermodal routing, this module has been written for use in https://finalrewind.org/projects/travelynx, as such it focuses on departures at stops and trips. As MOTIS is open source and can be self hosted, there are multiple services (sourced from the transport-apis repository located as a submodule in `ext/`), available: Currently RNV for local transit in Mannheim, Germany and surrounding cities and transitous for worldwide crowdsourced tranit feeds. In addition to scheduled stops and trips this module supports realtime delay predictions, tracks, polylines, cancellations, headsigns and route colors whenever available. --- .editorconfig | 11 + .gitignore | 6 + .gitmodules | 3 + Build.PL | 41 ++ COPYING | 6 + Changelog | 4 + Dockerfile | 23 ++ README.md | 6 + bin/motis | 532 ++++++++++++++++++++++++++ cpanfile | 15 + ext/transport-apis | 1 + lib/Travel/Status/MOTIS.pm | 595 ++++++++++++++++++++++++++++++ lib/Travel/Status/MOTIS/Polyline.pm | 98 +++++ lib/Travel/Status/MOTIS/Services.pm | 28 ++ lib/Travel/Status/MOTIS/Services.pm.PL | 135 +++++++ lib/Travel/Status/MOTIS/Stop.pm | 59 +++ lib/Travel/Status/MOTIS/Stopover.pm | 123 ++++++ lib/Travel/Status/MOTIS/Trip.pm | 186 ++++++++++ lib/Travel/Status/MOTIS/TripAtStopover.pm | 78 ++++ scripts/makedeb-docker | 11 + scripts/makedeb-docker-helper | 34 ++ shell.nix | 17 + xt/00-compile-pm.t | 8 + xt/01-compile-pl.t | 8 + xt/10-pod-coverage.t | 8 + 25 files changed, 2036 insertions(+) create mode 100644 .editorconfig create mode 100644 .gitignore create mode 100644 .gitmodules create mode 100644 Build.PL create mode 100644 COPYING create mode 100644 Changelog create mode 100644 Dockerfile create mode 100644 README.md create mode 100755 bin/motis create mode 100644 cpanfile create mode 160000 ext/transport-apis create mode 100644 lib/Travel/Status/MOTIS.pm create mode 100644 lib/Travel/Status/MOTIS/Polyline.pm create mode 100644 lib/Travel/Status/MOTIS/Services.pm create mode 100644 lib/Travel/Status/MOTIS/Services.pm.PL create mode 100644 lib/Travel/Status/MOTIS/Stop.pm create mode 100644 lib/Travel/Status/MOTIS/Stopover.pm create mode 100644 lib/Travel/Status/MOTIS/Trip.pm create mode 100644 lib/Travel/Status/MOTIS/TripAtStopover.pm create mode 100755 scripts/makedeb-docker create mode 100755 scripts/makedeb-docker-helper create mode 100644 shell.nix create mode 100755 xt/00-compile-pm.t create mode 100755 xt/01-compile-pl.t create mode 100755 xt/10-pod-coverage.t diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..023edcf --- /dev/null +++ b/.editorconfig @@ -0,0 +1,11 @@ +root = true + +[*] +charset = utf-8 +end_of_line = lf +insert_final_newline = true +indent_size = 4 +indent_style = space + +[*.pm *.pm.PL] +indent_style = tab diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..697aac5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +/_build +/Build +/blib +/cover_db +/MANIFEST* +/MYMETA.* diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..9e015f1 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "ext/transport-apis"] + path = ext/transport-apis + url = https://github.com/public-transport/transport-apis diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..b822881 --- /dev/null +++ b/Build.PL @@ -0,0 +1,41 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Module::Build; + +Module::Build->new( + build_requires => { + 'Test::Compile' => 0, + 'Test::More' => 0, + 'Test::Pod' => 0, + }, + configure_requires => { + 'Module::Build' => 0.40, + }, + module_name => 'Travel::Status::MOTIS', + license => 'perl', + recommends => { + 'Cache::File' => 0, + 'GIS::Distance' => 0, + }, + requires => { + 'perl' => '5.20.0', + 'Carp' => 0, + 'Class::Accessor' => '0.16', + 'DateTime' => 0, + 'DateTime::Format::ISO8601' => 0, + 'Getopt::Long' => 0, + 'JSON' => 0, + 'List::Util' => 0, + 'LWP::UserAgent' => 0, + 'LWP::Protocol::https' => 0, + 'URI' => 0, + }, + script_files => 'bin/', + sign => 1, + meta_merge => { + resources => + { repository => '' } + }, +)->create_build_script(); diff --git a/COPYING b/COPYING new file mode 100644 index 0000000..e89eab2 --- /dev/null +++ b/COPYING @@ -0,0 +1,6 @@ +Copyright (C) 2025 networkException + +Copyright (C) 2024-2025 Birte Kristina Friesel + +All files in this distribution are licensed under the same terms as Perl +itself. diff --git a/Changelog b/Changelog new file mode 100644 index 0000000..9154677 --- /dev/null +++ b/Changelog @@ -0,0 +1,4 @@ +Travel::Status::MOTIS 0.01 - Mon Apr 07 2025 + + * Initial release + * Supports stop board requests, trip details, and stop search diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..6b797b5 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,23 @@ +FROM perl:5.30-slim + +COPY bin/ /app/bin/ +COPY lib/ /app/lib/ +COPY Build.PL cpanfile* /app/ + +WORKDIR /app + +ARG DEBIAN_FRONTEND=noninteractive +ARG APT_LISTCHANGES_FRONTEND=none + +RUN apt-get update \ + && apt-get -y --no-install-recommends install ca-certificates curl gcc libc6-dev libssl1.1 libssl-dev make zlib1g-dev \ + && cpanm -n --no-man-pages --installdeps . \ + && perl Build.PL \ + && perl Build \ + && rm -rf ~/.cpanm \ + && apt-get -y purge curl gcc libc6-dev libssl-dev make zlib1g-dev \ + && apt-get -y autoremove \ + && apt-get -y clean \ + && rm -rf /var/cache/apt/* /var/lib/apt/lists/* + +ENTRYPOINT ["perl", "-Ilib", "bin/motis"] diff --git a/README.md b/README.md new file mode 100644 index 0000000..43d1261 --- /dev/null +++ b/README.md @@ -0,0 +1,6 @@ +# motis - Command Line Interface to MOTIS Routing Services + +**motis** is a commandline client and Perl module for MOTIS routing +interfaces. It can show the arrivals/departures at a specific public transit +stop, give details on individual trips, and look up stops by name or geo +coordinates. It supports text and JSON output. diff --git a/bin/motis b/bin/motis new file mode 100755 index 0000000..f6d0ab1 --- /dev/null +++ b/bin/motis @@ -0,0 +1,532 @@ +#!perl +use strict; +use warnings; +use 5.020; + +our $VERSION = '0.01'; + +use utf8; +use DateTime; +use Encode qw(decode); +use JSON; +use Getopt::Long qw(:config no_ignore_case); +use List::Util qw(min max); + +use Travel::Status::MOTIS; + +use Data::Dumper; + +my ( $date, $time ); +my $modes_of_transit; +my $developer_mode; +my $show_trip_ids; +my $use_cache = 1; +my $cache; +my ( $list_services, $service ); +my ( $json_output, $raw_json_output, $with_polyline ); + +my %known_mode_of_transit = map { $_ => 1 } + (qw(TRANSIT TRAM SUBWAY FERRY AIRPLANE BUS COACH RAIL METRO HIGHSPEED_RAIL LONG_DISTANCE NIGHT_RAIL REGIONAL_FAST_RAIL REGIONAL_RAIL)); + +binmode( STDOUT, ':encoding(utf-8)' ); +for my $arg (@ARGV) { + $arg = decode( 'UTF-8', $arg ); +} + +my $output_bold = -t STDOUT ? "\033[1m" : q{}; +my $output_reset = -t STDOUT ? "\033[0m" : q{}; + +my $cf_first = "\e[38;5;11m"; +my $cf_mixed = "\e[38;5;208m"; +my $cf_second = "\e[0m"; #"\e[38;5;9m"; +my $cf_reset = "\e[0m"; + +GetOptions( + 'd|date=s' => \$date, + 'h|help' => sub { show_help(0) }, + 'i|show-trip-ids' => \$show_trip_ids, + 'm|modes-of-transit=s' => \$modes_of_transit, + 't|time=s' => \$time, + 's|service=s' => \$service, + 'V|version' => \&show_version, + 'cache!' => \$use_cache, + 'devmode' => \$developer_mode, + 'json' => \$json_output, + 'raw-json' => \$raw_json_output, + 'list' => \$list_services, +) or show_help(1); + +if ($list_services) { + printf( + "%-40s %-14s %-15s\n\n", + 'operator', 'abbr. (-s)', 'languages (-l)', + ); + + for my $service ( Travel::Status::MOTIS::get_services() ) { + printf( + "%-40s %-14s %-15s\n", + $service->{name}, + $service->{shortname}, + join( q{ }, @{ $service->{languages} // [] } ), + ); + } + + exit 0; +} + +$service //= 'transitous'; + +if ($use_cache) { + my $cache_path = ( $ENV{XDG_CACHE_HOME} // "$ENV{HOME}/.cache" ) . '/Travel-Status-MOTIS'; + + eval { + require Cache::File; + + $cache = Cache::File->new( + cache_root => $cache_path, + default_expires => '90 seconds', + lock_level => Cache::File::LOCK_LOCAL(), + ); + }; + + if ($@) { + $cache = undef; + } +} + +my ( $input ) = @ARGV; + +if ( not $input ) { + show_help(1); +} + +my %opt = ( + cache => $cache, + service => $service, + developer_mode => $developer_mode, +); + +if ( $input =~ m{ ^ (? [0-9.]+ ) : (? [0-9].+ ) $ }x ) { + $opt{stops_by_coordinate} = { + lat => $+{lat}, + lon => $+{lon}, + }; +} +# Format: yyyymmdd_hh:mm_feed_id +elsif ( $input =~ m{^[0-9]{8}_[0-9]{2}:[0-9]{2}_} ) { + $opt{trip_id} = $input; +} +# Format: feed_id +elsif ( $input =~ m{_} ) { + $opt{stop_id} = $input; +} +else { + $opt{stops_by_query} = $input; + + my $status = Travel::Status::MOTIS->new(%opt); + if ( my $err = $status->errstr ) { + say STDERR "Request error while looking up '$opt{stops_by_query}': ${err}"; + exit 2; + } + + my $found; + for my $result ( $status->results ) { + if ( defined $result->id ) { + if ( lc( $result->name ) ne lc( $opt{stops_by_query} ) ) { + say $result->name; + } + + $opt{stop_id} = $result->id; + $found = 1; + last; + } + } + + if ( not $found ) { + say "Could not find stop '$opt{stops_by_query}'"; + exit 1; + } +} + +if ( $date or $time ) { + my $timestamp = DateTime->now( time_zone => 'local' ); + + if ($date) { + if ( $date + =~ m{ ^ (? \d{1,2} ) [.] (? \d{1,2} ) [.] (? \d{4})? $ }x + ) + { + $timestamp->set( + day => $+{day}, + month => $+{month} + ); + if ( $+{year} ) { + $timestamp->set( year => $+{year} ); + } + } + else { + say '--date must be specified as DD.MM.[YYYY]'; + exit 1; + } + } + + if ($time) { + if ( $time =~ m{ ^ (? \d{1,2} ) : (? \d{1,2} ) $ }x ) { + $timestamp->set( + hour => $+{hour}, + minute => $+{minute}, + second => 0, + ); + } + else { + say '--time must be specified as HH:MM'; + exit 1; + } + } + + $opt{timestamp} = $timestamp; +} + +if ( $modes_of_transit and $modes_of_transit eq 'help' ) { + say "Supported modes of transmit (-m / --modes-of-transit):"; + for my $mot ( + qw(TRANSIT TRAM SUBWAY FERRY AIRPLANE BUS COACH RAIL METRO HIGHSPEED_RAIL LONG_DISTANCE NIGHT_RAIL REGIONAL_FAST_RAIL REGIONAL_RAIL)) + { + say $mot; + } + + exit 0; +} + +if ($modes_of_transit) { + # Passing unknown MOTs to the backend results in HTTP 422 Unprocessable Entity + my @mots = split( qr{, *}, $modes_of_transit ); + + my $found_unknown; + for my $mot (@mots) { + if ( not $known_mode_of_transit{$mot} ) { + $found_unknown = 1; + say STDERR + "-m / --modes-of-transit: unknown mode of transit '$mot'"; + } + } + + if ($found_unknown) { + say STDERR 'supported modes of transit are: ' + . join( q{, }, sort keys %known_mode_of_transit ); + exit 1; + } + + $opt{modes_of_transit} = [ grep { $known_mode_of_transit{$_} } @mots ]; +} + +sub show_help { + my ($code) = @_; + + print + "Usage: motis [-d dd.mm.yyy] [-t hh:mm] [-i] \n" + . "See also: man motis\n"; + + exit $code; +} + +sub show_version { + say "motis version ${VERSION}"; + + exit 0; +} + +sub spacer { + my ($len) = @_; + return ( $len % 2 ? q { } : q{} ) . ( q{ ·} x ( $len / 2 ) ); +} + +sub format_delay { + my ( $delay, $len ) = @_; + if ( $delay and $len ) { + return sprintf( "(%+${len}d)", $delay ); + } + return q{}; +} + +my $status = Travel::Status::MOTIS->new(%opt); + +if ( my $err = $status->errstr ) { + say STDERR "Request error: ${err}"; + exit 2; +} + +if ($raw_json_output) { + say JSON->new->convert_blessed->encode( $status->{raw_json} ); + exit 0; +} + +if ($json_output) { + if ( $opt{journey} ) { + say JSON->new->convert_blessed->encode( $status->result ); + } + else { + say JSON->new->convert_blessed->encode( [ $status->results ] ); + } + + exit 0; +} + +if ( $opt{stop_id} ) { + my $max_route_name = max map { length( $_->route_name ) } $status->results; + my $max_headsign = max map { length( $_->headsign // q{} ) } $status->results; + my $max_delay = max map { length( $_->stopover->departure_delay // q{} ) } $status->results; + my $max_track = max map { length( $_->stopover->track // $_->stopover->scheduled_track // q{} ) } $status->results; + + $max_delay += 1; + + my @results = map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { [ ( $_->stopover->departure // $_->stopover->arrival )->epoch, $_ ] } $status->results; + + printf("%s\n\n", $results[0]->stopover->stop->name); + + for my $result (@results) { + printf( + "%s %s %${max_route_name}s %${max_headsign}s %${max_track}s\n", + $result->is_cancelled ? '--:--' : $result->stopover->departure->strftime('%H:%M'), + $result->stopover->departure_delay + ? sprintf( "(%+${max_delay}d)", $result->stopover->departure_delay ) + : q{ } x ( $max_delay + 2 ), + $result->route_name, + $result->headsign // q{???}, + $result->stopover->track // q{} + ); + + if ( $show_trip_ids ) { + say $result->id; + } + } +} +elsif ( $opt{trip_id} ) { + my $trip = $status->result; + + my $max_name = max map { length( $_->stop->name ) } $trip->stopovers; + my $max_track = max map { length( $_->track // q{} ) } $trip->stopovers; + my $max_delay = max map { $_->delay ? length( $_->delay ) + 3 : 0 } $trip->stopovers; + + my $mark_stop = 0; + my $now = DateTime->now; + + for my $i ( reverse 1 .. ( scalar $trip->stopovers // 0 ) ) { + my $stop = ( $trip->stopovers )[ $i - 1 ]; + + if ( + not $stop->is_cancelled + and ( $stop->departure and $now <= $stop->departure + or $stop->arrival and $now <= $stop->arrival ) + ) { + $mark_stop = $stop; + } + } + + printf( "%s am %s\n\n", $trip->route_name, $trip->scheduled_arrival->strftime('%d.%m.%Y') ); + + for my $stop ( $trip->stopovers ) { + if ( $stop == $mark_stop ) { + print($output_bold); + } + + if ( $stop->is_cancelled ) { + print(' --:-- '); + } + elsif ( $stop->arrival and $stop->departure ) { + printf( '%s → %s', + $stop->arrival->strftime('%H:%M'), + $stop->departure->strftime('%H:%M'), + ); + } + elsif ( $stop->departure ) { + printf( ' %s', $stop->departure->strftime('%H:%M') ); + } + elsif ( $stop->arrival ) { + printf( '%s ', $stop->arrival->strftime('%H:%M') ); + } + else { + print(' '); + } + + printf( " %${max_delay}s", format_delay( $stop->delay, $max_delay - 3 ) ); + printf( " %-${max_name}s %${max_track}s\n", $stop->stop->name, $stop->track // q{} ); + + if ( $stop == $mark_stop ) { + print($output_reset); + } + } +} +elsif ( $opt{stops_by_coordinate} ) { + for my $result ( $status->results ) { + if ( defined $result->id ) { + printf( "%8d %s\n", $result->id, $result->name ); + } + } +} +elsif ( $opt{stops_by_query} ) { + for my $result ( $status->results ) { + if ( defined $result->id ) { + printf( "%8d %s\n", $result->id, $result->name ); + } + } +} + +__END__ + +=head1 NAME + +motis - An interface to the MOTIS routing services + +=head1 SYNOPSIS + +B [B<-s> I] [B<-d> I] [B<-t> I] [B<-i>] [I] I + +B [B<-s> I] [I] I + +B [B<-s> I] I + +B [B<-s> I] BI|IB<:>I + +=head1 VERSION + +version 0.01 + +=head1 DESCRIPTION + +B is an interface to MOTIS routing services. It can serve as an +arrival/departure board, request details about a specific trip, and +look up public transport stops by name or geolocation. The operating +mode depends on the contents of its non-option argument. + +=head2 Departure Board (I) + +Show departures at I. I may be given as a stop name or +stop id. For each departure, B shows + +=over + +=item * estimated departure time, + +=item * delay, if known, + +=item * trip route name, + +=item * headsign / destination if known, and + +=item * track, if known. + +=back + +=head2 Trip details (I) + +List intermediate stops of I (as given by the departure board when +invoked with B<-i> / B<--show-trip-ids>) with arrival/departure time, delay (if +available), track (if available), and stop name. Also includes some generic +trip information. + +=head2 Stop Search (BI|IB<:>I) + +List stop that match I or that are located in the vicinity of +IB<:>I geocoordinates with stop id and name. + +=head1 OPTIONS + +Values in brackets indicate options that only apply to the corresponding +operating mode(s). + +=over + +=item B<-d>, B<--date> I (departure board) + +Request departures on the specified date. +Default: today. + +=item B<-t>, B<--time> I (departure board) + +Request departures on the specified time. +Default: now. + +=item B<-i>, B<--show-trip-ids> (departure board) + +Show trip id for each listed arrival/departure. +These can be used to obtain details on individual trips with subsequent +B invocations. + +=item B<-m>, B<--modes-of-transit> I[,I,...] (departure board) + +Only return results for the specified modes of transit. +Use C<<-m help>> to get a list of supported modes of transit. + +=item B<--json> + +Print result(s) as JSON and exit. This is a dump of internal data structures +and not guaranteed to remain stable between minor versions. Please use the +Travel::Status::MOTIS(3pm) module if you need a proper API. + +=item B<--no-cache> + +By default, if the Cache::File module is available, server replies are cached +for 90 seconds in F<~/.cache/Travel-Status-MOTIS> (or a path relative to +C<$XDG_CACHE_HOME>, if set). Use this option to disable caching. You can use +B<--cache> to re-enable it. + +=item B<--raw-json> + +Print unprocessed API response as JSON and exit. +Useful for debugging and development purposes. + +=item B<-t>, B<--date> I (departure board) + +Request departures on or after the specified time. +Default: now. + +=item B<-V>, B<--version> + +Show version information and exit. + +=back + +=head1 EXIT STATUS + +0 upon success, 1 upon internal error, 2 upon backend error. + +=head1 CONFIGURATION + +None. + +=head1 DEPENDENCIES + +=over + +=item * Class::Accessor(3pm) + +=item * DateTime(3pm) + +=item * LWP::UserAgent(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +=over + +This module is mainly to debug the Travel::Status::MOTIS(3pm) module designed +for use in travelynx (L) and as +such might not contain functionality needed otherwise. + +=back + +=head1 AUTHOR + +Copyright (C) networkException Egit@nwex.deE + +Based on Travel::Status::DE::DBRIS + +Copyright (C) 2024-2025 Birte Kristina Friesel Ederf@finalrewind.orgE + +=head1 LICENSE + +This program is licensed under the same terms as Perl itself. diff --git a/cpanfile b/cpanfile new file mode 100644 index 0000000..fa31f4a --- /dev/null +++ b/cpanfile @@ -0,0 +1,15 @@ +requires 'Class::Accessor'; +requires 'DateTime'; +requires 'DateTime::Format::ISO8601'; +requires 'Getopt::Long'; +requires 'JSON'; +requires 'List::Util'; +requires 'LWP::UserAgent'; +requires 'LWP::Protocol::https'; + +on test => sub { + requires 'File::Slurp'; + requires 'Test::Compile'; + requires 'Test::More'; + requires 'Test::Pod'; +}; diff --git a/ext/transport-apis b/ext/transport-apis new file mode 160000 index 0000000..0195bc6 --- /dev/null +++ b/ext/transport-apis @@ -0,0 +1 @@ +Subproject commit 0195bc662df790c1dee92aaaaa9fd4966cd35a22 diff --git a/lib/Travel/Status/MOTIS.pm b/lib/Travel/Status/MOTIS.pm new file mode 100644 index 0000000..23cc55e --- /dev/null +++ b/lib/Travel/Status/MOTIS.pm @@ -0,0 +1,595 @@ +package Travel::Status::MOTIS; + +# vim:foldmethod=marker + +use strict; +use warnings; +use 5.020; +use utf8; + +use Carp qw(confess); +use DateTime; +use DateTime::Format::ISO8601; +use Encode qw(decode encode); +use JSON; + +use LWP::UserAgent; + +use URI; + +use Travel::Status::MOTIS::Services; +use Travel::Status::MOTIS::TripAtStopover; +use Travel::Status::MOTIS::Trip; +use Travel::Status::MOTIS::Stopover; +use Travel::Status::MOTIS::Stop; + +our $VERSION = '0.01'; + +# {{{ Endpoint Definition + +# Data sources: . +# Thanks to Jannis R / @derhuerst and all contributors for maintaining these. +my $motis_instance = Travel::Status::MOTIS::Services::get_service_ref(); + +# {{{ Constructors + +sub new { + my ( $obj, %conf ) = @_; + my $service = $conf{service}; + + if ( not defined $service ) { + confess("You must specify a service"); + } + + if ( defined $service and not exists $motis_instance->{$service} ) { + confess("The service '$service' is not supported"); + } + + my $user_agent = $conf{user_agent}; + + if ( not $user_agent ) { + $user_agent = LWP::UserAgent->new(%{ + $conf{lwp_options} // { timeout => 10 } + }); + } + + my $self = { + cache => $conf{cache}, + developer_mode => $conf{developer_mode}, + results => [], + station => $conf{station}, + user_agent => $user_agent, + }; + + bless( $self, $obj ); + + my $request_url = URI->new; + + if ( my $stop_id = $conf{stop_id} ) { + my $timestamp = $conf{timestamp} // DateTime->now; + + my @modes_of_transit = ( qw(TRANSIT) ); + + if ( $conf{modes_of_transit} ) { + @modes_of_transit = @{ $conf{modes_of_transit} // [] }; + } + + $request_url->path('api/v1/stoptimes'); + $request_url->query_form( + time => DateTime::Format::ISO8601->format_datetime( $timestamp ), + stopId => $stop_id, + n => $conf{results} // 10, + mode => join( ',', @modes_of_transit ), + ); + } + elsif ( my $trip_id = $conf{trip_id} ) { + $request_url->path('api/v1/trip'); + $request_url->query_form( + tripId => $trip_id, + ); + } + elsif ( my $coordinates = $conf{stops_by_coordinate} ) { + my $lat = $coordinates->{lat}; + my $lon = $coordinates->{lon}; + + $request_url->path('api/v1/reverse-geocode'); + $request_url->query_form( + type => 'STOP', + place => "$lat,$lon,0", + ); + } + elsif ( my $query = $conf{stops_by_query} ) { + $request_url->path('api/v1/geocode'); + $request_url->query_form( + text => $query, + ); + } + else { + confess('stop_id / trip_id / stops_by_coordinate / stops_by_query must be specified'); + } + + my $json = $self->{json} = JSON->new->utf8; + + $request_url = $request_url->abs( $motis_instance->{$service}{endpoint} )->as_string; + + if ( $conf{async} ) { + $self->{request_url} = $request_url; + return $self; + } + + if ( $conf{json} ) { + $self->{raw_json} = $conf{json}; + } + else { + if ( $self->{developer_mode} ) { + say "requesting $request_url"; + } + + my ( $content, $error ) = $self->get_with_cache($request_url); + + if ($error) { + $self->{errstr} = $error; + return $self; + } + + if ( $self->{developer_mode} ) { + say decode( 'utf-8', $content ); + } + + $self->{raw_json} = $json->decode($content); + } + + if ( $conf{stop_id} ) { + $self->parse_trips_at_stopover; + } + elsif ( $conf{trip_id} ) { + $self->parse_trip; + } + elsif ( $conf{stops_by_query} or $conf{stops_by_coordinate} ) { + $self->parse_stops_by; + } + + return $self; +} + +sub new_p { + my ( $obj, %conf ) = @_; + + my $promise = $conf{promise}->new; + + if (not($conf{stop_id} + or $conf{trip_id} + or $conf{stops_by_coordinate} + or $conf{stops_by_query} + )) { + return $promise->reject( + 'stop_id / trip_id / stops_by_coordinate / stops_by_query flag must be passed' + ); + } + + my $self = $obj->new( %conf, async => 1 ); + + $self->{promise} = $conf{promise}; + + $self->get_with_cache_p( $self->{request_url} )->then( + sub { + my ($content) = @_; + $self->{raw_json} = $self->{json}->decode($content); + + if ( $conf{stop_id} ) { + $self->parse_trips_at_stopover; + } + elsif ( $conf{trip_id} ) { + $self->parse_trip; + } + elsif ( $conf{stops_by_query} or $conf{stops_by_coordinate} ) { + $self->parse_stops_by; + } + + if ( $self->errstr ) { + $promise->reject( $self->errstr, $self ); + } + else { + $promise->resolve($self); + } + + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +# }}} +# {{{ Internal Helpers + +sub get_with_cache { + my ( $self, $url ) = @_; + my $cache = $self->{cache}; + + if ( $self->{developer_mode} ) { + say "GET $url"; + } + + if ($cache) { + my $content = $cache->thaw($url); + if ($content) { + if ( $self->{developer_mode} ) { + say ' cache hit'; + } + + return ( ${$content}, undef ); + } + } + + if ( $self->{developer_mode} ) { + say ' cache miss'; + } + + my $reply = $self->{user_agent}->get($url); + + if ( $reply->is_error ) { + return ( undef, $reply->status_line ); + } + + my $content = $reply->content; + + if ($cache) { + $cache->freeze( $url, \$content ); + } + + return ( $content, undef ); +} + +sub get_with_cache_p { + my ( $self, $url ) = @_; + + my $cache = $self->{cache}; + + if ( $self->{developer_mode} ) { + say "GET $url"; + } + + my $promise = $self->{promise}->new; + + if ($cache) { + my $content = $cache->thaw($url); + if ($content) { + if ( $self->{developer_mode} ) { + say ' cache hit'; + } + + return $promise->resolve( ${$content} ); + } + } + + if ( $self->{developer_mode} ) { + say ' cache miss'; + } + + $self->{user_agent}->get_p($url)->then( + sub { + my ($tx) = @_; + if ( my $err = $tx->error ) { + $promise->reject("GET $url returned HTTP $err->{code} $err->{message}"); + + return; + } + + my $content = $tx->res->body; + + if ($cache) { + $cache->freeze( $url, \$content ); + } + + $promise->resolve($content); + return; + } + )->catch( + sub { + my ($err) = @_; + $promise->reject($err); + return; + } + )->wait; + + return $promise; +} + +sub parse_trip { + my ( $self, %opt ) = @_; + + $self->{result} = Travel::Status::MOTIS::Trip->new( json => $self->{raw_json} ); +} + +sub parse_stops_by { + my ($self) = @_; + + @{ $self->{results} } = map { + $_->{type} eq 'STOP' ? Travel::Status::MOTIS::Stop->from_match( json => $_ ) : () + } @{ $self->{raw_json} // [] }; + + return $self; +} + +sub parse_trips_at_stopover { + my ($self) = @_; + + @{ $self->{results} } = map { + Travel::Status::MOTIS::TripAtStopover->new( json => $_ ) + } @{ $self->{raw_json}{stopTimes} // [] }; + + return $self; +} + +# }}} +# {{{ Public Functions + +sub errstr { + my ($self) = @_; + + return $self->{errstr}; +} + +sub results { + my ($self) = @_; + return @{ $self->{results} }; +} + +sub result { + my ($self) = @_; + return $self->{result}; +} + +# static +sub get_services { + my @services; + for my $service ( sort keys %{$motis_instance} ) { + my %desc = %{ $motis_instance->{$service} }; + $desc{shortname} = $service; + push( @services, \%desc ); + } + return @services; +} + +# static +sub get_service { + my ($service) = @_; + + if ( defined $service and exists $motis_instance->{$service} ) { + return $motis_instance->{$service}; + } + return; +} + +# }}} + +1; + +__END__ + +=head1 NAME + +Travel::Status::MOTIS - An interface to the MOTIS routing service + +=head1 SYNOPSIS + +Blocking variant: + + use Travel::Status::MOTIS; + + my $status = Travel::Status::MOTIS->new( + service => 'RNV', + stop_id => 'rnv_241721', + ); + + for my $result ($status->results) { + printf( + "%s +%-3d %10s -> %s\n", + $result->stopover->departure->strftime('%H:%M'), + $result->stopover->delay, + $result->route_name, + $result->headsign, + ); + } + +Non-blocking variant; + + use Mojo::Promise; + use Mojo::UserAgent; + use Travel::Status::MOTIS; + + Travel::Status::MOTIS->new_p( + service => 'RNV', + stop_id => 'rnv_241721', + promise => 'Mojo::Promise', + user_agent => Mojo::UserAgent->new + )->then(sub { + my ($status) = @_; + for my $result ($status->results) { + printf( + "%s +%-3d %10s -> %s\n", + $result->stopover->departure->strftime('%H:%M'), + $result->stopover->delay, + $result->route_name, + $result->headsign, + ); + } + })->wait; + +=head1 VERSION + +version 0.01 + +=head1 DESCRIPTION + +Travel::Status::MOTIS is an interface to the departures and trips +provided by MOTIS routing services + +=head1 METHODS + +=over + +=item my $status = Travel::Status::MOTIS->new(I<%opt>) + +Requests item(s) as specified by I and returns a new +Travel::Status::MOTIS element with the results. Dies if the wrong +I were passed. + +I must contain exactly one of the following keys: + +=over + +=item B => I<$stop_id> + +Request stop board (departures) for the stop specified by I<$stop_id>. +Use B or B to obtain a stop id. +Results are available via C<< $status->results >>. + +=item B => B<{> B => I, B => I B<}> + +Search for stops near I, I. +Results are available via C<< $status->results >>. + +=item B => I<$query> + +Search for stops whose name is equal or similar to I. Results are +available via C<< $status->results >> and include the stop id needed for +stop board requests. + +=item B => I<$trip_id> + +Request trip details for I<$trip_id>. +The result is available via C<< $status->result >>. + +=back + +The following optional keys may be set. +Values in brackets indicate keys that are only relevant in certain request +modes, e.g. stops_by_coordinate or stop_id. + +=over + +=item B => I<$obj> + +A Cache::File(3pm) object used to cache realtime data requests. It should be +configured for an expiry of one to two minutes. + +=item B => I<\%hashref> + +Passed on to C<< LWP::UserAgent->new >>. Defaults to C<< { timeout => 10 } >>, +you can use an empty hashref to unset the default. + +=item B => I<\@arrayref> (stop_id) + +Only consider the modes of transit given in I when listing +departures. Accepted modes of transit are: +TRANSIT (same as RAIL, SUBWAY, TRAM, BUS, FERRY, AIRPLANE, COACH), +TRAM, +SUBWAY, +FERRY, +AIRPLANE, +BUS, +COACH, +RAIL (same as HIGHSPEED_RAIL, LONG_DISTANCE_RAIL, NIGHT_RAIL, REGIONAL_RAIL, REGIONAL_FAST_RAIL), +METRO, +HIGHSPEED_RAIL, +LONG_DISTANCE, +NIGHT_RAIL, +REGIONAL_FAST_RAIL, +REGIONAL_RAIL. + +By default, Travel::Status::MOTIS uses TRANSIT. + +=item B => I<\%json> + +Do not perform a request to MOTIS; load the prepared response provided in +I instead. Note that you still need to specify B, B, +etc. as appropriate. + +=back + +=item my $promise = Travel::Status::MOTIS->new_p(I<%opt>) + +Return a promise yielding a Travel::Status::MOTIS instance (C<< $status >>) +on success, or an error message (same as C<< $status->errstr >>) on failure. + +In addition to the arguments of B, the following mandatory arguments must +be set: + +=over + +=item B => I + +Promises implementation to use for internal promises as well as B return +value. Recommended: Mojo::Promise(3pm). + +=item B => I + +User agent instance to use for asynchronous requests. The object must support +promises (i.e., it must implement a C<< get_p >> function). Recommended: +Mojo::UserAgent(3pm). + +=back + +=item $status->errstr + +In case of a fatal HTTP request or backend error, returns a string describing +it. Returns undef otherwise. + +=item $status->results (stop_id, stops_by_query, stops_by_coordinate) + +Returns a list of Travel::Status::MOTIS::Stop(3pm) or Travel::Status::MOTIS::TripAtStopover(3pm) objects, depending on the arguments passed to B. + +=item $status->result (trip_id) + +Returns a Travel::Status::MOTIS::Trip(3pm) object, depending on the arguments passed to B. + +=back + +=head1 DIAGNOSTICS + +Calling B or B with the B key set to a true value +causes this module to print MOTIS requests and responses on the standard +output. + +=head1 DEPENDENCIES + +=over + +=item * DateTime(3pm) + +=item * DateTime::Format::ISO8601(3pm) + +=item * LWP::UserAgent(3pm) + +=item * URI(3pm) + +=back + +=head1 BUGS AND LIMITATIONS + +This module is designed for use in travelynx (L) and +might not contain functionality needed otherwise. + +=head1 REPOSITORY + +L + +=head1 AUTHOR + +Copyright (C) 2025 networkException Egit@nwex.deE + +Based on Travel::Status::DE::DBRIS + +Copyright (C) 2024-2025 Birte Kristina Friesel Ederf@finalrewind.orgE + +=head1 LICENSE + +This module is licensed under the same terms as Perl itself. diff --git a/lib/Travel/Status/MOTIS/Polyline.pm b/lib/Travel/Status/MOTIS/Polyline.pm new file mode 100644 index 0000000..ea46526 --- /dev/null +++ b/lib/Travel/Status/MOTIS/Polyline.pm @@ -0,0 +1,98 @@ +package Travel::Status::MOTIS::Polyline; + +use strict; +use warnings; +use 5.014; + +# Adapted from code by Slaven Rezic +# +# Copyright (C) 2009,2010,2012,2017,2018 Slaven Rezic. All rights reserved. +# This package is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# Mail: slaven@rezic.de +# WWW: http://www.rezic.de/eserte/ + +use parent 'Exporter'; + +our @EXPORT_OK = qw(decode_polyline); + +our $VERSION = '0.01'; + +# Translated this php script +# +# to perl +sub decode_polyline { + my ($encoded) = @_; + + my $length = length $encoded; + my $index = 0; + my @points; + my $lat = 0; + my $lon = 0; + + while ( $index < $length ) { + + # The encoded polyline consists of a latitude value followed + # by a longitude value. They should always come in pairs. Read + # the latitude value first. + for my $val ( \$lat, \$lon ) { + my $shift = 0; + my $result = 0; + + # Temporary variable to hold each ASCII byte. + my $b; + do { + # The `ord(substr($encoded, $index++))` statement returns + # the ASCII code for the character at $index. Subtract 63 + # to get the original value. (63 was added to ensure + # proper ASCII characters are displayed in the encoded + # polyline string, which is `human` readable) + $b = ord( substr( $encoded, $index++, 1 ) ) - 63; + + # AND the bits of the byte with 0x1f to get the original + # 5-bit `chunk. Then left shift the bits by the required + # amount, which increases by 5 bits each time. OR the + # value into $results, which sums up the individual 5-bit + # chunks into the original value. Since the 5-bit chunks + # were reversed in order during encoding, reading them in + # this way ensures proper summation. + $result |= ( $b & 0x1f ) << $shift; + $shift += 5; + } + + # Continue while the read byte is >= 0x20 since the last + # `chunk` was not OR'd with 0x20 during the conversion + # process. (Signals the end) + while ( $b >= 0x20 ); + + # see last paragraph of "Integer Arithmetic" in perlop.pod + use integer; + + # Check if negative, and convert. (All negative values have the last bit + # set) + my $dtmp + = ( ( $result & 1 ) ? ~( $result >> 1 ) : ( $result >> 1 ) ); + + # Compute actual latitude (resp. longitude) since value is + # offset from previous value. + $$val += $dtmp; + } + + # The actual latitude and longitude values were multiplied by + # 1e5 before encoding so that they could be converted to a 32-bit + # integer representation. (With a decimal accuracy of 7 places) + # Convert back to original values. + push( + @points, + { + lat => $lat * 1e-7, + lon => $lon * 1e-7 + } + ); + } + + return @points; +} + +1; diff --git a/lib/Travel/Status/MOTIS/Services.pm b/lib/Travel/Status/MOTIS/Services.pm new file mode 100644 index 0000000..71ec12b --- /dev/null +++ b/lib/Travel/Status/MOTIS/Services.pm @@ -0,0 +1,28 @@ +package Travel::Status::MOTIS::Services; + +# vim:readonly +# This module has been automatically generated +# by lib/Travel/Status/MOTIS/Services.pm.PL. +# Do not edit, changes will be lost. + +use strict; +use warnings; +use 5.014; +use utf8; + +our $VERSION = '0.01'; + +# Source . +# Many thanks to Jannis R / @derhuerst and all contributors for maintaining +# these resources. + +my $motis_instance = {'RNV' => {'coverage' => {'area' => {'coordinates' => [[['8.66147483636217','49.5668219936431'],['8.64642540920443','49.5568382715344'],['8.61042656597024','49.5503084660978'],['8.5819681642929','49.5577725222357'],['8.55635172724939','49.5487563121438'],['8.54881233439468','49.5248230928757'],['8.53276821729179','49.536837593048'],['8.49568358055447','49.5727690805899'],['8.47596243926148','49.5848639899874'],['8.44614801871398','49.5910126926984'],['8.42198404713383','49.5842342192271'],['8.41736989283368','49.5487563121438'],['8.40346035903804','49.5452129786743'],['8.37114730950125','49.555406853935'],['8.33286120248991','49.5529790328013'],['8.33137693421639','49.5375718561748'],['8.33494334548936','49.5221286699925'],['8.33690677795104','49.4988964466165'],['8.30678042064534','49.4885500590892'],['8.26784895688698','49.4838521585405'],['8.25423585654025','49.4735369859369'],['8.20632998266032','49.4760094013827'],['8.14462323584891','49.4734833746128'],['8.13045619910952','49.4443930041389'],['8.18420778670873','49.442720268909'],['8.27254930011','49.4496939870607'],['8.32155433680973','49.4591951125256'],['8.34370942136059','49.4513729891719'],['8.3668669374886','49.4323454360553'],['8.40277547897756','49.4209418648904'],['8.43005534345036','49.4239778970603'],['8.45940926837977','49.4431216465173'],['8.4917354449758','49.44388447979'],['8.51038774276287','49.4335868229186'],['8.49878755048184','49.417042238655'],['8.49553985226339','49.3996923273633'],['8.52037431311788','49.4046918305137'],['8.53117721917823','49.3953565625151'],['8.52699948591896','49.3835271603866'],['8.56649226595519','49.388735051347'],['8.60276909446185','49.3757445454189'],['8.60885726020382','49.3468487087811'],['8.64130741433121','49.3401811679553'],['8.65302897048286','49.3230983004625'],['8.70909291220218','49.312292313098'],['8.71188049820543','49.3403826797658'],['8.75572569226915','49.3430562267034'],['8.82165874069668','49.3630985437148'],['8.83347847335665','49.3927451052107'],['8.82975787417305','49.4998502106185'],['8.80422336940282','49.5074733892921'],['8.74840593219253','49.5017997361833'],['8.73188936131828','49.4590738976289'],['8.70928817502508','49.4483252857173'],['8.69685148074061','49.4688987841802'],['8.70045176672548','49.5065198846691'],['8.71373125714393','49.5462937942235'],['8.69365314006183','49.5626169448028'],['8.66147483636217','49.5668219936431']]],'type' => 'Polygon'},'regions' => ['DE-HE','DE-BW','DE-RP']},'endpoint' => 'https://directions.nwex.de/api/providers/rhein-neckar-verkehr/','homepage' => 'https://www.opendata-oepnv.de/ht/de/organisation/verkehrsunternehmen/rnv/openrnv/datensaetze','languages' => ['de'],'license' => 'https://www.govdata.de/dl-de/by-2-0','name' => 'Rhein-Neckar-Verkehr'},'transitous' => {'coverage' => {'area' => {'coordinates' => [[[['5.85','49.48'],['5.88','49.49'],['5.95','49.6'],['5.97','49.6'],['5.99','49.69'],['5.83','49.82'],['5.84','49.93'],['5.99','50.09'],['6.13','50.06'],['6.19','50.05'],['6.23','50.18'],['6.47','50.28'],['6.48','50.34'],['6.43','50.48'],['6.47','50.53'],['6.31','50.57'],['6.36','50.66'],['6.3','50.7'],['6.12','50.79'],['6.17','50.91'],['6.16','50.98'],['6.01','51.02'],['6.21','51.09'],['6.32','51.17'],['6.19','51.23'],['6.27','51.3'],['6.3','51.32'],['6.3','51.5'],['6.09','51.76'],['6.16','51.77'],['6.26','51.74'],['6.25','51.8'],['6.37','51.76'],['6.4','51.74'],['6.48','51.8'],['6.48','51.81'],['6.75','51.83'],['6.77','51.83'],['6.9','51.95'],['6.91','52.02'],['6.85','52.06'],['7.11','52.18'],['7.15','52.23'],['7.06','52.51'],['7.02','52.54'],['6.84','52.54'],['6.84','52.57'],['7.07','52.56'],['7.12','52.6'],['7.28','53.12'],['7.32','53.13'],['7.26','53.34'],['7.24','53.41'],['7.03','53.4'],['6.8','53.58'],['6.4','53.78'],['6.37','53.82'],['5.04','53.65'],['5.02','53.65'],['4.55','53.42'],['4.53','53.41'],['4.28','53.08'],['4.27','53.06'],['4.09','52.41'],['3.25','51.87'],['3.24','51.87'],['3.03','51.63'],['3.01','51.6'],['2.45','51.36'],['2.27','51.31'],['2.55','50.93'],['2.53','50.87'],['2.52','50.82'],['2.69','50.71'],['2.67','50.69'],['2.9','50.62'],['2.92','50.62'],['3.12','50.7'],['3.23','50.49'],['3.24','50.46'],['3.56','50.43'],['3.66','50.25'],['3.7','50.23'],['4.02','50.28'],['4.11','50.24'],['4.07','50.18'],['4.01','50.12'],['4.09','50.08'],['4.02','50.03'],['4.15','49.91'],['4.17','49.88'],['4.69','49.92'],['4.72','49.92'],['4.77','49.98'],['4.78','49.76'],['4.82','49.73'],['5.23','49.63'],['5.43','49.44'],['5.46','49.42'],['5.85','49.48']]],[[['9.05','45.76'],['9.19','45.91'],['9.14','45.95'],['9.09','46.02'],['9.33','46.22'],['9.32','46.25'],['9.34','46.43'],['9.42','46.44'],['9.51','46.22'],['9.57','46.24'],['9.92','46.31'],['10','46.17'],['10.04','46.16'],['10.19','46.16'],['10.2','46.21'],['10.24','46.43'],['10.2','46.47'],['10.11','46.49'],['10.11','46.5'],['10.22','46.55'],['10.26','46.49'],['10.29','46.48'],['10.5','46.48'],['10.56','46.53'],['10.46','46.69'],['10.57','46.96'],['10.52','46.99'],['10.39','47.07'],['10.35','47.06'],['10.1','46.91'],['9.94','46.98'],['9.94','47.08'],['9.88','47.09'],['9.56','47.11'],['9.59','47.23'],['9.74','47.35'],['9.74','47.42'],['9.54','47.6'],['9.27','47.72'],['9.25','47.72'],['8.92','47.71'],['8.83','47.8'],['8.75','47.8'],['8.75','47.78'],['8.57','47.89'],['8.53','47.86'],['8.32','47.69'],['8.34','47.66'],['8.21','47.69'],['8.2','47.69'],['7.76','47.61'],['7.77','47.65'],['7.7','47.67'],['7.55','47.65'],['7.54','47.63'],['7.38','47.5'],['7.28','47.49'],['7.24','47.55'],['7.21','47.56'],['6.94','47.56'],['6.93','47.53'],['6.8','47.36'],['6.83','47.29'],['6.87','47.29'],['6.9','47.28'],['6.68','47.11'],['6.34','46.96'],['6.37','46.91'],['6.38','46.81'],['5.99','46.58'],['6.04','46.55'],['5.98','46.38'],['6.04','46.36'],['6.06','46.35'],['5.85','46.1'],['5.95','46.06'],['6.33','46.17'],['6.39','46.22'],['6.31','46.31'],['6.36','46.34'],['6.43','46.35'],['6.68','46.39'],['6.75','46.37'],['6.73','46.11'],['6.76','46.07'],['6.81','46.07'],['6.79','46.02'],['6.87','45.98'],['6.91','45.99'],['7.07','45.79'],['7.12','45.79'],['7.57','45.92'],['7.87','45.85'],['7.9','45.86'],['8.22','46.12'],['8.22','46.17'],['8.18','46.24'],['8.38','46.35'],['8.38','46.19'],['8.42','46.19'],['8.59','46.06'],['8.6','46.06'],['8.74','46.03'],['8.66','45.95'],['8.77','45.93'],['8.84','45.91'],['8.86','45.75'],['8.92','45.76'],['9.02','45.75'],['9.05','45.76']]],[[['-62.79','17.53'],['-62.72','17.63'],['-63.04','17.83'],['-62.93','17.96'],['-62.88','18.03'],['-62.98','18.09'],['-62.99','18.1'],['-63.14','18.1'],['-63.17','18.09'],['-63.34','17.89'],['-63.3','17.86'],['-63.43','17.82'],['-63.45','17.8'],['-63.51','17.56'],['-63.5','17.53'],['-63.08','17.24'],['-63.04','17.22'],['-62.79','17.53']]],[[['-69.62','12.37'],['-69.62','12.39'],['-69.64','12.55'],['-69.65','12.56'],['-69.88','12.81'],['-70.02','12.87'],['-70.06','12.87'],['-70.2','12.82'],['-70.22','12.81'],['-70.31','12.49'],['-70.31','12.47'],['-70.21','12.33'],['-70.19','12.31'],['-69.79','12.23'],['-69.71','12.21'],['-69.62','12.37']]],[[['-68.53','11.76'],['-68.51','11.77'],['-68.43','11.87'],['-68.34','11.79'],['-68.32','11.79'],['-68.15','11.8'],['-68.13','11.81'],['-67.95','12.06'],['-67.95','12.08'],['-67.99','12.36'],['-68.01','12.38'],['-68.32','12.55'],['-68.34','12.55'],['-68.58','12.48'],['-68.6','12.46'],['-68.65','12.3'],['-69.06','12.62'],['-69.08','12.63'],['-69.26','12.61'],['-69.28','12.6'],['-69.4','12.46'],['-69.41','12.44'],['-69.4','12.22'],['-69.39','12.2'],['-69.26','12.03'],['-69.25','12.02'],['-68.72','11.74'],['-68.7','11.74'],['-68.53','11.76']]]],'type' => 'MultiPolygon'},'regions' => ['BE','CH','NL']},'endpoint' => 'https://api.transitous.org/','homepage' => 'https://transitous.org/','languages' => [],'license' => undef,'name' => 'Transitous open public transport routing'}}; +sub get_service_ref { + return $motis_instance; +} + +sub get_service_map { + return %{$motis_instance}; +} + +1; diff --git a/lib/Travel/Status/MOTIS/Services.pm.PL b/lib/Travel/Status/MOTIS/Services.pm.PL new file mode 100644 index 0000000..dc86963 --- /dev/null +++ b/lib/Travel/Status/MOTIS/Services.pm.PL @@ -0,0 +1,135 @@ +#!/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}.json") ); + my %ret = ( + name => $data->{name} =~ s{ *[(][^)]+[)]}{}r, + license => $data->{attribution}{license}, + homepage => $data->{attribution}{homepage}, + languages => $data->{supportedLanguages}, + endpoint => $data->{options}{endpoint}, + coverage => { + area => $data->{coverage}{realtimeCoverage}{area}, + regions => $data->{coverage}{realtimeCoverage}{region} // [] + }, + ); + + my %bitmask_to_product; + for my $product ( @{ $data->{options}{products} // [] } ) { + for my $bitmask ( @{ $product->{bitmasks} // [] } ) { + $bitmask_to_product{$bitmask} = $product; + } + } + + my $skipped = 0; + for my $bit ( 0 .. 15 ) { + if ( my $p = $bitmask_to_product{ 2**$bit } ) { + for ( 1 .. $skipped ) { + push( @{ $ret{productbits} }, [ "_", undef ] ); + } + if ( $p->{name} ) { + push( @{ $ret{productbits} }, [ $p->{id}, $p->{name} ] ); + } + else { + push( @{ $ret{productbits} }, $p->{id} ); + } + } + else { + $skipped += 1; + } + } + + if ( $data->{options}{ext} ) { + $ret{request}{ext} = $data->{options}{ext}; + } + if ( $data->{options}{ver} ) { + $ret{request}{ver} = $data->{options}{ver}; + } + elsif ( $data->{options}{version} ) { + $ret{request}{ver} = $data->{options}{version}; + } + + if ( $opt{geoip_lock} ) { + $ret{geoip_lock} = $opt{geoip_lock}; + } + + if ( $opt{lang} ) { + $ret{request}{lang} = $opt{lang}; + } + if ( $opt{ua_string} ) { + $ret{ua_string} = $opt{ua_string}; + } + if ( $opt{ver} ) { + $ret{request}{ver} = $opt{ver}; + } + + return %ret; +} + +my %motis_instance = ( + RNV => { + load_instance('de/rnv-motis') + }, + transitous => { + load_instance('un/transitous') + }, +); + +my $perlobj = Data::Dumper->new( [ \%motis_instance ], ['motis_instance'] ); + +my $buf = <<'__EOF__'; +package Travel::Status::MOTIS::Services; + +# vim:readonly +# This module has been automatically generated +# by lib/Travel/Status/MOTIS/Services.pm.PL. +# Do not edit, changes will be lost. + +use strict; +use warnings; +use 5.014; +use utf8; + +our $VERSION = '0.01'; + +# Source . +# Many thanks to Jannis R / @derhuerst and all contributors for maintaining +# these resources. + +__EOF__ + +$buf .= 'my ' . $perlobj->Sortkeys(1)->Indent(0)->Dump; + +$buf =~ s{\Q\x{d6}\E}{Ö}g; +$buf =~ s{\Q\x{c9}\E}{É}g; +$buf =~ s{\Q\x{f3}\E}{ó}g; +$buf =~ s{\Q\x{f6}\E}{ö}g; +$buf =~ s{\Q\x{fc}\E}{ü}g; + +$buf .= <<'__EOF__'; + +sub get_service_ref { + return $motis_instance; +} + +sub get_service_map { + return %{$motis_instance}; +} + +1; +__EOF__ + +write_file( $ARGV[0], { binmode => ':utf8' }, $buf ); diff --git a/lib/Travel/Status/MOTIS/Stop.pm b/lib/Travel/Status/MOTIS/Stop.pm new file mode 100644 index 0000000..85348bf --- /dev/null +++ b/lib/Travel/Status/MOTIS/Stop.pm @@ -0,0 +1,59 @@ +package Travel::Status::MOTIS::Stop; + +use strict; +use warnings; +use 5.020; + +use parent 'Class::Accessor'; + +our $VERSION = '0.01'; + +Travel::Status::MOTIS::Stop->mk_ro_accessors(qw( + id + name + type + lat + lon +)); + +sub from_match { + my ( $obj, %opt ) = @_; + + my $json = $opt{json}; + + my $ref = { + id => $json->{id}, + name => $json->{name}, + lat => $json->{lat}, + lon => $json->{lon}, + }; + + bless( $ref, $obj ); + + return $ref; +} + +sub from_stopover { + my ( $obj, %opt ) = @_; + + my $json = $opt{json}; + + my $ref = { + id => $json->{stopId}, + name => $json->{name}, + lat => $json->{lat}, + lon => $json->{lon}, + }; + + bless( $ref, $obj ); + + return $ref; +} + +sub TO_JSON { + my ($self) = @_; + + return { %{$self} }; +} + +1; diff --git a/lib/Travel/Status/MOTIS/Stopover.pm b/lib/Travel/Status/MOTIS/Stopover.pm new file mode 100644 index 0000000..e0b03df --- /dev/null +++ b/lib/Travel/Status/MOTIS/Stopover.pm @@ -0,0 +1,123 @@ +package Travel::Status::MOTIS::Stopover; + +use strict; +use warnings; +use 5.020; + +use parent 'Class::Accessor'; + +use DateTime::Format::ISO8601; + +our $VERSION = '0.01'; + +Travel::Status::MOTIS::Stopover->mk_ro_accessors(qw( + stop + + is_cancelled + is_realtime + + arrival + scheduled_arrival + realtime_arrival + + departure + scheduled_departure + realtime_departure + + delay + arrival_delay + departure_delay + + track + scheduled_track + realtime_track +)); + +sub new { + my ( $obj, %opt ) = @_; + + my $json = $opt{json}; + my $realtime = $opt{realtime} // 0; + my $cancelled = $opt{cancelled}; + + my $ref = { + stop => Travel::Status::MOTIS::Stop->from_stopover( json => $json ), + + is_realtime => $realtime, + is_cancelled => $json->{cancelled} // $cancelled, + }; + + if ( $json->{scheduledArrival} ) { + $ref->{scheduled_arrival} = DateTime::Format::ISO8601->parse_datetime( $json->{scheduledArrival} ); + $ref->{scheduled_arrival}->set_time_zone('local'); + } + + if ( $json->{arrival} and $realtime ) { + $ref->{realtime_arrival} = DateTime::Format::ISO8601->parse_datetime( $json->{arrival} ); + $ref->{realtime_arrival}->set_time_zone('local'); + } + + if ( $json->{scheduledDeparture} ) { + $ref->{scheduled_departure} = DateTime::Format::ISO8601->parse_datetime( $json->{scheduledDeparture} ); + $ref->{scheduled_departure}->set_time_zone('local'); + } + + if ( $json->{departure} and $realtime ) { + $ref->{realtime_departure} = DateTime::Format::ISO8601->parse_datetime( $json->{departure} ); + $ref->{realtime_departure}->set_time_zone('local'); + } + + if ( $ref->{scheduled_arrival} and $ref->{realtime_arrival} ) { + $ref->{arrival_delay} = $ref->{realtime_arrival} + ->subtract_datetime( $ref->{scheduled_arrival} ) + ->in_units('minutes'); + } + + if ( $ref->{scheduled_departure} and $ref->{realtime_departure} ) { + $ref->{departure_delay} = $ref->{realtime_departure} + ->subtract_datetime( $ref->{scheduled_departure} ) + ->in_units('minutes'); + } + + if ( $json->{scheduledTrack} ) { + $ref->{scheduled_track} = $json->{scheduledTrack}; + } + + if ( $json->{track} ) { + $ref->{realtime_track} = $json->{track}; + } + + $ref->{delay} = $ref->{arrival_delay} // $ref->{departure_delay}; + + $ref->{arrival} = $ref->{realtime_arrival} // $ref->{scheduled_arrival}; + $ref->{departure} = $ref->{realtime_departure} // $ref->{scheduled_departure}; + $ref->{track} = $ref->{realtime_track} // $ref->{scheduled_track}; + + bless( $ref, $obj ); + + return $ref; +} + +sub TO_JSON { + my ($self) = @_; + + my $ret = { %{$self} }; + + for my $timestamp_key (qw( + arrival + scheduled_arrival + realtime_arrival + + departure + scheduled_departure + realtime_departure + )) { + if ( $ret->{$timestamp_key} ) { + $ret->{$timestamp_key} = $ret->{$timestamp_key}->epoch; + } + } + + return $ret; +} + +1; diff --git a/lib/Travel/Status/MOTIS/Trip.pm b/lib/Travel/Status/MOTIS/Trip.pm new file mode 100644 index 0000000..c879bee --- /dev/null +++ b/lib/Travel/Status/MOTIS/Trip.pm @@ -0,0 +1,186 @@ +package Travel::Status::MOTIS::Trip; + +use strict; +use warnings; +use 5.020; + +use parent 'Class::Accessor'; + +use DateTime::Format::ISO8601; + +use Travel::Status::MOTIS::Stop; +use Travel::Status::MOTIS::Polyline qw(decode_polyline); + +our $VERSION = '0.01'; + +Travel::Status::MOTIS::Trip->mk_ro_accessors(qw( + id + mode + agency + route_name + route_color + headsign + + is_realtime + is_cancelled + + arrival + scheduled_arrival + realtime_arrival + + departure + scheduled_departure + realtime_departure +)); + +sub new { + my ( $obj, %opt ) = @_; + + my $json = $opt{json}{legs}[0]; + + my $ref = { + id => $json->{tripId}, + mode => $json->{mode}, + agency => $json->{agencyName}, + route_name => $json->{routeShortName}, + route_color => $json->{routeColor}, + headsign => $json->{headsign}, + + is_cancelled => $json->{cancelled}, + is_realtime => $json->{realTime}, + + raw_stopovers => [ $json->{from}, @{ $json->{intermediateStops} }, $json->{to} ], + raw_polyline => $json->{legGeometry}->{points}, + }; + + $ref->{scheduled_departure} = DateTime::Format::ISO8601->parse_datetime( $json->{scheduledStartTime} ); + $ref->{scheduled_departure}->set_time_zone('local'); + + if ( $json->{realTime} ) { + $ref->{realtime_departure} = DateTime::Format::ISO8601->parse_datetime( $json->{startTime} ); + $ref->{realtime_departure}->set_time_zone('local'); + } + + $ref->{departure} = $ref->{realtime_departure} // $ref->{scheduled_departure}; + + $ref->{scheduled_arrival} = DateTime::Format::ISO8601->parse_datetime( $json->{scheduledEndTime} ); + $ref->{scheduled_arrival}->set_time_zone('local'); + + if ( $json->{realTime} ) { + $ref->{realtime_arrival} = DateTime::Format::ISO8601->parse_datetime( $json->{endTime} ); + $ref->{realtime_arrival}->set_time_zone('local'); + } + + $ref->{arrival} = $ref->{realtime_arrival} // $ref->{scheduled_arrival}; + + bless( $ref, $obj ); + + return $ref; +} + +sub polyline { + my ($self) = @_; + + if ( not $self->{raw_polyline} ) { + return; + } + + if ( $self->{polyline} ) { + return @{ $self->{polyline} }; + } + + my $polyline = [ decode_polyline( $self->{raw_polyline} ) ]; + + my $gis_distance; + + eval { + require GIS::Distance; + $gis_distance = GIS::Distance->new; + }; + + if ($gis_distance) { + my %minimum_distances; + + for my $stopover ( $self->stopovers ) { + my $stop = $stopover->stop; + + for my $polyline_index ( 0 .. $#{$polyline} ) { + my $coordinate = $polyline->[$polyline_index]; + my $distance = $gis_distance->distance_metal( + $stop->{lat}, + $stop->{lon}, + $coordinate->{lat}, + $coordinate->{lon}, + ); + + if ( not $minimum_distances{ $stop->id } + or $minimum_distances{ $stop->id }{distance} > $distance + ) { + $minimum_distances{ $stop->id } = { + distance => $distance, + index => $polyline_index, + }; + } + } + } + + for my $stopover ( $self->stopovers ) { + my $stop = $stopover->stop; + + if ( $minimum_distances{ $stop->id } ) { + $polyline->[ $minimum_distances{ $stop->id }{index} ]{stop} = $stop; + } + } + } + + $self->{polyline} = $polyline; + + return @{ $self->{polyline} }; +} + +sub stopovers { + my ($self) = @_; + + if ( $self->{stopovers} ) { + return @{ $self->{stopovers} }; + } + + @{ $self->{stopovers} } = map { + Travel::Status::MOTIS::Stopover->new( + json => $_, + realtime => $self->{is_realtime} + ) + } ( @{ $self->{raw_stopovers} // [] } ); + + return @{ $self->{stopovers} }; +} + +sub TO_JSON { + my ($self) = @_; + + # transform raw_route into route (lazy accessor) + $self->route; + + # transform raw_polyline into polyline (lazy accessor) + $self->polyline; + + my $ret = { %{$self} }; + + for my $timestamp_key (qw( + arrival + scheduled_arrival + realtime_arrival + + departure + scheduled_departure + realtime_departure + )) { + if ( $ret->{$timestamp_key} ) { + $ret->{$timestamp_key} = $ret->{$timestamp_key}->epoch; + } + } + + return $ret; +} + +1; diff --git a/lib/Travel/Status/MOTIS/TripAtStopover.pm b/lib/Travel/Status/MOTIS/TripAtStopover.pm new file mode 100644 index 0000000..3d8d390 --- /dev/null +++ b/lib/Travel/Status/MOTIS/TripAtStopover.pm @@ -0,0 +1,78 @@ +package Travel::Status::MOTIS::TripAtStopover; + +use strict; +use warnings; +use 5.020; + +use DateTime::Format::ISO8601; + +use parent 'Class::Accessor'; + +our $VERSION = '0.01'; + +Travel::Status::MOTIS::TripAtStopover->mk_ro_accessors(qw( + id + mode + agency + route_name + route_color + headsign + + is_cancelled + is_realtime + + stopover +)); + +sub new { + my ( $obj, %opt ) = @_; + + my $json = $opt{json}; + + my $ref = { + id => $json->{tripId}, + mode => $json->{mode}, + agency => $json->{agencyName}, + route_name => $json->{routeShortName}, + route_color => $json->{routeColor}, + headsign => $json->{headsign}, + + is_cancelled => $json->{cancelled}, + is_realtime => $json->{realTime}, + + stopover => Travel::Status::MOTIS::Stopover->new( + json => $json->{place}, + + # NOTE: $json->{place}->{cancelled} isn't set, we just override this here. + cancelled => $json->{cancelled}, + realtime => $json->{realTime}, + ), + }; + + bless( $ref, $obj ); + + return $ref; +} + +sub TO_JSON { + my ($self) = @_; + + my $ret = { %{$self} }; + + for my $timestamp_key (qw( + scheduled_departure + realtime_departure + departure + scheduled_arrival + realtime_arrival + arrival + )) { + if ( $ret->{$timestamp_key} ) { + $ret->{$timestamp_key} = $ret->{$timestamp_key}->epoch; + } + } + + return $ret; +} + +1; diff --git a/scripts/makedeb-docker b/scripts/makedeb-docker new file mode 100755 index 0000000..6c06971 --- /dev/null +++ b/scripts/makedeb-docker @@ -0,0 +1,11 @@ +#!/bin/sh + +mkdir -p out + +docker run --rm -v "${PWD}:/orig:ro" -v "${PWD}/scripts:/scripts:ro" \ + -v "${PWD}/out:/out" -e USER=$(id -u) -e GROUP=$(id -g) \ + -e "DEBEMAIL=${DEBEMAIL}" -e "DEBFULLNAME=${DEBFULLNAME}" \ + -e "LOGNAME=${LOGNAME}" -e "VERSION=$(git describe --dirty)-1" \ + debian:buster /scripts/makedeb-docker-helper + +echo "Debian package has been written to $(pwd)/out" diff --git a/scripts/makedeb-docker-helper b/scripts/makedeb-docker-helper new file mode 100755 index 0000000..44b48b4 --- /dev/null +++ b/scripts/makedeb-docker-helper @@ -0,0 +1,34 @@ +#!/bin/sh + +set -e + +export DEBIAN_FRONTEND=noninteractive +export APT_LISTCHANGES_FRONTEND=none + +apt-get update +apt-get -y install \ + apt-file dh-make-perl libmodule-build-perl \ + libclass-accessor-perl libdatetime-perl libdatetime-format-strptime-perl \ + liblwp-protocol-https-perl libjson-perl libjson-xs-perl \ + liblist-moreutils-perl \ + libwww-perl \ + libtest-compile-perl libtest-pod-perl \ + libtest-simple-perl + +apt-file update +apt-cache dumpavail | dpkg --merge-avail + +mkdir -p /src/app +cp -a /orig/Build.PL /orig/Changelog /orig/README.md /src/app +cp -a /orig/bin /orig/lib /src/app +cd /src/app + +sed -i 's/sign *=> *1/sign => 0/' Build.PL +perl Build.PL +perl Build +perl Build manifest +perl Build dist +mv Travel-Status-MOTIS-*.tar.gz ../app.tar.gz +dh-make-perl --build --version "${VERSION}" +chown ${USER}:${GROUP} ../*.deb +mv -v ../*.deb /out diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..8a10355 --- /dev/null +++ b/shell.nix @@ -0,0 +1,17 @@ +{ pkgs ? import {} }: pkgs.mkShell { + nativeBuildInputs = with pkgs; [ + (perl.withPackages (perlPackages: with perlPackages; [ + ModuleBuild + ClassAccessor + DateTime + DateTimeFormatISO8601 + JSON + LWPProtocolHttps + LWPUserAgent + TestCompile + TestPod + URI + FileSlurp + ])) + ]; +} 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(); diff --git a/xt/10-pod-coverage.t b/xt/10-pod-coverage.t new file mode 100755 index 0000000..5fe4faa --- /dev/null +++ b/xt/10-pod-coverage.t @@ -0,0 +1,8 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use 5.010; +use Test::More; +use Test::Pod; + +all_pod_files_ok(); -- cgit v1.2.3