0

您好我正在尝试使用 CGI 上传文件，虽然 CGI 脚本运行，但创建的文件是空的。

我有一个 html 文件，它获取文件名并将其传递给 cgi 脚本：

<html>
<body>

<form enctype="multipart/form-data" action="cgi-bin/upload.pl" method="POST">
<input type="FILE" name="file">
<input type="submit">
</form>

</body>
</html>

cgi脚本如下：

#!/usr/bin/perl -w

use strict;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI;

print "Content-type: text/html\n\n";

my $cgi = new CGI;
my $dir = 'sub';

my $name = $cgi->param('file');
print "name: $name <br />\n";
open(LOCAL, ">$dir/$name") or die "error: failed to open $dir/$name\n";
my $file_handle = $cgi->upload('file');
die "file_handle not defined\n" unless(defined($file_handle));
while(<$file_handle>) {
    print $_;
    print LOCAL $_;
}
close($file_handle);
close(LOCAL);

print "done\n";

cgi 脚本运行正常，不产生警告，设法创建本地文件并正确获取远程文件名。但是，该脚本似乎没有从文件中读取任何数据或将任何数据写入本地文件，该文件是空的。

我肯定会上传一个包含多行数据的文件，但 cgi 脚本的输出如下：

   name: tmp.txt 
   done

非常感谢任何帮助...

4

1 回答 1

0

您可能想尝试binmode在 FH 上使用该命令。

这是一个 Perl 脚本，我将其用作上传文件（显示表单并进行上传）的 CGI 表单的起点：

#!/usr/bin/perl

use strict;
use warnings;

use POSIX;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser set_message);

use Upload;

# Constants
my $FILE_DIR_INTERNAL = 'Z:\webroot\tmp';

# Variables
my $ACTION = param('action') || "";

if (! $ACTION) { UploadForm() }
elsif ($ACTION eq "UploadFile") {
  my $file = UploadFile($FILE_DIR_INTERNAL, 1);
  print "File uploaded to $file\n<pre>";
  open(F, "$file");
  while(<F>) { print }
  close(F);
}

这是该脚本使用的 Perl 模块：

package Upload;

use strict;
use warnings;
use POSIX;
use File::Copy;
use CGI::Pretty qw(:standard -any -no_xhtml -oldstyle_urls *center);
use CGI::Carp qw(fatalsToBrowser); # supposed to echo STDERR to browser, too

use Exporter;
our $VERSION = do{ q$Revision: 1.5 $ =~ /(\d+)\.(\d*)([^ ]*)/; sprintf "%d.%02d%s", $1, $2, $3; };
our @ISA = qw(Exporter);
our @EXPORT = qw(UploadForm UploadFile);


my $FILE_UPLOAD_PARAM = "fileUploaded";

# *************************************************************************
# FUNCTION: UploadForm
# ARGUMENTS:    
# RETURNS:  
# NOTES:    This subroutine displays the upload form.
# *************************************************************************
sub UploadForm {


  print start_center;
  print p("Upload a file from your computer:");

  # Normally, I use the "get" method for forms (params show up in URL),
  # but "post" is required for uploading files!
  # Using "post" also requires that we pass parameters thru the hidden()
  # commands down below, instead of in the URL.
  print start_multipart_form({-method=>"post", -action=>script_name});
  print filefield($FILE_UPLOAD_PARAM,"",50) . "\n";

  # Hidden parameters are "sticky", so modify the existing "action" param,
  # before trying to insert a new hidden "action" param.
  # If you don't, CGI.pm will re-use the current "action" param.
  param("action", "UploadFile");
  print hidden("action") . "\n";

  print p(submit("", "Upload File"));
  print end_form;

  print end_center;

}

# *************************************************************************
# FUNCTION: UploadFile
# ARGUMENTS:    
# RETURNS:  
# NOTES:    This subroutine handles data "posted" thru the form
#       created in UploadForm().
# *************************************************************************
sub UploadFile {

  my $dir = shift || die "ERROR!  No arg passed to UploadFile().\n";
  my $overwrite = shift || 0;

  my $TEMP_FH;

  # The upload() function returns the filename and a file handle.  See CGI.pm.
  $_= $TEMP_FH = upload($FILE_UPLOAD_PARAM);

  # What do all the regexes do?  I wrote them, but I forgot.  I think they
  # strip off any path information (common in IE!) to get just the filename.
  s/\w://;
  s/([^\/\\]+)$//;
  $_ = $1;
  s/\.\.+//g;
  s/\s+//g;
  my $filename = $_;
  my $serverFullFilename = "$dir/$filename";

  if (! $filename) {
    DisplayErrorPage("Illegal filename: '$filename'");
  }

  if ((! $overwrite) && (-e $serverFullFilename)) {
    die "Unable to upload file.  File '$filename' already exists.";
  }

  open(SERVER_FH,">$serverFullFilename") || die "Error opening $filename for writing.";
  binmode SERVER_FH;

  # Copy the file from the temp dir to the final location.
  while (<$TEMP_FH>) {
    print SERVER_FH;
  }

  close(SERVER_FH);
  close($TEMP_FH);

  if ((stat $serverFullFilename)[7] <= 0) {
    unlink $serverFullFilename;
    die "Unable to upload file '$filename'.  This is usually due to the user specifying an invalid or unreadable file on the user's computer.";
  }

  return $serverFullFilename;
} 

return 1;

请原谅任何不一致之处，因为我不得不剪掉一些特定于站点的东西，但如果我正确地修剪它，那应该可以“开箱即用”

于 2012-09-14T14:42:16.390 回答