summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xbin/aseag-m382
-rwxr-xr-xbin/ura-m (renamed from bin/tfl-m)79
-rw-r--r--lib/Travel/Status/DE/URA.pm19
3 files changed, 78 insertions, 402 deletions
diff --git a/bin/aseag-m b/bin/aseag-m
deleted file mode 100755
index 0f59ecb..0000000
--- a/bin/aseag-m
+++ /dev/null
@@ -1,382 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use 5.010;
-
-no if $] >= 5.018, warnings => 'experimental::smartmatch';
-
-our $VERSION = '1.02';
-
-binmode( STDOUT, ':encoding(utf-8)' );
-
-use DateTime;
-use DateTime::Format::Duration;
-use Getopt::Long qw(:config no_ignore_case bundling);
-use List::Util qw(max);
-use Travel::Status::DE::ASEAG;
-
-my (@grep_lines);
-my $hide_past = 1;
-my $strftime_format = '%H:%M:%S';
-my $strfrel_format = '%M min';
-my ( %edata, @edata_pre );
-my $calculate_routes = 0;
-my $developer_mode;
-my $via;
-
-GetOptions(
- 'h|help' => sub { show_help(0) },
- 'l|line=s@' => \@grep_lines,
- 'o|output=s@' => \@edata_pre,
- 'p|with-past' => sub { $hide_past = 0 },
- 's|strftime=s' => \$strftime_format,
- 'S|strfrel=s' => \$strfrel_format,
- 'v|via=s' => \$via,
- 'V|version' => \&show_version,
- 'devmode' => \$developer_mode,
-
-) or show_help(1);
-
-if ( @ARGV != 1 ) {
- show_help(1);
-}
-
-# --line=foo,bar support
-@edata_pre = split( qr{,}, join( q{,}, @edata_pre ) );
-@grep_lines = split( qr{,}, join( q{,}, @grep_lines ) );
-
-for my $efield (@edata_pre) {
- given ($efield) {
- when ('a') { $edata{route_after} = 1; $calculate_routes = 1 }
- when ('b') { $edata{route_before} = 1; $calculate_routes = 1 }
- when ('f') { $edata{route_full} = 1; $calculate_routes = 1 }
- when ('i') { $edata{indicator} = 1 }
- when ('r') { $edata{route_interesting} = 1; $calculate_routes = 1 }
- when ('T') { $edata{relative_times} = 1 }
- default { $edata{$efield} = 1 }
- }
-}
-
-my ($stop_name) = @ARGV;
-
-my $status
- = Travel::Status::DE::ASEAG->new( developer_mode => $developer_mode );
-
-sub show_help {
- my ($code) = @_;
-
- print 'Usage: aseag-m [-pV] [-o <output>] [-l <lines>] [-v <stopname>] '
- . "<stopname>\n"
- . "See also: man aseag-m\n";
-
- exit $code;
-}
-
-sub show_version {
- say "aseag-m version ${VERSION}";
-
- exit 0;
-}
-
-sub display_result {
- my (@lines) = @_;
-
- if ( not @lines ) {
- die("Nothing to show\n");
- }
-
- my $max_col_idx = $#{ $lines[0] } - 1;
-
- my @format = (q{%-}) x ( $max_col_idx + 1 );
-
- if ( $edata{relative_times} ) {
- $format[0] = q{%};
- }
-
- for my $i ( 0 .. $max_col_idx ) {
- $format[$i] .= max map { length( $_->[$i] ) } @lines;
- $format[$i] .= 's';
- }
-
- for my $line (@lines) {
-
- printf( join( q{ }, @format ) . "\n", @{$line}[ 0 .. $max_col_idx ] );
-
- if ( @{ $line->[ $max_col_idx + 1 ] } ) {
- for my $route ( @{ $line->[ $max_col_idx + 1 ] } ) {
- printf( join( q{ }, @format ) . "\n", @{$route} );
- }
- print "\n";
- }
- }
-
- return;
-}
-
-sub get_exact_stop_name {
- my ($fuzzy_name) = @_;
-
- my @stops = $status->get_stop_by_name($fuzzy_name);
-
- if ( @stops == 0 ) {
- say STDERR "Got no departures for '$fuzzy_name'";
- say STDERR 'The stop may not exist or not be in service right now';
- exit(3);
- }
- elsif ( @stops == 1 ) {
- return $stops[0];
- }
- else {
- say STDERR "The stop name '$fuzzy_name' is ambiguous. Please choose "
- . 'one of the following:';
- say STDERR join( "\n", @stops );
- exit(3);
- }
-}
-
-sub show_route {
- my ( $dt_now, $dt_format, @routes ) = @_;
- my @res;
-
- if ( $edata{relative_times} ) {
- @res = map {
- [
- $dt_format->format_duration(
- $_->datetime->subtract_datetime($dt_now)
- ),
- q{},
- $_->name,
- q{},
- ]
- } @routes;
- }
- else {
- @res = map {
- [ $_->datetime->strftime($strftime_format), q{}, $_->name, q{}, ]
- } @routes;
- }
-
- return @res;
-}
-
-sub show_results {
- my @output;
-
- my $dt_now = DateTime->now( time_zone => 'Europe/Berlin' );
- my $dt_format
- = DateTime::Format::Duration->new( pattern => $strfrel_format );
-
- for my $d (
- $status->results(
- calculate_routes => $calculate_routes,
- hide_past => $hide_past,
- stop => $stop_name,
- via => $via,
- )
- )
- {
-
- if ( ( @grep_lines and not( $d->line ~~ \@grep_lines ) ) ) {
- next;
- }
- my ( @line, @route );
-
- if ( $edata{route_full} ) {
- @route = (
- show_route( $dt_now, $dt_format, $d->route_pre ),
- [ ' - - - -', q{}, q{}, q{} ],
- show_route( $dt_now, $dt_format, $d->route_post ),
- );
- }
- elsif ( $edata{route_after} ) {
- @route = show_route( $dt_now, $dt_format, $d->route_post );
- }
- elsif ( $edata{route_before} ) {
- @route = reverse show_route( $dt_now, $dt_format, $d->route_pre );
- }
-
- if ( $edata{relative_times} ) {
- @line = (
- $dt_format->format_duration(
- $d->datetime->subtract_datetime($dt_now)
- ),
- $d->line,
- q{},
- $d->destination,
- \@route,
- );
- }
- else {
- @line = (
- $d->datetime->strftime($strftime_format),
- $d->line, q{}, $d->destination, \@route,
- );
- }
-
- if ( $edata{indicator} ) {
- splice( @line, 1, 0, $d->stop_indicator );
- }
-
- if ( $edata{route_interesting} ) {
- $line[2] = join( q{ }, map { $_->name } $d->route_interesting );
- }
-
- push( @output, \@line );
- }
-
- display_result(@output);
-
- return;
-}
-
-if ( my $err = $status->errstr ) {
- say STDERR "Request error: ${err}";
- exit 2;
-}
-
-$stop_name = get_exact_stop_name($stop_name);
-if ($via) {
- $via = get_exact_stop_name($via);
-}
-show_results();
-
-__END__
-
-=head1 NAME
-
-aseag-m - Unofficial interface to the ASEAG departure monitor
-
-=head1 SYNOPSIS
-
-B<aseag-m> [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>]
-[B<-s> I<timefmt> | B<-S> I<timefmt>]
-[B<-v> I<stopname>] I<stopname>
-
-=head1 VERSION
-
-version 1.02
-
-=head1 DESCRIPTION
-
-B<aseag-m> lists upcoming bus departures at the ASEAG stop I<name>.
-It only shows realtime data and has no knowledge of schedules or delays.
-Departures without such data may not appear at all.
-
-=head1 OPTIONS
-
-=over
-
-=item B<-l>, B<--line> I<lines>
-
-Limit output to departures of I<lines> (comma-separated list of line
-names, may be used multiple times).
-
-=item B<-o>, B<--output> I<outputtypes>
-
-Format output according to I<outputtypes>. I<outputtypes> is a
-comma-separated list and the B<--output> option may be repeated. Each
-output type has both a short and a long form, so for instance both
-C<< -or,T >> and C<< --output=route_interesting,relative_times >> are valid.
-
-Valid output types are:
-
-=over
-
-=item a / route_after
-
-For each departure, include the route after I<name>. Both stop names and
-departure times are shown.
-
-=item b / route_before
-
-For each departure, include the route leading to I<name>. Both stop names and
-departure times are shown.
-
-=item f / route_full
-
-For each departure, include the entire route (stop names and departure times).
-
-=item i / indicator
-
-Show stop point indicator, if available. This is usually a sub-stop or
-platform number, such as "H3".
-
-=item r / route_interesting
-
-For each departure, show up to three "interesting" stops between I<name> and
-its destination. The importance of a stop is determined heuristically based on
-its name, so it is not always accurate.
-
-=item T / relative_times
-
-Show relative times. Applies to departure and route output.
-
-=back
-
-Note that the routes may be incomplete, since the backend only provides a
-limited amount of departures and the routes are calculated from this set.
-intermediate stops are always included, but both route_after and route_before
-may be cut off after / before any stop. The same applies to route_full.
-
-=item B<-p>, B<--with-past>
-
-Include past departures. Applies both to the departure output and to the
-route output of B<-oa>, B<-ob>, B<-of>.
-
-=item B<-s>, B<--strftime> I<format>
-
-Format absolute times in I<format>, applies both to departure and route
-output. See DateTime(3pm) for allowed patterns.
-
-=item B<-S>, B<--strfrel> I<format>
-
-Format relative times in I<format>, only applies when used with B<-oT>.
-See DateTime::Format::Duration(3pm) for allowed patterns.
-
-=item B<-v>, B<--via> I<stop>
-
-Only show lines which also serve I<stop> after I<name>.
-
-=item B<-V>, B<--version>
-
-Show version information.
-
-=back
-
-=head1 EXIT STATUS
-
-Normally zero. B<1> means B<aseag-m> was called with invalid options,
-B<2> indicates a request error from Travel::Status::DE::URA(3pm),
-B<3> a bad (unknown or ambiguous) I<stop> name.
-
-=head1 CONFIGURATION
-
-None.
-
-=head1 DEPENDENCIES
-
-=over
-
-=item * Class::Accessor(3pm)
-
-=item * DateTime(3pm)
-
-=item * DateTime::Format::Duration(3pm)
-
-=item * LWP::UserAgent(3pm)
-
-=item * Text::CSV(3pm)
-
-=back
-
-=head1 BUGS AND LIMITATIONS
-
-Unknown.
-
-=head1 AUTHOR
-
-Copyright (C) 2013-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
-
-=head1 LICENSE
-
-This program is licensed under the same terms as Perl itself.
diff --git a/bin/tfl-m b/bin/ura-m
index 96c1da5..72fd8d6 100755
--- a/bin/tfl-m
+++ b/bin/ura-m
@@ -12,8 +12,8 @@ binmode( STDOUT, ':encoding(utf-8)' );
use DateTime;
use DateTime::Format::Duration;
use Getopt::Long qw(:config no_ignore_case bundling);
-use List::Util qw(max);
-use Travel::Status::DE::TFL;
+use List::Util qw(first max);
+use Travel::Status::DE::URA;
my (@grep_lines);
my $hide_past = 1;
@@ -23,20 +23,31 @@ my ( %edata, @edata_pre );
my $calculate_routes = 0;
my $developer_mode;
my $via;
+my ( $list_services, $service );
+my $ura_base = 'http://ivu.aseag.de/interfaces/ura';
+my $ura_version = 1;
GetOptions(
- 'h|help' => sub { show_help(0) },
- 'l|line=s@' => \@grep_lines,
- 'o|output=s@' => \@edata_pre,
- 'p|with-past' => sub { $hide_past = 0 },
- 's|strftime=s' => \$strftime_format,
- 'S|strfrel=s' => \$strfrel_format,
- 'v|via=s' => \$via,
- 'V|version' => \&show_version,
- 'devmode' => \$developer_mode,
+ 'f|strftime=s' => \$strftime_format,
+ 'F|strfrel=s' => \$strfrel_format,
+ 'h|help' => sub { show_help(0) },
+ 'l|line=s@' => \@grep_lines,
+ 'L|list' => \$list_services,
+ 'o|output=s@' => \@edata_pre,
+ 'p|with-past' => sub { $hide_past = 0 },
+ 's|service=s' => \$service,
+ 'v|via=s' => \$via,
+ 'V|version' => \&show_version,
+ 'devmode' => \$developer_mode,
+ 'ura-base=s' => \$ura_base,
+ 'ura-version=s' => \$ura_version,
) or show_help(1);
+if ($list_services) {
+ show_services(0);
+}
+
if ( @ARGV != 1 ) {
show_help(1);
}
@@ -57,23 +68,51 @@ for my $efield (@edata_pre) {
}
}
+if ($service) {
+ my $service_ref = first { lc( $_->{shortname} ) eq lc($service) }
+ Travel::Status::DE::URA::get_services();
+ if ( not $service_ref ) {
+ printf STDERR (
+"Error: Unknown service '%s'. The following services are supported:\n\n",
+ $service
+ );
+ show_services(1);
+ }
+ $ura_base = $service_ref->{ura_base};
+ $ura_version = $service_ref->{ura_version};
+}
+
my ($stop_name) = @ARGV;
-my $status
- = Travel::Status::DE::TFL->new( developer_mode => $developer_mode );
+my $status = Travel::Status::DE::URA->new(
+ developer_mode => $developer_mode,
+ ura_base => $ura_base,
+ ura_version => $ura_version,
+);
sub show_help {
my ($code) = @_;
- print 'Usage: tfl-m [-pV] [-o <output>] [-l <lines>] [-v <stopname>] '
+ print "Usage: $0 [-pV] [-o <output>] [-l <lines>] [-v <stopname>] "
. "<stopname>\n"
- . "See also: man tfl-m\n";
+ . "See also: man ura-m\n";
+
+ exit $code;
+}
+
+sub show_services {
+ my ($code) = @_;
+
+ printf( "%-60s %-14s %s\n\n", 'service', 'abbr. (-s)', 'url (-u)' );
+ for my $service ( Travel::Status::DE::URA::get_services() ) {
+ printf( "%-60s %-14s %s\n", @{$service}{qw(name shortname ura_base)} );
+ }
exit $code;
}
sub show_version {
- say "tfl-m version ${VERSION}";
+ say "$0 version ${VERSION}";
exit 0;
}
@@ -244,11 +283,11 @@ __END__
=head1 NAME
-tfl-m - Unofficial interface to the TFL departure monitor
+ure-m - Unofficial interface to URA-based departure monitors
=head1 SYNOPSIS
-B<tfl-m> [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>]
+B<ura-m> [B<-pV>] [B<-l> I<lines>] [B<-o> I<outputtypes>]
[B<-s> I<timefmt> | B<-S> I<timefmt>]
[B<-v> I<stopname>] I<stopname>
@@ -258,7 +297,7 @@ version 1.02
=head1 DESCRIPTION
-B<tfl-m> lists upcoming bus departures at the TFL stop I<name>.
+B<ura-m> lists upcoming bus departures at the URA stop I<name>.
It only shows realtime data and has no knowledge of schedules or delays.
Departures without such data may not appear at all.
@@ -345,7 +384,7 @@ Show version information.
=head1 EXIT STATUS
-Normally zero. B<1> means B<tfl-m> was called with invalid options,
+Normally zero. B<1> means B<ura-m> was called with invalid options,
B<2> indicates a request error from Travel::Status::DE::URA(3pm),
B<3> a bad (unknown or ambiguous) I<stop> name.
diff --git a/lib/Travel/Status/DE/URA.pm b/lib/Travel/Status/DE/URA.pm
index ea8ed69..7c03ff0 100644
--- a/lib/Travel/Status/DE/URA.pm
+++ b/lib/Travel/Status/DE/URA.pm
@@ -3,6 +3,7 @@ package Travel::Status::DE::URA;
use strict;
use warnings;
use 5.010;
+use utf8;
no if $] >= 5.018, warnings => 'experimental::smartmatch';
@@ -337,6 +338,24 @@ sub results {
return @results;
}
+# static
+sub get_services {
+ return (
+ {
+ ura_base => 'http://ivu.aseag.de/interfaces/ura',
+ ura_version => 1,
+ name => 'Aachener Straßenbahn und Energieversorgungs AG',
+ shortname => 'ASEAG',
+ },
+ {
+ ura_base => 'http://countdown.api.tfl.gov.uk/interfaces/ura',
+ ura_version => 1,
+ name => 'Transport for London',
+ shortname => 'TfL',
+ }
+ );
+}
+
1;
__END__
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 06:49:48 +0000