Wikipediaから声優名一覧を取ってくるPerlスクリプトv2 (3) 2chを使ったスクリーニング案

続き。

そんなこんなで(茅原実里的な)、2chの「声優個人」のスレッド一覧を取ってくるところまではできたので、あとはWikipediaの名前リストを使ってマッチングをかけていけばよい。具体的には、スレタイ一覧の文字列に対して、Wikipediaの名前リストでマッチングをかけて、ヒットするものだけを取り出せばよいでしょう。

use strict;
use warnings;
use encoding 'utf-8';

use LWP::UserAgent;
use Web::Scraper;
use List::Util qw/first/;
use List::MoreUtils qw/uniq/;
use Encode;

my $url_bbsmenu = 'http://menu.2ch.net/bbsmenu.html';
my $url_wikipedia_voiceact = 'http://ja.wikipedia.org/wiki/Category:%E6%97%A5%E6%9C%AC%E3%81%AE%E5%A5%B3%E6%80%A7%E5%A3%B0%E5%84%AA';
## my $url_wikipedia_voiceact = 'http://ja.wikipedia.org/wiki/Category:%E6%97%A5%E6%9C%AC%E3%81%AE%E7%94%B7%E6%80%A7%E5%A3%B0%E5%84%AA'; # for men

## 1. get bbsmenu
my $request = HTTP::Request->new(GET => $url_bbsmenu);
$request->accept_decodable;    ## gzip-acceptable

my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->agent("Monazilla/1.00");  ## 2ch-browser should be set UA as 'Monazilla'
print STDERR "getting " .  $request->uri . " ...\n";

my $response = $ua->request($request);

## 2. scrape bbsmenu and find '声優個人' board
my $board = scraper {
  process 'a', 'board[]' => {
    url  => '@href',
    name => 'TEXT',
  };
  result 'board'; 
}->scrape($response);

my $va = first { $_->{name} =~ /声優個人/ } @$board;

## 3 get thread title list
$request->uri($va->{url} . 'subject.txt');
print STDERR "getting " .  $request->uri . " ...\n";

$response = $ua->request($request);
my $decoded_content = decode("shiftjis", $response->decoded_content);

## 4. pick up names using Wikipedia voice-actors list
my @name_list = get_names_from_wikipedia($url_wikipedia_voiceact);
my $names_regexp = '(' . join('|', @name_list) . ')';

print "$_\n" foreach uniq ($decoded_content =~ m/$names_regexp/go);

sub get_names_from_wikipedia
{
  my $base_uri = shift;
  ### $base_uri
  my $uri_list = scraper {
    process '//table[@class="toc plainlinks"]/tr/td/a', 'list[]' => '@href';
    result 'list';
  }->scrape(URI->new($base_uri));
  ### $uri_list
  my @name_list = uniq map{
    sleep 1;  # to avoid DoS
    print STDERR "scraping $_ ... \n";
    my $l = scraper {
      process '//div[@id="mw-pages"]//li/a', 'names[]', => ['TEXT', sub {s/ \(.+//;} ];
      result 'names';
    }->scrape(new URI($_));
    $l ? @$l : ();
  } @$uri_list;
  ### @name_list
  return @name_list;
}
戸松遥
中島愛
井口裕香
植田佳奈
水樹奈々
浅野真澄
沢城みゆき
生天目仁美
浅川悠
中原麻衣
折笠富美子
平野綾
釘宮理恵
水橋かおり
豊崎愛生
豊崎愛生
茅原実里
中原麻衣
..
..

合計444人。Wikipediaの名前リストは2801人なので、ずいぶん絞れました。マッチング自体のオーバーヘッドは数秒程度だし、それなりに実用的な速度で使えそう。