summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xbin/tfl-m382
-rw-r--r--lib/Travel/Status/DE/TFL.pm96
2 files changed, 478 insertions, 0 deletions
diff --git a/bin/tfl-m b/bin/tfl-m
new file mode 100755
index 0000000..96c1da5
--- /dev/null
+++ b/bin/tfl-m
@@ -0,0 +1,382 @@
+#!/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::TFL;
+
+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::TFL->new( developer_mode => $developer_mode );
+
+sub show_help {
+ my ($code) = @_;
+
+ print 'Usage: tfl-m [-pV] [-o <output>] [-l <lines>] [-v <stopname>] '
+ . "<stopname>\n"
+ . "See also: man tfl-m\n";
+
+ exit $code;
+}
+
+sub show_version {
+ say "tfl-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
+
+tfl-m - Unofficial interface to the TFL departure monitor
+
+=head1 SYNOPSIS
+
+B<tfl-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<tfl-m> lists upcoming bus departures at the TFL 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<tfl-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/lib/Travel/Status/DE/TFL.pm b/lib/Travel/Status/DE/TFL.pm
new file mode 100644
index 0000000..2c9b0ec
--- /dev/null
+++ b/lib/Travel/Status/DE/TFL.pm
@@ -0,0 +1,96 @@
+package Travel::Status::DE::TFL;
+
+use strict;
+use warnings;
+use 5.010;
+
+no if $] >= 5.018, warnings => 'experimental::smartmatch';
+
+our $VERSION = '1.02';
+
+use parent 'Travel::Status::DE::URA';
+
+sub new {
+ my ( $class, %opt ) = @_;
+
+ $opt{ura_base} = 'http://countdown.api.tfl.gov.uk/interfaces/ura';
+ $opt{ura_version} = '1';
+
+ return $class->SUPER::new(%opt);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Travel::Status::DE::TFL - unofficial TFL departure monitor.
+
+=head1 SYNOPSIS
+
+ use Travel::Status::DE::TFL;
+
+ my $status = Travel::Status::DE::TFL->new(
+ stop => 'Aachen Bushof'
+ );
+
+ for my $d ($status->results) {
+ printf(
+ "%s %-5s %25s (in %d min)\n",
+ $d->time, $d->line, $d->destination, $d->countdown
+ );
+ }
+
+=head1 VERSION
+
+version 1.02
+
+=head1 DESCRIPTION
+
+Travel::Status::DE::TFL is an unofficial interface to the TFL realtime
+departure monitor.
+
+=head1 METHODS
+
+=over
+
+=item my $status = Travel::Status::DE::TFL->new(I<%opt>)
+
+Requests the departures as specified by I<opts> and returns a new
+Travel::Status::DE::TFL object.
+
+Calls Travel::Status::DE::URA->new with the appropriate B<ura_base> and
+B<ura_version> parameters. All I<opts> are passed on.
+
+See Travel::Status::DE::URA(3pm) for the other methods.
+
+=back
+
+=head1 DIAGNOSTICS
+
+None.
+
+=head1 DEPENDENCIES
+
+=over
+
+=item * Travel::Status::DE::URA(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+Many.
+
+=head1 SEE ALSO
+
+tfl-m(1), Travel::Status::DE::URA(3pm).
+
+=head1 AUTHOR
+
+Copyright (C) 2013-2015 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+This module is licensed under the same terms as Perl itself.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-17 09:46:55 +0000