I have a logging module in my code which uses Log::Log4perl and basically does all the initialization stuff so the calling code doesn't need to worry about it, basically the caller does:
use PI3::Log qw(:all);
my $log_main = PI3::Log->new()->{logger};
and off we go. This is all fine, but... as usual, something always makes things trickier. I'm also using IPC::Shareable and Try::Tiny, and it turns out that Try::Tiny catches die/warn but not the Carp module routines which IPC::Shareable uses all over the place. So, of course, I decide the thing to do is to override Carp and redirect things to my own logging.
This is where my question comes in. Now that I've replaced carp() and friends with my own versions, they will obviously show the package and line numbers of the call to the logging routine when invoked by something else using carp() or friends... NOT the package/line of the actual carp(), which is further back in the stack.
Any clever ways to adjust this without having to rewrite half of Log4perl?
The layout I'm using is:
$class_data->{default_layout} = "%d{yyyy-MM-dd HH:mm:ss.SSS} %-6c %-6p %16C %05L| %m{indent,chomp}%n";
If the %C and %L placeholders supported a {frame-number} modifier, this would be fairly easy, even if I needed a custom layout for just these routines to use. But they do not.
Oh, an example of the overridden routines...
no warnings 'redefine';
*Carp::carp = sub { $log_main->warn(@_); };
EDIT: For clarity, here are the two files involved, in their entirety. The output they produce is shown here:
2020-04-02 16:31:48.663 main DEBUG PI3::Log 00106| New Logger main created.
2020-04-02 16:31:48.663 main FATAL main 00066| testing death in eval.
2020-04-02 16:31:48.663 main BOOT main 00094| System Started.
2020-04-02 16:31:48.663 main WARN main 00037| IPC::Shareable::SharedMem: shmget: No such file or directory
2020-04-02 16:31:48.663 main FATAL main 00041| Could not create shared memory segment: No such file or directory
2020-04-02 16:31:48.664 main BOOT main 00042| System Halted.
This is PI3::Log.pm
#!/usr/bin/perl -w
package PI3::Log;
=head1 NAME
PI3::Log - Logging module.
=head1 SYNOPSIS
use PI3::Log;
=head1 DESCRIPTION
This module initializes the logging system used by the server.
=cut
use strict;
use warnings;
use English -no_match_vars;
use Scalar::Util qw(weaken refaddr);
use Time::HiRes qw(time sleep alarm);
use Log::Log4perl;
use Log::Log4perl::Layout;
use Log::Log4perl::Level;
our $VERSION = '0.01';
BEGIN { @INC = ( ".", @INC ); }
use Exporter qw(import);
#our @EXPORT_OK = qw($log_main);
our @EXPORT_OK = qw();
our @EXPORT = qw();
our %EXPORT_TAGS = (all => [ @EXPORT, @EXPORT_OK ]);
my $class_data = {};
$class_data->{default_layout} = "%d{yyyy-MM-dd HH:mm:ss.SSS} "
. "%-6c %-6p %16C %05L| %m{indent,chomp}%n";
$class_data->{instances} = {};
# DEBUG, INFO, WARN, ERROR and FATAL
# ^ ^
# | AUTH
# BOOT
Log::Log4perl::Logger::create_custom_level("AUTH", "ERROR");
Log::Log4perl::Logger::create_custom_level("BOOT", "WARN");
=head1 METHODS
=over 4
=item new()
Constructor. The first argument after the implied object/class ref is the
category name of the logging object being created. It defaults to "main".
The second argument is an options hash (reference), which may contain
an alternative logging format, via the "layout" key, or a flag to indicate
that references should be weakened, via the "weakref" key.
If weak references are used, the caller must retain the logging object,
not just the actual logger itself. If they are not (the default), the
DESTROY function is not reliable, but the caller can simply use the logger
directly.
=cut
sub new {
my $this = shift;
my $id = shift || "main"; #sprintf "%08x", int(rand(2**32-1));
my $opt = shift || {};
#my $layout = shift || $class_data->{default_layout};
#my @args = @_;
return $class_data->{instances}{$id} if exists $class_data->{instances}{$id};
my $class = ref($this) || $this;
my %data = ();
my $self = bless \%data, $class;
$self->{id} = $id;
$self->{layout} = exists $opt->{layout} ? $opt->{layout}
: $class_data->{default_layout};
$self->{weakref} = exists $opt->{weakref} ? $opt->{weakref} : undef;
$self->{layout_object} =
Log::Log4perl::Layout::PatternLayout->new($self->{layout});
$self->{logger} = Log::Log4perl->get_logger($id);
$self->{appender} = [];
my $new_appender = Log::Log4perl::Appender->new(
"Log::Log4perl::Appender::Screen",
name => $self->{id} . "_screenlog",
stderr => 0);
$new_appender->layout($self->{layout_object});
$self->{logger}->add_appender($new_appender);
push @{ $self->{appender} }, $new_appender;
$self->{logger}->level($DEBUG);
$self->{created} = time();
$self->{logger}->debug("New Logger " . $self->{id} . " created.");
$class_data->{instances}{$id} = $self;
# We weaken the reference here so that the logger will go away
# when the caller's variable goes out of scope. This has the
# side effect of forcing them to keep the variable around.
#
weaken $class_data->{instances}{$id} if defined $self->{weakref};
#
# NOT doing this means the caller no longer needs to keep a reference
# around to prevent the logger from going poof... but it also means we
# can't do anything during shutdown, since DESTROY() is not reliable.
return $self;
}
=back
=cut
1;
and this is test.pl, a client that just accesses a shared memory segment which won't be present without the server, but that's fine since the errors which happen in that case are what I'm trying to properly log.
#!/usr/bin/perl -w
package main;
use strict;
use warnings;
use English -no_match_vars;
use Data::Dumper;
use Time::HiRes qw(time sleep alarm);
BEGIN { @INC = ( ".", @INC ); }
use PI3::Log qw(:all); # auto-import $log_main
my $log_main = PI3::Log->new()->{logger};
BEGIN {
# Soooo, IPC::Shareable has lots of calls to carp and croak in it.
# Normally, this is fine, however, we're trying to use Try::Tiny
# to be cleaner than the old eval kludge for handling timeouts.
# It does NOT play nice with the Carp module, only with warn/die.
#
# Thus, we are importing Carp here so we can override it BEFORE
# IPC::Shareable gets to it, and thus it will use OUR versions
# which direct things to our logging system.
#
# We didn't catch warn/die before, but since we have to go this far,
# we might as well grab them too...
require Carp;
my $o_carp = \&Carp::carp;
my $o_cluck = \&Carp::cluck;
my $o_warn = \&CORE::GLOBAL::warn;
my $o_croak = \&Carp::croak;
my $o_confess = \&Carp::confess;
my $o_die = \&CORE::GLOBAL::die;
no warnings 'redefine';
*Carp::carp = sub { $log_main->warn(@_); };
*Carp::cluck = sub { $log_main->warn(@_); };
*CORE::GLOBAL::warn = sub { $log_main->warn(@_); };
*Carp::croak = sub {
$log_main->fatal(@_); $log_main->boot("System Halted.");
exit 1;
if( $^S ) {
# If we're inside an eval, call the real die...
CORE::die(@_);
} else {
$log_main->boot("System Halted.");
exit 1;
}
};
*Carp::confess = sub {
#my @call_data = caller();
$log_main->fatal(@_);
$log_main->boot("System Halted.");
exit 1;
if( $^S ) {
# If we're inside an eval, call the real die...
CORE::die(@_);
} else {
$log_main->boot("System Halted.");
exit 1;
}
};
*CORE::GLOBAL::die = sub {
$log_main->fatal(@_);
if( $^S ) {
# If we're inside an eval, call the real die...
CORE::die(@_);
} else {
$log_main->boot("System Halted.");
exit 1;
}
}
};
eval {
die "testing death in eval.";
};
use IPC::Shareable;
use Try::Tiny;
my $start_time = time();
my $done = undef;
my $shared_name = 'testing';
my $share_options = {
create => 0,
exclusive => 0,
mode => 0666,
destroy => 0,
};
$log_main->boot("System Started.");
my %data = ();
my $shared = undef;
try {
$shared = tie %data, 'IPC::Shareable', $shared_name, $share_options;
$log_main->boot("Shared memory structure connected.");
} catch {
$log_main->fatal("Failed to connect to shared memory structure\n$_");
$log_main->boot("System Halted.");
exit 1;
};
$log_main->info("Flavor is " . $data{flavor});
$log_main->boot("System Halted.");
1;