95 lines
2.2 KiB
Perl
95 lines
2.2 KiB
Perl
use strict;
|
|
use warnings FATAL => 'all';
|
|
use feature qw/say/;
|
|
|
|
use Mojolicious::Lite -signatures;
|
|
|
|
use URI;
|
|
use DBIx::Struct qw/connector hash_ref_slice/;
|
|
use Data::Dumper;
|
|
|
|
my $SITE_NAME = 'shrl.be/';
|
|
|
|
my $db_file = 'shrl.db';
|
|
DBIx::Struct::connect(sprintf('dbi:SQLite:dbname=%s', $db_file),"","");
|
|
|
|
# Render template "index.html.ep" from the DATA section
|
|
get '/' => sub ($c) {
|
|
$c->render(template => 'index', page_data => {});
|
|
};
|
|
|
|
get '/s/*url' => sub ($c) {
|
|
my $url = normalize_source_url($c->param('url'));
|
|
my $shorten_path = write_url($url);
|
|
my $shorten_url = $SITE_NAME.$shorten_path;
|
|
$c->render(text => $shorten_url);
|
|
};
|
|
|
|
post '/' => sub ($c) {
|
|
my $url = normalize_source_url($c->param('url'));
|
|
my $shorten_path = write_url($url);
|
|
my $shorten_url = $SITE_NAME.$shorten_path;
|
|
$c->render(template => 'index', page_data => { url => $url, shorten_url => $shorten_url});
|
|
};
|
|
|
|
get '/:shorten_path' => sub ($c) {
|
|
my $path = $c->param('shorten_path');
|
|
my $url = get_url($path);
|
|
if ($url) {
|
|
$c->res->code(307);
|
|
$c->redirect_to($url);
|
|
} else {
|
|
$c->render(status => 404, text => 'Page not found :(');
|
|
}
|
|
|
|
};
|
|
|
|
app->start;
|
|
|
|
|
|
sub rand_str() {
|
|
my @set = ('0' ..'9', 'A' .. 'z', 'a'..'z');
|
|
my $str = join '' => map $set[rand @set], 1 .. 8;
|
|
return $str;
|
|
}
|
|
|
|
sub normalize_source_url($source_url) {
|
|
my $uri = URI->new($source_url);
|
|
$uri = URI->new('http://'.$source_url) if !$uri->scheme;
|
|
return $uri->as_string;
|
|
}
|
|
|
|
sub write_url($source_url) {
|
|
|
|
my $shorten_path;
|
|
eval {
|
|
my $short_row = one_row('urls',{ source_url => $source_url});
|
|
if (!$short_row) {
|
|
$shorten_path = rand_str();
|
|
new_row('urls' =>
|
|
source_url => $source_url,
|
|
shorten_path => $shorten_path,
|
|
);
|
|
|
|
} else {
|
|
$shorten_path = $short_row->shorten_path;
|
|
}
|
|
};
|
|
if ($@) { #may fall with deep recursion if no free names available
|
|
if ($@ =~ /urls.shorten_path inserting /) {
|
|
&write_url($source_url);
|
|
}
|
|
die $@;
|
|
}
|
|
return $shorten_path;
|
|
|
|
}
|
|
|
|
sub get_url($shorten_path) {
|
|
my $row = one_row('urls', { shorten_path => $shorten_path});
|
|
|
|
return $row->source_url if($row);
|
|
|
|
return;
|
|
}
|
|
|