File Coverage

blib/lib/Log/Any/Adapter/Multiplexor.pm

Criterion	Covered	Total	%
statement	18	20	90.0
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	25	27	92.5

package Log::Any::Adapter::Multiplexor;

use 5.008001;

use strict;
use warnings;
use utf8;
use open qw(:std :utf8);
use Carp 'croak';
use Log::Any::Adapter;
#Default adapter
Log::Any::Adapter->set('Stdout');

our $VERSION    = '0.02';

my %LOG_LEVELS = (
                    '0'     => 'emergency',
                    '1'     => 'alert',
                    '2'     => 'critical',
                    '3'     => 'error',
                    '4'     => 'warning',
                    '5'     => 'notice',
                    '6'     => 'info',
                    '7'     => 'debug',
                    '8'     => 'trace',
                );

sub new {
    my $class = shift;
    my $log = shift;
    my %opt = @_;
    my $self = {};
    $self->{log} = $log;
    $self->{adapters} = {};
    $self->{combine} = {};
    bless $self, $class;


    for my $key (keys %opt) {
        my $adapter = shift @{$opt{$key}};
        my @param = @{$opt{$key}};
        $self->set_logger($key, $adapter, @param);

    }

    $log->{filter} = sub {
                                no strict 'refs';
                                my $log_level_name = $LOG_LEVELS{$_[1]} || 'trace';
                                $self->{adapters}->{$log_level_name}->$log_level_name($_[2]);

                                for my $log_level_combine (keys %{$self->{combine}}) {
                                    $self->{adapters}->{$log_level_combine}->$log_level_combine($_[2]) if
                                            $log_level_combine ne $log_level_name;
                                }
                                return;
    };

    return $self;
}


sub set_logger {
    no strict 'refs';
    my ($self, $log_level, $package, @param) = @_;
    my $log = $self->{log};
    $self->{adapters}->{$log_level} = $log->clone();
    eval "require $package";
    if ($@) {
        croak $@;
    }
    $self->{adapters}->{$log_level} = $package->new(@param);

    return 1;
}

sub combine {
    my $self = shift;
    my @param = @_;
    for my $log_level (@param) {
        $log_level = lc($log_level);
        if (not grep {$_ eq $log_level} values %LOG_LEVELS) {
            croak "Wrong log level: $log_level";
        }
        $self->{combine}->{$log_level} = 1;
    }
    return 1;
}

sub uncombine {
    my $self = shift;
    $self->{combine} = {};
    return 1;
}

1;

__END__