Add Efa::Error class (probably sucks so far :p)

4 files changed, 118 insertions, 27 deletions

diff --git a/lib/WWW/Efa.pm b/lib/WWW/Efa.pm
index da0bb05..ecd3880 100755..100644
--- a/lib/WWW/Efa.pm
+++ b/lib/WWW/Efa.pm
@@ -4,10 +4,12 @@ use strict;
 use warnings;
 use 5.010;
 
-use Carp qw/croak confess/;
+use base 'Exporter';
+
 use XML::LibXML;
 use WWW::Mechanize;
 
+our @EXPORT_OK = ();
 my $VERSION = '1.3+git';
 
 sub post_time {
@@ -24,7 +26,9 @@ sub post_time {
 	}
 
 	if ($time !~ / ^ [0-2]? \d : [0-5]? \d $ /x) {
-		confess('conf: time invalid. Use HH:MM');
+		return WWW::Efa::Error->new(
+			'internal', 'conf', ['time', $time, 'Must match HH:MM']
+		);
 	}
 	@{$post}{'itdTimeHour', 'itdTimeMinute'} = split(/:/, $time);
 }
@@ -33,7 +37,9 @@ sub post_date {
 	my ($post, $date) = @_;
 
 	if ($date !~ /^ [0-3]? \d \. [01]? \d \. (?: \d{4} )? $/x) {
-		confess('conf: date invalid DD.MM.[YYYY]');
+		return WWW::Efa::Error->new(
+			'internal', 'conf', ['date', $date, 'Must match DD.MM.[YYYY]']
+		);
 	}
 	@{$post}{'itdDateDay', 'itdDateMonth', 'itdDateYear'} = split(/\./, $date);
 	$post->{'itdDateYear'} //= (localtime(time))[5] + 1900;
@@ -55,7 +61,14 @@ sub post_exclude {
 			}
 		}
 		if (not $ok) {
-			confess("conf: exclude: Invalid element $exclude_type");
+			return WWW::Efa::Error->new(
+				'internal', 'conf',
+				[
+					'exclude',
+					join(q{ }, @exclude),
+					'Must consist of ' . join(q{ }, @mapping)
+				]
+			);
 		}
 	}
 }
@@ -68,7 +81,10 @@ sub post_prefer {
 		when('nowait') { $post->{'routeType'} = 'LEASTINTERCHANGE' }
 		when('nowalk') { $post->{'routeType'} = 'LEASTWALKING' }
 		default {
-			confess("conf: prefer: Invalid argument $prefer");
+			return WWW::Efa::Error->new(
+				'internal', 'conf',
+				['prefer', $prefer, 'Must be either speed, nowait or nowalk']
+			);
 		}
 	}
 }
@@ -81,7 +97,10 @@ sub post_include {
 		when ('ic')    { $post->{'lineRestriction'} = 401 }
 		when ('ice')   { $post->{'lineRestriction'} = 400 }
 		default {
-			confess('conf: invalid include');
+			return WWW::Efa::Error->new(
+				'internal', 'conf',
+				['include', $include, 'Must be one of local/ic/ice']
+			);
 		}
 	}
 }
@@ -93,7 +112,10 @@ sub post_walk_speed {
 		$post->{'changeSpeed'} = $walk_speed;
 	}
 	else {
-		confess('conf: walk_speed invalid');
+		return WWW::Efa::Error->new(
+			'internal', 'conf',
+			['walk_speed', $walk_speed, 'Must be normal, fast or slow']
+		);
 	}
 }
 
@@ -101,7 +123,10 @@ sub post_place {
 	my ($post, $which, $place, $stop, $type) = @_;
 
 	if (not ($place and $stop)) {
-		confess("conf: ${which}: Need at least two elements");
+		return WWW::Efa::Error->new(
+			'internal', 'conf',
+			['place', "'$place' '$stop'", "Need at least two elements for ${which}"]
+		);
 	}
 
 	$type //= 'stop';
@@ -204,7 +229,9 @@ sub parse_initial {
 		return $cons;
 	}
 	else {
-		confess('efa.vrr.de returned no connections, check your input data');
+		return WWW::Efa::Error->new(
+			'efa.vrr.de', 'no data'
+		);
 	}
 }
 
