X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=495781ea275fe652ac9d99b6c9f1d8702da08246;hb=27141a7ad9039b0ae6b731f3f11e56ce11b8fbab;hp=165096d63b768c37881589c18f3c8b04319f8912;hpb=2033c911d249cbd91248eb2b8335fd8dff377307;p=p5sagit%2FLog-Contextual.git diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm index 165096d..495781e 100644 --- a/lib/Log/Contextual.pm +++ b/lib/Log/Contextual.pm @@ -1,63 +1,629 @@ package Log::Contextual; -use 5.006; +use strict; +use warnings; -$VERSION = '1.000'; +our $VERSION = '0.004100'; -require Exporter; +my @levels = qw(debug trace warn info error fatal); -BEGIN { @ISA = qw(Exporter) } +use Exporter::Declare; +use Exporter::Declare::Export::Generator; +use Data::Dumper::Concise; +use Scalar::Util 'blessed'; -@EXPORT = qw(set_logger log_debug with_logger); +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 ____ {} + +exports ('____', + @dlog, @log, + qw( set_logger with_logger ) +); + +export_tag dlog => ('____'); +export_tag log => ('____'); +import_arguments qw(logger package_logger default_logger); + +sub before_import { + my ($class, $importer, $spec) = @_; + + 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 ) + }); + } + } +} + +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_logger { - $Get_Logger = $_[0]; +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 log_debug (&) { - my $log = $Get_Logger->(); - $log->debug($_[0]->()) - if $log->is_debug; +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 => 3 }); +} + +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 } } + } + + warn 'set_logger (or -logger) called more than once! This is a bad idea!' + if $Get_Logger; + $Get_Logger = $logger; } sub with_logger { - local $Get_Logger = $_[0]; - $_[1]->() + 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 } } + } + local $Get_Logger = $logger; + $_[1]->(); +} + +sub _do_log { + my $level = shift; + my $logger = shift; + my $code = shift; + my @values = @_; + + $logger->$level($code->(@_)) + if $logger->${\"is_$level"}; + @values +} + +sub _do_logS { + my $level = shift; + my $logger = shift; + my $code = shift; + my $value = shift; + + $logger->$level($code->($value)) + if $logger->${\"is_$level"}; + $value } 1; __END__ -.:12:44:33:. <@mst> we have a $Get_Logger global that contains a subref -.:12:45:11:. <@mst> sub log_debug (&) { my $log = $Get_Logger->(); if ($log->is_debug) { - $log->debug($_[0]->()} } } -.:13:01:22:. >>@mst<< frew: the other part is we'll need a set_logger function that's global -.:13:01:26:. >>@mst<< frew: plus a with_logger function -.:13:01:33:. >>@mst<< frew: that uses local() -.:13:01:38:. <@mst> that should be enough to make a start -.:13:01:48:. <@frew> so with_logger is what gives us context? -.:13:01:57:. <@mst> right -.:13:02:09:. <@mst> with_logger { $logger }, sub { }; -.:13:02:29:. <@mst> sub with_logger { local $Get_Logger = $_[0]; $_[1]->() } -.: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) } }; -.:13:03:43:. <@frew> so why is $G_L a subref instead of just a ref? to allow for lazy - instantiation or what? -.:13:06:37:. <@mst> it does the caller introspection there IIRC -.:13:09:56:. <@mst> I've spent like a year thinking about how to do logging sanely -.:13:10:17:. <@mst> having it turn out to be this bloody trivial to implement amuses me -.:13:10:43:. <@frew> mst: I guess that's why thinking about it for a year is worth it :-) -.:13:12:01:. <@mst> there's a couple other things we'll want, I suspect -.:13:12:18:. <@mst> like a concept of depth and a category system separate from the logger -.:13:12:24:. <@mst> but those can be handled later atop this API -.:13:13:35:. <@frew> so like, logging from the model, logging from the controller, logging from - the DBIDS part of the model vs the DBIC part of the model ? -.:13:14:13:. <@mst> that sort of thing -.:13:14:20:. <@mst> how much of that we can delegate to the logger I dunno yet +=head1 NAME + +Log::Contextual - Simple logging interface with a contextual log + +=head1 SYNOPSIS + + use Log::Contextual qw( :log :dlog set_logger with_logger ); + use Log::Contextual::SimpleLogger; + use Log::Log4perl ':easy'; + Log::Log4perl->easy_init($DEBUG); + + my $logger = Log::Log4perl->get_logger; + + set_logger $logger; + + log_debug { 'program started' }; + + sub foo { + + 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(); + +Beginning with version 1.008 L also works out of the box +with C: + + use Log::Contextual qw( :log :dlog set_logger ); + use Log::Dispatchouli; + my $ld = Log::Dispatchouli->new({ + ident => 'slrtbrfst', + to_stderr => 1, + debug => 1, + }); + + set_logger $ld; + + log_debug { 'program started' }; + +=head1 DESCRIPTION + +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 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; + +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 for information on setting these project +wide. + +=head2 -logger + +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 + + 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; + +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 { + if (1 == 0) { + log_fatal { 'Non Logical Universe Detected' }; + } else { + log_info { 'All is good' }; + } + }; + +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> + +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->(@_)); + } + @_ + } + +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 + + my @friends = log_trace { + 'friends list being generated, data from first friend: ' . + Dumper($_[0]->TO_JSON) + } generate_friend_list(); + +If you want complete inspection of passthrough data, take a look at the +L functions. + +Which functions are exported depends on what was passed to L. The +default (no C<-levels> option passed) would export: + +=over 2 + +=item log_trace + +=item log_debug + +=item log_info + +=item log_warn + +=item log_error + +=item log_fatal + +=back + +=head2 logS_$level + +Import Tag: C<:log> + +Arguments: C + +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: + + my $friend = logS_trace { + 'I only have one friend: ' . Dumper($_[0]->TO_JSON) + } friend(); + +See also: L. + +=head2 Dlog_$level + +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. + +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>. + + 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}); + $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 AUTHOR + +frew - Arthur Axel "fREW" Schmidt + +=head1 DESIGNER + +mst - Matt S. Trout + +=head1 COPYRIGHT + +Copyright (c) 2012 the Log::Contextual L and L as listed +above. + +=head1 LICENSE + +This library is free software and may be distributed under the same terms as +Perl 5 itself. + +=cut