在Perl中提取文件的多個子部分

Question

我有以下腳本，並希望將其部分內容轉換為Perl腳本。 我感興趣的部分非常類似於perl並且易於轉換（FYI： COND和FORMULA表示if和return Perl）。 但是，我正在努力正確地提取這些部分。

... #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，

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
}

但

1. 它失敗了，我不知道如何解決它
2. 我如何能夠以一種能夠在同一部分中捕獲第二個COND語句的方式來修復它（即COND { w >= 0.03 } ）。 換句話說，我如何跳過第一個，第二個......字符串的出現。

PS如果我可以完成這個提取部分，我知道如何將其轉換為Perl外觀代碼

Answer 1

解析條件，並將它們轉換為可以eval'd然后分配給哈希的匿名子例程。

在使用之前，您需要徹底測試以下內容，因為我不知道您的完整數據集。

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

Answer 2

首先，抱歉單行，但我用一種可讀的方式。

要提取所需的信息（通常）：

my $data = <<EOD;
... #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) }
    }
}
EOD

while( $data =~ /COND    \s* { \s* (?<cond>    [^}]*? ) \s* } \s* 
                 FORMULA \s* { \s* (?<formula> [^}]*? ) \s* }
                /xg ) {
    print "Condition: $+{cond}\nFormula: $+{formula}\n";
}

對於特定項目，您可以使用：

if ($data =~ /K2 \s* { \s* LOL \s* { \s*
              COND    \s* { \s* (?<cond>    [^}]*? ) \s* } \s* 
              FORMULA \s* { \s* (?<formula> [^}]*? ) \s* }
             /x) {
    print "Condition: $+{cond}\nFormula: $+{formula}\n";
}

注意：我已經構建了模式來自動修剪包含“條件”和“公式”的空格，但是如果你想保留這些空格你可以改變\\s* (?<cond> [^}]*? ) \\s* to (?<cond> [^}]* ) （“公式”相同） 。 請注意，此更改使您的模式更具性能。

---

如果項目包含多個“LOL”部件，則可以在全局研究中使用\\G功能獲取所有項目：

my $data = <<EOD;
K K2 {
    LOL {
        COND { d < 0.02 }
        FORMULA { -2.1 + 1.2*sqrt(d) }
        COND { d >= 0.02 }
        FORMULA { -2.1 + 1.2*sqrt(d+0.7) }
    }
    LOL2 {
        COND { d < 0.03 }
        FORMULA { -2.2 + 1.3*sqrt(d) }
        COND { d >= 0.03 }
        FORMULA { -2.2 + 1.3*sqrt(d+0.8) }
    }
    LOL3 {
        COND { d < 0.04 }
        FORMULA { -2.3 + 1.4*sqrt(d) }
        COND { d >= 0.04 }
        FORMULA { -2.3 + 1.4*sqrt(d+0.9) }
    }
}
EOD

while($data =~ /(?:K2 \s* { | \G(?!\A) )\s* (?:LOL\d* \s* { \s* )? 
                COND    \s* { \s* (?<cond>    [^}]*? ) \s* } \s* 
                FORMULA \s* { \s* (?<formula> [^}]*? ) \s* } (?: \s* } )?
               /x) {
    print "Condition: $+{cond}\nFormula: $+{formula}\n";
}

注意：顯然，您必須將LOL\\d*替換為與所有可能名稱匹配的子模式。