#!/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
文件,而是返回{strong> 无内容 <的download.pl
(上面给出的脚本的名称) / strong>在里面。有什么问题?
我目前使用的脚本。
#!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;
}
答案 0 :(得分:7)
有很多问题。第一个是您使用@fileholder = <DLFILE>;
来填充二进制文件的事实。在Windows上,行结尾的自动转换将对该文件的内容造成严重破坏。
其他问题是:
您没有检查open
的返回值。我们甚至不知道open
是否成功。
您永远不会为$ID
分配值,这意味着您在回复中发送"filename=\n\n"
。
您正在啜饮二进制文件,使程序的内存占用量与二进制文件的大小成比例。强大的计划不会这样做。
您是use
CGI.pm,但您既没有使用它,也没有阅读过文档。
您正在使用裸字(即包全局)文件句柄。
然而,根本原因是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;
}
答案 1 :(得分:0)
我花了一段时间来弄清楚出了什么问题,所以对于那些最终在这里(就像我一样)服务大文件的随机问题的人来说,这是我的建议:
避免使用File :: Copy,因为它出于此目的而被窃听。 通过CGI提供数据时,syswrite可以在一段时间内返回undef($!为'资源暂时不可用')。
File :: Copy在这种情况下停止(返回0,设置$!),无法传输整个文件(或流)。
解决这个问题的许多不同选项,重试syswrite或使用阻塞套接字,不确定哪个是最好的!