Welcome to
Joachim Breitner's Homepage

The Trackback spam on my blog started to get really annoying, even with serendipity's “invert selection” and “delete” buttons. So I came up with a simple perl script, that looks at all unapproved trackpack pages and deletes those who don't link to my blog. It's not perfect, as there might be correct cases where someone trackbacks my post without actually linking to it, but that's ok for me. Also, the spammers will probably fix this “bug” of theirs, too (and some already have, as someone told us during a lightning talk at the GPN5), but at least for a little while this will save me some work. (See the complete post for the code)

#!/usr/bin/perl

# Trackback-Spam Deleter © 2006 Joachim Breitner
# 
# Automatically deletes unapproved trackbacks that do not include
# a link to our blog.

# DB-Configuration, should be clear
my $dbName    = 'serendipity';
my $dbPrefix  = 'serendipity_';
my $dbHost    = 'localhost';
my $dbUser    = 'serendipity';
my $dbPass    = 'shushshsh';

# String that has to appear in the linked pages (e.g. blog url)
my $require   = qr'joachim-breitner.de/blog';

# From here on, it's code

use DBI;
use LWP::Simple;
use strict;
use warnings;

print "Trackback-Deleter by Joachim Breitner\n";

print "Connecting to the database...\n";
my $dbh = DBI->connect(
        "DBI:mysql:database=$dbName;host=$dbHost",
        $dbUser,
        $dbPass,
        {RaiseError=>1, PrintError=>0}
);

my $urls = $dbh->selectall_arrayref(
        "SELECT url
                FROM ${dbPrefix}comments
                wHERE type = 'trackback' AND status = 'pending'
                GROUP BY url",
) or die $dbh->error();

foreach my $url ( @$urls ) {
        $url = $url->[0];
        print "Checking URL: $url\n";
        my $content = get("$url");
        if ($content =~ $require) {
                print "Page links to us, please approve manually\n";
        } else {
                print "Page does not link to us, deleting trackback...\n";
                $dbh->do("DELETE FROM ${dbPrefix}comments WHERE url = ?",
                          undef, $url)
        }
        print "\n"
}