/usr/share/doc/libparse-recdescent-perl/examples/demo_metaRD.pm 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 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | # Changes! /usr/local/bin/perl -w
use Parse::RecDescent;
local $/;
my $parse = Parse::RecDescent->new(<DATA>);
my $grammar = <>;
$tree = parse->grammar($grammar) or die "Bad grammar! No biscuit!";
print Data::Dumper->Dump([$tree]);
__DATA__
<autotree>
grammar : prerule(s?) components(s?) /\Z/
component : rule
| comment
rule : <skip:""> "\n" <skip: '[ \t]'> identifier ":"
<skip: $item[1]> production(s? /|/)
production : items(s)
item : lookahead(s?) simpleitem
| directive
| comment
lookahead : '...' | '...!' # +'ve or -'ve lookahead
simpleitem : subrule args(?) rep(?) # match another rule
| terminal # match the next input
| bracket args(?) # match alternative items
| action # do something
subrule : identifier # the name of the rule
args : {extract_codeblock($_[0],'[]')} # just like a [...] array ref
rep : '(' repspec ')'
repspec : '?' # 0 or 1 times
| 's?' # 0 or more times
| 's' # 1 or more times
| /(\d+)[.][.](/\d+)/ # $1 to $2 times
| /[.][.](/\d*)/ # at most $1 times
| /(\d*)[.][.])/ # at least $1 times
terminal : /[/]([\][/]|[^/])*[/]/ # interpolated pattern
| /"([\]"|[^"])*"/ # interpolated literal
| /'([\]'|[^'])*'/ # uninterpolated literal
action : <perl_codeblock> # embedded Perl code
bracket : '(' production(s? /|/) ')' # alternative subrules
directive : '<commit>' # commit to production
| '<uncommit>' # cancel commitment
| '<resync>' # skip to newline
| '<resync:' pattern '>' # skip <pattern>
| '<reject>' # fail this production
| '<reject:' condition '>' # fail if <condition>
| '<error>' # report an error
| '<error:' string '>' # report error as "<string>"
| '<error?>' # error only if committed
| '<error?:' string '>' # " " " "
| '<rulevar:' /[^>]+/ '>' # define rule-local variable
| '<matchrule:' string '>' # invoke rule named in string
identifier : /[a-z]\w*/i # must start with alpha
comment : /#[^\n]*/ # same as Perl
pattern : {extract_bracketed($text,'<')} # allow embedded "<..>"
condition : {extract_codeblock($text,'{<')} # full Perl expression
string : {extract_variable($text)} # any Perl variable
| {extract_quotelike($text)} # or quotelike string
| {extract_bracketed($text,'<')} # or balanced brackets
|