Use a better method of setting the internal error that automatically

adjusts for trailing newlines and exception detritus, saving duplicate
code.  Standardize the documentation of the error() method and document
using this in child classes of the generic ACL and Object classes.

Disable printing of errors during connect in Wallet::Server since we're
going to throw our own exception.

2 files changed, 22 insertions, 9 deletions

diff --git a/perl/Wallet/ACL/Base.pm b/perl/Wallet/ACL/Base.pm
index dfc6b60..a03086d 100644
--- a/perl/Wallet/ACL/Base.pm
+++ b/perl/Wallet/ACL/Base.pm
@@ -41,9 +41,15 @@ sub check {
     return 0;
 }
 
-# Return the error stashed in the object.
+# Set or return the error stashed in the object.
 sub error {
-    my ($self) = @_;
+    my ($self, @error) = @_;
+    if (@error) {
+        my $error = join ('', @error);
+        chomp $error;
+        1 while ($error =~ s/ at \S+ line \d+\.?\z//);
+        $self->{error} = $error;
+    }
     return $self->{error};
 }
 
@@ -87,11 +93,18 @@ and blesses an object.
 This method should always be overridden by child classes.  The default
 implementation just declines all access.
 
-=item error()
+=item error([ERROR ...])
+
+Returns the error of the last failing operation or undef if no operations
+have failed.  Callers should call this function to get the error message
+after an undef return from any other instance method.
 
-Returns whatever is stored in the error key of the object hash.  Child
-classes should store error messages in that key when returning undef from
-check().
+For the convenience of child classes, this method can also be called with
+one or more error strings.  If so, those strings are concatenated together,
+trailing newlines are removed, any text of the form S<C< at \S+ line
+\d+\.?>> at the end of the message is stripped off, and the result is stored
+as the error.  Only child classes should call this method with an error
+string.
 
 =back
 
diff --git a/perl/Wallet/ACL/Krb5.pm b/perl/Wallet/ACL/Krb5.pm
index ffe1fc5..eab0c28 100644
--- a/perl/Wallet/ACL/Krb5.pm
+++ b/perl/Wallet/ACL/Krb5.pm
@@ -34,11 +34,11 @@ $VERSION = '0.01';
 sub check {
     my ($self, $principal, $acl) = @_;
     unless ($principal) {
-        $self->{error} = 'no principal specified';
+        $self->error ('no principal specified');
         return undef;
     }
     unless ($acl) {
-        $self->{error} = 'malformed krb5 ACL';
+        $self->error ('malformed krb5 ACL');
         return undef;
     }
     return ($principal eq $acl) ? 1 : 0;
@@ -80,7 +80,7 @@ principal if and only if the principal exactly matches the ACL.
 
 =item new()
 
-Creates a new ACL verifier.  The database handle is not used.
+Creates a new ACL verifier.  For this verifier, there is no setup work.
 
 =item check(PRINCIPAL, ACL)