summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/efa214
-rwxr-xr-xlib/WWW/Efa.pm197
-rw-r--r--t/50-efa.t146
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);