perl - Perl 网页的缩略图截图::Mechanize

Question

我使用 WWW::Mechanize::Firefox 来控制 firefox 实例并使用 $mech->content_as_png 转储呈现的页面。

新更新 :在最初的帖子末尾看到:
感谢 user1126070，我们有了一个新的解决方案 - 我想在当天晚些时候试用 [现在我在办公室而不是在家 - 在装有程序的机器前]

$mech->repl->repl->setup_client( { extra_client_args => { timeout => 5*60 } } );

我试用了 put links to @list and use eval 的版本并执行以下操作:

while (scalar(@list)) {
        my $link = pop(@list);
        print "trying $link\n";
        eval{
        $mech->get($link);
        sleep (5);
        my $png = $mech->content_as_png();
        my $name = "$_";
        $name =~s/^www\.//;
        $name .= ".png";
        open(OUTPUT, ">$name");
        print OUTPUT $png;        
        close(OUTPUT);
        }
        if ($@){
          print "link: $link failed\n";
          push(@list,$link);#put the end of the list
          next;
        }
        print "$link is done!\n";

}

顺便说一句: user1126070 将图像修剪为缩略图大小。我应该在这里使用成像仪吗？你能在这里提出一些解决方案吗......!？那很好啊。

更新结束

这里问题大纲继续 - 正如写在 本问答开始

问题大纲:我有一个包含 2500 个网站的列表，需要抓取它们的缩略图。我怎么做？我可以尝试使用 Perl 解析站点。- Mechanize 将是一件好事。注意:我只需要结果为长尺寸最大为 240 像素的缩略图。目前我有一个缓慢且不返回缩略图的解决方案:如何使脚本以更少的开销运行得更快 - 吐出缩略图

但我必须意识到，设置它可能会带来相当大的挑战。
如果一切正常，您可以简单地使用这样的脚本来转储所需网站的图像，但您应该启动 Firefox 并手动将其调整为所需的宽度(高度无关紧要，WWW::Mechanize::Firefox 总是转储整个页面)。

我有什么 到目前为止完成 很多 - 我和 mozrepl 一起工作。目前我在为超时而苦恼:有没有办法用 WWW::Mechanize::Firefox 指定 Net::Telnet 超时？
目前我的互联网连接很慢，有时我会出错

with $mech->get():
command timed-out at /usr/local/share/perl/5.12.3/MozRepl/Client.pm line 186

看到这个:

> $mech->repl->repl->timeout(100000);

不幸的是它不起作用:无法通过包“MozRepl”找到对象方法“超时”
文档说这应该:

$mech->repl->repl->setup_client( { extra_client_args => { timeout => 1 +80 } } ); 

我已经尝试过的；这里是:

#!/usr/bin/perl

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

my $mech = new WWW::Mechanize::Firefox();

open(INPUT, "<urls.txt") or die $!;

while (<INPUT>) {
        chomp;
        print "$_\n";
        $mech->get($_);
        my $png = $mech->content_as_png();
        my $name = "$_";
        $name =~s/^www\.//;
        $name .= ".png";
        open(OUTPUT, ">$name");
        print OUTPUT $png;
        sleep (5);
}

好吧，这并不关心大小:请参阅输出命令行:

linux-vi17:/home/martin/perl # perl mecha_test_1.pl
www.google.com
www.cnn.com
www.msnbc.com
command timed-out at /usr/lib/perl5/site_perl/5.12.3/MozRepl/Client.pm line 186
linux-vi17:/home/martin/perl # 

在这里 - 这是我的来源:查看我在 url-list 中拥有的网站的片段示例。

urls.txt - 来源列表

www.google.com
www.cnn.com
www.msnbc.com
news.bbc.co.uk
www.bing.com
www.yahoo.com and so on...

顺便说一句:有了这么多的 url，我们必须预料到一些会失败并处理它。例如，我们将失败的放在一个数组或散列中，然后重试 X 次。

UTSL

嗯，这里的这个怎么样...

 sub content_as_png {

my ($self, $tab, $rect) = @_;
$tab ||= $self->tab;
$rect ||= {};

# Mostly taken from
# http://wiki.github.com/bard/mozrepl/interactor-screenshot-server
my $screenshot = $self->repl->declare(<<'JS');
function (tab,rect) {
    var browser = tab.linkedBrowser;
    var browserWindow = Components.classes['@mozilla.org/appshell/window-mediator;1']
        .getService(Components.interfaces.nsIWindowMediator)
        .getMostRecentWindow('navigator:browser');
    var win = browser.contentWindow;
    var body = win.document.body;
    if(!body) {
        return;
    };
    var canvas = browserWindow
           .document
           .createElementNS('http://www.w3.org/1999/xhtml', 'canvas');
    var left = rect.left || 0;
    var top = rect.top || 0;
    var width = rect.width || body.clientWidth;
    var height = rect.height || body.clientHeight;
    canvas.width = width;
    canvas.height = height;
    var ctx = canvas.getContext('2d');
    ctx.clearRect(0, 0, width, height);
    ctx.save();
    ctx.scale(1.0, 1.0);
    ctx.drawWindow(win, left, top, width, height, 'rgb(255,255,255)');
    ctx.restore();

    //return atob(
    return canvas
           .toDataURL('image/png', '')
           .split(',')[1]
    // );
}
JS
    my $scr = $screenshot->($tab, $rect);
    return $scr ? decode_base64($scr) : undef
};

期待您的来信!
问候零

Answer 1

你试过这个吗？这是工作？

$mech->repl->repl->setup_client( { extra_client_args => { timeout => 5*60 } } );

将链接放到@list 并使用 eval

while (scalar(@list)) {
        my $link = pop(@list);
        print "trying $link\n";
        eval{
        $mech->get($link);
        sleep (5);
        my $png = $mech->content_as_png();
        my $name = "$_";
        $name =~s/^www\.//;
        $name .= ".png";
        open(OUTPUT, ">$name");
        print OUTPUT $png;        
        close(OUTPUT);
        }
        if ($@){
          print "link: $link failed\n";
          push(@list,$link);#put the end of the list
          next;
        }
        print "$link is done!\n";

}