--- /dev/null
+-st
+-se
+-i=3
+-bar
+-ce
+-sot
+-sct
+-pt=2
+-sbt=2
+-bt=2
+-nolq
+-nasc
--- /dev/null
+Before submitting patches please run perltidy with the .perltidyrc included in
+this repository.
# ____ is because tags must have at least one export and we don't want to
# export anything but the levels selected
-sub ____ {}
+sub ____ { }
-exports (qw(____ set_logger with_logger ));
+exports(qw(____ set_logger with_logger ));
export_tag dlog => ('____');
export_tag log => ('____');
our $Router_Instance ||= do {
require Log::Contextual::Router;
Log::Contextual::Router->new
- }
+ }
}
-sub arg_logger { $_[1] }
-sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
+sub arg_logger { $_[1] }
+sub arg_levels { $_[1] || [qw(debug trace warn info error fatal)] }
sub arg_package_logger { $_[1] }
sub arg_default_logger { $_[1] }
sub before_import {
my ($class, $importer, $spec) = @_;
- my $router = $class->router;
- my $exports = $spec->exports;
- my %router_args = (exporter => $class, target => $importer, arguments => $spec->argument_info);
+ my $router = $class->router;
+ my $exports = $spec->exports;
+ my %router_args = (
+ exporter => $class,
+ target => $importer,
+ arguments => $spec->argument_info
+ );
die 'Log::Contextual does not have a default import list'
- if $spec->config->{default};
+ if $spec->config->{default};
$router->before_import(%router_args);
- $spec->add_export('&set_logger', sub {
- my $router = $class->router;
+ $spec->add_export(
+ '&set_logger',
+ sub {
+ my $router = $class->router;
- die ref($router) . " does not support set_logger()"
- unless $router->does('Log::Contextual::Role::Router::SetLogger');
+ die ref($router) . " does not support set_logger()"
+ unless $router->does('Log::Contextual::Role::Router::SetLogger');
- return $router->set_logger(@_);
- }) if $exports->{'&set_logger'};
+ return $router->set_logger(@_);
+ }) if $exports->{'&set_logger'};
- $spec->add_export('&with_logger', sub {
- my $router = $class->router;
+ $spec->add_export(
+ '&with_logger',
+ sub {
+ my $router = $class->router;
- die ref($router) . " does not support with_logger()"
- unless $router->does('Log::Contextual::Role::Router::WithLogger');
+ die ref($router) . " does not support with_logger()"
+ unless $router->does('Log::Contextual::Role::Router::WithLogger');
- return $router->with_logger(@_);
- }) if $exports->{'&with_logger'};
+ return $router->with_logger(@_);
+ }) if $exports->{'&with_logger'};
my @levels = @{$class->arg_levels($spec->config->{levels})};
for my $level (@levels) {
if ($spec->config->{log}) {
- $spec->add_export("&log_$level", sub (&@) {
- my ($code, @args) = @_;
- $router->handle_log_request(
- exporter => $class, caller_package => scalar(caller), caller_level => 1,
- message_level => $level, message_sub => $code, message_args => \@args,
- );
- return @args;
- });
- $spec->add_export("&logS_$level", sub (&@) {
- my ($code, @args) = @_;
- $router->handle_log_request(
- exporter => $class, caller_package => scalar(caller), caller_level => 1,
- message_level => $level, message_sub => $code, message_args => \@args,
- );
- return $args[0];
- });
+ $spec->add_export(
+ "&log_$level",
+ sub (&@) {
+ my ($code, @args) = @_;
+ $router->handle_log_request(
+ exporter => $class,
+ caller_package => scalar(caller),
+ caller_level => 1,
+ message_level => $level,
+ message_sub => $code,
+ message_args => \@args,
+ );
+ return @args;
+ });
+ $spec->add_export(
+ "&logS_$level",
+ sub (&@) {
+ my ($code, @args) = @_;
+ $router->handle_log_request(
+ exporter => $class,
+ caller_package => scalar(caller),
+ caller_level => 1,
+ message_level => $level,
+ message_sub => $code,
+ message_args => \@args,
+ );
+ return $args[0];
+ });
}
if ($spec->config->{dlog}) {
- $spec->add_export("&Dlog_$level", sub (&@) {
- my ($code, @args) = @_;
- my $wrapped = sub {
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- &$code;
- };
- $router->handle_log_request(
- exporter => $class, caller_package => scalar(caller), caller_level => 1,
- message_level => $level, message_sub => $wrapped, message_args => \@args,
- );
- return @args;
- });
- $spec->add_export("&DlogS_$level", sub (&$) {
- my ($code, $ref) = @_;
- my $wrapped = sub {
- local $_ = Data::Dumper::Concise::Dumper($_[0]);
- &$code;
- };
- $router->handle_log_request(
- exporter => $class, caller_package => scalar(caller), caller_level => 1,
- message_level => $level, message_sub => $wrapped, message_args => [ $ref ],
- );
- return $ref;
- });
+ $spec->add_export(
+ "&Dlog_$level",
+ sub (&@) {
+ my ($code, @args) = @_;
+ my $wrapped = sub {
+ local $_ = (@_ ? Data::Dumper::Concise::Dumper @_ : '()');
+ &$code;
+ };
+ $router->handle_log_request(
+ exporter => $class,
+ caller_package => scalar(caller),
+ caller_level => 1,
+ message_level => $level,
+ message_sub => $wrapped,
+ message_args => \@args,
+ );
+ return @args;
+ });
+ $spec->add_export(
+ "&DlogS_$level",
+ sub (&$) {
+ my ($code, $ref) = @_;
+ my $wrapped = sub {
+ local $_ = Data::Dumper::Concise::Dumper($_[0]);
+ &$code;
+ };
+ $router->handle_log_request(
+ exporter => $class,
+ caller_package => scalar(caller),
+ caller_level => 1,
+ message_level => $level,
+ message_sub => $wrapped,
+ message_args => [$ref],
+ );
+ return $ref;
+ });
}
}
}
sub after_import {
my ($class, $importer, $spec) = @_;
- my %router_args = (exporter => $class, target => $importer, arguments => $spec->argument_info);
+ my %router_args = (
+ exporter => $class,
+ target => $importer,
+ arguments => $spec->argument_info
+ );
$class->router->after_import(%router_args);
}
=head1 SYNOPSIS
package MyApp::Log::Router;
-
+
use Moo;
use Log::Contextual::SimpleLogger;
-
+
with 'Log::Contextual::Role::Router';
-
+
has logger => (is => 'lazy');
-
+
sub _build_logger {
return Log::Contextual::SimpleLogger->new({ levels_upto => 'debug' });
}
-
+
sub before_import {
my ($self, %export_info) = @_;
my $exporter = $export_info{exporter};
my $log_level_name = $message_info{message_level};
my $logger = $self->logger;
my $is_active = $logger->can("is_${log_level_name}");
-
+
return unless defined $is_active && $logger->$is_active;
my $log_message = $log_code_block->(@$args);
$logger->$log_level_name($log_message);
use Moo;
use MyApp::Log::Router;
-
+
extends 'Log::Contextual';
#This example router is a singleton
use strict;
use warnings;
use MyApp::Log::Contextual qw(:log);
-
+
log_info { "Hello there" };
=head1 DESCRIPTION
=item arguments
-This is a hash reference containing the configuration values that were provided for the import.
+This is a hash reference containing the configuration values that were provided for the import.
The key is the name of the configuration item that was specified without the leading hyphen ('-').
For instance if the logging API is imported as follows
=item message_args
This is an array reference that contains the arguments given to the message generating code block.
-When invoking the message generator it will almost certainly be expecting these argument values
+When invoking the message generator it will almost certainly be expecting these argument values
as well.
=back
use Scalar::Util 'blessed';
with 'Log::Contextual::Role::Router',
- 'Log::Contextual::Role::Router::SetLogger',
- 'Log::Contextual::Role::Router::WithLogger';
+ 'Log::Contextual::Role::Router::SetLogger',
+ 'Log::Contextual::Role::Router::WithLogger';
eval {
require Log::Log4perl;
};
has _default_logger => (
- is => 'ro',
- default => sub { {} },
+ is => 'ro',
+ default => sub { {} },
init_arg => undef,
);
has _package_logger => (
- is => 'ro',
- default => sub { {} },
+ is => 'ro',
+ default => sub { {} },
init_arg => undef,
);
has _get_logger => (
- is => 'ro',
- default => sub { {} },
+ is => 'ro',
+ default => sub { {} },
init_arg => undef,
);
sub after_import {
my ($self, %import_info) = @_;
my $exporter = $import_info{exporter};
- my $target = $import_info{target};
- my $config = $import_info{arguments};
+ my $target = $import_info{target};
+ my $config = $import_info{arguments};
if (my $l = $exporter->arg_logger($config->{logger})) {
$self->set_logger($l);
sub with_logger {
my $logger = $_[1];
- if(ref $logger ne 'CODE') {
+ if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ unless blessed($logger);
+ $logger = do {
+ my $l = $logger;
+ sub { $l }
+ }
}
local $_[0]->_get_logger->{l} = $logger;
$_[2]->();
sub set_logger {
my $logger = $_[1];
- if(ref $logger ne 'CODE') {
+ if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ unless blessed($logger);
+ $logger = do {
+ my $l = $logger;
+ sub { $l }
+ }
}
warn 'set_logger (or -logger) called more than once! This is a bad idea!'
- if $_[0]->_get_logger->{l};
+ if $_[0]->_get_logger->{l};
$_[0]->_get_logger->{l} = $logger;
}
sub _set_default_logger_for {
my $logger = $_[2];
- if(ref $logger ne 'CODE') {
+ if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ unless blessed($logger);
+ $logger = do {
+ my $l = $logger;
+ sub { $l }
+ }
}
$_[0]->_default_logger->{$_[1]} = $logger
}
sub _set_package_logger_for {
my $logger = $_[2];
- if(ref $logger ne 'CODE') {
+ if (ref $logger ne 'CODE') {
die 'logger was not a CodeRef or a logger object. Please try again.'
- unless blessed($logger);
- $logger = do { my $l = $logger; sub { $l } }
+ unless blessed($logger);
+ $logger = do {
+ my $l = $logger;
+ sub { $l }
+ }
}
$_[0]->_package_logger->{$_[1]} = $logger
}
sub get_loggers {
my ($self, %info) = @_;
- my $package = $info{caller_package};
+ my $package = $info{caller_package};
my $log_level = $info{message_level};
- my $logger = (
- $_[0]->_package_logger->{$package} ||
- $_[0]->_get_logger->{l} ||
- $_[0]->_default_logger->{$package} ||
- die q( no logger set! you can't try to log something without a logger! )
- );
+ my $logger =
+ ( $_[0]->_package_logger->{$package}
+ || $_[0]->_get_logger->{l}
+ || $_[0]->_default_logger->{$package}
+ || die
+ q( no logger set! you can't try to log something without a logger! ));
$info{caller_level}++;
$logger = $logger->($package, \%info);
- return $logger if $logger->${\"is_${log_level}"};
+ return $logger if $logger ->${\"is_${log_level}"};
return ();
}
sub handle_log_request {
my ($self, %message_info) = @_;
my $generator = $message_info{message_sub};
- my $args = $message_info{message_args};
+ my $args = $message_info{message_args};
my $log_level = $message_info{message_level};
$message_info{caller_level}++;
use warnings;
{
- for my $name (qw( trace debug info warn error fatal )) {
+ for my $name (qw( trace debug info warn error fatal )) {
- no strict 'refs';
+ no strict 'refs';
- *{$name} = sub {
- my $self = shift;
+ *{$name} = sub {
+ my $self = shift;
- $self->_log( $name, @_ )
- if ($self->{$name});
- };
+ $self->_log($name, @_)
+ if ($self->{$name});
+ };
- *{"is_$name"} = sub {
- my $self = shift;
- return $self->{$name};
- };
- }
+ *{"is_$name"} = sub {
+ my $self = shift;
+ return $self->{$name};
+ };
+ }
}
sub new {
- my ($class, $args) = @_;
- my $self = bless {}, $class;
-
- $self->{$_} = 1 for @{$args->{levels}};
- $self->{coderef} = $args->{coderef} || sub { print STDERR @_};
-
- if (my $upto = $args->{levels_upto}) {
-
- my @levels = (qw( trace debug info warn error fatal ));
- my $i = 0;
- for (@levels) {
- last if $upto eq $_;
- $i++
- }
- for ($i..$#levels) {
- $self->{$levels[$_]} = 1
- }
-
- }
- return $self;
+ my ($class, $args) = @_;
+ my $self = bless {}, $class;
+
+ $self->{$_} = 1 for @{$args->{levels}};
+ $self->{coderef} = $args->{coderef} || sub { print STDERR @_ };
+
+ if (my $upto = $args->{levels_upto}) {
+
+ my @levels = (qw( trace debug info warn error fatal ));
+ my $i = 0;
+ for (@levels) {
+ last if $upto eq $_;
+ $i++
+ }
+ for ($i .. $#levels) {
+ $self->{$levels[$_]} = 1
+ }
+
+ }
+ return $self;
}
sub _log {
- my $self = shift;
- my $level = shift;
- my $message = join( "\n", @_ );
- $message .= "\n" unless $message =~ /\n$/;
- $self->{coderef}->(sprintf( "[%s] %s", $level, $message ));
+ my $self = shift;
+ my $level = shift;
+ my $message = join("\n", @_);
+ $message .= "\n" unless $message =~ /\n$/;
+ $self->{coderef}->(sprintf("[%s] %s", $level, $message));
}
1;
use warnings;
{
- for my $name (qw( trace debug info warn error fatal )) {
+ for my $name (qw( trace debug info warn error fatal )) {
- no strict 'refs';
+ no strict 'refs';
- *{$name} = sub {
- my $self = shift;
+ *{$name} = sub {
+ my $self = shift;
- foreach my $logger (@{$self->{loggers}}) {
- $logger->$name(@_);
- }
- };
+ foreach my $logger (@{$self->{loggers}}) {
+ $logger->$name(@_);
+ }
+ };
- my $is_name = "is_${name}";
+ my $is_name = "is_${name}";
- *{$is_name} = sub {
- my $self = shift;
- foreach my $logger (@{$self->{loggers}}) {
- return 1 if $logger->$is_name(@_);
- }
- return 0;
- };
- }
+ *{$is_name} = sub {
+ my $self = shift;
+ foreach my $logger (@{$self->{loggers}}) {
+ return 1 if $logger->$is_name(@_);
+ }
+ return 0;
+ };
+ }
}
sub new {
- my ($class, $args) = @_;
- my $self = bless {}, $class;
+ my ($class, $args) = @_;
+ my $self = bless {}, $class;
- ref($self->{loggers} = $args->{loggers}) eq 'ARRAY'
- or die "No loggers passed to tee logger";
+ ref($self->{loggers} = $args->{loggers}) eq 'ARRAY'
+ or die "No loggers passed to tee logger";
- return $self;
+ return $self;
}
1;
my @default_levels = qw( trace debug info warn error fatal );
-
# generate subs to handle the default levels
# anything else will have to be handled by AUTOLOAD at runtime
{
- for my $level (@default_levels) {
+ for my $level (@default_levels) {
- no strict 'refs';
+ no strict 'refs';
- my $is_name = "is_$level";
- *{$level} = sub {
- my $self = shift;
+ my $is_name = "is_$level";
+ *{$level} = sub {
+ my $self = shift;
- $self->_log( $level, @_ )
- if $self->$is_name;
- };
+ $self->_log($level, @_)
+ if $self->$is_name;
+ };
- *{$is_name} = sub {
- my $self = shift;
- return 1 if $ENV{$self->{env_prefix} . '_' . uc $level};
- my $upto = $ENV{$self->{env_prefix} . '_UPTO'};
- return unless $upto;
- $upto = lc $upto;
-
- return $self->{level_num}{$level} >= $self->{level_num}{$upto};
- };
- }
+ *{$is_name} = sub {
+ my $self = shift;
+ return 1 if $ENV{$self->{env_prefix} . '_' . uc $level};
+ my $upto = $ENV{$self->{env_prefix} . '_UPTO'};
+ return unless $upto;
+ $upto = lc $upto;
+
+ return $self->{level_num}{$level} >= $self->{level_num}{$upto};
+ };
+ }
}
our $AUTOLOAD;
+
sub AUTOLOAD {
- my $self = $_[0];
+ my $self = $_[0];
- (my $name = our $AUTOLOAD) =~ s/.*:://;
- return if $name eq 'DESTROY';
+ (my $name = our $AUTOLOAD) =~ s/.*:://;
+ return if $name eq 'DESTROY';
- # extract the log level from the sub name
- my ($is, $level) = $name =~ m/^(is_)?(.+)$/;
- my $is_name = "is_$level";
+ # extract the log level from the sub name
+ my ($is, $level) = $name =~ m/^(is_)?(.+)$/;
+ my $is_name = "is_$level";
- no strict 'refs';
- *{$level} = sub {
- my $self = shift;
+ no strict 'refs';
+ *{$level} = sub {
+ my $self = shift;
- $self->_log( $level, @_ )
- if $self->$is_name;
- };
+ $self->_log($level, @_)
+ if $self->$is_name;
+ };
- *{$is_name} = sub {
- my $self = shift;
+ *{$is_name} = sub {
+ my $self = shift;
- my $prefix_field = $self->{env_prefix} . '_' . uc $level;
- return 1 if $ENV{$prefix_field};
+ my $prefix_field = $self->{env_prefix} . '_' . uc $level;
+ return 1 if $ENV{$prefix_field};
- # don't log if the variable specifically says not to
- return 0 if defined $ENV{$prefix_field} and not $ENV{$prefix_field};
+ # don't log if the variable specifically says not to
+ return 0 if defined $ENV{$prefix_field} and not $ENV{$prefix_field};
- my $upto_field = $self->{env_prefix} . '_UPTO';
- my $upto = $ENV{$upto_field};
+ my $upto_field = $self->{env_prefix} . '_UPTO';
+ my $upto = $ENV{$upto_field};
- if ($upto) {
- $upto = lc $upto;
+ if ($upto) {
+ $upto = lc $upto;
- croak "Unrecognized log level '$upto' in \$ENV{$upto_field}"
- if not defined $self->{level_num}{$upto};
+ croak "Unrecognized log level '$upto' in \$ENV{$upto_field}"
+ if not defined $self->{level_num}{$upto};
- return $self->{level_num}{$level} >= $self->{level_num}{$upto};
- }
+ return $self->{level_num}{$level} >= $self->{level_num}{$upto};
+ }
- # if we don't recognize this level and nothing says otherwise, log!
- return 1 if not $self->{custom_levels};
- };
- goto &$AUTOLOAD;
+ # if we don't recognize this level and nothing says otherwise, log!
+ return 1 if not $self->{custom_levels};
+ };
+ goto &$AUTOLOAD;
}
sub new {
- my ($class, $args) = @_;
+ my ($class, $args) = @_;
- my $levels = $args->{levels};
- croak 'invalid levels specification: must be non-empty arrayref'
- if defined $levels and (ref $levels ne 'ARRAY' or !@$levels);
+ my $levels = $args->{levels};
+ croak 'invalid levels specification: must be non-empty arrayref'
+ if defined $levels and (ref $levels ne 'ARRAY' or !@$levels);
- my $custom_levels = defined $levels;
- $levels ||= [ @default_levels ];
+ my $custom_levels = defined $levels;
+ $levels ||= [@default_levels];
- my %level_num; @level_num{ @$levels } = (0 .. $#{$levels});
+ my %level_num;
+ @level_num{@$levels} = (0 .. $#{$levels});
- my $self = bless {
- levels => $levels,
- level_num => \%level_num,
- custom_levels => $custom_levels,
- }, $class;
+ my $self = bless {
+ levels => $levels,
+ level_num => \%level_num,
+ custom_levels => $custom_levels,
+ }, $class;
- $self->{env_prefix} = $args->{env_prefix} or
- die 'no env_prefix passed to Log::Contextual::WarnLogger->new';
- return $self;
+ $self->{env_prefix} = $args->{env_prefix}
+ or die 'no env_prefix passed to Log::Contextual::WarnLogger->new';
+ return $self;
}
sub _log {
- my $self = shift;
- my $level = shift;
- my $message = join( "\n", @_ );
- $message .= "\n" unless $message =~ /\n$/;
- warn "[$level] $message";
+ my $self = shift;
+ my $level = shift;
+ my $message = join("\n", @_);
+ $message .= "\n" unless $message =~ /\n$/;
+ warn "[$level] $message";
}
1;
BEGIN {
$var_log = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var = shift }
- })
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var = shift }
+ })
}
use Log::Contextual qw{ :log :dlog}, -logger => $var_log;
my @args = qw(fizz buzz fizzbuzz);
for my $level (@levels) {
- for my $prefix (qw(log logS Dlog DlogS)) {
+ for my $prefix (qw(log logS Dlog DlogS)) {
- my $original = local $_ = "don't tread on me";
- my $method_name = "${prefix}_${level}";
- my $ref = __PACKAGE__->can($method_name) or die "no ref found for method $method_name";
+ my $original = local $_ = "don't tread on me";
+ my $method_name = "${prefix}_${level}";
+ my $ref = __PACKAGE__->can($method_name)
+ or die "no ref found for method $method_name";
- $ref->(sub { "$method_name" }, @args);
- ok($_ eq $original, "\$_ was not disturbed by $method_name");
- ok($var eq "[$level] $method_name\n", "log argument was correct");
- }
+ $ref->(sub { "$method_name" }, @args);
+ ok($_ eq $original, "\$_ was not disturbed by $method_name");
+ ok($var eq "[$level] $method_name\n", "log argument was correct");
+ }
}
VANILLA: {
for (@levels) {
main->can("log_$_")->(sub { 'fiSMBoC' });
- is( $DumbLogger2::var, "[$_] fiSMBoC\n", "$_ works");
+ is($DumbLogger2::var, "[$_] fiSMBoC\n", "$_ works");
- my @vars = main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz});
- is( $DumbLogger2::var, "[$_] fiSMBoC: bar\n", "log_$_ works with input");
- ok( eq_array(\@vars, [qw{foo bar baz}]), "log_$_ passes data through correctly");
+ my @vars =
+ main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz});
+ is($DumbLogger2::var, "[$_] fiSMBoC: bar\n", "log_$_ works with input");
+ ok(
+ eq_array(\@vars, [qw{foo bar baz}]),
+ "log_$_ passes data through correctly"
+ );
my $val = main->can("logS_$_")->(sub { 'fiSMBoC: ' . $_[0] }, 'foo');
- is( $DumbLogger2::var, "[$_] fiSMBoC: foo\n", "logS_$_ works with input");
- is( $val, 'foo', "logS_$_ passes data through correctly");
+ is($DumbLogger2::var, "[$_] fiSMBoC: foo\n", "logS_$_ works with input");
+ is($val, 'foo', "logS_$_ passes data through correctly");
}
}
ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies');
-
my $var;
my @caller_info;
my $var_log = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { chomp($_[0]); $var = "$_[0] at $caller_info[1] line $caller_info[2].\n" }
-});
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub {
+ chomp($_[0]);
+ $var = "$_[0] at $caller_info[1] line $caller_info[2].\n"
+ }
+ });
my $warn_faker = sub {
my ($package, $args) = @_;
@caller_info = caller($args->{caller_level});
set_logger($warn_faker);
log_debug { 'test log_debug' };
-is($var, "[debug] test log_debug at " . __FILE__ . " line " . (__LINE__-1) . ".\n", 'fake warn');
+is($var,
+ "[debug] test log_debug at " . __FILE__ . " line " . (__LINE__- 2) . ".\n",
+ 'fake warn');
logS_debug { 'test logS_debug' };
-is($var, "[debug] test logS_debug at " . __FILE__ . " line " . (__LINE__-1) . ".\n", 'fake warn');
+is(
+ $var,
+ "[debug] test logS_debug at " . __FILE__ . " line " . (__LINE__- 3) . ".\n",
+ 'fake warn'
+);
logS_debug { 'test Dlog_debug' };
-is($var, "[debug] test Dlog_debug at " . __FILE__ . " line " . (__LINE__-1) . ".\n", 'fake warn');
+is(
+ $var,
+ "[debug] test Dlog_debug at " . __FILE__ . " line " . (__LINE__- 3) . ".\n",
+ 'fake warn'
+);
logS_debug { 'test DlogS_debug' };
-is($var, "[debug] test DlogS_debug at " . __FILE__ . " line " . (__LINE__-1) . ".\n", 'fake warn');
+is(
+ $var,
+ "[debug] test DlogS_debug at " . __FILE__ . " line " . (__LINE__- 3) . ".\n",
+ 'fake warn'
+);
my $var2;
my $var3;
my $var_logger1 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var1 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var1 = shift },
});
my $var_logger2;
+
BEGIN {
$var_logger2 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var2 = shift },
- })
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var2 = shift },
+ })
}
my $var_logger3;
+
BEGIN {
$var_logger3 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var3 = shift },
- })
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var3 = shift },
+ })
}
{
+
package J;
- use Log::Contextual qw{:dlog :log with_logger set_logger}, -default_logger => $var_logger3;
+ use Log::Contextual qw{:dlog :log with_logger set_logger},
+ -default_logger => $var_logger3;
sub foo {
log_debug { 'bar' };
}
+
sub bar {
Dlog_debug { "bar: $_" } 'frew';
}
}
{
+
package K;
- use Log::Contextual qw{:log with_logger set_logger}, -default_logger => $var_logger2;
+ use Log::Contextual qw{:log with_logger set_logger},
+ -default_logger => $var_logger2;
sub foo {
log_debug { 'foo' };
set_logger($var_logger1);
K::foo;
-is($var2, q(), '... but set_logger wins');
+is($var2, q(), '... but set_logger wins');
is($var1, "[debug] foo\n", '... and gets the value');
BEGIN {
$var_log = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var = shift }
- })
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var = shift }
+ })
}
use Log::Contextual qw{:dlog}, -logger => $var_log;
for my $level (@levels) {
- my @foo = main->can("Dlog_$level")->(
- sub { "Look ma, data: $_" },
- qw{frew bar baz}
- );
+ my @foo =
+ main->can("Dlog_$level")->(sub { "Look ma, data: $_" }, qw{frew bar baz});
ok(
eq_array(\@foo, [qw{frew bar baz}]),
"Dlog_$level passes data through correctly"
);
is(
- $var, qq([$level] Look ma, data: "frew"\n"bar"\n"baz"\n),
+ $var,
+ qq([$level] Look ma, data: "frew"\n"bar"\n"baz"\n),
"Output for Dlog_$level is correct"
);
- my $bar = main->can("DlogS_$level")->(
- sub { "Look ma, data: $_" },
- [qw{frew bar baz}]
- );
+ my $bar =
+ main->can("DlogS_$level")
+ ->(sub { "Look ma, data: $_" }, [qw{frew bar baz}]);
ok(
eq_array($bar, [qw{frew bar baz}]),
'DlogS_trace passes data through correctly'
);
is(
- $var, qq([$level] Look ma, data: [\n "frew",\n "bar",\n "baz"\n]\n),
+ $var,
+ qq([$level] Look ma, data: [\n "frew",\n "bar",\n "baz"\n]\n),
"Output for DlogS_$level is correct"
);
@foo = main->can("Dlog_$level")->(sub { "nothing: $_" }, ());
- ok( eq_array(\@foo, []), "Dlog_$level passes nothing through correctly");
- is( $var, "[$level] nothing: ()\n", "Output for Dlog_$level is correct");
+ ok(eq_array(\@foo, []), "Dlog_$level passes nothing through correctly");
+ is($var, "[$level] nothing: ()\n", "Output for Dlog_$level is correct");
}
use Test::More qw(no_plan);
use Log::Contextual qw(:log set_logger);
-my ($var1,$var2,$var3);
+my ($var1, $var2, $var3);
my $complex_dispatcher = do {
my $l1 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var1 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var1 = shift },
});
my $l2 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var2 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var2 = shift },
});
my $l3 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var3 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var3 = shift },
});
my %registry = (
-logger => $l3,
- A1 => {
+ A1 => {
-logger => $l1,
lol => $l2,
},
- A2 => { -logger => $l2 },
+ A2 => {-logger => $l2},
);
sub {
- my ( $package, $info ) = @_;
+ my ($package, $info) = @_;
my $logger = $registry{'-logger'};
if (my $r = $registry{$package}) {
$logger = $r->{$sub} if $r->{$sub};
}
return $logger;
- }
+ }
};
set_logger $complex_dispatcher;
is($var3, "[debug] 2.var3\n", "global default logger works");
BEGIN {
+
package A1;
use Log::Contextual ':log';
- sub lol { log_debug { '1.var2' } }
- sub rofl { log_debug { '1.var1' } }
+ sub lol {
+ log_debug { '1.var2' }
+ }
+
+ sub rofl {
+ log_debug { '1.var1' }
+ }
package A2;
use Log::Contextual ':log';
- sub foo { log_debug { '2.var2' } }
+ sub foo {
+ log_debug { '2.var2' }
+ }
package A3;
use Log::Contextual ':log';
- sub squint { log_debug { '2.var3' } }
+ sub squint {
+ log_debug { '2.var3' }
+ }
}
sub arg_levels { $_[1] || [qw(lol wut zomg)] }
sub arg_logger { $_[1] || $logger }
+
sub router {
our $Router_Instance ||= do {
require Log::Contextual::Router;
Log::Contextual::Router->new
- }
+ }
}
-
package DumbLogger2;
our $var;
sub new { bless {}, 'DumbLogger2' }
-sub is_wut { 1 }
-sub wut { $var = "[wut] $_[1]\n" }
-sub is_lol { 1 }
-sub lol { $var = "[lol] $_[1]\n" }
+sub is_wut { 1 }
+sub wut { $var = "[wut] $_[1]\n" }
+sub is_lol { 1 }
+sub lol { $var = "[lol] $_[1]\n" }
sub is_zomg { 1 }
-sub zomg { $var = "[zomg] $_[1]\n" }
+sub zomg { $var = "[zomg] $_[1]\n" }
1;
our $Router ||= TestRouter->new
}
-1;
\ No newline at end of file
+1;
$self->captured->{message} = \%message_info;
}
-1;
\ No newline at end of file
+1;
use strict;
use warnings;
-use Log::Contextual qw{:dlog :log with_logger set_logger}, -levels => ['custom'];
+use Log::Contextual qw{:dlog :log with_logger set_logger},
+ -levels => ['custom'];
use Log::Contextual::SimpleLogger;
use Test::More qw(no_plan);
set_logger(sub { $logger });
log_custom { 'fiSMBoC' };
-is( $DumbLogger::var, "fiSMBoC", "custom works");
+is($DumbLogger::var, "fiSMBoC", "custom works");
my @vars = log_custom { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
-is( $DumbLogger::var, "fiSMBoC: bar", "log_custom works with input");
-ok( eq_array(\@vars, [qw{foo bar baz}]), "log_custom passes data through correctly");
+is($DumbLogger::var, "fiSMBoC: bar", "log_custom works with input");
+ok(
+ eq_array(\@vars, [qw{foo bar baz}]),
+ "log_custom passes data through correctly"
+);
my $val = logS_custom { 'fiSMBoC: ' . $_[0] } 'foo';
-is( $DumbLogger::var, "fiSMBoC: foo", "logS_custom works with input");
-is( $val, 'foo', "logS_custom passes data through correctly");
+is($DumbLogger::var, "fiSMBoC: foo", "logS_custom works with input");
+is($val, 'foo', "logS_custom passes data through correctly");
my @foo = Dlog_custom { "Look ma, data: $_" } qw{frew bar baz};
"Dlog_custom passes data through correctly"
);
is(
- $DumbLogger::var, qq(Look ma, data: "frew"\n"bar"\n"baz"\n),
+ $DumbLogger::var,
+ qq(Look ma, data: "frew"\n"bar"\n"baz"\n),
"Output for Dlog_custom is correct"
);
-my $bar = DlogS_custom { "Look ma, data: $_" } [qw{frew bar baz}];
-ok(
- eq_array($bar, [qw{frew bar baz}]),
- 'DlogS_custom passes data through correctly'
-);
+my $bar = DlogS_custom { "Look ma, data: $_" }[qw{frew bar baz}];
+ok(eq_array($bar, [qw{frew bar baz}]),
+ 'DlogS_custom passes data through correctly');
is(
- $DumbLogger::var, qq(Look ma, data: [\n "frew",\n "bar",\n "baz"\n]\n),
+ $DumbLogger::var,
+ qq(Look ma, data: [\n "frew",\n "bar",\n "baz"\n]\n),
"Output for DlogS_custom is correct"
);
@foo = Dlog_custom { "nothing: $_" } ();
-ok( eq_array(\@foo, []), "Dlog_custom passes nothing through correctly");
-is( $DumbLogger::var, "nothing: ()", "Output for Dlog_custom is correct");
+ok(eq_array(\@foo, []), "Dlog_custom passes nothing through correctly");
+is($DumbLogger::var, "nothing: ()", "Output for Dlog_custom is correct");
ok(!main->can($_), "$_ not imported")
- for map +( "log_$_", "logS_$_" ), qw(debug trace warn info error fatal);
+ for map +("log_$_", "logS_$_"), qw(debug trace warn info error fatal);
ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies');
BEGIN {
+
package DumbLogger;
our $var;
my $var2;
my $var3;
my $var_logger1 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var1 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var1 = shift },
});
my $var_logger2 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var2 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var2 = shift },
});
my $var_logger3 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var3 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var3 = shift },
});
SETLOGGER: {
set_logger(sub { $var_logger3 });
log_debug { 'set_logger' };
- is( $var3, "[debug] set_logger\n", 'set logger works' );
+ is($var3, "[debug] set_logger\n", 'set logger works');
}
SETLOGGERTWICE: {
local $SIG{__WARN__} = sub { $foo = shift };
set_logger(sub { $var_logger3 });
like(
- $foo, qr/set_logger \(or -logger\) called more than once! This is a bad idea! at/,
+ $foo,
+ qr/set_logger \(or -logger\) called more than once! This is a bad idea! at/,
'set_logger twice warns correctly'
);
}
};
- is( $var1, "[debug] nothing!\n", 'inner scoped logger works' );
- is( $var2, "[debug] frew!\n", 'outer scoped logger works' );
+ is($var1, "[debug] nothing!\n", 'inner scoped logger works');
+ is($var2, "[debug] frew!\n", 'outer scoped logger works');
}
SETWITHLOGGER: {
with_logger $var_logger1 => sub {
log_debug { 'nothing again!' };
+
# do this just so the following set_logger won't warn
- local $SIG{__WARN__} = sub {};
+ local $SIG{__WARN__} = sub { };
set_logger(sub { $var_logger3 });
log_debug { 'this is a set inside a with' };
};
- is( $var1, "[debug] nothing again!\n",
+ is(
+ $var1,
+ "[debug] nothing again!\n",
'inner scoped logger works after using set_logger'
);
- is( $var3, "[debug] this is a set inside a with\n",
- 'set inside with works'
- );
+ is($var3, "[debug] this is a set inside a with\n", 'set inside with works');
log_debug { 'frioux!' };
- is( $var3, "[debug] frioux!\n",
+ is(
+ $var3,
+ "[debug] frioux!\n",
q{set_logger's logger comes back after scoped logger}
);
}
VANILLA: {
for (@levels) {
main->can("log_$_")->(sub { 'fiSMBoC' });
- is( $var3, "[$_] fiSMBoC\n", "$_ works");
+ is($var3, "[$_] fiSMBoC\n", "$_ works");
- my @vars = main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz});
- is( $var3, "[$_] fiSMBoC: bar\n", "log_$_ works with input");
- ok( eq_array(\@vars, [qw{foo bar baz}]), "log_$_ passes data through correctly");
+ my @vars =
+ main->can("log_$_")->(sub { 'fiSMBoC: ' . $_[1] }, qw{foo bar baz});
+ is($var3, "[$_] fiSMBoC: bar\n", "log_$_ works with input");
+ ok(
+ eq_array(\@vars, [qw{foo bar baz}]),
+ "log_$_ passes data through correctly"
+ );
my $val = main->can("logS_$_")->(sub { 'fiSMBoC: ' . $_[0] }, 'foo');
- is( $var3, "[$_] fiSMBoC: foo\n", "logS_$_ works with input");
- is( $val, 'foo', "logS_$_ passes data through correctly");
+ is($var3, "[$_] fiSMBoC: foo\n", "logS_$_ works with input");
+ is($val, 'foo', "logS_$_ passes data through correctly");
}
}
use Test::More;
-if (eval <<'EOE'
+if (
+ eval <<'EOE'
require Log::Log4perl;
die if $Log::Log4perl::VERSION < 1.29;
1
EOE
-) {
+ ) {
plan tests => 2;
} else {
plan skip_all => 'Log::Log4perl 1.29 not installed'
my @datas = <$log>;
close $log;
-is $datas[0], "file:t/log4perl.t line:$elines[0] method:main:: - err FIRST\n", 'file and line work with Log4perl';
-is $datas[1], "file:t/log4perl.t line:$elines[1] method:main::foo - err SECOND\n", 'file and line work with Log4perl in a sub';
+is $datas[0], "file:t/log4perl.t line:$elines[0] method:main:: - err FIRST\n",
+ 'file and line work with Log4perl';
+is $datas[1],
+ "file:t/log4perl.t line:$elines[1] method:main::foo - err SECOND\n",
+ 'file and line work with Log4perl in a sub';
unlink 'myerrs.log';
my $var2;
my $var3;
my $var_logger1 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var1 = shift },
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var1 = shift },
});
my $var_logger2;
+
BEGIN {
$var_logger2 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var2 = shift },
- })
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var2 = shift },
+ })
}
my $var_logger3;
+
BEGIN {
$var_logger3 = Log::Contextual::SimpleLogger->new({
- levels => [qw(trace debug info warn error fatal)],
- coderef => sub { $var3 = shift },
- })
+ levels => [qw(trace debug info warn error fatal)],
+ coderef => sub { $var3 = shift },
+ })
}
{
+
package J;
- use Log::Contextual qw{:dlog :log with_logger set_logger}, -package_logger => $var_logger3;
+ use Log::Contextual qw{:dlog :log with_logger set_logger},
+ -package_logger => $var_logger3;
sub foo {
log_debug { 'bar' };
}
+
sub bar {
Dlog_debug { "bar: $_" } 'frew';
}
}
{
+
package K;
- use Log::Contextual qw{:log with_logger set_logger}, -package_logger => $var_logger2;
+ use Log::Contextual qw{:log with_logger set_logger},
+ -package_logger => $var_logger2;
sub foo {
log_debug { 'foo' };
set_logger($var_logger1);
K::foo;
-is($var1, q(), '... and set_logger does not win');
+is($var1, q(), '... and set_logger does not win');
is($var2, "[debug] foo\n", '... and package_logger still gets the value');
use Test::More;
use lib 't/lib';
-use TestExporter qw(:log), -logger => 'logger value', -default_logger => 'default logger value',
- -package_logger => 'package logger value';
+use TestExporter qw(:log),
+ -logger => 'logger value',
+ -default_logger => 'default logger value',
+ -package_logger => 'package logger value';
my @test_args = qw( some argument values );
log_info { "Ignored value" } @test_args;
-my $results = TestExporter->router->captured;
+my $results = TestExporter->router->captured;
my %export_info = (
- exporter => 'TestExporter', target => 'main', arguments => {
- logger => 'logger value', default_logger => 'default logger value',
+ exporter => 'TestExporter',
+ target => 'main',
+ arguments => {
+ logger => 'logger value',
+ default_logger => 'default logger value',
package_logger => 'package logger value'
},
);
my %message_info = (
- exporter => 'TestExporter', caller_package => 'main', caller_level => 1,
- message_level => 'info', message_args => \@test_args,
+ exporter => 'TestExporter',
+ caller_package => 'main',
+ caller_level => 1,
+ message_level => 'info',
+ message_args => \@test_args,
);
-is_deeply($results->{before_import}, \%export_info, 'before_import() values are correct');
-is_deeply($results->{after_import}, \%export_info, 'after_import() values are correct');
+is_deeply($results->{before_import},
+ \%export_info, 'before_import() values are correct');
+is_deeply($results->{after_import},
+ \%export_info, 'after_import() values are correct');
#can't really compare the sub ref value so make sure it exists and is the right type
#and remove it for the later result check
my $message_block = delete $results->{message}->{message_sub};
-is(ref $message_block, 'CODE', 'handle_log_request() got a sub ref for the message generator');
-is_deeply($results->{message}, \%message_info, 'handle_log_request() other values are correct');
+is(ref $message_block,
+ 'CODE', 'handle_log_request() got a sub ref for the message generator');
+is_deeply($results->{message}, \%message_info,
+ 'handle_log_request() other values are correct');
-done_testing;
\ No newline at end of file
+done_testing;
use File::Temp;
use Log::Contextual::SimpleLogger;
use Log::Contextual qw{:log set_logger} => -logger =>
- Log::Contextual::SimpleLogger->new({levels => [qw{debug}]});
+ Log::Contextual::SimpleLogger->new({levels => [qw{debug}]});
use Test::More qw(no_plan);
my $l = Log::Contextual::SimpleLogger->new({levels => [qw{debug}]});
ok(!$l->is_trace, 'is_trace is false on SimpleLogger');
-ok($l->is_debug, 'is_debug is true on SimpleLogger');
-ok(!$l->is_info, 'is_info is false on SimpleLogger');
-ok(!$l->is_warn, 'is_warn is false on SimpleLogger');
+ok($l->is_debug, 'is_debug is true on SimpleLogger');
+ok(!$l->is_info, 'is_info is false on SimpleLogger');
+ok(!$l->is_warn, 'is_warn is false on SimpleLogger');
ok(!$l->is_error, 'is_error is false on SimpleLogger');
ok(!$l->is_fatal, 'is_fatal is false on SimpleLogger');
-ok(eval { log_trace { die 'this should live' }; 1}, 'trace does not get called');
-ok(!eval { log_debug { die 'this should die' }; 1}, 'debug gets called');
-ok(eval { log_info { die 'this should live' }; 1}, 'info does not get called');
-ok(eval { log_warn { die 'this should live' }; 1}, 'warn does not get called');
-ok(eval { log_error { die 'this should live' }; 1}, 'error does not get called');
-ok(eval { log_fatal { die 'this should live' }; 1}, 'fatal does not get called');
+ok(
+ eval {
+ log_trace { die 'this should live' };
+ 1
+ },
+ 'trace does not get called'
+);
+ok(
+ !eval {
+ log_debug { die 'this should die' };
+ 1
+ },
+ 'debug gets called'
+);
+ok(
+ eval {
+ log_info { die 'this should live' };
+ 1
+ },
+ 'info does not get called'
+);
+ok(
+ eval {
+ log_warn { die 'this should live' };
+ 1
+ },
+ 'warn does not get called'
+);
+ok(
+ eval {
+ log_error { die 'this should live' };
+ 1
+ },
+ 'error does not get called'
+);
+ok(
+ eval {
+ log_fatal { die 'this should live' };
+ 1
+ },
+ 'fatal does not get called'
+);
{
- my $tempfile = File::Temp->new (UNLINK => 1, TEMPLATE => 'stderrXXXXXX');
- my $fn = fileno ($tempfile);
- open (STDERR, ">&$fn") or die $!;
- log_debug { 'frew' };
+ my $tempfile = File::Temp->new(UNLINK => 1, TEMPLATE => 'stderrXXXXXX');
+ my $fn = fileno($tempfile);
+ open(STDERR, ">&$fn") or die $!;
+ log_debug { 'frew' };
- my $out = do { local @ARGV = $tempfile; <> };
- is($out, "[debug] frew\n", 'SimpleLogger outputs to STDERR correctly');
+ my $out = do { local @ARGV = $tempfile; <> };
+ is($out, "[debug] frew\n", 'SimpleLogger outputs to STDERR correctly');
}
-
my $response;
my $l2 = Log::Contextual::SimpleLogger->new({
- levels => [qw{trace debug info warn error fatal}],
- coderef => sub { $response = $_[0] },
+ levels => [qw{trace debug info warn error fatal}],
+ coderef => sub { $response = $_[0] },
});
{
- local $SIG{__WARN__} = sub {}; # do this just to hide warning for tests
+ local $SIG{__WARN__} = sub { }; # do this just to hide warning for tests
set_logger($l2);
}
log_trace { 'trace' };
is($response, "[trace] trace\n", 'trace renders correctly');
log_debug { 'debug' };
is($response, "[debug] debug\n", 'debug renders correctly');
-log_info { 'info' };
+log_info { 'info' };
is($response, "[info] info\n", 'info renders correctly');
-log_warn { 'warn' };
+log_warn { 'warn' };
is($response, "[warn] warn\n", 'warn renders correctly');
log_error { 'error' };
is($response, "[error] error\n", 'error renders correctly');
log_fatal { 'fatal' };
is($response, "[fatal] fatal\n", 'fatal renders correctly');
-log_debug { 'line 1', 'line 2' };
+log_debug {'line 1', 'line 2'};
is($response, "[debug] line 1\nline 2\n", 'multiline log renders correctly');
my $u = Log::Contextual::SimpleLogger->new({levels_upto => 'debug'});
ok(!$u->is_trace, 'is_trace is false on SimpleLogger');
-ok($u->is_debug, 'is_debug is true on SimpleLogger');
-ok($u->is_info, 'is_info is true on SimpleLogger');
-ok($u->is_warn, 'is_warn is true on SimpleLogger');
-ok($u->is_error, 'is_error is true on SimpleLogger');
-ok($u->is_fatal, 'is_fatal is true on SimpleLogger');
+ok($u->is_debug, 'is_debug is true on SimpleLogger');
+ok($u->is_info, 'is_info is true on SimpleLogger');
+ok($u->is_warn, 'is_warn is true on SimpleLogger');
+ok($u->is_error, 'is_error is true on SimpleLogger');
+ok($u->is_fatal, 'is_fatal is true on SimpleLogger');
use strict;
use warnings;
-use Log::Contextual::WarnLogger; # -levels => [qw(custom1 custom2)];
+use Log::Contextual::WarnLogger; # -levels => [qw(custom1 custom2)];
use Log::Contextual qw{:log set_logger} => -logger =>
- Log::Contextual::WarnLogger->new({ env_prefix => 'FOO' });
+ Log::Contextual::WarnLogger->new({env_prefix => 'FOO'});
use Test::More qw(no_plan);
use Test::Fatal;
{
- my $l;
- like(
- exception { $l = Log::Contextual::WarnLogger->new({ levels => '' }) },
- qr/invalid levels specification: must be non-empty arrayref/,
- 'cannot pass empty string for levels',
- );
-
- like(
- exception { $l = Log::Contextual::WarnLogger->new({ levels => [] }) },
- qr/invalid levels specification: must be non-empty arrayref/,
- 'cannot pass empty list for levels',
- );
-
- is(
- exception { $l = Log::Contextual::WarnLogger->new({ levels => undef, env_prefix => 'FOO' }) },
- undef,
- 'ok to leave levels undefined',
- );
+ my $l;
+ like(
+ exception { $l = Log::Contextual::WarnLogger->new({levels => ''}) },
+ qr/invalid levels specification: must be non-empty arrayref/,
+ 'cannot pass empty string for levels',
+ );
+
+ like(
+ exception { $l = Log::Contextual::WarnLogger->new({levels => []}) },
+ qr/invalid levels specification: must be non-empty arrayref/,
+ 'cannot pass empty list for levels',
+ );
+
+ is(
+ exception {
+ $l = Log::Contextual::WarnLogger->new(
+ {levels => undef, env_prefix => 'FOO'})
+ },
+ undef,
+ 'ok to leave levels undefined',
+ );
}
-
{
- my $l = Log::Contextual::WarnLogger->new({
- env_prefix => 'BAR',
- levels => [qw(custom1 custom2)]
- });
-
- foreach my $sub (qw(is_custom1 is_custom2 custom1 custom2))
- {
- is(
- exception { $l->$sub },
- undef,
- $sub . ' is handled by AUTOLOAD',
- );
- }
-
- foreach my $sub (qw(is_foo foo))
- {
- is(
- exception { $l->$sub },
- undef,
- 'arbitrary sub ' . $sub . ' is handled by AUTOLOAD',
- );
- }
+ my $l = Log::Contextual::WarnLogger->new({
+ env_prefix => 'BAR',
+ levels => [qw(custom1 custom2)]});
+
+ foreach my $sub (qw(is_custom1 is_custom2 custom1 custom2)) {
+ is(exception { $l->$sub }, undef, $sub . ' is handled by AUTOLOAD',);
+ }
+
+ foreach my $sub (qw(is_foo foo)) {
+ is(
+ exception { $l->$sub },
+ undef, 'arbitrary sub ' . $sub . ' is handled by AUTOLOAD',
+ );
+ }
}
{
- # levels is optional - most things should still work otherwise.
- my $l = Log::Contextual::WarnLogger->new({
- env_prefix => 'BAR',
- });
-
- # if we don't know the level, and there are no environment variables set,
- # just log everything.
- {
- ok($l->is_custom1, 'is_custom1 defaults to true on WarnLogger');
- ok($l->is_custom2, 'is_custom2 defaults to true on WarnLogger');
- }
-
- # otherwise, go with what the variable says.
- {
- local $ENV{BAR_CUSTOM1} = 0;
- local $ENV{BAR_CUSTOM2} = 1;
- ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
- ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
-
- ok($l->is_foo, 'is_foo defaults to true on WarnLogger');
-
- local $ENV{BAR_UPTO} = 'foo';
- like(
- exception { $l->is_bar },
- qr/Unrecognized log level 'foo' in \$ENV{BAR_UPTO}/,
- 'Cannot use an unrecognized log level in UPTO',
- );
- }
+ # levels is optional - most things should still work otherwise.
+ my $l = Log::Contextual::WarnLogger->new({env_prefix => 'BAR',});
+
+ # if we don't know the level, and there are no environment variables set,
+ # just log everything.
+ {
+ ok($l->is_custom1, 'is_custom1 defaults to true on WarnLogger');
+ ok($l->is_custom2, 'is_custom2 defaults to true on WarnLogger');
+ }
+
+ # otherwise, go with what the variable says.
+ {
+ local $ENV{BAR_CUSTOM1} = 0;
+ local $ENV{BAR_CUSTOM2} = 1;
+ ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
+ ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
+
+ ok($l->is_foo, 'is_foo defaults to true on WarnLogger');
+
+ local $ENV{BAR_UPTO} = 'foo';
+ like(
+ exception { $l->is_bar },
+ qr/Unrecognized log level 'foo' in \$ENV{BAR_UPTO}/,
+ 'Cannot use an unrecognized log level in UPTO',
+ );
+ }
}
# these tests taken from t/warnlogger.t
my $l = Log::Contextual::WarnLogger->new({
- env_prefix => 'BAR',
- levels => [qw(custom1 custom2)]
-});
+ env_prefix => 'BAR',
+ levels => [qw(custom1 custom2)]});
{
- local $ENV{BAR_CUSTOM1} = 0;
- local $ENV{BAR_CUSTOM2} = 1;
- ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
- ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
+ local $ENV{BAR_CUSTOM1} = 0;
+ local $ENV{BAR_CUSTOM2} = 1;
+ ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
+ ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
- ok(!$l->is_foo, 'is_foo is false (custom levels supplied) on WarnLogger');
+ ok(!$l->is_foo, 'is_foo is false (custom levels supplied) on WarnLogger');
}
{
- local $ENV{BAR_UPTO} = 'custom1';
+ local $ENV{BAR_UPTO} = 'custom1';
- ok($l->is_custom1, 'is_custom1 is true on WarnLogger');
- ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
+ ok($l->is_custom1, 'is_custom1 is true on WarnLogger');
+ ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
}
{
- local $ENV{BAR_UPTO} = 'custom2';
+ local $ENV{BAR_UPTO} = 'custom2';
- ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
- ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
+ ok(!$l->is_custom1, 'is_custom1 is false on WarnLogger');
+ ok($l->is_custom2, 'is_custom2 is true on WarnLogger');
}
{
- local $ENV{BAR_UPTO} = 'foo';
+ local $ENV{BAR_UPTO} = 'foo';
- like(
- exception { $l->is_custom1 },
- qr/Unrecognized log level 'foo'/,
- 'Cannot use an unrecognized log level in UPTO',
- );
+ like(
+ exception { $l->is_custom1 },
+ qr/Unrecognized log level 'foo'/,
+ 'Cannot use an unrecognized log level in UPTO',
+ );
}
use Log::Contextual::WarnLogger;
use Log::Contextual qw{:log set_logger} => -logger =>
- Log::Contextual::WarnLogger->new({ env_prefix => 'FOO' });
+ Log::Contextual::WarnLogger->new({env_prefix => 'FOO'});
use Test::More qw(no_plan);
-my $l = Log::Contextual::WarnLogger->new({ env_prefix => 'BAR' });
+my $l = Log::Contextual::WarnLogger->new({env_prefix => 'BAR'});
{
local $ENV{BAR_TRACE} = 0;
local $ENV{BAR_DEBUG} = 1;
- local $ENV{BAR_INFO} = 0;
- local $ENV{BAR_WARN} = 0;
+ local $ENV{BAR_INFO} = 0;
+ local $ENV{BAR_WARN} = 0;
local $ENV{BAR_ERROR} = 0;
local $ENV{BAR_FATAL} = 0;
ok(!$l->is_trace, 'is_trace is false on WarnLogger');
- ok($l->is_debug, 'is_debug is true on WarnLogger');
- ok(!$l->is_info, 'is_info is false on WarnLogger');
- ok(!$l->is_warn, 'is_warn is false on WarnLogger');
+ ok($l->is_debug, 'is_debug is true on WarnLogger');
+ ok(!$l->is_info, 'is_info is false on WarnLogger');
+ ok(!$l->is_warn, 'is_warn is false on WarnLogger');
ok(!$l->is_error, 'is_error is false on WarnLogger');
ok(!$l->is_fatal, 'is_fatal is false on WarnLogger');
}
ok($l->is_trace, 'is_trace is true on WarnLogger');
ok($l->is_debug, 'is_debug is true on WarnLogger');
- ok($l->is_info, 'is_info is true on WarnLogger');
- ok($l->is_warn, 'is_warn is true on WarnLogger');
+ ok($l->is_info, 'is_info is true on WarnLogger');
+ ok($l->is_warn, 'is_warn is true on WarnLogger');
ok($l->is_error, 'is_error is true on WarnLogger');
ok($l->is_fatal, 'is_fatal is true on WarnLogger');
}
ok(!$l->is_trace, 'is_trace is false on WarnLogger');
ok(!$l->is_debug, 'is_debug is false on WarnLogger');
- ok(!$l->is_info, 'is_info is false on WarnLogger');
- ok($l->is_warn, 'is_warn is true on WarnLogger');
- ok($l->is_error, 'is_error is true on WarnLogger');
- ok($l->is_fatal, 'is_fatal is true on WarnLogger');
+ ok(!$l->is_info, 'is_info is false on WarnLogger');
+ ok($l->is_warn, 'is_warn is true on WarnLogger');
+ ok($l->is_error, 'is_error is true on WarnLogger');
+ ok($l->is_fatal, 'is_fatal is true on WarnLogger');
}
{
local $ENV{FOO_TRACE} = 0;
local $ENV{FOO_DEBUG} = 1;
- local $ENV{FOO_INFO} = 0;
- local $ENV{FOO_WARN} = 0;
+ local $ENV{FOO_INFO} = 0;
+ local $ENV{FOO_WARN} = 0;
local $ENV{FOO_ERROR} = 0;
local $ENV{FOO_FATAL} = 0;
- ok(eval { log_trace { die 'this should live' }; 1}, 'trace does not get called');
- ok(!eval { log_debug { die 'this should die' }; 1}, 'debug gets called');
- ok(eval { log_info { die 'this should live' }; 1}, 'info does not get called');
- ok(eval { log_warn { die 'this should live' }; 1}, 'warn does not get called');
- ok(eval { log_error { die 'this should live' }; 1}, 'error does not get called');
- ok(eval { log_fatal { die 'this should live' }; 1}, 'fatal does not get called');
+ ok(
+ eval {
+ log_trace { die 'this should live' };
+ 1
+ },
+ 'trace does not get called'
+ );
+ ok(
+ !eval {
+ log_debug { die 'this should die' };
+ 1
+ },
+ 'debug gets called'
+ );
+ ok(
+ eval {
+ log_info { die 'this should live' };
+ 1
+ },
+ 'info does not get called'
+ );
+ ok(
+ eval {
+ log_warn { die 'this should live' };
+ 1
+ },
+ 'warn does not get called'
+ );
+ ok(
+ eval {
+ log_error { die 'this should live' };
+ 1
+ },
+ 'error does not get called'
+ );
+ ok(
+ eval {
+ log_fatal { die 'this should live' };
+ 1
+ },
+ 'fatal does not get called'
+ );
}
{
local $ENV{FOO_TRACE} = 1;
local $ENV{FOO_DEBUG} = 1;
- local $ENV{FOO_INFO} = 1;
- local $ENV{FOO_WARN} = 1;
+ local $ENV{FOO_INFO} = 1;
+ local $ENV{FOO_WARN} = 1;
local $ENV{FOO_ERROR} = 1;
local $ENV{FOO_FATAL} = 1;
my $cap;
is($cap, "[trace] trace\n", 'trace renders correctly');
log_debug { 'debug' };
is($cap, "[debug] debug\n", 'debug renders correctly');
- log_info { 'info' };
+ log_info { 'info' };
is($cap, "[info] info\n", 'info renders correctly');
- log_warn { 'warn' };
+ log_warn { 'warn' };
is($cap, "[warn] warn\n", 'warn renders correctly');
log_error { 'error' };
is($cap, "[error] error\n", 'error renders correctly');
projects / p5sagit/Log-Contextual.git / commitdiff