if ($spec->config->{log}) {
$spec->add_export("&log_$level", sub (&@) {
my ($code, @args) = @_;
- my @loggers = $router->get_loggers(scalar(caller), $level);
- foreach my $logger (@loggers) {
- $logger->$level($code->(@args));
- }
+ $router->handle_log_request({
+ package => scalar(caller),
+ caller_level => 1,
+ level => $level,
+ }, $code, @args);
return @args;
});
$spec->add_export("&logS_$level", sub (&@) {
- my $code = shift;
- my @loggers = $router->get_loggers(scalar(caller), $level);
- foreach my $logger (@loggers) {
- $logger->$level($code->(@_));
- }
- return shift;
+ my ($code, @args) = @_;
+ $router->handle_log_request({
+ package => scalar(caller),
+ caller_level => 1,
+ level => $level,
+ }, $code, @args);
+ return $args[0];
});
}
if ($spec->config->{dlog}) {
$spec->add_export("&Dlog_$level", sub (&@) {
my ($code, @args) = @_;
- my $dumped = (@args?Data::Dumper::Concise::Dumper @args:'()');
- my @loggers = $router->get_loggers(scalar(caller), $level);
- foreach my $logger (@loggers) {
- $logger->$level(do { local $_ = $dumped; $code->(@args); });
- }
+ my $wrapped = sub {
+ local $_ = (@_?Data::Dumper::Concise::Dumper @_:'()');
+ &$code;
+ };
+ $router->handle_log_request({
+ package => scalar(caller),
+ caller_level => 1,
+ level => $level,
+ }, $wrapped, @args);
return @args;
});
$spec->add_export("&DlogS_$level", sub (&$) {
my ($code, $ref) = @_;
- my $dumped = Data::Dumper::Concise::Dumper $ref;
- my @loggers = $router->get_loggers(scalar(caller), $level);
- foreach my $logger (@loggers) {
- $logger->$level(do { local $_ = $dumped; $code->($ref); });
- }
+ my $wrapped = sub {
+ local $_ = Data::Dumper::Concise::Dumper($_[0]);
+ &$code;
+ };
+ $router->handle_log_request({
+ package => scalar(caller),
+ caller_level => 1,
+ level => $level,
+ }, $wrapped, $ref);
return $ref;
});
}
with 'Log::Contextual::Role::Router';
+eval {
+ require Log::Log4perl;
+ die if $Log::Log4perl::VERSION < 1.29;
+ Log::Log4perl->wrapper_register(__PACKAGE__)
+};
+
sub before_import { }
sub after_import {
}
sub get_loggers {
- my ($self, $package, $level) = @_;
+ my ($self, $info) = @_;
+
+ my $package = $info->{package};
+
my $logger = (
$_[0]->{Package_Logger}->{$package} ||
$_[0]->{Get_Logger} ||
die q( no logger set! you can't try to log something without a logger! )
);
- $logger = $logger->($package, { caller_level => 2 });
+ my %info = %$info;
- return $logger if $logger->${\"is_$level"};
- return ();
+ $info{caller_level}++;
+
+ $logger = $logger->($package, \%info);
+
+ return $logger if $logger->${\"is_${\$info->{level}}"};
+ return ();
+}
+
+sub handle_log_request {
+ my ($self, $info, $generator, @args) = @_;
+
+ my %info = %$info;
+
+ $info{caller_level}++;
+
+ foreach my $logger ($self->get_loggers(\%info)) {
+ $logger->${\$info->{level}}($generator->(@args));
+ }
}
-1;
+1;