уменьшенный скриншот веб-страниц с Perl :: Mechanize - PullRequest
Новая
       23

уменьшенный скриншот веб-страниц с Perl :: Mechanize

1 голос
/ 21 февраля 2012

Я использую 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. Механизация была бы хорошей вещью. Примечание. Мне нужны только результаты в виде миниатюр, максимальная длина которых составляет 240 пикселей. На данный момент у меня есть решение, которое является медленным и не возвращает миниатюры: как заставить скрипт работать быстрее с меньшими издержками - выкладывая миниатюры

Но я должен знать, что его настройка может быть довольно сложной задачей. Если все работает должным образом, вы можете просто использовать скрипт, подобный этому, чтобы выгрузить изображения нужных веб-сайтов, но вы должны запустить Firefox и изменить его размер до нужной ширины вручную (высота не имеет значения, WWW :: Mechanize :: Firefox всегда сбрасывает всю страницу).

То, что я сделал сделано до сих пор много - я работаю с mozrepl. На данный момент я борюсь с таймаутами: есть ли способ указать тайм-аут Net :: Telnet с WWW :: Mechanize :: Firefox? В настоящее время мое интернет-соединение очень медленное, и иногда я получаю сообщение об ошибке 

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

ВИДИТЕ ЭТОТ ОДИН: 

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

К сожалению, это не работает: не удается найти метод объекта "timeout" через пакет "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-списке.

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
};

Рад тебя слышать! привет ноль

1 Ответ

1 голос
/ 21 февраля 2012

Вы пробовали это?Это работает? 

$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";

}
...