May 2009 Archives

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