use strict;

my $ParseErrorFh;

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

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

    require Parse::RecDescent;

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

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

    local $::RD_ERROR = 1;
    local $::RD_WARN = 2;

    seek($ParseErrorFh, 0, 0);

    my $p = Parse::RecDescent->new($grammar)
        or die "Grammar is invalid";

    my $x = $p->start($str);

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

    return $x;
}

print parse('start: /foo/ | <error>', 'fo'), "\n";