File Coverage

blib/lib/Log/Stack.pm

Criterion	Covered	Total	%
statement	66	67	98.5
branch	15	18	83.3
condition	4	8	50.0
subroutine	11	11	100.0
pod	5	6	83.3
total	101	110	91.8

use strictures 2;

package Log::Stack;

# ABSTRACT: Cache log messages and throw them later

use Moo;
use Carp qw(croak);
use Scalar::Util qw(blessed);

our $VERSION = '0.001'; # VERSION


has _stack => (
    is => 'lazy',
    default => sub { [] },
    clearer => 1,
);

has _target => (
    is => 'ro',
);

has _defaults => (
    is => 'ro',
    default => sub { {} },
);

has _hooks => (
    is => 'ro',
    default => sub { {} },
);

has _initialized => (
    is => 'rw',
    default => 0,
);

sub _exechook {
    my ($self, $hook, @args) = @_;
    return unless $self->_hooks->{$hook};
    foreach my $code (@{ $self->_hooks->{$hook} }) {
        $code->($self, @args);
    }
}


sub BUILDARGS {
    my $class = shift;
    my ($target, %defaults);
    $target = shift if @_ % 2;
    %defaults = @_;
    return {
        _target => $target,
        _defaults => \%defaults,
    }
}


sub set {
    my ($self, %vals) = @_;
    foreach my $key (keys %vals) {
        $self->_defaults->{$key} = delete $vals{$key};
    }
}


sub log {
    my ($self, $level, $msg, %rest) = @_;
    unless ($self->_initialized) {
        $self->_exechook('init');
        $self->_initialized(1);
    }
    foreach my $key (keys %{ $self->_defaults }) {
        next if exists $rest{$key};
        my $val = $self->_defaults->{$key};
        if (ref $val eq 'CODE') {
            $rest{$key} = scalar($val->($level, $msg));
        } else {
            $rest{$key} = $val;
        }
    }
    push @{ $self->_stack } => [ $level, $msg, %rest ];
}


sub throw {
    my ($self, $target) = @_;
    return unless @{ $self->_stack };
    $target //= $self->_target;
    if (ref $target eq 'CODE') {
        $self->_exechook('before');
        while (my $msg = shift @{ $self->_stack }) {
            $target->(@$msg);
        }
        $self->_exechook('after');
    } elsif (blessed $target and $target->can('log')) {
        $self->_exechook('before');
        while (my $msg = shift @{ $self->_stack }) {
            $target->log(@$msg);
        }
        $self->_exechook('after');
    } else {
        croak "Logging target must be a blessed object with a log method or a CodeRref";
    }
    $self->_exechook('cleanup');
    $self->_initialized(0);
}


sub flush {
    my $self = shift;
    $self->_clear_stack;
    $self->_exechook('cleanup');
    $self->_initialized(0);
}


sub hook {
    my ($self, %def) = @_;
    foreach my $name (keys %def) {
        my $code = $def{$name};
        croak "Hook for $name must be a CodeRef" unless ref $code eq 'CODE';
        $self->_hooks->{$name} //= [];
        push @{ $self->_hooks->{$name} } => $code;
    }
}



1;

__END__