たつをさんが What You'll Wish You'd Knownで書いていた
これを読んだ人たちがどの部分に興味を持つかに興味がある。 誰がどの部分をブログで引用したかのリストがあると面白いかも。
たしかに面白そうだったので、 ブログで引用された部分を色別表示 してみました。
これを作成したプログラムですが、
- ishinaoさんのblogmapを利用して、リンクしてるブログをRSSで取得。
- それぞれのブログのHTMLを取得して blockquote で囲まれた文字列を探す。
- リンク元となる、Shiro Kawaiさんのページ 知っておきたかったこと － What You'll Wish You'd Knownを取得。
- 2. でためておいた引用された文字列にマッチしたら span タグで囲む
ってな感じです。引用したブログは DHTML を使ってバルーンヘルプ風に 出してみました。
広い範囲を引用した人が狭い範囲を引用した人を塗りつぶしちゃう。 そもそもバルーンヘルプの挙動がいまいち。 もうちょっとゆるいマッチにしないと、blockquote 内でいろいろやっている ブログの引用部分は表示されない。 という悪い点はあるものの、少しは面白さが実感できたので良しとします。
perl のゴリゴリしたコードは以下
use XML::Feed;
use LWP::Simple;
use Encode;
use Encode::Guess qw/utf-8 euc-jp shiftjis 7bit-jis/;
use Digest::SHA1 qw(sha1_hex);
use File::Slurp;
my $rss = 'http://1470.net/bm/urlinfo/12240885/rss';
my $hsj = 'http://www.shiro.dreamhost.com/scheme/trans/hs-j.html';
my $cap = './cap.html';
my $cache_dir = '/tmp/webcache';
mkdir $cache_dir, 0777 unless -e $cache_dir;
my $feed = XML::Feed->parse(URI->new($rss)) or die XML::Feed->errstr;
my $orig = simple_mirror($hsj);
$orig =~ s/<p>(.*?)<\/p>/(my $tmp = $1) =~ s!\n+!!gs; '<p>'.$tmp.'<\/p>'/egis;
# search quotes on each blogs
my $i = 0;
my $css_html;
for my $entry ($feed->entries) {
my $html = simple_mirror($entry->link);
my $quotes = retrieve_quotes($html);
my $title = Encode::encode('EUC-JP', $entry->title);
$title =~ s/'/\\'/g if $title;
my $link = $entry->link;
for my $text (@$quotes) {
$orig =~ s/(\Q$text\E)/<span onMouseOver="show_b(event, '$link', '$title'); "class="cssid$i">$1<\/span>/gs;
}
my @rgb = map {160 + $_} (int(rand(96)), int(rand(96)), int(rand(96)));
my $bgcolor = unpack("H*", pack("C*", @rgb));
$css_html .= "span\.cssid$i { background-color :#$bgcolor;}\n";
$i++;
}
print File::Slurp::read_file($cap);
print "<style type=\"text/css\">$css_html</style>\n";
print $orig;
exit;
sub simple_mirror {
my $url = shift;
my $digest = sha1_hex($url);
my $cache = "$cache_dir/$digest";
LWP::Simple::mirror($url, $cache);
my $html = File::Slurp::read_file($cache);
return $html;
}
sub retrieve_quotes {
my $html = shift;
my @quotes;
while ($html =~ m/<blockquote>(.*?)<\/blockquote>/sgi) {
my $quote = $1;
$quote =~ s/<.*?>//sg;
$quote =~ s/\s*//sg;
Encode::from_to($quote, 'Guess', 'euc-jp');
push @quotes, $quote;
}
return \@quotes;
}
Comments