新番組調査 そのに

というわけで作ってみました。

use strict;
use Time::Local;
use LWP::Simple;

my @klist = ();
open(F, 'kw.dat');
while(<F>){
    tr/\x0A\x0D//d;
    my($k, $d) = split(/\s+/);
    push(@klist, [$k, $d]);
}

print qq(<html><body>\n);
foreach(@klist){
    my($key, @days) = ($$_[0], nextoneweek($$_[1]));
    my $cnt = 0;
    my $llist;
    foreach(@days){
        my $url = "http://d.hatena.ne.jp/keyworddiary/$key?date=$_";
        my @l   = map{s/^[\t ]+//; $_}
             grep(/<li class=.*hatena-with-icon/, split(/\n/, get($url)));
        $llist .= '<p>' . join('-', unpack('A4A2A2', $_)) . ' (' . scalar(@l) .
             ")</p>\n<ul>\n"  . join("\n", @l) . "\n</ul>\n";
        $cnt   += @l;
    }
    $key =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
    print "<h3>keyword: $key (" . $cnt  . ")</h3>\n$llist\n";
}
print qq(</body></html>\n);

sub nextoneweek{
    my $date = shift;
    my ($y0,$m0,$d0) = unpack('A4A2A2', $date);
    my @days=();
    for(my $i=0; $i<7; $i++){
        my ($d, $m, $y) =  (localtime(timelocal(0,0,0,$d0,$m0,$y0-1900) 
                        + 60*60*24*$i))[3..5];
        push(@days, sprintf("%04d%02d%02d", $y+1900, $m, $d));
    }
    return @days;
}

kw.datはこんな感じでファイルを作っておきます。

ARIA%20The%20NATURAL	20060401
%ce%c3%b5%dc%a5%cf%a5%eb%a5%d2%a4%ce%cd%ab%dd%b5	20060401

やってることは超単純で、キーワードを含む日記を指定した日から1週間分とってきて数えるだけ。

必ずしも感想を書いているとは限らないし、略称とかあるだろうから(マイメロとか・・・)正確でもないんだけど、大体の傾向はつかめるんじゃないかと。

テストもかねてちょっと試してみる。

$ perl countkw.pl | grep keyword: 
<h3>keyword: ストロベリー・パニック! (35)</h3>
<h3>keyword: 涼宮ハルヒの憂鬱 (547)</h3>
<h3>keyword: シムーン (260)</h3>
<h3>keyword: 吉永さん家のガーゴイル (352)</h3>
<h3>keyword: 桜蘭高校ホスト部 (205)</h3>
<h3>keyword: ラブゲッCHU〜ミラクル声優白書〜 (69)</h3>
<h3>keyword: ガラスの艦隊 (183)</h3>
<h3>keyword: ARIA The NATURAL (288)</h3>
<h3>keyword: おねがいマイメロディ〜くるくるシャッフル!〜 (55)</h3>
<h3>keyword: スクールランブル二学期 (205)</h3>

ハルヒ大人気!シムーンの意外な人気っぷりにもびっくりですが。とりあえず新番組が出揃ったら一度試してみよう。

ちなみに、結構時間かかります・・・

追記

うまく動いてちょっとうれしい。「新番組調査@はてな」としてそのうち表で公開しよう。