用 perl 实现文件上传之二

---摘自《中华技术网》

无意中找到这个程序,感觉不错,分享给大家
(西西,作者信息忘了 *&^*&%*&^%^$^&%#^%#)
##################################################
# 网友阿恩 http://www2.cs.uestc.edu.cn/~boyarn #
##################################################
up.htm
##########################
<html><body>
<form action=/cgi-bin/up.pl method=post>
<input name=save-as-filename type=text size=30>

<input name=upload-file type=text size =30>
<input type=submit value="upLoadMe!!!">
</form>
</body>
</html>
##########################

#########################以下开始文件正文 up.pl #########################
#!/usr/bin/perl5.003
BEGIN { #begin setup

$userid = 2301; #

$groupid = 1000; #

$path = "c:/webshare/wwwroot/newsimg"; #777

$url = "http://cdxin/newsimg"; #

$overwrite = 1; #

$success_url = ""; #

$Windows = 1; #

$exclusive_lock = 2; #不能改变!

$unlock_lock = 8; #不能改变!

}

# -------------

$| = 1;

&GetInput;
&Process_File;
&Redirect_User;

# -------------

sub GetInput {

use CGI qw(:standard);
$CGI::OS = 'WINDOWS' if ($Windows);

$query = new CGI;

if ($query->param('save-as-filename') !~ /^[ \t]*$/) {
$filename = $query->param('save-as-filename');
} else {
$filename = $query->param('upload-file');
}
if ($filename eq ""){
&Error("请选择您要上传的文件!");
}
if (lc(substr($filename,length($filename) - 4,4)) ne ".gif"){
&Error("你只能上传 GIF 格式的文件!");
}
}
#end setup don't edit below this line!
# -------------

sub Process_File {

&Error("您的浏览器不能完成这个脚本的操作!") if ($ENV{'HTTP_USER_AGENT'} !~ /^Mozilla\/[432]/);

if ($filename =~ /\//) {
@array = split(/\//, $filename);
$real_name = pop(@array);
} elsif ($filename =~ /\\/) {
@array = split(/\\/, $filename);
$real_name = pop(@array);
} else {
$real_name = "$filename";
}

$outfile = "$path" . "/" . "$real_name";

$filename = $query->param('upload-file');

&Error("文件已经存在,请换一个文件名上传!") if ((-e "$outfile") && (!$overwrite));

if (!open(OUTFILE, ">$outfile")) {
print "Content-type: text/plain\n\n";
print "-------\n";
print "出错啦!\n";
print "-------\n";
print "文件: $outfile\n";
print "-------\n";
print "不能写文件,请确信您的目录属性为 777 ! 或请确信您要覆盖的文件属性为 666!!\n\n";
print "错误信息: $!\n";
exit;
}

while ($bytesread = read($filename,$buffer,1024)) {
$totalbytes += $bytesread;
binmode OUTFILE;
print OUTFILE $buffer;
}

close($filename);
close(OUTFILE);

if ((stat $outfile)[7] < 1) {
unlink $outfile;
&Error("您上传的文件有问题,请检查!");
}
chmod (0644, "$outfile") if (!$Windows);
chown ($userid, $groupid, "$outfile") if (!$Windows);

}

# -------------

sub Redirect_User {

if ($success_url) {
print "Location: $success_url\n\n\n";
exit 0;
} else {
print header;
print start_html('成功啦 !', '#FFFFFF'),
h1(tt(b('成功啦 ! :)'))), br;

print " 文件 ";
print a({HREF=>"$url/$real_name"}, "$real_name"), " 已上传\n";
print end_html;
exit 0;
}
}

# -------------
sub Error {

print header;
print start_html('出错啦!!', '#FFFFFF');
print h1(tt(b('出错啦!! -- :('))), br;
print $_[0];
print end_html;
exit 0;

}

# -------------
# EOF