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


Trackback Tracer

by miyagawa at Fri, 05 Dec 2003 03:54

Trackback は Blog のエントリ間のつながりを表現することができるプロトコルです。ある記事を起点にして Trackback Ping をたどれば、E-mail やニュースグループのスレッド表示のように、関連する記事を一覧でブラウズすることができます。今回は、起点となる URL から Trackback をたどっていく Web アプリケーション Trackback Tracer をつくってみます。


Trackback Tracer

Trackback をたどるアプリケーションは、Trackback Auto-DiscoveryTrackback の RSS 出力 を組み合わせれば容易に実装できます。つまり、
  1. 起点となる URL から Trackback Ping URL を抽出
  2. Ping URL に __mode=rss を付加して RSS を取得
という流れで、起点の URL に対して Trackback Ping を送信したエントリ一覧が取得できます。

サンプルコード

CGI スクリプトとして動作する Trackback Tracer のコードは List 1 のようになります。

use CGI;
use Net::TrackBack;
use LWP::Simple;
use URI;
use XML::RSS;
使用するモジュールを use します。もうおなじみのモノばかりですね。

my $q   = CGI->new();
my $url = $q->param('url');
my $rss = fetch_tb_rss($url) if $url;

print_form($q);

if ($rss && ref($rss)) {
    # if $rss is object, it's XML::RSS
    show_rss($q, $rss);
} elsif ($rss) {
    # otherwise, it's error string
    print "Error: $rss";
}
ここがメインの処理になります。CGI パラメータの url を取得し、入力されていれば fetch_tb_rss で Trackback Ping URL から RSS を取得します。print_form では入力フォームを表示、レスポンスの $rss がオブジェクトであれば show_rss で Ping の中身を表示、そうでなければエラーを表示します。

sub print_form {
    my $q = shift;
    print $q->header('text/html; charset=utf-8'),
        $q->h1("Trackback Tracer"),
        $q->start_form(-method => "GET"),
        "URL: ", $q->textfield(-name => 'url', -size => 50),
        $q->submit(-value => "Trace"), $q->end_form;
}
CGI.pm のフォーム生成機能で、HTML とフォーム部品を出力します。テンプレートを使用するのでもいいのですが、フォームの中身を Sticky(*1) にするには、CGI.pm のメソッドを使用するのが簡単です。

sub fetch_tb_rss {
    my $url = shift;
    my $p = Net::TrackBack->new();
    my($ping_url) = $p->discover($url);
    $ping_url or return "Trackback Ping URL Not Found";

    # strips weird <response> things
    my $xml = get("$ping_url?__mode=rss");
    $xml =~ s!<response>.*<error>.*</error>!!s;
    $xml =~ s!</response>!!s;

    # parse it with XML::RSS
    my $rss = XML::RSS->new();
    eval { $rss->parse($xml) };

    return $@ ? "$@" : $rss;
}
Net::TrackBack で Ping URL を Auto-Discovery します。見つからなかった場合には、文字列でエラーを返します。

次はちょっと汚いのですが、Trackback Ping の RSS モードについている、responseerror というエレメントが、XML パースの邪魔になるため、除去しておき、その文字列 $xmlXML::RSS に食わせます(*2)。エラーの場合はエラー文字、成功すれば XML::RSS オブジェクトを return します。

sub show_rss {
    my($q, $rss) = @_;
    if (@{$rss->items}) {
        for my $item (@{$rss->items}) {
            my $trace = URI->new($q->url);
            $trace->query_form(url => $item->{link});
            print $q->a({ -href => $item->{link} },
                        $item->{title}), "\n",
                $q->a({ -href => $trace->as_string }, "[trace]"),
                $q->blockquote($item->{description}), $q->br,
        }
    } else {
        print "No Trackback to this entry.";
    }
}
RSS に item がある場合は、title, link, description を表示します。$trace には、この CGI の URL を入れた後、クエリパラメータ url に item の link をセットしています。この $trace にリンクを張れば、今度はこのアイテムを起点にして Ping をたどることができるようになります。

Running the Hack

このスクリプトを CGI 実行可能な環境に配置して、ブラウザからアクセスします。 tbtrace フォーム このようなフォームが表示されるので、適当に Blog エントリの URL を入れましょう(*3)。ここでは、Monday Module ひとり というエントリの URL を入れてみました。実行結果は このようになります。 tbtrace 実行結果 このエントリに Trackback Ping を送信したエントリのタイトルと概要 (excerpt) が表示されます。それぞれのタイトルの右には [trace] というリンクがあり、これをクリックすると、さらにそのエントリを起点にしてたどることができます。

See Also

いずれも今回紹介したスクリプトと同等の処理ができます。

Listings

List 1: tbtrace.cgi
#!/usr/local/bin/perl -w
# tbtrace.cgi - Trackback Tracer

use strict;
use CGI;
use Net::TrackBack;
use LWP::Simple;
use URI;
use XML::RSS;

my $q   = CGI->new();
my $url = $q->param('url');
my $rss = fetch_tb_rss($url) if $url;

print_form($q);

if ($rss && ref($rss)) {
    # if $rss is object, it's XML::RSS
    show_rss($q, $rss);
} elsif ($rss) {
    # otherwise, it's error string
    print "Error: $rss";
}

sub print_form {
    my $q = shift;
    print $q->header('text/html; charset=utf-8'),
        $q->h1("Trackback Tracer"),
        $q->start_form(-method => "GET"),
        "URL: ", $q->textfield(-name => 'url', -size => 50),
        $q->submit(-value => "Trace"), $q->end_form;
}

sub fetch_tb_rss {
    my $url = shift;
    my $p = Net::TrackBack->new();
    my($ping_url) = $p->discover($url);
    $ping_url or return "Trackback Ping URL Not Found";

    # strips weird <response> things
    my $xml = get("$ping_url?__mode=rss");
    $xml =~ s!<response>.*<error>.*</error>!!s;
    $xml =~ s!</response>!!s;

    # parse it with XML::RSS
    my $rss = XML::RSS->new();
    eval { $rss->parse($xml) };

    return $@ ? "$@" : $rss;
}

sub show_rss {
    my($q, $rss) = @_;
    if (@{$rss->items}) {
        for my $item (@{$rss->items}) {
            my $trace = URI->new($q->url);
            $trace->query_form(url => $item->{link});
            print $q->a({ -href => $item->{link} },
                        $item->{title}), "\n",
                $q->a({ -href => $trace->as_string }, "[trace]"),
                $q->blockquote($item->{description}), $q->br,
        }
    } else {
        print "No Trackback to this entry.";
    }
}
*1) フォームに入力された値を保持して再表示すること。エラー表示などに便利です。
*2) Hack 的なのでこの処理を CPAN モジュール化した方がよいかもしれませんね。
*3) Blog のホームではなく、エントリを入力してください。

Copyright©2002-2003 Tatsuhiko Miyagawa