Question

我需要一个程序来复制XML元素并为其添加属性。使用XSLT转换可能会更容易，但我需要程序来询问是否应复制每个匹配的元素。

这是我入门的一个小而简单的例子

<?xml version="1.0" encoding="UTF-8"?>
<article>
  <section>
    <title>title</title>
    <para>text</para>
    <mediaobject>

      <imageobject>
        <imagedata fileref="filename.png" format="PNG"/>    
      </imageobject>

    </mediaobject>
    <para>text</para>
  </section>
</article>

传递脚本后我想要什么

<?xml version="1.0" encoding="UTF-8"?>
<article>
  <section>
    <title>title</title>
    <para>text</para>
    <mediaobject>

      <imageobject arch="html;fo;fo-print">
        <imagedata fileref="filename.png" format="PNG"/>    
      </imageobject>

      <imageobject arch="screen">
        <imagedata fileref="filename.png" format="PNG" width="100%"/>    
      </imageobject>

    </mediaobject>
  </section>
</article>

我需要找到该程序每个imageobject元素询问是否应该重复。如果是这样，则将其复制并添加属性arch和width。

该XML文件必须在脚本外部，如果可以将其应用于多个文件，那就太好了。

Answer 1

教程：https://grantm.github.io/perl-libxml-by-example/

use 5.024;
use IO::Prompt qw(prompt);
use XML::LibXML qw();

my $dom = XML::LibXML->new(line_numbers => 1)->parse_file('so51206867.xml');
for my $imageobject ($dom->findnodes('//imageobject')) {
    say 'Found at line ' . $imageobject->line_number;
    say $imageobject->toString;
    if (prompt 'Duplicate? ', '-yes') {
        my $copy = $imageobject->cloneNode(1);
        $imageobject->setAttribute(arch => 'html;fo;fo-print');
        $copy->setAttribute(arch => 'screen');
        $copy->findnodes('//imagedata')->get_node(1)->setAttribute(width => '100%');
        $imageobject->addSibling($copy);
    }
}
$dom->toFile('so51206867-out.xml');

复制XML元素并添加属性

1 个答案: