Amon2で画像掲示板
画像掲示板(Mojolicious::Lite)を見て、これを、最近いじくり始めたAmon2で書きなおしてみた(エラー処理はちょっとはしょった)。つまらないものですが、習作ということで。
Mojolicious::Liteでの「$self->req->upload('image')->move_to()」に相当する、ファイルをコピーするメソッドが、Amon2の方に(というかPlack::Request::Uploadに)見当たらず、ちょっと考えこんでしまったが、それ以外はあっという間にポーティングできた。おんなじようなPerlベースの軽量WAFなので、それも当たり前か。
Dispatcher.pm
1 |
package upfile::Web::Dispatcher; use strict; use warnings; use utf8; use Amon2::Web::Dispatcher::Lite; use File::Copy; use File::Spec; use File::Basename; use Time::Piece; my $dir = 'static/upload'; any '/' => sub { my ($c) = @_; my $ab_dir = File::Spec->catdir($c->base_dir(),$dir); my @image = reverse map {$dir.'/'.basename($_)} glob ("$ab_dir/*"); $c->render('index.tt', {image => \@image}); }; post '/post' => sub { my ($c) = @_; my $upload = $c->req->upload('upfile'); if($upload){ my $ext = valid_type($upload->content_type); if($ext){ my $src = $upload->tempname; my $dst = create_filename($ext); $dst = File::Spec->catfile($c->base_dir(),$dir,$dst); copy $src,$dst; } } return $c->redirect('/'); }; sub valid_type { my $type = shift; my %valid_types = ('image/gif' => 'gif','image/jpeg' => 'jpg','image/png' => 'png'); return $valid_types{$type}; } sub create_filename { my $ext = shift; my $date = localtime; my $rand_num = sprintf "%05s",int(rand 100000); return 'image-'.$date->datetime(date => '',time => '',T => '').'-'.$rand_num.'.'.$ext; } 1; |
index.tt
1 |
[% WRAPPER 'include/layout.tt' %] <form method="post" action="[% uri_for('/post') %]" enctype="multipart/form-data"> <input type="file" name="upfile" /> <input type="submit" value="Send" /> </form> [% FOR img IN image %] <hr> Image: [% img %] <br> <img src="[% img %]"> [% END %] [% END %] |
どっちかというと、最初にAmon2をmod_perl環境で動作させるのに苦労した。amon2-setup.plによって、lib以下に自動生成されるファイル(ここではupfile.pm)を、以下のように、sqlのスキーマのファイルの場所がフルパスになるように修正することで、動作させることができた。
まあ、この例ではDBは使ってないのだが。
upfile.pm
1 |
--- upfile.pm~2011-10-31 22:24:26.740659710 +0900 +++ upfile.pm2011-10-31 22:46:55.961647200 +0900 @@ -5,6 +5,7 @@ use parent qw/Amon2/; our $VERSION='0.01'; use 5.008001; +use File::Spec; __PACKAGE__->load_plugin(qw/DBI/); @@ -15,6 +16,7 @@ my $dbh = $self->dbh(); my $driver_name = $dbh->{Driver}->{Name}; my $fname = lc("sql/${driver_name}.sql"); + $fname = File::Spec->catfile($self->base_dir(),$fname); open my $fh, '<:encoding(UTF-8)', $fname or die "$fname: $!"; my $source = do { local $/; <$fh> }; for my $stmt (split /;/, $source) { |
関連ページ