[Perl]捕获配对括号(多层镶嵌)、平衡组的歪招

523066680

我看到之前论坛有不少相关的帖子和讨论。但是本人没有参与，主要是自己几乎没有遇到类似需求。
不过最近遇到了 :-)

首先考虑偷懒的做法，比如交给 DOM 解析器处理

1. # 523066680@163.com
   
2. use Modern::Perl;
   
3. use Mojo::DOM;
   
4. STDOUT->autoflush(1);
   
5. 
   
6. my $text =<<CODE;
   
7. lv0:
   
8. line1 (lv1:a (lv2:test(lv3:part1(lv4:deep)),turn(lv3:part2)) string);
   
9. line2 (lv1:b (lv2:I) (lv2:II));
   
10. CODE
    
11. 
    
12. # 把括号转成标签，标签名自定
    
13. $text =~ s/\(/<b>/g;
    
14. $text =~ s/\)/<\/b>/g;
    
15. 
    
16. # 交给 DOM 解析器
    
17. my $dom = Mojo::DOM->new->xml(1)->parse( $text );
    
18. print_st($dom, 0);
    
19. 
    
20. sub print_st
    
21. {
    
22.     my ( $node, $lv ) = @_;
    
23.     for my $e ( $node->children->each() )
    
24.     {
    
25.         my $s = $e;
    
26.         # 还原括号
    
27.         $s =~ s/<b>/\(/g;
    
28.         $s =~ s/<\/b>/\)/g;
    
29.         printf "%s%s\n", "  "x$lv, $s;
    
30.         print_st( $e, $lv+1 );
    
31.     }
    
32. }
    

复制代码

输出结果：

1. (lv1:a (lv2:test(lv3:part1(lv4:deep)),turn(lv3:part2)) string)
   
2.   (lv2:test(lv3:part1(lv4:deep)),turn(lv3:part2))
   
3.     (lv3:part1(lv4:deep))
   
4.       (lv4:deep)
   
5.     (lv3:part2)
   
6. (lv1:b (lv2:I) (lv2:II))
   
7.   (lv2:I)
   
8.   (lv2:II)

复制代码

性能差了点，耗时 600ms，不过比起写正则应该节省了不少调试的时间。

523066680

搞完野路子了，看看有没有正道。相信这种问题肯定有成熟的模块，AI 推的第一个模块：
Text::Balanced - Extract delimited text sequences from strings.

先看第一个极简示例

1. use Text::Balanced qw(extract_bracketed);
   
2. 
   
3. my $text = "(inside(lv2:(lv3:deep)))right";
   
4. my ($extracted, $remainder) = extract_bracketed($text, '()');
   
5. 
   
6. printf "%s\n", $extracted;
   
7. printf "%s\n", $remainder;
   

复制代码

结果

1. (inside(lv2:(lv3:deep)))
   
2. right

复制代码

这个extract_bracketed 只负责提取从(括号起到右侧配对的)括号范围的内容，它不会返回带层次的结构体。
如果左侧带有其他字符例如 "abc(括号内的)..." 那么需要手动去掉左侧内容或者提取从左括号( 开始的子串交给 extract_bracketed 处理
接着让ai写了一个递归的版本，像剥洋葱一样处理

1. #!/usr/bin/env perl
   
2. use strict;
   
3. use warnings;
   
4. use Text::Balanced qw(extract_bracketed);
   
5. 
   
6. my $text = "left (inside(lv2:(lv3:deep))) def(inside2(lv2:(lv3:deep1)(lv3:deep2))) right";
   
7. 
   
8. print "orig: $text\n";
   
9. print "-" x 50 . "\n";
   
10. 
    
11. # 第一步：处理顶层的所有独立括号组
    
12. # 因为字符串开头可能不是括号，或者中间有 "def" 隔开，我们需要循环查找
    
13. process_level($text, 0);
    
14. 
    
15. sub process_level
    
16. {
    
17.     my ($str, $level) = @_;
    
18.    
    
19.     # 缩进显示
    
20.     my $indent = "  " x $level;
    
21.    
    
22.     # 只要字符串里还有左括号，就继续尝试提取
    
23.     while ($str =~ /\(/)
    
24.     {
    
25.         # 找到第一个左括号的位置，截取子串供 extract_bracketed 使用
    
26.         # 因为 extract_bracketed 必须从字符串开头就是括号才能工作
    
27.         my $start_pos = index($str, '(');
    
28.         my $substring = substr($str, $start_pos);
    
29.         
    
30.         # 执行提取
    
31.         my ($extracted, $remainder) = extract_bracketed($substring, '()');
    
32.         
    
33.         if (defined $extracted)
    
34.         {
    
35.             # 1. 打印当前层级的完整括号内容
    
36.             print "${indent}Lv$level: $extracted\n";
    
37.             
    
38.             # 2. 准备下一层级的数据：去掉最外层的括号
    
39.             # 提取的内容格式是 "(...)", 我们取中间部分 [1 .. length-2]
    
40.             my $inner_content = substr($extracted, 1, -1);
    
41.             
    
42.             # 3. 递归处理内部内容（进入下一层）
    
43.             process_level($inner_content, $level + 1);
    
44.             
    
45.             # 4. 更新 $str，跳过刚才处理过的这部分，继续寻找同级的下一个括号
    
46.             # 原字符串 = (括号前的垃圾) + (提取的部分) + (剩余部分)
    
47.             # 我们需要保留：(括号前的垃圾) + (extract_bracketed 返回的 remainder)
    
48.             # 注意：$substring 是从 $start_pos 开始的，所以 $start_pos 之前的部分要拼回去
    
49.             my $prefix = substr($str, 0, $start_pos);
    
50.             $str = $prefix . $remainder;
    
51.             
    
52.         }
    
53.         else
    
54.         {
    
55.             # 理论上如果 =~ /\(/ 成立，extract_bracketed 应该能提取到，除非括号不匹配
    
56.             warn "检测到左括号但无法提取完整结构，可能存在语法错误。\n";
    
57.             last;
    
58.         }
    
59.     }
    
60. }
    

复制代码

打印结果

1. orig: left (inside(lv2:(lv3:deep))) def(inside2(lv2:(lv3:deep1)(lv3:deep2))) right
   
2. --------------------------------------------------
   
3. Lv0: (inside(lv2:(lv3:deep)))
   
4.   Lv1: (lv2:(lv3:deep))
   
5.     Lv2: (lv3:deep)
   
6. Lv0: (inside2(lv2:(lv3:deep1)(lv3:deep2)))
   
7.   Lv1: (lv2:(lv3:deep1)(lv3:deep2))
   
8.     Lv2: (lv3:deep1)
   
9.     Lv2: (lv3:deep2)

复制代码

耗时 200 ms