X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=1d0a1dca966de1903ba032dd5c71811c41d98f46;hb=0c180ced3d15f9851c4ae1cf4ea984c026f67b3f;hp=23770bb96588aeb3ca66c386db27e5283522de08;hpb=b144ba01913732526954180c295cd8865bf84f3f;p=p5sagit%2FLog-Contextual.git diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm index 23770bb..1d0a1dc 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.00300'; +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 { 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; @@ -98,7 +122,7 @@ sub _get_logger($) { $Get_Logger || $Default_Logger{$package} || die q( no logger set! you can't try to log something without a logger! ) - )->($package); + )->($package, { caller_level => 2 }); } sub set_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: =head1 DESCRIPTION -This module is a simple interface to extensible logging. 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.) +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 -=head1 OPTIONS +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 @@ -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, 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 @@ -336,17 +351,46 @@ Basically it sets the logger to be used if C 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 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 @@ -355,7 +399,7 @@ probably make C<:log> the default. But only time and usage will tell. my $logger = WarnLogger->new; set_logger $logger; -Arguments: C +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 @@ -374,7 +418,7 @@ more than once. } }; -Arguments: C +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 @@ -386,7 +430,7 @@ Import Tag: C<:log> Arguments: C -All of the following six functions work the same except that a different method +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 (&@) { @@ -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 functions. -=head3 log_trace - - log_trace { 'entered method foo with args ' join q{,}, @args }; +Which functions are exported depends on what was passed to L. The +default (no C<-levels> option passed) would export: -=head3 log_debug +=over 2 - log_debug { 'entered method foo' }; +=item log_trace -=head3 log_info +=item log_debug - log_info { 'started process foo' }; +=item log_info -=head3 log_warn +=item log_warn - log_warn { 'possible misconfiguration at line 10' }; +=item log_error -=head3 log_error +=item log_fatal - 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 +Which functions are exported depends on what was passed to L. The +default (no C<-levels> option passed) would export: - Dlog_debug { "random data structure: $_" } { foo => $bar }; +=over 2 -=head3 Dlog_info +=item Dlog_trace - return Dlog_info { "html from method returned: $_" } "..."; +=item Dlog_debug -=head3 Dlog_warn +=item Dlog_info - Dlog_warn { "probably invalid value: $_" } $foo; +=item Dlog_warn -=head3 Dlog_error +=item Dlog_error - Dlog_error { "non-numeric user input! ($_)" } $port; +=item Dlog_fatal -=head3 Dlog_fatal - - Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0; +=back =head2 DlogS_$level @@ -505,6 +539,69 @@ 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 @@ -539,7 +636,7 @@ 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