This file is indexed.

/usr/share/perl5/Plack/Middleware/Test/StashWarnings.pm is in libplack-middleware-test-stashwarnings-perl 0.08-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
package Plack::Middleware::Test::StashWarnings;

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

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

sub new {
    my $proto = shift;
    my $class = ref $proto || $proto;
    my $self = $class->SUPER::new(@_);
    $self->{verbose} = $ENV{TEST_VERBOSE} unless defined $self->{verbose};
    return $self;
}

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 $self->{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 ARGUMENTS

Plack::Middleware::Test::StashWarnings takes one optional argument,
C<verbose>, which defaults to C<$ENV{TEST_VERBOSE}>.  If set to true, it
will bubble warnings up to any pre-existing C<__WARN__> handler.
Turning this explicitly off may be useful if your tests load
L<Test::NoWarnings> and also use L<Test::WWW::Mechanize::PSGI> for
non-forking testing -- failure to do so would result in test failures
even for caught warnings.

=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