Try Exception::Class

4 files changed, 172 insertions, 41 deletions

diff --git a/Build.PL b/Build.PL
index 9595edd..5ff22bb 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 82ba7e3..b11018b 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 695feaa..73de3d1 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 c97b376..a53d71a 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];