#!/usr/bin/env perl
## Copyright © 2009,2010 by Daniel Friesel <derf@derf.homelinux.org>
## License: WTFPL <http://sam.zoy.org/wtfpl>
##   0. You just DO WHAT THE FUCK YOU WANT TO.
use strict;
use warnings;
use 5.010;

use Getopt::Long qw/:config no_ignore_case/;
use WWW::Efa;

my $VERSION = '1.3+git';
my %post;
my $ignore_info = 'Fahrradmitnahme';
my ($test_dump, $test_parse);
my $efa;
my (@from, @to, @via, $from_type, $to_type, $via_type);
my $opt = {
	'ignore-info' => \$ignore_info,
	'from'        => \@from,
	'to'          => \@to,
	'via'         => \@via,
};

binmode(STDOUT, ':utf8');
binmode(STDERR, ':utf8');

GetOptions(
	$opt,
	qw{
		arrive|a=s
		bike|b
		date|d=s
		depart=s
		exclude|e=s@
		from=s@{2}
		help|h
		ignore-info|I=s
		max-change|m=i
		prefer|P=s
		proximity|p
		include|i=s
		test-dump
		test-parse
		time|t=s
		timeout=i
		to=s@{2}
		version|v
		via=s@{2}
		walk-speed|w=s
	},
) or die("Please see $0 --help\n");

if ($opt->{'version'}) {
	say "efa version $VERSION";
	exit 0;
}

if (not (@from and @to)) {
	if (@ARGV == 4) {
		(@from[0,1], @to[0,1]) = @ARGV;
	}
	elsif (@ARGV == 6) {
		(@from[0,1], @via[0,1], @to[0,1]) = @ARGV;
	}
}

for my $pair (
	[$from[1], \$from_type],
	[$via[1] , \$via_type ],
	[$to[1]  , \$to_type  ],
) {
	next if (not defined $pair->[0]);

	if ($pair->[0] =~ s{ ^ (?<type> [^:]+ ) : \s* (?<target> .+ ) $ }
		{$+{target}}x)
	{
		given($+{type}) {
			when('addr') { ${$pair->[1]} = 'address' }
			default      { ${$pair->[1]} = $+{type}  }
		}
	}
}

$efa = WWW::Efa->new(
	from => [@from, $from_type],
	to   => [@to, $to_type],
	via  => (@via ? [@via, $via_type] : undef),

	arrive  => $opt->{'arrive'},
	depart  => $opt->{'depart'} // $opt->{'time'},
	date    => $opt->{'date'},
	exclude => $opt->{'exclude'},
	prefer  => $opt->{'prefer'},
	include => $opt->{'include'},
	bike    => $opt->{'bike'},

	proximity  => $opt->{'proximity'},
	walk_speed => $opt->{'walk-speed'},
	max_interchanges  => $opt->{'max-change'},
);

if (my $err = $efa->setup_error()) {
	die $err->as_string();
}

if ($opt->{'test-parse'}) {
	local $/ = undef;
	$efa->{'html_reply'} = <STDIN>;
}
else {
	$efa->submit(
		timeout => $opt->{'timeout'}
	);
}

$efa->parse();


$efa->check_ambiguous();
$efa->check_no_connections();

my @connections = $efa->connections();

for my $i (0 .. $#connections) {
	for my $c (@{$connections[$i]}) {

		for my $extra (@{$c->{'extra'}}) {

			if (not (length $ignore_info and $extra =~ /$ignore_info/i)) {
				say "# $extra";
			}
		}

		printf(
			"%-5s ab  %-30s %-20s %s\n%-5s an  %-30s\n\n",
			$c->{'dep_time'},
			$c->{'dep_stop'},
			$c->{'train_line'},
			$c->{'train_dest'},
			$c->{'arr_time'},
			$c->{'arr_stop'},
		);
	}
	if ($i != $#connections) {
		print "------\n\n";
	}
}

__END__

