Blog Developer's Cookbook : Automatic Trackback

Trackback の Auto-Discovery と送信を組み合わせれば、自動で Trackback を送ることもできます。今回は、ある URL を渡すと、リンクしている URL に自動で Trackback 送信するスクリプトを書いてみます。

HTML::LinkExtor

サンプルコード

sub fetch_content { my($ua, $url) = @_; my $request = HTTP::Request->new(GET => $url); my $response = $ua->request($request); return unless $response->is_success; my $content_type = $response->header('Content-Type'); my $charset = ($content_type =~ /charset=([\w\-]*)/)[0] || "utf-8"; return decode($charset, $response->content); }

my @links = find_links($html, $url); for my $link (@links) { warn "[Debug] finding Ping URL in $link\n" if $Debug; my $ping_url = find_ping_url($link); if ($ping_url) { warn "[Debug] Found Ping URL $ping_url\n" if $Debug; send_ping($ua, $ping_url, $html, $url); } }

sub find_links { my($html, $url) = @_; my $domain = URI->new($url)->host; my @links; my $cb = sub { my($tag, %attr) = @_; push @links, $attr{href} if $tag eq 'a' && $attr{href} && $attr{href} =~ /https?:/ && $attr{href} !~ /$domain/ && $attr{href} !~ $IgnoreLinks; }; my $p = HTML::LinkExtor->new($cb); $p->parse($html); return @links; }

sub send_ping { my($ua, $ping_url, $html, $url) = @_; my $title = title_for($html, $url); my %data = ( url => $url, blog_name => $title, title => $title, charset => "utf-8", );

if ($Debug) { print "[Debug] Send ping to $ping_url with:\n"; print map { " $_ => $data{$_}\n" } keys %data; } else { my $request = POST $ping_url, [ \%data ]; my $response = $ua->request($request); my $status = $response->is_success ? "successful" : "failure"; print "Sent ping to $ping_url: $status\n"; }

Running the Hack

% ./autotrack.pl http://blog.bulknews.net/mt/archives/000582.html [Debug] finding Ping URL in http://fenrir.naruoka.org/archives/000106.html [Debug] Found Ping URL http://fenrir.naruoka.org/mt/mt-tb.cgi/103 [Debug] Send ping to http://fenrir.naruoka.org/mt/mt-tb.cgi/103 with: blog_name => blog.bulknews.net: MT Plugin Development url => http://blog.bulknews.net/mt/archives/000582.html charset => utf-8 title => blog.bulknews.net: MT Plugin Development

Hacking the Hack

実際に、blosxom では autotrack プラグイン、また最近のバージョンの MovableType では自動で Trackback Ping URL を探して Ping するオプション(*5)がデフォルトで用意されています。

今回のコードでは、一度送信した URL に対して二度送らないなどの処理を入れていません。実際に利用する際には、キャッシュを作成するなどして、そうした面もケアする必要があるでしょう。

See Also

Listings

List 1: autotrack.pl

#!/usr/local/bin/perl -w
# autotrack - Automatic Trackback Pinger

use strict;
use HTML::LinkExtor;
use HTTP::Request::Common;
use Encode;
use LWP::UserAgent;
use Net::TrackBack;
use URI;

our $VERSION       = "1.0";
our $IgnoreLinks   = qr/movabletype\.org/;
our $Debug         = 1;

my $url = shift;

my $ua = LWP::UserAgent->new();
   $ua->agent("autotrack/$VERSION");
my $html = fetch_content($ua, $url) or die "Can't GET $url";

my @links = find_links($html, $url);
for my $link (@links) {
    warn "[Debug] finding Ping URL in $link\n" if $Debug;
    my $ping_url = find_ping_url($link);
    if ($ping_url) {
        warn "[Debug] Found Ping URL $ping_url\n" if $Debug;
        send_ping($ua, $ping_url, $html, $url);
    }
}

sub fetch_content {
    my($ua, $url) = @_;

    my $request = HTTP::Request->new(GET => $url);
    my $response = $ua->request($request);
    return unless $response->is_success;

    my $content_type = $response->header('Content-Type');
    my $charset = ($content_type =~ /charset=([\w\-]*)/)[0] || "utf-8";
    return decode($charset, $response->content);
}

sub find_links {
    my($html, $url) = @_;
    my $domain = URI->new($url)->host;

    my @links;
    my $cb = sub {
        my($tag, %attr) = @_;
        push @links, $attr{href}
            if $tag eq 'a' && $attr{href} &&
               $attr{href} =~ /https?:/ &&
               $attr{href} !~ /$domain/ &&
               $attr{href} !~ $IgnoreLinks;
    };

    my $p = HTML::LinkExtor->new($cb);
       $p->parse($html);

    return @links;
}

sub find_ping_url {
    my $link = shift;
    my $p = Net::TrackBack->new();
    my @ping_url = $p->discover($link);
    return @ping_url ? $ping_url[0] : undef;
}

sub send_ping {
    my($ua, $ping_url, $html, $url) = @_;
    my $title = title_for($html, $url);
    my %data = (
        url       => $url,
        blog_name => $title,
        title     => $title,
        charset   => "utf-8",
    );

    if ($Debug) {
        print "[Debug] Send ping to $ping_url with:\n";
        print map { "  $_ => $data{$_}\n" } keys %data;
    } else {
        my $request = POST $ping_url, [ \%data ];
        my $response = $ua->request($request);
        my $status = $response->is_success
            ? "successful" : "failure";
        print "Sent ping to $ping_url: $status\n";
    }
}

sub title_for {
    my($html, $url) = @_;
    my $title_part = ($html =~ m!<title>(.*)</title>!is)[0];
    return $title_part || URI->new($url)->host;
}

*1) 必要なら meta タグのスキャンや、Encode::Guess による自動判定も入れると、より robust になるでしょう。
*2) 実際には blog_name は必須でない実装が多いので送らなくても平気かもしれません。
*3) Net::TrackBack がらみで warning が出ますが無視して問題ありません。
*4) Trackback Ping は取り消すことができないため、実際にこのスクリプトで送ることはオススメしません。コードの参考程度にしておいてください。
*5) autodiscover_links という項目です。