URL shortening...

| No Comments | No TrackBacks
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

No TrackBacks

TrackBack URL: http://www.petesh.com/scgi-bin/MT/mt-tb.cgi/233

Leave a comment

About this Entry

This page contains a single entry by Pete Shanahan published on May 19, 2009 10:28 PM.

Classy error from XCode was the previous entry in this blog.

On the assumption that these are monthly stats... is the next entry in this blog.

Find recent content on the main index or look in the archives to find all content.