一个基于 Web 的剪报服务

作者:Reuven M. Lerner

在十一月份,我们了解了如何使用 Perl 的 Web 编程库 (LWP) 来创建一个简单的 HTTP 客户端,从 Web 上检索一个或多个页面。本月,我们将扩展这些工作,创建一个程序,该程序不仅可以从 Web 上检索页面,还可以根据我们的偏好对它们进行分类。通过这种方式,我们可以创建我们自己的基于 Web 的剪报服务,找到那些我们特别感兴趣的文章。

LWP 由多个模块组成,这些模块允许我们使用 HTTP,“超文本传输​​协议”。 HTTP 在无状态的请求-响应基础上工作:客户端连接到服务器并提交请求。然后,服务器生成响应并关闭连接。(如果您错过了上个月的专栏,可以在这里找到:使用 LWP。在继续之前,您应该阅读该文章。)

下载文件

我们需要一个程序,它可以访问特定的 URL 并将该 URL 的内容保存到磁盘上。此外,我们希望跟踪文档中的任何超链接,以收集其他新闻报道。但是,我们不想跟踪到其他站点的链接;这不仅减少了我们跑题的可能性,而且避免了被过多误导的可能性。

换句话说,我希望能够将一个程序指向一个站点,并将该站点的所有文件检索到磁盘上。下载-递归.pl,这样的程序的第一个尝试,类似于我们上个月探索的简单机器人程序。它使用两个哈希,%already_retrieved%to_be_retrieved 来存储 URL。我们不是将 URL 作为哈希中的值存储,而是将它们用作键。这确保了每个 URL 只会出现一次,避免了无限循环和错误计数。URL 在首次遇到时被放入 %to_be_retrieved 中,然后在检索其内容后移动到 %already_retrieved

检索是通过 while 循环执行的。while 循环的每次迭代都从 %to_be_retrieved 中检索另一个 URL,并使用它来创建 HTTP::Request 的新实例。

方法 $response->last_modified 返回文档上次修改的日期和时间。从当前时间减去 $response->last_modified,然后将此结果与我们希望看到的最大文档年龄 ($maximum_age) 进行比较,这使我们能够过滤掉相对较旧的文档

my $document_age = time -
   $response->last_modified;
    if ($document_age > $maximum_age)
    {
        print STDOUT
        "  Age of document: $document_age\n";
        next;
    }

如果文档太旧,我们使用 next 返回到 while 循环的下一次迭代——因此返回到要检索的下一个 URL。

接下来,我们使用 HTML::LinkExtor 模块解析 HTTP 响应的内容。当我们创建 HTML::LinkExtor 的实例时,我们实际上是在创建一个简单的解析器,它可以查找 HTML 页面并返回一个或多个信息片段。分析由一个子例程执行,通常命名为 callback。callback 的引用与将要解析的 URL 一起传递,以创建 HTML::LinkExtor 的新实例。

my $parser = HTML::LinkExtor->new (\&callback, $url);

然后,可以通过调用以下命令,使生成的对象解析我们 URL 的内容

$parser->parse($response->content);
当调用 $parser->parse 时,对于文件中的每个 HTML 标记,&callback 都会被调用一次。我们的 &callback 版本从每个 <a> 标记的 href 属性中抓取每个 URL,除非该 URL 存在于 %already_retrieved 中,否则将其保存在 %to_be_retrieved 中。

最后,我们将检索到的文档保存在本地文件系统上。将文件保存到磁盘的棘手部分与我们检索 URL 的方式有关——我们不是遍历 URL 树,而是按哈希顺序提取 URL。这意味着 URL http://foo.com/a/b/c/ 可能在 http://foo.com/a/index.html 之前被检索。因此,我们需要确保在创建 /a 和 /a/b 之前,/a/b/c 目录在我们的本地系统上存在。我们该怎么做呢?

