Add Catmandu::Fix::oops

lib/Catmandu/CLI.pm

@@ -91,7 +91,7 @@ sub setup_debugging {
     catch {
         print STDERR <<EOF;
 
-Oops! Debugging tools not available on this platform
+Debugging tools not available on this platform
 
 Try to install Log::Log4perl and Log::Any::Adapter::Log4perl
 
@@ -151,7 +151,7 @@ sub run {
     };
 
     if (defined $err) {
-        say STDERR "Oops! $err";
+        say STDERR $err;
         return;
     }
 

lib/Catmandu/Error.pm

@@ -322,6 +322,7 @@ Catmandu::Error - Catmandu error hierarchy
     ];
 
 =head1 CURRRENT ERROR HIERARCHY
+
     Throwable::Error
         Catmandu::Error
             Catmandu::BadVal

lib/Catmandu/Fix/oops.pm

@@ -0,0 +1,84 @@
+package Catmandu::Fix::oops;
+
+use Catmandu::Sane;
+
+our $VERSION = '1.08';
+
+use Moo;
+use Catmandu::Util qw(:is);
+use Catmandu::Fix::Has;
+
+has message     => (fix_arg => 1, required => 0);
+has error_field => (fix_opt => 1, default => 'errors');
+
+sub fix {
+    my ($self, $data) = @_;
+
+    my @messages = $self->{message};
+
+    my $errors = $data->{$self->error_field // 'errors'};
+    if ($errors) {
+        if (is_array_ref($errors)) {
+            push @messages, map { $self->_error_message($_) } @$errors;
+        } else {
+            push @messages, $self->_error_message($errors);
+        }
+    }
+
+    my $msg = join "\n", grep { defined $_ } @messages;
+	$msg = 'Oops!' if $msg eq '';
+
+    # errors cannot be thrown in compiled fixes
+    Catmandu::Error->throw($msg);
+}
+
+sub _error_message {
+    my ($self, $error) = @_;
+
+    if (is_hash_ref($error)) {
+        $error = $error->{message}
+    }
+
+    return $error // 'Oops!';
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Catmandu::Fix::oops - abort execution with error messages
+
+=head1 SYNOPSIS
+
+On the command line:
+
+   catmandu convert JSON --fix 'oops("I'm sorry, Dave")'
+   echo $?
+
+To abort validation with error messages in a Fix script:
+
+   validate('author', JSONSchema, schema: 'my/schema.json')
+   if exists(errors)
+      oops('validation failed:')
+   end
+
+=head1 DESCRIPTION
+
+This Fix function throws an error to terminate execution of Catmandu with
+nonzero exit code and print error message to STDERR. The error message can be
+passed as string and/or it is read from field C<errors>. This error field can
+be configured with option C<error_field> but path expressions are not
+supported. Individual error messages can be plain strings or objects with field
+C<message>.
+
+=head1 SEE ALSO
+
+L<Catmandu::Fix>
+
+L<Catmandu::Fix::validate>
+
+=cut

t/Catmandu-CLI.t

@@ -46,7 +46,7 @@ if ($^O ne 'MSWin32') {    # /dev/null required
         ]
     );
     ok !$res->error;
-    like $res->stderr, qr/Oops! Can't find the exporter 'NotFound'/;
+    like $res->stderr, qr/Can't find the exporter 'NotFound'/;
 }
 
 {
@@ -64,13 +64,13 @@ if ($^O ne 'MSWin32') {    # /dev/null required
 {
     my $result = test_app(
         qq|Catmandu::CLI| => [qw(convert Null to Null --fix testing123() )]);
-    like $result->stderr, qr/Oops/, 'wrong fix error';
+    like $result->stderr, qr/testing123/, 'wrong fix error';
 }
 
 {
     my $result = test_app(
         qq|Catmandu::CLI| => [qw(convert Null to Null --fix), "test("]);
-    like $result->stderr, qr/Oops/, 'syntax error';
+    like $result->stderr, qr/Syntax error/, 'syntax error';
 }
 
 {
@@ -82,7 +82,7 @@ if ($^O ne 'MSWin32') {    # /dev/null required
 {
     my $result = test_app(
         qq|Catmandu::CLI| => [qw(convert Null to Null --fix add_field())]);
-    like $result->stderr, qr/Oops/, 'wrong arguments';
+    like $result->stderr, qr/add_field/, 'wrong arguments';
 }
 
 {
@@ -131,7 +131,7 @@ EOF
 {
     my $result = test_app(qq|Catmandu::CLI| =>
             [qw(convert JSON --file http://google.com/nonononono to Null)]);
-    like $result->stderr, qr/Oops! Got a HTTP error/, 'Got an HTTP error';
+    like $result->stderr, qr/Got a HTTP error/, 'Got an HTTP error';
 }
 
 done_testing;

t/Catmandu-Fix-oops.t

@@ -0,0 +1,43 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+use App::Cmd::Tester;
+use Catmandu::CLI;
+
+my $pkg;
+
+BEGIN {
+    $pkg = 'Catmandu::Fix::oops';
+    use_ok $pkg;
+}
+
+sub test_oops {
+	my ($fix, $stderr, $msg) = @_;
+
+    my $result = test_app(
+        qq|Catmandu::CLI| => [qw(convert Null to Null --fix), $fix]);
+    like $result->stderr, $stderr, $msg // $fix;
+    $result;
+}
+
+ok !test_oops('oops()', qr/^Oops!/)->error, 'exit code';
+
+test_oops('oops("WTF!")', qr/^WTF!/);
+
+test_oops('oops("WTF!")', qr/^WTF!/);
+
+test_oops('set_field(errors,42) oops()', qr/^42/, 'scalar errors');
+
+test_oops('add_field(errors.message,42) oops()', qr/^42/, 'error object');
+
+test_oops('add_field(errors.$append.message,42) oops()', qr/^42/, 'error objects');
+
+test_oops('add_field(errors,42) oops("Sorry")', qr/^Sorry\n42/, 'prepend message');
+
+test_oops('add_field(errors.$append,7) add_field(errors.$append,3) oops()',
+	qr/^7\n3/, 'multiple errors');
+
+done_testing;