如何在 Perl 中修改 HTML 文件？答案

【问题标题】：How can I modify HTML files in Perl?如何在 Perl 中修改 HTML 文件？
【发布时间】：2011-04-23 11:40:45
【问题描述】：

我有一堆 HTML 文件，我想做的是在每个 HTML 文件中查找关键字“来自 Argumbay”，并用我拥有的一些 href 更改它。起初我认为它很简单，所以我打开每个 HTML 文件并将其内容加载到一个数组（列表）中，然后查找每个关键字并将其替换为 s///，并将内容转储到文件，有什么问题？有时关键字也可以出现在href中，在这种情况下我不希望它被替换，或者它可以出现在某些标签等中。

一个例子：http://www.astrosociety.org/education/surf.html

我希望我的脚本用我在 $href 中的一些 href 替换每个出现的单词“here”，但是正如你所看到的，还有另一个 'here' 已经是 href'ed，我不想要它再次href这个。在这种情况下，除了 href 之外没有额外的 'here's there，但我们假设有。

我只想替换关键字，如果它只是文本，有什么想法吗？

BOUUNTY 编辑：嗨，我相信这是一件简单的事情，但似乎它会删除 HTML、SHTML 文件中的所有 cmets（主要问题是它会删除 SHTML 中的 SSI），我尝试使用：store_cmets(1 ) 方法在 $html 调用递归函数之前，但无济于事。知道我在这里缺少什么吗？

【问题讨论】：

没有看到你的代码，很难说问题出在哪里。
你能给出示例 HTML 行吗？
也许接受的答案也应该得到赏金？ :)
我接受了，上面写着“你可以在 7 小时内奖励赏金”，为什么？

标签： html perl html-parsing

【解决方案1】：

要使用HTML::TreeBuilder 执行此操作，您将读取文件、修改树并将其写出（到同一个文件或不同的文件）。这是相当复杂的，因为您试图将文本节点的一部分转换为标签，并且因为您有无法移动的 cmets。

HTML-Tree 的一个常见习惯用法是使用递归函数来修改树：

use strict;
use warnings;
use 5.008;

use File::Slurp 'read_file';
use HTML::TreeBuilder;

sub replace_keyword
{
  my $elt = shift;

  return if $elt->is_empty;

  $elt->normalize_content;      # Make sure text is contiguous

  my $content = $elt->content_array_ref;

  for (my $i = 0; $i < @$content; ++$i) {
    if (ref $content->[$i]) {
      # It's a child element, process it recursively:
      replace_keyword($content->[$i])
          unless $content->[$i]->tag eq 'a'; # Don't descend into <a>
    } else {
      # It's text:
      if ($content->[$i] =~ /here/) { # your keyword or regexp here
        $elt->splice_content(
          $i, 1, # Replace this text element with...
          substr($content->[$i], 0, $-[0]), # the pre-match text
          # A hyperlink with the keyword itself:
          [ a => { href => 'http://example.com' },
            substr($content->[$i], $-[0], $+[0] - $-[0]) ],
          substr($content->[$i], $+[0])   # the post-match text
        );
      } # end if text contains keyword
    } # end else text
  } # end for $i in content index
} # end replace_keyword


my $content = read_file('foo.shtml');

# Wrap the SHTML fragment so the comments don't move:
my $html = HTML::TreeBuilder->new;
$html->store_comments(1);
$html->parse("<html><body>$content</body></html>");

my $body = $html->look_down(qw(_tag body));
replace_keyword($body);

# Now strip the wrapper to get the SHTML fragment back:
$content = $body->as_HTML;
$content =~ s!^<body>\n?!!;
$content =~ s!</body>\s*\z!!;

print STDOUT $content; # Replace STDOUT with a suitable filehandle

as_HTML 的输出将是语法正确的 HTML，但不一定是格式良好的 HTML，以便人们查看其源代码。如果需要，可以使用HTML::PrettyPrinter 写出文件。

【讨论】：

WOOOOOOOOOOOOOOOOOOOOOOOOW！认真的人，你从哪里来的？我不能要求更好的解决方案！惊人的。它工作得很好，但不是我需要几个小时才能理解你在那里做了什么（-：非常感谢！
我经常使用 HTML-Tree。此外，substr 表达式只是从 @- 的文档中复制出来的，因为使用 $& 等会减慢您的程序。
@soulSurfer2010，如果你想保留 cmets，你不能使用new_from_file，因为你必须在加载文件之前调用store_comments。而是调用new，然后是store_comments，然后是parse_file。
@soulSurfer2010，这是 HTML::TreeBuilder 的当前限制。一切都是节点的子节点，甚至是出现在它之前或之后的 cmets。
@soulSurfer2010，我在示例中添加了一种解决方法。由于您的示例不是完整的 HTML 文档，您可以将其包装在 <body> 标记中，并且 cmets 不会重新排列。

【解决方案2】：

如果标签在您的搜索和替换中很重要，您需要使用HTML::Parser。

这个tutorial 看起来比模块文档更容易理解。

【讨论】：

我可以使用 HTML::TreeBuilder 代替吗？我问的是因为我从来没有使用过它们。
@soulSurfer2010，是的，HTML::TreeBuilder 可以帮助您做到这一点。（它建立在 HTML::Parser 之上。）
@soulSurfer2010 是的，看起来它也可以。我真正想说的是，您需要实际解析 HTML，而不仅仅是将正则表达式应用于源代码，这就是我根据您提供的少量信息猜测您正在做的事情。
是的，我尝试使用正则表达式一切正常，直到我有类似的东西：'From Argum bay in love'已经在href中，然后我的脚本所做的是href'ing再次，这不是我要找的。只有当文本还没有被href'ed然后我想用我的href（=超链接）替换它
好吧，我可以使用 HTML::TreeBuilder 或 HTML::TokeParser 来查找关键字是否已被href'ed，但我目前的问题是，如果不是，我如何将其替换为我的href，因为我是使用模块解析它，而不是直接从我可以替换的东西然后打印到文件的列表中解析它....有什么建议吗？

【解决方案3】：

如果您想采用仅正则表达式类型的方法，并且准备接受以下条件：

这在 HTML cmets 中无法正常工作
这在标签中使用< 或> 字符时不起作用
这在使用 < 或 > 字符而不是标签的一部分时不起作用
这在标签跨越多行时不起作用（如果您一次处理一行）

如果确实存在上述任何一种情况，那么您将不得不使用其他答案中概述的 HTML/XML 解析策略之一。

否则：

my $searchfor = "From Argumbay";
my $replacewith = "<a href='http://google.com/?s=Argumbay'>From_Argumbay</a>";

1 while $html =~ s/
  \A             # beginning of string
  (              # group all non-searchfor text
    (            # sub group non-tag followed by tag
      [^<]*?     # non-tags (non-greedy)
      <[^>]*>    # whole tags
    )*?          # zero or more (non-greedy)
  )
  \Q$searchfor\E # search text
/$1$replacewith/sx;

请注意，如果 $searchfor 匹配 $replacetext，这将不起作用（因此不要将“From Argumbay”放回替换文本中）。

【讨论】：

我在今天访问这个网站之前几分钟前已经想出了一些类似的解决方案，我无法接受这些规定。谢谢！