-# add example for Log::Dispatchouli
-#
-# make basic warn logger
-
-
package Log::Contextual;
use strict;
use warnings;
-our $VERSION = '0.00101';
+our $VERSION = '0.00202';
require Exporter;
use Data::Dumper::Concise;
unless @_;
for my $idx ( 0 .. $#_ ) {
- if ( $_[$idx] eq '-logger' ) {
+ my $val = $_[$idx];
+ if ( defined $val && $val eq '-logger' ) {
set_logger($_[$idx + 1]);
splice @_, $idx, 2;
- } elsif ( $_[$idx] eq '-default_logger' ) {
- set_default_logger_for(scalar caller, $_[$idx + 1]);
+ } 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;
}
}
our $Get_Logger;
our %Default_Logger;
+our %Package_Logger;
-sub _set_default_logger_for { $Default_Logger{$_[0]} = $_[1] }
+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! )
$_[1]->();
}
+sub _do_log {
+ my $level = shift;
+ my $logger = shift;
+ my $code = shift;
+ my @values = @_;
-
-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 log_info (&@) {
- my $log = _get_logger( caller );
- my $code = shift;
- $log->info($code->(@_))
- if $log->is_info;
- @_
+ local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
+ $logger->$level($code->(@_))
+ if $logger->${\"is_$level"};
+ @values
}
-sub log_warn (&@) {
- my $log = _get_logger( caller );
- my $code = shift;
- $log->warn($code->(@_))
- if $log->is_warn;
- @_
-}
+sub _do_logS {
+ my $level = shift;
+ my $logger = shift;
+ my $code = shift;
+ my $value = shift;
-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;
+ local $Log::Log4perl::caller_depth = ($Log::Log4perl::caller_depth || 0 ) + 2;
+ $logger->$level($code->($value))
+ if $logger->${\"is_$level"};
$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 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;
- my @values = @_;
- return log_trace {
- if (@values) {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- } else {
- do { local $_ = '()'; $code->() };
- }
- } @values
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( trace => _get_logger( caller ), $code, @_ );
}
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
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( debug => _get_logger( caller ), $code, @_ );
}
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
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( info => _get_logger( caller ), $code, @_ );
}
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
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( warn => _get_logger( caller ), $code, @_ );
}
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
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( error => _get_logger( caller ), $code, @_ );
}
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
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ return _do_log( fatal => _get_logger( caller ), $code, @_ );
}
-
sub DlogS_trace (&$) {
- my $code = $_[0];
- my $value = $_[1];
- logS_trace {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- } $value
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( trace => _get_logger( caller ), $_[0], $_[1] )
}
sub DlogS_debug (&$) {
- my $code = $_[0];
- my $value = $_[1];
- logS_debug {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- } $value
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( debug => _get_logger( caller ), $_[0], $_[1] )
}
sub DlogS_info (&$) {
- my $code = $_[0];
- my $value = $_[1];
- logS_info {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- } $value
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( info => _get_logger( caller ), $_[0], $_[1] )
}
sub DlogS_warn (&$) {
- my $code = $_[0];
- my $value = $_[1];
- logS_warn {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- } $value
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( warn => _get_logger( caller ), $_[0], $_[1] )
}
sub DlogS_error (&$) {
- my $code = $_[0];
- my $value = $_[1];
- logS_error {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- } $value
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( error => _get_logger( caller ), $_[0], $_[1] )
}
sub DlogS_fatal (&$) {
- my $code = $_[0];
- my $value = $_[1];
- logS_fatal {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- } $value
+ local $_ = Data::Dumper::Concise::Dumper $_[1];
+ _do_logS( fatal => _get_logger( caller ), $_[0], $_[1] )
}
1;
foo();
+Beginning with version 1.008 L<Log::Dispatchouli> also works out of the box
+with C<Log::Contextual>:
+
+ 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
This module is a simple interface to extensible logging. 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, take a look at L<Log::Dispatchouli>.
+overly complicated, try L<Log::Dispatchouli> (see L</SYNOPSIS> for example.)
=head1 OPTIONS
+=head2 -logger
+
When you import this module you may use C<-logger> as a shortcut for
L<set_logger>, for example:
BEGIN { $var_log = VarLogger->new }
use Log::Contextual qw( :dlog ), -logger => $var_log;
+=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.
+
+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 A WORK IN PROGRESS
This module is certainly not complete, but we will not break the interface
projects / p5sagit/Log-Contextual.git / blobdiff