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 Travel::Routing::DE::VRR;
use Exception::Class;
use Getopt::Long qw/:config no_ignore_case/;

our $VERSION = '1.3';
my $ignore_info = 'Fahrradmitnahme';
my $efa;
my ( @from, @to, @via, $from_type, $to_type, $via_type );
my $opt = {
	'help' => \&show_help,
	,
	'ignore-info' => \$ignore_info,
	'from'        => \@from,
	'to'          => \@to,
	'version'     => sub { say "efa version $VERSION"; exit 0 },
	'via'         => \@via,
};

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

sub show_help {
	say 'Usage: efa [options] <from-city> <from-stop> <to-city> <to-stop>';
	say 'See also: man efa';
	exit 0;
}

sub handle_efa_exception {
	my ($e) = @_;

	if ( $e->isa('Travel::Routing::DE::VRR::Exception::Setup') ) {
		if ( $e->message ) {
			printf STDERR ( "Error: %s (option '%s'): %s\n", $e->description,
				$e->message );
		}
		else {
			printf STDERR (
				"Error: %s (option '%s', got '%s', want '%s')\n",
				$e->description, $e->option, $e->have, $e->want
			);
		}

		exit 1;
	}
	if ( $e->isa('Travel::Routing::DE::VRR::Exception::Net') ) {
		printf STDERR ( "Error: %s: %s\n", $e->description,
			$e->http_errstr->as_string );
		exit 2;
	}
	if ( $e->isa('Travel::Routing::DE::VRR::Exception::NoData') ) {
		printf STDERR ( 'Error: %s', $e->description );
		exit 3;
	}
	if ( $e->isa('Travel::Routing::DE::VRR::Exception::Ambiguous') ) {
		printf STDERR (
			"Error: %s for key %s. Specify one of %s\n",
			$e->description, $e->post_key, $e->possibilities
		);
		exit 4;
	}
	if ( $e->isa('Travel::Routing::DE::VRR::Exception::NoConnections') ) {
		printf STDERR ( "Error: %s: %s\n", $e->description, $e->error );
		exit 5;
	}

	printf STDERR ( "Uncatched exception: %s\n%s", ref($e), $e->trace );
	exit 10;
}

sub check_for_error {
	my ($eval_error) = @_;

	if ( not defined $efa ) {
		if (    $eval_error
			and ref($eval_error)
			and $eval_error->isa('Travel::Routing::DE::VRR::Exception') )
		{
			handle_efa_exception($eval_error);
		}
		elsif ($eval_error) {
			printf STDERR
			  "Unknown Travel::Routing::DE::VRR error:\n${eval_error}";
			exit 10;
		}
		else {
			say STDERR 'Travel::Routing::DE::VRR failed to return an object';
			exit 10;
		}
	}

	return;
}

#<<<
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
		time|t=s
		timeout=i
		to=s@{2}
		version|v
		via=s@{2}
		walk-speed|w=s
	},
) or die("Please see perldoc -F $0\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;
	}
}

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

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

if ( defined $opt->{'ignore-info'} and length( $opt->{'ignore-info'} ) == 0 ) {
	$opt->{'ignore-info'} = undef;
}

$efa = eval {
	Travel::Routing::DE::VRR->new(
		origin      => [ @from, $from_type ],
		destination => [ @to,   $to_type ],
		via => ( @via ? [ @via, $via_type ] : undef ),

		arrival_time   => $opt->{arrive},
		departure_time => $opt->{depart} // $opt->{time},
		date           => $opt->{date},
		exclude        => $opt->{exclude},
		train_type     => $opt->{include},
		with_bike      => $opt->{bike},

		select_interchange_by => $opt->{prefer},
		use_near_stops        => $opt->{proximity},
		walk_speed            => $opt->{'walk-speed'},
		max_interchanges      => $opt->{'max-change'},

		lwp_options => { timeout => $opt->{timeout} },
	);
};

check_for_error($@);

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

for my $i ( 0 .. $#routes ) {
	for my $c ( $routes[$i]->parts() ) {

		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->get(
				qw(departure_time departure_stop train_line
				  train_destination arrival_time arrival_stop)
			),
		);
	}
	if ( $i != $#routes ) {
		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 VERSION

version 1.3

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

It should be noted that B<efa>, although using the web interface of a local
transport association, is able to look up connections all over Germany.

=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, use plain ASCII.

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