タイトル長っ！
例のキーワードの不具合関係*1で、2/14以降に書かれた日記から、見出しのみにキーワードが入ってる場合に「含むブログ」に入らないケースに該当するキーワードを調べたい。
ので、書いた。
use strict; use warnings; use Web::Scraper; use Encode qw(encode decode _utf8_off); use URI; use URI::Escape qw(uri_escape); use List::Util qw(sum); use YAML; my $input_enc = 'euc-jp'; my $internal_enc = 'utf-8'; while(<>){ tr/\x0A\x0D//d; my $name = encode($internal_enc, decode($input_enc, $_)); my $key = uri_escape(encode('euc-jp', decode($internal_enc, $name))); my $uri = URI->new("http://d.hatena.ne.jp/keyword/$key"); print STDERR "scraping $name : $uri ... \n"; my $titles = scraper { process '//div[@class="keyword-relation area-keywordblog"]/h3', 'date[]' => 'TEXT'; process '//div[@class="keyword-relation area-keywordblog"]/h3/following-sibling::node()[1]', 'list[]' => scraper{ process '//li/a[1]', 'titles[]', ['TEXT', sub{ _utf8_off($_); $_; }]; result 'titles'; }; }->scrape($uri); my %titles_bydate; @titles_bydate{@{$titles->{date}}} = @{$titles->{list}}; foreach(keys %titles_bydate){ delete $titles_bydate{$_} unless $_ ge '2009-02-14'; } next unless %titles_bydate; my @titles_after = map{ @$_ } values %titles_bydate; my $cnt = sum map { /$name/ } @titles_after; $cnt //= 0; printf ("%.2f,(%d/%d),%s,%s\n", $cnt/@titles_after, $cnt, scalar @titles_after, $name, $uri); print YAML::Dump \%titles_bydate; # open my $fh, '>', "$key.txt"; # print $fh YAML::Dump \%titles_bydate; # close $fh; sleep 1; }
実行結果
scraping フレッシュプリキュア！ : http://d.hatena.ne.jp/keyword/%A5%D5%A5%EC%A5%C3%A5%B7%A5%E5%A5%D7%A5%EA%A5%AD%A5%E5%A5%A2%A1%AA ... 0.45,(10/22),フレッシュプリキュア！,http://d.hatena.ne.jp/keyword/%A5%D5%A5%EC%A5%C3%A5%B7%A5%E5%A5%D7%A5%EA%A5%AD%A5%E5%A5%A2%A1%AA --- 2009-02-14: - 少女向けアニメキャラクター - TSUTAYA 2009-02-15: - 2009-02-15の注目キーワード - フレッシュプリキュア！＃３ - 'フレッシュプリキュア！ #3 とれたてフレッシュ!キュアパイン誕生!!' - カリカリ - コミックマーケット75その2 - SHTon090215 - 2009-02-15 - フレッシュプリキュア！第3話「とれたてフレッシュ！キュアパイン誕生！」 - 'フレッシュプリキュア！ #3「とれたてフレッシュ！キュアパイン誕生!!」' - フレッシュプリキュア！（たぶん第３話）。 - フレッシュプリキュア！ 03話 - 「フレッシュプリキュア！」第3話「とれたてフレッシュ！キュアパイン誕生！！」 ざっと感想 - '[アニメ]' - フレッシュプリキュア！ - '#1413 セイビIV' - アニメ感想 2009-02-16: - 昨日の「フレッシュプリキュア！」 - フレッシュプリキュア！ 第3話「とれたてフレッシュ！キュアパイン誕生！！」 - ジョイサウンド 2009-02-17: - 2009-02-17
ある日付以下のダイアリーを抜き出すXPATHに難儀してしまった・・・。日付はH3タグなんだけど、その下のダイアリー一覧が子要素って訳でもない。ので、とりあえず隣のタグということにしておきました。今のところ問題はなさそうな。
んで、14日以降の日記の中から、見出しにキーワードが含まれている日記の確率を取る。値が大きければ修正済み、小さければ未修正ってことでいいでしょう。多分ね。
追記
使い捨てスクリプトのつもりだったけど、もう少し長めのスパンでwatchしようかな、と思ったのでコメントのアドバイスを参考にして書き直してみました。
期待通り encode/decode 辺りがすっきりした感じがする。Encodeにはいまだに慣れないので、ちゃんと使いこなせるようになりたいですね。
use strict; use warnings; use Web::Scraper; use Encode; use URI; use URI::Escape qw(uri_escape); use List::Util qw(sum); use YAML; my $input_enc = find_encoding('euc-jp'); my $kw_enc = find_encoding('euc-jp'); my $scraper = scraper { process '//div[@class="keyword-relation area-keywordblog"]/h3', 'date[]' => 'TEXT'; process '//div[@class="keyword-relation area-keywordblog"]/h3/following-sibling::node()[1]', 'list[]' => scraper{ process '//li/a[1]', 'titles[]', 'TEXT'; result 'titles'; }; }; binmode STDERR, ":utf8"; binmode STDOUT, ":utf8"; while(<>){ tr/\x0A\x0D//d; my $name = $input_enc->decode($_); my $key = uri_escape($kw_enc->encode($name)); my $uri = URI->new("http://d.hatena.ne.jp/keyword/$key"); print STDERR "scraping $name : $uri ... \n"; my $titles = $scraper->scrape($uri); my %titles_bydate; @titles_bydate{@{$titles->{date}}} = @{$titles->{list}}; foreach(keys %titles_bydate){ delete $titles_bydate{$_} unless $_ ge '2009-02-14'; } next unless %titles_bydate; my @titles_after = map{ @$_ } values %titles_bydate; my $cnt = sum map { /$name/ } @titles_after; $cnt //= 0; printf ("%.2f,(%d/%d),%s,%s\n", $cnt/@titles_after, $cnt, scalar @titles_after, $name, $uri); print YAML::Dump \%titles_bydate; # open my $fh, '>', "$key.txt"; # print $fh YAML::Dump \%titles_bydate; # close $fh; sleep 1; }
