从 Perl XS 扩展打印到标准输出

Question

我最近开始尝试使用 XS 编写 Perl (v5.8.8) 扩展。我正在编写的方法之一收集一堆数据并将其发送给客户端。我想编写一些单元测试来对输出进行断言，但我遇到了一个问题：PerlIO 方法似乎没有通过与 print 相同的通道传递数据在 Perl 中调用确实如此。通常，您可以连接到 STDOUT 文件处理程序并拦截结果，但 PerlIO 方法似乎完全绕过了这一点。

我在下面粘贴了一个示例，但我的测试的基本要点是：Tie in to STDOUT，运行代码，untie，返回收集的字符串。这样做，我能够捕获 print 语句，但不能捕获来自模块的 PerlIO_* 调用。我尝试过使用 PerlIO_write、PerlIO_puts、PerlIO_printf 等。没有骰子。

从头开始，这是我正在做的事情的最小重现：

h2xs -A -n IOTest
cd IOTest

将其放入 IOTest.xs 中：

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"

MODULE = IOTest PACKAGE = IOTest

void
oink ()
    CODE:
        PerlIO_puts(PerlIO_stdout(), "oink!\n");

这将进入一个名为 test.pl 的文件（有趣的部分在底部附近，其他所有内容都只是为了捕获标准输出）：

# Set up the include path to match the build directories
BEGIN {
    push @INC, './blib/lib/';
    push @INC, './blib/arch/auto/IOTest';
}

use IOTest;

# This package is just a set of hooks for tieing in to stdout
{
    # Lifted from the Test::Output module found here:
    # http://search.cpan.org/~bdfoy/Test-Output-1.01/lib/Test/Output.pm
    package OutputTie;

    sub TIEHANDLE {
      my $class = shift;
      my $scalar = '';
      my $obj = shift || \$scalar;
      bless( $obj, $class);
    }

    sub PRINT {
        my $self = shift;
        $$self .= join(defined $, ? $, : '', @_);
        $$self .= defined $\ ? $\ : '';
    }

    sub PRINTF {
        my $self = shift;
        my $fmt  = shift;
        $$self .= sprintf $fmt, @_;
    }

    sub read {
        my $self = shift;
        my $data = $$self;
        $$self = '';
        return $data;
    }
}

# Runs a sub, intercepts stdout and returns it as a string
sub getStdOut (&) {
    my $callback = shift;

    select( ( select(STDOUT), $| = 1 )[0] );
    my $out = tie *STDOUT, 'OutputTie';

    $callback->();
    my $stdout = $out->read;

    undef $out;
    untie *STDOUT;

    return $stdout;
}

# This is the interesting part, the actual test:
print "Pre-capture\n";
my $output = getStdOut(sub {
    print "before";
    IOTest::oink();
    print "after";
});
print "Captured StdOut:\n" . $output . "\nend\n";

构建和测试只是一个问题：

perl Makefile.PL
make
perl test.pl

我看到的输出是：

Pre-capture
oink!
Captured StdOut:
beforeafter
end

显然，我期待“oink！”夹在“之前”和“之后”之间，但这似乎并没有发生。

有什么想法吗？

Answer 1

我认为捕捉有问题。比较：

use IOTest;
use Capture::Tiny qw(capture);

print "Pre-capture\n";
my $output = capture {
    print "before";
    IOTest::oink();
    print "after";
};
print "Captured StdOut:\n" . $output . "\nend\n";

---

Pre-capture
Captured StdOut:
beforeoink!
after
end