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)});
}
{
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()||'';
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,
);
}
}