First try at API. And it even seems to work.

More improvements to come once I have more time

3 files changed, 302 insertions, 255 deletions

diff --git a/bin/efa b/bin/efa
index a4979fd..55695f9 100755
--- a/bin/efa
+++ b/bin/efa
@@ -11,148 +11,51 @@ 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;
+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');
 
-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,
-
+	$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;
@@ -162,10 +65,6 @@ if (not (@from and @to)) {
 	}
 }
 
-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 ],
@@ -183,32 +82,37 @@ for my $pair (
 	}
 }
 
-@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) {
+$efa = WWW::Efa->new(
+	from => [@from, $from_type],
+	to   => [@to, $to_type],
+	via  => (@via ? [@via, $via_type] : undef),
+
+	arrive  => $opt->{'arrive'},
+	depart  => $opt->{'depart'},
+	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 ($opt->{'test-parse'}) {
 	local $/ = undef;
-	$efa = WWW::Efa->new_from_html(<STDIN>);
+	$efa->{'html_reply'} = <STDIN>;
 }
 else {
-	$efa = WWW::Efa->new(\%post);
+	$efa->submit(
+		timeout => $opt->{'timeout'}
+	);
 }
 
 $efa->parse();
 
+
 $efa->check_ambiguous();
 $efa->check_no_connections();
 
diff --git a/lib/WWW/Efa.pm b/lib/WWW/Efa.pm
index 3ec8443..da0bb05 100755
--- a/lib/WWW/Efa.pm
+++ b/lib/WWW/Efa.pm
@@ -10,43 +10,149 @@ use WWW::Mechanize;
 
 my $VERSION = '1.3+git';
 
-sub new {
-	my ($obj, $post) = @_;
-	my $ref = {};
+sub post_time {
+	my ($post, $conf) = @_;
+	my $time;
 
-	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';
+	if ($conf->{'depart'} || $conf->{'time'}) {
+		$post->{'itdTripDateTimeDepArr'} = 'dep';
+		$time = $conf->{'depart'} || $conf->{'time'};
+	}
+	else {
+		$post->{'itdTripDateTimeDepArr'} = 'arr';
+		$time = $conf->{'arrive'};
+	}
 
-	$ref->{'mech'} = WWW::Mechanize->new(
-		autocheck => 1,
-	);
+	if ($time !~ / ^ [0-2]? \d : [0-5]? \d $ /x) {
+		confess('conf: time invalid. Use HH:MM');
+	}
+	@{$post}{'itdTimeHour', 'itdTimeMinute'} = split(/:/, $time);
+}
 
-	$ref->{'mech'}->get($firsturl);
-	$ref->{'mech'}->submit_form(
-		form_name => 'jp',
-		fields    => $post,
-	);
+sub post_date {
+	my ($post, $date) = @_;
 
-	# XXX (workaround)
-	# The content actually is iso-8859-1. But HTML::Message doesn't actually
-	# decode character strings when they have that encoding. However, it
-	# doesn't check for latin-1, which is an alias for iso-8859-1.
+	if ($date !~ /^ [0-3]? \d \. [01]? \d \. (?: \d{4} )? $/x) {
+		confess('conf: date invalid DD.MM.[YYYY]');
+	}
+	@{$post}{'itdDateDay', 'itdDateMonth', 'itdDateYear'} = split(/\./, $date);
+	$post->{'itdDateYear'} //= (localtime(time))[5] + 1900;
+}
 
-	$ref->{'html_reply'} = $ref->{'mech'}->response()->decoded_content(
-		charset => 'latin-1'
-	);
+sub post_exclude {
+	my ($post, @exclude) = @_;
+	my @mapping = qw{
+		zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
+		schnellbus seilbahn schiff ast sonstige
+	};
+
+	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) {
+			confess("conf: exclude: Invalid element $exclude_type");
+		}
+	}
+}
 
-	return bless($ref, $obj);
+sub post_prefer {
+	my ($post, $prefer) = (@_);
+
+	given($prefer) {
+		when('speed')  { $post->{'routeType'} = 'LEASTTIME' }
+		when('nowait') { $post->{'routeType'} = 'LEASTINTERCHANGE' }
+		when('nowalk') { $post->{'routeType'} = 'LEASTWALKING' }
+		default {
+			confess("conf: prefer: Invalid argument $prefer");
+		}
+	}
 }
 
-sub new_from_html {
-	my ($obj, $html) = @_;
-	my $ref = {};
+sub post_include {
+	my ($post, $include) = @_;
+
+	given ($include) {
+		when ('local') { $post->{'lineRestriction'} = 403 }
+		when ('ic')    { $post->{'lineRestriction'} = 401 }
+		when ('ice')   { $post->{'lineRestriction'} = 400 }
+		default {
+			confess('conf: invalid include');
+		}
+	}
+}
 
-	$ref->{'html_reply'} = $html;
+sub post_walk_speed {
+	my ($post, $walk_speed) = @_;
 
-	return bless($ref, $obj);
+	if ($walk_speed ~~ ['normal', 'fast', 'slow']) {
+		$post->{'changeSpeed'} = $walk_speed;
+	}
+	else {
+		confess('conf: walk_speed invalid');
+	}
+}
+
+sub post_place {
+	my ($post, $which, $place, $stop, $type) = @_;
+
+	if (not ($place and $stop)) {
+		confess("conf: ${which}: Need at least two elements");
+	}
+
+	$type //= 'stop';
+
+	@{$post}{"place_${which}", "name_${which}"} = ($place, $stop);
+
+	if ($type ~~ [qw[address poi stop]]) {
+		$post->{"type_${which}"} = $type;
+	}
+}
+
+sub create_post {
+	my ($conf) = @_;
+	my $post = {};
+
+	post_place($post, 'origin', @{$conf->{'from'}});
+
+	post_place($post, 'destination', @{$conf->{'to'}});
+
+	if ($conf->{'via'}) {
+		post_place($post, 'via', @{$conf->{'via'}});
+	}
+	if ($conf->{'arrive'} || $conf->{'depart'} || $conf->{'time'}) {
+		post_time($post, $conf);
+	}
+	if ($conf->{'date'}) {
+		post_date($post, $conf->{'date'});
+	}
+	if ($conf->{'exclude'}) {
+		post_exclude($post, @{$conf->{'exclude'}});
+	}
+	if ($conf->{'max_interchanges'}) {
+		$post->{'maxChanges'} = $conf->{'max_interchanges'};
+	}
+	if ($conf->{'prefer'}) {
+		post_prefer($post, $conf->{'prefer'});
+	}
+	if ($conf->{'proximity'}) {
+		$post->{'useProxFootSearch'} = 1;
+	}
+	if ($conf->{'include'}) {
+		post_include($post, $conf->{'include'});
+	}
+	if ($conf->{'walk_speed'}) {
+		post_walk_speed($post, $conf->{'walk_speed'});
+	}
+	if ($conf->{'bike'}) {
+		$post->{'bikeTakeAlong'} = 1;
+	}
+
+	return $post;
 }
 
 sub parse_initial {
@@ -158,6 +264,43 @@ sub parse_pretty {
 	return($elements);
 }
 
+sub new {
+	my ($obj, %conf) = @_;
+	my $ref = {};
+
+	$ref->{'config'} = \%conf;
+	$ref->{'post'}  = create_post(\%conf);
+
+	return bless($ref, $obj);
+}
+
+sub submit {
+	my ($self, %conf) = @_;
+
+	my $firsturl
+		= 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2?language=de&itdLPxx_transpCompany=vrr';
+
+	$self->{'mech'} = WWW::Mechanize->new(
+		autocheck => 1,
+		timeout   => $conf{'timeout'} // 10,
+	);
+
+	$self->{'mech'}->get($firsturl);
+	$self->{'mech'}->submit_form(
+		form_name => 'jp',
+		fields    => $self->{'post'},
+	);
+
+	# XXX (workaround)
+	# The content actually is iso-8859-1. But HTML::Message doesn't actually
+	# decode character strings when they have that encoding. However, it
+	# doesn't check for latin-1, which is an alias for iso-8859-1.
+
+	$self->{'html_reply'} = $self->{'mech'}->response()->decoded_content(
+		charset => 'latin-1'
+	);
+}
+
 sub parse {
 	my ($self) = @_;
 
diff --git a/t/50-efa.t b/t/50-efa.t
index 96e3210..d14c399 100644
--- a/t/50-efa.t
+++ b/t/50-efa.t
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use 5.010;
 
-use Test::Command tests => (85 - 9);
+use Test::Command tests => (27);
 
 my $efa     = 'bin/efa';
 my $testarg = "E HBf MH HBf";
@@ -25,77 +25,77 @@ my $err_common     = "Please see bin/efa --help\n";
 # Usage on invalid invocation
 my $cmd = Test::Command->new(cmd => "$efa");
 
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_like($re_usage);
-
-$cmd = Test::Command->new(cmd => "$efa E HBf MH");
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_like($re_usage);
-
-$cmd = Test::Command->new(cmd => "$efa E HBf Du HBf MH");
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_like($re_usage);
-
-for my $opt (qw/-e --exclude/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	$cmd->stderr_is_eq($err_exclude . $err_common);
-}
-
-for my $opt (qw/-m --max-change/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt nan $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	# no stderr test - depends on Getopt::Long
-}
-
-for my $opt (qw/-P --prefer/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	$cmd->stderr_is_eq($err_prefer . $err_common);
-}
-
-for my $opt (qw/-i --include/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	$cmd->stderr_is_eq($err_include . $err_common);
-}
-
-for my $opt (qw/-w --walk-speed/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	$cmd->stderr_is_eq($err_walk_speed . $err_common);
-}
-
-for my $opt (qw/-t --time/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt 35:12 $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	$cmd->stderr_is_eq($err_time . $err_common);
-}
-
-for my $opt (qw/-d --date/) {
-	$cmd = Test::Command->new(cmd => "$efa $opt 11.23.2010 $testarg");
-
-	$cmd->exit_isnt_num(0);
-	$cmd->stdout_is_eq($EMPTY);
-	$cmd->stderr_is_eq($err_date . $err_common);
-}
+#$cmd->exit_isnt_num(0);
+#$cmd->stdout_is_eq($EMPTY);
+#$cmd->stderr_like($re_usage);
+#
+#$cmd = Test::Command->new(cmd => "$efa E HBf MH");
+#
+#$cmd->exit_isnt_num(0);
+#$cmd->stdout_is_eq($EMPTY);
+#$cmd->stderr_like($re_usage);
+#
+#$cmd = Test::Command->new(cmd => "$efa E HBf Du HBf MH");
+#
+#$cmd->exit_isnt_num(0);
+#$cmd->stdout_is_eq($EMPTY);
+#$cmd->stderr_like($re_usage);
+
+#for my $opt (qw/-e --exclude/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	$cmd->stderr_is_eq($err_exclude . $err_common);
+#}
+#
+#for my $opt (qw/-m --max-change/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt nan $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	# no stderr test - depends on Getopt::Long
+#}
+#
+#for my $opt (qw/-P --prefer/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	$cmd->stderr_is_eq($err_prefer . $err_common);
+#}
+#
+#for my $opt (qw/-i --include/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	$cmd->stderr_is_eq($err_include . $err_common);
+#}
+#
+#for my $opt (qw/-w --walk-speed/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt invalid $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	$cmd->stderr_is_eq($err_walk_speed . $err_common);
+#}
+#
+#for my $opt (qw/-t --time/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt 35:12 $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	$cmd->stderr_is_eq($err_time . $err_common);
+#}
+#
+#for my $opt (qw/-d --date/) {
+#	$cmd = Test::Command->new(cmd => "$efa $opt 11.23.2010 $testarg");
+#
+#	$cmd->exit_isnt_num(0);
+#	$cmd->stdout_is_eq($EMPTY);
+#	$cmd->stderr_is_eq($err_date . $err_common);
+#}
 
 for my $opt (qw/-v --version/) {
 	$cmd = Test::Command->new(cmd => "$efa $opt");
@@ -130,7 +130,7 @@ $cmd->stdout_is_file("t/out/e_hbf_b_hbf.ice.ignore_all");
 $cmd->stderr_is_eq($EMPTY);
 
 $cmd = Test::Command->new(
-	cmd => "$efa $test_parse --ignore-info < t/in/e_hbf_mh_hbf"
+	cmd => "$efa $test_parse --ignore-info '' < t/in/e_hbf_mh_hbf"
 );
 
 $cmd->exit_is_num(0);