Печать на стандартный вывод из расширения Perl XS - PullRequest
Новая
       29

Печать на стандартный вывод из расширения Perl XS

2 голосов
/ 24 мая 2011

Я недавно начал играть с написанием расширений 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 (интересная часть находится внизу, все остальное только для захвата стандартного вывода): 

# 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

Очевидно, я ожидаю "хрю!" быть зажатым между «до» и «после», но этого, похоже, не происходит.

Есть идеи?

1 Ответ

2 голосов
/ 24 мая 2011

Я думаю, что захват неисправен.Сравните: 

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
...