2008年、Webは文字列解析で変わっていくまとめサイト2.0(7/8 ページ)

» 2007年12月28日 10時44分 公開
[大澤文孝,ITmedia]
リスト2■ブログに含まれている主要なキーワードを頻度順に表示する

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.

注目のテーマ