X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=b63a29de0afc09c4ca51ed33ac989b4f7c735b88;hb=30d7027abaddfbfc5df25e358e4d69a42cf2d316;hp=7520290e7a05a9914a6ab2a5a534cf8ff36b7746;hpb=6d77ba42ceb20cab06c3b5d47de0d739403bb939;p=p5sagit%2FLog-Contextual.git

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index 7520290..b63a29d 100644
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -3,31 +3,18 @@ package Log::Contextual;
 use strict;
 use warnings;
 
-our $VERSION = '0.00304';
+our $VERSION = '0.004100';
 
-require Exporter;
+my @levels = qw(debug trace warn info error fatal);
+
+use Exporter::Declare;
+use Exporter::Declare::Export::Generator;
 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;
@@ -35,36 +22,73 @@ eval {
    Log::Log4perl->wrapper_register(__PACKAGE__)
 };
 
-our @EXPORT_OK = (
+# ____ is because tags must have at least one export and we don't want to
+# export anything but the levels selected
+sub ____ {}
+
+exports ('____',
    @dlog, @log,
    qw( set_logger with_logger )
 );
 
-our %EXPORT_TAGS = (
-   dlog => \@dlog,
-   log  => \@log,
-   all  => [@dlog, @log],
-);
+export_tag dlog => ('____');
+export_tag log  => ('____');
+import_arguments qw(logger package_logger default_logger);
+
+sub before_import {
+   my ($class, $importer, $spec) = @_;
 
-sub import {
-   my $package = shift;
    die 'Log::Contextual does not have a default import list'
-      unless @_;
-
-   for my $idx ( 0 .. $#_ ) {
-      my $val = $_[$idx];
-      if ( defined $val && $val eq '-logger' ) {
-         set_logger($_[$idx + 1]);
-         splice @_, $idx, 2;
-      } elsif ( defined $val && $val eq '-package_logger' ) {
-         _set_package_logger_for(scalar caller, $_[$idx + 1]);
-         splice @_, $idx, 2;
-      } elsif ( defined $val && $val eq '-default_logger' ) {
-         _set_default_logger_for(scalar caller, $_[$idx + 1]);
-         splice @_, $idx, 2;
+      if $spec->config->{default};
+
+   my @levels = @{$class->arg_levels($spec->config->{levels})};
+   for my $level (@levels) {
+      if ($spec->config->{log}) {
+         $spec->add_export("&log_$level", sub (&@) {
+            _do_log( $level => _get_logger( caller ), shift @_, @_)
+         });
+         $spec->add_export("&logS_$level", sub (&@) {
+            _do_logS( $level => _get_logger( caller ), $_[0], $_[1])
+         });
+      }
+      if ($spec->config->{dlog}) {
+         $spec->add_export("&Dlog_$level", sub (&@) {
+           my ($code, @args) = @_;
+           return _do_log( $level => _get_logger( caller ), sub {
+              local $_ = (@args?Data::Dumper::Concise::Dumper @args:'()');
+              $code->(@_)
+           }, @args );
+         });
+         $spec->add_export("&DlogS_$level", sub (&$) {
+           my ($code, $ref) = @_;
+           _do_logS( $level => _get_logger( caller ), sub {
+              local $_ = Data::Dumper::Concise::Dumper $ref;
+              $code->($ref)
+           }, $ref )
+         });
       }
    }
-   $package->export_to_level(1, $package, @_);
+}
+
+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 after_import {
+   my ($class, $importer, $specs) = @_;
+
+   if (my $l = $class->arg_logger($specs->config->{logger})) {
+      set_logger($l)
+   }
+
+   if (my $l = $class->arg_package_logger($specs->config->{package_logger})) {
+      _set_package_logger_for($importer, $l)
+   }
+
+   if (my $l = $class->arg_default_logger($specs->config->{default_logger})) {
+      _set_default_logger_for($importer, $l)
+   }
 }
 
 our $Get_Logger;
@@ -147,88 +171,6 @@ 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, @_ );
-}
-
-sub Dlog_info (&@) {
-  my $code = shift;
-  local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
-  return _do_log( info => _get_logger( caller ), $code, @_ );
-}
-
-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, @_ );
-}
-
-
-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] )
-}
-
 1;
 
 __END__
@@ -244,7 +186,6 @@ Log::Contextual - Simple logging interface with a contextual log
  use Log::Log4perl ':easy';
  Log::Log4perl->easy_init($DEBUG);
 
