为什么我的图片下载用Perl编写的CGI脚本不起作用？ [英] Why is my image download CGI script written in Perl not working?

问题描述

#!/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 file它返回 download.pl （上面给出的脚本的名称）与 没有内容 里面这是什么问题？

When I run this script, instead of returning the icon.png file it returns the download.pl (the name of the script given above) with no content inside it. What is the issue?

我目前正在使用的脚本。

Script i am using currently.

#!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上，自动转换行结尾将严重破坏该文件的内容。

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.

其他问题是：

您没有检查打开的返回值。我们甚至不知道打开是否成功。

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

你永远不会为<$​​ c $ c> $ ID ，表示您在回复中发送filename = \\\
\\\
。

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

您正在篡改二进制文件，使程序的内存占用与二进制文件的大小成正比。

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.

你是使用 ing CGI.pm ，但您既不使用也不使用文档。

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

您正在使用一个裸字（即全球全局）文件句柄。

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

我们尝试运行，是吗？

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

我还发布了一个我的博客上的详细说明。

这篇关于为什么我的图片下载用Perl编写的CGI脚本不起作用？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！