2017-02-21 07:41:50 +01:00
|
|
|
package Lemonldap::NG::Common::Logger::Log4perl;
|
|
|
|
|
|
|
|
use strict;
|
|
|
|
use Log::Log4perl;
|
2021-10-08 10:36:57 +02:00
|
|
|
use Log::Log4perl::MDC;
|
2017-02-21 07:41:50 +01:00
|
|
|
|
2017-02-28 21:53:19 +01:00
|
|
|
our $VERSION = '2.0.0';
|
|
|
|
|
2017-02-21 07:41:50 +01:00
|
|
|
our $init = 0;
|
|
|
|
|
|
|
|
sub new {
|
|
|
|
my ( $class, $conf, %args ) = @_;
|
|
|
|
my $self = bless {}, $class;
|
2021-10-08 10:36:57 +02:00
|
|
|
|
2017-02-21 07:41:50 +01:00
|
|
|
unless ($init) {
|
|
|
|
my $file = $conf->{log4perlConfFile} || '/etc/log4perl.conf';
|
2021-10-08 10:36:57 +02:00
|
|
|
|
|
|
|
# Fix reporting of code location
|
|
|
|
Log::Log4perl->wrapper_register(
|
|
|
|
"Lemonldap::NG::Common::Logger::_Duplicate");
|
|
|
|
Log::Log4perl->wrapper_register(__PACKAGE__);
|
|
|
|
|
|
|
|
# map %E to the stored $req->env
|
|
|
|
Log::Log4perl::Layout::PatternLayout::add_global_cspec(
|
|
|
|
'E',
|
|
|
|
sub {
|
|
|
|
my $layout = shift;
|
|
|
|
my $subvar = $layout->{curlies};
|
|
|
|
my $req = Log::Log4perl::MDC->get("req");
|
|
|
|
return defined($req) ? $req->env->{$subvar} : undef;
|
|
|
|
}
|
|
|
|
);
|
|
|
|
|
|
|
|
# map %Q to the stored $req
|
|
|
|
Log::Log4perl::Layout::PatternLayout::add_global_cspec(
|
|
|
|
'Q',
|
|
|
|
sub {
|
|
|
|
my $layout = shift;
|
|
|
|
my $subvar = $layout->{curlies};
|
|
|
|
my $req = Log::Log4perl::MDC->get("req");
|
|
|
|
if ( ref($req) and $req->can($subvar) ) {
|
|
|
|
return $req->$subvar;
|
|
|
|
}
|
|
|
|
else {
|
|
|
|
return undef;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
);
|
2017-02-21 07:41:50 +01:00
|
|
|
Log::Log4perl->init($file);
|
|
|
|
$init++;
|
|
|
|
}
|
|
|
|
my $logger =
|
|
|
|
$args{user}
|
|
|
|
? ( $conf->{log4perlUserLogger} || 'LLNG.user' )
|
|
|
|
: ( $conf->{log4perlLogger} || 'LLNG' );
|
|
|
|
$self->{log} = Log::Log4perl->get_logger($logger);
|
|
|
|
return $self;
|
|
|
|
}
|
|
|
|
|
2021-10-08 10:36:57 +02:00
|
|
|
sub setRequestObj {
|
|
|
|
my ($self, $req) = @_;
|
|
|
|
Log::Log4perl::MDC->put( "req", $req );
|
|
|
|
}
|
|
|
|
|
|
|
|
sub clearRequestObj {
|
|
|
|
my ($self, $req) = @_;
|
|
|
|
my $text = Log::Log4perl::MDC->remove();
|
|
|
|
}
|
|
|
|
|
2017-02-21 07:41:50 +01:00
|
|
|
sub AUTOLOAD {
|
|
|
|
my $self = shift;
|
|
|
|
no strict;
|
|
|
|
$AUTOLOAD =~ s/.*:://;
|
|
|
|
$AUTOLOAD =~ s/notice/info/;
|
|
|
|
return $self->{log}->$AUTOLOAD(@_);
|
|
|
|
}
|
|
|
|
|
|
|
|
1;
|