2 
#!/usr/bin/perl 
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser); 
my $files_location; 
my $ID; 
my @fileholder;
$files_location = "C:\Users\user\Documents\hello\icon.png";
open(DLFILE, "<$files_location") ; 
@fileholder = <DLFILE>; 
close (DLFILE) ; 
print "Content-Type:application/x-download\n"; 
print "Content-Disposition:attachment;filename=$ID\n\n";
print @fileholder;

このスクリプトを実行すると、icon.pngファイルを返す代わりに、コンテンツを含まないdownload.pl（上記のスクリプトの名前）が返されます。どうした？

現在使用しているスクリプト。

#!C:\Perl64\bin\perl.exe -w 
use CGI qw(:standard);
use File::Copy qw( copy );
use File::Spec::Functions qw( catfile );
use constant IMG_DIR => catfile(qw(     D:\  ));
serve_logo(IMG_DIR);
sub serve_logo {
    my ($dir) = @_;

                my $cgi = CGI->new;

                my $file = "icon.png";
                #print $file;

                defined ($file)         or die "Invalid image name in CGI request\n";
                send_file($cgi, $dir, $file);


                return;
                }
sub send_file
  {
    my ($cgi, $dir, $file) = @_;
    my $path = catfile($dir, $file);
    open my $fh, '<:raw', $path         or die "Cannot open '$path': $!";
    print $cgi->header(         -type => 'application/octet-stream',         -attachment => $file,     ); 
    binmode STDOUT, ':raw';
     copy $fh => \*STDOUT, 8_192;      
    close $fh         or die "Cannot close '$path': $!";
    return;

}
4

2 に答える 2

7

There are quite a few issues. The first one is the fact that you are using @fileholder = <DLFILE>; to slurp a binary file. On Windows, automatic conversion of line endings will wreak havoc on the contents of that file.

Other issues are:

  1. You are not checking the return value of open. We don't even know if open succeeded.

  2. You never assign a value to $ID, meaning you're sending "filename=\n\n" in your response.

  3. You are slurping a binary file, making the memory footprint of your program proportional to the size of the binary file. Robust programs don't do that.

  4. You're useing CGI.pm, but you are neither using it nor have you read the docs.

  5. You're using a bareword (i.e. package global) filehandle.

The fundamental reason, however, is that open fails. Why does open fail? Simple:

C:\temp> cat uu.pl
#!/usr/bin/env perl

use strict; use warnings;

my $files_location = "C:\Users\user\Documents\hello\icon.png";
print "$files_location\n";

Let's try running that, shall we?

C:\temp> uu
Unrecognized escape \D passed through at C:\temp\uu.pl line 5.
Unrecognized escape \h passed through at C:\temp\uu.pl line 5.
Unrecognized escape \i passed through at C:\temp\uu.pl line 5.
C:SERSSERDOCUMENTSHELLOICON.PNG

Here is a short script illustrating a better way:

use CGI qw(:standard);
use File::Copy qw( copy );
use File::Spec::Functions qw( catfile );

use constant IMG_DIR => catfile(qw(
    E:\ srv localhost images
));

serve_logo(IMG_DIR);

sub serve_logo {
    my ($dir) = @_;

    my %mapping = (
        'big' => 'logo-1600x1200px.png',
        'medium' => 'logo-800x600.png',
        'small' => 'logo-400x300.png',
        'thumb' => 'logo-200x150.jpg',
        'icon' => 'logo-32x32.gif',
    );

    my $cgi = CGI->new;

    my $file = $mapping{ $cgi->param('which') };
    defined ($file)
        or die "Invalid image name in CGI request\n";

    send_file($cgi, $dir, $file);

    return;
}

sub send_file {
    my ($cgi, $dir, $file) = @_;

    my $path = catfile($dir, $file);

    open my $fh, '<:raw', $path
        or die "Cannot open '$path': $!";

    print $cgi->header(
        -type => 'application/octet-stream',
        -attachment => $file,
    );

    binmode STDOUT, ':raw';

    copy $fh => \*STDOUT, 8_192;

    close $fh
        or die "Cannot close '$path': $!";

    return;
}

I also posted a detailed explanation on my blog.

于 2012-05-12T11:48:12.320 に答える
0

何が問題なのかを理解するのにしばらく時間がかかりました。そのため、(私がしたように) ここにたどり着き、大きなファイルを処理する際にランダムな問題が発生した人には、次のようにアドバイスします。

File::Copy は、この目的のためにバグがあるため、避けてください。CGI を介してデータを提供する場合、syswrite はしばらくの間 undef ($! は「リソースが一時的に使用不可」であることを示します) を返すことがあります。

その場合、File::Copy は停止し (0 を返し、$! を設定します)、ファイル全体 (またはストリーム) の転送に失敗します。

それを回避するためのさまざまなオプション、syswrite の再試行、またはブロック ソケットの使用がありますが、どれが最適かはわかりません。

于 2012-11-20T20:23:31.387 に答える