File Coverage

blib/lib/Piper/Logger.pm

Criterion	Covered	Total	%
statement	22	22	100.0
branch	6	6	100.0
condition	2	3	66.6
subroutine	7	7	100.0
pod	2	2	100.0
total	39	40	97.5

#####################################################################
## AUTHOR: Mary Ehlers, [e-mail]
## ABSTRACT: Logging and debugging message handler for Piper
#####################################################################

package Piper::Logger;

use v5.10;
use strict;
use warnings;

use Carp qw();
# use Data::Dump qw(dump); # required if needed

use Moo;

with qw(Piper::Role::Logger);

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

#pod =head1 CONSTRUCTOR
#pod
#pod =head2 new
#pod
#pod =head1 METHODS
#pod
#pod =head2 DEBUG($segment, $message, @items)
#pod
#pod This method is a no-op unless S<<< C<< $self->debug_level($segment) > 0 >> >>>.
#pod
#pod Prints an informational message to STDERR.
#pod
#pod Uses the method C to format the printed message according to the debug/verbose levels of C<$segment>.
#pod
#pod Labels the message by pre-pending 'Info: ' to the formatted message.
#pod
#pod =cut

sub DEBUG {
    my $self = shift;
    $self->INFO(@_);
}

#pod =head2 ERROR($segment, $message, @items)
#pod
#pod Prints an error to STDERR and dies via L.
#pod
#pod Uses the method C to format the printed message according to the debug/verbose levels of C<$segment>.
#pod
#pod Labels the message by pre-pending 'Error: ' to the formatted message.
#pod
#pod =cut

sub ERROR {
    my $self = shift;
    Carp::croak('Error: '.$self->make_message(@_));
}

#pod =head2 INFO($segment, $message, @items)
#pod
#pod This method is a no-op unless S<<< C<< $self->verbose_level($segment) > 0 >> >>> or S<<< C<< $self->debug_level($segment) > 0 >> >>>.
#pod
#pod Prints an informational message to STDERR.
#pod
#pod Uses the method C to format the printed message according to the debug/verbose levels of C<$segment>.
#pod
#pod Labels the message by pre-pending 'Info: ' to the formatted message.
#pod
#pod =cut

sub INFO {
    my $self = shift;
    say STDERR 'Info: '.$self->make_message(@_);
}

#pod =head2 WARN($segment, $message, @items)
#pod
#pod Prints a warning to STDERR via L.
#pod
#pod Uses the method C to format the printed message according to the debug/verbose levels of C<$segment>.
#pod
#pod Labels the message by pre-pending 'Warning: ' to the formatted message.
#pod
#pod =cut

sub WARN {
    my $self = shift;
    Carp::carp('Warning: '.$self->make_message(@_));
}

#pod =head1 UTILITY METHODS
#pod
#pod =head2 make_message($segment, $message, @items)
#pod
#pod Formats and returns the message according to the debug/verbose levels of C<$segment> and the provided arguments.
#pod
#pod There are two-three parts to the message:
#pod
#pod     segment_name: message
#pod
#pod The message part is simply C<$message> for all debug/verbose levels.
#pod
#pod The  part is only included when the verbosity level of the segment is greater than 1.  It is formatted by L.
#pod
#pod If the verbosity and debug levels are both 0, segment_name is simply the segment's C.  If the verbosity level of the segment is greater than zero, the full path of the segment is used instead of C.  If the debug level of the segment is greater than 1, the segment's C is appended to C/C in parentheses.
#pod
#pod =cut

sub make_message {
    my ($self, $segment, $message, @items) = @_;

    $message = ($self->verbose_level($segment) ? $segment->path : $segment->label)
        . ($self->debug_level($segment) > 1 ? ' (' . $segment->id . '): ' : ': ')
        . $message;

    if ($self->verbose_level($segment) > 1 and @items) {
        require Data::Dump;

        $message .= ' ' . Data::Dump::dump(@items);
    }

    return $message;
}

#pod =head2 debug_level($segment)
#pod
#pod =head2 verbose_level($segment)
#pod
#pod These methods determine the appropriate debug and verbosity levels for the given $segment, while respecting any environment variable overrides.
#pod
#pod Available environment variable overrides:
#pod
#pod     PIPER_DEBUG
#pod     PIPER_VERBOSE
#pod
#pod =cut

1;

__END__