File Coverage

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

Criterion	Covered	Total	%
statement	49	56	87.5
branch	20	28	71.4
condition	13	20	65.0
subroutine	14	15	93.3
pod	0	1	0.0
total	96	120	80.0

use 5.008001;
use strict;
use warnings;

package Log::Any::Adapter::Capture;

# ABSTRACT: Adapter for capturing log messages into an arrayref
our $VERSION = '1.715';

use Log::Any::Adapter::Util ();

use Log::Any::Adapter::Base;
our @ISA = qw/Log::Any::Adapter::Base/;

# Subclass for optional structured logging
@Log::Any::Adapter::Capture::_Structured::ISA = ( __PACKAGE__ );

sub init {
    my ($self) = @_;

    # Handle 'text' and 'structured' aliases
    if ( defined $self->{text} ) {
        $self->{format} = 'text';
        $self->{to} = delete $self->{text};
    }
    if ( defined $self->{structured} ) {
        $self->{format} = 'structured';
        $self->{to} = delete $self->{structured};
    }

    my $to = $self->{to};
    unless ( $to and ref $to eq 'CODE' || ref $to eq 'ARRAY' ) {
        require Carp;
        Carp::croak( "Capture destination 'to' must be an arrayref or coderef" );
    }

    my $format = $self->{format} || 'messages';
    if ( $format eq 'text' ) {
        $self->{_callback} = # only pass the message text argument
            ref $to eq 'CODE' ? sub { $to->($_[2]) }
            : sub { push @$to, $_[2] };
    }
    elsif ( $format eq 'messages' ) {
        $self->{_callback} = ref $to eq 'CODE' ? $to : sub { push @$to, [ @_ ] };
    }
    elsif ( $format eq 'structured' ) {
        $self->{_callback} = ref $to eq 'CODE' ? $to : sub { push @$to, [ @_ ] };
        # Structured logging is determined by whether or not the package
        # contains a method of that name.  If structured logging were enabled,
        # the proxy would always call ->structured rather than its default
        # behavior of flattening to a string, even for the case where the user
        # of this module wanted strings.  So, enable/disable of structured
        # capture requires changing the class of this object.
        # This line is written in a way to make subclassing possible.
        bless $self, ref($self).'::_Structured' unless $self->can('structured');
    }
    else {
        require Carp;
        Carp::croak( "Unknown capture format '$format' (expected 'text', 'messages', or 'structured')" );
    }

    if ( defined $self->{log_level} && $self->{log_level} =~ /\D/ ) {
        my $numeric_level = Log::Any::Adapter::Util::numeric_level( $self->{log_level} );
        if ( !defined($numeric_level) ) {
            require Carp;
            Carp::carp( "Invalid log level '$self->{log_level}'.  Will capture all messages." );
        }
        $self->{log_level} = $numeric_level;
    }
}

# Each logging method simply passes its arguments (minus $self) to the _callback
# Logging can be skipped if a log_level is in effect.
foreach my $method ( Log::Any::Adapter::Util::logging_methods() ) {
    no strict 'refs';
    my $method_level = Log::Any::Adapter::Util::numeric_level($method);
    *{$method} = sub {
        my ( $self, $text ) = @_;
        return if defined $self->{log_level} and $method_level > $self->{log_level};
        $self->{_callback}->( $method, $self->{category}, $text );
    };
}

# Detection methods return true unless a log_level is in effect
foreach my $method ( Log::Any::Adapter::Util::detection_methods() ) {
    no strict 'refs';
    my $base = substr( $method, 3 );
    my $method_level = Log::Any::Adapter::Util::numeric_level($base);
    *{$method} = sub {
        return !defined $_[0]{log_level} || !!( $method_level <= $_[0]{log_level} );
    };
}

# A separate package is required for handling the ->structured Adapter API.
# See notes in init()
sub Log::Any::Adapter::Capture::_Structured::structured {
    my ( $self, $method, $category, @parts ) = @_;
    return if defined $self->{log_level}
        and Log::Any::Adapter::Util::numeric_level($method) > $self->{log_level};
    $self->{_callback}->( $method, $category, @parts );
};

1;

__END__