Coro のメモ書き。
これまでに Coro で色々と試してきましたが、そろそろクロール機能をつけてサイトを辿らせてみようと思います。
ただし、試作品だしエラー処理とか負荷とか色々考慮していない部分があるので、下記条件で自分で管理するサーバに対してのみやってみます。
- クロールする時間は 60 秒
- 内部リンクのみを辿る
- クロールしたページからタイトルを抜き出す
これで良いかはわかりませんが、上記の条件を元に書いたのがコレ。
#!/usr/bin/perl
use strict;
use warnings;
use Coro;
use Coro::Timer;
use Coro::Semaphore;
use Coro::LWP;
use LWP::UserAgent;
use URI;
use HTML::TreeBuilder;
use Digest::MD5 qw/md5_hex/;
my $lock = {};
my $queue = {};
my $crawl = {};
my @url = ();
my @done = ();
my @fail = ();
## fetcher の timeout (秒)
my $timeout = 15;
## クロールし続ける時間 (秒)
my $crawl_timeout = 60;
my $main = Coro::Signal->new;
my $url = 'http://example.jp/';
my $dom = URI->new($url)->host;
worker( fetcher => \&fetcher, 5 );
worker( parser => \&parser, 1 );
worker( manager => \&manager, 1 );
## fetcher に 1 つだけ url を投げる
queue("fetch")->put($url);
## スレッド切り替え
$main->wait;
## 取得できたタイトルを表示
foreach (@done) {
print "$_\n";
}
sub done {
push(@done, $_[0]);
}
sub fail {
push(@fail, $_[0]);
}
sub queue {
my $name = shift;
$queue->{$name} ||= Coro::Channel->new;
}
sub worker {
my ($name, $code, $num) = @_;
for (1 .. $num) {
my $desc = $name . "_" . rand_md5();
async {
Coro::current->desc($desc);
while ( 1 ) {
$code->();
}
};
}
}
sub manager {
Coro::Timer::sleep 1;
my $done = scalar(@done);
my $fail = scalar(@fail);
print "Timeout: $crawl_timeout Done: $done Fail: $fail\n";
my @coro = Coro::State::list;
foreach my $coro (@coro) {
next if (!$coro->desc);
next if ($coro->desc !~ /fetcher/);
next if (! defined($coro->{alive}));
if ($coro->{alive} <= 0 && ! $coro->{idle}) {
print "timeout: " . $coro->desc . "\n";
$coro->cancel();
fail("timeout: " . $coro->desc);
$lock->{$coro->{host}}->up;
worker( fetcher => \&fetcher, 1 );
} else {
print $coro->desc . " alive = $coro->{alive} $coro->{status} $coro->{url}\n";
if (! $coro->{idle}) { $coro->{alive} -= 1; }
}
}
## クロール用のタイマーを減算
$crawl_timeout--;
if ( $crawl_timeout <= 0) {
print "completed: Done => $done Fail => $fail\n";
Coro::Timer::sleep 5;
foreach my $coro (@coro) {
next if (!$coro->desc);
next if ($coro->desc !~ /parser/);
$coro->cancel();
}
$main->send;
}
}
sub fetcher {
my $url = queue("fetch")->get;
my $cur = Coro::current;
my $host = URI->new($url)->host;
my $sem = $lock->{$host} ||= Coro::Semaphore->new(2);
my $lwp = '';
my $res = 0;
$cur->{host} = $host;
$cur->{url} = $url;
$cur->{status} = '[lock]';
$lock->{$host}->down;
$cur->{status} = '[run]';
$cur->{idle} = 0;
$cur->{alive} = $timeout;
$lwp = LWP::UserAgent->new();
$res = $lwp->get($url);
if ($res->is_success) {
queue("parser")->put($res->content);
} else {
fail("fail:$url");
}
$cur->{status} = '[wait]';
$cur->{idle} = 1;
Coro::Timer::sleep 3;
undef $cur->{host};
undef $cur->{url};
$cur->{status} = '[idle]';
$cur->{alive} = $timeout;
$lock->{$host}->up;
}
sub parser {
my $content = queue("parser")->get;
my $tree = HTML::TreeBuilder->new;
$tree->parse($content);
$tree->eof();
## スクレイピングしてデータを抜き出し
if ($tree->find('title')) {
foreach ($tree->find('title')) {
done($_->as_text);
last;
}
} else {
fail("notitle");
}
## スクレイピングしたページのリンクを抜き出し
## fetcher に送りつけて内部リンクを辿る
if ($tree->find('a')) {
foreach ($tree->find('a')) {
next if ( !$_->attr('href') );
next if ( $_->attr('href') !~ /$dom/ );
next if ( $_->attr('href') !~ /^http/ );
my $url = $_->attr('href');
## url はハッシュに格納して重複しないようにする
if (! $crawl->{$url}) {
$crawl->{$url} = 1;
queue("fetch")->put($url);
}
}
}
}
sub rand_md5 {
my $max = 9999;
my $min = 1000;
my $rand = time() . int( rand($max - $min + 1) ) + $min;
my $md5 = md5_hex($rand);
return($md5);
}
これを走らせるとこんな感じに。
Timeout: 25 Done: 22 Fail: 0 fetcher_afd8a9f322b11c08823642a489a1846a alive = 15 [wait] https://worklog.be/archives/2995 fetcher_fef5b40e43245f64e36dbff8c3936c46 alive = 15 [wait] https://worklog.be/archives/2996 Timeout: 24 Done: 23 Fail: 0 fetcher_afd8a9f322b11c08823642a489a1846a alive = 15 [run] https://worklog.be/page/2 fetcher_fef5b40e43245f64e36dbff8c3936c46 alive = 15 [wait] https://worklog.be/archives/2993 ・ ・ ? 制限時間いっぱいまでクロール ? ・ completed: Done => 37 Fail => 0 ? 以下取得できたタイトル ?
意外とあっさりできちゃいました。
今回はアンカーテキストのリンクのみを見て内部リンクを辿っていますが、link タグ何かもみたりした方が良さげ。
暫くは遊びながら改良してみようと思います。