X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FLog%2FContextual.pm;h=596c155e807d3bfd9316e0c8d1116bc14332d448;hb=3ccc9c473fae3fc33dc3863734c75fda552939d9;hp=adfca1ab0e34c31cbdf9fdaefa30b6dc7cbe4dfc;hpb=7cec609cfa15bdf1f4cf2132273c55d0e1999f42;p=p5sagit%2FLog-Contextual.git diff --git a/lib/Log/Contextual.pm b/lib/Log/Contextual.pm index adfca1a..596c155 100644 --- a/lib/Log/Contextual.pm +++ b/lib/Log/Contextual.pm @@ -1,53 +1,611 @@ +# add example for Log::Dispatchouli +# +# make basic warn logger + + package Log::Contextual; +use strict; +use warnings; + +our $VERSION = '0.00101'; + +require Exporter; +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 + )); + +our @EXPORT_OK = ( + @dlog, @log, + qw( set_logger with_logger ) +); + +our %EXPORT_TAGS = ( + dlog => \@dlog, + log => \@log, + all => [@dlog, @log], +); + +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 '-default_logger' ) { + _set_default_logger_for(scalar caller, $_[$idx + 1]); + splice @_, $idx, 2; + } + } + $package->export_to_level(1, $package, @_); +} + our $Get_Logger; +our %Default_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 _get_logger($) { + my $package = shift; + ( + $Get_Logger || + $Default_Logger{$package} || + die q( no logger set! you can't try to log something without a logger! ) + )->($package); +} sub set_logger { - $Get_Logger = $_[0]; + 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 { + 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 log_debug (&) { - my $log = $Get_Logger->(); - $log->debug($_[0]->()) + + +sub log_trace (&@) { + my $log = _get_logger( caller ); + my $code = shift; + $log->trace($code->(@_)) + if $log->is_trace; + @_ +} + +sub log_debug (&@) { + my $log = _get_logger( caller ); + my $code = shift; + $log->debug($code->(@_)) if $log->is_debug; + @_ } -sub with_logger { - local $Get_Logger = $_[0]; - $_[1]->() +sub log_info (&@) { + my $log = _get_logger( caller ); + my $code = shift; + $log->info($code->(@_)) + if $log->is_info; + @_ +} + +sub log_warn (&@) { + my $log = _get_logger( caller ); + my $code = shift; + $log->warn($code->(@_)) + if $log->is_warn; + @_ +} + +sub log_error (&@) { + my $log = _get_logger( caller ); + my $code = shift; + $log->error($code->(@_)) + if $log->is_error; + @_ +} + +sub log_fatal (&@) { + my $log = _get_logger( caller ); + my $code = shift; + $log->fatal($code->(@_)) + if $log->is_fatal; + @_ +} + + +sub logS_trace (&$) { + my $log = _get_logger( caller ); + my $code = shift; + my $value = shift; + $log->trace($code->($value)) + if $log->is_trace; + $value +} + +sub logS_debug (&$) { + my $log = _get_logger( caller ); + my $code = shift; + my $value = shift; + $log->debug($code->($value)) + if $log->is_debug; + $value +} + +sub logS_info (&$) { + my $log = _get_logger( caller ); + my $code = shift; + my $value = shift; + $log->info($code->($value)) + if $log->is_info; + $value +} + +sub logS_warn (&$) { + my $log = _get_logger( caller ); + my $code = shift; + my $value = shift; + $log->warn($code->($value)) + if $log->is_warn; + $value +} + +sub logS_error (&$) { + my $log = _get_logger( caller ); + my $code = shift; + my $value = shift; + $log->error($code->($value)) + if $log->is_error; + $value +} + +sub logS_fatal (&$) { + my $log = _get_logger( caller ); + my $code = shift; + my $value = shift; + $log->fatal($code->($value)) + if $log->is_fatal; + $value +} + + + +sub Dlog_trace (&@) { + my $code = shift; + my @values = @_; + return log_trace { + if (@values) { + do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() }; + } else { + do { local $_ = '()'; $code->() }; + } + } @values +} + +sub Dlog_debug (&@) { + my $code = shift; + my @values = @_; + log_debug { + if (@values) { + do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() }; + } else { + do { local $_ = '()'; $code->() }; + } + } @values +} + +sub Dlog_info (&@) { + my $code = shift; + my @values = @_; + log_info { + if (@values) { + do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() }; + } else { + do { local $_ = '()'; $code->() }; + } + } @values +} + +sub Dlog_warn (&@) { + my $code = shift; + my @values = @_; + log_warn { + if (@values) { + do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() }; + } else { + do { local $_ = '()'; $code->() }; + } + } @values +} + +sub Dlog_error (&@) { + my $code = shift; + my @values = @_; + log_error { + if (@values) { + do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() }; + } else { + do { local $_ = '()'; $code->() }; + } + } @values +} + +sub Dlog_fatal (&@) { + my $code = shift; + my @values = @_; + log_fatal { + if (@values) { + do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() }; + } else { + do { local $_ = '()'; $code->() }; + } + } @values +} + + + +sub DlogS_trace (&$) { + my $code = $_[0]; + my $value = $_[1]; + logS_trace { + do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() }; + } $value +} + +sub DlogS_debug (&$) { + my $code = $_[0]; + my $value = $_[1]; + logS_debug { + do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() }; + } $value +} + +sub DlogS_info (&$) { + my $code = $_[0]; + my $value = $_[1]; + logS_info { + do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() }; + } $value +} + +sub DlogS_warn (&$) { + my $code = $_[0]; + my $value = $_[1]; + logS_warn { + do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() }; + } $value +} + +sub DlogS_error (&$) { + my $code = $_[0]; + my $value = $_[1]; + logS_error { + do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() }; + } $value +} + +sub DlogS_fatal (&$) { + my $code = $_[0]; + my $value = $_[1]; + logS_fatal { + do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() }; + } $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 { + with_logger(Log::Contextual::SimpleLogger->new({ + levels => [qw( trace debug )] + }) => sub { + log_trace { 'foo entered' }; + my ($foo, $bar) = Dlog_trace { "params for foo: $_" } @_; + # ... + log_trace { 'foo left' }; + }); + } + + foo(); + +=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, take a look at L. + +=head1 OPTIONS + +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; + +=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 FUNCTIONS + +=head2 set_logger + + my $logger = WarnLogger->new; + set_logger $logger; + +Arguments: C + +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: 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 + +All of the following six functions 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. + +=head3 log_trace + + log_trace { 'entered method foo with args ' join q{,}, @args }; + +=head3 log_debug + + log_debug { 'entered method foo' }; + +=head3 log_info + + log_info { 'started process foo' }; + +=head3 log_warn + + log_warn { 'possible misconfiguration at line 10' }; + +=head3 log_error + + log_error { 'non-numeric user input!' }; + +=head3 log_fatal + + log_fatal { '1 is never equal to 0!' }; + +=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" + +=head3 Dlog_trace + + my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_; + +=head3 Dlog_debug + + Dlog_debug { "random data structure: $_" } { foo => $bar }; + +=head3 Dlog_info + + return Dlog_info { "html from method returned: $_" } "..."; + +=head3 Dlog_warn + + Dlog_warn { "probably invalid value: $_" } $foo; + +=head3 Dlog_error + + Dlog_error { "non-numeric user input! ($_)" } $port; + +=head3 Dlog_fatal + + Dlog_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0; + +=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 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) 2010 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