自记Perl模块（不含Moose）

Question

我遇到的问题与问HERE相同，但遗憾的是我无法安装Moose，我认为Moose特有的解决方案。有人能告诉我如何在老派“使用基地”说话吗？

重申一下这个问题，我希望我的基类能够使用Log4perl自动记录机制，所以如果用户没有做任何事情，我会得到一些合理的记录，但如果我的类的用户需要/想要覆盖记录器他们可以。

Answer 1

好吧，如果你想拥有角色/ mixin类型的行为，就像在另一个答案中那样，你可以使用vanilla多重继承，或者更好地使用像Ovid的Role::Basic这样的东西。

Answer 2

以下是我为其他可能感兴趣的人提出的解决方案：

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 3

听起来有点像Log::Any。