-
  my $logger  = Log::Log4perl->get_logger;
 
  set_logger $logger;
@@ -252,14 +193,17 @@ Log::Contextual - Simple logging interface with a contextual log
  log_debug { 'program started' };
 
  sub foo {
-   with_logger(Log::Contextual::SimpleLogger->new({
-       levels => [qw( trace debug )]
-     }) => sub {
+
+   my $minilogger = Log::Contextual::SimpleLogger->new({
+     levels => [qw( trace debug )]
+   });
+
+   with_logger $minilogger => sub {
      log_trace { 'foo entered' };
      my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
      # ...
      log_trace { 'foo left' };
-   });
+   };
  }
 
  foo();
@@ -281,12 +225,72 @@ with C<Log::Contextual>:
 
 =head1 DESCRIPTION
 
-This module is a simple interface to extensible logging.  It is bundled with a
-really basic logger, L<Log::Contextual::SimpleLogger>, but in general you
-should use a real logger instead of that.  For something more serious but not
-overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
+Major benefits:
+
+=over 2
+
+=item * Efficient
+
+The logging functions take blocks, so if a log level is disabled, the
+block will not run:
+
+ # the following won't run if debug is off
+ log_debug { "the new count in the database is " . $rs->count };
+
+Similarly, the C<D> prefixed methods only C<Dumper> the input if the level is
+enabled.
+
+=item * Handy
+
+The logging functions return their arguments, so you can stick them in
+the middle of expressions:
 
-=head1 OPTIONS
+ for (log_debug { "downloading:\n" . join qq(\n), @_ } @urls) { ... }
+
+=item * Generic
+
+C<Log::Contextual> is an interface for all major loggers.  If you log through
+C<Log::Contextual> you will be able to swap underlying loggers later.
+
+=item * Powerful
+
+C<Log::Contextual> chooses which logger to use based on user defined C<CodeRef>s.
+Normally you don't need to know this, but you can take advantage of it when you
+need to later
+
+=item * Scalable
+
+If you just want to add logging to your extremely basic application, start with
+L<Log::Contextual::SimpleLogger> and then as your needs grow you can switch to
+L<Log::Dispatchouli> or L<Log::Dispatch> or L<Log::Log4perl> or whatever else.
+
+=back
+
+This module is a simple interface to extensible logging.  It exists to
+abstract your logging interface so that logging is as painless as possible,
+while still allowing you to switch from one logger to another.
+
+It is bundled with a really basic logger, L<Log::Contextual::SimpleLogger>,
+but in general you should use a real logger instead of that.  For something
+more serious but not overly complicated, try L<Log::Dispatchouli> (see
+L</SYNOPSIS> for example.)
+
+=head1 A WORK IN PROGRESS
+
+This module is certainly not complete, but we will not break the interface
+lightly, so I would say it's safe to use in production code.  The main result
+from that at this point is that doing:
+
+ use Log::Contextual;
+
+will die as we do not yet know what the defaults should be.  If it turns out
+that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
+probably make C<:log> the default.  But only time and usage will tell.
+
+=head1 IMPORT OPTIONS
+
+See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
+wide.
 
 =head2 -logger
 
@@ -304,6 +308,17 @@ case you might try something like the following:
  BEGIN { $var_log = VarLogger->new }
  use Log::Contextual qw( :dlog ), -logger => $var_log;
 
+=head2 -levels
+
+The C<-levels> import option allows you to define exactly which levels your
+logger supports.  So the default,
+C<< [qw(debug trace warn info error fatal)] >>, works great for
+L<Log::Log4perl>, but it doesn't support the levels for L<Log::Dispatch>.  But
+supporting those levels is as easy as doing
+
+ use Log::Contextual
+   -levels => [qw( debug info notice warning error critical alert emergency )];
+
 =head2 -package_logger
 
 The C<-package_logger> import option is similar to the C<-logger> import option
@@ -336,17 +351,46 @@ Basically it sets the logger to be used if C<set_logger> is never called; so
       env_prefix => 'MY_PACKAGE'
    });
 
-=head1 A WORK IN PROGRESS
+=head1 SETTING DEFAULT IMPORT OPTIONS
 
-This module is certainly not complete, but we will not break the interface
-lightly, so I would say it's safe to use in production code.  The main result
-from that at this point is that doing:
+Eventually you will get tired of writing the following in every single one of
+your packages:
 
