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__ |