perl - 在 perl 中创建日志

Question

我的 perl 脚本中有许多子例程。我想为每个子例程创建日志，即日志将写入子例程是否正常工作，或者如果失败则在哪里失败。根据我的逻辑标志应该被维护&如果基于标志值子程序日志被创建。我是 perl 的新手，所以任何人都可以给我一个同样的例子。

Answer 1

最直接的解决方案就是编写一个debug子程序并在适当的地方使用它：

sub debug {
    my($p, $f, $l) = caller;
    print "$p, $f, $l\n";
}

sub test {
    debug;
    print "something\n";
    debug;
}

caller您可以在perlfunc手册页上查找。

如果你想要它更漂亮，可以试一试Aspect。

Answer 2

您尝试做的事情可以通过手动插入日志语句来实现：

use constant LOG => 1;

sub foo {
  debug 'BEFORE', 'main::foo', @_ if LOG; # gets optimized away if LOG is false
  do stuff;
  debug 'AFTER', 'main::foo', if LOG;      # the same
  return $things;
}

（假设debug是一个记录日志的函数）

但是，我们可以在某些情况下将其自动化。特别是，我们可以为每个命名的子例程添加日志包装器。我们将通过stash 包（即符号表）进行元编程。

stash 是一个大散列，其名称如%main::，请注意尾随的双冒号。它拥有glob，它们是具有一组固定键的散列。他们有*印记。glob的CODE条目包含一个代码引用。

我们可以选择所有包含代码条目的存储球，例如

my $stash = \%main::;
my @interesting_globs = grep *$_{CODE}, values %$stash;

我们可以为 glob 分配一个引用，这将在 glob 中填充正确的插槽。例如，

sub foo { say 1 }

与

BEGIN {
  *foo = sub { say 1 };
}

所以现在我们可以用一个进行日志记录的包装器来包装原始 sub：

for my $glob (@interesting_globs) {
  my $code = *$glob{CODE}; # store the coderef in a lexical variable
  no warnings 'redefine';
  *$glob = sub {
     debug 'BEFORE', $glob, @_ if LOG;
     my @return_value = wantarray ? &$code : scalar &$code;
     debug 'AFTER', $glob, @return_value if LOG;
     return wantarray ? @return_value : $return_value[0];
  }
}

这些wantarray东西确保在正确的上下文（列表上下文/标量上下文）中调用内部子。但是，我们不检查无效上下文。（&$code注意缺少的括号）是一种花哨的说法$code->(@_)or &$code(@_)。

重要的是，在编译所有 subs 之后对 subs 进行修饰。因此，它可能应该在一个INIT块内执行，该块在主编译阶段之后但在常规执行开始之前运行。

此解决方案有一些缺点：

1. 它仅适用于命名潜艇，但不适用于匿名潜艇。
2. 它还默认装饰导入的潜艇。
3. 如果没有进一步的过滤器，它将装饰所有的潜艇。
4. 我们不会将无效上下文传播到原始代码。

更好的解决方案是使用子程序属性，但设置起来有点困难。属性是在编译时执行的处理程序，可以传达元数据。例如sub foo :log_this { ... }，log_this将调用处理程序。

---

完整示例：

$ perl -E'
  sub foo {say "@_"};
  sub bar { foo(0, @_, "inf") }
  INIT{
    for my $glob (grep *$_{CODE}, values %main::){
      my $orig = *$glob{CODE};
      *$glob = sub {
        say "BEFORE $glob: @_";
        my @ret = $orig->(@_); # this demo misses context handling
        say "AFTER $glob: @ret";
        @ret;
      };
    }
  }
  bar(1,2,3)'
BEFORE *main::bar: 1 2 3
BEFORE *main::foo: 0 1 2 3 inf
0 1 2 3 inf
AFTER *main::foo: 1
AFTER *main::bar: 1