File Coverage

blib/lib/Plack/Middleware/LogStderr.pm
Criterion Covered Total %
statement 68 75 90.6
branch 22 26 84.6
condition 17 19 89.4
subroutine 17 20 85.0
pod 2 2 100.0
total 126 142 88.7


line stmt bran cond sub pod time code
1 1     1   74349 use strict;
  1         2  
  1         22  
2 1     1   3 use warnings;
  1         3  
  1         34  
3             package Plack::Middleware::LogStderr;
4             $Plack::Middleware::LogStderr::VERSION = '1.000';
5             # ABSTRACT: Everything printed to STDERR sent to psgix.logger or other logger
6             # KEYWORDS: plack middleware errors logging environment I/O handle stderr
7              
8 1     1   4 use parent 'Plack::Middleware';
  1         2  
  1         4  
9              
10 1     1   9605 use Plack::Util::Accessor qw/logger callback tie_callback capture_callback no_tie log_level log_level_capture/;
  1         2  
  1         3  
11 1     1   55 use Scalar::Util ();
  1         2  
  1         11  
12 1     1   432 use Capture::Tiny 'capture_stderr';
  1         13813  
  1         656  
13              
14             sub prepare_app {
15 19     19 1 33085 my $self = shift;
16 19   100     43 $self->{log_level} = $self->log_level || 'error';
17 19   66     180 $self->{log_level_capture} = $self->log_level_capture || $self->{log_level} ;
18            
19 19         114 foreach my $cb (qw/logger callback tie_callback capture_callback/){
20 58 100       167 if ($self->$cb) {
21 22 100       81 if (not __isa_coderef($self->$cb)) {
22 12         391 die "'$cb' is not a coderef!"
23             }
24             }
25             }
26             }
27              
28             sub call {
29 7     7 1 21580 my ($self, $env) = @_;
30 7   100     19 my $logger = $self->logger || $env->{'psgix.logger'};
31              
32 7 100       81 die 'no psgix.logger in $env; cannot send STDERR to it!'
33             if not $logger;
34            
35             my $stderr_logger = sub {
36 12     12   53 my $message = shift;
37 12         62 $message = $self->__run_tie_callback($message);
38 12         105 $logger->({level => $self->{log_level}, message => $message });
39 6         23 };
40            
41             my ($stderr, @app) = capture_stderr {
42 6     6   3530 my ($app, $err);
43              
44 6 100       15 tie *STDERR, 'Plack::Middleware::LogStderr::Handle2Logger', $stderr_logger
45             unless $self->no_tie ;
46              
47 6         20 eval {
48 6         16 $app = $self->app->($env);
49             };
50 6 50       15104 $err = $@ if $@;
51              
52 6 100       57 untie *STDERR
53             unless $self->no_tie ;
54            
55 6 50       94 if ($err) {
56 0         0 die $@;
57             }
58 6         27 return $app;
59 6         121 };
60 6 50       2381 if ($stderr) {
61 6         26 $stderr = $self->__run_capture_callback($stderr) ;
62 6         45 $logger->({level => $self->{log_level_capture}, message => $stderr });
63             }
64            
65 6         221 return $app[0];
66             }
67              
68             sub __run_callback {
69 18     18   59 my ($self, $msg, $extra_cb) = @_;
70 18 100       69 $msg = $self->callback->($msg) if $self->callback;
71 18 50       171 if ($extra_cb) {
72 18 100 100     82 if ($extra_cb eq 'tie' && $self->tie_callback) {
73 6         28 $msg = $self->tie_callback->($msg) ;
74             }
75 18 100 100     135 if ($extra_cb eq 'capture' && $self->capture_callback) {
76 3         33 $msg = $self->capture_callback->($msg) ;
77             }
78             }
79 18         68 return $msg;
80             }
81             sub __run_capture_callback {
82 6     6   17 my ($self, $msg) = @_;
83 6         22 $msg = $self->__run_callback($msg, 'capture');
84 6         9 return $msg;
85            
86             }
87             sub __run_tie_callback {
88 12     12   47 my ($self, $msg) = @_;
89 12         48 $msg = $self->__run_callback($msg, 'tie');
90 12         17 return $msg;
91             }
92              
93             sub __isa_coderef {
94 22 100 100 22   153 ref $_[0] eq 'CODE'
      66        
95             or (Scalar::Util::reftype($_[0]) || '') eq 'CODE'
96             or overload::Method($_[0], '&{}')
97             }
98              
99             package # hide from PAUSE
100             Plack::Middleware::LogStderr::Handle2Logger;
101             our $VERSION = '1.000';
102             # ABSTRACT: Tie File Handle to a logger
103              
104             sub TIEHANDLE {
105 4     4   64 my ($pkg, $logger) = @_;
106 4         18 return bless {logger => $logger}, $pkg;
107             }
108             sub PRINT {
109 8     8   229 my ($self, @msg) = @_;
110 8         18 my $message = join('', @msg);
111 8         17 $self->{logger}->( $message );
112             }
113             sub PRINTF {
114 4     4   15021 my ($self, $fmt, @msg) = @_;
115 4         32 my $message = sprintf($fmt, @msg);
116 4         50 $self->{logger}->($message);
117             }
118             ## if something tries to reopen FILEHANDLE just return true -- noop
119             sub OPEN {
120 0     0     my ($self) = @_;
121 0           return 1;
122             }
123             ## if something tries to set BINMODE -- noop
124             sub BINMODE {
125 0     0     my ($self) = @_;
126 0           return undef;
127             }
128              
129             sub FILENO {
130 0     0     my ($self) = @_;
131 0           return undef;
132             }
133              
134              
135             1;
136              
137             __END__