#!/usr/bin/perl
use strict;
use warnings;
use FindBin;
use 5.12.0;
use DBI;
use open ':std',':utf8';
use Encode;
use CGI '-debug';

my $basedir=$FindBin::Bin.'/..';

my $db=DBI->connect("dbi:SQLite:dbname=${basedir}/urls.db",'','',{
    PrintError => 0,
    RaiseError => 1,
    AutoCommit => 1,
    sqlite_unicode => 1,
});

my $dbversion=eval {
    $db->selectall_arrayref('select version from metainfo',{Slice=>{}})
        ->[0]{version};
};
if (!defined $dbversion) {
    $db->do(q{create table metainfo(version integer not null)});
    $db->do(q{create table url(url varchar not null unique,shorted varchar not null unique)});
    $db->do(q{insert into metainfo(version) values(1)});
}

{
# these could be multiple ranges
my @ranges=(0x4e00,0x9fcb);
my $base=0;
for(my $i=0;$i<@ranges;$i+=2) {
    $base+=$ranges[$i+1]-$ranges[$i];
}
sub num2chars {
    my ($number) = @_;

    my @ret=();
    while ($number >= $base) {
        unshift @ret,$number % $base;
        $number=int($number/$base);
    }
    unshift @ret,$number;

    for my $v (@ret) {
        for(my $i=0;$i<@ranges;$i+=2) {
            $v+=$ranges[$i];
            last
                if $v<$ranges[$i+1];
            $v-=$ranges[$i+1];
        }
    }
    return @ret;
}
}

sub shorten {
    my ($url) = @_;

    my $ret=$db->selectall_arrayref(q{select shorted from url where url=?},
                                    {Slice=>{}},
                                    $url);
    if (@$ret) {
        return $ret->[0]{shorted};
    }

    $ret=$db->selectall_arrayref(q{select count(*) as howmany from url},
                                 {Slice=>{}});
    my $number = $ret->[0]{howmany};
    my @codepoints=num2chars($number);
    my $short=pack 'U0U*',@codepoints;
    $db->do(q{insert into url(url,shorted) values (?,?)},
            {},
            $url,$short);
    return $short;
}

sub lengthen {
    my ($short) = @_;
    my $ret=$db->selectall_arrayref(q{select url from url where shorted=?},
                                    {Slice=>{}},
                                    $short);
    if (@$ret) {
        return $ret->[0]{url};
    }
    return 404;
}

sub urlencode {
    my ($str) = @_;

    my @bytes = unpack 'U0C*',$str;
    return join '',map {sprintf '%%%02X',$_} @bytes;
}

sub urldecode {
    my ($str) = @_;

    my @pieces = ($str =~ m{%(..)}g);
    my @bytes = map { oct("0x$_") } @pieces;
    return pack 'U0C*',@bytes;
}

my $q=CGI->new();
my $path=$q->path_info()||'';
$path=~s{^/}{};
my $url=$q->param('url');

if ($url) {
    my $str=shorten($url);
    say $q->header(
        -type => 'text/plain',
        -charset => 'utf-8',
    ),
        'http://',$q->virtual_host,'/',$str;
}
else {
    if ($path =~ m{^%}) {
        $path=urldecode($path);
    }
    else {
        $path=decode('utf8',$path);
    }
    my ($short,$rest) = ($path =~ m{^(\w+)(.*)$});
    my $url=lengthen($short);
    if ($url eq '404') {
        say $q->header(-type=>'text/plain');
    }
    else {
        say $q->redirect(
            -uri=>$url.$rest,
            -status=>301,
        );
    }
}
