CGI.pmを使ったファイルのアップロードのサンプル

CGI.pmを使ったファイルのアップロードの簡単なサンプル

下記のサンプルは、技術評論社「CGI&Perlポケットリファレンス」のファイルアップロードのサンプルおよびユーティリティ（util.pl）をベースにしています。

注）
・CGI.pmはPerl5に標準添付されていますので新たに入手する必要はありません。
・Win98&Apache1.3.9 + ActivePerlビルド522でのテストしかしておりません。
・ファイル名は英数字であることを前提にしています。英数字に限定する場合はそのチェック処理、日本語を使う場合は文字コードの変換処理が必要になります。

●HTML文書
###############-- Beginning of upload2.html
<HTML>
<HEAD>
<TITILE>ファイルのアップロード</TITLE>
</HEAD>
<BODY>
<h2>ファイルのアップロード</h2>
サイズ制限：６００ＫＢ<BR>
<FORM ACTION="/cgi-bin/up.cgi" ENCTYPE="multipart/form-data" METHOD="POST"><P>
<STRONG>送信元のOS：</STRONG>
<SELECT NAME="ostype">
<OPTION VALUE="MSWin32" SELECTED>MS-Windows
<OPTION VALUE="MacOS">MacOS
<OPTION VALUE="">UNIX
</SELECT>
<BR>
ファイル: <INPUT TYPE="file" NAME="File" SIZE="32"><BR>
<INPUT TYPE="submit" VALUE="送信">
</FORM>
</BODY>
</HTML>
###############--End of upload2.html

●CGIスクリプト
###############-- Beginning of upload2.cgi
#!/usr/bin/perl
#
# upload2.cgi
#
# (C)1999-2000 Kaoru Fujita & Syunji Mishima
#
use lib './lib'; # util.libを格納しているディレクトリ
use CGI;
require 'util.pl';
use File::Basename;

#
# 定数
#
$Title = 'CGI.pmを使ったファイルのアップロードサンプル';
$Temp = './tmp'; # 適切なディレクトリに変更してください。
$BUFSZ = 2048;
$CharSet = 'Shift_JIS';
# $CharSet = 'x-euc-jp'; # Linux等でEUCを使っている場合（当スクリプトの文字コードの変更も必要）

#
$query = new CGI;

$filename = $query->param('File'); # ファイル名の取得
$ostype = $query->param('ostype'); # OSの種類の取得
# MIMEタイプの取得
$type = $query->uploadInfo($filename)->{'Content-Type'};

while($bytesread = read($filename, $buffer, $BUFSZ)){
$file .= $buffer;

### ファイルサイズ制限をしない場合は、
### 以下の４行をコメント化してください。--次の行から--
$file_size ++;
if($file_size > 300){
exitError("ファイルサイズが大きすぎます。600KB 以下にして下さい。");
###--ここまで--
}
}

# ファイル名（フルパス）からベースネームを取り出す
fileparse_set_fstype("$ostype");
$basename = basename($filename,"");

# 同じファイル名がないかチェック
if ( -f "$Temp/$basename") {
exitError("同じファイル名が存在します。" .
"ファイル名を変更して送信してください。\n");
}

# ファイルを指定ディレクトリにコピー
open(OUT, "> $Temp/$basename")
or exitError("現在ファイルの処理ができなくなっています。" .
"しばらくして再試行しても駄目な場合は当サイトの管理者までご連絡下さい。") ;
binmode(OUT);
print(OUT $file);
close(OUT);

# パーミッションを変更
chmod (0666, "$Temp/$basename");

# 完了メッセージの表示
print <<END_OF_HTML;
Content-type: text/html

<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$CharSet">
<TITLE>$Title</TITLE>
</HEAD>
<BODY>
MIMEタイプ：$typeの「$basename」のアップロードに成功しました。
</BODY>
</HTML>
END_OF_HTML

exit(0);
#################--End of upload2.cgi

●CGI.pmのホームページ：

http://stein.cshl.org/WWW/software/CGI/cgi_docs.html

以下はファイルアップロードに関する注意事項の抜粋です。

Using the File Upload Feature

The file upload feature doesn't work with every combination of browser and server. The various versions of Netscape and Internet
Explorer on the Macintosh, Unix and Windows platforms don't all seem to implement file uploading in exactly the same way. I've tried
to make CGI.pm work with all versions on all platforms, but I keep getting reports from people of instances that break the file upload
feature.

Known problems include:

    1.Large file uploads may fail when using SSL version 2.0. This affects the Netscape servers and possibly others that use the SSL
      library. I have received reports that WebSite Pro suffers from this problem. This is a documented bug in the Netscape
      implementation of SSL and not a problem with CGI.pm.
    2.If you try to upload a directory path with Unix Netscape, the browser will hang until you hit the "stop" button. I haven't tried
      to figure this one out since I think it's dumb of Netscape to allow this to happen at all.
    3.If you create the CGI object in one package (e.g. "main") and then obtain the filehandle in a different package (e.g. "foo"), the
      filehandle will be accessible through "main" but not "foo". In order to use the filehandle, try the following contortion:

                  $file = $query->param('file to upload');
                  $file = "main::$file";
                      ...