=head1 NAME

efa - unofficial efa.vrr.de command line client

=head1 SYNOPSIS

=over

=item B<efa> B<--from> I<city> I<stop> B<--to> I<city> I<stop> [ I<additional options> ]

=item B<efa> [ I<options> ] I<from-city> I<from-stop> [ I<via-city> I<via-stop> ] I<to-city> I<to-stop>

=back

=head1 DESCRIPTION

B<efa> is a command line client for the L<http://efa.vrr.de> web interface.
It sends the specified information to the online form and displays the results.

=head1 OPTIONS

=over

=item B<--from> I<city> I<stop>

Departure place

=item B<--to> I<city> I<stop>

Arrival place

=item B<--via> I<city> I<stop>

Travel via this place

In case you want I<stop> to be an address or "point of interest", you can set
it to 'addr:something' or 'poi:something'.

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

Journey start time

=item B<-a>|B<--arrive> I<hh>:I<mm>

Journey end time (overrides --time/--depart)

=item B<-d>|B<--date> I<dd>.I<mm>.[I<yyyy>]

Journey date

=item B<-b>|B<--bike>

Choose connections allowing to carry a bike

=item B<-e>|B<--exclude> I<transports>

Exclude I<transports> (comma separated list).

Possible transports: zug, s-bahn, u-bahn, stadtbahn, tram, stadtbus, regionalbus,
schnellbus, seilbahn, schiff, ast, sonstige

=item B<-m>|B<--max-change> I<number>

Print connections with at most I<number> interchanges

=item B<-P>|B<--prefer> I<type>

Prefer connections of I<type>:

=over

=item * speed (default)

The faster, the better

=item * nowait

Prefer connections with less interchanges

=item * nowalk

Prefer connections with less walking (at interchanges)

=back

=item B<-p>|B<--proximity>

Take stops close to the stop/start into account and possibly use them instead

=item B<-i>|B<--include> I<type>

Include connections using trains of type I<type>, where I<type> may be:

=over

=item * local (default)

only take local trains ("Verbund-/Nahverkehrslinien"). Slow, but the cheapest
method if you're not travelling long distance

=item * ic

Local trains + IC

=item * ice

All trains (local + IC + ICE)

=back

=item B<-w>|B<--walk-speed> I<speed>

Set your walking speed to I<speed>.
Accepted values: normal (default), fast, slow

=item B<-I>|B<--ignore-info> [ I<regex> ]

Ignore additional information matching I<regex> (default: /Fahrradmitnahme/)

If I<regex> is not supplied, removes the default regex (-E<gt> nothing will be ignored)

=item B<--timeout> I<seconds>

Set timeout for HTTP requests. Default: 60 seconds.

=item B<--post> I<key>=I<value>

Add I<key> with I<value> to the HTTP POST request sent to the EFA server.
This can be used to use setting B<efa> does not yet cover, like
C<--post lineRestriction=400> to also show IC and ICE trains.
Note that B<--post> will be overridden by the standard efa options, such as
B<--time>

=item B<-v>|B<--version>

Print version information

=back

=head1 EXIT STATUS

    0    Everything went well
    1    Ambiguous input, re-run efa with different arguments
    2    efa.vrr.de error (i.e. unable to find matching connections)
    3    efa.vrr.de error (usually invalid input data)
    255  Any other kind of error

=head1 CONFIGURATION

None.

=head1 DEPENDENCIES

This script requires perl 5.10 (or higher) with the modules
WWW::Mechanize and XML::LibXML.

=head1 BUGS AND LIMITATIONS

B<efa> cannot handle Unicode in its arguments, so use plain ASCII.

The Parser is quite new and may not yet cover all corner cases, use with
caution.

=head1 AUTHOR

Copyright (C) 2009,2010 by Daniel Friesel E<lt>derf@derf.homelinux.orgE<gt>

=head1 LICENSE

  0. You just DO WHAT THE FUCK YOU WANT TO.