Perl XML LibXML 用 xsd 模式中的另一个节点替换一个节点

Question

我有一个 XML 架构，我想用在 RootNode 复杂类型中找到的元素替换 RootNode。

例如，低于预期的结果是将<xs:element name="RootNode" ...>替换为<xs:element name="real_node" type="RealNode"/>并删除<xs:complexType name="RootNode">的整个节点。

XML 架构：

<xs:schema xmlns="test" xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="test" elementFormDefault="qualified">
    <xs:element name="RootNode" type="RootNode"/>

    <xs:complexType name="RootNode">
            <xs:sequence>
                    <xs:element name="real_node" type="RealNode"/>
            </xs:sequence>
    </xs:complexType>

    <xs:complexType name="RealNode">
            <xs:annotation>
                    <xs:documentation source="Name" xml:lang="EN">TestName</xs:documentation>
                    <xs:documentation source="Type" xml:lang="EN">TestType</xs:documentation>
            </xs:annotation>
            <xs:sequence>
                    <xs:element name="Elem2" type="Type2" minOccurs="1">
                            <xs:annotation>
                                    <xs:documentation source="Name3" xml:lang="EN">TestName3</xs:documentation>
                                    <xs:documentation source="Type3" xml:lang="EN">TestType3</xs:documentation>
                            </xs:annotation>
                    </xs:element>
                    <xs:element name="Elem4" type="Type4" maxOccurs="99" />
            </xs:sequence>
    </xs:complexType>

    <xs:simpleType name="Type2">
            <xs:restriction base="xs:string">
                    <xs:pattern value="[A-Z]{9,9}"/>
            </xs:restriction>
    </xs:simpleType>

    <xs:simpleType name="Type4">
            <xs:annotation>
                    <xs:documentation source="Name5" xml:lang="EN">TestName5</xs:documentation>
                    <xs:documentation source="Type5" xml:lang="EN">TestType5</xs:documentation>
            </xs:annotation>
            <xs:restriction base="xs:string">
                    <xs:pattern value="[A-Z]{7,9}"/>
            </xs:restriction>
    </xs:simpleType>

</xs:schema>

预期结果：

<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns="test" xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="test" elementFormDefault="qualified">
    <xs:element name="real_node" type="RealNode"/>

    <xs:complexType name="RealNode">
            <xs:annotation>
                    <xs:documentation source="Name" xml:lang="EN">TestName</xs:documentation>
                    <xs:documentation source="Type" xml:lang="EN">TestType</xs:documentation>
            </xs:annotation>
            <xs:sequence>
                    <xs:element name="Elem2" type="Type2" minOccurs="1">
                            <xs:annotation>
                                    <xs:documentation source="Name3" xml:lang="EN">TestName3</xs:documentation>
                                    <xs:documentation source="Type3" xml:lang="EN">TestType3</xs:documentation>
                            </xs:annotation>
                    </xs:element>
                    <xs:element name="Elem4" type="Type4" maxOccurs="99" />
            </xs:sequence>
    </xs:complexType>

    <xs:simpleType name="Type2">
            <xs:restriction base="xs:string">
                    <xs:pattern value="[A-Z]{9,9}"/>
            </xs:restriction>
    </xs:simpleType>

    <xs:simpleType name="Type4">
            <xs:annotation>
                    <xs:documentation source="Name5" xml:lang="EN">TestName5</xs:documentation>
                    <xs:documentation source="Type5" xml:lang="EN">TestType5</xs:documentation>
            </xs:annotation>
            <xs:restriction base="xs:string">
                    <xs:pattern value="[A-Z]{7,9}"/>
            </xs:restriction>
    </xs:simpleType>

</xs:schema>

我的脚本：

#!/opt/perl/bin/perl -w
use strict;
use warnings;

use XML::LibXML               qw( );
use XML::LibXML::XPathContext qw( );
use File::Copy;
use File::Basename;

my $in_qfn  = $ARGV[0];
my ($parser, $doc, $root, $out_qfn);
my ($name, $path, $suffix);
my ($documentroot, $complexdoc, $copyelem, $test, $fnd_type, $parent);

