our $VERSION = '0.00304';
+my @levels = qw(debug trace warn info error fatal);
+
require Exporter;
use Data::Dumper::Concise;
use Scalar::Util 'blessed';
BEGIN { our @ISA = qw(Exporter) }
-my @dlog = (qw(
- Dlog_debug DlogS_debug
- Dlog_trace DlogS_trace
- Dlog_warn DlogS_warn
- Dlog_info DlogS_info
- Dlog_error DlogS_error
- Dlog_fatal DlogS_fatal
- ));
-
-my @log = (qw(
- log_debug logS_debug
- log_trace logS_trace
- log_warn logS_warn
- log_info logS_info
- log_error logS_error
- log_fatal logS_fatal
- ));
+my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
+
+my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
eval {
require Log::Log4perl;
$value
}
-sub log_trace (&@) { _do_log( trace => _get_logger( caller ), shift @_, @_) }
-sub log_debug (&@) { _do_log( debug => _get_logger( caller ), shift @_, @_) }
-sub log_info (&@) { _do_log( info => _get_logger( caller ), shift @_, @_) }
-sub log_warn (&@) { _do_log( warn => _get_logger( caller ), shift @_, @_) }
-sub log_error (&@) { _do_log( error => _get_logger( caller ), shift @_, @_) }
-sub log_fatal (&@) { _do_log( fatal => _get_logger( caller ), shift @_, @_) }
-
-sub logS_trace (&$) { _do_logS( trace => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_debug (&$) { _do_logS( debug => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_info (&$) { _do_logS( info => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_warn (&$) { _do_logS( warn => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_error (&$) { _do_logS( error => _get_logger( caller ), $_[0], $_[1]) }
-sub logS_fatal (&$) { _do_logS( fatal => _get_logger( caller ), $_[0], $_[1]) }
-
-
-sub Dlog_trace (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( trace => _get_logger( caller ), $code, @_ );
-}
-
-sub Dlog_debug (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( debug => _get_logger( caller ), $code, @_ );
-}
+for my $level (@levels) {
+ no strict 'refs';
-sub Dlog_info (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( info => _get_logger( caller ), $code, @_ );
-}
+ *{"log_$level"} = sub (&@) {
+ _do_log( $level => _get_logger( caller ), shift @_, @_)
+ };
-sub Dlog_warn (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( warn => _get_logger( caller ), $code, @_ );
-}
-
-sub Dlog_error (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( error => _get_logger( caller ), $code, @_ );
-}
-
-sub Dlog_fatal (&@) {
- my $code = shift;
- local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
- return _do_log( fatal => _get_logger( caller ), $code, @_ );
-}
+ *{"logS_$level"} = sub (&$) {
+ _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
+ };
+ *{"Dlog_$level"} = sub (&@) {
+ my $code = shift;
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( $level => _get_logger( caller ), $code, @_ );
+ };
-sub DlogS_trace (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
-}
-
-sub DlogS_debug (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
-}
-
-sub DlogS_info (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
-}
-
-sub DlogS_warn (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
-}
-
-sub DlogS_error (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
-}
-
-sub DlogS_fatal (&$) {
- local $_ = Data::Dumper::Concise::Dumper $_[1];
- _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
+ *{"DlogS_$level"} = sub (&$) {
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( $level => _get_logger( caller ), $_[0], $_[1] )
+ };
}
1;
my $var_log;
my $var;
+my @levels = qw(debug trace warn info error fatal);
+
BEGIN {
$var_log = Log::Contextual::SimpleLogger->new({
levels => [qw(trace debug info warn error fatal)],
}
use Log::Contextual qw{:dlog}, -logger => $var_log;
-{
-my @foo = Dlog_trace { "Look ma, data: $_" } qw{frew bar baz};
-ok( eq_array(\@foo, [qw{frew bar baz}]), 'Dlog_trace passes data through correctly');
-is( $var, <<'OUT', 'Output for Dlog_trace is correct');
-[trace] Look ma, data: "frew"
-"bar"
-"baz"
-OUT
-
-my $bar = DlogS_trace { "Look ma, data: $_" } [qw{frew bar baz}];
-ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_trace passes data through correctly');
-is( $var, <<'OUT', 'Output for DlogS_trace is correct');
-[trace] Look ma, data: [
- "frew",
- "bar",
- "baz"
-]
-OUT
-}
-
-
-{
-my @foo = Dlog_debug { "Look ma, data: $_" } qw{frew bar baz};
-ok( eq_array(\@foo, [qw{frew bar baz}]), 'Dlog_debug passes data through correctly');
-is( $var, <<'OUT', 'Output for Dlog_debug is correct');
-[debug] Look ma, data: "frew"
-"bar"
-"baz"
-OUT
-
-my $bar = DlogS_debug { "Look ma, data: $_" } [qw{frew bar baz}];
-ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_debug passes data through correctly');
-is( $var, <<'OUT', 'Output for DlogS_debug is correct');
-[debug] Look ma, data: [
- "frew",
- "bar",
- "baz"
-]
-OUT
-}
-
-
-{
-my @foo = Dlog_info { "Look ma, data: $_" } qw{frew bar baz};
-ok( eq_array(\@foo, [qw{frew bar baz}]), 'Dlog_info passes data through correctly');
-is( $var, <<'OUT', 'Output for Dlog_info is correct');
-[info] Look ma, data: "frew"
-"bar"
-"baz"
-OUT
-
-my $bar = DlogS_info { "Look ma, data: $_" } [qw{frew bar baz}];
-ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_info passes data through correctly');
-is( $var, <<'OUT', 'Output for DlogS_info is correct');
-[info] Look ma, data: [
- "frew",
- "bar",
- "baz"
-]
-OUT
-}
-
-
-{
-my @foo = Dlog_warn { "Look ma, data: $_" } qw{frew bar baz};
-ok( eq_array(\@foo, [qw{frew bar baz}]), 'Dlog_warn passes data through correctly');
-is( $var, <<'OUT', 'Output for Dlog_warn is correct');
-[warn] Look ma, data: "frew"
-"bar"
-"baz"
-OUT
-
-my $bar = DlogS_warn { "Look ma, data: $_" } [qw{frew bar baz}];
-ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_warn passes data through correctly');
-is( $var, <<'OUT', 'Output for DlogS_warn is correct');
-[warn] Look ma, data: [
- "frew",
- "bar",
- "baz"
-]
-OUT
-}
-
-
-{
-my @foo = Dlog_error { "Look ma, data: $_" } qw{frew bar baz};
-ok( eq_array(\@foo, [qw{frew bar baz}]), 'Dlog_error passes data through correctly');
-is( $var, <<'OUT', 'Output for Dlog_error is correct');
-[error] Look ma, data: "frew"
-"bar"
-"baz"
-OUT
-
-my $bar = DlogS_error { "Look ma, data: $_" } [qw{frew bar baz}];
-ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_error passes data through correctly');
-is( $var, <<'OUT', 'Output for DlogS_error is correct');
-[error] Look ma, data: [
- "frew",
- "bar",
- "baz"
-]
-OUT
-}
-
-
-{
-my @foo = Dlog_fatal { "Look ma, data: $_" } qw{frew bar baz};
-ok( eq_array(\@foo, [qw{frew bar baz}]), 'Dlog_fatal passes data through correctly');
-is( $var, <<'OUT', 'Output for Dlog_fatal is correct');
-[fatal] Look ma, data: "frew"
-"bar"
-"baz"
-OUT
-
-my $bar = DlogS_fatal { "Look ma, data: $_" } [qw{frew bar baz}];
-ok( eq_array($bar, [qw{frew bar baz}]), 'DlogS_fatal passes data through correctly');
-is( $var, <<'OUT', 'Output for DlogS_fatal is correct');
-[fatal] Look ma, data: [
- "frew",
- "bar",
- "baz"
-]
-OUT
-}
-
-
-
-{
- my @foo = Dlog_trace { "nothing: $_" } ();
- ok( eq_array(\@foo, []), 'Dlog_trace passes nothing through correctly');
- is( $var, "[trace] nothing: ()\n", 'Output for Dlog_trace is correct');
-}
-
-{
- my @foo = Dlog_debug { "nothing: $_" } ();
- ok( eq_array(\@foo, []), 'Dlog_debug passes nothing through correctly');
- is( $var, "[debug] nothing: ()\n", 'Output for Dlog_debug is correct');
-}
-
-{
- my @foo = Dlog_info { "nothing: $_" } ();
- ok( eq_array(\@foo, []), 'Dlog_info passes nothing through correctly');
- is( $var, "[info] nothing: ()\n", 'Output for Dlog_info is correct');
-}
-
-{
- my @foo = Dlog_warn { "nothing: $_" } ();
- ok( eq_array(\@foo, []), 'Dlog_warn passes nothing through correctly');
- is( $var, "[warn] nothing: ()\n", 'Output for Dlog_warn is correct');
-}
-
-{
- my @foo = Dlog_error { "nothing: $_" } ();
- ok( eq_array(\@foo, []), 'Dlog_error passes nothing through correctly');
- is( $var, "[error] nothing: ()\n", 'Output for Dlog_error is correct');
-}
-{
- my @foo = Dlog_fatal { "nothing: $_" } ();
- ok( eq_array(\@foo, []), 'Dlog_fatal passes nothing through correctly');
- is( $var, "[fatal] nothing: ()\n", 'Output for Dlog_fatal is correct');
+for my $level (@levels) {
+
+ 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),
+ "Output for Dlog_$level is correct"
+ );
+
+ 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),
+ "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");
}
use Log::Contextual qw{:log with_logger set_logger};
use Log::Contextual::SimpleLogger;
use Test::More qw(no_plan);
+
+my @levels = qw(debug trace warn info error fatal);
+
my $var1;
my $var2;
my $var3;
}
VANILLA: {
- log_trace { 'fiSMBoC' };
- is( $var3, "[trace] fiSMBoC\n", 'trace works');
-
- log_debug { 'fiSMBoC' };
- is( $var3, "[debug] fiSMBoC\n", 'debug works');
-
- log_info { 'fiSMBoC' };
- is( $var3, "[info] fiSMBoC\n", 'info works');
-
- log_warn { 'fiSMBoC' };
- is( $var3, "[warn] fiSMBoC\n", 'warn works');
-
- log_error { 'fiSMBoC' };
- is( $var3, "[error] fiSMBoC\n", 'error works');
-
- log_fatal { 'fiSMBoC' };
- is( $var3, "[fatal] fiSMBoC\n", 'fatal works');
-
+ for (@levels) {
+ main->can("log_$_")->(sub { 'fiSMBoC' });
+ 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 $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");
+ }
}
ok(!eval { Log::Contextual->import; 1 }, 'Blank Log::Contextual import dies');
-PASSTHROUGH: {
- my @vars;
-
- @vars = log_trace { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
- is( $var3, "[trace] fiSMBoC: bar\n", 'log_trace works with input');
- ok( eq_array(\@vars, [qw{foo bar baz}]), 'log_trace passes data through correctly');
-
- @vars = log_debug { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
- is( $var3, "[debug] fiSMBoC: bar\n", 'log_debug works with input');
- ok( eq_array(\@vars, [qw{foo bar baz}]), 'log_debug passes data through correctly');
-
- @vars = log_info { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
- is( $var3, "[info] fiSMBoC: bar\n", 'log_info works with input');
- ok( eq_array(\@vars, [qw{foo bar baz}]), 'log_info passes data through correctly');
-
- @vars = log_warn { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
- is( $var3, "[warn] fiSMBoC: bar\n", 'log_warn works with input');
- ok( eq_array(\@vars, [qw{foo bar baz}]), 'log_warn passes data through correctly');
-
- @vars = log_error { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
- is( $var3, "[error] fiSMBoC: bar\n", 'log_error works with input');
- ok( eq_array(\@vars, [qw{foo bar baz}]), 'log_error passes data through correctly');
-
- @vars = log_fatal { 'fiSMBoC: ' . $_[1] } qw{foo bar baz};
- is( $var3, "[fatal] fiSMBoC: bar\n", 'log_fatal works with input');
- ok( eq_array(\@vars, [qw{foo bar baz}]), 'log_fatal passes data through correctly');
-
-
-
- my $val;
- $val = logS_trace { 'fiSMBoC: ' . $_[0] } 'foo';
- is( $var3, "[trace] fiSMBoC: foo\n", 'logS_trace works with input');
- is( $val, 'foo', 'logS_trace passes data through correctly');
-
- $val = logS_debug { 'fiSMBoC: ' . $_[0] } 'foo';
- is( $var3, "[debug] fiSMBoC: foo\n", 'logS_debug works with input');
- is( $val, 'foo', 'logS_debug passes data through correctly');
-
- $val = logS_info { 'fiSMBoC: ' . $_[0] } 'foo';
- is( $var3, "[info] fiSMBoC: foo\n", 'logS_info works with input');
- is( $val, 'foo', 'logS_info passes data through correctly');
-
- $val = logS_warn { 'fiSMBoC: ' . $_[0] } 'foo';
- is( $var3, "[warn] fiSMBoC: foo\n", 'logS_warn works with input');
- is( $val, 'foo', 'logS_warn passes data through correctly');
-
- $val = logS_error { 'fiSMBoC: ' . $_[0] } 'foo';
- is( $var3, "[error] fiSMBoC: foo\n", 'logS_error works with input');
- is( $val, 'foo', 'logS_error passes data through correctly');
-
- $val = logS_fatal { 'fiSMBoC: ' . $_[0] } 'foo';
- is( $var3, "[fatal] fiSMBoC: foo\n", 'logS_fatal works with input');
- is( $val, 'foo', 'logS_fatal passes data through correctly');
-
- ok(!eval "logS_error { 'frew' } 'bar', 'baz'; 1", 'logS_$level dies from too many args');
-}
projects / p5sagit/Log-Contextual.git / commitdiff