Published on Blog Developer's Cookbook.
Printer friendly version of http://blog.bulknews.net/cookbook/blosxom/trackback/tb_thread.html.


Trackback スレッド化

by miyagawa at Tue, 09 Dec 2003 01:24

Trackback Tracer では、Permalink から Trackback Ping 一覧を順々に表示するツールを実装しましたが、UI としてはフラットに表示していたため、URL を起点にして、議論がどのように拡散していったかを一目で見ることはできませんでした。今回は、表示方法を再帰的にすることで、Trackback Ping の広がりをニュースグループのスレッドのように閲覧できるツールを実装してみます。

スレッド表示

Trackback Ping をスレッド表示するためには、Trackback Tracer で紹介したように、
  1. 起点となる URL から Trackback Ping URL を抽出
  2. Ping URL に __mode=rss を付加して RSS を取得
のアルゴリズムを再帰的に行う必要があります。今回は CGI スクリプトをノンバッファリングモード(*1)で実行し、エントリを取得しながら STDOUT に出力する方法で実装します。

サンプルコード

Permalink の URL から Trackback Ping URL を探し出し、 Ping した URL をスレッド表示するスクリプトは List 1 のようになります。 

use CGI;
use Encode;
use LWP::Simple;
use Net::TrackBack;
use XML::RSS;
使用するモジュールをロードします。CGI スクリプトとして動作するmod_perl でも問題なく動作します。ため CGI, XML の文字コード処理に Encode を使用しています。 

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 を再帰的に実行しています。ここで、
  1. $level が最大レベルを超えている
  2. すでに処理した (%seen ハッシュにエントリがある)
場合はのぞきます。 

    $finder->($root);
クロージャ $finder に、起点 URL $root を渡して処理が開始されます。 

sub display_item {
    my($q, $item, $level) = @_;
    print "&nbsp;" 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 "&nbsp;" 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) 直列に、順番を待ちながら実行するという意味

Copyright©2002-2003 Tatsuhiko Miyagawa