Trackback Ping を受信する
Trackback Ping を送信する では、Trackback Ping を送信するクライアントについて解説しました。今回は、受信する側の実装を解説します。 Trackback Ping クライアント で解説したように、Trackback は HTTP POST によりパラメータを送信し、結果を XML 形式で返すという非常にシンプルなフレームワークです。よって、受信する Trackback サーバも、CGI スクリプトで簡単に記述することが可能です。 受信する CGI スクリプトでは、- Trackback ID の解析 (必要なら)
- POST で渡された CGI パラメータの解析
- パラメータの保存
- XML レスポンスの表示
- .../tb.cgi?tb_id=1234
- .../tb.cgi/1234
- .../1234.tb
ツール名 | Trackback URL サンプル |
---|---|
Movable Type | http://example.com/mt-tb.cgi/1234 |
Blosxom | http://example.com/entry.trackback |
TypePad | http://www.typepad.com/t/trackback/1234 |
tDiary | http://example.com/tdiary/tb.rb/20031126 |
サンプルコード
Trackback を受信する CGI スクリプトのサンプルは List 1 のようになります。ここでは、Trackback ID の抽出は PATH_INFO を使用、取得したデータは DBI インタフェースを使用して SQLite データベースに格納することにします。use CGI; use DBI; use HTML::Entities; use Time::Piece;使用するモジュールを use します。XML の文字変換に HTML::Entities を使用します。
our $dbdir = "/tmp"; our @cols = qw(url title blog_name excerpt timestamp);Trackback を格納するデータベースファイルのパス、またテーブルに使用するカラム名をパッケージグローバルで宣言します。
my $query = CGI->new(); $query->charset('utf-8');CGI オブジェクトを new し、charset に UTF-8 をセットします。
my $tb_id = munge_tb_id($query);
munge_tb_id
で、PATH_INFO から Trackback ID を取得します。
sub munge_tb_id { my $query = shift; my $path_info = $query->path_info(); $path_info && $path_info =~ m!(\w+)! && return $1; return; }
munge_tb_id
では、CGI.pm の path_info
メソッドで環境変数 PATH_INFO
を取得し、/(\w+)/
という正規表現にマッチさせて ID を拾っています(*3)。
my $vars = $query->Vars(); # Some validations if (!$tb_id) { send_response(1 => "Invalid Trackback ID"); return; } if (!$vars->{url}) { send_response(1 => "No url parameter (required)"); return; }CGI.pm の
Vars
メソッドでハッシュリファレンスにパラメータを取得した後、Trackback ID が指定されているか、また url パラメータのチェックをしています。Trackback 仕様書 には、どのパラメータが必須かは記載されていませんが、
In the Movable Type implementation, of the above parameters only url is required. If title is not provided, the value for url will be set as the title.とも記述されている通り、url パラメータだけはチェックしておきます。
fix_encoding($vars) if $vars->{charset};
charset
パラメータが指定されている場合は、fix_encoding
でエンコーディングの変換を行います。
sub fix_encoding { my $vars = shift; require Encode; Encode::from_to($vars->{$_}, $vars->{charset} => "utf-8") for @cols; }
@cols
に含まれるパラメータについて、Encode の from_to
関数を使用してエンコーディングを変換します。from_to
では変換前後ともに、変数は Perl の Unicode 文字列とはみなされず、バイト文字列として処理されます。
# Default values $vars->{title} ||= $vars->{url}; $vars->{blog_name} ||= do { require URI; URI->new($vars->{url})->host; }; $vars->{excerpt} ||= "No excerpt."; $vars->{timestamp} = Time::Piece->new->datetime;値が空のパラメータについて、デフォルトの値を埋めておきます。title は url と同様、blog_name は url のホスト部分としています。timestamp には現在時刻を ISO 8601 形式の文字列で格納します。
eval { store_ping($tb_id, $vars); send_response(0 => "Thanks for your Ping to $tb_id"); }; if ($@) { send_response(1 => "Error while storing ping: $@"); }
store_ping
で Trackback Ping の内容をデータベースに保存します。何かエラーが発生すると例外が投げられるため、拾ってレスポンスに表示します。うまくいった場合には、成功した旨のメッセージをレスポンスに表示します。
sub store_ping { my($tb_id, $vars) = @_; my $is_existent = -e "$dbdir/$tb_id.db"; my @dsn = ("dbi:SQLite:dbname=$dbdir/$tb_id.db", "", ""); my $dbh = DBI->connect(@dsn, { RaiseError => 1, AutoCommit => 1, }); # Create table "tb" if it's first time init_table($dbh) unless $is_existent;
store_ping
の実装です。事前にデータベースファイルが存在するかどうかをチェックし$is_existent
に格納しておきます。存在しなかった場合には、データベースに接続後、init_table
で CREATE TABLE 文を発行します。
sub init_table { my $dbh = shift; $dbh->do(<<SQL); CREATE TABLE tb ( url VARCHAR(255) NOT NULL, title VARCHAR(255) NOT NULL, blog_name VARCHAR(255) NOT NULL, excerpt TEXT, timestamp DATETIME ) SQL ; }
init_table
では do
メソッドで CREATE TABLE の SQL 文を実行します。VARCHAR, TEXT, DATETIME などの型を指定していますが、実は SQLite では、PRIMARY KEY 以外のカラムは、どの型にしても内部的には文字列型として保存されますので、スキーマの指定は気休め程度です。
# Generate SQL statements my $sql = sprintf "INSERT INTO tb (%s) VALUES (%s)", join(",", @cols), join(",", ('?') x @cols); my $sth = $dbh->prepare($sql); $sth->execute(@{$vars}{@cols}); $sth->finish(); $dbh->disconnect();カラム配列
@cols
からプレースホルダを含む SQL 文を生成します。$sql
は、
INSERT INTO tb (url,title,blog_name,excerpt,timestamp) VALUES (?,?,?,?,?)のような内容になります。このステートメントに、
$vars
のスライスをとって execute
メソッドを呼び出します(*4)。
sub send_response { my($error, $message) = @_; my $msg = encode_entities($message); print $query->header('text/xml'), <<XML; <?xml encoding="utf-8"?> <response> <error>$error</error> <message>$msg</message> </response> XML ; }
send_response
では、エラーかどうかと、内容を表すメッセージを XML にして Content-Type: text/xml
で print します。メッセージは XML エンコードが必要です。
実行例
Trackback Ping クライアントを使用して Trackback を送信してみましょう。Trackback URL は、今回作成したスクリプトのパスの後ろに、/TrackbackID
を付加したものになります。うまく、"Ping sent successfully" が表示されたでしょうか。
SQLite のデータベースファイルを作成するため、$dbdir
のディレクトリに対し、httpd の実行ユーザで書き込み権限を許可する必要があることに注意してください。
LWP モジュールに付属するコマンドラインプログラム POST
で Trackback Ping を送信すると以下のようになります。
% POST http://localhost/tb/1234 blog_name=test&url=http%3A%2F%2Fblog.example.com%2F&title=TEST&charset=utf-8 ^D <?xml encoding="utf-8"?> <response> <error>0</error> <message>Thanks for your Ping to 1234</message> </response>格納された結果は
sqlite
コマンドなどで確認できます。
% sqlite /tmp/1234.db SQLite version 2.8.6 Enter ".help" for instructions sqlite> select * from tb; http://blog.example.com/|TEST|test|No excerpt.|2003-11-26T23:14:56 sqlite>
Hack the Hacks
Trackback リファレンス実装である tb-standalone でも、同様に PATH_INFO から Trackback ID を取得してローカルパスにデータを保持することが可能です。 CPAN モジュール Net::TrackBack を利用して、パラメータや Trackback ID の取得処理などを隠蔽・再利用することも可能ですが、この例でいえば、あまりメリットはないでしょう。Listings
List 1: tb_receive.pl
#!/usr/local/bin/perl -w # tb_receive - Trackback Server use strict; use CGI; use DBI; use HTML::Entities; use Time::Piece; our $dbdir = "/tmp"; our @cols = qw(url title blog_name excerpt timestamp); my $query = CGI->new(); $query->charset('utf-8'); do_task($query); sub do_task { my $query = shift; my $tb_id = munge_tb_id($query); my $vars = $query->Vars(); # Some validations if (!$tb_id) { send_response(1 => "Invalid Trackback ID"); return; } if (!$vars->{url}) { send_response(1 => "No url parameter (required)"); return; } fix_encoding($vars) if $vars->{charset}; # Default values $vars->{title} ||= $vars->{url}; $vars->{blog_name} ||= do { require URI; URI->new($vars->{url})->host; }; $vars->{excerpt} ||= "No excerpt."; $vars->{timestamp} = Time::Piece->new->datetime; eval { store_ping($tb_id, $vars); send_response(0 => "Thanks for your Ping to $tb_id"); }; if ($@) { send_response(1 => "Error while storing ping: $@"); } } sub fix_encoding { my $vars = shift; require Encode; Encode::from_to($vars->{$_}, $vars->{charset} => "utf-8") for @cols; } sub store_ping { my($tb_id, $vars) = @_; my $is_existent = -e "$dbdir/$tb_id.db"; my @dsn = ("dbi:SQLite:dbname=$dbdir/$tb_id.db", "", ""); my $dbh = DBI->connect(@dsn, { RaiseError => 1, AutoCommit => 1, }); # Create table "tb" if it's first time init_table($dbh) unless $is_existent; # Generate SQL statements my $sql = sprintf "INSERT INTO tb (%s) VALUES (%s)", join(",", @cols), join(",", ('?') x @cols); my $sth = $dbh->prepare($sql); $sth->execute(@{$vars}{@cols}); $sth->finish(); $dbh->disconnect(); } sub init_table { my $dbh = shift; $dbh->do(<<SQL); CREATE TABLE tb ( url VARCHAR(255) NOT NULL, title VARCHAR(255) NOT NULL, blog_name VARCHAR(255) NOT NULL, excerpt TEXT, timestamp DATETIME ) SQL ; } sub munge_tb_id { my $query = shift; my $path_info = $query->path_info(); $path_info && $path_info =~ m!(\w+)! && return $1; return; } sub send_response { my($error, $message) = @_; my $msg = encode_entities($message); print $query->header('text/xml'), <<XML; <?xml encoding="utf-8"?> <response> <error>$error</error> <message>$msg</message> </response> XML ; }
*1) Apache モジュール mod_rewrite などを利用して、URL を変換して環境変数などに切り出す手法。
*2) Python でできた Blog ツール PyCS ではこの方法を利用しているようです。
*3)
*4) こうして SQL 文や bind する値のリストを生成すれば、カラムの数が増えた場合でも
*2) Python でできた Blog ツール PyCS ではこの方法を利用しているようです。
*3)
\w
は [0-9a-zA-Z_] と同等の文字クラスです。マルチバイトや - (ハイフン)などの文字はマッチしないので注意してください。*4) こうして SQL 文や bind する値のリストを生成すれば、カラムの数が増えた場合でも
@cols
に追加するだけで OK になり、DBI をインラインに記述した場合でもメンテナンスが楽になります。posted at: 23:28 by miyagawa | category: Trackback Pings | permalink
Trackback (1) | Printer Friendly | Email this blog