File Coverage

blib/lib/Dancer/Logger/Hourlyfile.pm
Criterion Covered Total %
statement 27 67 40.3
branch 0 16 0.0
condition 0 11 0.0
subroutine 9 12 75.0
pod 1 1 100.0
total 37 107 34.5


line stmt bran cond sub pod time code
1             package Dancer::Logger::Hourlyfile;
2              
3 1     1   21645 use strict;
  1         2  
  1         39  
4 1     1   6 use warnings;
  1         2  
  1         36  
5              
6 1     1   6 use Carp;
  1         6  
  1         142  
7 1     1   6 use base 'Dancer::Logger::Abstract';
  1         2  
  1         1025  
8 1     1   312809 use Dancer::FileUtils qw(open_file);
  1         3  
  1         57  
9 1     1   7 use Dancer::Config 'setting';
  1         1  
  1         36  
10 1     1   6 use IO::File;
  1         1  
  1         136  
11 1     1   6 use File::Path qw(make_path);
  1         2  
  1         51  
12 1     1   6 use POSIX qw/strftime/;
  1         2  
  1         6  
13              
14             our $VERSION = '0.06';
15              
16             sub init {
17 0     0 1   my $self = shift;
18 0           $self->SUPER::init(@_);
19              
20             # Grab Settings
21 0           $self->{log_path} = setting('log_path') . '/';
22 0   0       $self->{log_fname} = setting('log_file') . '.log' || setting('environment') . '.log';
23 0           $self->{log_file} = $self->{log_fname};
24 0   0       $self->{log_hourly} = setting('log_hourly') || "filename";
25              
26 0           my $log_time = setting('log_time');
27 0 0         if ( $log_time eq 'gmtime' ) {
28 0           $self->{log_time} = 'gmtime';
29             } else {
30 0           $self->{log_time} = 'localtime';
31             }
32              
33             }
34              
35              
36             sub _log {
37 0     0     my ( $self, $level, $message ) = @_;
38              
39             # Check or set fh
40 0           $self->_setfh;
41              
42 0           my $fh = $self->{fh};
43              
44 0 0         $fh->print( $self->format_message( $level => $message ) )
45             or carp "writing logs to file $self->{logfile} failed: $!";
46             }
47              
48              
49             sub _setfh {
50 0     0     my $self = shift;
51            
52 0           my $test_fh = $self->{fh};
53 0           my $current_time = undef;
54 0           my $path_time = undef;
55 0           my $file_time = undef;
56              
57              
58 0 0         if ( $self->{log_time} eq 'gmt' ) {
59 0           $current_time = POSIX::strftime( "%Y-%m-%d-%H", gmtime ) ;
60 0           $path_time = POSIX::strftime( "%Y/%m/%d/", gmtime ) ;
61 0           $file_time = POSIX::strftime( "%Y%m%d%H_", gmtime ) ;
62             } else {
63 0           $current_time = POSIX::strftime( "%Y-%m-%d-%H", localtime ) ;
64 0           $path_time = POSIX::strftime( "%Y/%m/%d/", localtime ) ;
65 0           $file_time = POSIX::strftime( "%Y%m%d%H_", localtime ) ;
66             }
67              
68             # Return if fh is good
69 0 0 0       if ( ref $test_fh && $test_fh->opened ) { # fh exists and is open
70 0           return ;
71             }
72              
73             # Date hasn't changed
74 0 0 0       if ( exists $self->{log_current} && $self->{log_current} eq $current_time ) {
75 0           return ;
76             }
77              
78             # if here, then fh is no good. Clean it up
79 0 0         close($test_fh) if ( ref $test_fh );;
80              
81 0           $self->{log_current} = $current_time; # reset tracking of time change
82 0           $self->{log_file} = $self->{log_path} ;
83              
84             # YYYY/MM/DD to path if extended
85 0 0         if ( $self->{log_hourly} eq 'extended' ) {
86 0           $self->{log_path} .= $path_time ;
87             }
88              
89             # Make sure path exists
90 0           make_path( $self->{log_path} );
91              
92             # finish building filename
93 0           $self->{log_file} = $self->{log_path} . $file_time . $self->{log_fname};
94              
95             # get a new fh
96 0 0         open( my $fh, '>>', $self->{log_file} )
97             || croak "Unable to open $self->{log_file}: $!";
98              
99 0           $fh->autoflush(1);
100              
101             # store fh for later use
102 0           $self->{fh} = $fh;
103              
104             }
105              
106             1;
107             __END__