X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=1d0a1dca966de1903ba032dd5c71811c41d98f46;hb=0c180ced3d15f9851c4ae1cf4ea984c026f67b3f;hp=d1da84fd7a92e69cc990a022fed316e3b029474f;hpb=a2777569858d502c8889b8efe31af96ffcb9d4bd;p=p5sagit%2FLog-Contextual.git

diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm
index d1da84f..1d0a1dc 100644
--- a/lib/Log/Contextual.pm
+++ b/lib/Log/Contextual.pm
@@ -3,260 +3,414 @@ package Log::Contextual;
 use strict;
 use warnings;
 
-our $VERSION = '1.000';
+our $VERSION = '0.004202';
 
-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';
+
+my @dlog = ((map "Dlog_$_", @levels), (map "DlogS_$_", @levels));
+
+my @log = ((map "log_$_", @levels), (map "logS_$_", @levels));
+
+eval {
+   require Log::Log4perl;
+   die if $Log::Log4perl::VERSION < 1.29;
+   Log::Log4perl->wrapper_register(__PACKAGE__)
+};
+
+# ____ is because tags must have at least one export and we don't want to
+# export anything but the levels selected
+sub ____ {}
 
-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
-   log_trace
-   log_warn
-   log_info
-   log_error
-   log_fatal
-});
-
-our @EXPORT_OK = (
+exports ('____',
    @dlog, @log,
-   qw{set_logger with_logger}
+   qw( set_logger with_logger )
 );
 
-our %EXPORT_TAGS = (
-   dlog => \@dlog,
-   log  => \@log,
-);
+export_tag dlog => ('____');
+export_tag log  => ('____');
+import_arguments qw(logger package_logger default_logger);
 
-sub import {
-   my $package = shift;
-   die 'Log::Contextual does not have a default import list'
-      unless @_;
+sub before_import {
+   my ($class, $importer, $spec) = @_;
 
-   for my $idx ( 0 .. $#_ ) {
-      if ( $_[$idx] eq '-logger' ) {
-         set_logger($_[$idx + 1]);
-         splice @_, $idx, 2;
-         last;
+   die 'Log::Contextual does not have a default import list'
+      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;
+our %Default_Logger;
+our %Package_Logger;
+
+sub _set_default_logger_for {
+   my $logger = $_[1];
+   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 } }
+   }
+   $Default_Logger{$_[0]} = $logger
+}
+
+sub _set_package_logger_for {
+   my $logger = $_[1];
+   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 } }
+   }
+   $Package_Logger{$_[0]} = $logger
+}
+
+sub _get_logger($) {
+   my $package = shift;
+   (
+      $Package_Logger{$package} ||
+      $Get_Logger ||
+      $Default_Logger{$package} ||
+      die q( no logger set!  you can't try to log something without a logger! )
+   )->($package, { caller_level => 2 });
+}
+
+sub set_logger {
+   my $logger = $_[0];
+   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 } }
+   }
 
-sub set_logger (&) {
-   $Get_Logger = $_[0];
+   warn 'set_logger (or -logger) called more than once!  This is a bad idea!'
+      if $Get_Logger;
+   $Get_Logger = $logger;
 }
 
 sub with_logger {
    my $logger = $_[0];
-   $logger = do { my $l = $logger; sub { $l } }
-      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 } }
+   }
    local $Get_Logger = $logger;
    $_[1]->();
 }
 
