В моем коде есть модуль журналирования, который использует Log :: Log4 perl и в основном выполняет все действия по инициализации, поэтому вызывающему коду не нужно беспокоиться об этом, в основном вызывающий объект делает:
use PI3::Log qw(:all);
my $log_main = PI3::Log->new()->{logger};
и мы go. Это все хорошо, но ... как обычно, что-то всегда усложняет дело. Я также использую IP C :: Shareable и Try :: Tiny, и получается, что Try :: Tiny перехватывает die / warn, но не подпрограммы модуля Carp, которые IP C :: Shareable использует повсеместно , Поэтому, конечно, я решаю, что нужно сделать, это переопределить Carp и перенаправить вещи в мою собственную регистрацию.
Это мой вопрос. Теперь, когда я заменил carp () и друзей на мой в собственных версиях они, очевидно, будут показывать номера пакетов и строк вызова подпрограммы ведения журнала, когда она вызывается чем-то другим, используя carp () или друзей ... НЕ пакет / строку фактического carp (), который находится дальше в стек.
Любые умные способы отрегулировать это без необходимости переписывать половину Log4 perl?
Используемый мной макет:
$class_data->{default_layout} = "%d{yyyy-MM-dd HH:mm:ss.SSS} %-6c %-6p %16C %05L| %m{indent,chomp}%n";
Если заполнители% C и% L поддерживали модификатор {frame-number}, это было бы довольно просто, даже если бы мне понадобился пользовательский макет для использования только этими подпрограммами. Но они этого не делают.
О, пример переопределенных подпрограмм ...
no warnings 'redefine';
*Carp::carp = sub { $log_main->warn(@_); };
РЕДАКТИРОВАТЬ: Для ясности, вот два файла, участвующих, в полном объеме. Вывод, который они производят, показан здесь:
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.
Это 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;
, а это test.pl, клиент, который просто обращается к сегменту общей памяти который не будет присутствовать без сервера, но это нормально, так как ошибки, которые происходят в этом случае, - это то, что я пытаюсь правильно зарегистрировать.
#!/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;