Как перемещать узел в XML-данных с помощью Perl

Question

Я пробовал несколько разных методов анализа XML-документов. Мне нужно найти узел в документе с атрибутом x, а затем переместить этот узел со своими дочерними элементами на другой родительский узел.

У меня был некоторый успех, используя XML::LibXML для определения местонахождения узла и возможности повторения его дочерних элементов, но я застрял в том, как переместить его в другой родитель.

Использование $node->cloneNode(1) выглядит многообещающим, но я не могу найти хороших примеров его использования.

Это исходные данные XML

<config logdir="/var/log/foo/" debugfile="/tmp/foo.debug"> 
    <old> 
    <server name="sahara" osname="solaris" osversion="2.6"> 
     <address ip="10.0.0.101">Private</address> 
     <address ip="10.0.1.101">Private</address> 
    </server> 
    <server name="gobi" osname="irix" osversion="6.5"> 
     <address ip="10.0.0.102">Private</address> 
    </server> 
    <server name="kalahari" osname="linux" osversion="2.0.34"> 
     <address ip="10.0.0.103">Private</address> 
     <address ip="10.0.1.103">Private</address> 
    </server> 
    </old> 
    <new> 
    </new>   
</config> 

и это результат я хотел бы

<config logdir="/var/log/foo/" debugfile="/tmp/foo.debug"> 
    <old> 
    <server name="sahara" osname="solaris" osversion="2.6"> 
     <address ip="10.0.0.101">Private</address> 
     <address ip="10.0.1.101">Private</address> 
    </server> 
    <server name="gobi" osname="irix" osversion="6.5"> 
     <address ip="10.0.0.102">Private</address> 
    </server> 
    </old> 
    <new> 
    <server name="kalahari" osname="linux" osversion="2.0.34"> 
     <address ip="10.0.0.103">Private</address> 
     <address ip="10.0.1.103">Private</address> 
    </server> 
    </new>   
</config> 

Answer 1

Использование XML::LibXML:

use strict; 
use warnings; 

use XML::LibXML; 

my $xml = XML::LibXML->load_xml(IO => \*DATA); 

my ($new) = $xml->findnodes('//new'); 

for my $linux ($xml->findnodes('//old/server[@osname="linux"]')) { 
    $linux->unbindNode();   # Remove from Parent (done automatically when added elsewhere without cloning) 
    $new->addChild($linux); 
} 

print $xml; 

__DATA__ 
<config logdir="/var/log/foo/" debugfile="/tmp/foo.debug"> 
    <old> 
     <server name="sahara" osname="solaris" osversion="2.6"> 
      <address ip="10.0.0.101">Private</address> 
      <address ip="10.0.1.101">Private</address> 
     </server> 
     <server name="gobi" osname="irix" osversion="6.5"> 
      <address ip="10.0.0.102">Private</address> 
     </server> 
     <server name="kalahari" osname="linux" osversion="2.0.34"> 
      <address ip="10.0.0.103">Private</address> 
      <address ip="10.0.1.103">Private</address> 
     </server> 
    </old> 
    <new> 
    </new>  
</config> 

Выходы:

<?xml version="1.0"?> 
<config logdir="/var/log/foo/" debugfile="/tmp/foo.debug"> 
    <old> 
     <server name="sahara" osname="solaris" osversion="2.6"> 
      <address ip="10.0.0.101">Private</address> 
      <address ip="10.0.1.101">Private</address> 
     </server> 
     <server name="gobi" osname="irix" osversion="6.5"> 
      <address ip="10.0.0.102">Private</address> 
     </server> 

    </old> 
    <new> 
    <server name="kalahari" osname="linux" osversion="2.0.34"> 
      <address ip="10.0.0.103">Private</address> 
      <address ip="10.0.1.103">Private</address> 
     </server></new>  
</config> 

Answer 2

Все, что вам нужно сделать, это найти как дочерний узел, так и родительский элемент, и переместить его в новый родитель с вызовом appendChild.

Предположим, что ваши исходные данные XML находятся в файле с именем config.xml, код будет выглядеть следующим образом.

Я не знаю, как лучше уговорить XML::LibXML для получения данных с отличным отступом. Лучшее, что я нашел, это включить no_blanks и использовать ненулевой параметр до toString, но, как вы можете видеть, это далеко не идеальный.

use strict; 
use warnings; 

use XML::LibXML; 

my $xml = XML::LibXML->load_xml(location => 'config.xml', no_blanks => 1); 

my ($kalahari) = $xml->findnodes('/config/old/server[@name="kalahari"]'); 

my ($new) = $xml->findnodes('/config/new'); 

$new->appendChild($kalahari); 

print $xml->toString(1); 

выход

<?xml version="1.0"?> 
<config logdir="/var/log/foo/" debugfile="/tmp/foo.debug"> 
    <old> 
    <server name="sahara" osname="solaris" osversion="2.6"> 
     <address ip="10.0.0.101">Private</address> 
     <address ip="10.0.1.101">Private</address> 
    </server> 
    <server name="gobi" osname="irix" osversion="6.5"> 
     <address ip="10.0.0.102">Private</address> 
    </server> 
    </old> 
    <new> 
    <server name="kalahari" osname="linux" osversion="2.0.34"><address ip="10.0.0.103">Private</address><address ip="10.0.1.103">Private</address></server></new> 
</config>