File Coverage

blib/lib/MarpaX/Languages/ECMAScript/AST/Impl/Logger.pm
Criterion Covered Total %
statement 22 36 61.1
branch 3 10 30.0
condition 1 13 7.6
subroutine 8 11 72.7
pod n/a
total 34 70 48.5


line stmt bran cond sub pod time code
1 1     1   6 use strict;
  1         3  
  1         44  
2 1     1   6 use warnings FATAL => 'all';
  1         2  
  1         61  
3              
4             package MarpaX::Languages::ECMAScript::AST::Impl::Logger;
5              
6             # ABSTRACT: Log::Any implementation on top of Marpa
7              
8 1     1   1343 use diagnostics;
  1         234159  
  1         11  
9 1     1   576 use MarpaX::Languages::ECMAScript::AST::Exceptions qw/:all/;
  1         2  
  1         205  
10 1     1   1010 use Log::Any;
  1         2036  
  1         4  
11              
12             our $VERSION = '0.018'; # VERSION
13              
14             sub BEGIN {
15             #
16             ## Some Log implementation specificities
17             #
18 1   50 1   128 my $log4perl = eval 'use Log::Log4perl; 1;' || 0; ## no critic
  1     1   320  
  0         0  
  0         0  
19 1 50       316 if ($log4perl) {
20             #
21             ## Here we put know hooks for logger implementations
22             #
23 0         0 Log::Log4perl->wrapper_register(__PACKAGE__);
24             }
25             }
26              
27             sub TIEHANDLE {
28 1     1   3 my($class, %options) = @_;
29              
30 1 50 0     11 my $self = {
    50 0        
31             level => exists($options{level}) ? ($options{level} || 'trace') : 'trace',
32             category => exists($options{category}) ? ($options{category} || '') : '',
33             };
34              
35 1         10 $self->{logger} = Log::Any->get_logger(category => $self->{category});
36              
37 1         1131 bless $self, $class;
38             }
39              
40             sub PRINT {
41 0     0     my $self = shift;
42 0   0       my $logger = $self->{logger} || '';
43 0   0       my $level = $self->{level} || '';
44 0 0 0       if ($logger && $level) {
45 0           $logger->trace(@_);
46             }
47 0           return 1;
48             }
49              
50             sub PRINTF {
51 0     0     my $self = shift;
52 0           return $self->PRINT(sprintf(@_));
53             }
54              
55             sub UNTIE {
56 0     0     my ($obj, $count) = @_;
57 0 0         if ($count) {
58 0           InternalError(error => "untie attempted while $count inner references still exist");
59             }
60             }
61              
62              
63             1;
64              
65             __END__