From: Arthur Axel 'fREW' Schmidt <frioux@gmail.com>
Date: Sat, 7 Aug 2010 07:30:25 +0000 (-0500)
Subject: reduce silly repetitive code
X-Git-Tag: v0.00305~8
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ae9785e227eefc73de652ed668e8f1249f6ac080;p=p5sagit%2FLog-Contextual.git

reduce silly repetitive code
---

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 7520290..3b6e4ea 100644
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -5,29 +5,17 @@ use warnings;
 
 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;
@@ -147,86 +135,27 @@ sub _do_logS {
    $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;
diff --git a/t/dlog.t b/t/dlog.t
index 36d5538..c9a8fe3 100644
--- a/t/dlog.t
+++ b/t/dlog.t
@@ -6,6 +6,8 @@ use Test::More 'no_plan';
 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)],
@@ -14,166 +16,37 @@ BEGIN {
 }
 
 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");
 }
 
diff --git a/t/log.t b/t/log.t
index 3a56c77..ea0734d 100644
--- a/t/log.t
+++ b/t/log.t
@@ -4,6 +4,9 @@ use warnings;
 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;
@@ -76,81 +79,19 @@ SETWITHLOGGER: {
 }
 
 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');
-}