File Coverage

lib/Log/Dump.pm

Criterion	Covered	Total	%
statement	136	137	99.2
branch	75	86	87.2
condition	24	33	72.7
subroutine	17	17	100.0
pod	6	6	100.0
total	258	279	92.4

package Log::Dump;

use strict;
use warnings;
use Sub::Install qw( install_sub );
use Scalar::Util qw( blessed );

our $VERSION = '0.14';
our @CARP_NOT = qw/Log::Dump Log::Dump::Class Log::Dump::Functions/;

sub import {
  my $class = shift;
  my $caller = caller;

  return if $caller eq 'main';

  my @methods = qw/logger logfilter logfile logcolor logtime log/;
  for my $method (@methods) {
    install_sub({
      as   => $method,
      into => $caller,
      code => \&{$method},
    });
  }
}

sub logger {
  my $self = shift;

  my $logger = $_[0];
  if ( blessed $self ) {
    @_ ? $self->{_logger} = $logger : $self->{_logger};
  }
  else {
    no strict 'refs';
    @_ ? ${"$self\::_logger"} = $logger : ${"$self\::_logger"};
  }
}

sub logfilter {
  my $self = shift;

  my $filter = undef;
  if (@_ && $_[0]) {
    $filter = {pos => [], neg => []};
    for (@_) {
      if (substr($_, 0, 1) eq '!') {
        push @{$filter->{neg}}, substr($_, 1);
      }
      else {
        push @{$filter->{pos}}, $_;
      }
    }
  }

  if ( blessed $self ) {
    @_ ? $self->{_logfilter} = $filter : $self->{_logfilter};
  }
  else {
    no strict 'refs';
    @_ ? ${"$self\::_logfilter"} = $filter : ${"$self\::_logfilter"};
  }
}

sub logfile {
  my $self = shift;

  my $logfile_ref;
  if ( blessed $self ) {
    $logfile_ref = \($self->{_logfile});
    }
  else {
    no strict 'refs';
    $logfile_ref = \(${"$self\::_logfile"});
  }

  if ( @_ && $_[0] ) {
    push @_, 'w' if @_ == 1;
    require IO::File;
    my $fh = IO::File->new(@_) or $self->log( fatal => $! );
    $$logfile_ref = $fh;
  }
  elsif ( @_ && !$_[0] ) {
    $$logfile_ref->close if $$logfile_ref;
    $$logfile_ref = undef;
  }
  else {
    $$logfile_ref;
  }
}

sub logtime {
  my $self = shift;

  my $logtime_ref;
  if ( blessed $self ) {
    $logtime_ref = \($self->{_logtime});
    }
  else {
    no strict 'refs';
    $logtime_ref = \(${"$self\::_logtime"});
  }

  if ( @_ && $_[0] ) {
    eval { require Time::Piece };
    return $$logtime_ref = undef if $@;

    my $format = $_[0] =~ /%/ ? $_[0] : '%Y-%m-%d %H:%M:%S';
    $$logtime_ref = sub { Time::Piece->new(shift)->strftime($format) };
  }
  elsif ( @_ && !$_[0] ) {
    $$logtime_ref = undef;
  }
  else {
    $$logtime_ref;
  }
}

sub logcolor {
  my $self = shift;

  my $logcolor_ref;
  if ( blessed $self ) {
    $logcolor_ref = \($self->{_logcolor});
    }
  else {
    no strict 'refs';
    $logcolor_ref = \(${"$self\::_logcolor"});
  }

  unless ( defined $$logcolor_ref ) {
    eval { require Term::ANSIColor };
    $$logcolor_ref = $@ ? 0 : {};

    eval { require Win32::Console::ANSI } if $^O eq 'MSWin32';
  }
  return unless $$logcolor_ref;

  if ( @_ == 1 && $_[0] ) {
    $$logcolor_ref->{$_[0]};
  }
  elsif ( @_ && !$_[0] ) {
    $$logcolor_ref = {};
  }
  elsif ( @_ % 2 == 0 ) {
    $$logcolor_ref = { %{ $$logcolor_ref }, @_ };
  }
}

sub log {
  my $self = shift;

  my $logger = $self->logger;

  if ( defined $logger and !$logger ) {
    return;
  }
  elsif ( $logger and $logger =~ /^[A-Za-z]/ && $logger->can('log') ) {
    $logger->log(@_);
  }
  else {
    my $label = shift;

    if ($self->logfilter) {
      if (my @neg = @{ $self->logfilter->{neg} }) {
        return if grep { $label eq $_ } @neg;
      }
      if (my @pos = @{ $self->logfilter->{pos} }) {
        return if !grep { $label eq $_ } @pos;
      }
    }

    require Data::Dump;
    my $msg = join '', map { ref $_ ? Data::Dump::dump($_) : $_ } @_;
    my $colored_msg = $msg;
    if ( my $color = $self->logcolor($label) ) {
      eval { $colored_msg = Term::ANSIColor::colored($msg, $color) };
      $colored_msg = $msg if $@;
    }
    my $time = '';
    if (my $func = $self->logtime) {
      $time = $func->(time) . " ";
    }

    if ( $label eq 'fatal' ) {
      require Carp;
      Carp::croak $time."[$label] $colored_msg";
    }
    elsif ( $label eq 'error' or $label eq 'warn' ) {
      require Carp;
      Carp::carp $time."[$label] $colored_msg";
      $self->logfile->print(Carp::shortmess($time."[$label] $msg"), "\n") if $self->logfile;
    }
    else {
      print STDERR $time."[$label] $colored_msg\n";
      $self->logfile->print($time."[$label] $msg\n") if $self->logfile;
    }
  }
}

1;

__END__