path: root/bin/aseag-m

#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;

no if $] >= 5.018, warnings => 'experimental::smartmatch';

our $VERSION = '0.04';

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 $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,

) 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;

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) = @_;

	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(
					$_->[0]->subtract_datetime($dt_now)
				),
				q{},
				$_->[1]
			]
		} @routes;
	}
	else {
		@res = map { [ $_->[0]->strftime($strftime_format), q{}, $_->[1] ] }
		  @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 = ( $d->route_pre, $d->route_post );
		}
		elsif ( $edata{route_after} ) {
			@route = $d->route_post;
		}
		elsif ( $edata{route_before} ) {
			@route = $d->route_pre;
		}

		if ( $edata{relative_times} ) {
			@line = (
				$dt_format->format_duration(
					$d->datetime->subtract_datetime($dt_now)
				),
				$d->line,
				q{},
				$d->destination,
				[ show_route( $dt_now, $dt_format, @route ) ],
			);
		}
		else {
			@line = (
				$d->datetime->strftime($strftime_format),
				$d->line, q{}, $d->destination,
				[ show_route( $dt_now, $dt_format, @route ) ],
			);
		}

		if ( $edata{route_before} ) {
			@{ $line[4] } = reverse @{ $line[4] };
		}

		if ( $edata{route_interesting} ) {
			$line[2] = join( q{  }, $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 0.04

=head1 DESCRIPTION

B<aseag-m> lists upcoming bus departures at the ASEAG stop I<name>.

=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 T / relative_times

Show relative times. Applies to departure and route output.

=back

=item B<-p>, B<--with-past>

Include past departures. Applies both to the departure output and to the
route output of B<-a>, B<-b>, B<-f>.

=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<-r>.
See DateTime::Format::Duration(3pm) for allowed patterns.

=item B<-v>, B<--via> I<stop>

Only show lines which also serve I<stop>. When used with B<-b>,
I<stop> must be in the schedule before I<name>, with B<-f> it may be anywhere,
with B<-a> (and by default) it must be 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)

=back

=head1 BUGS AND LIMITATIONS

Unknown.

=head1 AUTHOR

Copyright (C) 2013 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>

=head1 LICENSE

This program is licensed under the same terms as Perl itself.