File Coverage

blib/lib/MooseX/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 MooseX::Role::Loggable;
{
  $MooseX::Role::Loggable::VERSION = '0.112';
}
# ABSTRACT: Extensive, yet simple, logging role using Log::Dispatchouli

use Carp;
use Safe::Isa;
use Moo::Role;
use MooX::Types::MooseLike::Base qw<Bool Str>;
use Sub::Quote 'quote_sub';
use Log::Dispatchouli;
use namespace::sweep;

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 => sub {0},
);

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

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

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

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

has log_to_stderr => (
    is      => 'ro',
    isa     => Bool,
    default => sub {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 => sub {1},
);

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

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

has log_quiet_fatal => (
    is      => 'ro',
    isa     => quote_sub(q{
                use Safe::Isa;
                $_[0] || $_[0]->$_isa( ref [] )
                        or die "$_[0] must be a string or arrayref"
        }),
    default => sub {'stderr'},
);

has logger => (
    is      => 'lazy',
    isa     => quote_sub(q{
                use Safe::Isa;
                $_[0]->$_isa('Log::Dispatchouli')        ||
                $_[0]->$_isa('Log::Dispatchouli::Proxy')
                        or die "$_[0] must be a Log::Dispatchouli object";
        }),

    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<log_file log_path> ) {
        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 =
        '[MooseX::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;



=pod

=head1 NAME

MooseX::Role::Loggable - Extensive, yet simple, logging role using Log::Dispatchouli

=head1 VERSION

version 0.112

=head1 SYNOPSIS

    package My::Object;

    use Moose; # or Moo
    with 'MooseX::Role::Loggable';

    sub do_this {
        my $self = shift;
        $self->set_prefix('[do_this] ');
        $self->log_debug('starting...');
        ...
        $self->log_debug('more stuff');
        $self->clear_prefix;
    }

=head1 DESCRIPTION

This is a role to provide logging ability to whoever consumes it using
L<Log::Dispatchouli>. Once you consume this role, you have attributes and
methods for logging defined automatically.

    package MyObject;
    use Moose # Moo works too
    with 'MooseX::Role::Loggable';

    sub run {
        my $self = shift;

        $self->log('Trying to do something');

        # this only gets written if debug flag is on
        $self->log_debug('Some debugging output');

        $self->log(
            { level => 'critical' },
            'Critical log message',
        );

        $self->log_fatal('Log and die');
    }

This module uses L<Moo> so it takes as little resources as it can by default,
and can seamlessly work with both L<Moo> or L<Moose>.

=head1 Propagating logging definitions

Sometimes your objects create additional object which might want to log
using the same settings. You can simply give them the same logger object.

    package Parent;
    use Moose;
    with 'MooseX::Role::Loggable';

    has child => (
        is      => 'ro',
        isa     => 'Child',
        lazy    => 1,
        builder => '_build_child',
    );

    sub _build_child {
        my $self = shift;
        return Child->new( logger => $self->logger );
    }

=head1 ATTRIBUTES

=head2 debug

A boolean for whether you're in debugging mode or not.

Default: B<no>.

Read-only.

=head2 logger_facility

The facility the logger would use. This is useful for syslog.

Default: B<local6>.

=head2 logger_ident

The ident the logger would use. This is useful for syslog.

Default: B<calling object's class name>.

Read-only.

=head2 log_to_file

A boolean that determines if the logger would log to a file.

Default location of the file is in F</tmp>.

Default: B<no>.

Read-only.

=head2 log_to_stdout

A boolean that determines if the logger would log to STDOUT.

Default: B<no>.

=head2 log_to_stderr

A boolean that determines if the logger would log to STDERR.

Default: B<no>.

=head2 log_file

The leaf name for the log file.

Default: B<undef>

=head2 log_path

The path for the log file.

Default: B<undef>

=head2 log_pid

Whether to append the PID to the log filename.

Default: B<yes>

=head2 log_fail_fatal

Whether failure to log is fatal.

Default: B<yes>

=head2 log_muted

Whether only fatals are logged.

Default: B<no>

=head2 log_quiet_fatal

From L<Log::Dispatchouli>:
I<'stderr' or 'stdout' or an arrayref of zero, one, or both fatal log messages
will not be logged to these>.

Default: B<stderr>

=head2 logger

A L<Log::Dispatchouli> object.

=head1 METHODS

All methods here are imported from L<Log::Dispatchouli>. You can read its
documentation to understand them better.

=head2 log

Log a message.

=head2 log_debug

Log a message only if in debug mode.

=head2 log_fatal

Log a message and die.

=head2 set_debug

Set the debug flag.

=head2 clear_debug

Clear the debug flag.

=head2 set_prefix

Set a prefix for all next messages.

=head2 clear_prefix

Clears the prefix for all next messages.

=head2 set_muted

Sets the mute property, which makes only fatal messages logged.

=head2 clear_muted

Clears the mute property.

=head2 BUILDARGS

You shouldn't care about this. It takes care of propagating attributes
from a given logger (if you provided one) to the attributes this role provides.

=head2 log_fields

B<DEPRECATED>.

Please pass the logger attribute instead:

    SomeObject->new( logger => $parent->logger );

=head1 DEBUGGING

Occassionally you might encounter the following error:

    no ident specified when using Log::Dispatchouli at Loggable.pm line 117.

The problem does not stem from L<MooseX::Role::Loggable>, but from a builder
calling a logging method before the logger is built. Since L<Moo> and L<Moose>
do not assure order of building attributes, which means that some attributes
might not exist by the time you need them.

This specific error happens when the C<ident> attribute isn't built by the
time a builder runs. In order to avoid it, the attribute which uses the builder
should be made lazy, and then called in the C<BUILD> method. Here is an
example:

    package Stuff;

    use Moose;
    with 'MooseX::Role::Logger';

    has db => (
        is      => 'ro',
        lazy    => 1,
        builder => '_build_db',
    }

    sub _build_db {
        my $self = shift;
        $self->log_debug('Building DB');
        ...
    }

    sub BUILD {
        my $self = shift;
        $self->db;
    }

This makes the C<db> attribute non-lazy, but during run-time. This will assure
that all the logging attributes are created B<before> you build the C<db>
attribute and call C<log_debug>.

=head1 AUTHOR

Sawyer X <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2012 by Sawyer X.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut


__END__