X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=e5ea99958146031979416e54dba04746d6304b4f;hb=84d7d9ee2754784b80f49f2456a49429086821e3;hp=9915155c510a4e37b9483ca7273c84ef4e1d4d68;hpb=f11f9542711c651746cf31e1ef1ccad0b5c52eb6;p=p5sagit%2FLog-Contextual.git diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm index 9915155..e5ea999 100644 --- a/lib/Log/Contextual.pm +++ b/lib/Log/Contextual.pm @@ -1,252 +1,397 @@ package Log::Contextual; -use 5.006; +use strict; +use warnings; -$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'; -BEGIN { @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 -}); - -@EXPORT_OK = ( - @dlog, @log, - qw{set_logger with_logger} -); - -%EXPORT_TAGS = ( - dlog => \@dlog, - log => \@log, -); - -sub import { - die 'Log::Contextual does not have a default import list' - if @_ == 1; - __PACKAGE__->export_to_level(1, shift, @_); -} +eval { + require Log::Log4perl; + die if $Log::Log4perl::VERSION < 1.29; + Log::Log4perl->wrapper_register(__PACKAGE__) +}; -our $Get_Logger; +# ____ is because tags must have at least one export and we don't want to +# export anything but the levels selected +sub ____ { } -sub set_logger (&) { - $Get_Logger = $_[0]; -} +exports(qw(____ set_logger with_logger )); -sub with_logger { - my $logger = $_[0]; - $logger = do { my $l = $logger; sub { $l } } - if ref $logger ne 'CODE'; - local $Get_Logger = $logger; - $_[1]->(); -} +export_tag dlog => ('____'); +export_tag log => ('____'); +import_arguments qw(logger package_logger default_logger); -sub log_trace (&) { - my $log = $Get_Logger->(); - $log->trace($_[0]->()) - if $log->is_trace; +sub router { + our $Router_Instance ||= do { + require Log::Contextual::Router; + Log::Contextual::Router->new + } } -sub log_debug (&) { - my $log = $Get_Logger->(); - $log->debug($_[0]->()) - if $log->is_debug; -} +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 + ); -sub log_info (&) { - my $log = $Get_Logger->(); - $log->info($_[0]->()) - if $log->is_info; + die 'Log::Contextual does not have a default import list' + if $spec->config->{default}; + + $router->before_import(%router_args); + + if ($exports->{'&set_logger'}) { + die ref($router) . " does not support set_logger()" + unless $router->does('Log::Contextual::Role::Router::SetLogger'); + + $spec->add_export('&set_logger', sub { $router->set_logger(@_) }) + } + + if ($exports->{'&with_logger'}) { + die ref($router) . " does not support with_logger()" + unless $router->does('Log::Contextual::Role::Router::WithLogger'); + + $spec->add_export('&with_logger', sub { $router->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]; + }); + } + 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; + }); + } + } } -sub log_warn (&) { - my $log = $Get_Logger->(); - $log->warn($_[0]->()) - if $log->is_warn; +sub after_import { + my ($class, $importer, $spec) = @_; + my %router_args = ( + exporter => $class, + target => $importer, + arguments => $spec->argument_info + ); + $class->router->after_import(%router_args); } -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 also works out of the box +with C: -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 prefixed methods only C 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 is an interface for all major loggers. If you log through +C you will be able to swap underlying loggers later. + +=item * Powerful + +C chooses which logger to use based on L<< user defined Cs|/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 and then as your needs grow you can switch to +L or L or L 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, +but in general you should use a real logger instead of that. For something +more serious but not overly complicated, try L (see +L 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 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, 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, but it doesn't support the levels for L. But +supporting those levels is as easy as doing -This module is for simplistic but very extensible logging. + 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, C<-package_logger> cannot be overridden with +L. + + 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 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 logger for the current package. + +Basically it sets the logger to be used if C 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 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. 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 method will get C<$foo> and your C +will get C<[qw(bar baz biff)]>; =head1 FUNCTIONS =head2 set_logger my $logger = WarnLogger->new; - set_logger { $logger }; + set_logger $logger; -Arguments: CodeRef $returning_logger +Arguments: L + +C will just set the current logger to whatever you pass it. It +expects a C, but if you pass it something else it will wrap it in a +C for you. C 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 { @@ -254,62 +399,242 @@ Arguments: CodeRef $returning_logger } }; -Arguments: CodeRef $to_execute, CodeRef $returning_logger +Arguments: L, C + +C sets the logger for the scope of the C C<$to_execute>. +As with L, C will wrap C<$returning_logger> with a +C if needed. + +=head2 log_$level + +Import Tag: C<:log> -=head2 log_trace +Arguments: C + +C 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 (&@) { + if ($logger->is_$level) { + $logger->$level(shift->(@_)); + } + @_ + } - log_trace { 'entered method foo with args ' join q{,}, @args }; +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 -Arguments: CodeRef $returning_message + my @friends = log_trace { + 'friends list being generated, data from first friend: ' . + Dumper($_[0]->TO_JSON) + } generate_friend_list(); -=head2 log_debug +If you want complete inspection of passthrough data, take a look at the +L functions. - log_debug { 'entered method foo' }; +Which functions are exported depends on what was passed to L. The +default (no C<-levels> option passed) would export: -Arguments: CodeRef $returning_message +=over 2 -=head2 log_info +=item log_trace - log_info { 'started process foo' }; +=item log_debug -Arguments: CodeRef $returning_message +=item log_info -=head2 log_warn +=item log_warn - log_warn { 'possible misconfiguration at line 10' }; +=item log_error -Arguments: CodeRef $returning_message +=item log_fatal -=head2 log_error +=back - log_error { 'non-numeric user input!' }; +=head2 logS_$level -Arguments: CodeRef $returning_message +Import Tag: C<:log> -=head2 log_fatal +Arguments: C - log_fatal { '1 is never equal to 0!' }; +This is really just a special case of the L functions. It forces +scalar context when that is what you need. Other than that it works exactly +same: -Arguments: CodeRef $returning_message + my $friend = logS_trace { + 'I only have one friend: ' . Dumper($_[0]->TO_JSON) + } friend(); -=head1 SUGARY SYNTAX +See also: L. -This package also provides: +=head2 Dlog_$level -L - provides Dlog_$level and DlogS_$level convenience -functions +Import Tag: C<:dlog> + +Arguments: C + +All of the following six functions work the same as their L +brethren, except they return what is passed into them and put the stringified +(with L) 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. 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 + +Like L, these functions are a special case of L. +They only take a single scalar after the C<$returning_message> instead of +slurping up (and also setting C) 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 to reproduce the +output of C 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 +package to C<$l1>, except the C method in C which uses the C<$l2> +logger and lastly the logger for the C 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; + } + }; + + set_logger $complex_dispatcher; + +=head1 LOGGER INTERFACE + +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: + + is_trace + is_debug + is_info + is_warn + is_error + is_fatal + trace + debug + info + warn + error + fatal + +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. + +=head1 LOG ROUTING + +In between the loggers and the log functions is a log router that is responsible for +finding a logger to handle the log event and passing the log information to the +logger. This relationship is described in the documentation for C. + +C and packages that extend it will by default share a router singleton that +implements the with_logger() and set_logger() functions and also respects the -logger, +-package_logger, and -default_logger import options with their associated default value +functions. The router singleton is available as the return value of the router() function. Users +of Log::Contextual may overload router() to return instances of custom log routers that +could for example work with loggers that use a different interface. =head1 AUTHOR frew - Arthur Axel "fREW" Schmidt +=head1 CONTRIBUTORS + +triddle - Tyler Riddle + =head1 DESIGNER mst - Matt S. Trout =head1 COPYRIGHT -Copyright (c) 2010 the Log::Contextual L and L as listed +Copyright (c) 2012 the Log::Contextual L and L as listed above. =head1 LICENSE @@ -319,8 +644,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) } };