我的解决方案是使用 Perl 的内置 split 运算符,它将标量转换为列表。通过将此部分目录列表分配给数组 (@output_directory),我们可以从根目录 (/) 到最终名称顺序构建目录。在此过程中,我们检查目录是否存在。如果不存在,我们使用 mkdir 创建新目录。如果目录不存在且 mkdir 失败,我们将退出并显示致命错误,指示发生了什么错误。

那些缺少文件名的 URL 将被赋予 “index.html” 之一。由于这是许多 Web 服务器上访问的默认文件名,因此有理由认为这可能不会与任何这些名称冲突。

运行此程序的最终结果是下载站点的镜像,存储在 $output_directory 中。

筛选输出

能够下载网站的全部或部分内容非常方便。但是,我们最初的目标是能够筛选网站的内容,以查找我们感兴趣的一个或多个短语。

这样的程序与 download-recursively.pl 没有太大区别。我们的新版本 download-matching.pl 的不同之处在于,它只存储包含一个或多个短语的消息,这些短语存储在外部文件 phrase-file.txt 中。这两个程序的代码都可以在文件 ftp.linuxjournal.com/pub/lj/listings/issue68/3714.tgz 中找到。

有几种方法可以执行此类检查和匹配。我选择以一种相对简单但直接的方式来做,遍历文件中的每个短语,并使用 Perl 的内置字符串匹配机制。

由于短语在整个程序运行期间将保持不变,因此我们在 while 循环开始之前从 phrase-file.txt 加载它们

my $phrase_file = "phrase-file.txt";
    my @phrases;
    open PHRASES, $phrase_file or die
    "Cannot read $phrase_file: $! ";
    while (<PHRASES>)
    {
        chomp;
        push @phrases, $_;
    }
    close PHRASES;

上面的代码遍历短语文件的每一行,删除尾随换行符(使用 chomp),然后将该行存储在 @phrases 中。每个短语都必须在短语文件中单独占一行;一个可能的文件可能看起来像这样

Linux
Reuven
mortgage
一旦 @phrases 包含我们要搜索的所有短语,download-matching.pl 的运行方式与其不太挑剔的前身非常相似。不同之处在于,在回调已经被调用之后,扫描文件以查找任何新链接时。站点的目录可能不包含 @phrases 中的任何字符串,但它指向的文档可能包含。

在收集新链接之后,但在将文件写入磁盘之前,download-matching 然后遍历 @phrases 中的短语,将每个短语与文档进行比较。如果找到匹配项,它会将 $did_match 设置为 1 并退出循环

foreach my $phrase (@phrases)
    {
        if ($content =~ m/>.*[^<]*\b$phrase\b/is)
        {
            # Did we match?
            $did_match = 1;
            print "        Matched $phrase\n";
            # Exit from the foreach if we found a
            # match
            last;
        }
    }

请注意我们如何用 \b 包围 $phrase。这是 Perl 表示单词之间分隔符的方式,并确保我们的短语不会出现在单词的中间。例如,如果我们要搜索 “vest”,\b 元字符确保 download-matching.pl 不会匹配单词 “investments”。

