如何钩入Perl的print函数？

Question

如何钩入Perl的print函数？

21

这是一个场景。您有大量的旧脚本，所有脚本都使用通用库。这些脚本使用“print”语句进行诊断输出。不允许对脚本进行任何更改-它们遍布各地，已经得到批准，并且长时间以来已经离开了监督和控制的肥沃山谷。

现在出现了新的需求：必须向库添加日志记录。这必须自动且透明地完成，而不需要标准库的用户更改其脚本。可以简单地向通用库方法添加日志记录调用；这是易事。困难之处在于这些脚本的诊断输出总是使用“print”语句显示。这些诊断输出必须存储，但同样重要的是进行处理。

例如，库应仅记录包含单词“warning”，“error”，“notice”或“attention”的打印行。下面是极为微不足道且牵强附会的示例代码(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很烂”或“此示例有缺陷xyz”等问题……这是为了简洁和清晰而大大简化的。

基本问题归结为捕获和处理传递给print（或任何perl内置函数，沿着这些推理线路）的数据。可以吗？有没有干净的方法？是否有任何记录模块具有钩子来让您执行它？还是需要像瘟疫一样避免它，而且我应该放弃捕获和处理打印输出的想法？

额外信息：必须在跨平台上运行-无论是windows还是*nix。脚本的运行过程必须保持不变，脚本的输出也必须如此。

额外额外信息：codelogic答案的评论中提出了一个有趣的建议：

您可以对http://perldoc.perl.org/IO/Handle.html进行子类化并创建自己的文件句柄，该文件句柄将执行日志记录工作。 - Kamil Kisiel

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

1）我需要一种方式将此功能导出给使用公共库的任何人。它必须自动适用于STDOUT，可能还有STDERR。

2) IO::Handle文档说你不能对其进行子类化，而我的尝试迄今为止都没有成功。是否需要特殊处理才能使子类化IO::Handle工作？标准的'use base'然后覆盖new/print方法似乎没有任何作用。

最终编辑：看起来IO::Handle是个死胡同，但Tie::Handle可能可行。感谢所有建议；它们都非常好。我将尝试Tie::Handle路线。如果它引起问题，我会回来的！

补充说明：请注意，在与此有关的工作中，我发现如果不做任何花哨的事情，Tie::Handle可以使用。如果您在绑定的STDOUT或STDERR上使用IO::Handle的任何功能，则基本上是随机的，无法可靠地使它们正常工作-我找不到一种方法来使IO::Handle的autoflush方法在我的绑定句柄上工作。如果在绑定句柄之前启用了autoflush，则可以正常工作。如果这适用于您，那么Tie::Handle路线可能是可接受的。

- Robert P

那么你被允许更改什么呢？命令行？参数文件？例如，假设我说“是的，你可以挂钩打印”，那么你能做到什么程度？ - Axeman

我可以更改常用库中的任何内容。用户不应需要以不同的方式运行脚本，也不必在命令行上传递任何新内容。 STDOUT和STDERR 上的最终数据流必须与之前相同。 - Robert P

原始输出会发生什么？你能够使用tail -f命令来实时查看并进行处理吗？ - user44511

原始输出将由其他程序处理。它们期望其保持与以前相同的状态。另外，正如在另一条评论中所提到的那样，我们也不想改变环境 - 因此用另一个执行日志处理的程序来掩盖“perl”将会有问题。 - Robert P

5个回答

9

你可以使用Perl的select来重定向STDOUT。

open my $fh, ">log.txt";
print "test1\n";
my $current_fh = select $fh;
print "test2\n";
select $current_fh;
print "test3\n";

文件句柄可以是任何东西，甚至是指向另一个进程（用于后处理日志消息）的管道。 PerlIO::Util 模块中的 PerlIO::tee 似乎允许你将文件句柄的输出同时传递到多个目标（例如日志处理器和 STDOUT）。

- codelogic

选择数据很好，但我们也需要处理这些数据。是否有一种文件句柄类型，可以提供钩子来评估并对传递给它的数据执行操作？ - Robert P

此外，我们无法修改这些脚本的当前行为，因此输出必须仍然保留在STDOUT上。 - Robert P

有趣的想法......这会涉及类似fork()的东西吗？还有另一个要求......它必须跨平台运行：包括Windows和*nix。据我所知，fork在Windows上并不真正起作用。或者你是在谈论不同的管道机制？ - Robert P

关于codelogic的问题-我的意思是您会创建管道，然后使用fork启动另一个进程吗？如果不是fork，您会怎么做来启动该进程？ qx？关于Kamil的问题：有趣。那么这将需要包含IO :: Handle的子类，对吧？它可以自动重新导出吗？ - Robert P

@Robert：不，你不需要手动分叉。Perl会负责创建另一个进程并建立文件句柄与另一个进程的STDIN之间的连接。它是非阻塞的。 - codelogic

显示剩余4条评论

7

有很多选择。使用select()更改print默认的文件句柄。或者绑定STDOUT。或重新打开它。或者应用IO层。

- ysth

3

虽然这不是解决您问题的答案，但是您应该能够采用类似的逻辑来解决自己的问题。如果不能，请其他人可能会发现它有用。

在出现问题之前捕获格式不正确的标题...

package PsychicSTDOUT;
use strict;

my $c = 0;
my $malformed_header = 0;
open(TRUE_STDOUT, '>', '/dev/stdout');
tie *STDOUT, __PACKAGE__, (*STDOUT);

sub TIEHANDLE {
    my $class = shift;
    my $handles = [@_];
    bless $handles, $class;
    return $handles;
}

sub PRINT {
    my $class = shift;
    if (!$c++ && @_[0] !~ /^content-type/i) {
        my (undef, $file, $line) = caller;
        print STDERR "Missing content-type in $file at line $line!!\n";
        $malformed_header = 1;
    }
    return 0 if ($malformed_header);
    return print TRUE_STDOUT @_;
}
1;

用法：

use PsychicSTDOUT;
print "content-type: text/html\n\n"; #try commenting out this line
print "<html>\n";
print "</html>\n";

- Andrew Sohn

-1

你可以从一个包装脚本中运行该脚本，该脚本捕获原始脚本的标准输出并将输出写入到某个合适的位置。

- Greg Hewgill

很遗憾，这违反了“脚本必须与之前相同运行”的要求。用户不应该做任何不同的事情来获取此日志信息。 - Robert P

从一般实现的角度来看，使用包装脚本是一个可行的解决方案。然而，在这种情况下，要求用户运行另一个脚本才能运行他们的脚本并不是一个可行的解决方案 - 命令行、perl发行版和控制台输出必须保持不变。 - Robert P

它必须仅影响使用该特定库的脚本。如果我改变了shell对'perl'的定义，它会影响其他没有需要公共库的脚本。对于此应用程序，这也不是可接受的解决方案。 - Robert P

但根据你的情况，可能是这样。 :) - Robert P

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Axeman · Accepted Answer

有一些内置函数可以被覆盖（请参见perlsub）。不过，print 是其中之一，无法以这种方式工作。有关覆盖 print 的困难在这个PerlMonk的线程中详细说明。

然而，您可以：

创建一个包
绑定一个处理器
选择此处理器

现在，有些人已经给出了基本框架，但是它的实现大致如下：

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行为的所有内容。