diff options
Diffstat (limited to 'bin/tfl-m')
| -rwxr-xr-x | bin/tfl-m | 382 |
1 files changed, 382 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. |