summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore1
-rwxr-xr-xbin/efa101
-rw-r--r--lib/WWW/Efa.pm787
-rw-r--r--lib/WWW/Efa/Error/Ambiguous.pm69
-rw-r--r--lib/WWW/Efa/Error/Backend.pm60
-rw-r--r--lib/WWW/Efa/Error/NoData.pm50
-rw-r--r--lib/WWW/Efa/Error/Setup.pm80
-rw-r--r--t/50-www-efa.t28
-rw-r--r--t/60-bin-efa.t189
9 files changed, 437 insertions, 928 deletions
diff --git a/.gitignore b/.gitignore
index 6ffbe1e..a8f36dc 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,6 +3,7 @@
/blib
/cover_db
/MANIFEST
+/MANIFEST.bak
/MANIFEST.SKIP
/MANIFEST.SKIP.bak
/MYMETA.yml
diff --git a/bin/efa b/bin/efa
index 4e4333b..c97f4f1 100755
--- a/bin/efa
+++ b/bin/efa
@@ -9,24 +9,23 @@ use 5.010;
use Getopt::Long qw/:config no_ignore_case/;
use WWW::Efa;
-my $VERSION = '1.3+git';
-my %post;
+our $VERSION = '1.3';
my $ignore_info = 'Fahrradmitnahme';
-my ($test_dump, $test_parse);
my $efa;
-my (@from, @to, @via, $from_type, $to_type, $via_type);
+my ( @from, @to, @via, $from_type, $to_type, $via_type );
my $opt = {
- 'help' => sub { exec('perldoc', '-F', $0) },
+ 'help' => sub { exec( 'perldoc', '-F', $0 ) },
'ignore-info' => \$ignore_info,
'from' => \@from,
'to' => \@to,
- 'version' => sub { say "efa version $VERSION"; exit 0 },
- 'via' => \@via,
+ 'version' => sub { say "efa version $VERSION"; exit 0 },
+ 'via' => \@via,
};
-binmode(STDOUT, ':utf8');
-binmode(STDERR, ':utf8');
+binmode( STDOUT, ':encoding(utf-8)' );
+binmode( STDERR, ':encoding(utf-8)' );
+#<<<
GetOptions(
$opt,
qw{
@@ -52,37 +51,37 @@ GetOptions(
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;
+#>>>
+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;
+ 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]);
+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)
+ if (
+ $pair->[0]->[1] =~ s{ ^ (?<type> [^:]+ ) : \s* (?<target> .+ ) $ }
+ {$+{target}}x
+ )
{
- given($+{type}) {
- when('addr') { ${$pair->[1]} = 'address' }
- default { ${$pair->[1]} = $+{type} }
+ given ( $+{type} ) {
+ when ('addr') { ${ $pair->[1] } = 'address' }
+ default { ${ $pair->[1] } = $+{type} }
}
}
}
$efa = WWW::Efa->new(
- from => [@from, $from_type],
- to => [@to, $to_type],
- via => (@via ? [@via, $via_type] : undef),
+ from => [ @from, $from_type ],
+ to => [ @to, $to_type ],
+ via => ( @via ? [ @via, $via_type ] : undef ),
arrive => $opt->{'arrive'},
depart => $opt->{'depart'} // $opt->{'time'},
@@ -92,50 +91,34 @@ $efa = WWW::Efa->new(
include => $opt->{'include'},
bike => $opt->{'bike'},
- proximity => $opt->{'proximity'},
- walk_speed => $opt->{'walk-speed'},
- max_interchanges => $opt->{'max-change'},
+ proximity => $opt->{'proximity'},
+ walk_speed => $opt->{'walk-speed'},
+ max_interchanges => $opt->{'max-change'},
);
-if ($efa->error()) {
- die $efa->error()->as_string();
-}
+$efa->submit( timeout => $opt->{'timeout'} );
-if ($opt->{'test-parse'}) {
- local $/ = undef;
- $efa->{'html_reply'} = <STDIN>;
-}
-else {
- $efa->submit(
- timeout => $opt->{'timeout'}
- );
-}
-
-$efa->parse or die $efa->error()->as_string();
+$efa->parse();
my @connections = $efa->connections();
-for my $i (0 .. $#connections) {
- for my $c (@{$connections[$i]}) {
+for my $i ( 0 .. $#connections ) {
+ for my $c ( @{ $connections[$i] } ) {
- for my $extra (@{$c->{'extra'}}) {
+ for my $extra ( @{ $c->{'extra'} } ) {
- if (not (length $ignore_info and $extra =~ /$ignore_info/i)) {
+ 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'},
+ $c->{'dep_time'}, $c->{'dep_stop'}, $c->{'train_line'},
+ $c->{'train_dest'}, $c->{'arr_time'}, $c->{'arr_stop'},
);
}
- if ($i != $#connections) {
+ if ( $i != $#connections ) {
print "------\n\n";
}
}
@@ -156,6 +139,10 @@ efa - unofficial efa.vrr.de command line client
=back
+=head1 VERSION
+
+version 1.3
+
=head1 DESCRIPTION
B<efa> is a command line client for the L<http://efa.vrr.de> web interface.
diff --git a/lib/WWW/Efa.pm b/lib/WWW/Efa.pm
index 417fd6b..99c3181 100644
--- a/lib/WWW/Efa.pm
+++ b/lib/WWW/Efa.pm
@@ -1,313 +1,269 @@
package WWW::Efa;
-=head1 NAME
-
-WWW::Efa - inofficial interface to the efa.vrr.de German itinerary service
-
-=head1 SYNOPSIS
-
- use WWW::Efa;
-
- my $efa = WWW::Efa->new(
- from => ['Essen', 'HBf'],
- to => ['Duisburg', 'HBf'],
- );
-
- $efa->submit();
- $efa->parse();
-
- for my $con ($efa->connections()) {
- for my $c (@{$con}) {
- printf(
- "%-5s ab %-30s %-20s %s\n%-5s an %-30s\n\n",,
- @{$c}{'dep_time', 'dep_stop', 'train_line', 'train_dest'},
- @{$c}{'arr_time', 'arr_stop'},
- );
- }
- print "\n\n";
- }
-
-=head1 DESCRIPTION
-
-B<WWW::Efa> is a client for the efa.vrr.de web interface.
-You pass it the start/stop of your journey, maybe a time and a date and more
-details, and it returns the up-to-date scheduled connections between those two
-stops.
-
-It uses B<LWP::USerAgent> and B<XML::LibXML> for this.
-
-=cut
-
use strict;
use warnings;
use 5.010;
-use base 'Exporter';
-
+use Carp qw(confess);
use LWP::UserAgent;
use XML::LibXML;
-use WWW::Efa::Error::Ambiguous;
-use WWW::Efa::Error::Backend;
-use WWW::Efa::Error::NoData;
-use WWW::Efa::Error::Setup;
-our @EXPORT_OK = ();
-my $VERSION = '1.3+git';
+our $VERSION = '1.3';
sub post_time {
- my ($post, $conf) = @_;
+ my ( $post, $conf ) = @_;
+
my $time;
- if ($conf->{'depart'}) {
- $post->{'itdTripDateTimeDepArr'} = 'dep';
- $time = $conf->{'depart'} || $conf->{'time'};
+ if ( $conf->{depart} ) {
+ $post->{itdTripDateTimeDepArr} = 'dep';
+ $time = $conf->{depart} || $conf->{time};
}
else {
- $post->{'itdTripDateTimeDepArr'} = 'arr';
- $time = $conf->{'arrive'};
+ $post->{itdTripDateTimeDepArr} = 'arr';
+ $time = $conf->{arrive};
}
- if ($time !~ / ^ [0-2]? \d : [0-5]? \d $ /x) {
- die WWW::Efa::Error::Setup->new(
- ($conf->{'depart'} ? 'depart' : 'arrive'),
- $time, 'Must match HH:MM'
- );
+ if ( $time !~ / ^ [0-2]? \d : [0-5]? \d $ /x ) {
+ confess("time: must match HH:MM - '${time}'");
}
- @{$post}{'itdTimeHour', 'itdTimeMinute'} = split(/:/, $time);
+
+ @{$post}{ 'itdTimeHour', 'itdTimeMinute' } = split( /:/, $time );
+
+ return;
}
sub post_date {
- my ($post, $date) = @_;
- my ($day, $month, $year) = split(/\./, $date);
+ my ( $post, $date ) = @_;
+
+ my ( $day, $month, $year ) = split( /[.]/, $date );
- if (not defined $day or not length($day) or $day < 1 or $day > 31) {
- die WWW::Efa::Error::Setup->new(
- 'date', $date, 'Invalid day'
- );
+ if ( not defined $day or not length($day) or $day < 1 or $day > 31 ) {
+ confess("date: invalid day, must match DD.MM[.[YYYY]] - '${date}'");
}
- if (not defined $month or not length($month) or $month < 1 or $month > 12) {
- die WWW::Efa::Error::Setup->new(
- 'date', $date, 'Invalid month'
- );
+ if ( not defined $month or not length($month) or $month < 1 or $month > 12 )
+ {
+ confess("date: invalid month, must match DD.MM[.[YYYY]] - '${date}'");
}
- if (not defined $year or not length($year)) {
- $year = (localtime(time))[5] + 1900;
+ if ( not defined $year or not length($year) ) {
+ $year = ( localtime(time) )[5] + 1900;
}
- @{$post}{'itdDateDay', 'itdDateMonth', 'itdDateYear'} = ($day, $month, $year);
+ @{$post}{ 'itdDateDay', 'itdDateMonth', 'itdDateYear' }
+ = ( $day, $month, $year );
+
+ return;
}
sub post_exclude {
- my ($post, @exclude) = @_;
+ my ( $post, @exclude ) = @_;
+
my @mapping = qw{
- zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus
- schnellbus seilbahn schiff ast sonstige
+ 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]) {
+ for my $map_id ( 0 .. $#mapping ) {
+ if ( $exclude_type eq $mapping[$map_id] ) {
$post->{"inclMOT_${map_id}"} = undef;
$ok = 1;
}
}
- if (not $ok) {
- die WWW::Efa::Error::Setup->new(
- 'exclude',
- join(q{ }, @exclude),
- 'Must consist of ' . join(q{ }, @mapping)
- );
+ if ( not $ok ) {
+ confess("exclude: Unsupported type '${exclude_type}'");
}
}
+
+ return;
}
sub post_prefer {
- my ($post, $prefer) = @_;
+ my ( $post, $prefer ) = @_;
given ($prefer) {
- when ('speed') { $post->{'routeType'} = 'LEASTTIME' }
- when ('nowait') { $post->{'routeType'} = 'LEASTINTERCHANGE' }
- when ('nowalk') { $post->{'routeType'} = 'LEASTWALKING' }
+ when ('speed') { $post->{routeType} = 'LEASTTIME' }
+ when ('nowait') { $post->{routeType} = 'LEASTINTERCHANGE' }
+ when ('nowalk') { $post->{routeType} = 'LEASTWALKING' }
default {
- die WWW::Efa::Error::Setup->new(
- 'prefer', $prefer, 'Must be either speed, nowait or nowalk'
- );
+ confess("prefer: Must be speed/nowait/nowalk: '${prefer}'");
}
}
+
+ return;
}
sub post_include {
- my ($post, $include) = @_;
+ my ( $post, $include ) = @_;
given ($include) {
- when ('local') { $post->{'lineRestriction'} = 403 }
- when ('ic') { $post->{'lineRestriction'} = 401 }
- when ('ice') { $post->{'lineRestriction'} = 400 }
+ when ('local') { $post->{lineRestriction} = 403 }
+ when ('ic') { $post->{lineRestriction} = 401 }
+ when ('ice') { $post->{lineRestriction} = 400 }
default {
- die WWW::Efa::Error::Setup->new(
- 'include', $include, 'Must be one of local/ic/ice'
- );
+ confess("include: Must be local/ic/ice: '${include}'");
}
}
+
+ return;
}
sub post_walk_speed {
- my ($post, $walk_speed) = @_;
+ my ( $post, $walk_speed ) = @_;
- if ($walk_speed ~~ ['normal', 'fast', 'slow']) {
- $post->{'changeSpeed'} = $walk_speed;
+ if ( $walk_speed ~~ [ 'normal', 'fast', 'slow' ] ) {
+ $post->{changeSpeed} = $walk_speed;
}
else {
- die WWW::Efa::Error::Setup->new(
- 'walk_speed', $walk_speed, 'Must be normal, fast or slow'
- );
+ confess("walk_speed: Must be normal/fast/slow: '${walk_speed}'");
}
+
+ return;
}
sub post_place {
- my ($post, $which, $place, $stop, $type) = @_;
+ my ( $post, $which, $place, $stop, $type ) = @_;
- if (not ($place and $stop)) {
- die WWW::Efa::Error::Setup->new(
- 'place', $which, 'Need at least two elements'
- );
+ if ( not( $place and $stop ) ) {
+ confess('place: Need two elements');
}
$type //= 'stop';
- @{$post}{"place_${which}", "name_${which}"} = ($place, $stop);
+ @{$post}{ "place_${which}", "name_${which}" } = ( $place, $stop );
- if ($type ~~ [qw[address poi stop]]) {
+ if ( $type ~~ [qw[address poi stop]] ) {
$post->{"type_${which}"} = $type;
}
+
+ return;
}
sub create_post {
my ($conf) = @_;
- my @now = localtime(time());
- my $post = {
- changeSpeed => "normal",
- command => "",
- execInst => "",
- imparedOptionsActive => 1,
- inclMOT_0 => "on",
- inclMOT_1 => "on",
- inclMOT_10 => "on",
- inclMOT_11 => "on",
- inclMOT_2 => "on",
- inclMOT_3 => "on",
- inclMOT_4 => "on",
- inclMOT_5 => "on",
- inclMOT_6 => "on",
- inclMOT_7 => "on",
- inclMOT_8 => "on",
- inclMOT_9 => "on",
- includedMeans => "checkbox",
- itOptionsActive => 1,
- itdDateDay => $now[3],
- itdDateMonth => $now[4] + 1,
- itdDateYear => $now[5] + 1900,
- itdLPxx_ShowFare => " ",
- itdLPxx_command => "",
- itdLPxx_enableMobilityRestrictionOptionsWithButton => "",
- itdLPxx_id_destination => ":destination",
- itdLPxx_id_origin => ":origin",
- itdLPxx_id_via => ":via",
- itdLPxx_mapState_destination => "",
- itdLPxx_mapState_origin => "",
- itdLPxx_mapState_via => "",
- itdLPxx_mdvMap2_destination => "",
- itdLPxx_mdvMap2_origin => "",
- itdLPxx_mdvMap2_via => "",
- itdLPxx_mdvMap_destination => "::",
- itdLPxx_mdvMap_origin => "::",
- itdLPxx_mdvMap_via => "::",
- itdLPxx_priceCalculator => "",
- itdLPxx_transpCompany => "vrr",
- itdLPxx_view => "",
- itdTimeHour => $now[2],
- itdTimeMinute => $now[1],
- itdTripDateTimeDepArr => "dep",
- language => "de",
- lineRestriction => 403,
- maxChanges => 9,
- nameInfo_destination => "invalid",
- nameInfo_origin => "invalid",
- nameInfo_via => "invalid",
- nameState_destination => "empty",
- nameState_origin => "empty",
- nameState_via => "empty",
- name_destination => "",
- name_origin => "",
- name_via => "",
- placeInfo_destination => "invalid",
- placeInfo_origin => "invalid",
- placeInfo_via => "invalid",
- placeState_destination => "empty",
- placeState_origin => "empty",
- placeState_via => "empty",
- place_destination => "",
- place_origin => "",
- place_via => "",
- ptOptionsActive => 1,
- requestID => 0,
- routeType => "LEASTTIME",
- sessionID => 0,
- text => 1993,
- trITArrMOT => 100,
- trITArrMOTvalue100 => 8,
- trITArrMOTvalue101 => 10,
- trITArrMOTvalue104 => 10,
- trITArrMOTvalue105 => 10,
- trITDepMOT => 100,
- trITDepMOTvalue100 => 8,
- trITDepMOTvalue101 => 10,
- trITDepMOTvalue104 => 10,
- trITDepMOTvalue105 => 10,
- typeInfo_destination => "invalid",
- typeInfo_origin => "invalid",
- typeInfo_via => "invalid",
- type_destination => "stop",
- type_origin => "stop",
- type_via => "stop",
- useRealtime => 1
+ my @now = localtime( time() );
+ my $post = {
+ changeSpeed => 'normal',
+ command => q{},
+ execInst => q{},
+ imparedOptionsActive => 1,
+ inclMOT_0 => 'on',
+ inclMOT_1 => 'on',
+ inclMOT_10 => 'on',
+ inclMOT_11 => 'on',
+ inclMOT_2 => 'on',
+ inclMOT_3 => 'on',
+ inclMOT_4 => 'on',
+ inclMOT_5 => 'on',
+ inclMOT_6 => 'on',
+ inclMOT_7 => 'on',
+ inclMOT_8 => 'on',
+ inclMOT_9 => 'on',
+ includedMeans => 'checkbox',
+ itOptionsActive => 1,
+ itdDateDay => $now[3],
+ itdDateMonth => $now[4] + 1,
+ itdDateYear => $now[5] + 1900,
+ itdLPxx_ShowFare => q{ },
+ itdLPxx_command => q{},
+ itdLPxx_enableMobilityRestrictionOptionsWithButton => q{},
+ itdLPxx_id_destination => ':destination',
+ itdLPxx_id_origin => ':origin',
+ itdLPxx_id_via => ':via',
+ itdLPxx_mapState_destination => q{},
+ itdLPxx_mapState_origin => q{},
+ itdLPxx_mapState_via => q{},
+ itdLPxx_mdvMap2_destination => q{},
+ itdLPxx_mdvMap2_origin => q{},
+ itdLPxx_mdvMap2_via => q{},
+ itdLPxx_mdvMap_destination => q{::},
+ itdLPxx_mdvMap_origin => q{::},
+ itdLPxx_mdvMap_via => q{::},
+ itdLPxx_priceCalculator => q{},
+ itdLPxx_transpCompany => 'vrr',
+ itdLPxx_view => q{},
+ itdTimeHour => $now[2],
+ itdTimeMinute => $now[1],
+ itdTripDateTimeDepArr => 'dep',
+ language => 'de',
+ lineRestriction => 403,
+ maxChanges => 9,
+ nameInfo_destination => 'invalid',
+ nameInfo_origin => 'invalid',
+ nameInfo_via => 'invalid',
+ nameState_destination => 'empty',
+ nameState_origin => 'empty',
+ nameState_via => 'empty',
+ name_destination => q{},
+ name_origin => q{},
+ name_via => q{},
+ placeInfo_destination => 'invalid',
+ placeInfo_origin => 'invalid',
+ placeInfo_via => 'invalid',
+ placeState_destination => 'empty',
+ placeState_origin => 'empty',
+ placeState_via => 'empty',
+ place_destination => q{},
+ place_origin => q{},
+ place_via => q{},
+ ptOptionsActive => 1,
+ requestID => 0,
+ routeType => 'LEASTTIME',
+ sessionID => 0,
+ text => 1993,
+ trITArrMOT => 100,
+ trITArrMOTvalue100 => 8,
+ trITArrMOTvalue101 => 10,
+ trITArrMOTvalue104 => 10,
+ trITArrMOTvalue105 => 10,
+ trITDepMOT => 100,
+ trITDepMOTvalue100 => 8,
+ trITDepMOTvalue101 => 10,
+ trITDepMOTvalue104 => 10,
+ trITDepMOTvalue105 => 10,
+ typeInfo_destination => 'invalid',
+ typeInfo_origin => 'invalid',
+ typeInfo_via => 'invalid',
+ type_destination => 'stop',
+ type_origin => 'stop',
+ type_via => 'stop',
+ useRealtime => 1
};
+ post_place( $post, 'origin', @{ $conf->{from} } );
+ post_place( $post, 'destination', @{ $conf->{to} } );
- post_place($post, 'origin', @{$conf->{'from'}});
- post_place($post, 'destination', @{$conf->{'to'}});
-
- if ($conf->{'via'}) {
- post_place($post, 'via', @{$conf->{'via'}});
+ if ( $conf->{via} ) {
+ post_place( $post, 'via', @{ $conf->{via} } );
}
- if ($conf->{'arrive'} || $conf->{'depart'}) {
- post_time($post, $conf);
+ if ( $conf->{arrive} || $conf->{depart} ) {
+ post_time( $post, $conf );
}
- if ($conf->{'date'}) {
- post_date($post, $conf->{'date'});
+ if ( $conf->{date} ) {
+ post_date( $post, $conf->{date} );
}
- if ($conf->{'exclude'}) {
- post_exclude($post, @{$conf->{'exclude'}});
+ if ( $conf->{exclude} ) {
+ post_exclude( $post, @{ $conf->{exclude} } );
}
- if ($conf->{'max_interchanges'}) {
- $post->{'maxChanges'} = $conf->{'max_interchanges'};
+ if ( $conf->{max_interchanges} ) {
+ $post->{maxChanges} = $conf->{max_interchanges};
}
- if ($conf->{'prefer'}) {
- post_prefer($post, $conf->{'prefer'});
+ if ( $conf->{prefer} ) {
+ post_prefer( $post, $conf->{prefer} );
}
- if ($conf->{'proximity'}) {
- $post->{'useProxFootSearch'} = 1;
+ if ( $conf->{proximity} ) {
+ $post->{useProxFootSearch} = 1;
}
- if ($conf->{'include'}) {
- post_include($post, $conf->{'include'});
+ if ( $conf->{include} ) {
+ post_include( $post, $conf->{include} );
}
- if ($conf->{'walk_speed'}) {
- post_walk_speed($post, $conf->{'walk_speed'});
+ if ( $conf->{walk_speed} ) {
+ post_walk_speed( $post, $conf->{walk_speed} );
}
- if ($conf->{'bike'}) {
- $post->{'bikeTakeAlong'} = 1;
+ if ( $conf->{bike} ) {
+ $post->{bikeTakeAlong} = 1;
}
return $post;
@@ -320,10 +276,10 @@ sub parse_initial {
my $con_no;
my $cons = [];
- my $xp_td = XML::LibXML::XPathExpression->new('//table//table/tr/td');
+ my $xp_td = XML::LibXML::XPathExpression->new('//table//table/tr/td');
my $xp_img = XML::LibXML::XPathExpression->new('./img');
- foreach my $td (@{$tree->findnodes($xp_td)}) {
+ foreach my $td ( @{ $tree->findnodes($xp_td) } ) {
my $colspan = $td->getAttribute('colspan') // 0;
my $class = $td->getAttribute('class') // q{};
@@ -332,29 +288,28 @@ sub parse_initial {
next;
}
- if ($colspan == 8) {
- if ($td->textContent() =~ / (?<no> \d+ ) \. .+ Fahrt /x) {
- $con_no = $+{'no'} - 1;
+ if ( $colspan == 8 ) {
+ if ( $td->textContent() =~ m{ (?<no> \d+ ) [.] .+ Fahrt }x ) {
+ $con_no = $+{no} - 1;
$con_part = 0;
next;
}
}
- if ($class =~ /^bgColor2?$/) {
- if ($class eq 'bgColor' and ($con_part % 2) == 1) {
+ if ( $class =~ /^bgColor2?$/ ) {
+ if ( $class eq 'bgColor' and ( $con_part % 2 ) == 1 ) {
$con_part++;
}
- elsif ($class eq 'bgColor2' and ($con_part % 2) == 0) {
+ elsif ( $class eq 'bgColor2' and ( $con_part % 2 ) == 0 ) {
$con_part++;
}
}
- if (
- defined $con_no and not $td->exists($xp_img)
- and $td->textContent() !~ /^\s*$/
- )
+ if ( defined $con_no
+ and not $td->exists($xp_img)
+ and $td->textContent() !~ /^\s*$/ )
{
- push(@{$cons->[$con_no]->[$con_part]}, $td->textContent());
+ push( @{ $cons->[$con_no]->[$con_part] }, $td->textContent() );
}
}
@@ -363,21 +318,22 @@ sub parse_initial {
sub parse_pretty {
my ($con_parts) = @_;
+
my $elements;
my @next_extra;
- for my $con (@{$con_parts}) {
+ for my $con ( @{$con_parts} ) {
my $hash;
# Note: Changes @{$con} elements
- foreach my $str (@{$con}) {
+ foreach my $str ( @{$con} ) {
$str =~ s/[\s\n\t]+/ /gs;
$str =~ s/^ //;
$str =~ s/ $//;
}
- if (@{$con} < 5) {
+ if ( @{$con} < 5 ) {
@next_extra = @{$con};
next;
}
@@ -385,41 +341,190 @@ sub parse_pretty {
# @extra may contain undef values
foreach my $extra (@next_extra) {
if ($extra) {
- push(@{$hash->{'extra'}}, $extra);
+ push( @{ $hash->{extra} }, $extra );
}
}
@next_extra = undef;
- if ($con->[0] !~ / \d{2} : \d{2} /ox) {
- splice(@{$con}, 0, 0, q{});
- splice(@{$con}, 4, 0, q{});
+ if ( $con->[0] !~ / \d{2} : \d{2} /ox ) {
+ splice( @{$con}, 0, 0, q{} );
+ splice( @{$con}, 4, 0, q{} );
$con->[7] = q{};
}
- elsif ($con->[4] =~ / Plan: \s ab /ox) {
- push(@{$hash->{'extra'}}, splice(@{$con}, 4, 1));
+ elsif ( $con->[4] =~ / Plan: \s ab /ox ) {
+ push( @{ $hash->{extra} }, splice( @{$con}, 4, 1 ) );
}
- foreach my $extra (splice(@{$con}, 8, -1)) {
- push (@{$hash->{'extra'}}, $extra);
+ foreach my $extra ( splice( @{$con}, 8, -1 ) ) {
+ push( @{ $hash->{extra} }, $extra );
}
- $hash->{'dep_time'} = $con->[0];
+ $hash->{dep_time} = $con->[0];
+
# always "ab" $con->[1];
- $hash->{'dep_stop'} = $con->[2];
- $hash->{'train_line'} = $con->[3];
- $hash->{'arr_time'} = $con->[4];
+ $hash->{dep_stop} = $con->[2];
+ $hash->{train_line} = $con->[3];
+ $hash->{arr_time} = $con->[4];
+
# always "an" $con->[5];
- $hash->{'arr_stop'} = $con->[6];
- $hash->{'train_dest'} = $con->[7];
+ $hash->{arr_stop} = $con->[6];
+ $hash->{train_dest} = $con->[7];
+
+ push( @{$elements}, $hash );
+ }
+
+ 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 ) = @_;
+
+ $conf{autocheck} = 1;
+
+ $self->{ua} = LWP::UserAgent->new(%conf);
- push(@{$elements}, $hash);
+ my $response = $self->{ua}
+ ->post( 'http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2', $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} = $response->decoded_content( charset => 'latin-1' );
+
+ return;
+}
+
+sub parse {
+ my ($self) = @_;
+
+ my $tree = XML::LibXML->load_html( string => $self->{html_reply}, );
+
+ my $raw_cons = parse_initial($tree);
+
+ for my $raw_con ( @{$raw_cons} ) {
+ push( @{ $self->{connections} }, parse_pretty($raw_con) );
+ }
+ $self->{tree} = $tree;
+
+ $self->check_ambiguous();
+ $self->check_no_connections();
+
+ if ( @{$raw_cons} == 0 ) {
+ confess('Got no data to parse');
+ }
+
+ return 1;
+}
+
+sub check_ambiguous {
+ my ($self) = @_;
+ my $tree = $self->{tree};
+
+ my $xp_select = XML::LibXML::XPathExpression->new('//select');
+ my $xp_option = XML::LibXML::XPathExpression->new('./option');
+
+ foreach my $select ( @{ $tree->findnodes($xp_select) } ) {
+
+ my $post_key = $select->getAttribute('name');
+ my @possible;
+
+ foreach my $val ( $select->findnodes($xp_option) ) {
+ push( @possible, $val->textContent() );
+ }
+ my $err_text = join( q{, }, @possible );
+
+ confess("Ambiguous input for '${post_key}': '${err_text}'");
}
- return($elements);
+
+ return;
}
+sub check_no_connections {
+ my ($self) = @_;
+ my $tree = $self->{tree};
+
+ my $xp_err_img = XML::LibXML::XPathExpression->new(
+ '//td/img[@src="images/ausrufezeichen.jpg"]');
+
+ my $err_node = $tree->findnodes($xp_err_img)->[0];
+
+ if ($err_node) {
+ my $text = $err_node->parentNode()->parentNode()->textContent();
+ confess("Got no connections: '${text}'");
+ }
+
+ return;
+}
+
+sub connections {
+ my ($self) = @_;
+
+ return @{ $self->{connections} };
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+WWW::Efa - inofficial interface to the efa.vrr.de German itinerary service
+
+=head1 SYNOPSIS
+
+ use WWW::Efa;
+
+ my $efa = WWW::Efa->new(
+ from => ['Essen', 'HBf'],
+ to => ['Duisburg', 'HBf'],
+ );
+
+ $efa->submit();
+ $efa->parse();
+
+ for my $con ($efa->connections()) {
+ for my $c (@{$con}) {
+ printf(
+ "%-5s ab %-30s %-20s %s\n%-5s an %-30s\n\n",,
+ @{$c}{'dep_time', 'dep_stop', 'train_line', 'train_dest'},
+ @{$c}{'arr_time', 'arr_stop'},
+ );
+ }
+ print "\n\n";
+ }
+
+=head1 VERSION
+
+version 1.3
+
+=head1 DESCRIPTION
+
+B<WWW::Efa> is a client for the efa.vrr.de web interface.
+You pass it the start/stop of your journey, maybe a time and a date and more
+details, and it returns the up-to-date scheduled connections between those two
+stops.
+
+It uses B<LWP::USerAgent> and B<XML::LibXML> for this.
+
=head1 METHODS
-=head2 new(%conf)
+=over
+
+=item $efa = WWW::Efa->new(I<%conf>)
Returns a new WWW::Efa object and sets up its POST data via %conf.
@@ -487,153 +592,17 @@ If true: Prefer connections allowing to take a bike along
=back
-When encountering invalid hash keys, a WWW::Efa::Error object is stored to be
-retrieved by $efa->error();
-
-=cut
-
-sub new {
- my ($obj, %conf) = @_;
- my $ref = {};
-
- $ref->{'config'} = \%conf;
-
- eval {
- $ref->{'post'} = create_post(\%conf);
- };
- if ($@ and ref($@) eq 'WWW::Efa::Error::Setup') {
- $ref->{'error'} = $@;
- }
-
- return bless($ref, $obj);
-}
-
-=head2 $efa->error()
-
-In case a WWW::Efa operation encountered an error, this returns a
-B<WWW::Efa::Error> object related to the exact error. Otherwise, returns
-undef.
-
-=cut
-
-sub error {
- my ($self) = @_;
-
- if ($self->{'error'}) {
- return $self->{'error'};
- }
- return;
-}
-
-=head2 $efa->submit(%opts)
+=item $efa->submit(I<%opts>)
Submit the query to B<http://efa.vrr.de>.
-B<%opts> is passed on to LWP::UserAgent->new(%opts).
+I<%opts> is passed on to LWP::UserAgent->new(%opts).
-=cut
-
-sub submit {
- my ($self, %conf) = @_;
-
- $conf{'autocheck'} = 1;
-
- $self->{'ua'} = LWP::UserAgent->new(%conf);
-
- my $response
- = $self->{'ua'}->post('http://efa.vrr.de/vrr/XSLT_TRIP_REQUEST2',
- $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'} = $response->decoded_content(
- charset => 'latin-1'
- );
-}
-
-=head2 $efa->parse()
+=item $efa->parse()
Parse the B<efa.vrr.de> reply.
-returns a true value on success. Upon failure, returns undef and sets
-$efa->error() to a WWW::Efa::Error object.
-
-=cut
-
-sub parse {
- my ($self) = @_;
- my $err;
-
- my $tree = XML::LibXML->load_html(
- string => $self->{'html_reply'},
- );
-
- my $raw_cons = parse_initial($tree);
-
- if (@{$raw_cons} == 0) {
- $self->{'error'} = WWW::Efa::Error::NoData->new();
- }
-
- for my $raw_con (@{$raw_cons}) {
- push(@{$self->{'connections'}}, parse_pretty($raw_con));
- }
- $self->{'tree'} = $tree;
-
- if ($err = $self->check_ambiguous()) {
- $self->{'error'} = $err;
- }
- elsif ($err = $self->check_no_connections()) {
- $self->{'error'} = $err;
- }
-
- if ($self->{'error'}) {
- return;
- }
-
- return 1;
-}
-
-sub check_ambiguous {
- my ($self) = @_;
- my $tree = $self->{'tree'};
-
- my $xp_select = XML::LibXML::XPathExpression->new('//select');
- my $xp_option = XML::LibXML::XPathExpression->new('./option');
-
- foreach my $select (@{$tree->findnodes($xp_select)}) {
-
- my $post_key = $select->getAttribute('name');
- my @possible;
-
- foreach my $val ($select->findnodes($xp_option)) {
- push(@possible, $val->textContent());
- }
-
- return WWW::Efa::Error::Ambiguous->new(
- $post_key,
- @possible,
- );
- }
-}
-
-sub check_no_connections {
- my ($self) = @_;
- my $tree = $self->{'tree'};
-
- my $xp_err_img = XML::LibXML::XPathExpression->new(
- '//td/img[@src="images/ausrufezeichen.jpg"]');
-
- my $err_node = $tree->findnodes($xp_err_img)->[0];
-
- if ($err_node) {
- return WWW::Efa::Error::Backend->new(
- $err_node->parentNode()->parentNode()->textContent()
- );
- }
-}
+returns a true value on success.
-=head2 $efa->connections()
+=item $efa->connections()
Returns an array of connection elements. Each connection element is an
arrayref of connection part, and each connecton part is a hash containing the
@@ -663,12 +632,32 @@ Arrival stop, e.g. "Berlin HBf"
=back
-=cut
+=back
-sub connections {
- my ($self) = @_;
+=head1 DIAGNOSTICS
- return(@{$self->{'connections'}});
-}
+Dies with a backtrace when anything goes wrong.
-1;
+=head1 DEPENDENCIES
+
+=over
+
+=item * LWP::UserAgent(3pm)
+
+=item * XML::LibXML(3pm)
+
+=back
+
+=head1 BUGS AND LIMITATIONS
+
+The parser is still somewhat fragile and has no proper error handling.
+
+It is best not to pass Unicode characters to B<WWW::Efa>.
+
+=head1 AUTHOR
+
+Copyright (C) 2009-2011 by Daniel Friesel E<lt>derf@finalrewind.orgE<gt>
+
+=head1 LICENSE
+
+ 0. You just DO WHAT THE FUCK YOU WANT TO.
diff --git a/lib/WWW/Efa/Error/Ambiguous.pm b/lib/WWW/Efa/Error/Ambiguous.pm
deleted file mode 100644
index e738a63..0000000
--- a/lib/WWW/Efa/Error/Ambiguous.pm
+++ /dev/null
@@ -1,69 +0,0 @@
-package WWW::Efa::Error::Ambiguous;
-
-=head1 NAME
-
-WWW::Efa::Error::Ambiguous - WWW::Efa error, ambiguous to/from/via input
-
-=head1 SYNOPSIS
-
- use WWW::Efa::Error::Ambiguous;
-
- my $error = WWW::Efa::Error::Ambiguous->new(
- 'name_origin', 'Bredeney', 'Bredeney Friedhof'
- );
-
- die $error->as_string();
- # WWW::Efa error: ambiguous input for name_origin:
- # Bredeney
- # Bredeney Friedhof
-
-=head1 DESCRIPTION
-
-Class for all WWW::Efa-internal errors occuring during initialization. Usually
-caused by missing or invalid setup arguments.
-
-=cut
-
-use strict;
-use warnings;
-use 5.010;
-
-use base 'Exporter';
-
-our @EXPORT_OK = qw{};
-our @ISA = ('WWW::Efa::Error');
-
-sub new {
- my ($obj, $key, @possible) = @_;
- my $ref = {};
-
- $ref->{'key'} = $key;
- $ref->{'possible'} = \@possible;
-
- return bless($ref, $obj);
-}
-
-=head1 METHODS
-
-=head2 $error->as_string()
-
-Return the error as string, can directly be displayed to the user
-
-=cut
-
-sub as_string {
- my ($self) = @_;
-
- my $ret = sprintf(
- "WWW::Efa error: ambiguous input for %s:\n",
- $self->{'key'},
- );
-
- foreach my $value (@{$self->{'possible'}}) {
- $ret .= "\t$value\n";
- }
-
- return $ret;
-}
-
-1;
diff --git a/lib/WWW/Efa/Error/Backend.pm b/lib/WWW/Efa/Error/Backend.pm
deleted file mode 100644
index 930fed5..0000000
--- a/lib/WWW/Efa/Error/Backend.pm
+++ /dev/null
@@ -1,60 +0,0 @@
-package WWW::Efa::Error::Backend;
-
-=head1 NAME
-
-WWW::Efa::Error::Backend - WWW::Efa unknown error from efa.vrr.de
-
-=head1 SYNOPSIS
-
- use WWW::Efa::Error::Backend;
-
- my $error = WWW::Efa::Error::Backend->new(
- 'Yadda Yadda'
- );
-
- die $error->as_string();
- # WWW::Efa error from efa.vrr.de:
- # Yadda Yadda
-
-=head1 DESCRIPTION
-
-Received an unknown error from efa.vrr.de
-
-=cut
-
-use strict;
-use warnings;
-use 5.010;
-
-use base 'Exporter';
-
-our @EXPORT_OK = qw{};
-our @ISA = ('WWW::Efa::Error');
-
-sub new {
- my ($obj, $msg) = @_;
- my $ref = {};
-
- $ref->{'message'} = $msg;
-
- return bless($ref, $obj);
-}
-
-=head1 METHODS
-
-=head2 $error->as_string()
-
-Return the error as string, can directly be displayed to the user
-
-=cut
-
-sub as_string {
- my ($self) = @_;
-
- return sprintf(
- "WWW::Efa error from efa.vrr.de:\n%s\n",
- $self->{'message'},
- );
-}
-
-1;
diff --git a/lib/WWW/Efa/Error/NoData.pm b/lib/WWW/Efa/Error/NoData.pm
deleted file mode 100644
index e74d220..0000000
--- a/lib/WWW/Efa/Error/NoData.pm
+++ /dev/null
@@ -1,50 +0,0 @@
-package WWW::Efa::Error::NoData;
-
-=head1 NAME
-
-WWW::Efa::Error::NoData - WWW::Efa error, efa.vrr.de returned no data
-
-=head1 SYNOPSIS
-
- use WWW::Efa::Error::Setup;
-
- my $error = WWW::Efa::Error::NoData->new();
-
- die $error->as_string();
- # WWW::Efa error: No data returned by efa.vrr.de
-
-=head1 DESCRIPTION
-
-efa.vrr.de returned no parsable data
-
-=cut
-
-use strict;
-use warnings;
-use 5.010;
-
-use base 'Exporter';
-
-our @EXPORT_OK = qw{};
-our @ISA = ('WWW::Efa::Error');
-
-sub new {
- my ($obj) = @_;
- my $ref = {};
-
- return bless($ref, $obj);
-}
-
-=head1 METHODS
-
-=head2 $error->as_string()
-
-Return the error as string, can directly be displayed to the user
-
-=cut
-
-sub as_string {
- return "WWW::Efa error: No data returned by efa.vrr.de\n";
-}
-
-1;
diff --git a/lib/WWW/Efa/Error/Setup.pm b/lib/WWW/Efa/Error/Setup.pm
deleted file mode 100644
index 9840687..0000000
--- a/lib/WWW/Efa/Error/Setup.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-package WWW::Efa::Error::Setup;
-
-=head1 NAME
-
-WWW::Efa::Error::Setup - WWW::Efa error, happened in ->new()
-
-=head1 SYNOPSIS
-
- use WWW::Efa::Error::Setup;
-
- my $error = WWW::Efa::Error::Setup->new(
- 'max_interchanges', '-1', 'Must be positive'
- );
-
- die $error->as_string();
- # WWW::Efa setup error: Wrong arg for option max_interchanges: -1
- # Must be positive
-
-=head1 DESCRIPTION
-
-Class for all WWW::Efa-internal errors occuring during initialization. Usually
-caused by missing or invalid setup arguments.
-
-=cut
-
-use strict;
-use warnings;
-use 5.010;
-
-use base 'Exporter';
-
-our @EXPORT_OK = qw{};
-
-sub new {
- my ($obj, $key, $value, $msg) = @_;
- my $ref = {};
-
- $ref->{'key'} = $key;
- $ref->{'value'} = $value;
- $ref->{'message'} = $msg;
-
- return bless($ref, $obj);
-}
-
-=head1 METHODS
-
-=head2 $error->as_string()
-
-Return the error as string, can directly be displayed to the user
-
-=cut
-
-sub as_string {
- my ($self) = @_;
-
- return sprintf(
- "WWW::Efa setup error: Wrong arg for option %s: %s\n%s\n",
- @{$self}{'key', 'value', 'message'},
- );
-}
-
-=head2 $error->option()
-
-Returns the option which caused the error.
-
-=head2 $error->value()
-
-Returns the value which caused the error.
-
-=head2 $error->message()
-
-Returns a message describing what went wrong and how to fix it.
-
-=cut
-
-sub option { return $_[0]->{'key'} }
-sub value { return $_[0]->{'value'} }
-sub message { return $_[0]->{'message'} }
-
-1;
diff --git a/t/50-www-efa.t b/t/50-www-efa.t
index 8144026..29e4af5 100644
--- a/t/50-www-efa.t
+++ b/t/50-www-efa.t
@@ -3,7 +3,7 @@ use strict;
use warnings;
use 5.010;
-use Test::More tests => 131;
+use Test::More tests => 59;
BEGIN {
use_ok('WWW::Efa');
@@ -38,11 +38,6 @@ sub is_efa_post {
"$ck => $cv: conf ok",
);
- is(
- $efa->{'error'}, undef,
- "$ck => $cv: No error",
- );
-
foreach my $ref (@post) {
my ($key, $value) = @{$ref};
if (not defined $efa->{'post'}->{"key"} and
@@ -62,6 +57,7 @@ sub is_efa_post {
sub is_efa_err {
my ($key, $val, $str) = @_;
+ return; # FIXME error handling
my $efa = efa_new([$key, $val]);
my $val_want = $val;
@@ -75,29 +71,13 @@ sub is_efa_err {
"conf ok: $key => $val",
);
- isa_ok($efa->{'error'}, 'WWW::Efa::Error::Setup');
+ # FIXME actual error tests
- is(
- $efa->{'error'}->option(), $key,
- "$key => $val: Error: Correct key",
- );
- is(
- $efa->{'error'}->value(), $val_want,
- "$key => $val: Error: Correct valuef",
- );
- is(
- $efa->{'error'}->message(), $str,
- "$key => $val: Error: String is '$str'",
- );
}
is_efa_post('ignored', 'ignored');
-my $efa = new_ok('WWW::Efa' => []);
-isa_ok($efa->{'error'}, 'WWW::Efa::Error::Setup');
-is($efa->{'error'}->{'key'}, 'place');
-is($efa->{'error'}->{'value'}, 'origin');
-is($efa->{'error'}->{'message'}, 'Need at least two elements');
+my $efa;
is_efa_post(
'via', ['MH', 'HBf'],
diff --git a/t/60-bin-efa.t b/t/60-bin-efa.t
deleted file mode 100644
index 4e46766..0000000
--- a/t/60-bin-efa.t
+++ /dev/null
@@ -1,189 +0,0 @@
-#!/usr/bin/env perl
-use strict;
-use warnings;
-use 5.010;
-
-use Test::Command tests => 94;
-
-my $efa = 'bin/efa';
-my $testarg = "E HBf MH HBf";
-my $test_parse = "--test-parse $testarg";
-
-my $EMPTY = '';
-
-my $re_version = qr{\S*efa version \S+};
-
-sub mk_err {
- my ($arg, $value, $message) = @_;
- return sprintf(
- "WWW::Efa setup error: Wrong arg for option %s: %s\n%s\n",
- $arg, $value, $message
- );
-}
-
-# Usage on invalid invocation
-my $cmd = Test::Command->new(cmd => "$efa");
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_is_eq(
- mk_err('place', 'origin', 'Need at least two elements')
-);
-
-$cmd = Test::Command->new(cmd => "$efa E HBf MH");
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_is_eq(
- mk_err('place', 'origin', 'Need at least two elements')
-);
-
-$cmd = Test::Command->new(cmd => "$efa E HBf Du HBf MH");
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_is_eq(
- mk_err('place', 'origin', 'Need at least two elements')
-);
-
-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(
- mk_err('exclude', 'invalid', 'Must consist of zug s-bahn u-bahn stadtbahn tram stadtbus regionalbus schnellbus seilbahn schiff ast sonstige')
- );
-}
-
-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(
- mk_err('prefer', 'invalid', 'Must be either speed, nowait or nowalk')
- );
-}
-
-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(
- mk_err('include', 'invalid', 'Must be one of local/ic/ice')
- );
-}
-
-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(
- mk_err('walk_speed', 'invalid', 'Must be normal, fast or slow')
- );
-}
-
-for my $opt (qw/-t --time --depart/) {
- $cmd = Test::Command->new(cmd => "$efa $opt 35:12 $testarg");
-
- $cmd->exit_isnt_num(0);
- $cmd->stdout_is_eq($EMPTY);
- $cmd->stderr_is_eq(
- mk_err('depart', '35:12', 'Must match HH:MM')
- );
-}
-
-for my $opt (qw/-a --arrive/) {
- $cmd = Test::Command->new(cmd => "$efa $opt 35:12 $testarg");
-
- $cmd->exit_isnt_num(0);
- $cmd->stdout_is_eq($EMPTY);
- $cmd->stderr_is_eq(
- mk_err('arrive', '35:12', 'Must match HH:MM')
- );
-}
-
-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(
- mk_err('date', '11.23.2010', 'Invalid month')
- );
-}
-
-for my $opt (qw/-v --version/) {
- $cmd = Test::Command->new(cmd => "$efa $opt");
-
- $cmd->exit_is_num(0);
- $cmd->stdout_like($re_version);
- $cmd->stderr_is_eq($EMPTY);
-}
-
-
-for my $file (qw{
- e_hbf_mh_hbf
- e_hbf_du_hbf.ice
- e_werden_e_hbf
- e_hbf_b_hbf.ice
- e_martinstr_e_florastr
- })
-{
- $cmd = Test::Command->new(cmd => "$efa $test_parse < t/in/$file");
-
- $cmd->exit_is_num(0);
- $cmd->stdout_is_file("t/out/$file");
- $cmd->stderr_is_eq($EMPTY);
-}
-
-$cmd = Test::Command->new(
- cmd => "$efa $test_parse --ignore-info '.*' < t/in/e_hbf_b_hbf.ice"
-);
-
-$cmd->exit_is_num(0);
-$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->exit_is_num(0);
-$cmd->stdout_is_file("t/out/e_hbf_mh_hbf.ignore_none");
-$cmd->stderr_is_eq($EMPTY);
-
-$cmd = Test::Command->new(
- cmd => "$efa $test_parse < t/in/ambiguous"
-);
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_is_file('t/out/ambiguous');
-
-$cmd = Test::Command->new(
- cmd => "$efa $test_parse < t/in/no_connections"
-);
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_is_file('t/out/no_connections');
-
-$cmd = Test::Command->new(
- cmd => "$efa $test_parse < t/in/invalid_input"
-);
-
-$cmd->exit_isnt_num(0);
-$cmd->stdout_is_eq($EMPTY);
-$cmd->stderr_is_file('t/out/invalid_input');
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-01 03:31:53 +0000