尝试在XML文档中编辑PCDATA

时间:2012-03-26 22:25:02

标签: xml perl

我们的一个流程包括从Excel电子表格到Oxygen编辑器文档的复制粘贴。它工作得很好,但没有捕获特殊字符,因此,我正在编写一个脚本来查找和更改它们。我已经开始在流模式下使用XML :: Parser了,但我不太确定我是否会得到我需要采用这种方法的地方。

首先,因为解析器(正确)不关心属性顺序,所以属性可以(并且确实)以不同的顺序返回,这会使一些人烦恼。此外,我目前无法始终如一地识别PCDATA。并且重新组装元素标签似乎有点多了......而且我也不会真正处理EMPTY元素。我在这里错过了一点,或者我应该看看其他东西,比如XML :: Twig?

提前致谢所有(任何人)花时间回复!

use strict;
use warnings;
use IO::File;
use XML::Parser;

my $xml = <<EOD;
<?xml version="1.0"?>
<messages>
  <message>
    <from id="t_8ur9k0" type="king">Maximus</from>
    <to>knave</to>
    <subject>My boots</subject>
    <body>I <i>really</i> want my riding boots. Bring them to me, at once!</body>
  </message>
</messages>
EOD

my $parser = new XML::Parser(Style => 'Stream', ErrorContext => 2);
$parser->setHandlers(Start => \&handle_start, 
      End => \&handle_end, 
      Char => \&handle_char,
      Default => \&handle_default);

$parser->parse($xml);

sub handle_start {
  my ($self, $tag, %attrs) = @_;
  my $atts = '';
  if (%attrs) {
    while ( my ($key, $val) = each(%attrs) ) {
      $atts .= " " . $key . '="' . $val . '"';
    }
  }
  print "<" . $tag . $atts . ">";
}

sub handle_end {
  my ($self, $tag) = @_;
  print "</" . $tag . ">";
}

sub handle_char {
  my ($self,$raw) = @_;
  if ( !($raw =~ m/\s/) ) {
    $raw =~ s/.*/FOO/;
  }
  print $raw;
}

sub handle_default {
  my ($self,$str) = @_;
  print $str;
}

1 个答案:

答案 0 :(得分:0)

XML::Parser以正确的顺序将属性信息提供给Start回调处理程序。这些属性在程序中不按顺序出现,因为您将它们放入行

中的哈希值
my ($self, $tag, %attrs) = @_;

失去了订单。

XML::Parser很少单独使用。您可以使用XML::Twig,但我的偏好是XML::LibXML

您没有说明要对数据执行哪些转换,但此程序会再现除删除的(任意选择的)<subject>元素之外的输入。请注意直接使用XPath表示法来操作文档,以及<from>元素的多个属性按顺序保存。

use strict;
use warnings;

use XML::LibXML;

my $doc = XML::LibXML->load_xml(string => <<XML);
<?xml version="1.0"?>
<messages>
  <message>
    <from id="t_8ur9k0" type="king" b="b" c="c" d="d" e="e" f="f" g="g">Maximus </from>
    <to>knave</to>
    <subject>My boots</subject>
    <body>I <i>really</i> want my riding boots. Bring them to me, at once!</body>
  </message>
</messages>
XML

my @nodes = $doc->findnodes('/messages/message/subject');
$nodes[0]->unbindNode;
print $doc->toString;

<强>输出

<?xml version="1.0"?>
<messages>
  <message>
    <from id="t_8ur9k0" type="king" b="b" c="c" d="d" e="e" f="f" g="g">Maximus </from>
    <to>knave</to>

    <body>I <i>really</i> want my riding boots. Bring them to me, at once!</body>
  </message>
</messages>

<强>更新

这是一个修改所有文本节点的演示,无论文档的结构如何

use strict;
use warnings;

use XML::LibXML;

my $doc = XML::LibXML->load_xml(string => <<XML);
<?xml version="1.0"?>
<messages>
  <message>
    <from id="t_8ur9k0" type="king" b="b" c="c" d="d" e="e" f="f" g="g">Maximus </from>
    <to>knave</to>
    <subject>My boots</subject>
    <body>I <i>really</i> want my riding boots. Bring them to me, at once!</body>
  </message>
</messages>
XML

my @nodes = $doc->findnodes('//text()');
$_->setData(lc $_->data) for @nodes;
print $doc->toString;

<强>输出

<?xml version="1.0"?>
<messages>
  <message>
    <from id="t_8ur9k0" type="king" b="b" c="c" d="d" e="e" f="f" g="g">maximus </from>
    <to>knave</to>
    <subject>my boots</subject>
    <body>i <i>really</i> want my riding boots. bring them to me, at once!</body>
  </message>
</messages>