Re: How to grab Parse::RecDescent error output in a variable?

[w-ber]

in reply to How to grab Parse::RecDescent error output in a variable?

Answering my own question, here is one way to do it:

my $ParseErrorFh;

BEGIN {
    open(my $olderr, '>&', STDERR) or die "Cannot dup STDERR: $!";
    close STDERR;
    open(STDERR, '+>', undef) or die "Cannot open anonymous file: $!";
    select STDERR; $| = 1;

    open($ParseErrorFh, '>&STDERR') or die "Cannot dup anoynomous file
+: $!";

    # Cannot use, since that messes up execution order for some reason
+ (since use
    # implies a BEGIN block itself?).
    require Parse::RecDescent;

    close STDERR;
    open(STDERR, '>&', $olderr) or die "Cannot restore STDERR: $!";
}

sub report_error {
    seek($ParseErrorFh, 0, 0);
    die join '', grep { $_ !~ m/^\s*$/ } <$ParseErrorFh>;
}

sub parse {
    my ($grammar, $str) = @_;

    seek($ParseErrorFh, 0, 0); # To ensure it's not growing indefinite
+ly, as it is package global.

    my $p = Parse::RecDescent->new($grammar) or report_error();

    seek($ParseErrorFh, 0, 0);

    return $p->startrule($str) or report_error();
}

Of course, this is not thread-safe, and it is also quite ugly. Other solutions?