+# add example for Log::Dispatchouli
+#
+# make basic warn logger
+
+
package Log::Contextual;
use strict;
use warnings;
-our $VERSION = '1.000';
+our $VERSION = '0.00101';
require Exporter;
use Data::Dumper::Concise;
+use Scalar::Util 'blessed';
BEGIN { our @ISA = qw(Exporter) }
-my @dlog = (qw{
+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
-});
+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}
+ qw( set_logger with_logger )
);
our %EXPORT_TAGS = (
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;
- last;
+ } 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 {
my $logger = $_[0];
- $logger = do { my $l = $logger; sub { $l } }
- if ref $logger ne 'CODE';
+ 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];
- $logger = do { my $l = $logger; sub { $l } }
- if ref $logger ne 'CODE';
+ 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_trace (&) {
- my $log = $Get_Logger->();
- $log->trace($_[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->();
- $log->debug($_[0]->())
+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->();
- $log->info($_[0]->())
+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->();
- $log->warn($_[0]->())
+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->();
- $log->error($_[0]->())
+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->();
- $log->fatal($_[0]->())
+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 Dlog_trace (&@) {
- my $code = shift;
- my @values = @_;
- log_trace {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- };
- @values
+sub logS_info (&$) {
+ my $log = _get_logger( caller );
+ my $code = shift;
+ my $value = shift;
+ $log->info($code->($value))
+ if $log->is_info;
+ $value
}
-sub DlogS_trace (&$) {
- my $code = $_[0];
- my $value = $_[1];
- log_trace {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- };
- $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 Dlog_debug (&@) {
+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 = @_;
- log_debug {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- };
- @values
+ return log_trace {
+ if (@values) {
+ do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
+ } else {
+ do { local $_ = '()'; $code->() };
+ }
+ } @values
}
-sub DlogS_debug (&$) {
- my $code = $_[0];
- my $value = $_[1];
+sub Dlog_debug (&@) {
+ my $code = shift;
+ my @values = @_;
log_debug {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- };
- $value
+ 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 {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- };
- @values
-}
-
-sub DlogS_info (&$) {
- my $code = $_[0];
- my $value = $_[1];
- log_info {
- do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- };
- $value
+ 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 {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- };
- @values
+ if (@values) {
+ do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
+ } else {
+ do { local $_ = '()'; $code->() };
+ }
+ } @values
}
-sub DlogS_warn (&$) {
+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];
- log_warn {
+ logS_trace {
do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- };
- $value
+ } $value
}
-sub Dlog_error (&@) {
- my $code = shift;
- my @values = @_;
- log_error {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- };
- @values
+sub DlogS_debug (&$) {
+ my $code = $_[0];
+ my $value = $_[1];
+ logS_debug {
+ do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
+ } $value
}
-sub DlogS_error (&$) {
+sub DlogS_info (&$) {
my $code = $_[0];
my $value = $_[1];
- log_error {
+ logS_info {
do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- };
- $value
+ } $value
}
-sub Dlog_fatal (&@) {
- my $code = shift;
- my @values = @_;
- log_fatal {
- do { local $_ = Data::Dumper::Concise::Dumper @values; $code->() };
- };
- @values
+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];
- log_fatal {
+ logS_fatal {
do { local $_ = Data::Dumper::Concise::Dumper $value; $code->() };
- };
- $value
+ } $value
}
1;
=head1 NAME
-Log::Contextual - Super simple logging interface
+Log::Contextual - Simple logging interface with a contextual log
=head1 SYNOPSIS
- use Log::Contextual qw{:log set_logger with_logger};
+ 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::Contextual::SimpleLogger->new({ levels => [qw{debug}]});
+ my $logger = Log::Log4perl->get_logger;
- set_logger { $logger };
+ set_logger $logger;
- log_debug { "program started" };
+ log_debug { 'program started' };
sub foo {
- with_logger Log::Contextual::SimpleLogger->new({
- levels => [qw{trace debug}]
+ 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
L<set_logger>, for example:
use Log::Contextual::SimpleLogger;
- use Log::Contextual qw{:dlog},
- -logger => Log::Contextual::SimpleLogger->new({ levels => [qw{ debug }] });
+ 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;
+ use Log::Contextual qw( :dlog ), -logger => $var_log;
=head1 A WORK IN PROGRESS
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.
+probably make C<:log> the default. But only time and usage will tell.
=head1 FUNCTIONS
my $logger = WarnLogger->new;
set_logger $logger;
-Arguments: Ref|CodeRef $returning_logger
+Arguments: C<Ref|CodeRef $returning_logger>
C<set_logger> will just set the current logger to whatever you pass it. It
expects a C<CodeRef>, but if you pass it something else it will wrap it in a
-C<CodeRef> for you.
+C<CodeRef> for you. C<set_logger> 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
}
};
-Arguments: Ref|CodeRef $returning_logger, CodeRef $to_execute
+Arguments: C<Ref|CodeRef $returning_logger, CodeRef $to_execute>
C<with_logger> sets the logger for the scope of the C<CodeRef> C<$to_execute>.
-as with L<set_logger>, C<with_logger> will wrap C<$returning_logger> with a
+As with L</set_logger>, C<with_logger> will wrap C<$returning_logger> with a
C<CodeRef> if needed.
=head2 log_$level
-Import Tag: ":log"
+Import Tag: C<:log>
-Arguments: CodeRef $returning_message
+Arguments: C<CodeRef $returning_message, @args>
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 (&) {
+ sub log_$level (&@) {
if ($logger->is_$level) {
- $logger->$level(shift->());
+ $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</Dlog_$level> functions.
+
=head3 log_trace
log_trace { 'entered method foo with args ' join q{,}, @args };
log_fatal { '1 is never equal to 0!' };
+=head2 logS_$level
+
+Import Tag: C<:log>
+
+Arguments: C<CodeRef $returning_message, Item $arg>
+
+This is really just a special case of the L</log_$level> 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</DlogS_$level>.
+
=head2 Dlog_$level
-Import Tag: ":dlog"
+Import Tag: C<:dlog>
-Arguments: CodeRef $returning_message, @args
+Arguments: C<CodeRef $returning_message, @args>
-All of the following six functions work the same as their L<log_$level> brethren,
-except they return what is passed into them and as a bonus put the stringified
+All of the following six functions work the same as their L</log_$level>
+brethren, except they return what is passed into them and put the stringified
(with L<Data::Dumper::Concise>) version of their args into C<$_>. This means
you can do cool things like the following:
=head3 Dlog_trace
- my ($foo, $bar) = Dlog_trace { "entered method foo with args $_" } @_;
+ my ($foo, $bar) = Dlog_trace { "entered method foo with args: $_" } @_;
=head3 Dlog_debug
=head2 DlogS_$level
-Import Tag: ":dlog"
+Import Tag: C<:dlog>
-Arguments: CodeRef $returning_message, Item $arg
+Arguments: C<CodeRef $returning_message, Item $arg>
-All of the following six functions work the same as the related L<Dlog_$level>
-functions, except they only take a single scalar after the
-C<$returning_message> instead of slurping up (and also setting C<wantarray>)
-all the C<@args>
+Like L</logS_$level>, these functions are a special case of L</Dlog_$level>.
+They only take a single scalar after the C<$returning_message> instead of
+slurping up (and also setting C<wantarray>) all the C<@args>
my $pals_rs = DlogS_debug { "pals resultset: $_" }
$schema->resultset('Pals')->search({ perlers => 1 });
-=head3 DlogS_trace
-
- my ($foo, $bar) = DlogS_trace { "entered method foo with first arg $_" } $_[0], $_[1];
-
-=head3 DlogS_debug
-
- DlogS_debug { "random data structure: $_" } { foo => $bar };
-
-=head3 DlogS_info
-
- return DlogS_info { "html from method returned: $_" } "<html>...</html>";
-
-=head3 DlogS_warn
-
- DlogS_warn { "probably invalid value: $_" } $foo;
-
-=head3 DlogS_error
-
- DlogS_error { "non-numeric user input! ($_)" } $port;
-
-=head3 DlogS_fatal
-
- DlogS_fatal { '1 is never equal to 0!' } 'ZOMG ZOMG' if 1 == 0;
-
=head1 LOGGER INTERFACE
Because this module is ultimately pretty looking glue (glittery?) with the
projects / p5sagit/Log-Contextual.git / blobdiff