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;
}



となりますが、どこが間違えているのでしょうか。
上記コードは、サイトからのコピペになります。

よろしくお願いします。

No.2 ベストアンサー 回答者： YkazubonY 回答日時： 2012/09/19 15:51

このコードには、ファイルの読込み処理が書かれていません。

ファイルを読み込むには、通常は、下記の簡単なコードで十分です。

use CGI;
print "Content-type: text/html; charset=UTF-8\n\n";
my $query = new CGI;
my $filename = $query->param('filename');
my $mimetype = $query->uploadInfo($filename)->{'Content-Type'};
my @mytbl = ();
while (<$filename>) {
push(@mytbl, $_);
}

@mytblに読み込んだファイルの内容があります。

この回答へのお礼

ありがとうございます。大変参考になりました。

お礼日時：2014/09/27 13:58

No.1 回答者： Tacosan 回答日時： 2012/09/01 23:44

せめて「どんなエラーが出るのか」くらいはあった方がいいんじゃないかなぁ....

この回答へのお礼

ありがとうございます。大変参考になりました。

お礼日時：2014/09/27 13:58