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 encoding 'utf8';
use 5.010;
use Encode;
use Getopt::Long qw/:config no_ignore_case/;
use WWW::Mechanize;

my $firsturl = 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2?language=de&itdLPxx_transpCompany=vrr';
my $posturl = 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2';

my $version = '1.1.1+git';
my $content;
my %post;
my $www = WWW::Mechanize->new(
	autocheck => 1,
);
my $raw;
my (@from, @to, @via);
my ($from_type, $to_type, $via_type) = ('stop') x 3;
my ($time, $time_depart, $time_arrive);
my $date;
my @exclude;
my $maxinter;
my $include;
my $prefer;
my $proximity;
my $walk_speed;
my $with_bike;
my $debug = 0;
my $ignore_info = 'Fahrradmitnahme';
my ($test_dump, $test_parse);

sub check_ambiguous {
	my $html = shift;
	my $choose_re = qr{
		<span \s class="errorTextBold">
		Bitte \s auswählen
		</span>
	}x;
	my $select_re = qr{
		<select \s name="
		(?<what>
			( place | type | name )
			_
			( origin | destination )
		) "
	}x;
	my $option_re = qr{
		<option \s value=" \d+ ( : \d+ )* "
		( \s selected )? >
		(?<choice> [^<]+ )
		</option>
	}x;

	if ($html =~ /$choose_re/s) {
		foreach (split(/$choose_re/s, $html)) {
			if (/$select_re/) {
				print "Ambiguous input for $+{what}\n";
			}
			while (/$option_re/gs) {
				print "\t$+{choice}\n";
			}
		}
		return 1;
	}
	return 0;
}

sub parse_content {
	my $input = shift;
	my $groupsize = 8;
	my $return;
	my $time_re = qr{ \d+ : \d+ }x;
	my $ext_time_re = qr{
		^ (
			$time_re
			|
			ab \s
			|
		) $
	}x;
	my $anschluss_re = qr{
		^ (
			Fußweg
			|
			Anschluss \s wird .* abgewartet
		)
	}x;

	for my $offer (0 .. $#{$input}) {
		foreach (@{$input->[$offer]}) {
			s/\s* <br> \s*/, /gx;
			s/< [^>]+ >//gx;
		}

		for (my $i = 0; @{$input->[$offer]} >= (($i+1) * $groupsize) - 1; $i++) {
			my $offset = $i * $groupsize;
			my @extra;
			if (
			     $input->[$offer]->[$offset+2] =~ $anschluss_re
			  or $input->[$offer]->[$offset+3] =~ / ^ Fußweg /x
			) {
				# These are generic and usually lack both the time and the last element
				if ($input->[$offer]->[$offset  ] !~ $time_re) {splice(@{$input->[$offer]}, $offset  , 0, '')}
				if ($input->[$offer]->[$offset+4] !~ $time_re) {splice(@{$input->[$offer]}, $offset+4, 0, '')}
				splice(@{$input->[$offer]}, $offset+7, 0, '');
			}

			for my $j (0, 4, 8) {
				while (
					exists $input->[$offer]->[$offset+$j]
					and $input->[$offer]->[$offset+$j] !~ $ext_time_re
					and $input->[$offer]->[$offset+$j] ne 'Verspätungen sind berücksichtigt'
				) {
					if ($input->[$offer]->[$offset+$j] =~ /^ \s* $/x) {
						splice(@{$input->[$offer]}, $offset+$j, 1);
					}
					else {
						push(@extra, splice(@{$input->[$offer]}, $offset+$j, 1));
					}
				}
			}

			$return->[$offer]->[$i] = {
				deptime  => $input->[$offer]->[$offset],
				dep      => $input->[$offer]->[$offset+1],
				depstop  => $input->[$offer]->[$offset+2],
				deptrain => $input->[$offer]->[$offset+3],
				depdest  => $input->[$offer]->[$offset+7],
				arrtime  => $input->[$offer]->[$offset+4],
				arr      => $input->[$offer]->[$offset+5],
				arrstop  => $input->[$offer]->[$offset+6],
			};
			@{$return->[$offer]->[$i]->{extra}} = @extra;
		}
	}
	return $return;
}

sub prepare_content {
	my $html = shift;
	my $offer = 0;
	my $return;
	my $split_re = qr{
		<span \s class="labelTextBold">
		\s \d+ \. \s Fahrt
		</span>
	}x;
	my $content_re = qr{
		<span \s class="labelText" ( \s valign="center" )? >
		(?<content> .+ )
		</span> </td>
	}x;

	foreach my $chunk (split($split_re, $html)) {
		if ($offer == 0) {
			$offer++;
			next;
		}
		foreach my $line (split(/\n/, $chunk)) {
			if ($line =~ $content_re) {
				push(@{$return->[$offer-1]}, $+{content});
			}
		}
		$offer++;
	}
	return $return;
}

