我最近开始尝试使用 XS 编写 Perl (v5.8.8) 扩展。我正在编写的方法之一是收集一堆数据并将其发送给客户端。我想编写一些对输出进行断言的单元测试,但我遇到了一个问题:PerlIO 方法似乎没有像print
Perl 中的调用那样通过相同的通道传递数据。通常,您可以绑定到 STDOUT 文件处理程序并拦截结果,但 PerlIO 方法似乎完全绕过了这一点。
我在下面粘贴了一个示例,但我的测试的基本要点是:Tie
在 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!” 夹在“之前”和“之后”之间,但这似乎没有发生。
有任何想法吗?