Printing to stdout from a Perl XS extension

Question

I recently started playing around with writing Perl (v5.8.8) extensions using XS. One of the methods I am writing collects a bunch of data and splats it to the client. I want to write some unit tests that make assertions against the output, but I'm running in to a problem: It doesn't appear that the PerlIO methods are passing data through the same channels as a print call in Perl does. Normally, you can tie in to the STDOUT file handler and intercept the result, but the PerlIO methods seem to be bypassing this completely.

I've pasted an example below, but the basic jist of my test is this: Tie in to STDOUT, run code, untie, return collected string. Doing this, I'm able to capture print statements, but not the PerlIO_* calls from my module. I've tried using PerlIO_write, PerlIO_puts, PerlIO_printf, and more. No dice.

From scratch, here is a minimal repro of what I'm doing:

h2xs -A -n IOTest
cd IOTest

Put this in to 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");

And this goes in to a file called test.pl (The interesting part is near the bottom, everything else is just for capturing 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-capture\n";
my $output = getStdOut(sub {
    print "before";
    IOTest::oink();
    print "after";
});
print "Captured StdOut:\n" . $output . "\nend\n";

Building and testing is then just a matter of:

perl Makefile.PL
make
perl test.pl

The output I'm seeing is:

Pre-capture
oink!
Captured StdOut:
beforeafter
end

Obviously, I'm expecting "oink!" to be sandwiched between "before" and "after", but that doesn't appear to be happening.

Any ideas?

Answer 1

I think the capturing is faulty. Compare:

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