Change level of Log4perl logger in module from calling script

Question

OK - so I have a module and a script that calls it, that both implement Log4perl. Here is a 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;

Which generates the output:

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!!

If I change the line

      level => $main::INFO,

to

      level => $main::ERROR,

I get:

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

As you can see, calling $logger-level($ERROR) in the main script changes the logging level there (the main INFO and WARN calls no longer output), but the module's logger level does not appear to be changed by the call.

Clearly the module is getting it's logger level from the main script at loading because the module WARN call no longer prints if I change the level to ERROR in the BEGIN block. But it does not appear to maintain a reference to the same logger object, since the changes at run time do not propagate.

(how) Can I get the logger level change to propagate to the module dynamically?

Thanks.

P.S. I would prefer to use DEBUG ... form v.s. $logger->debug(...) form, just for consistency with other code we have, though I'll switch if that's the only way.

(Edited to try to be more clear.)

Answer 1

So you need to tie STDOUT to log4perl.

more infor 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;

and a tie command in the main program to tie STDERR to the trapper module along with regular Log::Log4perl initialization:

########################################
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";