Trackback スレッド化
Trackback Tracer では、Permalink から Trackback Ping 一覧を順々に表示するツールを実装しましたが、UI としてはフラットに表示していたため、URL を起点にして、議論がどのように拡散していったかを一目で見ることはできませんでした。今回は、表示方法を再帰的にすることで、Trackback Ping の広がりをニュースグループのスレッドのように閲覧できるツールを実装してみます。スレッド表示
Trackback Ping をスレッド表示するためには、Trackback Tracer で紹介したように、- 起点となる URL から Trackback Ping URL を抽出
- Ping URL に
__mode=rss
を付加して RSS を取得
サンプルコード
Permalink の URL から Trackback Ping URL を探し出し、 Ping した URL をスレッド表示するスクリプトは List 1 のようになります。use CGI; use Encode; use LWP::Simple; use Net::TrackBack; use XML::RSS;使用するモジュールをロードします。CGI スクリプトとして動作する
our $MaxLevel = 5; # max level of threads our $HackPingRSS = 1; # fix latin-1 response?設定変数として、スレッドの最大の深さを示す
$MaxLevel
と、XML の encoding 宣言が正しくない RSS を修正するかどうかを示す $HackPingRSS
を設定しています。
local $| = 1;このスクリプトは、再帰的に Trackback Ping を取得するため実行に時間がかかります。その間でもブラウザに処理内容が表示されるよう、ノンバッファリングの設定とします。
print_form($q); if ($url) { print qq(<div id="tb-thread">\n); show_thread($q, $url, $MaxLevel, \&display_item); print qq(</div>\n); }
print_form
でフォームを表示し、$url
が渡されていれば show_thread
でスレッド化した Ping ツリーを表示します。
sub show_thread { my($q, $root, $max_level, $callback) = @_; my $level = 1; my %seen = ($root => 1);スレッドの深さを表わす
$level
と、すでに処理した URL を格納しておくハッシュ %seen
をレキシカル変数として用意します。
my $finder; $finder = sub { my $url = shift; my $rss = fetch_tb_rss($url) or return; if ($level == 1) { # This is root item $callback->($q, $rss->channel, 0); } for my $ping (@{$rss->items}) { $callback->($q, $ping, $level); $level++; # note $level is lexical $finder->($ping->{link}) # do it recursively if $level <= $max_level && !$seen{$ping->{link}}++; $level--; # going back } };URL を渡して、Trackback Ping を検出して表示し、再帰的に実行するサブルーチンをクロージャとして
$finder
に格納します。ここは難しいので詳しくみていきます。
my $finder; $finder = sub { my $url = shift; my $rss = fetch_tb_rss($url) or return; if ($level == 1) { # This is root item $callback->($q, $rss->channel, 0); } for my $ping (@{$rss->items}) { $callback->($q, $ping, $level); $level++; # note $level is lexical $finder->($ping->{link}) # do it recursively if $level <= $max_level && !$seen{$ping->{link}}++; $level--; # going back } };前回同様、Permalink から Trackback Ping の URL を Auto-Discovery で探索し、XML::RSS にして取得 (
fetch_tb_rss
) します。$level == 1
の場合は、起点となる URL のため、RSS の channel 要素から title, link, description を取得して表示 ($callback
: ここでは display_info
が実行される) します。
my $finder; $finder = sub { my $url = shift; my $rss = fetch_tb_rss($url) or return; if ($level == 1) { # This is root item $callback->($q, $rss->channel, 0); } for my $ping (@{$rss->items}) { $callback->($q, $ping, $level); $level++; # note $level is lexical $finder->($ping->{link}) # do it recursively if $level <= $max_level && !$seen{$ping->{link}}++; $level--; # going back } };RSS の item には、Trackback Ping を送信した Blog のエントリが格納されています。これについては、
$callback
で表示した後、インデント $level
をインクリメントし、このクロージャ自身である $finder
を再帰的に実行しています。ここで、
$level
が最大レベルを超えている- すでに処理した (
%seen
ハッシュにエントリがある)
$finder->($root);クロージャ
$finder
に、起点 URL $root
を渡して処理が開始されます。
sub display_item { my($q, $item, $level) = @_; print " " x ($level * 4); # indent my $tooltip = substr($item->{description}, 0, 256); print $q->a({ -href => $item->{link}, -title => _enc($tooltip) }, _enc($item->{title} || "(no-title)")), $q->br; }
display_item
は、Ping のアイテムが見つかるたびに呼び出されるコールバックルーチンで、インデントを適切に行い、エントリにリンクしています。description の内容を a タグの title 属性にいれています ($tooltip
) ので、Win32 上で IE を使用している場合は、マウスを載せると description をツールチップでプレビューすることができます。
sub _enc { Encode::encode("utf-8", shift) }XML::RSS 内の title や description といった変数は Unicode 文字列であるため、出力するためには Encode の
encode
でバイト列に落とす必要があります(*2)。
sub fetch_tb_rss { my $url = shift; my $p = Net::TrackBack->new(); my($ping_url) = $p->discover($url); $ping_url or return; # strips weird <response> things my $xml = get("$ping_url?__mode=rss"); $xml =~ s!<response>.*<error>.*</error>!!s; $xml =~ s!</response>!!s; $xml =~ s/iso-8859-1/utf-8/ if $HackPingRSS; # parse it with XML::RSS my $rss = XML::RSS->new(); eval { $rss->parse($xml) }; return $@ ? undef : $rss; }
fetch_tb_rss
については、ほぼ変更はありませんが、$HackPingRSS
が true の場合には、RSS 文字列内の iso-8859-1 文字列を utf-8 に変更します。これは特定バージョンの MovableType などに見られるバグに対処するための workaround です。
Running the Hack
このスクリプトを CGI で実行可能な場所に配置し、List 2 のような tb_thread.css ファイルを同一ディレクトリに置いてブラウザからアクセスします。 適当に、Trackback の多い Blog の Permalink を入力してみます。ここでは Six Apart 社というエントリを選んでみました。 このように Trackback のつながりをスレッド表示できました。Hacking the Hack
このスクリプトは、再帰的にネットワークからデータを取得するため、エントリ数が多い場合には、実行に非常に時間がかかります。また、リロードなどを繰り返した場合には、同じ URL からのエントリを短時間に取得することになり、効率が良くないばかりか、相手先のサイトの迷惑になってしまう可能性もあります。。See Also で紹介する mt-thread のように、一度取得した URL をキャッシュするような実装を入れておくと良いでしょう。 また、ここでは URL の取得をシリアル(*3)で行っていますが、複数のホストについては、POE や fork などの手法を使って、並列に同時実行すればさらに高速化が見込めるでしょう。See Also
- mt-thread
- MovableType の開発者である BenTrott によって作成された Trackback のスレッド表示スクリプトです。クレジットにもあるように、今回のスクリプトの実装にあたっては、mt-thread を大いに参考にしました。mt-thread では、ツリー内容のキャッシュも実装されています。
- Trackback Tracer
- (フラット版と同名となってしまいましたが).NET Framework で動作する、Trackback をスレッド表示するクライアントツールです。
Listings
List 1: tb_thread.cgi
#!/usr/local/bin/perl -w # tb_thread.cgi - Trackback Threading # This program is based on mt-thread by Benjamin Trott # <http://www.movabletype.org/news/2002_08.shtml#000568> use strict; use CGI; use Encode; use LWP::Simple; use Net::TrackBack; use XML::RSS; our $MaxLevel = 5; # max level of threads our $HackPingRSS = 1; # fix latin-1 response? my $q = CGI->new(); my $url = $q->param('url'); local $| = 1; print_form($q); if ($url) { print qq(<div id="tb-thread">\n); show_thread($q, $url, $MaxLevel, \&display_item); print qq(</div>\n); } sub print_form { my $q = shift; print $q->header('text/html; charset=utf-8'), $q->start_html(-title => "Trackback Threading", -style => { -src => "tb_thread.css" }), $q->h1("Trackback Threading"), $q->start_form(-method => "GET"), "URL: ", $q->textfield(-name => 'url', -size => 50), $q->submit(-value => "Show Thread"), $q->end_form; } sub show_thread { my($q, $root, $max_level, $callback) = @_; my $level = 1; my %seen = ($root => 1); my $finder; $finder = sub { my $url = shift; my $rss = fetch_tb_rss($url) or return; if ($level == 1) { # This is root item $callback->($q, $rss->channel, 0); } for my $ping (@{$rss->items}) { $callback->($q, $ping, $level); $level++; # note $level is lexical $finder->($ping->{link}) # do it recursively if $level <= $max_level && !$seen{$ping->{link}}++; $level--; # going back } }; $finder->($root); } sub display_item { my($q, $item, $level) = @_; print " " x ($level * 4); # indent my $tooltip = substr($item->{description}, 0, 256); print $q->a({ -href => $item->{link}, -title => _enc($tooltip) }, _enc($item->{title} || "(no-title)")), $q->br; } sub _enc { Encode::encode("utf-8", shift) } sub fetch_tb_rss { my $url = shift; my $p = Net::TrackBack->new(); my($ping_url) = $p->discover($url); $ping_url or return; # strips weird <response> things my $xml = get("$ping_url?__mode=rss"); $xml =~ s!<response>.*<error>.*</error>!!s; $xml =~ s!</response>!!s; $xml =~ s/iso-8859-1/utf-8/ if $HackPingRSS; # parse it with XML::RSS my $rss = XML::RSS->new(); eval { $rss->parse($xml) }; return $@ ? undef : $rss; }List 2: tb_thread.css
#tb-thread { line-height: 1.4em; } a, a:link { color: #246; } a:active, a:hover { color: #468; } a:visited { color: #224; }
*1) CGI の場合 nph (Non-Parsed Header) スクリプトとして実行する必要があります。
*2) 今回は、XML 以外の文字列が ASCII であるため問題は起こりませんが、マルチバイトの場合、Sv の自動アップグレードによって文字化けが発生してしまいます。
*3) 直列に、順番を待ちながら実行するという意味
*2) 今回は、XML 以外の文字列が ASCII であるため問題は起こりませんが、マルチバイトの場合、Sv の自動アップグレードによって文字化けが発生してしまいます。
*3) 直列に、順番を待ちながら実行するという意味
posted at: 01:24 by miyagawa | category: Trackback Pings | permalink
Trackback (2) | Printer Friendly | Email this blog