Question

我的Google fu让我失望了。如何使用Perl来提供已生成的图像？

示例：

<html><body><img src="getimage.pl"></body></html>

getimage.pl中有什么内容？

Answer 1

你走了：

#!/usr/bin/perl -w
my $file = "inner-nav.gif";

## my $length = (stat($file)) [10];
## (stat($file)) [10]; is the inode change time in seconds since  00:00 January 1, 1970 GMT. 
my $length = (stat($file)) [7];
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);

Answer 2

像这样......

#!/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;

Answer 3

对代码的一个小修正 - 提供的stat命令没有返回文件的长度。有些浏览器并不关心，但其他浏览器无法加载图像。（stat（$ file））[10]是＆＃39; ctime＆＃39;，而不是文件的长度。

#!/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;
}

Answer 4

WWW FAQs: "How do I output images from a Perl/CGI or PHP script"应该让你朝着正确的方向前进。您将不得不原谅我没有直接回答您的问题，因为我在大约5年内没有接触过Perl。

Answer 5

处理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);
    }


}

Answer 6

一位用户询问是否遗漏了什么。我认同。脚本末尾缺少exit 1;。这是我修改后的版本（lol我只在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;

无论如何，更好的方法是做到这一点：

#!/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函数，可以“调整”图像的大小吗？如果是这样，怎么样？我不想安装另一个包，或类似的东西。它必须简单。

如何使用Perl CGI脚本提供图像？

6 个答案: