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) { |
関連ページ