Perlでファイルアップロード

Perl プログラミング

Perlでアップロードファイルを受け取る時の最小よりちょっと色々おまけが付いてるコード。

post.cgi

UTF-8で記述。

#!/usr/bin/perl -w
use strict;
use warnings;
use utf8;
use CGI;
use File::Copy;
use File::Basename;

&main();

sub main{
	# CGIオブジェクト
	my $cgi = new CGI;
	
	# アップロードディレクトリ
	my $updir = './upload';
	
	# アップロードファイルのハンドル
	my $fh = $cgi->upload('filename');
	
	# 一時ファイルの場所
	my $tmpPath = $cgi->tmpFileName($fh);
	
	# オリジナルのファイル名
	my $filename = File::Basename::basename($fh);
	utf8::decode($filename);
	
	# MIME TYPEの取得
	my $mimetype = $cgi->uploadInfo($fh)->{'Content-Type'};
	
	# ユニークなファイル名で保存。
	$filename =~ m{(\.[\w]+)$};
	my $saveName = $updir.'/'.time().$1;
	
	# 保存
	File::Copy::move($tmpPath, $saveName) or &fail();
	chmod(0644, $saveName);
	
	# 完了画面
	&success($saveName, $filename, $mimetype);

	close($fh);
	
	return 0;
}

sub success{
	my($saveName, $filename, $mimetype) = @_;
	my $out = <<VIEW;
<html>
	<head>
		<title>アップロード完了</title>
	</head>
	<body>
		<table>
			<tr>
				<td>保存ファイル名</td>
				<td>$saveName</td>
			</tr>
			<tr>
				<td>アップロード前ファイル名</td>
				<td>$filename</td>
			</tr>
			<tr>
				<td>MIME TYPE</td>
				<td>$mimetype</td>
			</tr>
			<tr>
				<td>ビュー</td>
				<td><img src="$saveName"></td>
			</tr>
		</table>
	</body>
</html>
VIEW
	utf8::encode($out);
	print "Content-Type: text/html\n\n", $out;
}

sub fail{
	my $out = <<VIEW;
<html>
	<head>
		<title>アップロード完了</title>
	</head>
	<body>
		<p>アップロードに失敗。</p>
	</body>
</html>
VIEW
	utf8::encode($out);
	print "Content-Type: text/html\n\n", $out;
}

post.html

UTF-8で記述。

<html>
	<head>
		<title>テストアップローダ</title>
	</head>
	<body>
		<h1>テストアップローダ</h1>
		<form action="./post.cgi" method="POST" enctype="multipart/form-data">
			<input type="file" name="filename">
			<input type="submit" value="UPLOAD">
		</form>
	</body>
</html>