Amon2::Lite をつかった TinyURL
Amon2::Lite を使いやすくしたいなあ、とおもって小物をちょっとかいてみる。まあ、こんなもんかなあ。もうちょいうまく書けそう、という部分もなくはない。
オシャレポイントとしては
- DBD::SQLite つかってるので管理しやすい気がする
- HTML5 の pattern とかをつかってみた
- コードがシンプル
- えーじゃっくすっていうのつかってみた
といったところでしょうか。
use strict; use warnings; use utf8; use File::Spec; use File::Basename; use lib File::Spec->catdir(dirname(__FILE__), 'extlib', 'lib', 'perl5'); use lib File::Spec->catdir(dirname(__FILE__), 'lib'); use Plack::Builder; use Amon2::Lite; our $VERSION = '0.01'; # put your configuration here sub config { my $c = shift; my $mode = $c->mode_name || 'development'; +{ 'DBI' => [ "dbi:SQLite:dbname=$mode.db", '', '' ] } } { package MyTinyURL::Storage; sub _random_string { my $length = shift; my @chars = ( 'A' .. 'Z', 'a' .. 'z', '0' .. '9' ); my $ret; for ( 1 .. $length ) { $ret .= $chars[ int rand @chars ]; } return $ret; } sub setup_schema { my ($class, $c) = @_; $c->dbh->do(q{ CREATE TABLE IF NOT EXISTS url ( key VARCHAR(10) NOT NULL PRIMARY KEY, url TEXT ); }); $c->dbh->do(q{ CREATE INDEX IF NOT EXISTS url_url ON url (url); }); } sub get_url { my ($class, $c, $key) = @_; $class->setup_schema($c); return $c->dbh->selectrow_array(q{SELECT url FROM url WHERE key=?}, {}, $key); } sub find_or_create_key { my ($class, $c, $url) = @_; $url || die; $class->setup_schema($c); my $guard = $c->dbh->txn_scope; { my $key = $c->dbh->selectrow_array( q{SELECT key FROM url WHERE url=?}, {}, $url ); $guard->commit; return $key if $key; } my $key = sub { for (1..16) { my $key = _random_string(10); my $cnt = $c->dbh->selectrow_array(q{SELECT COUNT(*) FROM url WHERE key=?}, {}, $key); return $key if $cnt==0; } die "FATAL"; }->(); $c->dbh->do_i(q{INSERT INTO url }, {url => $url, key => $key}); $guard->commit(); return $key; } } get '/' => sub { my $c = shift; return $c->render('index.tt'); }; get '/t/{key}' => sub { my ($c, $args) = @_; my $url = MyTinyURL::Storage->get_url($c, $args->{key}); return $url ? $c->redirect($url) : $c->res_404(); }; post '/api/create' => sub { my $c = shift; my $url = $c->req->param('url') || die "Missing mandatory parameter: url"; $url =~ m{^https?://} or die "Invalid url: $url"; my $key = MyTinyURL::Storage->find_or_create_key($c, $url); my $res_url = URI->new_abs($c->uri_for('/t/' . $key), $c->req->base); return $c->create_response( 200, [ 'Content-Type' => 'text/plain; charset=utf8', 'Content-Length' => length($res_url) ], $res_url ); }; # for your security __PACKAGE__->add_trigger( AFTER_DISPATCH => sub { my ( $c, $res ) = @_; $res->header( 'X-Content-Type-Options' => 'nosniff' ); $res->header( 'X-Frame-Options' => 'DENY' ); }, ); # load plugins __PACKAGE__->load_plugin('DBI'); __PACKAGE__->to_app(handle_static => 1); __DATA__ @@ index.tt <!doctype html> <html> <head> <met charst="utf-8"> <title>MyTinyURL</title> <meta name="viewport" content="width=device-width, initial-scale=1.0"> <script type="text/javascript" src="http://ajax.googleapis.com/ajax/libs/jquery/1.7.0/jquery.min.js"></script> <link rel="stylesheet" href="http://twitter.github.com/bootstrap/1.4.0/bootstrap.min.css"> <script> $(function () { $('#TinyURLForm').submit(function () { $('#Result').hide(); $.ajax({ type: 'POST', url: '/api/create', data: $(this).serialize() }).success(function (res) { $('#Result').text("Result url is : " + res).show(); }).error(function (res) { alert("ERROR"); }); return false; }); }); </script> </head> <body> <div class="container"> <header><h1>MyTinyURL</h1></header> <section> <form method="post" action="/create" id="TinyURLForm"> <input type="url" name="url" size="40" pattern="^https?://.+" required /> <input type="submit" value="Make Tiny URL" class="btn primary" /> </form> <div id="Result"></div> </section> <footer>Powered by <a href="http://amon.64p.org">Amon2::Lite</a></footer> </div> </body>