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         4  
2 1     1   5 use strict;
  1         2  
  1         18  
3 1     1   4 use warnings;
  1         2  
  1         53  
4              
5             package Log::Any::Adapter::File;
6              
7             # ABSTRACT: Simple adapter for logging to files
8             our $VERSION = '1.716';
9              
10 1     1   7 use Config;
  1         2  
  1         41  
11 1     1   6 use Fcntl qw/:flock/;
  1         10  
  1         136  
12 1     1   446 use IO::File;
  1         1000  
  1         119  
13 1     1   7 use Log::Any::Adapter::Util ();
  1         1  
  1         16  
14              
15 1     1   478 use Log::Any::Adapter::Base;
  1         2  
  1         371  
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 39 my ( $class, $file, @args ) = @_;
23 9         29 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         22 my $numeric_level = Log::Any::Adapter::Util::numeric_level( $self->{log_level} );
30 7 100       23 if ( !defined($numeric_level) ) {
31 1         5 require Carp;
32 1         276 Carp::carp( sprintf 'Invalid log level "%s". Defaulting to "%s"', $self->{log_level}, 'trace' );
33             }
34 7         69 $self->{log_level} = $numeric_level;
35             }
36 9 100       21 if ( !defined $self->{log_level} ) {
37 1         2 $self->{log_level} = $trace_level;
38             }
39 9         14 my $file = $self->{file};
40 9   100     26 my $binmode = $self->{binmode} || ':utf8';
41 9 100       25 $binmode = ":$binmode" unless substr($binmode,0,1) eq ':';
42 9 50       434 open( $self->{fh}, ">>$binmode", $file )
43             or die "cannot open '$file' for append: $!";
44 9         62 $self->{fh}->autoflush(1);
45             }
46              
47             foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
48 1     1   8 no strict 'refs';
  1         1  
  1         177  
49             my $method_level = Log::Any::Adapter::Util::numeric_level( $method );
50             *{$method} = sub {
51 3     3   7 my ( $self, $text ) = @_;
52 3 50       7 return if $method_level > $self->{log_level};
53 3         103 my $msg = sprintf( "[%s] %s\n", scalar(localtime), $text );
54 3 50       38 flock($self->{fh}, LOCK_EX) if $HAS_FLOCK;
55 3         21 $self->{fh}->print($msg);
56 3 50       188 flock($self->{fh}, LOCK_UN) if $HAS_FLOCK;
57             }
58             }
59              
60             foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
61 1     1   6 no strict 'refs';
  1         2  
  1         134  
62             my $base = substr($method,3);
63             my $method_level = Log::Any::Adapter::Util::numeric_level( $base );
64             *{$method} = sub {
65 10     10   57 return !!( $method_level <= $_[0]->{log_level} );
66             };
67             }
68              
69             1;
70              
71             __END__