File Coverage

blib/lib/Piper/Role/Logger.pm

Criterion	Covered	Total	%
statement	19	19	100.0
branch			n/a
condition	6	6	100.0
subroutine	8	8	100.0
pod	2	2	100.0
total	35	35	100.0

#####################################################################
## AUTHOR: Mary Ehlers, [e-mail]
## ABSTRACT: Role for logging and debugging in the Piper system
#####################################################################

package Piper::Role::Logger;

use v5.10;
use strict;
use warnings;

use Carp;
use Types::Common::Numeric qw(PositiveOrZeroNum);

use Moo::Role;

our $VERSION = '0.03'; # from Piper-0.03.tar.gz

#TODO: Look into making this Log::Any-compatible

#pod =head1 DESCRIPTION
#pod
#pod The role exists to support future subclassing and testing of the logging mechanism used by L.
#pod
#pod =head1 REQUIRES
#pod
#pod This role requires the definition of the below methods, each of which will be provided the following arguments:
#pod
#pod   $segment  # The pipeline segment calling the method
#pod   $message  # The message sent (a string)
#pod   @items    # Items that provide context to the message
#pod
#pod =head2 DEBUG
#pod
#pod This method is only called if the debug level of the segment is greater than zero.
#pod
#pod =cut

requires 'DEBUG';

around DEBUG => sub {
    my ($orig, $self, $instance) = splice @_, 0, 3;
    return unless $self->debug_level($instance);
    $self->$orig($instance, @_);
};

#pod =head2 ERROR
#pod
#pod This method should cause a C or C.  It will do so automatically if not done explicitly, though with an extremely generic and unhelpful message.
#pod
#pod =cut

requires 'ERROR';

after ERROR => sub {
    croak 'ERROR encountered';
};

#pod =head2 INFO
#pod
#pod This method is only called if either the verbosity or debug levels of the segment are greater than zero.
#pod
#pod =cut

requires 'INFO';

around INFO => sub {
    my ($orig, $self, $instance) = splice @_, 0, 3;
    return unless $self->debug_level($instance) or $self->verbose_level($instance);
    $self->$orig($instance, @_);
};

#pod =head2 WARN
#pod
#pod This method should issue a warning (such as C or C).
#pod
#pod =cut

requires 'WARN';

#pod =head1 UTILITY METHODS
#pod
#pod =head2 debug_level($segment)
#pod
#pod =head2 verbose_level($segment)
#pod
#pod These methods should be used to determine the appropriate debug and verbosity levels for the logger.  They honor the following environment variable overrides (if they exist) before falling back to the appropriate levels set by the given C<$segment>:
#pod
#pod     PIPER_DEBUG
#pod     PIPER_VERBOSE
#pod
#pod =cut

sub debug_level {
    return $ENV{PIPER_DEBUG} // $_[1]->debug;
}

sub verbose_level {
    return $ENV{PIPER_VERBOSE} // $_[1]->verbose;
}

1;

__END__