如何使用Perl在节点值的开始处以XML格式添加新的子节点

我试图在使用Perl中的XML::LibXML的节点值开始的XML中添加子元素到节点。我的XML是:

<root>
<book>
<title>
Test title for xml
</title>
<para n=1> para1 information </para>
<para n=2><head value="PARA HEADING"/>para2 information<subpara i=1>subpara Info</subpara><xyz/></para>
</book>
</root>

我想要的输出是:

<root>
<book>
<title>
Test title for xml
</title>
<para n=1><head value="PARA HEADING"/>para1 information </para>
<para n=2><head value="PARA HEADING"/>para2 information<subpara i=1><head value="PARA HEADING"/>Subpara Info</subpara><xyz/></para>
</book>
</root>

如果'para'或'subpara'中不存在子节点'head'，我想像上面那样添加子节点'head'。

我试过这个代码:

#!/usr/local/bin/perl5.8.8
use XML::LibXML;
my $xml_parser = XML::LibXML->new();
my $xml_doc    = $xml_parser->parse_file( xml_file . xml );
my $root       = $xml_doc->getDocumentElement();
my $xml_xc     = XML::LibXML::XPathContext->new( $root );
my @array_list = ( para, deck );
foreach my $xml_sections ( $xml_xc->findnodes( '//*' ) ) {
    if ( $xml_sections->nodeName ne "head" ) {
        my $marker_flag = 0;
        foreach my $first_child ( $xml_sections->childNodes() ) {
            if ( $first_child->nodeName eq "head" ) {
                $marker_flag = 1;
                last;
            }
        }
        if ( !$marker_flag ) {
            foreach my $array_elt ( @array_list ) {
                if ( $array_elt eq $xml_sections->nodeName ) {
                    my $new_tag = $xml_doc->createElement( "head" );
                    my $value   = "PARA HEADING";
                    my $att1    = $xml_doc->createAttribute( "value", "$value" );
                    $new_tag->setAttributeNode( $att1 );
                    $xml_sections->addChild( $new_tag );
                }
            }
        }
    }
}
print $root->toString();
exit 0;

我的输出是:

<root>
<book>
<title>
Test title for xml
</title>
<para n=1>para1 information <head value="PARA HEADING"/></para>
<para n=2><head value="PARA HEADING"/>para2 information<subpara i=1>subpara Info<head value="PARA HEADING"/></subpara><xyz/></para>
</book>
</root>

我怎样才能做到这一点?

你在给自己找麻烦!例如，除非您的XML数据具有非默认名称空间，否则不需要涉及XML::LibXML::XPathContext，而您的示例没有。此外,para和subpara元素(如n=1)的属性值应该在它们周围加上引号，给予n="1"等

下面的解决方案使用XPath表达式查找所有para或subpara元素，并使用exists检查它们是否都已经有head子元素。使用要插入的数据设置标量$head，并在找到的每个元素的第一个子元素之前插入它的克隆

use strict;
use warnings;
use XML::LibXML;
my $parser = XML::LibXML->new;
my $doc = $parser->parse_fh(*DATA);
my $head = $parser->parse_balanced_chunk('<head value="PARA HEADING"/>');
for my $para ( $doc->findnodes('//para | //subpara') ) {
    if ( not $para->exists('head') ) {
        $para->insertBefore($head->cloneNode(1), $para->firstChild);
    }
}
print $doc;

__DATA__
<root>
<book>
<title>
Test title for xml
</title>
<para n="1"> para1 information </para>
<para n="2"><head value="PARA HEADING"/>para2 information<subpara i="1">subpara Info</subpara><xyz/></para>
</book>
</root>

输出

<?xml version="1.0"?>
<root>
<book>
<title>
Test title for xml
</title>
<para n="1"><head value="PARA HEADING"/> para1 information </para>
<para n="2"><head value="PARA HEADING"/>para2 information<subpara i="1"><head value="PARA HEADING"/>subpara Info</subpara><xyz/></para>
</book>
</root>