如果 $did_match 设置为非零值,则表示在文档中找到了至少一个短语。(我们使用 /i 选项来 Perl 的 m// 匹配运算符,以指示搜索应不区分大小写。如果您希望区分大写字母和小写字母,请删除 /i。)如果 $did_match 设置为 0,我们使用 next 转到 while 循环的下一次迭代,因此转到 %to_be_retrieved 中的下一个 URL。

这一切都假定布尔 “或” 匹配,其中只需要一个短语匹配。如果我们想坚持要求我们所有的短语都出现在文件中才能获得肯定结果(“与” 匹配),我们必须稍微改变我们的策略。与其将 $did_match 设置为 1,不如在每次找到匹配项时递增它。然后我们将 $did_match 的值与 @phrases 中元素的数量进行比较;如果它们相等,我们可以确定所有短语都包含在文档中。

如果可能,我们希望避免匹配 HTML 标记中包含的文本。例如,在撰写本文时,我惊讶地发现 Wired News(一个技术新闻来源)上有多少文章匹配了单词 “mortgage”。最后,我发现该程序匹配的是 HTML 标记内的短语,而不是文本本身。我们可以通过剥离文件中的 HTML 标记来避免这个问题——但这将意味着失去在阅读下载的文件时浏览链接的能力。

相反,download-matching.pl 将当前检查文件的内容复制到一个变量 ($content) 中,并从中删除 HTML 标记

my $content = $response->content;
    $content =~ s|<.+?>||gs;

请注意,我们如何使用替换运算符 (s///) 的 gs 选项,删除所有成对的 HTML 标记,即使它们被换行符分隔。(s 选项在 . 的定义中包含换行符,通常情况下不是这样。)

我们通过在 + 之后放置 ? 来避免贪婪正则表达式的后果,在贪婪正则表达式中,Perl 试图匹配尽可能多的内容。如果我们替换 <.+>,而不是 <.+?>,我们将删除文件中第一个 < 和最后一个 > 之间的所有内容——这可能包括内容以及 HTML 标记。

download-matching.pl 优于 download-recursively.pl 的最后一个改进是它可以处理多个命令行参数。如果 @ARGV 包含一个或多个参数,则这些参数用于初始填充 %to_be_searched。如果 @ARGV 为空,我们将默认 URL 分配给 $ARGV[0]。在这两种情况下,@ARGV 的元素都会转换为 %to_be_retrieved 的键

foreach my $url (@ARGV)
    {
        print "    Adding $url to the list...\n"
        if $DEBUGGING;
        $to_be_retrieved{$url} = 1;
    }
使用 download-matching.pl

现在我们有了一个程序来检索符合我们条件的文档,我们如何使用它呢?我们可以从命令行运行它,但是这个程序的重点是为您完成工作,在您睡觉或看电视时下载文档。

最简单的方法是使用 cron,Linux 工具,它允许我们定期运行程序。每个用户都有自己的 crontab,一个表格,指示程序应在何时运行。每个命令前面都有五列,指示程序应运行的时间和日期:分钟、小时、月份中的某天、月份和星期几。这些列通常用数字填充,但星号可以用于指示通配符。

crontab 中的以下条目指示程序 /bin/foo 应在每个星期日凌晨 4:05 运行。

5 4 * * 0 /bin/foo

使用 cron 时,请务必使用完整的路径名——这里我们指示 /bin/foo,而不仅仅是 “foo”。

crontab 使用 crontab 程序编辑,使用其 -e 选项。这将打开 EDITOR 环境变量中定义的编辑器,默认情况下为 vi。(Emacs 用户应考虑将其设置为 emacsclient,它会在已运行的 Emacs 进程中加载文件。)

要每天午夜从 Wired News 下载所有与我们的短语匹配的文件,我们可以使用以下命令

0 0 * * 0 /usr/bin/download-matching.pl\
www.wired.com/news/http://www.wired.com/news/

这将启动从 http://www.wirec.com/news/ 下载文件的过程,时间为午夜,并将结果放置在 $output_directory 中。我们也可以指定多个 URL,从而允许我们从多个我们喜爱的新闻来源检索新闻。当我们早上醒来时,新的我们感兴趣的文档将等待我们阅读,位于 $output_directory 中。

结论

许多组织聘请剪报服务来查找他们感兴趣的新闻。凭借一点聪明才智和对 LWP 的大量依赖,我们可以创建我们自己的个性化剪报服务,下载反映我们个人兴趣的文档。您不再需要浏览标题列表才能找到相关文档——让 Perl 和 Web 为您完成工作。

资源

A Web-Based Clipping Service
Reuven M. Lerner 是一位居住在以色列海法的互联网和 Web 顾问。他的著作《Core Perl》即将由 Prentice-Hall 出版。可以通过 reuven@lerner.co.il 联系 Reuven。ATF 主页位于 http://www.lerner.co.il/atf/
加载 Disqus 评论