从调用脚本

时间:2017-05-25 04:25:03

标签: perl log4perl

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

test.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;

test.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调用不再输出),但模块& #39; s记录器级别似乎没有被呼叫改变。

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

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

感谢。

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

(编辑试图更清楚。)

1 个答案:

答案 0 :(得分:0)

所以你需要tie STDOUT来log4perl。

更多信息here

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绑定到捕获器模块以及常规的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";