Perl XML LibXML 用 xsd 模式上的另一个节点替换一个节点答案

【问题标题】：Perl XML LibXML to replace a node with the other on xsd schemaPerl XML LibXML 用 xsd 模式上的另一个节点替换一个节点
【发布时间】：2017-08-22 21:27:19
【问题描述】：

我有一个 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"

感谢任何帮助。

【问题讨论】：

请先添加strict 和warnings。
你也可以发布预期的结果吗？
@choroba，已更新。

标签： xml perl xsd libxml2

【解决方案1】：

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

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

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

但是，你的第二个循环

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

将findnodes 放入标量上下文，因为您首先将结果分配给$documentroot。这会导致findnodes 返回一个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>

【讨论】：

不需要分配结果，所以我修改了脚本，但是错误输出还是一样...
@dellair：不，它不是“仍然一样”。消息现在是Can't locate object method "getAttribute" via package "XML::LibXML::Attr"，而之前是via package "XML::LibXML::NodeList"。
@dellair：我已经修复了剩余的错误并添加了您的代码的功能版本。

【解决方案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返回的是一个节点列表，你可以用->size检查它的大小，如代码所示，并将它的成员作为数组引用的元素访问。

【讨论】：