使用Perl提供图像打印错误的内容长度(在Chrome中提供net :: ERR_CONTENT_LENGTH_MISMATCH)

时间:2014-07-02 16:57:39

标签: perl activeperl

Activeperl 5.16 + Windows环境。

Windows机器:

我的perl5(修订版5版本16颠覆3)配置摘要:

Linux机器:

我的perl5(修订版5版本14颠覆2)配置摘要:

在Linux上根本不会使用相同的代码。

这是我的代码,它获取了一个天气gif图像,并做了一些魔术(从缓存目录提供故障转移支持,以防互联网死机或远程服务器在获取,离线时进行雷达更新)

sub get_map
{
    my $whichImage = $_[0];

    my $ua = LWP::UserAgent->new;
    my $cache_file      = $GLOB{'cache_mapA'};          # tempdata file path
    my $cache_file_age  = 100000;                       # this is used to determine if we have to get fresh data from the ems site will hold the tempdata file age in seconds 
    my $data            = '';                           # initializing empty data variable to enable later check for empty variable
    my $cache_time      = $GLOB{'cache_timeMap'};       # Max age of the temdata file in seconds
    my $useCached       = 0;
    my $url             = $GLOB{'mapAurl'};

    if( $whichImage eq "B" )
    {
        $cache_file     = $GLOB{'cache_mapB'};
        $url            = $GLOB{'mapBurl'};
    }

    if ( -s $cache_file )   # test existence of the tempdata file - if it has a size it exists
    {
        my $mtime           = ( stat $cache_file )[9];  # get the Unix time of the last change (in seconds)
        my $current_time    = time;                     # get the current Unix time (in  seconds)
        $cache_file_age     = $current_time - $mtime;       # get the age of the tempdata fileim seconds!       
    }

    if( $cache_file_age > $cache_time ) # check if we have to query the ems server 
    {
        my $response = $ua->get($url);

        if ($response->is_success) # checking if we were able to get the website
        {
            $data = $response->decoded_content( charset => 'none' );
            open my $filehandle , '>' , $cache_file or die 'Horribly';  
            binmode $filehandle;
            print $filehandle $data;
            close $filehandle;
        }
    }

    my $file = $cache_file;
    my $length = -s $file;

    print "Content-type: image/gif\n";
    print "Content-length: $length \n\n";

    binmode STDOUT;

    open (FH,'<', $file) || die "Could not open $file: $!";
    my $buffer = "";

    while (read(FH, $buffer, 10240)) 
    {
        print $buffer;
    }
    close(FH);
}

cache_mapA指向tmp / map.A.gif和缓存

转到http://mywebserver.com/whatever.cgi?type=mapA会出现一个损坏的gif文件,该文件在Google Chrome的调试器中显示net :: ERR_CONTENT_LENGTH_MISMATCH。

转到http://mywebserver.com/tmp/map.A.gif可以在浏览器中正常运行。

在我的测试盒上尝试切换服务器软件,Apache和LightTPD都显示了这种行为。

我没有想法,因为这在非基于Windows的机器上运行得非常好。

这部分可能存在问题,但对我来说这很好看:

print "Content-type: image/gif\n";
print "Content-length: $length \n\n";

binmode STDOUT;

open (FH,'<', $file) || die "Could not open $file: $!";
my $buffer = "";

while (read(FH, $buffer, 10240)) 
{
    print $buffer;
}
close(FH);

帮助!

1 个答案:

答案 0 :(得分:0)

binmode STDOUT但未binmode FH。 Windows Perl打开默认启用:crlf的文件; Unix Perl没有。

更现代的技术是open (FH,'<:raw', $file),而不是单独调用binmode

如果图像显示在其他浏览器中,则该特定图像的损坏可能很小,以至于它不会阻止解码。