Rewriting a recursive regex for an older version of Perl

The following code snippet works fine with Perl (v5.16.2). However, when I run it with Perl v5.8.9, it complains about the following regular expression. How can I rewrite this regex like it does with Perl v5.8.9. (I can not update the version).

REGEX:

use strict; use warnings; our %formula_per_k; INIT { # List all functions that you want to allow in formulas. All other words will be interpretted as variables. my @FORMULA_FUNCS = qw(sqrt exp log); # Load the data via a file. my $data = do {local $/; <DATA>}; # Parse K blocks while ($data =~ m{ ^K \s+ (\w+) \s* \{ ( (?: [^{}]+ | \{(?2)\} )* ) # Matched braces only. \} }mgx) { my ($name, $params) = ($1, $2); # Parse LOL block next if $params !~ m{ LOL \s* \{ ( (?: [^{}]+ | \{(?1)\} )*? ) # Matched braces only. \} }mx; my $lol = $1; # Start building anonymous subroutine my $conditions = ''; # Parse Conditions and Formulas while ($lol =~ m{ COND \s* \{ (.*?) \} \s* FORMULA \s* \{ (.*?) \} }gx) { my ($cond, $formula) = ($1, $2); # Remove Excess spacing and translate variable into perl scalar. for ($cond, $formula) { s/^\s+|\s+$//g; s{([a-zA-Z]+)}{ my $var = $1; $var = "\$hashref->{$var}" if ! grep {$var eq $_} @FORMULA_FUNCS; $var }eg; } $conditions .= "return $formula if $cond; "; } my $code = "sub {my \$hashref = shift; ${conditions} return; }"; my $sub = eval $code; if ( $@ ) { die "Invalid formulas in $name: $@ "; } $formula_per_k{$name} = $sub; } } sub formula_per_k { my ($k, $vars) = @_; die "Unrecognized K value '$k'" if ! exists $formula_per_k{$k}; return $formula_per_k{$k}($vars); } print "'K1', {d => .1} = " . formula_per_k('K1', {d => .1}) . "\n"; print "'K1', {d => .05} = " . formula_per_k('K1', {d => .05}) . "\n"; print "'K3', {d => .02} = " . formula_per_k('K3', {d => .02}) . "\n"; print "'K3', {d => .021} = " . formula_per_k('K3', {d => .021}) . "\n"; __DATA__ ... #OTHER STUFFS K K1 { LOL { COND { d < 0.01 } FORMULA { -0.2 + 3.3*sqrt(d) } COND { d >= 0.01 } FORMULA { -0.2 + 3.3*sqrt(d+0.4) } } } ... #OTHER STUFFS K K2 { LOL { COND { d < 0.03 } FORMULA { -2.2 + 1.3*sqrt(d) } COND { d >= 0.03 } FORMULA { -2.2 + 1.3*sqrt(d+0.8) } } } ... #OTHER STUFFS K K3 { LOL { COND { d < 0.02 } FORMULA { -4.3 + 0.3*sqrt(d) } COND { d >= 0.02 } FORMULA { -4.3 + 0.3*sqrt(d+0.3) } } } ... #OTHER STUFF 

Outputs:

 'K1', {d => .1} = 2.13345237791561 'K1', {d => .05} = 2.01370729772479 'K3', {d => .02} = -4.13029437251523 'K3', {d => .021} = -4.13002941430942 

Error:

 Sequence (?1...) not recognized in regex; marked by <-- HERE in m/ ^K \s+ M3 \s* { ( (?: [^{}]+ | {(?2 <-- HERE )} )* ) # Matched braces only. } / at ./code.pl line 215, <RFILE> line 12. 

UPDATE: The code is updated. This was originally proposed by https://stackoverflow.com/users/1733163/miller

+5
source share
1 answer

Before introducing (?PARNO) we had to use (??{ code }) to create recursive regular expressions. An example can be found in perlre - Advanced Templates .

Below is a description of v5.16.2 , v5.20.0 and locally on a v5.8.9 perlbrew:

 our $braces_re; $braces_re = qr{ \{ (?: (?> [^{}]+ ) | (??{ $braces_re }) )* \} }sx; # parse FOO block while ( $data =~ m{ ^FOO \s+ (\w+) \s* \{ ( (?: [^{}]+ | (??{ $braces_re }) )* ) # Matched braces only. \} }mgx ) { my $params = $1; # parse BAR block next if $params !~ m{ BAR \s* \{ ( (?: [^{}]+ | (??{ $braces_re }) )*? ) # Matched braces only. \} }mx; # SOME CODE } 

Note. I intentionally highlighted the _re variable declaration and its initialization. There are some versions of perl that allow you to declare a recursive regular expression in the same expression as initialization, but v5.8.9 is not one of them.

In addition, if you prefer to change the original regular expression more than just replace the replacement with a note (?PARNO) , then the above can be summarized as follows. Also confirmed on v5.16.2 :

 my $braces_re; $braces_re = qr{ (?: (?> [^{}]+ ) | # The following is a "postponed" regular subexpression. \{ (??{ $braces_re }) \} # Deferred execution enables recursive regex )* }sx; # parse FOO block while ( $data =~ m{^FOO \s+ (\w+) \s* \{ ( $braces_re ) \} }mgx ) { my $params = $1; # parse BAR block next if $params !~ m{BAR \s* \{ ( $braces_re ) \}}mx; # SOME CODE } 
+2
source

Source: https://habr.com/ru/post/1202457/


All Articles