File Coverage

blib/lib/Plack/Middleware/SimpleLogger.pm
Criterion Covered Total %
statement 35 38 92.1
branch 4 6 66.6
condition 1 2 50.0
subroutine 10 10 100.0
pod 1 3 33.3
total 51 59 86.4


line stmt bran cond sub pod time code
1             package Plack::Middleware::SimpleLogger;
2 1     1   59542 use strict;
  1         3  
  1         32  
3 1     1   6 use parent qw(Plack::Middleware);
  1         2  
  1         6  
4 1     1   40 use Config ();
  1         2  
  1         16  
5 1     1   5 use Plack::Util::Accessor qw(level);
  1         1  
  1         4  
6 1     1   483 use POSIX ();
  1         5676  
  1         27  
7 1     1   8 use Scalar::Util ();
  1         2  
  1         293  
8              
9             # Should this be in Plack::Util?
10             my $i = 0;
11             my %level_numbers = map { $_ => $i++ } qw(debug info warn error fatal);
12              
13             sub call {
14 1     1 1 6 my($self, $env) = @_;
15              
16 1   50     5 my $min = $level_numbers{ $self->level || "debug" };
17              
18 1         3 my $env_ref = $env;
19 1         4 Scalar::Util::weaken($env_ref);
20              
21             $env->{'psgix.logger'} = sub {
22 2     2   36 my $args = shift;
23              
24 2 100       8 if ($level_numbers{$args->{level}} >= $min) {
25 1         5 $env_ref->{'psgi.errors'}->print($self->format_message($args->{level}, $args->{message}));
26             }
27 1         6 };
28              
29 1         6 $self->app->($env);
30             }
31              
32             sub format_time {
33 1     1 0 4 my $old_locale;
34 1 50       10 if ( $Config::config{d_setlocale} ) {
35 0         0 $old_locale = POSIX::setlocale(&POSIX::LC_ALL);
36 0         0 POSIX::setlocale(&POSIX::LC_ALL, 'C');
37             }
38 1         35 my $out = POSIX::strftime(@_);
39 1 50       5 if ( $Config::config{d_setlocale} ) {
40 0         0 POSIX::setlocale(&POSIX::LC_ALL, $old_locale);
41             };
42 1         3 return $out;
43             }
44              
45             sub format_message {
46 1     1 0 3 my($self, $level, $message) = @_;
47              
48 1         40 my $time = format_time("%Y-%m-%dT%H:%M:%S", localtime);
49 1         21 sprintf "%s [%s #%d] %s: %s\n", uc substr($level, 0, 1), $time, $$, uc $level, $message;
50             }
51              
52             1;
53              
54             __END__