perl上传文件实例程序

示例的 HTML 文件如下：

  
  

   
   <
   
   html
   
   >
   
   

   
   <
   
   body
   
   >
   
   

   
   <
   
   form 
   
   method
   
   ="POST"
   
    action
   
   ="psupload.cgi"
   
    ENCTYPE
   
   ="multipart/form-data"
   
   >
   
   
File 1:

   
   <
   
   input 
   
   type
   
   ="file"
   
    name
   
   ="FILE1"
   
   >
   
   

   
   <
   
   br
   
   >
   
   
File 2:

   
   <
   
   input 
   
   type
   
   ="file"
   
    name
   
   ="FILE2"
   
   >
   
   

   
   <
   
   br
   
   >
   
   

   
   <
   
   input 
   
   type
   
   ="submit"
   
    value
   
   ="Upload!"
   
   >
   
   

   
   </
   
   form
   
   >
   
   

   
   </
   
   body
   
   >
   
   

   
   </
   
   html
   
   >
  
  

　　后台的 Perl 程序如下：

  
  

   
   #
   
   !/
   
   usr
   
   /
   
   bin
   
   /
   
   perl
#######################################
## Perl Services Upload Helper v1.
   
   0
   
    ##
## http:
   
   //
   
   www.perlservices.com ##
   
   

   
   ## perlservices@perlservices.com ##
## ###########################################
## You should carefully read all of the following terms and conditions ##
## before 
   
   using
   
    
   
   this
   
    program. Your use of 
   
   this
   
    software indicates your ##
## acceptance of 
   
   this
   
    license agreement and warranty. ##
## This program 
   
   is
   
    being distributed 
   
   as
   
    freeware. It may be used ##
## free of charge, but not modified below the line specified. This copyright ##
## must remain intact. ##
## ##
## By 
   
   using
   
    
   
   this
   
    program you agree to indemnify Perl Services from any ##
## liability. ##
## ##
## Selling the code 
   
   for
   
    
   
   this
   
    program without prior written consent 
   
   is
   
    ##
## expressly forbidden. Obtain permission before redistributing 
   
   this
   
    ##
## program over the Internet or 
   
   in
   
    any other medium. In all cases the ##
## copyright must remain intact. ##
## ##
## There are security hazards involved with 
   
   this
   
    script. Read the readme file##
## before 
   
   using
   
    the script. ##
################################################################################
##
## Start setting up options here:
## Your path to where you want your files uploaded.
## Note: NO trailing slash
$basedir 
   
   =
   
    
   
   "
   
   /home/path/to/directory
   
   "
   
   ;
## Do you wish to allow all file types
   
   ?
   
    yes
   
   /
   
   no (no capital letters)
$allowall 
   
   =
   
    
   
   "
   
   yes
   
   "
   
   ;
## If the above 
   
   =
   
    
   
   "
   
   no
   
   "
   
   ; then which 
   
   is
   
    the only extention to allow
   
   ?
   
   
## Remember to have the LAST 
   
   4
   
    characters i.e. .ext
$theext 
   
   =
   
    
   
   "
   
   .gif
   
   "
   
   ;
## The page you wish it to forward to when done:
## I.E. http:
   
   //
   
   www.mydomainname.com/thankyou.html
   
   

   
   $donepage 
   
   =
   
    
   
   "
   
   http://www.perlservices.com/
   
   "
   
   ;
################################################
################################################
## DO NOT EDIT OR COPY BELOW THIS LINE ##
################################################
################################################
use CGI;
$onnum 
   
   =
   
    
   
   1
   
   ;

   
   while
   
    ($onnum 
   
   !=
   
    
   
   11
   
   ) {
my $req 
   
   =
   
    
   
   new
   
    CGI;
my $file 
   
   =
   
    $req
   
   ->
   
   param(
   
   "
   
   FILE$onnum
   
   "
   
   );

   
   if
   
    ($file ne 
   
   ""
   
   ) {
my $fileName 
   
   =
   
    $file;
$fileName 
   
   =~
   
    s
   
   !^
   
   .
   
   *
   
   (\\
   
   |
   
   \
   
   /
   
   )
   
   !!
   
   ;
$newmain 
   
   =
   
    $fileName;

   
   if
   
    ($allowall ne 
   
   "
   
   yes
   
   "
   
   ) {

   
   if
   
    (lc(substr($newmain,length($newmain) 
   
   -
   
    
   
   4
   
   ,
   
   4
   
   )) ne $theext){
$filenotgood 
   
   =
   
    
   
   "
   
   yes
   
   "
   
   ;
}
}

   
   if
   
    ($filenotgood ne 
   
   "
   
   yes
   
   "
   
   ) {
open (OUTFILE, 
   
   "
   
   >$basedir/$fileName
   
   "
   
   );
print 
   
   "
   
   $basedir/$fileName<br>
   
   "
   
   ;

   
   while
   
    (my $bytesread 
   
   =
   
    read($file, my $buffer, 
   
   1024
   
   )) {
print OUTFILE $buffer;
}
close (OUTFILE);
}
}
$onnum
   
   ++
   
   ;
}
print 
   
   "
   
   Content-type: text/html\n
   
   "
   
   ;
print 
   
   "
   
   Location:$donepage\n\n
   
   "
   
   ; 



  
  























用 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