自我記錄Perl模塊（不含駝鹿）

Question

我有和問HERE一樣的問題，但不幸的是我不能安裝Moose，我認爲那裏描述的解決方案對於Moose是特別的。有人能告訴我如何在老同學「使用基地」說話嗎？

爲了重申這個問題，我想讓我的基類具有使用Log4perl的自動日誌記錄機制，所以如果用戶沒有做任何事情，我會得到一些合理的日誌記錄，但是如果我的類的用戶需要/想要覆蓋記錄器他們可以。

Answer 1

這裏是我想出了其他人可能感興趣的解決方案：

MyBaseClass.pm

package MyBaseClass; 
use Log::Log4perl; 
use Log::Log4perl::Layout; 
use Log::Log4perl::Level; 

our $VERSION = '0.01'; 

sub new { 
    my $class = shift; 
    my $name = shift; 

    my $starttime = time; 
    my $self = { 
     NAME    => $name,   # Single-word name (use underscores) 
     STDOUTLVL   => "INFO", 
     LOGOUTLVL   => "WARN", 
     LOG    => "" 
    }; 
    bless($self, $class); 
    return $self; 
} 

sub init_logs { 
    my ($self, $stdoutlvl, $logoutlvl, $no_color, $trace_stack) = @_; 

    # If stdoutlvl was not supplied then default to "INFO" 
    $self->{STDOUTLVL} = (defined $stdoutlvl) ? $stdoutlvl : "INFO"; 
    $self->{LOGOUTLVL} = (defined $logoutlvl) ? $logoutlvl : "WARN"; 
    my $color_enabled = (defined $no_color ) ? ""   : "ColoredLevels"; 

    # Define a category logger 
    $self->{LOG} = Log::Log4perl->get_logger("MyBaseClass"); 

    # Define 3 appenders, one for screen, one for script log and one for baseclass logging. 
    my $stdout_appender = Log::Log4perl::Appender->new(
          "Log::Log4perl::Appender::Screen$color_enabled", 
          name  => "screenlog", 
          stderr => 0); 
    my $script_appender = Log::Log4perl::Appender->new(
          "Log::Log4perl::Appender::File", 
          name  => "scriptlog", 
          filename => "/tmp/$self->{NAME}.log"); 
    my $mybaseclass_appender = Log::Log4perl::Appender->new(
          "Log::Log4perl::Appender::File", 
          name  => "mybaseclasslog", 
          filename => "/tmp/MyBaseClass.pm.log"); 

    # Define a layouts 
    my $stdout_layout; 
    if (defined $trace_stack) { 
     $stdout_layout = Log::Log4perl::Layout::PatternLayout->new("[%-5p] %M-%L --- %m --- %T%n"); 
    } else { 
     $stdout_layout = Log::Log4perl::Layout::PatternLayout->new("[%-5p] %M-%L --- %m ---%n"); 
    } 
    my $file_layout = Log::Log4perl::Layout::PatternLayout->new("%d [%-5p] PID_%05P $ENV{USER} --- %m --- %l %T%n"); 
    my $mybaseclass_layout = Log::Log4perl::Layout::PatternLayout->new("%d [%-5p] PID_%05P $ENV{USER} --- %m --- %l %rmS %T%n"); 

    # Assign the appenders to there layouts 
    $stdout_appender->layout($stdout_layout); 
    $script_appender->layout($file_layout); 
    $mybaseclass_appender->layout($mybaseclass_layout); 

    # Set the log levels and thresholds 
    $self->{LOG}->level($self->{STDOUTLVL}); 
    $script_appender->threshold($self->{LOGOUTLVL}); 
    $mybaseclass_appender->threshold("WARN");    # For the mybaseclass log I only ever want to read about WARNs or above: 

    # Add the appenders to the log object 
    $self->{LOG}->add_appender($stdout_appender); 
    $self->{LOG}->add_appender($script_appender); 
    $self->{LOG}->add_appender($mybaseclass_appender); 
    return($self->{LOG}); 
} 
    ... 
1; 

MyRegrClass.pm

package MyBaseClass::MyRegrClass; 

# This class extends from the base class MyBaseClass 
use base qw(MyBaseClass); 

sub new { 
    my $class = shift; 
    my $self = $class->SUPER::new(@_); 
     ... 
    $self->{passed} = 0; 
    bless($self, $class); 
    return $self; 
} 
    ... 
1; 

my_script.pl

#!/usr/bin/perl -w 
use Getopt::Long; 
use MyBaseClass::MyRegrClass; 

################################## 
# Initialize global variables 
################################## 
my $VERSION = '0.02'; 
my $regr_obj = MyBaseClass::MyRegrClass->new("my_script.pl"); 

################################## 
# DEFINE ARGUMENTS TO BE PASSED IN 
################################## 
my %opts =(); 
print_header("FATAL") unless &GetOptions(\%opts, 'help', 
             'min_stdout_lvl=s', 
             'min_logout_lvl=s', 
             'no_color' 
           ); 
if (exists $opts{help}) { 
    print_header(); 
    exit; 
} 

################################## 
# CONFIGURE OPTIONS 
################################## 
$opts{min_stdout_lvl} = "INFO" unless exists $opts{min_stdout_lvl}; 
$opts{min_logout_lvl} = "WARN" unless exists $opts{min_logout_lvl}; 
my $log = $regr_obj->init_logs($opts{min_stdout_lvl},$opts{min_logout_lvl},$opts{no_color}); 

$log->info("Only printed to STDOUT."); 
$log->warn("Gets printed to the two logs and STDOUT."); 
    ... 

Answer 2

聽起來有點像Log::Any。

Answer 3

好吧，如果你想有角色/混入類型的行爲，就像在其他答案中一樣，你可以使用vanilla多重繼承，或者更好的使用類似Ovid的Role::Basic。