File Coverage

blib/lib/Log/Log4perl/Shortcuts.pm

Criterion	Covered	Total	%
statement	103	119	86.5
branch	21	40	52.5
condition	2	4	50.0
subroutine	21	21	100.0
pod	9	10	90.0
total	156	194	80.4

package Log::Log4perl::Shortcuts ;
$Log::Log4perl::Shortcuts::VERSION = '0.024';
use 5.10.0;
use Carp;
use Log::Log4perl;
use Log::Log4perl::Level;
use Path::Tiny;
use Module::Data;
use File::UserConfig;
use Data::Dumper qw(Dumper);

require Exporter;
@ISA = Exporter;
@EXPORT_OK = qw(logc logt logd logi logw loge logf set_log_config set_log_level get_log_config);
%EXPORT_TAGS = ( all => [qw(logc logt logd logi logw loge logf set_log_config set_log_level get_log_config)] );
Exporter::export_ok_tags('all');

my $package = __PACKAGE__;
$package =~ s/::/-/g;
my $config_file;
my $config_dir = path(File::UserConfig->new(dist => $package)->sharedir, 'log_config');

my $default_config_file = path($config_dir, 'default.cfg');

if (!$default_config_file->exists) {
  carp ("Unable to load default Log::Log4perl::Shortcuts configuration file. Aborting");
} else {
  Log::Log4perl->init_once($default_config_file->canonpath);
  $config_file = $default_config_file->canonpath;
}

my $log_level = $TRACE;

### Public methods ###

sub get_log_config {
  return $config_file;
}

sub set_log_config {
  my $new_config = shift;
  my $module = shift || '';

  # must pass in name of a file
  if (!$new_config) {
    logw('No log config file passed. Configuration file unchanged');
    return;
  }

  # try to get config file from path passed directly in
  my $cf_path = path($new_config);
  if ($cf_path->exists) {
    return _init_config($cf_path);
  }

  # try to get the config from the module argument or pkg of caller
  if (!$module) {
    ($module) = caller;
  }
  $module =~ s/::/-/g;
  my $temp_config_dir;
  eval {
    my $share_dir = File::UserConfig->new(dist => $module)->sharedir;
    if ($share_dir) {
      $temp_config_dir = path(File::UserConfig->new(dist => $module)->sharedir, 'log_config');
    }
  };
  if ($temp_config_dir) {
    $cf_path = path($temp_config_dir, $new_config);
    if ($cf_path->exists) {
      return _init_config($cf_path);
    }
  }

  # Lastly, check the Log::Log4perl::Shortcuts module for config file
  $temp_config_dir = $config_dir;
  $cf_path = path($temp_config_dir, $new_config);

  if (! $cf_path->exists) {
    carp ("Configuration file $new_config does not exist. Configuration file unchanged.");
  } else {
    return _init_config($cf_path);
  }
}

sub _init_config {
  my $config = shift;
  Log::Log4perl->init($config->canonpath);
  $config_file = $config->canonpath;
  return 'success';
}

sub set_log_level {
  my $level = ${uc(shift)};
  $log_level = $level;
}

sub logc {
  my $log = _get_logger(shift);
  return unless $log->is_trace;

  my $msg = sprintf(' ' x 81 . "%s\n", [caller(0)]->[0] . ": " . [caller(0)]->[2]);
  $msg .= '        ' . _get_callers() . "\n       ";

  $log->trace($msg);
}

sub logt {
  my $msg = shift;

  my $log = _get_logger(shift);;
  return unless $log->is_trace;

  $log->trace($msg);
}

sub logd {
  my $msg = shift;

  my $log = _get_logger(shift);;
  return unless $log->is_debug;

  $msg = Dumper ($msg);
  $log->debug($msg);
}

sub logi {
  my $msg = shift;

  my $log = _get_logger(shift);;
  return unless $log->is_info;

  $log->info($msg);
}

sub logw {
  my $msg = shift;

  my $log = _get_logger(shift);;
  return unless $log->is_warn;

  $log->logwarn($msg);
}

sub loge {
  my $msg = shift;

  my $log = '';
  my $options = {};
  my $next_arg = shift;
  if (ref $next_arg) {
    my $options = shift;
  } else {
    $log = _get_logger($next_arg);;
  }

  return unless $log->is_error;

  $msg = sprintf("%-80s %s\n", $msg, [caller(0)]->[0] . ": line " . [caller(0)]->[2]);
  if ($options->{show_callers}) {
    $msg .= '        ' . _get_callers();
    chomp $msg;
    chomp $msg;
  }
  $log->error_warn($msg);
}

sub logf {
  my $msg = shift;

  my $log = '';
  my $options = {};
  my $next_arg = shift;
  if (ref $next_arg) {
    my $options = shift;
  } else {
    $log = _get_logger($next_arg);;
  }

  return unless $log->is_fatal;

  $msg = sprintf("%-80s %s\n", $msg, [caller(0)]->[0] . ": line " . [caller(0)]->[2]);
  if ($options->{show_callers}) {
    $msg .= '        ' . _get_callers();
    chomp $msg;
    chomp $msg;
  }

  $log->logdie($msg);
}
### Private methods ###
sub _get_logger {
  my $category = shift || '';
  my $logger = Log::Log4perl->get_logger((caller(1))[0] . ($category ? '.' . $category : '') );
  $logger->level($log_level);
  return $logger;
}



sub _get_callers {
  my @callers = ();
  my $has_sub = 1;
  foreach (my $depth = 2; $has_sub; $depth++) {
    my $caller = [caller($depth)]->[3] . ': ';
    $has_sub = [caller($depth + 1)]->[3];
    $caller .= $has_sub ? [caller($depth)]->[2] : 'main ' . [caller($depth)]->[2];
    push @callers, $caller;
  }
  my $msg = join "\n        ", @callers;
  return $msg;

}

1; # Magic true value
# ABSTRACT: shortcut functions to make log4perl even easier

__END__