私のイメージダウンロードのPerlで書かれたCGIスクリプトが動作しないのはなぜですか？

Question

#!/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; 

私はこのスクリプトを実行し、代わりにそれが何のコンテンツも内側とdownload.pl（上記のスクリプトの名前を）返しませんicon.pngファイルを返します。どうした？

私は現在使用中です。

#!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; 

} 

Answer 1

かなりの問題があります。最初は、@fileholder = <DLFILE>;を使用してバイナリファイルをスラッシングするという事実です。 Windowsでは、行末の自動変換がそのファイルの内容を混乱させるでしょう。

その他の問題があります：あなたがopenの戻り値をチェックしていない

1. 。 openが成功したかどうかはわかりません。

2. $IDに値を割り当てることは決してありません。これは、応答に"filename=\n\n"を送信していることを意味します。

3. プログラムのメモリフットプリントがバイナリファイルのサイズに比例するように、バイナリファイルをスラッピングしています。ロバストなプログラムはそれをしません。

4. あなたはuseです。CGI.pmですが、あなたはそれを使用していないし、ドキュメントを読んだこともありません。

5. あなたは、裸の（つまり、パッケージ全体）ファイルハンドルを使用しています。

しかし、基本的な理由は、openが失敗することです。 openが失敗するのはなぜですか？シンプル：

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";

これを実行してみましょうか？ここで

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

は、より良い方法を説明する短いスクリプトです：

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; 
} 

私もdetailed explanation on my blogを掲載しました。

Answer 2

（私が行ったように）大きなファイルを提供するランダムな問題を抱えて、ここで終わるもののために、ここで私からのアドバイスですので、それは、間違っていたものを理解するために私にしばらく時間がかかった：それはだとして

避けファイル::コピーは、この目的のために盗んだ。 CGIでデータを提供する場合、syswriteはundef（$！being 'Resource temporarily unavailable'）をしばらく返すことができます。

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

これを回避するには、syswriteを再試行するか、ブロッキングソケットを使用するか、どちらが最善かはっきりしないさまざまなオプションがあります。