1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
package Plack::Middleware::Test::StashWarnings;
use strict;
use 5.008_001;
our $VERSION = '0.07';
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 ] ];
}
my $ret = $self->_stash_warnings_for($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') {
return sub { $self->_stash_warnings_for($ret, @_) };
}
return $ret;
}
sub _stash_warnings_for {
my $self = shift;
my $code = shift;
my $old_warn = $SIG{__WARN__} || sub { warn @_ };
local $SIG{__WARN__} = sub {
$self->add_warning(@_);
$old_warn->(@_) if $ENV{TEST_VERBOSE};
};
return $code->(@_);
}
sub add_warning {
my $self = shift;
push @{ $self->{stashed_warnings} }, @_;
}
sub dump_warnings {
my $self = shift;
return nfreeze([ splice @{ $self->{stashed_warnings} } ]);
}
sub DESTROY {
my $self = shift;
for (splice @{ $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
# for your PSGI application:
enable "Test::StashWarnings";
# for your Test::WWW::Mechanize subclass:
use Storable 'thaw';
sub get_warnings {
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $self = shift;
my $clone = $self->clone;
return unless $clone->get_ok('/__test_warnings');
my @warnings = @{ thaw $clone->content };
return @warnings;
}
=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.
The warnings generated by your application are available at a special URL
(C</__test_warnings>), encoded with L<Storable/nfreeze>. So using
L<Test::WWW::Mechanize> you can just C<get> that URL and L<Storable/thaw> its
content.
=head1 RATIONALE
Warnings are an important part of any application. Your web application should
warn its operators when something is amiss.
Almost as importantly, your web application should gracefully cope with bad
input, the back button, and all other aspects of the user experience.
Unfortunately, tests seldom cover what happens when things go poorly. Are you
I<sure> that your application correctly denies that action and logs the
failure? Are you I<sure> it will tomorrow?
This module lets you retrieve the warnings that your forked server issues. That
way you can test that your application continues to issue warnings when it
makes sense. Catching the warnings also keeps your test output tidy. Finally,
you'll be able to see (and be notified via failing tests) when your
application issues new, unexpected warnings so you can fix them immediately.
=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
|
