带有Perl :: Mechanize的网页的缩略图

时间:2012-02-21 07:49:16

标签: perl parsing mechanize thumbnails

我使用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";

}

BTW: user1126070将图像缩小为缩略图大小。我应该在这里使用成像仪吗?你能在这里建议一些解决方案......!?那太好了。

更新结束

此处问题大纲仍在继续 - 正如本Q&的非常开头所写的那样。 A

问题大纲:我有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”找到对象方法“timeout” 文档说这应该:

$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 # 

在这里 - 这是我的来源:查看我在网址列表中的网站示例。

urls.txt - 来源列表

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

BTW:有了这么多网址,我们不得不期待有些会失败并处理它。例如,我们将失败的数据放入数组或散列中并重试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
};

很高兴收到你的来信! 问候零

1 个答案:

答案 0 :(得分: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";

}