0

好的 - 所以我有一个模块和一个调用它的脚本,它们都实现了 Log4perl。这是一个MWE:

测试.plx:

#!/usr/bin/perl -w 
use strict;

my $logger;

BEGIN {
  eval { require Log::Log4perl; };

  if($@) {
    print "Log::Log4perl not installed - stubbing.\n";
    no strict qw(refs);
    *{__PACKAGE__."::$_"} = sub { } for qw(TRACE DEBUG INFO WARN ERROR FATAL);
  } else {
    no warnings;
    print "Log::Log4perl installed - life is good.\n";
    require Log::Log4perl::Level;
    Log::Log4perl::Level->import(__PACKAGE__);
    Log::Log4perl->import(qw(:easy));
    Log::Log4perl->easy_init({
      level => $main::INFO,
      layout => "[%r] %p %M %F line: %L> %m%n"});
    $logger = Log::Log4perl->get_logger();
  }
}

require "test.pm";

DEBUG "This is the test.plx DEBUG line";
INFO  "This is the test.plx INFO  line";
WARN  "This is the test.plx WARN  line";
ERROR "This is the test.plx ERROR line";

test::warning();

print "\nsetting logger level to ERROR\n\n";
$logger->level($ERROR);

DEBUG "This is the test.plx DEBUG line";
INFO  "This is the test.plx INFO  line";
WARN  "This is the test.plx WARN  line";
ERROR "This is the test.plx ERROR line";

test::warning();

exit;

测试.pm

package test;
use strict;

my $logger;

BEGIN {  
  eval { require Log::Log4perl; };

  if($@) {
      #print "Log::Log4perl not installed - stubbing.\n";
      no strict qw(refs);
      *{__PACKAGE__."::$_"} = sub { } for qw(TRACE DEBUG INFO WARN ERROR FATAL);
  } else {
      no warnings;
      #print "Log::Log4perl installed - life is good.\n";
      require Log::Log4perl::Level;
      Log::Log4perl::Level->import(__PACKAGE__);
      Log::Log4perl->import(qw(:easy get_logger :nowarn));
  }
}

INFO "This is the test.pm loading info";

sub warning {
  WARN "Danger!! Danger, Will Robinson!!"
}

return 1;

生成输出:

Log::Log4perl installed - life is good.
[1] INFO main:: test.pm line: 22> This is the test.pm loading info
[1] INFO main:: test.plx line: 29> This is the test.plx INFO  line
[1] WARN main:: test.plx line: 30> This is the test.plx WARN  line
[1] ERROR main:: test.plx line: 31> This is the test.plx ERROR line
[1] WARN test::warning test.pm line: 25> Danger!! Danger, Will Robinson!!

setting logger level to ERROR

[2] ERROR main:: test.plx line: 40> This is the test.plx ERROR line
[2] WARN test::warning test.pm line: 25> Danger!! Danger, Will Robinson!!

如果我换行

      level => $main::INFO,

      level => $main::ERROR,

我得到:

Log::Log4perl installed - life is good.
[1] ERROR main:: test.plx line: 31> This is the test.plx ERROR line

setting logger level to ERROR

[2] ERROR main:: test.plx line: 40> This is the test.plx ERROR line

如您所见,$logger-level($ERROR)在主脚本中调用会更改那里的日志记录级别(main INFOWARN调用不再输出),但调用似乎不会更改模块的日志记录级别。

显然,模块在加载时从主脚本获取它的记录器级别,因为如果我将级别更改为块中的模块WARN调用不再打印。但它似乎没有维护对同一记录器对象的引用,因为运行时的更改不会传播。ERRORBEGIN

(如何)我可以让记录器级别更改动态传播到模块吗?

谢谢。

PS我更喜欢使用DEBUG ...表单与$logger->debug(...)表单,只是为了与我们拥有的其他代码保持一致,但如果这是唯一的方法,我会切换。

(编辑以试图更清楚。)

4

1 回答 1

0

所以你需要tieSTDOUT 到 log4perl。

更多信息在这里

use Log::Log4perl qw(:easy);

sub TIEHANDLE {
    my $class = shift;
    bless [], $class;
}

sub PRINT {
    my $self = shift;
    $Log::Log4perl::caller_depth++;
    DEBUG @_;
    $Log::Log4perl::caller_depth--;
}
1;

以及主程序中的 tie 命令,将 STDERR 与 Trapper 模块以及常规 Log::Log4perl 初始化一起绑定:

########################################
package main;
########################################
use Log::Log4perl qw(:easy);
Log::Log4perl->easy_init(
    {level  => $DEBUG, 
     file   => 'stdout',   # make sure not to use stderr here!
     layout => "%d %M: %m%n",
    });
tie *STDERR, "Trapper";
于 2017-05-25T06:55:43.840 回答