summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Friesel <derf@derf.homelinux.org>2010-08-06 19:24:03 +0200
committerDaniel Friesel <derf@derf.homelinux.org>2010-08-06 19:24:03 +0200
commitee38a4b7cdf0032e35e8249eb45d255480895119 (patch)
tree45e43f819a3eea555bd0fa5fa22cd2505500771e
parent308ec1bf336e39736916ba72053f16df0a9ba122 (diff)
Add Efa::Error class (probably sucks so far :p)
-rw-r--r--[-rwxr-xr-x]lib/WWW/Efa.pm75
-rw-r--r--lib/WWW/Efa/Error.pm60
-rwxr-xr-xt/00-compile-pm.t (renamed from t/00-compile.t)2
-rwxr-xr-xt/01-compile-pl.t8
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();