my @files = glob "$in_qfn/*.xsd";

foreach my $file (@files) {
   print "###LI### 1 $file\n";
   ($name, $path, $suffix) = fileparse($file);
   $out_qfn = "${name}NoRoot.${suffix}";

   $parser = XML::LibXML->new();
   $doc    = $parser->parse_file($file);
   $root   = $doc->documentElement();

   my $xpc = XML::LibXML::XPathContext->new($doc);
   $xpc->registerNs('xsd', 'http://www.w3.org/2001/XMLSchema');

   # Get the RootNode element node and delete it
   foreach $test ($xpc->findnodes("//xsd:element", $root)) {
      $fnd_type = $test->getAttribute('type') or next;

      if ( $xpc->findnodes('./@name[.="RootNode"]', $test) ) {
         foreach my $fnd_node ($xpc->findnodes('./@name[.="RootNode"]', $test)) {
            $fnd_type = $fnd_node->getAttribute('type') or next;
            $parent = $fnd_node->[0]->parentNode;
            $parent->removeChild($fnd_node->[0]);
         }
      }
   }

   # Get the RootNode Complext Type node
   foreach $test ($xpc->findnodes("//xsd:complexType", $root)) {
      if ($xpc->findnodes('./@name[.="RootNode"]', $root)) {
         $complexdoc = $xpc->findnodes('./@name[.="RootNode"]', $root);
         $copyelem = $xpc->findnodes("//xsd:element", $complexdoc);
         # Copy the element node within RootNode node to the top level
         $root->appendChild($copyelem->cloneNode(1));
      }
   }

   $doc->toFile($out_qfn);
}

但是，脚本抛出错误：

Can't locate object method "getAttribute" via package "XML::LibXML::NodeList"

感谢任何帮助。

Answer 1

在列表上下文中调用findnodes将return一个匹配节点列表。这就是你的第一个循环

foreach $test ($xpc->findnodes("//xsd:element", $root)) { ... }

有效，因为 for 将列表上下文应用于括号中的表达式

然而，你的第二个循环

foreach my $fnd_node ($documentroot = $xpc->findnodes('./@name[.="RootNode"]', $test)) { ... }

将 findnodes 放入 标量上下文 ，因为您首先将结果分配给 $documentroot。这导致 findnodes 到 return 一个 XML::LibXML::NodeList 对象而不是节点列表，并且循环将只迭代一次，将 $fnd_node 设置为该对象并导致您看到的错误

我不清楚您为什么将赋值添加到 $documentroot，因为它只会将 $documentroot 和 $fnd_node 设置为相同的值，这没有任何优势。如果您删除该分配并在循环体

中将 $documentroot 替换为 $fnd_node，您的错误就会消失

顺便说一句，不需要测试

if ( $xpc->findnodes('./@name[.="RootNode"]', $test) ) { ... }

在循环对 findnodes 的相同调用之前。如果调用没有找到匹配的节点，那么 for 循环根本不会执行

更新

您的程序还有一些其他问题。例如，您没有删除原始 <xs:complexType name="RootNode"> 元素，而是在文件

末尾插入了包含的 <xs:element name="real_node" type="RealNode"/>

我已经像这样修复了你的代码

#!/opt/perl/bin/perl
use strict;
use warnings 'all';

use XML::LibXML ();
use XML::LibXML::XPathContext ();
use File::Copy;
use File::Basename;

my ($in_qfn) = @ARGV;

my @files = $in_qfn ? glob "$in_qfn/*.xsd" : 'test.xsd';

