带文件得form上传perl cgi脚本

关注

原创最新推荐文章于 2026-06-12 10:08:41 发布 1.2k 阅读 AI 写同款· GEO 优化 ›

纯Delphi开发CGI <br />------------------------------------这是以前写下的---------------------------------------<br /> <br /> <br /> <br />在JAVA泛滥、ASP.net 漫山遍野的今天，也许，大家认为CGI是一种落后的技术，但，也许大家有所不知的是CGI是一种效率很高的编程方式。因为，在前端，CGI不用面对复杂的网络请求过程，而后端输出，又是可以直接输出给浏览器。<br /><br /> 宝刀未老的PERL，是CG 阅读详情

#! /usr/bin/perl -w

use strict;
use Fcntl; # C fcntl.h得对应模块，这里会使用其中定义得O_xx等常量。
use CGI;

＃定义一些系统控制常量
use constant RECEIVE_FILE_PATH => '/Library/WebServer/Received';
use constant BUFFER_SIZE => 10_240;
use constant MAX_SIZE_FILE_PATH => 1024*1024*512;

my $q = new CGI();
$q->cgi_error and &error($q, 'Having error creating cgi handle: '.$q->cgi_error);
my $username = $q -> param('uname') or &error($q, 'username cannot be fetched');
my $password = $q -> param('pw') or &error($q, 'password cannot be fetched');

＃获取上传文件得文件名
my $file = $q -> param('upload_file') or &error($q, 'upload file name cannot be fetched');

＃获取上传文件得本地文件句柄
my $fh = $q -> upload('upload_file') or &error($q, 'cannot get the handler of uploaded file with name - '.$file);

＃检查上传文件存储目录，确认未超出限定size值
&file_path_volume_check($q);

＃用控制力强得sysopen打开用于写入得句柄，并且保持句柄对应的文件不重名。
until(sysopen(OUTPUT, RECEIVE_FILE_PATH."/$file", O_CREAT|O_EXCL|O_WRONLY)){
$file =~ s/(\w+)(\.\w+)$/$1_$2/;
}

＃这是简便的方式，但控制力较弱，不能表达一些sysopen有的逻辑。
#open OUTPUT, "> ".RECEIVE_FILE_PATH."/$file";
# or &error($q, 'open OUTPUT fails');

＃把读写句柄都设置成2进制模式，以免处理的是上传的2进制文件(jpg, zip.....)
binmode $fh;
binmode OUTPUT;

my $buffer ="";

＃循环从硬盘读出BUFFER_SIZE大小的字节到内存，然后再通过OUTPUT写入磁盘。这是对无边界的二进制数据的操作方式。
while(read($fh, $buffer, BUFFER_SIZE)){
print OUTPUT $buffer;

}

＃如果就是上传的文本(.txt)的话，可用下面简便方式

#while(<$fh>){
# print OUTPUT $_;
#}

close $fh;
close OUTPUT;

&error($q, 'Thank you for uploading!');

sub file_path_volume_check{
my ($q) = @_;
opendir DIR, RECEIVE_FILE_PATH or error($q, '/Library/WebServer/Received cannot be opened');
my $path_size;
while(readdir DIR){
$path_size += -s RECEIVE_FILE_PATH."/$_";
}
erorr($q, 'Library/WebServer/Received is full, cannot receive more files.') if($path_size > MAX_SIZE_FILE_PATH);
}
sub error{
my ($q, $aug) = @_;
print $q -> header('text/html'),
$q -> start_html('ERROR'),
$q -> p('Error is: '.$aug),
$q -> end_html();
exit 1;

}

*************************************************************

对应的html：

<html>
<head>
Sample Form
</head>
<body>
<p>
<form action='/cgi-bin/form_processor.cgi' method='post' enctype='multipart/form-data'> ＃enctype='multipart/form-data' 这种media type格式支持文件上传
username: <input type='text' name='uname' value='username' size='20'><br>
dummy password: <input type='password' name='pw' value='dummy password' size='20'>
<br><br>
<input type='file' name='upload_file'>
<input type='submit' name='submit_button' value='Upload File'>
</form>
</p>
</body>
</html>