File Coverage

blib/lib/MouseX/Role/Loggable.pm

Criterion	Covered	Total	%
statement	51	51	100.0
branch	12	12	100.0
condition	3	3	100.0
subroutine	12	12	100.0
pod	2	2	100.0
total	80	80	100.0

use strict;
use warnings;
package MouseX::Role::Loggable;
{
  $MouseX::Role::Loggable::VERSION = '0.112001';
}
# ABSTRACT: Extensive, yet simple, logging role using Log::Dispatchouli

use Carp;
use Safe::Isa;
use Mouse::Role;
use Mouse::Util::TypeConstraints;
use MouseX::Types::Mouse qw;
use Log::Dispatchouli;
use namespace::sweep;

class_type 'Log::Dispatchouli';
class_type 'Log::Dispatchouli::Proxy';

my %attr_meth_map = (
    logger_facility => 'facility',
    logger_ident    => 'ident',
    log_to_file     => 'to_file',
    log_to_stdout   => 'to_stdout',
    log_to_stderr   => 'to_stderr',
    log_fail_fatal  => 'fail_fatal',
    log_muted       => 'muted',
    log_quiet_fatal => 'quiet_fatal',
);

has debug => (
    is      => 'ro',
    isa     => Bool,
    default => 0,
);

has logger_facility => (
    is      => 'ro',
    isa     => Str,
    default => 'local6',
);

has logger_ident => (
    is      => 'ro',
    isa     => Str,
    default => sub { ref shift },
);

has log_to_file => (
    is      => 'ro',
    isa     => Bool,
    default => 0,
);

has log_to_stdout => (
    is      => 'ro',
    isa     => Bool,
    default => 0,
);

has log_to_stderr => (
    is      => 'ro',
    isa     => Bool,
    default => 0,
);

has log_file => (
    is        => 'ro',
    isa       => Str,
    predicate => 'has_log_file',
);

has log_path => (
    is        => 'ro',
    isa       => Str,
    predicate => 'has_log_path',
);

has log_pid => (
    is      => 'ro',
    isa     => Bool,
    default => 1,
);

has log_fail_fatal => (
    is      => 'ro',
    isa     => Bool,
    default => 1,
);

has log_muted => (
    is      => 'ro',
    isa     => Bool,
    default => 0,
);

has log_quiet_fatal => (
    is      => 'ro',
    isa     => 'Str|ArrayRef',
    default => 'stderr',
);

has logger => (
    is      => 'ro',
    isa     => 'Log::Dispatchouli|Log::Dispatchouli::Proxy',
    lazy    => 1,
    builder => '_build_logger',
    handles => [ qw/
        log log_fatal log_debug
        set_debug clear_debug set_prefix clear_prefix set_muted clear_muted
    / ],
);

sub _build_logger {
    my $self     = shift;
    my %optional = ();

    foreach my $option ( qw ) {
        my $method = "has_$option";
        if ( $self->$method ) {
            $optional{$option} = $self->$option;
        }
    }

    my $logger = Log::Dispatchouli->new( {
        debug       => $self->debug,
        ident       => $self->logger_ident,
        facility    => $self->logger_facility,
        to_file     => $self->log_to_file,
        to_stdout   => $self->log_to_stdout,
        to_stderr   => $self->log_to_stderr,
        log_pid     => $self->log_pid,
        fail_fatal  => $self->log_fail_fatal,
        muted       => $self->log_muted,
        quiet_fatal => $self->log_quiet_fatal,
        %optional,
    } );

    return $logger;
}

# if we already have a logger, use its values
sub BUILDARGS {
    my $class = shift;
    my %args  = @_;
    my @items = qw<
        debug logger_facility logger_ident
        log_to_file log_to_stdout log_to_stderr log_file log_path
        log_pid log_fail_fatal log_muted log_quiet_fatal
    >;

    if ( exists $args{'logger'} ) {
        $args{'logger'}->$_isa('Log::Dispatchouli')        ||
        $args{'logger'}->$_isa('Log::Dispatchouli::Proxy')
            or croak 'logger must be a Log::Dispatchouli object';

        foreach my $item (@items) {
            # if value is overridden, don't touch it
            my $attr = exists $attr_meth_map{$item} ?
                       $attr_meth_map{$item}        :
                       $item;

            if ( exists $args{$item} ) {
                # override logger configuration
                $args{'logger'}{$attr} = $args{$item};
            } else {
                # override our attributes if it's in logger
                exists $args{'logger'}{$attr}
                    and $args{$item} = $args{'logger'}{$attr};
            }
        }
    }

    return {%args};
}

sub log_fields {
    my $self    = shift;
    my $warning =
        '[MouseX::Role::Loggable] Calling ->log_fields() is deprecated, ' .
        'it will be removed in the next version';

    $self->log( { level => 'warning' }, $warning );
    carp $warning;

    return ( logger => $self->logger );
}

1;

__END__