こんにちは！
今日のお題は、「総務省の固定電話の市外局番一覧から csv を作る」です。
(以下の各コードでは、前提として $html に、utf-8 なデータが入っているものとします。)
正規表現を使ってスクレイプ
まずは、正規表現でやってみます。
とにかく書くのが面倒なので、td タグの中身を取り出して、そこからテキストを抽出する方針でいきます。
HTML エンティティのデコード(HTML::Entities の decode_entities 等でデコードすることになりますが、今回は しか出てこないのでベタに置換しました)や、いらないタグの除去やら、いろいろ自分でやることになります。
タグの配置が少し変わっただけで、正規表現の書き直しになることが多く、メンテナンス時にうんざりするかと思います。
my ($data) = $html =~ m!<table[^>]+border=1[^>]+>(.*?)</table>!s;
my $scraped;
while ($data =~ m!<tr[^>]+>\s*<td[^>]+>(.+?)<td[^>]+>(.+?)<td[^>]+>(.+?)<td[^>]+>(.+?)</tr>!sgi) {
my $code;
@{ $code }{qw/areacode areas telcode telcodetype/} = ($1, $2, $3, $4);
for (values(%$code)) {
s/ / /sg;
s/<[^>]+>//sg;
s/\s+//sg;
}
push @{ $scraped->{codes} }, $code;
}
Web::Scraper を使ってスクレイプ
次に、miyagawa さんの神モジュール Web::Scraper を使った方法です。
たったこれだけのコードを書くだけで、ほんとサクっとデータを取れちゃいます。
正規表現を書くのと比べて、とてもシンプルにできますね！
my $s = scraper {
process '//table[@border="1"]//tr', 'codes[]' => scraper {
process '//td[1]', areacode => 'TEXT';
process '//td[2]', areas => 'TEXT';
process '//td[3]', telcode => 'TEXT';
process '//td[4]', telcodetype => 'TEXT';
};
};
my $scraped = $s->scrape($html);
for my $code (@{ $scraped->{codes} }) {
for (values(%$code)) {
s/\s+//sg;
}
}
Web::Scraper を爆速に！
CPAN にある Web::Scraper だと PurePerl なモジュールを使っているため、どうしてもちょっとだけ重くなります。
そういうときのために、前にこそっとつくった (僕がいつも使ってる) XML::LibXML を使えるようにした Web::Scraper を使いたいと思います。
スクリプトから use lib 等して libxml ブランチ を読み込むようにして、
Web::Scraper->use_libxml(1);
とクラスメソッドを呼ぶだけで、libxml2 の parser が使われるようになります。
libxml2 ブランチについて詳しくは Web::Scraper を XML::LibXML で爆速にする hack! - woremacxの日記 をごらんください。
ベンチしてみる
あとあとのメンテナンスでうんざりすることになる正規表現が最速なのはさておき、C で書かれたライブラリである libxml2 の威力はすごいですね！ほれぼれしちゃいますね！
$ perl bench.pl 0 Default : 47 wallclock secs (45.86 usr + 0.02 sys = 45.88 CPU) @ 0.22/s (n=10) 1 XML::LibXML: 4 wallclock secs ( 4.14 usr + 0.01 sys = 4.15 CPU) @ 2.41/s (n=10) 2 regexp : 1 wallclock secs ( 1.01 usr + 0.01 sys = 1.02 CPU) @ 9.80/s (n=10)
よいスクレイピングライフを！
ベンチに使ったコード
#!/usr/bin/perl
use strict;
use lib qw(libxml/lib);
use FileHandle;
use LWP::UserAgent;
use Web::Scraper;
use Benchmark;
my $html;
sub write_csv {
my ($name, $data) = @_;
open my $csv, ">:encoding(utf8)", $name or die $!;
for my $code (@$data) {
printf $csv qq{"%s","%s","%s","%s"\n}, @{$code}{qw/areacode areas telcode telcodetype/};
}
close $csv;
}
sub run_scraper {
my $use_libxml = shift;
Web::Scraper->use_libxml($use_libxml);
my $s = scraper {
process '//table[@border="1"]//tr', 'codes[]' => scraper {
process '//td[1]', areacode => 'TEXT';
process '//td[2]', areas => 'TEXT';
process '//td[3]', telcode => 'TEXT';
process '//td[4]', telcodetype => 'TEXT';
};
};
my $scraped = $s->scrape($html);
for my $code (@{ $scraped->{codes} }) {
for (values(%$code)) {
s/\s+//sg;
}
}
write_csv($use_libxml ? "libxml.csv" : "default.csv", $scraped->{codes});
}
sub run_regexp {
# 37.45/s
my ($data) = $html =~ m!<table[^>]+border=1[^>]+>(.*?)</table>!s;
my $scraped;
while ($data =~ m!<tr[^>]+>\s*<td[^>]+>(.+?)<td[^>]+>(.+?)<td[^>]+>(.+?)<td[^>]+>(.+?)</tr>!sgi) {
my $code;
@{ $code }{qw/areacode areas telcode telcodetype/} = ($1, $2, $3, $4);
for (values(%$code)) {
s/ / /sg;
s/<[^>]+>//sg;
s/\s+//sg;
}
push @{ $scraped->{codes} }, $code;
}
write_csv("regexp.csv", $scraped->{codes});
}
sub main {
my $file = "shigai_list.html";
my $url = "http://www.soumu.go.jp/joho_tsusin/top/tel_number/shigai_list.html";
unless (-e $file) {
my $ua = LWP::UserAgent->new;
$ua->get($url, ':content_file' => $file);
}
open my $fh, "<:encoding(cp932)", $file or die $!;
$html = do { local $/; <$fh>; };
close $fh;
timethese(10, {
'0 Default ' => sub { run_scraper(0); },
'1 XML::LibXML' => sub { run_scraper(1); },
'2 regexp ' => sub { run_regexp; },
});
}
main;
Leave a comment