- use Log::Contextual;
+ use Log::Log4perl;
+ use Log::Log4perl ':easy';
+ BEGIN { Log::Log4perl->easy_init($DEBUG) }
 
-will die as we do not yet know what the defaults should be.  If it turns out
-that nearly everyone uses the C<:log> tag and C<:dlog> is really rare, we'll
-probably make C<:log> the default.  But only time and usage will tell.
+ use Log::Contextual -logger => Log::Log4perl->get_logger;
+
+You can set any of the import options for your whole project if you define your
+own C<Log::Contextual> subclass as follows:
+
+ package MyApp::Log::Contextual;
+
+ use base 'Log::Contextual';
+
+ use Log::Log4perl ':easy';
+ Log::Log4perl->easy_init($DEBUG)
+
+ sub arg_default_logger { $_[1] || Log::Log4perl->get_logger }
+ sub arg_levels { [qw(debug trace warn info error fatal custom_level)] }
+
+ # or maybe instead of default_logger
+ sub arg_package_logger { $_[1] }
+
+ # and almost definitely not this, which is only here for completeness
+ sub arg_logger { $_[1] }
+
+Note the C<< $_[1] || >> in C<arg_default_logger>.  All of these methods are
+passed the values passed in from the arguments to the subclass, so you can
+either throw them away, honor them, die on usage, or whatever.  To be clear,
+if you define your subclass, and someone uses it as follows:
+
+ use MyApp::Log::Contextual -default_logger => $foo,
+                            -levels => [qw(bar baz biff)];
+
+Your C<arg_default_logger> method will get C<$foo> and your C<arg_levels>
+will get C<[qw(bar baz biff)]>;
 
 =head1 FUNCTIONS
 
@@ -386,7 +430,7 @@ Import Tag: C<:log>
 
 Arguments: C<CodeRef $returning_message, @args>
 
-All of the following six functions work the same except that a different method
+C<log_$level> functions all work the same except that a different method
 is called on the underlying C<$logger> object.  The basic pattern is:
 
  sub log_$level (&@) {
@@ -407,29 +451,24 @@ ways, but often it's convenient just for partial inspection of passthrough data
 If you want complete inspection of passthrough data, take a look at the
 L</Dlog_$level> functions.
 
-=head3 log_trace
+Which functions are exported depends on what was passed to L</-levels>.  The
+default (no C<-levels> option passed) would export:
 
- log_trace { 'entered method foo with args ' join q{,}, @args };
+=over 2
 
-=head3 log_debug
+=item log_trace
 
- log_debug { 'entered method foo' };
+=item log_debug
 
-=head3 log_info
+=item log_info
 
- log_info { 'started process foo' };
+=item log_warn
 
-=head3 log_warn
+=item log_error
 
- log_warn { 'possible misconfiguration at line 10' };
+=item log_fatal
 
-=head3 log_error
-
- log_error { 'non-numeric user input!' };
-
-=head3 log_fatal
-
- log_fatal { '1 is never equal to 0!' };
+=back
 
 =head2 logS_$level
 
@@ -468,29 +507,24 @@ and the output might look something like:
  "fRUE"
  "fiSMBoC"
 
-=head3 Dlog_trace
-
- my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
-
-=head3 Dlog_debug
-
- Dlog_debug { "random data structure: $_" } { foo => $bar };
+Which functions are exported depends on what was passed to L</-levels>.  The
+default (no C<-levels> option passed) would export:
 
-=head3 Dlog_info
+=over 2
 
- return Dlog_info { "html from method returned: $_" } "<html>...</html>";
+=item Dlog_trace
 
-=head3 Dlog_warn
+=item Dlog_debug
 
- Dlog_warn { "probably invalid value: $_" } $foo;
+=item Dlog_info
 
-=head3 Dlog_error
+=item Dlog_warn
 
- Dlog_error { "non-numeric user input! ($_)" } $port;
+=item Dlog_error
 
-=head3 Dlog_fatal
+=item Dlog_fatal
 
- Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
+=back
 
 =head2 DlogS_$level
 
@@ -539,7 +573,7 @@ mst - Matt S. Trout <mst@shadowcat.co.uk>
 
 =head1 COPYRIGHT
 
-Copyright (c) 2010 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
+Copyright (c) 2012 the Log::Contextual L</AUTHOR> and L</DESIGNER> as listed
 above.
 
 =head1 LICENSE