#!/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;
}
有相当多的问题。 第一个是一个事实,即使用的是@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;
}
我还贴出了我的博客上详细解释 。
我花了一段时间来弄清楚什么是错的,那么对于那些在这里结束了(像我一样),具有服务大型文件的随机问题,这是我的建议是:
避免使用文件::复制,因为它是窃听用于这一目的。 当通过CGI提供数据,SYSWRITE可以返回民主基金($!是“资源暂时不可用”)一段时间。
文件::复制停止在这种情况下(返回0,设置$!),未转移整个文件(或流)。
许多不同的选项来解决的是,重试SYSWRITE,或使用阻塞套接字,不知道这对虽然是最好的!