File Coverage

blib/lib/Bio/Gonzales/Util/Log.pm

Criterion	Covered	Total	%
statement	53	67	79.1
branch	11	30	36.6
condition	2	6	33.3
subroutine	14	28	50.0
pod	13	19	68.4
total	93	150	62.0

package Bio::Gonzales::Util::Log;

# shamelessly stolen from Mojo::Log, thanks to Sebastian Riedel & contributors for creating it.
use Moo;

use Carp qw(croak confess);
use Fcntl ':flock';
use POSIX qw/strftime/;

use warnings;
use strict;

use 5.010;

our $VERSION = '0.083'; # VERSION

# Supported log level
my $LEVEL = { debug => 1, info => 2, warn => 3, error => 4, fatal => 5 };
my $is_thread = eval '$threads::threads';

has path       => ( is => 'rw' );
has level      => ( is => 'rw', default => sub { 'info' } );
has namespace  => ( is => 'rw' );
has _fh        => ( is => 'lazy' );
has tee_stderr => ( is => 'rw' );

has append => ( is => 'rw', default => 1 );

sub _build__fh {
  my $self = shift;

  # File
  if ( my $path = $self->path ) {
    my $mode = $self->append ? '>>' : '>';

    croak qq{Can't open log file "$path": $!}
      unless open( my $fh, $mode, $path );
    return $fh;
  }

  # STDERR
  $self->tee_stderr(0);
  return \*STDERR;
}

sub debug { shift->log( debug => @_ ) }
sub error { shift->log( error => @_ ) }
sub warn  { shift->log( warn  => @_ ) }
sub fatal { shift->log( fatal => @_ ) }

sub fatal_confess { shift->log( fatal => @_ ) and confess(@_) }
sub fatal_die     { shift->log( fatal => @_ ) and die(@_) }
sub fatal_croak   { shift->log( fatal => @_ ) and croak(@_) }

sub fatal_confess_silent { shift->log( fatal => @_ ) and confess }
sub fatal_die_silent     { shift->log( fatal => @_ ) and die }
sub fatal_croak_silent   { shift->log( fatal => @_ ) and croak }

sub format {
  my ( $self, $level, @lines ) = @_;

  @lines = map { split /\n/, $_ } @lines;

  my $txt = strftime( "[%d %b %H:%M:%S]", localtime ) . " [" . uc($level) . "]";
  $txt .= " " . $self->namespace       if ( $self->namespace );
  $txt .= ' (t' . threads->tid() . ')' if ($is_thread);
  $txt .= ": ";

  $txt .= join( ( "\n" . ( " " x length($txt) ) ), @lines );
  $txt .= "\n";
  return $txt;
}

sub info { shift->log( info => @_ ) }

sub is_debug { shift->is_level('debug') }
sub is_error { shift->is_level('error') }
sub is_fatal { shift->is_level('fatal') }
sub is_info  { shift->is_level('info') }
sub is_warn  { shift->is_level('warn') }

sub is_level {
  my ( $self, $level ) = @_;
  croak "level not specified" unless ($level);
  return $LEVEL->{ lc $level } >= $LEVEL->{ lc($ENV{GONZ_LOG_LEVEL} || $self->level) };
}

sub log {
  my ( $self, $level ) = ( shift, shift );

  return unless $self->is_level($level) && ( my $handle = $self->_fh );

  my $msg = $self->format( $level, @_ );

  _print( $handle, $msg );
  _print( \*STDERR, $msg ) if ( $self->tee_stderr );
  return $self;
}

sub _print {
  my ( $handle, $msg ) = ( shift, shift );

  flock $handle, LOCK_EX;
  $handle->print($msg) or croak "Can't write to log: $!";
  $handle->flush;
  flock $handle, LOCK_UN;
}

1;

__END__

=head1 NAME

Bio::Gonzales::Util::Log - basic logging for Bio::Gonzales

=head1 SYNOPSIS

    # logs to stderr by default
    my $l = Bio::Gonzales::Util::Log->new();
    $l->info("started application");

=head1 DESCRIPTION

First of all: Shamelessly stolen from Mojo::Log, thanks to Sebastian Riedel & contributors for creating it.

=head1 METHODS

=over 4

=item B<< $log->path($file) >>

Sets or gets the log file path. If not set, STDERR is used.

=item B<< $log->level($level) >>

Sets or gets the threshold level for logging. Everything lower than this level will not be logged. By default C<debug>.

=item B<< $log->namespace($namespace) >>

Sets or gets the namespace of the logger.

=item B<< $log->tee_stderr($bool) >>

Log to file and STDERR. If no path is set, setting this option has no effect.

=item B<< $log->append($bool) >>

If 1, the logger appends the log output to the log file.

=item B<< $log->debug(@lines) >>

Log debug message.

=item B<< $log->error(@lines) >>

Log error message.

=item B<< $log->warn(@lines) >>

Log warning message.

=item B<< $log->fatal(@lines) >>

Log fatal message.

=item B<< $log->info(@lines) >>

Log info message.

=item B<< $log_text = $log->format($level, @lines) >>

Format C<@lines> and return the formatted text.

=item B<< $log->is_debug >>

Return true if log level is debug.

=item B<< $log->is_error >>

Return true if log level is error.

=item B<< $log->is_fatal >>

Return true if log level is fatal.

=item B<< $log->is_info >>

Return true if log level is info.

=item B<< $log->is_warn >>

Return true if log level is warn.

=item B<< $log->is_level($level) >>

Return true if log level is C<$level>

=item B<< $log->log($level, @lines) >>

Logs C<$lines> with C<$level> to log destination.

=back

=head1 SEE ALSO

L<Mojo::Log>

=head1 AUTHOR

jw bargsten, C<< <jwb at cpan dot org> >>

=cut