perl - 我怎样才能 Hook 到 Perl 的打印？

Question

这是一个场景。你有大量的遗留脚本，都使用一个公共(public)库。所述脚本使用“打印”语句进行诊断输出。不允许对脚本进行任何更改——它们的范围很广，得到了他们的批准，并且早已离开了富有成效的监督和控制谷。

现在一个新的需求出现了:现在必须将日志记录添加到库中。这必须自动且透明地完成，标准库的用户无需更改他们的脚本。公共(public)库方法可以简单地添加日志调用；这是容易的部分。困难的部分在于这些脚本的诊断输出总是使用“打印”语句显示的。必须存储此诊断输出，但同样重要的是，必须对其进行处理。

作为这种处理的一个例子，库应该只记录包含单词“警告”、“错误”、“通知”或“注意”的打印行。下面的非常琐碎和人为的示例代码(tm)将记录一些所说的输出:

sub CheckPrintOutput
{
    my @output = @_; # args passed to print eventually find their way here.
    foreach my $value (@output) {
         Log->log($value) if $value =~ /warning|error|notice|attention/i;
    }
}

(我想避免诸如“实际应该记录什么”、“打​​印不应该用于诊断”、“perl 很烂”或“这个例子有 x y 和 z 的缺陷”之类的问题......这是为了简洁明了，大大简化了。)

基本问题归结为捕获和处理传递给打印(或任何 perl 内置，沿着这些推理)的数据。是否可以？有什么办法可以干净利落的吗？是否有任何带有钩子(Hook)的日志记录模块可以让你做到这一点？还是像瘟疫一样应该避免，我应该放弃捕获和处理打印输出？

附加:这必须跨平台运行 - windows 和 *nix 一样。运行脚本的过程必须保持不变，脚本的输出也必须保持不变。

附加附加:在codelogic的回答的评论中提出的一个有趣的建议:

You can subclass http://perldoc.perl.org/IO/Handle.html and create your own file handle which will do the logging work. – Kamil Kisiel

这可能会做到这一点，但有两个警告:

1)我需要一种方法将此功能导出给使用公共(public)库的任何人。它必须自动适用于 STDOUT，也可能适用于 STDERR。

2) the IO::Handle文档说你不能子类化它，到目前为止我的尝试都没有结果。使子类化 IO::Handle 工作需要什么特别的东西吗？标准的 'use base 'IO::Handle' 然后覆盖 new/print 方法似乎什么都不做。

最终编辑:看起来 IO::Handle 是一个死胡同，但 Tie::Handle 可能会这样做。感谢所有的建议;他们都很好。我要试试 Tie::Handle 路线。如果它引起问题，我会回来的!

附录:请注意，在处理了这个之后，我发现 Tie::Handle 可以工作，如果你不做任何棘手的事情。如果您将 IO::Handle 的任何功能与绑定(bind)的 STDOUT 或 STDERR 一起使用，那么让它们可靠地工作基本上是一个废话——我找不到让 IO::Handle 的 autoflush 方法在我的绑定(bind)上工作的方法处理。如果我在绑定(bind) handle 之前启用了自动冲洗，它会起作用。如果这对您有用，则 Tie::Handle 路线可能是可以接受的。

Answer 1

您可以覆盖许多内置函数(参见 perlsub)。但是，print是不能以这种方式工作的内置插件之一。覆盖 print 的困难详情见此perlmonk's thread .

但是，您可以

创建包

系个 Handlebars

选择此 handle 。

现在，有几个人给出了基本框架，但它的工作原理是这样的:

package IO::Override;
use base qw<Tie::Handle>;
use Symbol qw<geniosym>;

sub TIEHANDLE { return bless geniosym, __PACKAGE__ }

sub PRINT { 
    shift;
    # You can do pretty much anything you want here. 
    # And it's printing to what was STDOUT at the start.
    # 
    print $OLD_STDOUT join( '', 'NOTICE: ', @_ );
}

tie *PRINTOUT, 'IO::Override';
our $OLD_STDOUT = select( *PRINTOUT );

您可以覆盖 printf以相同的方式:

sub PRINTF { 
    shift;
    # You can do pretty much anything you want here. 
    # And it's printing to what was STDOUT at the start.
    # 
    my $format = shift;
    print $OLD_STDOUT join( '', 'NOTICE: ', sprintf( $format, @_ ));
}

见 Tie::Handle对于您可以覆盖 STDOUT 行为的所有内容。