perlはネストされた関数とパラメータを取得します（text :: balancedまたはplain perl）

Question

私は以下の内容のテキストファイルを持っており、配列や他のデータ構造でperlを使ってネストされた関数（rootfuncを含む）

INPUTファイルの内容：

rootfunc aaa with string1 { 
    blah blah 
    subfunc bbb (different parameters) { 
     blah blah 
    } 
    subfunc others_in_aaa (different parameters) { 
     blah blah 
    } 
} 

rootfunc ccc with string2 { 
    blah blah 
    if (blah) { 
     blah blah 
    } else { 
     blah blah 
    } 
    subfunc others_in_ccc (different parameters) { 
     blah blah 
    } 
} 

rootfunc others with stringothers { 
    blah blah 
    subfunc others_in_others (different parameters) { 
     blah blah 
    } 
} 

私は以下のような出力を持つすべてrootfuncとsubfuncを抽出したいと思います：

意図した出力ファイルを（、他/場合も取り除かれていません） ：perlスクリプトで

rootfunc aaa with string1 { 
    subfunc bbb (different parameters) { 
    } 
    subfunc others_in_aaa (different parameters) { 
    } 
} 

rootfunc ccc with string2 { 
    subfunc others_in_ccc (different parameters) { 
    } 
} 

rootfunc others with stringothers { 
    subfunc others_in_others (different parameters) { 
    } 
} 

次のように私はrootfuncのブラケットにあるものを抽出し、その後subfuncにあるものは何でも得るが、rootfunc名/パラメータをすることができますそしてsubfunc名/パラメータが失われています。

PERL SCRIPT：

use Text::Balanced qw(extract_multiple extract_bracketed); 

open(FILE, "/tmp/a") || die "Unable to open /tmp/a: $!\n"; 
{ 
    local $/=undef; 
    my $file = <FILE>; 
} 
close(FILE); 
my @array = extract_multiple($file, [sub{extract_bracketed($_[0], '{}')},], undef, 1); 

は、所望の出力を取得する方法はありますか？ありがとう、

Answer 1

と仮定すると、subfuncは正規表現を使用できます。私は2つのs ///に分割しましたが、組み合わせることができます。 [テキスト::正規表現と組み合わせて使用​​することができるバランスのとれ

sub squeeze { 
    my($s) = @_; 
    $s =~ s/(?<=\{\n)[^(){}]*?(?= *subfunc)//sg; 
    $s =~ s/(?<=\{)[^(){}]*?(?=\})//sg; 
    return $s; 
} 

がネストされている場合は、中括弧：

sub squeeze { 
    my($s) = @_; 
    my $out = ''; 
    while($s =~ s/^(\s*rootfunc[^{]*\{).*?(?=\s*subfunc)//s){ 
     $out .= $1 ; 
     while($s =~ s/^(\s*subfunc[^)]+\)\s*).*?(?=\{)//s){ 
      $out .= $1; 
      my($ext, $rem) = extract_bracketed($s, '{'); 
      $out .= "{}"; 
      $s = $rem; 
     } 
     $out .= "}"; 
     if($s =~ s/^(\s+\})//s){ 
      $s .= $1; 
     } 
    } 
    return $out; 
}