diff --git a/Build.PL b/Build.PL
index 9595eddf8d1ca4a8a219540009620b6b6557ea2c..5ff22bbe8bd68e86a93460200580a6ddc7240f75 100644
--- a/Build.PL
+++ b/Build.PL
@@ -15,8 +15,9 @@ Module::Build->new(
module_name => 'Travel::Routing::DE::VRR',
license => 'unrestricted',
requires => {
- 'Class::Accessor' => 0,
'perl' => '5.10.0',
+ 'Class::Accessor' => 0,
+ 'Exception::Class' => 0,
'Getopt::Long' => 0,
'XML::LibXML' => 0,
'WWW::Mechanize' => 0,
diff --git a/bin/efa b/bin/efa
index 82ba7e3a983a121ca67f9b342858446a83d03bee..b11018b593666ced7a79688a2a57e817225e9599 100755
--- a/bin/efa
+++ b/bin/efa
@@ -7,6 +7,7 @@ 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';
@@ -25,6 +26,71 @@ my $opt = {
binmode( STDOUT, ':encoding(utf-8)' );
binmode( STDERR, ':encoding(utf-8)' );
+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) =~ m{^Travel::Routing::DE::VRR::Exception}x )
+ {
+ 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,
@@ -80,25 +146,29 @@ if ( defined $opt->{'ignore-info'} and length( $opt->{'ignore-info'} ) == 0 ) {
$opt->{'ignore-info'} = undef;
}
-$efa = 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'},
-);
-
-$efa->submit( timeout => $opt->{'timeout'} );
+$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();
diff --git a/lib/Travel/Routing/DE/VRR.pm b/lib/Travel/Routing/DE/VRR.pm
index 695feaaf30a5dce0fb85004076be73b92cec5db0..73de3d105db38e5a04a5f5fef30a165ec230a0d5 100644
--- a/lib/Travel/Routing/DE/VRR.pm
+++ b/lib/Travel/Routing/DE/VRR.pm
@@ -4,11 +4,29 @@ use strict;
use warnings;
use 5.010;
-use Carp qw(confess);
use Travel::Routing::DE::VRR::Route;
use LWP::UserAgent;
use XML::LibXML;
+use Exception::Class (
+ 'Travel::Routing::DE::VRR::Exception::Setup' => {
+ description => 'invalid argument on setup',
+ fields => [ 'option', 'have', 'want' ],
+ },
+ 'Travel::Routing::DE::VRR::Exception::Net' => {
+ description => 'could not submit POST request',
+ fields => 'http_response',
+ },
+ 'Travel::Routing::DE::VRR::Exception::NoData' =>
+ { description => 'got no data to parse', },
+ 'Travel::Routing::DE::VRR::Exception::Ambiguous' => {
+ description => 'ambiguous input',
+ fields => [ 'post_key', 'possibilities' ],
+ },
+ 'Travel::Routing::DE::VRR::Exception::NoConnections' =>
+ { description => 'got no connections', },
+);
+
our $VERSION = '1.3';
sub set_time {
@@ -25,11 +43,18 @@ sub set_time {
$time = $conf{arrival_time};
}
else {
- confess('time: Specify either departure_time or arrival_time');
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'time',
+ error => 'Specify either departure_time or arrival_time'
+ );
}
if ( $time !~ / ^ [0-2]? \d : [0-5]? \d $ /x ) {
- confess("time: must match HH:MM - '${time}'");
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'time',
+ have => $time,
+ want => 'HH:MM',
+ );
}
@{ $self->{post} }{ 'itdTimeHour', 'itdTimeMinute' } = split( /:/, $time );
@@ -54,12 +79,22 @@ sub date {
my ( $day, $month, $year ) = split( /[.]/, $date );
- 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 )
+ if (
+ not( defined $day
+ and length($day)
+ and $day >= 1
+ and $day <= 31
+ and defined $month
+ and length($month)
+ and $month >= 1
+ and $month <= 12 )
+ )
{
- confess("date: invalid month, must match DD.MM[.[YYYY]] - '${date}'");
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'date',
+ have => $date,
+ want => 'DD.MM[.[YYYY]]'
+ );
}
if ( not defined $year or not length($year) ) {
@@ -89,7 +124,11 @@ sub exclude {
}
}
if ( not $ok ) {
- confess("exclude: Unsupported type '${exclude_type}'");
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'exclude',
+ have => $exclude_type,
+ want => join( ' / ', @mapping ),
+ );
}
}
@@ -112,8 +151,10 @@ sub select_interchange_by {
when ('waittime') { $self->{post}->{routeType} = 'LEASTINTERCHANGE' }
when ('distance') { $self->{post}->{routeType} = 'LEASTWALKING' }
default {
- confess(
-"select_interchange_by: Must be speed/waittime/distance: '${prefer}'"
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'select_interchange_by',
+ have => $prefer,
+ want => 'speed / waittime / distance',
);
}
}
@@ -129,7 +170,11 @@ sub train_type {
when ('ic') { $self->{post}->{lineRestriction} = 401 }
when ('ice') { $self->{post}->{lineRestriction} = 400 }
default {
- confess("train_type: Must be local/ic/ice: '${include}'");
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'train_type',
+ have => $include,
+ want => 'local / ic / ice',
+ );
}
}
@@ -151,7 +196,11 @@ sub walk_speed {
$self->{post}->{changeSpeed} = $walk_speed;
}
else {
- confess("walk_speed: Must be normal/fast/slow: '${walk_speed}'");
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'walk_speed',
+ have => $walk_speed,
+ want => 'normal / fast / slow',
+ );
}
return;
@@ -169,7 +218,10 @@ sub place {
my ( $self, $which, $place, $stop, $type ) = @_;
if ( not( $place and $stop ) ) {
- confess('place: Need >= three elements');
+ Travel::Routing::DE::VRR::Exception::Setup->throw(
+ option => 'place',
+ error => 'Need >= three elements'
+ );
}
$type //= 'stop';
@@ -435,22 +487,24 @@ sub new {
$ref->create_post();
+ if ( not( defined $conf{submit} and $conf{submit} == 0 ) ) {
+ $ref->submit( %{ $conf{lwp_options} } );
+ }
+
return $ref;
}
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} );
if ( $response->is_error ) {
- my $errstr = $response->status_line;
- confess("Could not submit POST request: ${errstr}");
+ Travel::Routing::DE::VRR::Exception::Net->throw(
+ http_response => $response, );
}
# XXX (workaround)
@@ -478,7 +532,7 @@ sub parse {
$self->check_no_connections();
if ( @{$raw_cons} == 0 ) {
- confess('Got no data to parse');
+ Travel::Routing::DE::VRR::Exception::NoData->throw();
}
return 1;
@@ -501,7 +555,10 @@ sub check_ambiguous {
}
my $err_text = join( q{, }, @possible );
- confess("Ambiguous input for '${post_key}': '${err_text}'");
+ Travel::Routing::DE::VRR::Exception::Ambiguous->throw(
+ post_key => $post_key,
+ possibilities => $err_text,
+ );
}
return;
@@ -518,7 +575,8 @@ sub check_no_connections {
if ($err_node) {
my $text = $err_node->parentNode()->parentNode()->textContent();
- confess("Got no connections: '${text}'");
+ Travel::Routing::DE::VRR::Exception::NoConnections->throw(
+ error => $text, );
}
return;
diff --git a/t/20-vrr.t b/t/20-vrr.t
index c97b3766ff36823d81da5e01eb16845ee598d9bb..a53d71aeb643849b85fed673e761bc224de52146 100644
--- a/t/20-vrr.t
+++ b/t/20-vrr.t
@@ -14,6 +14,8 @@ sub efa_conf {
my $ret = {
origin => ['Essen', 'HBf'],
destination => ['Koeln', 'HBf'],
+ lwp_options => {},
+ submit => 0,
};
foreach my $p (@_) {
$ret->{$p->[0]} = $p->[1];