for my $file ( @files ) {

    print "###LI### 1 $file\n";

    my ( $name, $path, $suffix ) = fileparse( $file, qr/\.[^.]*/ );
    my $out_qfn = "${name}NoRoot${suffix}";

    print "###LO### 1 $out_qfn\n";

    my $parser = XML::LibXML->new();
    my $doc    = $parser->parse_file( $file );
    my $root   = $doc->documentElement();

    my $xpc = XML::LibXML::XPathContext->new( $doc );
    $xpc->registerNs( 'xsd', 'http://www.w3.org/2001/XMLSchema' );

    # Get the RootNode element node and delete it
    for my $element_root ( $xpc->findnodes( '//xsd:element[@name="RootNode"]', $root ) ) {
        my $parent = $element_root->parentNode;
        $parent->removeChild( $element_root );
    }

    # Get the RootNode Complex Type node
    for my $complex_root ( $xpc->findnodes( '//xsd:complexType[@name="RootNode"]', $root ) ) {

        my ($copyelem) = $xpc->findnodes( ".//xsd:element", $complex_root );

        # Copy the element node within RootNode node to the top level
        $root->insertBefore(
            $copyelem->cloneNode( 1 ),
            $root->firstChild
        );

        # Put a newline before the cloned copy
        $root->insertBefore(
            XML::LibXML::Text->new( "\n\n    " ),
            $root->firstChild
        );

        # Remove the <xs:complexType name="RootNode">
        $complex_root->parentNode->removeChild($complex_root);
    }

    $doc->toFile( $out_qfn );
}

输出

<?xml version="1.0"?>
<xs:schema xmlns="test" xmlns:xs="http://www.w3.org/2001/XMLSchema" targetNamespace="test" elementFormDefault="qualified">

    <xs:element name="real_node" type="RealNode"/>




    <xs:complexType name="RealNode">
            <xs:annotation>
                    <xs:documentation source="Name" xml:lang="EN">TestName</xs:documentation>
                    <xs:documentation source="Type" xml:lang="EN">TestType</xs:documentation>
            </xs:annotation>
            <xs:sequence>
                    <xs:element name="Elem2" type="Type2" minOccurs="1">
                            <xs:annotation>
                                    <xs:documentation source="Name3" xml:lang="EN">TestName3</xs:documentation>
                                    <xs:documentation source="Type3" xml:lang="EN">TestType3</xs:documentation>
                            </xs:annotation>
                    </xs:element>
                    <xs:element name="Elem4" type="Type4" maxOccurs="99"/>
            </xs:sequence>
    </xs:complexType>

    <xs:simpleType name="Type2">
            <xs:restriction base="xs:string">
                    <xs:pattern value="[A-Z]{9,9}"/>
            </xs:restriction>
    </xs:simpleType>

    <xs:simpleType name="Type4">
            <xs:annotation>
                    <xs:documentation source="Name5" xml:lang="EN">TestName5</xs:documentation>
                    <xs:documentation source="Type5" xml:lang="EN">TestType5</xs:documentation>
            </xs:annotation>
            <xs:restriction base="xs:string">
                    <xs:pattern value="[A-Z]{7,9}"/>
            </xs:restriction>
    </xs:simpleType>

</xs:schema>

Answer 2

您没有描述要删除和替换哪些元素的逻辑。下面的代码只是按照你所说的去做：用一个元素替换另一个元素并删除第三个元素。

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

use XML::LibXML;
use XML::LibXML::XPathContext;

my $dom = 'XML::LibXML'->load_xml(location => shift);
my $xpc = 'XML::LibXML::XPathContext'->new($dom);
$xpc->registerNs(xsd => 'http://www.w3.org/2001/XMLSchema');
my $root = $dom->documentElement;

my $replace    = $xpc->findnodes('//xsd:element[@name="RootNode"]');
my $replace_by = $xpc->findnodes('//xsd:element[@name="real_node"]');
my $remove     = $xpc->findnodes('//xsd:complexType[@name="RootNode"]');

die "Can't replace by several" if $replace_by->size > 1;

$_->parentNode->removeChild($_) for @$remove;
$_->replaceNode($replace_by->[0]) for @$replace;

print $dom;

请注意，findnodes returns 是一个节点列表，您可以使用 ->size 检查其大小，如代码所示，并将其成员作为数组引用的元素进行访问。

Perl XML LibXML 用 xsd 模式中的另一个节点替换一个节点

Perl XML LibXML to replace a node with the other on xsd schema

xml

perl

xsd

libxml2

更新

输出