Fix warning handling from spinning thread

Teach App::DocKnot::Command to rewrite warnings as well as errors
to add the invoked command, and rely on that for warnings from
App::DocKnot::Spin::Thread.

2 files changed, 33 insertions, 10 deletions

diff --git a/lib/App/DocKnot/Command.pm b/lib/App/DocKnot/Command.pm
index e138ce2..8ce78d3 100644
--- a/lib/App/DocKnot/Command.pm
+++ b/lib/App/DocKnot/Command.pm
@@ -166,6 +166,29 @@ sub _parse_command {
 }
 
 ##############################################################################
+# Error handling
+##############################################################################
+
+# Reformat an error message (from warn or die) to prepend the command run and
+# to strip the file and line information from Perl.
+#
+# $command - Invoked command
+# $error   - Error to reformat
+#
+# Return: Reformatted error suitable for passing to warn or die, with no
+#         trailing newline (the caller should add it)
+sub _reformat_error {
+    my ($self, $command, $error) = @_;
+    chomp($error);
+    $error =~ s{ \s+ at \s+ \S+ \s+ line \s+ \d+ [.]? \z }{}xms;
+    if ($error =~ m{ \S+ : \d+ : \s+ \S }xms) {
+        return "$0 $command:$error";
+    } else {
+        return "$0 $command: $error";
+    }
+}
+
+##############################################################################
 # Public interface
 ##############################################################################
 
@@ -229,21 +252,21 @@ sub run {
         }
     }
 
-    # Dispatch the command and turn exceptions into error messages.
+    # Dispatch the command and turn exceptions into error messages.  Also
+    # capture warnings and perform the same transformation on those.
+    local $SIG{__WARN__} = sub {
+        my ($error) = @_;
+        $error = $self->_reformat_error($command, $error);
+        warn "$error\n";
+    };
     eval {
         my $object = $COMMANDS{$command}{module}->new($opts_ref);
         my $method = $COMMANDS{$command}{method};
         $object->$method($args_ref->@*);
     };
     if ($@) {
-        my $error = $@;
-        chomp($error);
-        $error =~ s{ \s+ at \s+ \S+ \s+ line \s+ \d+ [.]? \z }{}xms;
-        if ($error =~ m{ \S+ : \d+ : \s+ \S }xms) {
-            die "$0 $command:$error\n";
-        } else {
-            die "$0 $command: $error\n";
-        }
+        my $error = $self->_reformat_error($command, $@);
+        die "$error\n";
     }
     return;
 }
diff --git a/lib/App/DocKnot/Spin/Thread.pm b/lib/App/DocKnot/Spin/Thread.pm
index 4b2e361..7080886 100644
--- a/lib/App/DocKnot/Spin/Thread.pm
+++ b/lib/App/DocKnot/Spin/Thread.pm
@@ -181,7 +181,7 @@ sub _fatal {
 sub _warning {
     my ($self, $problem) = @_;
     my (undef, $file, $lineno) = $self->{input}[-1]->@*;
-    warn "$0 spin:$file:$lineno: $problem\n";
+    warn "$file:$lineno: $problem\n";
     return;
 }