如何在Perl中运行时动态重命名XML元素名称？

需求说明 #

需修复不符合规范的XML文件：将元素名称与合法名称列表做忽略大小写的匹配，把错误大小写的标签替换为对应的标准合法名称。禁止通过生成所有大小写排列组合来匹配，因实际错误标签占比少，该方式效率低下。

示例 #

合法元素名称列表 #

use constant GOOD_TAGS => qw(ABBA beard Elvis set ZZTop);

错误输入XML #

<Set>
  <Beard type="none">
    <elvis />
  </Beard>
  <Beard type="long">
    <ZZtop />
  </Beard>
  <Beard type="mixed">
    <Abba />
  </Beard>
</Set>

修复后预期输出 #

<set>
  <beard type="none">
    <Elvis />
  </beard>
  <beard type="long">
    <ZZTop />
  </beard>
  <beard type="mixed">
    <ABBA />
  </beard>
</set>

现有未完成思路 #

已尝试构建正则匹配哈希，但不知道如何用XML::Twig为所有节点设置处理器来修复标签名：

#!/usr/bin/perl
use strict;
use warnings;

use constant GOOD_TAGS => qw(ABBA beard Elvis set ZZTop);
my %fixes;

foreach (GOOD_TAGS) {
    $fixes{qr/^${_}$/i} = $_;
}

my @matchers = keys %fixes;

解决方案 #

使用XML::Twig的_all_处理器捕获所有节点，结合小写映射表高效匹配修正标签：

#!/usr/bin/perl
use strict;
use warnings;
use XML::Twig;

use constant GOOD_TAGS => qw(ABBA beard Elvis set ZZTop);

# 构建小写标签到标准标签的映射，查找效率O(1)
my %tag_map = map { lc($_) => $_ } GOOD_TAGS;

# 所有节点的标签修正处理器
sub fix_tag {
    my ($twig, $node) = @_;
    my $current_tag = $node->tag;
    my $lower_tag = lc($current_tag);
    
    # 匹配到标准标签则替换
    if (exists $tag_map{$lower_tag}) {
        $node->set_tag($tag_map{$lower_tag});
    }
    # 可选：未匹配到的标签可添加日志或自定义处理逻辑
}

# 初始化Twig并处理XML
my $twig = XML::Twig->new(
    twig_handlers => { '_all_' => \&fix_tag },
    pretty_print => 'indented', # 保持输出格式美观
);

# 处理输入文件（替换为你的输入路径，或用parse(\*STDIN)读取标准输入）
$twig->parsefile('input.xml');

# 输出修复后的XML
$twig->print;

方案说明 #

1. 高效映射：用小写标签作为哈希键对应标准标签，比正则匹配哈希更高效，避免循环匹配正则列表的开销。
2. 全局节点捕获：XML::Twig的_all_是特殊匹配符，会捕获所有元素节点，无需逐个指定标签。
3. 标签修正：通过set_tag方法直接替换节点标签，不影响元素属性和内容。
4. 格式保留：pretty_print参数确保输出XML保持缩进格式，与输入风格一致。

内容的提问来源于stack exchange，提问作者U. Windl