perl アップロード
http://hole.sugutsukaeru.jp/archives/10
こちらのサイトでPerlでのファイルのアップロードを行なおう思い、
作成しているのですが、
エラーになり表示されません。
コードを貼り付けると、
#!/usr/bin/perl -w
#使用するモジュールをロード
use File::Basename;
use CGI;
#変数宣言
my ($form, $dir, $filename, $parsename, @filename,
$error, $ok, $type, $newfile, $i,
$buffer, @ext_ok);
#ファイルを保存するディレクトリを設定
#（CGIの実行ユーザで書き込み権限が必要）
$dir = './files';
#受付可能な拡張子（正規表現）
@ext_ok = qw (
txt
zip
pdf
doc
cgi
);
#CGIオブジェクトを作成
$form = new CGI;
#転送できるファイルの最大サイズを設定
#（実際は、post送信されるコンテンツ合計の最大サイズ）
#この値は、CGIオブジェクトを作成する時には既に
#設定されていなければならない
$CGI::POST_MAX = 1024 * 1000; #max = 1MB
#CGIオブジェクトを作成
$form = new CGI;
#クライアントにヘッダを送信
#これは、結果メッセージ表示のため
binmode STDOUT;
print "Content-Type: text/plain;charset=euc-jp\r\n\r\n";
#ファイルの転送のチェック
if (!defined($filename) and $error = $form->cgi_error){
#ファイルが転送されていなかったら、$filename は 未定義値となっている。
#フォーム上でファイルを選択しないままフォームがサブミットされた場合は、
#通常はこの変数 $filename は空文字列として定義されている（＝未定義ではない）。
#このため、以前のバージョンでは $filename が定義されている
#かどうかをエラーの判別の基準としていたが、
#2007年3月 Mac OS X 上の Netscape 7.1 で試したところ、
#ファイル選択されていない場合に未定義値になることが判明。
#このため、エラーの場合に設定される（筈の）値 $form->cgi_error も判別の
#基準に追加した。
print "ファイルが転送できませんでした：$error\n";
exit;
}
if ($filename) { #ファイルが転送されていれば、値は真
#ファイルパス内の「\」を「/」に変換
# $parsename には、送信元クライアントマシン内での
#ファイルパスが格納されている。
#注：Shift_JISで実装する場合、このあたりには工夫が必要。
$parsename =~ s#\\#/#g;
#ファイル名を（ベース名, ディレクトリ名, 拡張子）に分解
@filename = fileparse($parsename, "\.[^\.]+");
#ベース名のチェック（アスキー文字列であること）
$filename[0] =~ /^[\.\w~-]+$/ and $filename[2] =~ /^[\.\w-]+$/ and $ok = 1;
unless ($ok) {
$error = 'ファイル名は、半角英数字にして下さい。';
print "ファイル転送ができませんでした。: $error\n";
exit;
}
$ok = 0; #フラグのリセット
#拡張子のチェック
foreach (@ext_ok){
$filename[2] =~ /^\.$_$/ and $ok = 1 and last;
}
unless ($ok){
$error = "許可されていない拡張子($filename[2])です。";
print "ファイル転送ができませんでした。: $error\n";
exit;
#サーバ側ファイル名の決定
#まず、セッションごとに一意のディレクトリ名を作成
while (-d "$dir") {
$dir = $dir.'/upload_'.&gen_unique_key(15);
}
#ファイルを格納するディレクトリを作成
unless (mkdir($dir, oct(777))){
print "保存ファイル用ディレクトリの作成に失敗しました。: $!\n";
exit;
#サーバ側のファイルパスを設定
$newfile = $dir."/".$filename[0].$filename[2];
#既に同名のファイルが存在した場合
#（複数の同名ファイルを同時にアップロードした場合など）は、
#ベース名にアンダースコアと番号を付けて別名にする
$i = 0;
while (-f "$newfile"){
$i++;
$newfile = $dir."/".$filename[0]."_".$i.$filename[2];
}
#ファイルの保存
unless (open (OUTFILE,">$newfile")){
print "サーバ側の保存ファイルの作成に失敗しました。: $!\n";
exit;
}
#保存用ファイルを無事 open できた場合
#改行コードの自動変換を停止
binmode (OUTFILE);
binmode ($filename);
# $filename から内容を読み出して
#保存用ファイルに書き出す
#この場合、変数 $filename はファイルハンドルとして
#機能する
while (read($filename,$buffer,1024)) {
print OUTFILE $buffer;
#ファイルを close して終了メッセージを表示
#この場合、$filename は、送信元クライアント
#マシン内でのファイルパス（ブラウザが送信してきた値）を返す
close (OUTFILE)
and print "送信されたファイル ($filename) を右のファイル名で保存しました： $newfile\n"
or print "サーバ側の保存ファイルのクローズに失敗しました。: $!\n";
} else {
# ファイルが転送されていない場合
# $filename は 偽
print "ファイルはアップロードされていません。\n";
}
#一意の文字列を作成するための関数
sub gen_unique_key($){
#生成する文字列の長さを引数で指定
my $length = shift;
my ($i, $tempval, $key, $chars, @chars);
#引数で指定された文字列長さが、
# 5以上 30以下の数値でない場合、15に設定
#（範囲は、長からず短からず...。）
($length =~ m/^\d+$/ and $length >= 5 and $length <= 30
) or $length = 15;
#使用する文字を指定（ディレクトリ名として使用できる文字を指定する）
$chars = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890~-_';
@chars = split(//, $chars);
#乱数のタネを作る
srand(time|$$);
for ($i=0; $i<$length; $i++){
# @chars 配列の最大の添字までの乱数を生成する
$tempval = int(rand(scalar(@chars)));
$key .= $chars[$tempval];
}
return $key;
}
となりますが、どこが間違えているのでしょうか。
上記コードは、サイトからのコピペになります。
よろしくお願いします。
お礼
返事が遅くなって申し訳ありませんでした。 ファイルをコピーする方法で解決いたしました。 モジュールを使うバージョンと 読み込み書き込みでコピーするバージョン 2タイプで作成し分岐で汎用性をもたしてみました。 なぜ2番目以降のファイルの書き込みができなかったのかの原因は不明ですが。結果オーライということにしときます。 本当にありがとうございました。