/usr/share/doc/libparse-recdescent-perl/examples/demo_OOparsetree.pl is in libparse-recdescent-perl 1.967013+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 | #!/usr/bin/perl -sw
# PARSE AND EVALUATE LOGICAL EXPRESSIONS WITH A OO PARSE TREE
$::RD_AUTOACTION =
q{ bless [$item[-1]], $item[0] };
use Parse::RecDescent;
my $parse = Parse::RecDescent->new(<<'EOG');
expr : set | clear | disj
set : 'set' atom
clear : 'clear' atom
disj : <leftop: conj 'or' conj>
{ bless $item[-1], $item[0] }
conj : <leftop: unary 'and' unary>
{ bless $item[-1], $item[0] }
unary : neg | bracket | atom
bracket : '(' expr ')' { $item[2] }
neg : 'not' unary
atom : /[a-z]+/i
EOG
while (<>)
{
my $tree = $parse->expr($_);
print $tree->eval(), "\n" if $tree;
}
BEGIN {@var{qw(a c e)} = (1,1,1);}
sub returning
{
# local $^W;
# print +(caller(1))[3], " returning ($_[0])\n";
$_[0];
}
sub expr::eval { returning $_[0][0]->eval() }
sub disj::eval { returning join '', map {$_->eval()} @{$_[0]} }
sub conj::eval { returning ! join '', map {! $_->eval()} @{$_[0]} }
sub unary::eval { returning $_[0][0]->eval() }
sub neg::eval { returning ! $_[0][0]->eval() }
sub set::eval { returning $::var{$_[0][0]->name()} = 1 }
sub clear::eval { returning $::var{$_[0][0]->name()} = 0 }
sub atom::eval { returning $::var{$_[0][0]} }
sub atom::name { returning $_[0][0] }
|