path: root/bin/efa

#!/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 (@from, @to, @via);
my ($from_type, $to_type, $via_type) = ('stop') x 3;
my $ignore_info = 'Fahrradmitnahme';
my ($test_dump, $test_parse);
my $efa;

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

sub opt_time_arr {
	$post{itdTripDateTimeDepArr} = 'arr';
	opt_time(@_);
}

sub opt_time_dep {
	$post{itdTripDateTimeDepArr} = 'dep';
	opt_time(@_);
}

sub opt_time {
	my (undef, $time) = @_;

	if ($time !~ /^ [0-2]? \d : [0-5]? \d $/x) {
		die("time: Invalid argument. Use HH:MM\n");
	}
	@post{'itdTimeHour', 'itdTimeMinute'} = split(/:/, $time);
}

sub opt_date {
	my (undef, $date) = @_;

	if ($date !~ /^ [0-3]? \d \. [01]? \d \. (?: \d{4} )? $/x) {
		die("date: Invalid argument: Use DD.MM.[YYYY]\n");
	}
	@post{'itdDateDay', 'itdDateMonth', 'itdDateYear'} = split(/\./, $date);
	$post{itdDateYear} //= (localtime(time))[5] + 1900;
}

sub opt_exclude {
	my @mapping = qw/
		zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
		schnellbus seilbahn schiff ast sonstige
	/;
	my (undef, $str) = @_;
	my @exclude = split(/,/, $str);

	foreach my $exclude_type (@exclude) {
		my $ok = 0;
		for my $map_id (0 .. $#mapping) {
			if ($exclude_type eq $mapping[$map_id]) {
				$post{"inclMOT_$map_id"} = undef;
				$ok = 1;
			}
		}
		if (not $ok) {
			die("exclude: Invalid argument: $exclude_type\n");
		}
	}
}

sub opt_maxinter {
	my (undef, $opt) = @_;
	$post{maxChanges} = $opt;
}

sub opt_prefer {
	my (undef, $prefer) = @_;

	given ($prefer) {
		when ('speed')  { $post{routeType} = 'LEASTTIME' }
		when ('nowait') { $post{routeType} = 'LEASTINTERCHANGE' }
		when ('nowalk') { $post{routeType} = 'LEASTWALKING' }
		default {
			die("prefer: Invalid argument. Use speed|nowait|nowalk\n");
		}
	}
}

sub opt_proximity {
	$post{useProxFootSearch} = 1;
}

sub opt_include {
	my (undef, $include) = @_;

	given ($include) {
		when ('local') { $post{lineRestriction} = 403 }
		when ('ic')    { $post{lineRestriction} = 401 }
		when ('ice')   { $post{lineRestriction} = 400 }
		when (/\d+/)   { $post{lineRestriction} = $include }
		default {
			die("include: Invalid argument. Use local|ic|ice\n");
		}
	}
}

sub opt_walk_speed {
	my (undef, $walk_speed) = @_;

	if ($walk_speed ~~ ['normal', 'fast', 'slow']) {
		$post{changeSpeed} = $walk_speed;
	}
	else {
		die("walk-speed: Invalid argument. Use normal|fast|slow\n");
	}
}

sub opt_bike {
	$ignore_info = undef;
	$post{bikeTakeAlong} = 1;
}

sub opt_timeout {
	my (undef, $timeout) = @_;
	# XXX
}

GetOptions(
	'a|arrive=s'     => \&opt_time_arr,
	'b|bike'         => \&opt_bike,
	'd|date=s'       => \&opt_date,
	'depart=s'       => \&opt_time_dep,
	'e|exclude=s'    => \&opt_exclude,
	'from=s{2}'      => \@from,
	'h|help'         => sub {exec('perldoc', '-F', $0)},
	'I|ignore-info=s{0,1}' => \$ignore_info,
	'm|max-change=i' => \&opt_maxinter,
	'post=s'         => \%post,
	'P|prefer=s'     => \&opt_prefer,
	'p|proximity'    => \&opt_proximity,
	'i|include=s'    => \&opt_include,
	'test-dump'      => \$test_dump,
	'test-parse'     => \$test_parse,
	't|time=s'       => \&opt_time,
	'timeout=i'      => \&opt_timeout,
	'to=s{2}'        => \@to,
	'v|version'      => sub {print "efa version $VERSION\n"; exit 0},
	'via=s{2}'       => \@via,
	'w|walk-speed=s' => \&opt_walk_speed,

) or die("Please see $0 --help\n");

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

if (@to != 2 or @from != 2) {
	die("Insufficient to/from arguments, see $0 --help for usage\n");
}

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}  }
		}
	}
}

@post{'place_origin', 'name_origin'} = @from;
@post{'place_destination', 'name_destination'} = @to;
if (@via == 2) {
	@post{'place_via', 'name_via'} = @via;
}

foreach my $type ($from_type, $to_type, $via_type) {
	if (not ($type ~~ ['stop', 'address', 'poi'])) {
		die("from/to/via type: Must be stop, addr or poi, not '$type'\n");
	}
}

$post{type_origin} = $from_type;
$post{type_destination} = $to_type;
$post{type_via} = $via_type;

if ($test_parse) {
	local $/ = undef;
	$efa = WWW::Efa->new_from_html(<STDIN>);
}
else {
	$efa = WWW::Efa->new(\%post);
}

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