File Coverage

blib/lib/App/ReslirpTunnel/Logger.pm
Criterion Covered Total %
statement 15 54 27.7
branch 0 8 0.0
condition 0 10 0.0
subroutine 5 10 50.0
pod n/a
total 20 82 24.3


line stmt bran cond sub pod time code
1             package App::ReslirpTunnel::Logger;
2              
3 1     1   375 use strict;
  1         2  
  1         39  
4 1     1   13 use warnings;
  1         2  
  1         49  
5 1     1   4 use Path::Tiny;
  1         1  
  1         42  
6 1     1   29218 use Log::Any;
  1         20600  
  1         6  
7 1     1   93 use Carp qw(croak confess);
  1         3  
  1         894  
8              
9             sub _init_logger {
10 0     0     my ($self, %args) = @_;
11             # warn "initializing logger for $self\n";
12 0           eval {
13 0   0       $self->{log_level} = my $level = $args{log_level} // 'warn';
14 0 0         if ($args{log_to_stderr}) {
15 0           $self->{log_to_stderr} = 1;
16 0           $self->{log} = Log::Any->get_logger(default_adapter => ['Stderr', log_level => $level]);
17             }
18             else {
19 0           $self->{log_to_stderr} = 0;
20 0   0       my $fn = $self->{log_file} = $args{log_file} // "/tmp/reslirp-tunnel.log";
21 0           Path::Tiny->new($fn)->parent->mkdir;
22 0           $self->{log} = Log::Any->get_logger(default_adapter => ['File', "$fn", log_level => $level]);
23 0 0         if (defined $args{log_uid}) {
24 0           chown $args{log_uid}, -1, $fn;
25             }
26             # warn "Sending log to $fn\n";
27             }
28 0   0       $self->{log_prefix} = $args{log_prefix} // 'ReslirpTunnel';
29             };
30 0 0         if ($@) {
31 0           warn "Can't initialize logger for $self, (uid: $<, euid: $>): $@\n";
32 0           die $@;
33             }
34             # warn "logger initialized for $self: $self->{log}, level: $args{log_level}\n";
35             }
36              
37             sub _log {
38 0     0     my ($self, $level, @msg) = @_;
39 0           local ($?, $@, $!);
40 0   0       my $prefix = $self->{log_prefix} // 'ReslirpTunnel';
41 0           my $msg = "$prefix> ".join(': ', grep defined, @msg);
42 0           eval {
43 0           $self->{log}->$level($msg);
44             };
45 0 0         if ($@) {
46 0   0       my $slots = join ', ', map { $_." => ".($self->{$_}//'') } keys %$self;
  0            
47 0           confess "$msg -- Can't log properly, $@\n$self: $slots\n";
48             }
49 0           return;
50             }
51              
52 0     0     sub _log_join { shift; join(': ', grep defined, @_) }
  0            
53              
54             sub _warn {
55 0     0     my ($self, @msg) = @_;
56 0           local ($?, $@, $!);
57 0           my $msg = $self->_log_join(@msg);
58 0           $self->_log(warn => @msg);
59 0           warn "$msg\n";
60             }
61              
62             sub _die {
63 0     0     my ($self, @msg) = @_;
64 0           local ($?, $@, $!);
65 0           my $msg = $self->_log_join(@msg);
66 0           $self->_log(fatal => $msg);
67 0           die "$msg\n";
68             }
69              
70             1;