regex - perl 获取嵌套函数和参数(text::balanced 或普通 perl)

Question

我有一个包含以下内容的文本文件，我想使用 perl 提取数组或其他数据结构中的嵌套函数(包括 rootfunc)。

输入文件内容:

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，输出如下:

预期输出文件(不，if/else 也被删除):

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) {
    }
}

使用下面的 perl 脚本，我只能提取 rootfunc 括号中的内容，然后获取 subfunc 中的内容，但是 rootfunc 名称/参数和 subfunc 名称/参数丢失了:

PERL 脚本:

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是关键字，可以使用正则表达式。我把它分成两个///，但它可以合并。

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

如果有嵌套的大括号，那么 Text::Balanced 可以与正则表达式结合使用:

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;
}