您正在寻找XML::LibXML::Node的insertBefore和addChild方法

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
use XML::LibXML;
my $dom = XML::LibXML->load_xml( IO => *DATA );
for my $node ( $dom->findnodes("//para | //subpara") ) {
    my $newnode = XML::LibXML->load_xml( string => '<head value="PARA HEADING"/>' )->findnodes('//*')->[0];
    my @children = $node->childNodes();
    if ( !@children ) {
        $node->addChild($newnode);
    } elsif ( $children[0]->nodeName ne 'head' ) {
        $node->insertBefore( $newnode, $children[0] );
    }
}
print $dom->toString;
__DATA__
<root>
<book>
<title>
Test title for xml
</title>
<para n="1"> para1 information </para>
<para n="2"><head value="PARA HEADING"/>para2 information<subpara i="1">subpara Info</subpara><xyz/></para>
</book>
</root>

输出:

<?xml version="1.0"?>
<root>
<book>
<title>
Test title for xml
</title>
<para n="1"><head value="PARA HEADING"/> para1 information </para>
<para n="2"><head value="PARA HEADING"/>para2 information<subpara i="1"><head value="PARA HEADING"/>subpara Info</subpara><xyz/></para>
</book>
</root>

此外，您可以使用其<xsl:when>和<xsl:otherwise>逻辑运行XSLT转换。作为信息，XSLT是一种声明性的专用编程语言(与SQL类型相同，但有数据库)，专门用于转换、样式化、重新格式化或重新构造XML文档。

Perl

(通用脚本)

use XML::LibXML;
use XML::LibXSLT;
my $xml_parser  = XML::LibXML->new();
my $xml_doc     = $xml_parser->parse_file($XML_FILENAME);
my $xslt_parser = XML::LibXSLT->new;    
my $xsl_doc     = $xml_parser->parse_file($XSL_FILENAME);
my $stylesheet  = $xslt_parser->parse_stylesheet($xsl_doc);
my $results     = $stylesheet->transform($xml_doc);
my $output      = $stylesheet->output_string($results);
print $stylesheet->output_string($results);

XSLT (另存为。xsl文件以供上面使用)

<?xml version="1.0" ?> 
<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0">  
  <xsl:output method="xml" indent="yes"/>
    <xsl:template match="@*|node()">
      <xsl:copy>
        <xsl:apply-templates select="@*|node()"/>
      </xsl:copy>
    </xsl:template>
    <xsl:template match="para" name="paratemplate">      
      <xsl:choose>        
        <xsl:when test="string-length(head/@value)>0">
          <xsl:copy>
            <xsl:apply-templates select="@*|node()"/>
          </xsl:copy> 
        </xsl:when>
        <xsl:otherwise>
          <para>
            <xsl:apply-templates select="@*"/>
            <xsl:element name="head">
              <xsl:attribute name="value">PARA HEADING</xsl:attribute>
            </xsl:element>
            <xsl:apply-templates select="text()"/>
          </para>          
        </xsl:otherwise>
      </xsl:choose>      
    </xsl:template>
  <xsl:template match="subpara" name="subparatemplate">      
      <xsl:choose>        
        <xsl:when test="string-length(head/@value)>0">
          <xsl:copy>
            <xsl:apply-templates select="@*|node()"/>
          </xsl:copy> 
        </xsl:when>
        <xsl:otherwise>
          <subpara>
            <xsl:apply-templates select="@*"/>  
            <xsl:element name="head">            
              <xsl:attribute name="value">PARA HEADING</xsl:attribute>              
            </xsl:element>
            <xsl:apply-templates select="text()"/>  
          </subpara>          
        </xsl:otherwise>
      </xsl:choose>      
    </xsl:template>
</xsl:stylesheet>

<?xml version="1.0"?>
<root>
  <book>
    <title>
Test title for xml
</title>
    <para n="1"><head value="PARA HEADING"/> para1 information </para>
    <para n="2"><head value="PARA HEADING"/>para2 information<subpara i="1"><head value="PARA HEADING"/>subpara Info</subpara><xyz/></para>
  </book>
</root>

相关内容

最新更新

热门标签：