Amon2で画像掲示板

最終更新時間:2011年11月05日 17時44分59秒

 画像掲示板(Mojolicious::Lite)を見て、これを、最近いじくり始めたAmon2で書きなおしてみた(エラー処理はちょっとはしょった)。つまらないものですが、習作ということで。
 Mojolicious::Liteでの「$self->req->upload('image')->move_to()」に相当する、ファイルをコピーするメソッドが、Amon2の方に(というかPlack::Request::Uploadに)見当たらず、ちょっと考えこんでしまったが、それ以外はあっという間にポーティングできた。おんなじようなPerlベースの軽量WAFなので、それも当たり前か。

Dispatcher.pm

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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
2
3
4
5
6
7
8
9
10
11
12
13
14
15
[% 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
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
--- 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) {