add warnings to queue results

metacpan · May 13, 2016 · 095a93c · 095a93c
1 parent d63af5b
commit 095a93c
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 4 deletions.
diff --git a/lib/MetaCPAN/Queue.pm b/lib/MetaCPAN/Queue.pm
@@ -32,17 +32,24 @@ sub startup {
         index_release => sub {
             my ( $job, @args ) = @_;
 
+            my @warnings;
+            local $SIG{__WARN__} = sub {
+                push @warnings, $_[0];
+                warn $_[0];
+            };
+
             # @args could be ( '--latest', '/path/to/release' );
             unshift @args, 'release';
 
             # Runner expects to have been called via CLI
             local @ARGV = @args;
             try {
                 my $release = MetaCPAN::Script::Runner->run(@args);
+                $job->finish( { warnings => \@warnings } );
             }
             catch {
                 warn $_;
-                $job->fail( { message => $_ } );
+                $job->fail( { message => $_, warnings => \@warnings } );
             };
         }
     );

diff --git a/lib/MetaCPAN/Script/Release.pm b/lib/MetaCPAN/Script/Release.pm
@@ -342,9 +342,10 @@ sub _build_perms {
     return \%authors;
 }
 
-$SIG{__WARN__} = sub {
-    my $msg = shift;
-    warn $msg unless $msg =~ m{Invalid header block at offset unknown at};
+my $warn = $SIG{__WARN__} || sub { warn $_[0] };
+local $SIG{__WARN__} = sub {
+    $warn->( $_[0] )
+        unless $_[0] =~ /Invalid header block at offset unknown at/;
 };
 
 __PACKAGE__->meta->make_immutable;