CODEWITHSUNDEEP
perlimage
Nifle
Nifle

Reputation: 11933

How can I serve an image with a Perl CGI script?

My Google fu is failing me. How do I use Perl to serve up an already generated image?

Example:

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

What goes in getimage.pl?

Upvotes: 3

Views: 7873

Answers (6)

RichieHindle
RichieHindle

Reputation: 281875

Here you go:

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

Upvotes: 7

Jarett Lloyd
Jarett Lloyd

Reputation: 135

One user asked if there was something missing. I think so. exit 1; is missing at the end of the script. Here's my revised version (lol I only added in the 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;

A better way, I think anyway, is to do this:

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

Oh! And this might be a useful link (mime types!):

====

Finally, using the above printImage function I made, is it possible to 'resize' the image? If so, how? I do not want to install another package, or anything like that. It has to be simple.

Upvotes: 0

gpssjim
gpssjim

Reputation: 31

A small correction to the code -- the stat command provided did not return the length of the file. Some browsers did not care, but others would fail to load the image. (stat($file))[10] is 'ctime', not the length of the file.

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

Upvotes: 3

darkstarEmber
darkstarEmber

Reputation: 1

A simple solution that handles png or jpg files. Lookup the latest version of GD if you want to do more filetypes.

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


}

Upvotes: 0

Jordan S. Jones
Jordan S. Jones

Reputation: 13903

WWW FAQs: "How do I output images from a Perl/CGI or PHP script" should get you going in the right direction. You will have to forgive me for not answering your question directly as I haven't touched Perl in about 5 years.

Upvotes: 2

hpavc
hpavc

Reputation:

Something like this ...

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

Upvotes: 6

Related Questions