#!/usr/bin/env perl use strict; use warnings; use 5.010; no if $] >= 5.018, warnings => 'experimental::smartmatch'; our $VERSION = '1.00'; 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 ('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 ] [-l ] [-v ] ' . "\n" . "See also: man aseag-m\n"; exit $code; } sub show_version { say "aseag-m version ${VERSION}"; exit 0; } sub display_result { my (@lines) = @_; my @format = qw(%- %- %- %-); if ( not @lines ) { die("Nothing to show\n"); } if ( $edata{relative_times} ) { $format[0] = q{%}; } for my $i ( 0 .. 3 ) { $format[$i] .= max map { length( $_->[$i] ) } @lines; $format[$i] .= 's'; } for my $line (@lines) { printf( join( q{ }, @format ) . "\n", @{$line}[ 0 .. 3 ] ); if ( @{ $line->[4] } ) { for my $route ( @{ $line->[4] } ) { 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{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 [B<-pV>] [B<-l> I] [B<-o> I] [B<-s> I | B<-S> I] [B<-v> I] I =head1 VERSION version 1.00 =head1 DESCRIPTION B lists upcoming bus departures at the ASEAG stop I. 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 Limit output to departures of I (comma-separated list of line names, may be used multiple times). =item B<-o>, B<--output> I Format output according to I. I 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. Both stop names and departure times are shown. =item b / route_before For each departure, include the route leading to I. 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 r / route_interesting For each departure, show up to three "interesting" stops between I 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 absolute times in I, applies both to departure and route output. See DateTime(3pm) for allowed patterns. =item B<-S>, B<--strfrel> I Format relative times in I, only applies when used with B<-oT>. See DateTime::Format::Duration(3pm) for allowed patterns. =item B<-v>, B<--via> I Only show lines which also serve I after I. =item B<-V>, B<--version> Show version information. =back =head1 EXIT STATUS Normally zero. B<1> means B 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 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 Ederf@finalrewind.orgE =head1 LICENSE This program is licensed under the same terms as Perl itself.