Not a lot of code. We create a rewrite rule for apache to remap any 5 character requests at root to this script.
RewriteRule ^/([A-Za-z0-9][A-Za-z0-9][A-Za-z0-9][A-Za-z0-9][A-Za-z0-9])$ /cgi-bin/shorten.cgi?$1 [PT].
Requests for http://site/….. lookup the entry in the database, requests to shorten.cgi?URL return the shortened uri in a text/plain output when it works.
There isn’t a lot of checking, and you probably need to create the db/ directory with mode 777 so you can update the database under cgi, but it… works on my box 😉
#!/usr/bin/perl -w
# shorten or unshorten a url passed in
use strict;
use DBI;
use Sys::Hostname;
my %keys;
my $value=0;
# 26 + 26 + 10 = 62
my $keys = join("", ‘A‘..‘Z‘) . join("", ‘a‘..‘z‘) . join("", ‘0‘..‘9‘);
my @keys = split(//, $keys);
for my $i (@keys) {
$keys{$i} = $value++;
}
my $file = "shorten.db";
my $dir;
my $var;
if (defined($ENV{‘SCRIPT_FILENAME‘})) {
$var = $ENV{‘SCRIPT_FILENAME‘};
} else {
$var = $0;
}
($dir) = $var =~ m/(.*)\/[^\/]+/;
$file = $dir . "/db/" . $file;
if (! -d $dir . "/db") {
mkdir($dir . "/db", 0777);
chmod(0777, $dir . "/db");
}
my $dbh = DBI->connect("dbi:SQLite:dbname=$file", "", "") || die "Could not open $file";
chmod(0666, $file);
$dbh->do("create table if not exists mapping (id INTEGER PRIMARY KEY, url TEXT)");
$dbh->do("create index if not exists mappurl on mapping(url)");
exit(0) if (!defined($ENV{‘QUERY_STRING‘}));
my $qs = $ENV{‘QUERY_STRING‘};
if (length($qs) == 5) { # from short -> long
my $key = 0;
map { $key = $key * 62 + $keys{$_} } split(//, $qs);
my $ary = $dbh->selectall_arrayref("select url from mapping where id = $key");
if ($ary) {
my @ary=@$ary;
print "Location: " . $ary[0][0] . "\n\n";
}
} else {
my $sth = $dbh->prepare("select id from mapping where url = ?");
my $ret = $sth->execute($qs);
die "Failed to execute " . $sth->errstr unless($ret);
my @row = $sth->fetchrow_array();
my $value;
if (!@row) {
$sth = $dbh->prepare("insert or replace into mapping (url) values (?)");
$sth->execute($qs) or die "Failed to insert" . $sth->errstr;
$value = $dbh->last_insert_id("","","","");
} else {
$value = $row[0];
}
if (defined($value) && ($value > 0)) {
my $op = "";
while(length($op) != 5) {
$op = $keys[$value % 62] . $op;
$value /= 62;
}
my $base;
if (!defined($ENV{‘HTTP_HOST‘})) {
$base = hostname();
} else {
$base = $ENV{‘HTTP_HOST‘};
}
print "Content-Type: text/plain\n\nhttp://" . $base . "/" . $op . "\n";
} else {
print "Content-Type: text/plain\n\nFailed to shorten $qs.";
exit(0);
}
}
# vim: ts=4:sw=4:et