Self logging Perl modules (without Moose)

Question

I have the same question as was asked HERE but unfortunately I cannot install Moose and I think the solution described there was particular to Moose. Can someone tell me how to the same in old school "use base" speak?

To reiterate the question, I would like to have my base classes to have an automatic logging mechanism using Log4perl so if the user does not do anything I get some reasonable logging but if the user of my class needs/wants to overwrite the logger they can.

Answer 1

Here is the solution I came up with for anyone else that might be interested:

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

Well, if you want to have role/mixin type behavior and such just like in the other answer, you could use vanilla multiple inheritance, or better yet use something like Ovid's Role::Basic.

Answer 3

Sounds a bit like Log::Any.