File Coverage

blib/lib/App/Manoc/Logger.pm
Criterion Covered Total %
statement 42 54 77.7
branch 9 20 45.0
condition 2 5 40.0
subroutine 8 10 80.0
pod 3 3 100.0
total 64 92 69.5


line stmt bran cond sub pod time code
1             package App::Manoc::Logger;
2             ##ABSTRACT: A tiny wrapper around Log4perl
3              
4 1     1   13439 use strict;
  1         2  
  1         23  
5 1     1   5 use warnings;
  1         1  
  1         34  
6              
7             our $VERSION = '2.99.2'; ##TRIAL VERSION
8              
9 1     1   5 use Carp;
  1         1  
  1         55  
10              
11 1     1   391 use FindBin;
  1         780  
  1         37  
12 1     1   627 use Log::Log4perl;
  1         35509  
  1         5  
13 1     1   46 use Log::Log4perl::Level;
  1         2  
  1         4  
14              
15              
16 0     0 1 0 sub initialized { Log::Log4perl->initialized(); }
17              
18              
19             sub logger {
20 0     0 1 0 my $self = shift;
21 0         0 Log::Log4perl->get_logger(@_);
22             }
23              
24             sub _init_screen_logger {
25 1     1   3 my ($category) = @_;
26 1         3 my $logger = Log::Log4perl->get_logger($category);
27              
28 1         17 my $appender =
29             Log::Log4perl::Appender->new( "Log::Log4perl::Appender::Screen", name => 'screenlog' );
30              
31 1         707 my $layout = Log::Log4perl::Layout::PatternLayout->new("[%d] %p %m%n");
32 1         596 $appender->layout($layout);
33 1         9 $logger->add_appender($appender);
34 1         450 $logger->level($DEBUG);
35             }
36              
37              
38             sub init {
39 1     1 1 41 my $self = shift;
40 1 50       4 my %args = ( scalar(@_) == 1 ) ? %{ $_[0] } : @_;
  0         0  
41 1   50     7 my $class = $args{class} || '';
42              
43 1 50       4 return if Log::Log4perl->initialized();
44              
45 1 50       8 if ( $ENV{MANOC_SUPPRESS_LOG} ) {
46 0         0 Log::Log4perl->easy_init($OFF);
47 0         0 return;
48             }
49              
50 1 50       3 if ( $args{debug} ) {
51 0         0 _init_screen_logger('');
52 0         0 return;
53             }
54              
55 1         3 my $config_file = $ENV{MANOC_LOGCONFIG};
56 1 50 33     11 unless ( defined($config_file) && -f $config_file ) {
57              
58 1         2 my @config_paths;
59             exists $ENV{MANOC_CONFIG} and
60 1 50       4 push @config_paths, $ENV{MANOC_CONFIG};
61 1         13 push @config_paths, File::Spec->catdir( $FindBin::Bin, File::Spec->updir() );
62 1 50       18 -d '/etc' and push @config_paths, '/etc';
63              
64 1         2 foreach my $p (@config_paths) {
65 2         14 my $file = File::Spec->catfile( $p, 'manoc_log.conf' );
66 2 50       71 -f $file or next;
67 0         0 $config_file = $file;
68 0         0 last;
69             }
70             }
71              
72 1 50       4 if ( defined($config_file) ) {
73 0 0       0 -f $config_file or croak "Cannot open config file $config_file";
74 0         0 Log::Log4perl->init($config_file);
75             }
76             else {
77 1         2 _init_screen_logger('');
78             }
79             }
80              
81             1;
82              
83             # Local Variables:
84             # mode: cperl
85             # indent-tabs-mode: nil
86             # cperl-indent-level: 4
87             # cperl-indent-parens-as-block: t
88             # End:
89              
90             __END__
91              
92             =pod
93              
94             =head1 NAME
95              
96             App::Manoc::Logger - A tiny wrapper around Log4perl
97              
98             =head1 VERSION
99              
100             version 2.99.2
101              
102             =head1 METHODS
103              
104             =head2 logger
105              
106             Return a Log4Perl logger.
107              
108             =head2 init
109              
110             Initialize Manoc loggers.
111              
112             =head1 FUNCTIONS
113              
114             =head2 initialized
115              
116             Return true if the logger has been initialized.
117              
118             =head1 AUTHORS
119              
120             =over 4
121              
122             =item *
123              
124             Gabriele Mambrini <gmambro@cpan.org>
125              
126             =item *
127              
128             Enrico Liguori
129              
130             =back
131              
132             =head1 COPYRIGHT AND LICENSE
133              
134             This software is copyright (c) 2017 by Gabriele Mambrini.
135              
136             This is free software; you can redistribute it and/or modify it under
137             the same terms as the Perl 5 programming language system itself.
138              
139             =cut