0

こんにちは私はCGIを使用してファイルをアップロードしようとしていますが、CGIスクリプトは実行されますが、作成されるファイルは空です。

ファイル名を取得してcgiスクリプトに渡すhtmlファイルがあります。

<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

binmodeFH でコマンドを使用してみてください。

ファイルをアップロードする CGI フォームの開始点として使用する Perl スクリプトを次に示します (フォームを表示してアップロードを行います)。

#!/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 に答える