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;
}
となりますが、どこが間違えているのでしょうか。
上記コードは、サイトからのコピペになります。
よろしくお願いします。
お礼
御礼が遅くなり申し訳ありません おっしゃる通りにやってみましたところ、できました。 ありがとうございました。