Open MagicVox.net
feed meter を使うと、そのブログの更新頻度や人気度を集計してアイコン表示することができます。feedmeter で公開している 人気度上位ランキングの詳細リストが欲しくなったので、これを取得するためのPerlスクリプトを書いてみました。
取得した結果を標準出力に吐き出します。
人気度の変り目の探索には二分法を用い、相手サーバへの問合せ回数を最小にするようにしていますが、負荷を心配して過度の実行はできるだけお控えください。
#!/usr/bin/perl -w
$|++;
use strict;
use LWP::UserAgent;
use constant DETAIL_PAGE => 'http://feedmeter.net/detail.php';
### LWp::UserAgent の初期化
my $ua = new LWP::UserAgent
or die 'Failed to initialize <LWP::UserAgent>';
$ua->timeout (30);
### ランキングのサイトリストを得る
printf STDERR "Retrieving a whole ranking list
";
my @ranking = GetRankingList ();
### 二分法でスコアの変り目を探す
my %table = ();
$table{ 1 } = GetSiteScore ( 1 );
$table{300} = GetSiteScore (300);
for (my $loop = 1; $loop; ) {
my @ranks = sort { $a <=> $b } keys %table;
$loop = 0;
while (1) {
my $rank1 = shift @ranks or last;
my $rank2 = shift @ranks or last;
unshift @ranks, $rank2;
my $score1 = GetSiteScore ($rank1);
my $score2 = GetSiteScore ($rank2);
unless ($score1 == $score2) {
my $mid = int (($rank1 + $rank2) / 2.);
unless ($mid == $rank1) {
printf STDERR "Retrieving [$mid]
";
$table{$mid} = GetSiteScore ($mid);
$loop = 1;
}
}
}
}
### 結果出力
my $score;
foreach my $rank (1..300) {
$score = $table{$rank}
if defined $table{$rank};
printf STDOUT "%st%st%st%st%s
",
$rank, $score,
$ranking[$rank]->{star},$ranking[$rank]->{freq},
$ranking[$rank]->{name};
}
exit;
### ランキングのサイトリストを得る
sub GetRankingList {
my @ret = ();
my $res = $ua->get (DETAIL_PAGE);
sleep 3;
die 'Can't retrieve the page'
unless $res->is_success;
my $buf = $res->content;
while ($buf =~ s!<tr[^>]*><td>(d+)<img[^>]*></td><td>([^<]+)</td><td><a href="([^"]+)"[^>]*>RSS</a></td><td><a[^>]*><img src="http://feedmeter.net/img/meterb(d)(d).gif"[^>]*></a></td></tr>!!) {#"
$ret[$1] = { rank => $1, name => $2, rss => $3, star => $4, freq => $5 };
}
@ret;
}
### 指定されたランクのサイトのスコアを得る
sub GetSiteScore {
my ($rank) = @_;
if (defined $ranking[$rank]) {
if (! defined $ranking[$rank]->{score}) {
$ranking[$rank]->{score} = RetrieveSiteScore ($ranking[$rank]->{rss});
}
return $ranking[$rank]->{score};
}
undef;
}
### 指定された RSS のサイトのスコアを得る
sub RetrieveSiteScore {
my ($rss) = @_;
printf STDERR "%s ", $rss;
my $res = $ua->get (DETAIL_PAGE. '?r='. $rss);
sleep 1;
die 'Can't retrieve the page'
unless $res->is_success;
my $buf = $res->content;
if ($buf =~ m!<td nowrap width="75%">([d.]+)</td>!s) {
printf STDERR ": %s
", $1;
return $1;
}
printf STDERR ": failed
";
return undef;
}
English