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

our $VERSION = '0.02';

use Getopt::Long qw(:config no_ignore_case);
use List::Util qw(max);
use Travel::Status::DE::VRR;

my ( $date, $time, $input_type );
my ( @grep_lines, @grep_platforms );
my @output;

binmode( STDOUT, ':encoding(utf-8)' );

GetOptions(
	'd|date=s'      => \$date,
	'h|help'        => sub { show_help(0) },
	'l|line=s@'     => \@grep_lines,
	'p|platform=s@' => \@grep_platforms,
	't|time=s'      => \$time,
	'V|version'     => \&show_version,

) or show_help(1);

if ( @ARGV != 2 ) {
	show_help(1);
}

# --line=foo,bar support
@grep_lines     = split( qr{,}, join( q{,}, @grep_lines ) );
@grep_platforms = split( qr{,}, join( q{,}, @grep_platforms ) );

my ( $place, $input ) = @ARGV;

if ( $input =~ s{ ^ (?<type> address|poi|stop) : }{}x ) {
	$input_type = $+{type};
}

my $status = Travel::Status::DE::VRR->new(
	date  => $date,
	place => $place,
	name  => $input,
	time  => $time,
	type  => $input_type,
);

sub show_help {
	my ($code) = @_;

	print "Usage: efa-m [-d <dd.mm.yyyy>] [-t <hh:mm>] <city> <station>\n"
	  . "See also: man efa-m\n";

	exit $code;
}

sub show_version {
	say "efa-m version ${VERSION}";

	exit 0;
}

sub display_result {
	my (@lines) = @_;

	my @line_length;

	if ( not @lines ) {
		die("Nothing to show\n");
	}

	for my $i ( 0 .. 3 ) {
		$line_length[$i] = max map { length( $_->[$i] ) } @lines;
	}

	for my $line (@lines) {

		if ( length( $line->[4] ) ) {
			$line->[4] =~ tr{\n\x0d}{ }s;
			chomp $line->[4];
			print "\n";
			for my $info_line ( split( qr{\n}, $line->[4] ) ) {
				say "# ${info_line}";
			}
		}

		printf(
			join( q{  },
				"%${line_length[0]}s",
				( map { "%-${_}s" } @line_length[ 1 .. $#line_length ] ) )
			  . "\n",
			@{$line}[ 0 .. 3 ]
		);
	}

	return;
}

if ( my $err = $status->errstr ) {
	say STDERR "Request error: ${err}";
	exit 2;
}

for my $d ( $status->results ) {

	if (
		( @grep_lines and not( $d->line ~~ \@grep_lines ) )
		or ( @grep_platforms
			and not( substr( $d->platform, 6 ) ~~ \@grep_platforms ) )
	  )
	{
		next;
	}

	push( @output,
		[ $d->time, $d->platform, $d->line, $d->destination, $d->info ] );
}

display_result(@output);

__END__

=head1 NAME

efa-m - Inofficial interface to the efa.vrr.de departure monitor

=head1 SYNOPSIS

B<efa-m> [B<-d> I<date>] [B<-t> I<time>] I<city> [I<type>B<:>]I<name>

=head1 VERSION

version 0.02

=head1 DESCRIPTION

B<efa-m> lists upcoming tram, bus and train departures at the location I<name>
in I<city>.

By default, I<name> refers to a stop, this can be changed by specifying
I<type>.  Supported types are B<address> and B<poi> (point of interest).

=head1 OPTIONS

=over

=item B<-d>, B<--date> I<dd.mm.yyyy>

Show departures for I<date> instead of today

=item B<-l>, B<--line> I<lines>

Only show departures of I<lines> (comma-separatad list, option may be
repeated)

=item B<-p>, B<--platform> I<platforms>

Only show departures at I<platforms> (comma-separated list, option may be
repeated).  Note that the C<< Bstg. >> / C<< Gleis >> prefix must be omitted.

=item B<-t>, B<--time> I<hh:mm>

Show departures starting at I<time> instead of now

=item B<-V>, B<--version>

Show version information.

=back

=head1 EXIT STATUS

Zero.

=head1 CONFIGURATION

None.

=head1 DEPENDENCIES

=over

=item * Class::Accessor(3pm)

=item * XML::LibXML(3pm)

=item * WWW::Mechanize(3pm)

=back

=head1 BUGS AND LIMITATIONS

Unknown.

=head1 AUTHOR

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

=head1 LICENSE

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