获取 HTML 中的特定链接答案

【问题标题】：Get specific links within HTML获取 HTML 中的特定链接
【发布时间】：2014-01-09 18:24:09
【问题描述】：

很好的堆栈溢出人员。我正在尝试获取 HTML 文件链接到的文件的 Perl 数组。我对 Perl 还是很陌生，而且我对 HTML 很不熟悉，所以请多多包涵。部分文件在链接文本外标有星号 (*)，表示该文件定期更新。我只想提取定期更新的文件的链接。 HTML 文件如下所示：

<tr>
    <td height="34" nowrap width="170">
    <a href="/Files/link1.pdf">Link 1</a>*</td>
</tr>

<!--
<tr>
    <td height="34" nowrap width="170">
    <a href="/Files/link2.pdf">Link 2</a>*</td>
</tr>
-->

<tr>
    <td height="34" nowrap width="170">
    <a href="/Files/link3.pdf">Link 3</a>
    *</td>
</tr>

<tr>
    <td height="34" nowrap width="170">
    <a href="/Files/link4.pdf">Link 4</a></td>
</tr>

所以我想要在我的数组中是链接 1 和 3 的 URL，它们用星号标记为更新，但不是 2，因为它在评论中，而不是 4，因为它没有星号。我根据the accepted answer to this question尝试了以下：

use strict;
use warnings;
use WWW::Mechanize;

my $page = "file://server/web/site.htm";

my $mech = WWW::Mechanize->new();
$mech->get($page);

my @links = $mech->links();
my @urls;

for my $lnk (@links) {
    push(@urls, $lnk->url);
}

即使在评论中，我仍然会得到链接 #2。另外，我不知道从哪里开始只用pushing 星号链接，特别是因为链接#3 的星号在新行上。我最初尝试使用正则表达式而不使用 WWW::Mechanize，但无法在下一行获得星号。

use strict;
use warnings;

my $html = do {
    local $/ = undef;
    open(my $fh, "<", "file") || die $!;
    <$fh>;
};

$html =~ s/(<!--)+.*(-->)+//;

my @urls = ($html =~ /\bhref[ ]?=[ ]?"([^"]+)".*\*/gc);

这将获得链接 1 和 2，但不会获得 3。这将获得 cmets 中的链接，因为显然我的查找和替换正则表达式没有像我预期的那样工作。

那么我如何只获得加星标的链接并跳过评论的链接？我对任何想法都持开放态度——也许我从一开始就采取的方法是不正确的。任何帮助、洞察力或方向都会很棒。非常感谢大家！

【问题讨论】：

Regex is probably not the way to go...使用real HTML parser。
小马，它来了……
CPAN 有一个相当完整的HTML parser。使用它。
@ThisSuitIsBlackNot：页面上关于使用正则表达式解析由 Kaitlin Duck Sherwood 给出的 HTML 的答案更准确地描述了我的情况。我不是在解析任意 HTML；我有一组有限的已知 HTML，其格式如我的示例所示。这个问题的公认答案在我的情况下非常有效。
很公平。但是，对于将来将登陆此页面的许多用户而言，情况可能并非如此。他们应该警告正则表达式方法可能存在的缺陷（尽管我链接到的具体答案只是对此的幽默表达）。

标签： html regex perl

【解决方案1】：

根据您的示例，它应该可以工作。

$html =~ s/<!--.*?-->//sg;
my @urls = ($html =~ /\bhref\s*=\s*"([^"]*)"[^>]*>[^<]*<\/a>\s*\*/sg);
## my @urls = ($html =~ /<a\s+[^>]*href\s*=\s*"([^"]*)"[^>]*>[^<]*<\/a>\s*\*/sg);

【讨论】：

如果文本链接包含标签，[^<]* 将失败。由于您使用/s 修饰符，您可以将其替换为.*?
@sabuj hassan：使用修改后的正则表达式使这项工作完美无缺。非常感谢！

【解决方案2】：

在我的示例中，星号表示定期更新的文件，星号位于 td 标记中。我已经确定如何使用 HTML::TokeParser 提取这些文件。

use strict;
use warnings;
use HTML::TokeParser;

my $html = HTML::TokeParser->new("file.html");

my @urls;

while(my $td = $html->get_tag("td")) {
    my $txt = $html->get_trimmed_text("/td");
    my $url = $html->get_tag("a")->[1]{href};
    if ($txt =~ /\*/) {
        push(@urls, $url);
    }
}

感谢 @sabujhassan 提供有效的解决方案，并感谢 @ThisSuitIsBlackNot 鼓励我寻求更普遍适用的解决方案。

【讨论】：