package Plack::Middleware::Test::StashWarnings;

use strict;
use 5.008_001;
our $VERSION = '0.02';

use parent qw(Plack::Middleware);
use Carp ();
use Storable 'nfreeze';

sub call {
    my ($self, $env) = @_;

    if ($env->{PATH_INFO} eq '/__test_warnings') {
        Carp::carp("Use a single process server like Standalone to run Test::StashWarnings middleware")
            if $env->{'psgi.multiprocess'} && $self->{multiprocess_warn}++ == 0;

        return [ 200, ["Content-Type", "application/x-storable"], [ $self->dump_warnings ] ];
    }

    local $SIG{__WARN__} = sub {
        push @{ $self->{stashed_warnings} }, @_;
        warn @_ if $ENV{TEST_VERBOSE};
    };

    my $ret = $self->app->($env);

    # for the streaming API, we need to re-instate the dynamic sigwarn handler
    # around the streaming callback
    if (ref($ret) eq 'CODE') {
        my $original_ret = $ret;
        $ret = sub {
            local $SIG{__WARN__} = sub {
                push @{ $self->{stashed_warnings} }, @_;
                warn @_ if $ENV{TEST_VERBOSE};
            };
            $original_ret->(@_);
        };
    }

    return $ret;
}

sub dump_warnings {
    my $self = shift;

    return nfreeze([ splice @{ $self->{stashed_warnings} } ]);
}

sub DESTROY {
    my $self = shift;
    for (@{ $self->{stashed_warnings} }) {
        warn "Unhandled warning: $_";
    }
}

1;
__END__

=encoding utf-8

=for stopwords

=head1 NAME

Plack::Middleware::Test::StashWarnings - Test your application's warnings

=head1 SYNOPSIS

  enable "Test::StashWarnings";


  use Storable 'thaw';
  $mech->get('/__test_warnings');
  my @warnings = @{ thaw($mech->content) };
  like(@warnings[0], qr/No private key/);

=head1 DESCRIPTION

Plack::Middleware::Test::StashWarnings is a Plack middleware component to
record warnings generated by your application so that you can test them to make
sure your application complains about the right things.

=head1 AUTHOR

Shawn M Moore C<sartak@bestpractical.com>

Tatsuhiko Miyagawa wrote L<Plack::Middleware::Test::Recorder> which served as
a model for this module.

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=head1 SEE ALSO

L<Test::HTTP::Server::Simple::StashWarnings>

=cut
