use strict;
use utf8;
use encoding 'utf8', STDIN=>'utf8', STDOUT=>'utf8';
use Encode::Guess;
use Encode;
use WWW::Mechanize;
use Web::Scraper;
use Text::MeCab;
use HTTP::Response::Encoding;
# 1. ブログ一覧ページからブロガーのトップページを得る
my $blogtopurl = 'http://blogs.itmedia.co.jp/portal2/blogger/list.html';
# div.personの下のdiv.photoの下の<a href>の部分を取得
my $scrape = scraper {
process 'div.person > div.photo > a',
'personurl[]' => '@href';
result 'personurl';
};
my $result = $scrape->scrape(URI->new($blogtopurl));
# 2. それぞれのブロガー記事を検索
# ここでは、それぞれの記事に対して、2階層まで辿ることにする
my $linknum = 2;
use vars qw(%followed_link %keywords);
%followed_link = {}; # 辿ったリンクを記録してもう一度辿らないようにするフラグ
%keywords = {}; # キーワードをカウントするハッシュ
my $mech = WWW::Mechanize->new();
foreach my $urlobj (@$result)
{
my $url = $urlobj->as_string();
$mech->get($url);
getcontent($mech, $linknum);
}
# 結果をソートして出力する
my $count = 0;
foreach my $key (sort {$keywords{$b} <=> $keywords{$a}} keys %keywords)
{
my $urlencodedkey = $key;
$urlencodedkey =~ s/(\W)/'%'.unpack("H2", $1)/eg;
print "<a href='http://www.google.co.jp/search?q=$urlencodedkey&ie=utf-8&oe=utf-8&hl=ja&domains=blogs.itmedia.co.jp&sitesearch=http%3A%2F%2Fblogs.itmedia.co.jp%2F'>" .
$key . "(" . $keywords{$key} . ")" . "
" . "\n";
$count++;
if ($count > 30) # トップ30件まで出力
{
last;
}
}
exit();
# 3. コンテンツの取得とMeCabによる解析
sub getcontent($$)
{
my ($mech, $linknum) = @_;
my $mecab = Text::MeCab->new();
# コンテンツを取得
if ($mech->success() && $mech->is_html())
{
# 内容の取得
my $content = $mech->content();
my $res = $mech->response();
# 文字コード変換
my @encoding =
$res->encoding,
($res->header('Content-Type') =~ /charset=(\w\-]+)/g);
my $enc;
foreach my $value (@encoding)
{
if (Encode::find_encoding($value))
{
$enc = $value;
last;
}
}
if (!defined $enc)
{
Encode::Guess->setsuspects(qw/shift-jis euc-jp 7bit-jis/);
$enc = "Guess";
}
$content = Encode::decode($enc, $content);
# Web::Scraperを使い、div.bodyの部分だけを取り出す
my $scrape = scraper {
process 'div.body', 'body[]' => 'text';
result 'body';
};
my $result = $scrape->scrape($content);
# MeCabに突っ込む
my $body;
if ($result)
{
$body = join ' ', @$result;
}
my $node = $mecab->parse($body);
while ($node)
{
my @parsed = split /,/, $node->feature;
# 名詞であり、「数」と「代名詞」ではないものに限る
if ($node->surface && $parsed[0] eq '名詞'
&& $parsed[1] ne '数' && $parsed[1] ne '代名詞')
{
$keywords{$node->surface}++;
}
$node = $node->next;
}
# 内部リンクの数だけ繰り返す
$linknum--;
if ($linknum > 0)
{
foreach my $link($mech->find_all_links(url_abs_regex => qr#^http://blogs.itmedia.co.jp/[a-z_]+/#))
{
# リンク先を辿る
my $url = $link->url();
if (!$followed_link{$url})
{
$followed_link{$url} = 1;
$mech->get($link->url());
# 再帰呼び出し
getcontent($mech, $linknum);
}
# 戻る
$mech->back();
}
}
}
}
Copyright © ITmedia, Inc. All Rights Reserved.