-sub log_trace (&) {
-   my $log = $Get_Logger->();
-   $log->trace($_[0]->())
-      if $log->is_trace;
-}
+sub _do_log {
+   my $level  = shift;
+   my $logger = shift;
+   my $code   = shift;
+   my @values = @_;
 
-sub log_debug (&) {
-   my $log = $Get_Logger->();
-   $log->debug($_[0]->())
-      if $log->is_debug;
+   $logger->$level($code->(@_))
+      if $logger->${\"is_$level"};
+   @values
 }
 
-sub log_info (&) {
-   my $log = $Get_Logger->();
-   $log->info($_[0]->())
-      if $log->is_info;
-}
+sub _do_logS {
+   my $level  = shift;
+   my $logger = shift;
+   my $code   = shift;
+   my $value  = shift;
 
-sub log_warn (&) {
-   my $log = $Get_Logger->();
-   $log->warn($_[0]->())
-      if $log->is_warn;
+   $logger->$level($code->($value))
+      if $logger->${\"is_$level"};
+   $value
 }
 
-sub log_error (&) {
-   my $log = $Get_Logger->();
-   $log->error($_[0]->())
-      if $log->is_error;
-}
+1;
 
-sub log_fatal (&) {
-   my $log = $Get_Logger->();
-   $log->fatal($_[0]->())
-      if $log->is_fatal;
-}
+__END__
 
+=head1 NAME
 
+Log::Contextual - Simple logging interface with a contextual log
 
-sub Dlog_trace (&@) {
-  my $code = shift;
-  my @values = @_;
-  log_trace {
-     do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-  };
-  @values
-}
+=head1 SYNOPSIS
 
-sub DlogS_trace (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  log_trace {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  };
-  $value
-}
+ use Log::Contextual qw( :log :dlog set_logger with_logger );
+ use Log::Contextual::SimpleLogger;
+ use Log::Log4perl ':easy';
+ Log::Log4perl->easy_init($DEBUG);
 
-sub Dlog_debug (&@) {
-  my $code = shift;
-  my @values = @_;
-  log_debug {
-     do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-  };
-  @values
-}
+ my $logger  = Log::Log4perl->get_logger;
 
-sub DlogS_debug (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  log_debug {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  };
-  $value
-}
+ set_logger $logger;
 
-sub Dlog_info (&@) {
-  my $code = shift;
-  my @values = @_;
-  log_info {
-     do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-  };
-  @values
-}
+ log_debug { 'program started' };
 
-sub DlogS_info (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  log_info {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  };
-  $value
-}
+ sub foo {
 
-sub Dlog_warn (&@) {
-  my $code = shift;
-  my @values = @_;
-  log_warn {
-     do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-  };
-  @values
-}
+   my $minilogger = Log::Contextual::SimpleLogger->new({
+     levels => [qw( trace debug )]
+   });
 
-sub DlogS_warn (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  log_warn {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  };
-  $value
-}
+   with_logger $minilogger => sub {
+     log_trace { 'foo entered' };
+     my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_;
+     # ...
+     log_trace { 'foo left' };
+   };
+ }
 
-sub Dlog_error (&@) {
-  my $code = shift;
-  my @values = @_;
-  log_error {
-     do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-  };
-  @values
-}
+ foo();
 
-sub DlogS_error (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  log_error {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  };
-  $value
-}
+Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
+with C<Log::Contextual>:
 
-sub Dlog_fatal (&@) {
-  my $code = shift;
-  my @values = @_;
-  log_fatal {
-     do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
-  };
-  @values
-}
+ use Log::Contextual qw( :log :dlog set_logger );
+ use Log::Dispatchouli;
+ my $ld = Log::Dispatchouli->new({
+    ident     => 'slrtbrfst',
+    to_stderr => 1,
+    debug     => 1,
+ });
 
-sub DlogS_fatal (&$) {
-  my $code = $_[0];
-  my $value = $_[1];
-  log_fatal {
-     do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
-  };
-  $value
-}
+ set_logger $ld;
 
-1;
+ log_debug { 'program started' };
 
-__END__
+=head1 DESCRIPTION
 
-=head1 NAME
+Major benefits:
 
-Log::Contextual - Super simple logging interface
+=over 2
 
-=head1 SYNOPSIS
+=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:
+
+ 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 L<< user defined C<CodeRef>s|/LOGGER CODEREF >>.
+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;
 
- my $logger  = WarnLogger->new;
- my $logger2 = FileLogger->new;
+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.
 
- set_logger { $logger };
+=head1 IMPORT OPTIONS
 
- log_debug { "program started" };
+See L</SETTING DEFAULT IMPORT OPTIONS> for information on setting these project
+wide.
 
- sub foo {
-   with_logger {
-     log_trace { "foo entered" };
-     # ...
-     log_trace { "foo left"    };
-   } $logger2;
- }
+=head2 -logger
 
-=head1 DESCRIPTION
+When you import this module you may use C<-logger> as a shortcut for
+L<set_logger>, for example:
+
+ use Log::Contextual::SimpleLogger;
+ use Log::Contextual qw( :dlog ),
+   -logger => Log::Contextual::SimpleLogger->new({ levels => [qw( debug )] });
+
+sometimes you might want to have the logger handy for other stuff, in which
+case you might try something like the following:
+
+ my $var_log;
+ 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
+except C<-package_logger> sets the the logger for the current package.
+
+Unlike L</-default_logger>, C<-package_logger> cannot be overridden with
+L</set_logger>.
+
+ package My::Package;
+ use Log::Contextual::SimpleLogger;
+ use Log::Contextual qw( :log ),
+   -package_logger => Log::Contextual::WarnLogger->new({
+      env_prefix => 'MY_PACKAGE'
+   });
+
+If you are interested in using this package for a module you are putting on
+CPAN we recommend L<Log::Contextual::WarnLogger> for your package logger.
+
+=head2 -default_logger
+
+The C<-default_logger> import option is similar to the C<-logger> import option
+except C<-default_logger> sets the the B<default> logger for the current package.
 
-This module is for simplistic but very extensible logging.
+Basically it sets the logger to be used if C<set_logger> is never called; so
+
+ package My::Package;
+ use Log::Contextual::SimpleLogger;
+ use Log::Contextual qw( :log ),
+   -default_logger => Log::Contextual::WarnLogger->new({
+      env_prefix => 'MY_PACKAGE'
+   });
+
+=head1 SETTING DEFAULT IMPORT OPTIONS
+
+Eventually you will get tired of writing the following in every single one of
+your packages:
+
+ use Log::Log4perl;
+ use Log::Log4perl ':easy';
+ BEGIN { Log::Log4perl->easy_init($DEBUG) }
+
+ 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
 
 =head2 set_logger
 
  my $logger = WarnLogger->new;
- set_logger { $logger };
+ set_logger $logger;
+
+Arguments: L</LOGGER CODEREF>
 
-Arguments: CodeRef $returning_logger
+C<set_logger> will just set the current logger to whatever you pass it.  It
+expects a C<CodeRef>, but if you pass it something else it will wrap it in a
+C<CodeRef> for you.  C<set_logger> is really meant only to be called from a
+top-level script.  To avoid foot-shooting the function will warn if you call it
+more than once.
 
 =head2 with_logger
 
  my $logger = WarnLogger->new;
- with_logger { $logger } sub {
+ with_logger $logger => sub {
     if (1 == 0) {
        log_fatal { 'Non Logical Universe Detected' };
     } else {
@@ -264,50 +418,213 @@ Arguments: CodeRef $returning_logger
     }
  };
 
-Arguments: CodeRef $to_execute, CodeRef $returning_logger
+Arguments: L</LOGGER CODEREF>, C<CodeRef $to_execute>
 
-=head2 log_trace
+C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
+As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
+C<CodeRef> if needed.
 
- log_trace { 'entered method foo with args ' join q{,}, @args };
+=head2 log_$level
 
-Arguments: CodeRef $returning_message
+Import Tag: C<:log>
 
-=head2 log_debug
+Arguments: C<CodeRef $returning_message, @args>
 
- log_debug { 'entered method foo' };
+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:
 
-Arguments: CodeRef $returning_message
+ sub log_$level (&@) {
+   if ($logger->is_$level) {
+     $logger->$level(shift->(@_));
+   }
+   @_
+ }
 
-=head2 log_info
+Note that the function returns it's arguments.  This can be used in a number of
+ways, but often it's convenient just for partial inspection of passthrough data
 
- log_info { 'started process foo' };
+ my @friends = log_trace {
+   'friends list being generated, data from first friend: ' .
+     Dumper($_[0]->TO_JSON)
+ } generate_friend_list();
 
-Arguments: CodeRef $returning_message
+If you want complete inspection of passthrough data, take a look at the
+L</Dlog_$level> functions.
 
-=head2 log_warn
+Which functions are exported depends on what was passed to L</-levels>.  The
+default (no C<-levels> option passed) would export:
 
- log_warn { 'possible misconfiguration at line 10' };
+=over 2
 
-Arguments: CodeRef $returning_message
+=item log_trace
 
-=head2 log_error
+=item log_debug
 
- log_error { 'non-numeric user input!' };
+=item log_info
 
-Arguments: CodeRef $returning_message
+=item log_warn
 
-=head2 log_fatal
+=item log_error
+
+=item log_fatal
+
+=back
+
+=head2 logS_$level
+
+Import Tag: C<:log>
+
+Arguments: C<CodeRef $returning_message, Item $arg>
+
+This is really just a special case of the L</log_$level> functions.  It forces
+scalar context when that is what you need.  Other than that it works exactly
+same:
+
+ my $friend = logS_trace {
+   'I only have one friend: ' .  Dumper($_[0]->TO_JSON)
+ } friend();
+
+See also: L</DlogS_$level>.
+
+=head2 Dlog_$level
+
+Import Tag: C<:dlog>
+
+Arguments: C<CodeRef $returning_message, @args>
+
+All of the following six functions work the same as their L</log_$level>
+brethren, except they return what is passed into them and put the stringified
+(with L<Data::Dumper::Concise>) version of their args into C<$_>.  This means
+you can do cool things like the following:
+
+ my @nicks = Dlog_debug { "names: $_" } map $_->value, $frew->names->all;
+
+and the output might look something like:
+
+ names: "fREW"
+ "fRIOUX"
+ "fROOH"
+ "fRUE"
+ "fiSMBoC"
+
+Which functions are exported depends on what was passed to L</-levels>.  The
+default (no C<-levels> option passed) would export:
+
+=over 2
+
+=item Dlog_trace
+
+=item Dlog_debug
+
+=item Dlog_info
+
+=item Dlog_warn
+
+=item Dlog_error
+
+=item Dlog_fatal
+
+=back
+
+=head2 DlogS_$level
+
+Import Tag: C<:dlog>
+
+Arguments: C<CodeRef $returning_message, Item $arg>
+
+Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
+They only take a single scalar after the C<$returning_message> instead of
+slurping up (and also setting C<wantarray>) all the C<@args>
+
+ my $pals_rs = DlogS_debug { "pals resultset: $_" }
+   $schema->resultset('Pals')->search({ perlers => 1 });
+
+=head1 LOGGER CODEREF
+
+Anywhere a logger object can be passed, a coderef is accepted.  This is so
+that the user can use different logger objects based on runtime information.
+The logger coderef is passed the package of the caller the caller level the
+coderef needs to use if it wants more caller information.  The latter is in
+a hashref to allow for more options in the future.
+
+Here is a basic example of a logger that exploits C<caller> to reproduce the
+output of C<warn> with a logger:
+
+ my @caller_info;
+ my $var_log = Log::Contextual::SimpleLogger->new({
+    levels  => [qw(trace debug info warn error fatal)],
+    coderef => sub { chomp($_[0]); warn "$_[0] at $caller_info[1] line $caller_info[2].\n" }
+ });
+ my $warn_faker = sub {
+    my ($package, $args) = @_;
+    @caller_info = caller($args->{caller_level});
+    $var_log
+ };
+ set_logger($warn_faker);
+ log_debug { 'test' };
+
+The following is an example that uses the information passed to the logger
+coderef.  It sets the global logger to C<$l3>, the logger for the C<A1>
+package to C<$l1>, except the C<lol> method in C<A1> which uses the C<$l2>
+logger and lastly the logger for the C<A2> package to C<$l2>.
+
+Note that it increases the caller level as it dispatches based on where
+the caller of the log function, not the log function itself.
+
+ my $complex_dispatcher = do {
+
+    my $l1 = ...;
+    my $l2 = ...;
+    my $l3 = ...;
+
+    my %registry = (
+       -logger => $l3,
+       A1 => {
+          -logger => $l1,
+          lol     => $l2,
+       },
+       A2 => { -logger => $l2 },
+    );
+
+    sub {
+       my ( $package, $info ) = @_;
+
+       my $logger = $registry{'-logger'};
+       if (my $r = $registry{$package}) {
+          $logger = $r->{'-logger'} if $r->{'-logger'};
+          my (undef, undef, undef, $sub) = caller($info->{caller_level} + 1);
+          $sub =~ s/^\Q$package\E:://g;
+          $logger = $r->{$sub} if $r->{$sub};
+       }
+       return $logger;
+    }
+ };
 
- log_fatal { '1 is never equal to 0!' };
+ set_logger $complex_dispatcher;
 
-Arguments: CodeRef $returning_message
+=head1 LOGGER INTERFACE
 
-=head1 SUGARY SYNTAX
+Because this module is ultimately pretty looking glue (glittery?) with the
+awesome benefit of the Contextual part, users will often want to make their
+favorite logger work with it.  The following are the methods that should be
+implemented in the logger:
 
-This package also provides:
+ is_trace
+ is_debug
+ is_info
+ is_warn
+ is_error
+ is_fatal
+ trace
+ debug
+ info
+ warn
+ error
+ fatal
 
-L<Log::Contextual::Sugar> - provides Dlog_$level and DlogS_$level convenience
-functions
+The first six merely need to return true if that level is enabled.  The latter
+six take the results of whatever the user returned from their coderef and log
+them.  For a basic example see L<Log::Contextual::SimpleLogger>.
 
 =head1 AUTHOR
 
@@ -319,7 +636,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
@@ -329,8 +646,3 @@ Perl 5 itself.
 
 =cut
 
-.:13:03:05:. <@mst> amazing how simple this stuff is once you get the paradigm
-.:13:03:13:. <@mst> also consider
-.:13:04:17:. <@mst> package Catalyst::Plugin::LogContextual; use Moose::Role; around
-                    handle_request => sub { my ($orig, $self) = (shift, shift); my @args = @_;
-                    with_logger { $self->log } sub { $self->$orig(@args) } };