@@ -318,25 +345,23 @@ sub parse {
 
 sub check_ambiguous {
 	my ($self) = @_;
-	my $ambiguous = 0;
 	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)}) {
-		$ambiguous = 1;
-		printf {*STDERR} (
-			"Ambiguous input for %s\n",
-			$select->getAttribute('name'),
-		);
+
+		my @possible = ($select->getAttribute('name'));
+
 		foreach my $val ($select->findnodes($xp_option)) {
-			print {*STDERR} "\t";
-			say {*STDERR} $val->textContent();
+			push(@possible, $val->textContent());
 		}
-	}
-	if ($ambiguous) {
-		exit 1;
+
+		return WWW::Efa::Error->new(
+			'efa.vrr.de', 'ambiguous',
+			\@possible
+		);
 	}
 }
 
@@ -350,12 +375,10 @@ sub check_no_connections {
 	my $err_node = $tree->findnodes($xp_err_img)->[0];
 
 	if ($err_node) {
-		say {*STDERR} 'Looks like efa.vrr.de showed an error.';
-		say {*STDERR} 'I will now try to dump the error message:';
-
-		say {*STDERR} $err_node->parentNode()->parentNode()->textContent();
-
-		exit 2;
+		return WWW::Efa::Error->new(
+			'efa.vrr.de', 'error',
+			$err_node->parentNode()->parentNode()->textContent()
+		);
 	}
 }
 
diff --git a/lib/WWW/Efa/Error.pm b/lib/WWW/Efa/Error.pm
new file mode 100644
index 0000000..1f390bf
--- /dev/null
+++ b/lib/WWW/Efa/Error.pm
@@ -0,0 +1,60 @@
+package WWW::Efa::Error;
+
+use strict;
+use warnings;
+use 5.010;
+
+use base 'Exporter';
+
+our @EXPORT_OK = qw{};
+
+# source: internal / efa.vrr.de
+# type: internal: conf
+#     efa.vrr.de: ambiguous / error / no data
+sub new {
+	my ($obj, $source, $type, $data) = @_;
+	my $ref = {};
+
+	$ref->{'source'} = $source;
+	$ref->{'type'}   = $type;
+	$ref->{'data'}   = $data;
+
+	return bless($ref, $obj);
+}
+
+sub as_string {
+	my ($self) = @_;
+	my $ret;
+
+	if ($self->{'source'} eq 'internal') {
+		$ret = sprintf(
+			"WWW::Efa config error: Wrong args for option %s. %s\n",
+			@{$self->{'data'}}
+		);
+	}
+	elsif ($self->{'source'} eq 'efa.vrr.de') {
+		given ($self->{'type'}) {
+			when ('no data') {
+				$ret = "WWW::Efa: efa.vrr.de returned no data\n";
+			}
+			when ('ambiguous') {
+				$ret = sprintf(
+					"WWW::Efa: efa.vrr.de: Ambiguous input for %s:\n",
+					shift(@{$self->{'data'}}),
+				);
+				foreach my $possible (@{$self->{'data'}}) {
+					$ret .= "\t${possible}\n";
+				}
+			}
+			when ('error') {
+				$ret = sprintf(
+					"WWW::Efa: efa.vrr.de error:\n%s\n",
+					$self->{'data'},
+				);
+			}
+		}
+	}
+	return $ret;
+}
+
+1;
diff --git a/t/00-compile.t b/t/00-compile-pm.t
index 10c1984..2476ab2 100755
--- a/t/00-compile.t
+++ b/t/00-compile-pm.t
@@ -5,4 +5,4 @@ use 5.010;
 use Test::More;
 use Test::Compile;
 
-all_pl_files_ok('bin/efa');
+all_pm_files_ok();
diff --git a/t/01-compile-pl.t b/t/01-compile-pl.t
new file mode 100755
index 0000000..f130ac4
--- /dev/null
+++ b/t/01-compile-pl.t
@@ -0,0 +1,8 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use 5.010;
+use Test::More;
+use Test::Compile;
+
+all_pl_files_ok();