File Coverage

blib/lib/Dancer/Logger/File/PerRequest.pm
Criterion Covered Total %
statement 51 91 56.0
branch 4 36 11.1
condition 1 23 4.3
subroutine 16 18 88.8
pod 1 2 50.0
total 73 170 42.9


line stmt bran cond sub pod time code
1             package Dancer::Logger::File::PerRequest;
2              
3 1     1   204657 use strict;
  1         2  
  1         36  
4 1     1   4 use warnings;
  1         1  
  1         28  
5 1     1   24 use 5.008_005;
  1         5  
  1         46  
6             our $VERSION = '0.02';
7              
8 1     1   4 use Carp;
  1         1  
  1         51  
9 1     1   4 use base 'Dancer::Logger::Abstract';
  1         1  
  1         72  
10 1     1   4 use Dancer::FileUtils qw(open_file);
  1         1  
  1         35  
11 1     1   4 use Dancer::Config 'setting';
  1         1  
  1         33  
12 1     1   4 use Dancer::Hook;
  1         1  
  1         16  
13 1     1   4 use Dancer::Factory::Hook;
  1         0  
  1         23  
14 1     1   4 use Dancer::SharedData;
  1         1  
  1         14  
15 1     1   3 use IO::File;
  1         1  
  1         106  
16 1     1   4 use Fcntl qw(:flock SEEK_END);
  1         1  
  1         99  
17 1     1   8 use Scalar::Util ();
  1         1  
  1         568  
18              
19             Dancer::Factory::Hook->instance->install_hooks(
20             qw/before_file_per_request_close after_file_per_request_close/
21             );
22              
23             sub init {
24 1     1 1 23 my $self = shift;
25 1         5 $self->SUPER::init(@_);
26              
27 1         3 my $logdir = logdir();
28 1 50       2 return unless ($logdir);
29 1 50       19 mkdir($logdir) unless -d $logdir;
30              
31             my $logfile_callback = setting('logfile_callback') || sub {
32             ## timestamp + pid + request->id
33 0     0   0 my @d = localtime();
34 0         0 my $file = sprintf('%04d%02d%02d%02d%02d%02d', $d[5] + 1900, $d[4] + 1, $d[3], $d[2], $d[1], $d[0]);
35 0 0       0 my $request_id = Dancer::SharedData->request ? Dancer::SharedData->request->id : '';
36 0         0 return $file . '-' . $$ . '-' . $request_id . '.log';
37 1   50     2 };
38 1         11 $self->{logfile_callback} = $logfile_callback;
39              
40             # per request
41 1         4 Scalar::Util::weaken $self;
42             Dancer::Hook->new('after' => sub {
43 1 50   1   2655 return unless $self->{fh};
44              
45 0         0 Dancer::Factory::Hook->execute_hooks('before_file_per_request_close', $self->{fh}, $self->{logfile});
46 0         0 close($self->{fh}); # close
47 0         0 undef $self->{fh};
48 0         0 Dancer::Factory::Hook->execute_hooks('after_file_per_request_close', $self->{logfile}, Dancer::SharedData->response);
49 0         0 undef $self->{logfile};
50 1         8 });
51             }
52              
53             sub _log {
54 0     0   0 my ($self, $level, $message) = @_;
55              
56 0         0 my $fh = $self->{fh};
57 0 0       0 unless ($fh) {
58 0         0 my $logfile = $self->{logfile_callback}->();
59 0 0       0 my $logdir = logdir() or return;
60 0         0 $logfile = File::Spec->catfile($logdir, $logfile);
61              
62 0 0       0 unless($fh = open_file('>>', $logfile)) {
63 0         0 carp "unable to create or append to $logfile";
64 0         0 return;
65             }
66              
67             # looks like older perls don't auto-convert to IO::File
68             # and can't autoflush
69             # see https://github.com/PerlDancer/Dancer/issues/954
70 0         0 eval { $fh->autoflush };
  0         0  
71              
72 0         0 $self->{fh} = $fh;
73 0         0 $self->{logfile} = $logfile;
74             }
75              
76 0 0 0     0 return unless(ref $fh && $fh->opened);
77              
78 0 0       0 flock($fh, LOCK_EX)
79             or carp "locking logfile $self->{logfile} failed";
80 0 0       0 seek($fh, 0, SEEK_END)
81             or carp "seeking to logfile $self->{logfile} end failed";
82 0 0       0 $fh->print($self->format_message($level => $message))
83             or carp "writing to logfile $self->{logfile} failed";
84 0 0       0 flock($fh, LOCK_UN)
85             or carp "unlocking logfile $self->{logfile} failed";
86             }
87              
88             # Copied from Dancer::Logger::File
89             sub logdir {
90 1 50   1 0 3 if ( my $altpath = setting('log_path') ) {
91 1         8 return $altpath;
92             }
93              
94 0           my $logroot = setting('appdir');
95              
96 0 0 0       if ( $logroot and ! -d $logroot and ! mkdir $logroot ) {
      0        
97 0           carp "app directory '$logroot' doesn't exist, am unable to create it";
98 0           return;
99             }
100              
101 0 0         my $expected_path = $logroot ?
102             Dancer::FileUtils::path($logroot, 'logs') :
103             Dancer::FileUtils::path('logs');
104              
105 0 0 0       return $expected_path if -d $expected_path && -x _ && -w _;
      0        
106              
107 0 0 0       unless (-w $logroot and -x _) {
108 0           my $perm = (stat $logroot)[2] & 07777;
109 0           chmod($perm | 0700, $logroot);
110 0 0 0       unless (-w $logroot and -x _) {
111 0           carp "app directory '$logroot' isn't writable/executable and can't chmod it";
112 0           return;
113             }
114             }
115 0           return $expected_path;
116             }
117              
118             1;
119             __END__