File Coverage

blib/lib/Log/Any/Adapter/File.pm
Criterion Covered Total %
statement 52 52 100.0
branch 12 16 75.0
condition 4 5 80.0
subroutine 14 14 100.0
pod 0 2 0.0
total 82 89 92.1


line stmt bran cond sub pod time code
1 1     1   17 use 5.008001;
  1         3  
2 1     1   5 use strict;
  1         3  
  1         20  
3 1     1   5 use warnings;
  1         1  
  1         54  
4              
5             package Log::Any::Adapter::File;
6              
7             # ABSTRACT: Simple adapter for logging to files
8             our $VERSION = '1.715';
9              
10 1     1   6 use Config;
  1         3  
  1         38  
11 1     1   5 use Fcntl qw/:flock/;
  1         10  
  1         151  
12 1     1   448 use IO::File;
  1         1014  
  1         119  
13 1     1   7 use Log::Any::Adapter::Util ();
  1         2  
  1         16  
14              
15 1     1   435 use Log::Any::Adapter::Base;
  1         2  
  1         431  
16             our @ISA = qw/Log::Any::Adapter::Base/;
17              
18             my $HAS_FLOCK = $Config{d_flock} || $Config{d_fcntl_can_lock} || $Config{d_lockf};
19              
20             my $trace_level = Log::Any::Adapter::Util::numeric_level('trace');
21             sub new {
22 9     9 0 26 my ( $class, $file, @args ) = @_;
23 9         31 return $class->SUPER::new( file => $file, log_level => $trace_level, @args );
24             }
25              
26             sub init {
27 9     9 0 14 my $self = shift;
28 9 100 66     51 if ( exists $self->{log_level} && $self->{log_level} =~ /\D/ ) {
29 7         21 my $numeric_level = Log::Any::Adapter::Util::numeric_level( $self->{log_level} );
30 7 100       23 if ( !defined($numeric_level) ) {
31 1         9 require Carp;
32 1         292 Carp::carp( sprintf 'Invalid log level "%s". Defaulting to "%s"', $self->{log_level}, 'trace' );
33             }
34 7         73 $self->{log_level} = $numeric_level;
35             }
36 9 100       17 if ( !defined $self->{log_level} ) {
37 1         2 $self->{log_level} = $trace_level;
38             }
39 9         15 my $file = $self->{file};
40 9   100     25 my $binmode = $self->{binmode} || ':utf8';
41 9 100       23 $binmode = ":$binmode" unless substr($binmode,0,1) eq ':';
42 9 50       497 open( $self->{fh}, ">>$binmode", $file )
43             or die "cannot open '$file' for append: $!";
44 9         70 $self->{fh}->autoflush(1);
45             }
46              
47             foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
48 1     1   7 no strict 'refs';
  1         2  
  1         211  
49             my $method_level = Log::Any::Adapter::Util::numeric_level( $method );
50             *{$method} = sub {
51 3     3   6 my ( $self, $text ) = @_;
52 3 50       7 return if $method_level > $self->{log_level};
53 3         121 my $msg = sprintf( "[%s] %s\n", scalar(localtime), $text );
54 3 50       36 flock($self->{fh}, LOCK_EX) if $HAS_FLOCK;
55 3         24 $self->{fh}->print($msg);
56 3 50       174 flock($self->{fh}, LOCK_UN) if $HAS_FLOCK;
57             }
58             }
59              
60             foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
61 1     1   7 no strict 'refs';
  1         1  
  1         135  
62             my $base = substr($method,3);
63             my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
64             *{$method} = sub {
65 10     10   56 return !!( $method_level <= $_[0]->{log_level} );
66             };
67             }
68              
69             1;
70              
71             __END__