Печат до stdout от разширение Perl XS - perl, perl-module, xs

Наскоро започнах да се занимавам с писанеPerl (v5.8.8) разширения, използващи XS. Един от методите, които пиша, събира куп данни и го прави на клиента. Искам да напиша някои тестове, които правят твърдения срещу изхода, но аз се занимавам с проблем: изглежда, че методите на PerlIO не предават данни по същите канали като print в Perl. Обикновено можете да се свържете с манипулатора на STDOUT файлове и да прехванете резултата, но методите на PerlIO изглежда заобикалят напълно.

Вмъкнах пример по-долу, но основният извод на теста ми е следният: Tie в 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 (Интересната част е близо до дъното, всичко останало е само за улавяне на stdout):

# 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-capturen";
my $output = getStdOut(sub {
print "before";
IOTest::oink();
print "after";
});
print "Captured StdOut:n" . $output . "nendn";

Изграждането и тестването е само въпрос на:

perl Makefile.PL
make
perl test.pl

Изходът, който виждам, е:

Pre-capture
oink!
Captured StdOut:
beforeafter
end

Очевидно очаквам, че "ойн!" Ще бъде поставен между "преди" и "след", но това не изглежда да се случва.

Някакви идеи?

Отговори:

2 за отговор № 1

Мисля, че заснемането е погрешно. Сравнете:

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

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

---

Pre-capture
Captured StdOut:
beforeoink!
after
end

---