sub show_content {
	my $connections = shift;
	my $first = 0;

	foreach my $connection (@{$connections}) {
		if ($first) {
			print "------\n\n";
		}
		else {
			$first = 1;
		}

		foreach my $part (@{$connection}) {
			foreach (@{$part->{extra}}) {
				if (not (length($ignore_info) and $_ =~ /$ignore_info/i)) {
					print "# $_\n";
				}
			}

			printf(
				"%-5s %-2s %-30s %-20s %s\n%-5s %-2s %-30s\n\n",
				$part->{deptime}, $part->{dep}, $part->{depstop}, $part->{deptrain},
				$part->{depdest}, $part->{arrtime}, $part->{arr}, $part->{arrstop}
			);

		}
	}
	return;
}

GetOptions(
	'a|arrive=s'     => \$time_arrive,
	'b|bike'         => \$with_bike,
	'd|date=s'       => \$date,
	'D|debug'        => \$debug,
	'depart=s'       => \$time_depart,
	'e|exclude=s'    => \@exclude,
	'from=s{2}'      => \@from,
	'from-type=s'    => \$from_type,
	'h|help'         => sub {exec('perldoc', '-F', $0)},
	'I|ignore-info=s{0,1}' => \$ignore_info,
	'm|max-change=i' => \$maxinter,
	'post=s'         => \%post,
	'P|prefer=s'     => \$prefer,
	'p|proximity'    => \$proximity,
	'i|include=s'    => \$include,
	'test-dump'      => \$test_dump,
	'test-parse'     => \$test_parse,
	't|time=s'       => \$time,
	'to=s{2}'        => \@to,
	'to-type=s'      => \$to_type,
	'v|version'      => sub {print "efa version $version\n"; exit 0},
	'via=s{2}'       => \@via,
	'via-type=s'     => \$via_type,
	'w|walk-speed=s' => \$walk_speed,
);

@exclude = split(/,/, join(',', @exclude));

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]);
	for my $type (['addr', 'address'], ['poi', 'poi']) {
		if ($pair->[0] =~ s/ ^ $type->[0] : \s* (.+) $ /$1/x) {
			${$pair->[1]} = $type->[1];
		}
	}
}

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

# note that $from_type etc are changed here
foreach my $type ($from_type, $to_type, $via_type) {
	if (not ($type ~~ ['stop', 'address', 'poi'])) {
		$type = 'stop';
		die("from/to/via type: Must be stop, address or poi, not '$type'\n");
	}
}

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

if ($time_arrive) {
	$time = $time_arrive;
	$post{itdTripDateTimeDepArr} = 'arr';
}
elsif ($time_depart) {
	$time = $time_depart;
	$post{itdTripDateTimeDepArr} = 'dep';
}

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

if (@exclude) {
	my @mapping = qw/
		zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
		schnellbus seilbahn schiff ast sonstige
	/;
	my $ok = 0;

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

# Argument verification done by Getopt::Long
if (defined($maxinter)) {
	$post{maxChanges} = $maxinter;
}

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

if ($proximity) {
	$post{useProxFootSearch} = 1;
}

if ($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("Invalid argument. Usage: --include local|ic|ice\n");
		}
	}
}

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

if ($with_bike) {
	$ignore_info = undef;
	$post{bikeTakeAlong} = 1;
}

if ($test_parse) {
	local $/;
	$content = <STDIN>;
}
else {
	$www->get($firsturl);
	$www->submit_form(
		form_name => 'jp',
		fields => \%post,
	);

	$content = $www->content;
	$content =~ s/\xa0/ /gs;
	$content = decode('iso-8859-1', $content);
}

if ($test_dump) {
	print $content;
	exit 0
}

if (check_ambiguous($content)) {
	exit 1;
}

$raw = prepare_content($content);

if ($debug) {
	print STDERR "custom post values used in query:\n";
	foreach (keys(%post)) {
		print STDERR "\t$_ => $post{$_}\n";
	}

	print STDERR "\nraw response:\n";
	foreach (@{$raw}) {
		print STDERR "---\n";
		foreach (@{$_}) {
			print STDERR "$_\n";
		}
	}
}

show_content(parse_content($raw));

__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

=item B<--from-type>, B<--to-type>, B<--via-type> I<type>

Designate type of the I<stop> for from/to/via.
Possible I<type>s: B<stop> (default), B<address>, B<poi> (point of interest)

Alternatively, you can specify the I<stop> of the from/to/via options as
"addr:I<stop>" or "poi:I<stop>", respectively

=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<-D>|B<--debug>

Display debug information (additional post requests sent to the site,
raw items received from the site)

=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 BUGS

The Unicode handling is slightly messed up. Therefore, arguments to B<efa>
should always be plain ASCII (ue instead of E<uuml> etc).