make the censor function customizable

cpanfile

@@ -3,6 +3,7 @@ requires 'Attribute::Handlers';
 requires 'Carp';
 requires 'Clone';
 requires 'Config::Any';
+requires 'Data::Censor' => '0.04';
 requires 'Digest::SHA';
 requires 'Encode';
 requires 'Exporter', '5.57';

lib/Dancer2/Core/Error.pm

@@ -8,7 +8,7 @@ use Dancer2::Core::HTTP;
 use Data::Dumper;
 use Dancer2::FileUtils qw/path open_file/;
 use Sub::Quote;
-use Module::Runtime 'require_module';
+use Module::Runtime qw/ require_module use_module /;
 use Ref::Util qw< is_hashref >;
 use Clone qw(clone);
 
@@ -48,6 +48,51 @@ has title => (
     builder => '_build_title',
 );
 
+has censor => (
+    is => 'ro',
+    isa => CodeRef,
+    lazy => 1, 
+    default => sub {
+        my $self = shift;
+
+        if( my $custom = $self->has_app && $self->app->setting('error_censor') ) {
+
+            if( is_hashref $custom ) {
+                die "only one key can be set for the 'error_censor' setting\n" 
+                    if 1 != keys %$custom;
+
+                my( $class, $args ) = %$custom;
+
+                my $censor = use_module($class)->new(%$args);
+
+                return sub {
+                    $censor->censor(@_);
+                }
+            }
+
+            my $coderef = eval '\&'.$custom;
+
+            # it's already defined? Nice! We're done
+            return $coderef if $coderef;
+
+            my $module = $custom =~ s/::[^:]*?$//r;
+
+            require_module($module);
+
+            return eval '\&'.$custom;
+        }
+
+         my $data_censor = use_module('Data::Censor')->new(
+             sensitive_fields => qr/pass|card?num|pan|secret/i,
+             replacement => "Hidden (looks potentially sensitive)",
+         );
+
+         return sub {
+             $data_censor->censor(@_);
+         };
+    }
+);
+
 sub _build_title {
     my ($self) = @_;
     my $title = 'Error ' . $self->status;
@@ -367,11 +412,11 @@ sub backtrace {
 }
 
 sub dumper {
-    my $obj = shift;
+    my ($self,$obj) = @_;
 
     # Take a copy of the data, so we can mask sensitive-looking stuff:
     my $data     = clone($obj);
-    my $censored = _censor( $data );
+    my $censored = $self->censor->( $data );
 
     #use Data::Dumper;
     my $dd = Data::Dumper->new( [ $data ] );
@@ -399,7 +444,7 @@ sub environment {
     my $env = $self->has_app && $self->app->has_request && $self->app->request->env;
 
     # Get a sanitised dump of the settings, session and environment
-    $_ = $_ ? dumper($_) : '<i>undefined</i>' for $settings, $session, $env;
+    $_ = $_ ? $self->dumper($_) : '<i>undefined</i>' for $settings, $session, $env;
 
     return <<"END_HTML";
 <div class="title">Stack</div><pre class="content">$stack</pre>
@@ -423,37 +468,6 @@ sub get_caller {
 
 # private
 
-# Given a hashref, censor anything that looks sensitive.  Returns number of
-# items which were "censored".
-
-sub _censor {
-    my $hash = shift;
-    my $visited = shift || {};
-
-    unless ( $hash && is_hashref($hash) ) {
-        carp "_censor given incorrect input: $hash";
-        return;
-    }
-
-    my $censored = 0;
-    for my $key ( keys %$hash ) {
-        if ( is_hashref( $hash->{$key} ) ) {
-            if (!$visited->{ $hash->{$key} }) {
-                # mark the new ref as visited
-                $visited->{ $hash->{$key} } = 1;
-
-                $censored += _censor( $hash->{$key}, $visited );
-            }
-        }
-        elsif ( $key =~ /(pass|card?num|pan|secret)/i ) {
-            $hash->{$key} = "Hidden (looks potentially sensitive)";
-            $censored++;
-        }
-    }
-
-    return $censored;
-}
-
 # Replaces the entities that are illegal in (X)HTML.
 sub _html_encode {
     my $value = shift;
@@ -523,6 +537,60 @@ This is only an attribute getter, you'll have to set it at C<new>.
 
 The message of the error page.
 
+=attr censor 
+
+The function to use to censor error messages. By default it uses the C<censor> method of L<Data::Censor> C<_censor>"
+
+         # default censor function used by `error_censor` 
+         # is equivalent to
+         sub MyApp::censor {
+             Data::Censor->new(
+                sensitive_fields => qr/pass|card?num|pan|secret/i,
+                replacement      => "Hidden (looks potentially sensitive)",
+            )->censor(@_);
+         }
+         setting error_censor => 'MyApp::censor';
+
+It can be configured via the app setting C<error_censor>. If provided, 
+C<error_censor> has to be the fully qualified name of the censor 
+function. That function is expected to take in the data as a hashref, 
+modify it in place and return the number of items 'censored'.
+
+For example, using L<Data::Censor>.
+
+    # in config.yml
+    error_censor: MyApp::Censor::censor
+
+    # in MyApp::Censor
+    package MyApp::Censor;
+
+    use Data::Censor;
+
+    my $data_censor = Data::Censor->new(
+        sensitive_fields => [ qw(card_number password hush) ],
+        replacement => '(Sensitive data hidden)',
+    );
+
+    sub censor { $data_censor->censor(@_) }
+
+    1;
+
+
+As a shortcut, C<error_censor> can also be the key/value combo of 
+a class and the arguments for its constructor. The created object 
+is expected to have a method C<censor>. For example, the use of 
+L<Data::Censor> above could also have been done via the config 
+
+    error_censor:
+        Data::Censor: 
+            sensitive_fields:
+                - card_number 
+                - password 
+                - hush 
+            replacement: '(Sensitive data hidden)'
+
+
+
 =method throw($response)
 
 Populates the content of the response with the error's information.

t/error.t

@@ -1,10 +1,14 @@
 use strict;
 use warnings;
+
+use lib 't/lib';
+
 use Test::More import => ['!pass'];
 use Plack::Test;
 use HTTP::Request::Common;
 use Ref::Util qw<is_coderef>;
 use List::Util qw<all>;
+use Module::Runtime qw/ require_module /;
 
 use Dancer2::Core::App;
 use Dancer2::Core::Response;
@@ -37,6 +41,7 @@ my $request = $app->build_request($env);
 
 $app->set_request($request);
 
+
 subtest 'basic defaults of Error object' => sub {
     my $err = Dancer2::Core::Error->new( app => $app );
     is $err->status,  500,                                 'code';
@@ -240,8 +245,56 @@ subtest 'Errors with show_stacktrace and circular references' => sub {
         'Values for other keys (non-sensitive) appear in the stacktrace');
 };
 
-done_testing;
+subtest censor => sub {
+    sub MyApp::Censor::censor { $_[0]->{hush} = 'NOT TELLING'; return 1; }
+
+    my $app = Dancer2::Core::App->new( name => 'main' );
+
+    $app->setting( password => 'potato' ); # oh my, we're leaking a password
+
+    subtest 'core censor()' => sub {
+        my $error = Dancer2::Core::Error->new( app => $app );
+
+        unlike $error->environment => qr/potato/, 'the password is censored';
+        like $error->environment => qr/^.*password.*Hidden.*$/m, 'we say it is hidden';
+    };
+
+    subtest 'custom censor' => sub {
+
+        subtest 'via function string' => sub {
+            my $app = Dancer2::Core::App->new( name => 'main' );
+            my $error = Dancer2::Core::Error->new( app => $app );
+
+            $app->setting( hush => 'potato' ); 
+
+            $app->setting( error_censor => 'MyApp::Censor::censor' );
 
+            unlike $error->environment => qr/potato/, 'the password is censored';
+            like $error->environment => qr/^ .* hush .* NOT \s TELLING .* $/xm, 'we say it is hidden';
+        };
+
+        subtest 'via class hashref' => sub {
+            my $app = Dancer2::Core::App->new( name => 'main' );
+            $app->setting( 'error_censor' => {
+                'Data::Censor' => {
+                    sensitive_fields => ['hush'],
+                    replacement => 'NOT TELLING',
+                }
+            });
+
+            my $error = Dancer2::Core::Error->new( app => $app );
+
+            $app->setting( hush => 'potato' ); 
+
+            unlike $error->environment => qr/potato/, 'the password is censored';
+            like $error->environment => qr/^ .* hush .* NOT \s TELLING .* $/xm, 'we say it is hidden';
+        };
+
+    }
+};
+
+
+done_testing;
 
 {   # Simple test exception class
     package MyTestException;

t/lib/CustomCensor.pm

@@ -0,0 +1,11 @@
+package CustomCensor;
+
+sub censor {
+    my $data = shift;
+
+    $data->{personal} = 'for my eyes only';
+
+    return 1;
+}
+
+1;