Perlゼミ画像掲示板(Mojolicious::Liteバージョン)
画像掲示板です。これはかんたんプログラミング CGI/Perl」の第5章の2節の「画像掲示板」をMojolicious::Liteを使って書き直したものになっています。
画像掲示板
画像掲示板です。
[f:id:yukikimoto:20100219230544p:image]
ソースコード
画像掲示板のソースコードです。
use Mojolicious::Lite;
use File::Basename 'basename';
use File::Path 'mkpath';
# Image base URL
my $IMAGE_BASE = '/image-bbs/image';
# Directory to save image files
# (app is Mojolicious object. static is MojoX::Dispatcher::Static object)
my $IMAGE_DIR = app->home->rel_file('/public') . $IMAGE_BASE;
# Create directory if not exists
unless (-d $IMAGE_DIR) {
mkpath $IMAGE_DIR or die "Cannot create dirctory: $IMAGE_DIR";
}
# Display top page
get '/' => sub {
my $self = shift;
# Get file names(Only base name)
my @images = map {basename($_)} glob("$IMAGE_DIR/*");
# Sort by new order
@images = sort {$b cmp $a} @images;
# Render
return $self->render(images => \@images, image_base => $IMAGE_BASE);
} => 'index';
# Upload image file
post '/upload' => sub {
my $self = shift;
# Uploaded image(Mojo::Upload object)
my $image = $self->req->upload('image');
# Not upload
unless ($image) {
return $self->render(
template => 'error',
message => "Upload fail. File is not specified."
);
}
# Upload max size
my $upload_max_size = 3 * 1024 * 1024;
# Over max size
if ($image->size > $upload_max_size) {
return $self->render(
template => 'error',
message => "Upload fail. Image size is too large."
);
}
# Check file type
my $image_type = $image->headers->content_type;
my %valid_types = map {$_ => 1} qw(image/gif image/jpeg image/png);
# Content type is wrong
unless ($valid_types{$image_type}) {
return $self->render(
template => 'error',
message => "Upload fail. Content type is wrong."
);
}
# Extention
my $exts = {'image/gif' => 'gif', 'image/jpeg' => 'jpg',
'image/png' => 'png'};
my $ext = $exts->{$image_type};
# Image file
my $image_file = "$IMAGE_DIR/" . create_filename(). ".$ext";
# If file is exists, Retry creating filename
while(-f $image_file){
$image_file = "$IMAGE_DIR/" . create_filename() . ".$ext";
}
# Save to file
$image->move_to($image_file);
# Redirect to top page
$self->redirect_to('index');
} => 'upload';
sub create_filename {
# Date and time
my ($sec, $min, $hour, $mday, $month, $year) = localtime;
$month = $month + 1;
$year = $year + 1900;
# Random number(0 ~ 99999)
my $rand_num = int(rand 100000);
# Create file name form datatime and random number
# (like image-20091014051023-78973)
my $name = sprintf(
"image-%04s%02s%02s%02s%02s%02s-%05s",
$year,
$month,
$mday,
$hour,
$min,
$sec,
$rand_num
);
return $name;
}
app->start;
__DATA__
@@ error.html.ep
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=UTF-8" >
<title>Error</title>
</head>
<body>
<%= $message %>
</body>
</html>
@@ index.html.ep
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=UTF-8" >
<title>Image BBS</title>
</head>
<body>
<h1>Image BBS</h1>
<form method="post" action="<%= url_for('upload') %>" enctype ="multipart/form-data">
<div>
File name
<input type="file" name="image" >
<input type="submit" value="Upload" >
</div>
</form>
<div>
<% for my $image (@$images) { %>
<div>
<hr>
<div>Image: <%= $image %></div>
<div>
<img src="<%= "$image_base/$image" %>">
</div>
<div>
<% } %>
</div>
</body>
</html>
(参考)File::Path
while文は、画像ファイルが存在した場合に、違うファイル名を作成するのに利用されています。
業務に役立つPerl
Perlテキスト処理のエッセンス
PerlでポータブルなLinuxファイル管理入門
