add warnings to queue results

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

Hide file tree

Showing 2 changed files with 13 additions and 3 deletions.
diff --git a/lib/MetaCPAN/Queue.pm b/lib/MetaCPAN/Queue.pm
@@ -18,6 +18,7 @@ use Mojo::Base 'Mojolicious';
 use MetaCPAN::Queue::Helper  ();
 use MetaCPAN::Script::Runner ();
 use Try::Tiny qw( catch try );
+use Cpanel::JSON::XS qw( encode_json );
 
 sub startup {
     my $self = shift;
@@ -32,6 +33,12 @@ 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';
 
@@ -44,6 +51,8 @@ sub startup {
                 warn $_;
                 $job->fail( { message => $_ } );
             };
+
+            $job->finish( { warnings => encode_json( \@warnings ) } ) or die;
         }
     );
 }

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;