如何在Perl的LibXML中使用正则表达式进行XPath属性查询？

问题背景 #

在Python中可以通过lxml调用EXSLT的re:test函数轻松实现基于正则表达式的XML属性查询，但在Perl的XML::LibXML中直接注册EXSLT命名空间调用re:test会报错：

error : xmlXPathCompOpEval: function test not found XPath error : Unregistered function at line ...

尝试自定义XPath函数grep_attrs时，又遇到两个问题：

• 代码量远大于Python实现
• 函数返回整个XML树而非匹配的节点

解决方案1：使用XPath 2.0的matches()函数（推荐） #

XML::LibXML从2.00版本开始原生支持XPath 2.0的matches()函数，无需依赖EXSLT，直接用该函数即可实现正则匹配，还支持传入标志位（如i表示忽略大小写）。

示例代码：

use XML::LibXML;

my $dom = XML::LibXML->new->parse_string(<<'EOT');
<?xml version="1.0" encoding="utf-8"?>
<ADDRESSOBJECTS>
  <OBJECT ID="1" NAME="Broadway" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="2" NAME="Times Square" TYPENAME="sq" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="3" NAME="DownTown" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="4" NAME="MidthTown" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="5" NAME="UpTown" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
</ADDRESSOBJECTS>
EOT

my $xpc = XML::LibXML::XPathContext->new($dom);
# 使用XPath 2.0的matches函数，匹配NAME含Town且ISACTIVE=1的节点
my @nodes = $xpc->findnodes(q{//OBJECT[matches(@NAME, '.*Town.*', 'i') and @ISACTIVE='1']});

foreach my $node (@nodes) {
    printf "NAME: %s, ID: %s\n", $node->getAttribute('NAME'), $node->getAttribute('ID');
}

输出结果：

NAME: DownTown, ID: 3
NAME: MidthTown, ID: 4
NAME: UpTown, ID: 5

解决方案2：修复自定义XPath函数 #

原自定义函数的问题在于：

1. 函数设计为接收节点列表并返回节点列表，但XPath谓词需要的是布尔判断结果，而非节点集合
2. 调用时传入的OBJECT是节点集合，而非当前待判断的单个节点

修改后的自定义函数：

use XML::LibXML;

my $dom = XML::LibXML->new->parse_string(<<'EOT');
<?xml version="1.0" encoding="utf-8"?>
<ADDRESSOBJECTS>
  <OBJECT ID="1" NAME="Broadway" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="2" NAME="Times Square" TYPENAME="sq" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="3" NAME="DownTown" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="4" NAME="MidthTown" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
  <OBJECT ID="5" NAME="UpTown" TYPENAME="st" LEVEL="8" ISACTIVE="1" />
</ADDRESSOBJECTS>
EOT

# 自定义函数：接收单个节点、属性名、正则表达式，返回布尔值
sub attr_matches_regex {
    my ($node, $attr_name, $regex_str) = @_;
    my $attr_value = $node->getAttribute($attr_name);
    return 0 unless defined $attr_value;
    # 编译正则表达式，支持忽略大小写等标志（这里可以根据需求调整）
    my $regex = qr/$regex_str/i;
    return $attr_value =~ $regex ? 1 : 0;
}

my $xc = XML::LibXML::XPathContext->new($dom);
$xc->registerFunction('attr_matches_regex', \&attr_matches_regex);

# XPath中用.表示当前节点，传入给自定义函数做判断
my @nodes = $xc->findnodes(q{//OBJECT[attr_matches_regex(., 'NAME', '.*Town.*') and @ISACTIVE='1']});

print "\n-========================================-\n";
foreach my $node (@nodes) {
    printf "%s => %s\n", $node->getAttribute('NAME'), $node->getAttribute('ID');
}
print "-========================================-\n";

输出结果：

-========================================-
DownTown => 3
MidthTown => 4
UpTown => 5
-========================================-

内容的提问来源于stack exchange，提问作者Sergey Zakharov