如何重命名在运行时决定的 XML 元素名称？

Question

我自己尝试过一点，搜索了很多，但找不到如何在 Perl 中有效地做到这一点的解决方案（我猜该解决方案有点类似于 https://stackoverflow.com/a/22119220/6607497 ）：

我有一些错误的 XML 输入文件（即它声称符合特定的 XML 内容模型，但元素名称的大小写不一致），我想在必要时修复它们。 为此，我必须将每个元素名称与有效名称列表进行比较，如果坏元素名称与有效元素名称匹配，忽略名称的大小写，则应将坏名称更改为相应的有效名称。

就像

<Bad>...</Bad>

（错误大小写）转换为

<bad>...</bad>

（正确大小写）。 当然，实际上情况要复杂得多。此外，坏标签并不总是使用混合大小写，而好标签仅使用小写字母；它可以是任何组合...

我已经创建了所有有效元素名称的列表，但我缺少（例如）如何使用

XML::Twig

为“任何节点”设置处理程序（想要在处理程序中使用

set_tag

来修复名称） .

创建任何标签的任何大小写排列的列表是可行的，但这似乎效率低下，因为所有这些可能的错误拼写中只有一小部分实际上会发生。

奇特的例子

这里有一些有趣的例子： 假设有效的元素名称是：

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

错误输入示例如下所示：

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

我不知道您可以使用编译的正则表达式作为哈希键，但它似乎有效，所以您也可以假设这个起始场景：

#!/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;

因此，与

@matchers

中的项目匹配的所有元素都应重命名为相应的哈希值。

Answer 1

测试了 XML::SAX 解析器。似乎以下应该有效：

use v5.38;

package MySAXHandler;
use feature qw(say);
use strict;
use warnings;
use base qw(XML::SAX::Base);
use HTML::Entities ();

sub new {
    my $class = shift;
    #my $self = $class->SUPER::new();
    my %args = @_;
    my $self = bless \%args, $class;
    my $output_file = $self->{output_file};
    $self->{good_regex} = join "|", map {quotemeta} @{$self->{good_tags}};
    $self->{tags_seen} = {};
    open (my $fh, ">", $output_file) or die "Could not open file '$output_file': $!";
    $self->{fh} = $fh;
    return bless $self, $class;
}

sub characters {
    my ($self, $content) = @_;
    print {$self->{fh}} HTML::Entities::encode_entities($content->{Data});
}

sub end_document {
  my ($self, $doc) = @_;
  # process document end event
    $self->{fh}->close();
}

sub end_element {
    my ($self, $el) = @_;

    my $tag = $el->{Name};
    $tag = $self->fixup_tag($tag);
    print {$self->{fh}} "</" . $tag . ">"; # process element end event
}

sub find_good_tag {
    my ($self, $tag) = @_;

    for my $key (@{$self->{good_tags}}) {
        if ($tag =~ /$key/i) {
            $self->{tags_seen}{$tag} = $key;
            return $key;
        }
    }
    return undef;
}

sub fixup_tag {
    my ($self, $tag) = @_;
    my %tags_seen = %{$self->{tags_seen}};
    if ($tag =~ /($self->{good_regex})/i) {
        my $good_tag;
        if (exists $tags_seen{$tag}) {
            $good_tag = $tags_seen{$tag};
        }
        else {
            $good_tag = $self->find_good_tag($tag);
        }
        $good_tag = $tag if not defined $good_tag;
        return $good_tag;
    }
    return $tag;
}

sub get_attribute_string {
    my ($self, $attrs) = @_;

    my @attr_pairs = ();
    for my $key (keys %$attrs) {
        my $attr_name = $key =~ s/^\Q{}\E//r;  # TODO: This looks like a bug in XML::SAX ?
        my $attr_value = $attrs->{$key}->{Value};
        my $str = $attr_name . "=" . $attr_value;
        push @attr_pairs, $str;
    }
    my $str = "";
    $str = join " ", @attr_pairs;
    $str = " " . $str if $str ne "";
    return $str;
}

sub start_document {
  my ($self, $doc) = @_;
  # process document start event
}

sub start_element {
    my ($self, $el) = @_;
    # process element start event
    my $tag = $el->{Name};
    my $attrs = $el->{Attributes};
    $tag = $self->fixup_tag($tag);
    my $attr_str = $self->get_attribute_string($attrs);
    print {$self->{fh}} "<${tag}${attr_str}>";
}

package main;
use v5.38;
use XML::SAX;

my @GOOD_TAGS = qw(ABBA beard Elvis set ZZTop);
my $output_file = "output.xml";
my $handler = MySAXHandler->new(output_file => $output_file, good_tags => \@GOOD_TAGS);
my $p = XML::SAX::ParserFactory->parser(Handler => $handler);
$p->parse_file("input.xml");