The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Bio::Gonzales::Util::Log;

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

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

use warnings;
use strict;

use 5.010;

our $VERSION = 0.01_01;

# 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 {'debug'} );
has namespace => (is => 'rw');
has _fh   => ( is => 'lazy' );
has tee_stderr => (is => 'rw');

sub _build__fh {
  my $self = shift;

  # File
  if ( my $path = $self->path ) {
    croak qq{Can't open log file "$path": $!}
      unless open my $file, '>>', $path;
    return $file;
  }

  # 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 format {
  my ( $self, $level, @lines ) = @_;


  my $txt = '[' . strftime("%Y-%m-%d %H:%M:%S", localtime) . "] [" . uc($level) . "]";
  $txt .= " " . $self->namespace . ":" if ( $self->namespace );
  $txt .= ' [t' . threads->tid() .']' if($is_thread);
  $txt .= " " . join( "\n", @lines, '' );
  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 ) = @_;
  return $LEVEL->{ lc $level } >= $LEVEL->{ $ENV{GONZALES_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);
}

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



=head1 SYNOPSIS


=head1 DESCRIPTION

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

=head1 OPTIONS

=head1 SUBROUTINES
=head1 METHODS

=head1 SEE ALSO

L<Mojo::Log>

=head1 AUTHOR

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

=cut