File Coverage

blib/lib/Log/Any/Adapter/Multiplexor.pm
Criterion Covered Total %
statement 66 68 97.0
branch 4 6 66.6
condition 1 2 50.0
subroutine 14 14 100.0
pod 4 4 100.0
total 89 94 94.6


line stmt bran cond sub pod time code
1             package Log::Any::Adapter::Multiplexor;
2              
3 2     2   56434 use 5.008001;
  2         7  
4              
5 2     2   10 use strict;
  2         4  
  2         42  
6 2     2   9 use warnings;
  2         8  
  2         51  
7 2     2   465 use utf8;
  2         15  
  2         11  
8 2     2   800 use open qw(:std :utf8);
  2         1706  
  2         9  
9 2     2   251 use Carp 'croak';
  2         4  
  2         103  
10 2     2   779 use Log::Any::Adapter;
  2         8129  
  2         8  
11             #Default adapter
12             Log::Any::Adapter->set('Stdout');
13            
14             our $VERSION = '0.03';
15              
16             my %LOG_LEVELS = (
17             '0' => 'emergency',
18             '1' => 'alert',
19             '2' => 'critical',
20             '3' => 'error',
21             '4' => 'warning',
22             '5' => 'notice',
23             '6' => 'info',
24             '7' => 'debug',
25             '8' => 'trace',
26             );
27              
28             sub new {
29 1     1 1 736 my $class = shift;
30 1         2 my $log = shift;
31 1         5 my %opt = @_;
32 1         3 my $self = {};
33 1         4 $self->{log} = $log;
34 1         3 $self->{adapters} = {};
35 1         3 $self->{combine} = {};
36 1         3 bless $self, $class;
37              
38              
39 1         4 for my $key (keys %opt) {
40 2         5 my $adapter = shift @{$opt{$key}};
  2         7  
41 2         3 my @param = @{$opt{$key}};
  2         7  
42 2         9 $self->set_logger($key, $adapter, @param);
43              
44             }
45              
46             $log->{filter} = sub {
47 2     2   298 no strict 'refs';
  2         5  
  2         275  
48 5   50 5   1133 my $log_level_name = $LOG_LEVELS{$_[1]} || 'trace';
49 5         27 $self->{adapters}->{$log_level_name}->$log_level_name($_[2]);
50              
51 5         435 for my $log_level_combine (keys %{$self->{combine}}) {
  5         20  
52 2 100       74 $self->{adapters}->{$log_level_combine}->$log_level_combine($_[2]) if
53             $log_level_combine ne $log_level_name;
54             }
55 5         14 return;
56 1         7 };
57              
58 1         5 return $self;
59             }
60              
61              
62             sub set_logger {
63 2     2   12 no strict 'refs';
  2         4  
  2         435  
64 5     5 1 1839 my ($self, $log_level, $package, @param) = @_;
65 5         17 my $log = $self->{log};
66 5         22 $self->{adapters}->{$log_level} = $log->clone();
67 5         467 eval "require $package";
68 5 50       2891 if ($@) {
69 0         0 croak $@;
70             }
71 5         28 $self->{adapters}->{$log_level} = $package->new(@param);
72              
73 5         501 return 1;
74             }
75              
76             sub combine {
77 1     1 1 6 my $self = shift;
78 1         4 my @param = @_;
79 1         4 for my $log_level (@param) {
80 2         5 $log_level = lc($log_level);
81 2 50       6 if (not grep {$_ eq $log_level} values %LOG_LEVELS) {
  18         38  
82 0         0 croak "Wrong log level: $log_level";
83             }
84 2         6 $self->{combine}->{$log_level} = 1;
85             }
86 1         3 return 1;
87             }
88              
89             sub uncombine {
90 1     1 1 1139 my $self = shift;
91 1         3 $self->{combine} = {};
92 1         4 return 1;
93             }
94              
95             1;
96              
97             __END__