在 Perl 中提取文件的多个小节 [英] Extracting multiple subsections of a file in Perl
问题描述
我有以下脚本,想将其中的某些部分转换为 Perl 脚本.我感兴趣的部分与 perl 非常相似并且易于转换(仅供参考:COND
和 FORMULA
表示 if
和 分别在 Perl 中返回
).但是,我正在努力正确提取这些部分.
I have the following script and want turn some parts of it to Perl script. The parts that I'm interested in are very similar to perl and easy to convert (FYI: COND
and FORMULA
mean if
and return
in Perl, respectively). However, I'm struggling to extract these sections properly.
... #OTHER STUFFS
K K1 {
... #MORE OTHER STUFFS
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) }
}
... #MORE OTHER STUFFS
}
... #OTHER STUFFS
K K2 {
... #MORE OTHER STUFFS
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) }
}
... #MORE OTHER STUFFS
}
... #OTHER STUFFS
K K3 {
... #MORE OTHER STUFFS
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) }
}
... #MORE OTHER STUFFS
}
... #OTHER STUFF
我尝试了以下 perl-liner,
I've tried the following perl-liner,
perl -ne 'print $1 if /K\sK2\s\{/ .. /\}/ and /LOL\s\{/ .. /\}/ and /COND*(.*)/' filename
提取,例如 { d <;0.03 }
来自
K K2 {
... #MORE OTHER STUFFS
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) }
}
... #MORE OTHER STUFFS
}
但是
- 它失败了,我不知道如何修复它
- 如何修复它以便能够在同一部分中捕获第二个
COND
语句(即COND { w >= 0.03 }
).换句话说,我如何跳过字符串的第一次、第二次、...出现.
- It failed and I don't know how to fix it
- How I can fix it in a way to be able to catch the second
COND
statement in the same section (i.e.COND { w >= 0.03 }
). In other word, how I can skip the first, second,... occurrence of a string.
PS 如果我能完成这个提取部分,我知道如何将它转换为 Perl 代码
PS If I can get this extraction part done, I know how to convert it to Perl-looking code
推荐答案
解析条件,并将它们转换成匿名子例程,这些子例程可以进行评估,然后分配给散列.
Parse the conditions, and translate them into anonymous subroutines that can be eval'd and then assigned to a hash.
您需要在使用前彻底测试以下内容,因为我不知道您的完整数据集.
You will want to test the below thoroughly before using, as I don't know your full data set.
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
输出:
'K1', {d => .1} = 2.13345237791561
'K1', {d => .05} = 2.01370729772479
'K3', {d => .02} = -4.13029437251523
'K3', {d => .021} = -4.13002941430942
这篇关于在 Perl 中提取文件的多个小节的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!