如何使用Perl CGI腳本爲圖像提供服務？

7

在這裏你去：

#!/usr/bin/perl -w 
my $file = "inner-nav.gif"; 
my $length = (stat($file)) [10]; 
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);

來源

2009-05-02 22:03:18 RichieHindle

+1

非常簡單，無需加載CGI，謝謝。 – Nifle 2009-05-04 13:20:28

2

WWW FAQs: "How do I output images from a Perl/CGI or PHP script"應該讓你朝着正確的方向前進。你將不得不原諒我直接回答你的問題，因爲我大約5年沒有碰過Perl。

來源

2009-05-02 21:56:09

6

事情是這樣的......

#!/usr/bin/perl 

use strict; 
use warnings; 
use CGI; 

my $gfx=''; 
$gfx = makeImage(); 
print CGI::header(type=>'image/png', 
        expires=>'+1m', 
        content_length=>length($gfx)}); 
print $gfx;

來源

2009-05-02 22:03:24

0

一個簡單的解決方案，處理PNG或JPG文件。如果你想做更多的文件類型，查找GD的最新版本。

http://www.perlmonks.org/?node_id=18565

＃

sub serveImage 
{ 
    use GD; 

    my ($localPath) = @_; 

    if($localPath =~ /\.png/i) 
    { 
     print "Content-type: image/png\n\n"; 
     binmode STDOUT; 
     my $image = GD::Image->newFromPng($localPath); 
     print $image->png; 
    } 
    else 
    { 
     print "Content-type: image/jpeg\n\n"; 
     binmode STDOUT; 
     my $image = GD::Image->newFromJpeg($localPath); 
     print $image->jpeg(100); 
    } 


}

來源

2013-04-18 18:24:20 darkstarEmber

1

小校正的代碼 - 提供沒有返回該文件的長度的stat命令。有些瀏覽器不關心，但其他瀏覽器無法加載圖像。（stat（$ file））[10]是'ctime'，而不是文件的長度。如果有一些人失蹤

#!/usr/bin/perl -w 
my $file = "inner-nav.gif"; 
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; 
}

來源

2013-08-22 15:54:08 gpssjim

0

一位用戶問。我想是這樣。腳本結尾缺少exit 1;。這裏是我的修訂版

#!/usr/bin/perl -w 
my $file = "inner-nav.gif"; 
my $length = (stat($file)) [10]; 
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); 
exit 1;

一個更好的辦法（笑我只在exit 1;加），我想反正是要做到這一點：

#!/usr/bin/perl 

# must haves! 
use strict; 
use warnings; 

use CGI; 
my $cgi = new CGI; # used in 'getParam($)' for getting URL paramaters 

use lib "pm"; # my own perl modules library 
use user; # my user related functions 
use dir; # my directory handling functions 

# these will be used for $fn if $fn not found, read error, or no user 
my $file_not_found = "/img_srvr/error-file-not-found.jpg"; 
my $read_error = "/img_srvr/error-reading-image.jpg"; 
my $no_such_user = "/img_srvr/error-no-such-user.jpg"; 

# the premise of the following is to capture all input into separate vars 
# verify that each element is correct, and then spit out the image. 

# for my site. remove it if you like. see below for getParam($) definition 
my $uid = getParam("uid"); 
if (not userExists($uid)) { printImage($no_such_user); exit 1; } 

my $folder = "/img_srvr/$uid"; # the folder where the images are stored 

my $fn = getParam("img"); # see below for definition 
my $path = "$folder/$fn"; # this, too, _is_ better 

if (not fileExists($path)) 
    { printImage($file_not_found); exit 1; } else 
    { printImage($path); } 

exit 1; 


######################################################################### 


###################### 
sub printImage($) { 
    # be sure to do your error checking BEFORE calling this. it'll just 
    # blindly rip along. 
    my $fn = $_[0]; 
    my $type = getType($fn); # see sub below 
    my $buffer = ""; 

    print "content-type: image/$type\n"; # these are awful, but ok for now 
    print "\n"; # separate just in case we want to add more to the header. 

    binmode STDOUT; 

    open my $FH, "<", $fn or die "$!"; 
    while (read ($FH, $buffer, 10240)) { 
    print $buffer; # prefer NOT to print as I read... 
    } 
    close $FH; 

    # return $OUTPUT; # this would be better, no? 
} 

###################### 
# there's gotta be a better way, spock! 
sub getType($) { 
    my $f = $_[0]; 

    if ($f =~ /\.gif$/i) { return "gif"; } 
    if ($f =~ /\.jpg|\.jpeg$/i) { return "jpeg"; } 
    if ($f =~ /\.png$/i) { return "png"; } 

    return "bmp"; 
} 

sub getParam($) { 
    return $cgi->param($_[0]); 
}

哦！而這可能是a useful link（MIME類型！）：

====

最後，利用上述printImage功能我做了，是有可能「調整」的形象呢？如果是這樣，怎麼樣？我不想安裝其他軟件包，或其他類似的東西。它必須很簡單。

來源

2015-07-27 02:05:18

如何使用Perl CGI腳本爲圖像提供服務？

回答

相關問題