Category: Web Stuff
Author/Contact Info
Description: If our Web server receives an image request and the image is not found, the Web server calls a cgi script to serve the image. The script analyzes the request and serves the appropriate image from MS SQL 7.0 Server.

I have posted this code to show an extensible method of serving images in the event that any monks are called upon to write a similar script.

This can easily be modified to allow calls directly from a CGI script in the following format:

<img src="/cgi-bin/images.cgi?image=category1234" height=40 width=40 alt="some text">

Then, you'd add the following to your code:

use CGI; my $query = new CGI;
Then, substitute the following line:
$ENV{'QUERY_STRING'} =~ m!([a-zA-Z]+)(\d+)\.($types)$!;
With this line:
$query->param('image') =~ m!([a-zA-Z]+)(\d+)\.($types)$!;
#!C:/perl/bin/perl.exe -wT

use strict;
use DBI qw(:sql_types);

# This program works as follows:
# In a Web document, if an image is not found, the server calls this s
# The script checks the $ENV{'QUERY_STRING'} for the image name.
# If the image name is not in the form /([a-zA-z])(\d+)\.($types)/,
# the script exits and a broken image link will result, letting the de
# know that there's a typo in the image format.
# If the image is in the proper form, the script queries the appropria
# database to see if the image is there.  If it is, the image is serve
# If it is not, the appropriate noImage path is pulled from %catData 
# and this image is served instead, letting the developer know that th
# image format is correct, but an image probably needs to be added to
# the database.

my ($imageType, $imageID, $types, $extension, $table, $field, $noImage
+, $image,
    %mimeType,  %catData);

# Keys should mirror extensions and values should be the proper MIME t
# Currently, we only use gifs and jpegs.

%mimeType = (jpg  => 'jpeg',
             gif  => 'gif');

# This creates an extension alternation to be used in a regex

$types = join '|', keys %mimeType;

# The catData hash fields are as follows:
# primary key -- This corresponds to $imageType
# database    -- Database image is in
# table       -- Table in database
# field       -- field in table where image is stored
# noImage     -- Path to image to display if no image found in databas
# mimetype    -- If an explicit mime type is not listed, this represen
#                the fieldname in table that the mime type is stored i
#                This probably will not be used, but is included on th
#                off chance that this is necessary in the future.
# Thus, if in our UFMCatalog database, in table _5, we have an image w
#  an ID of 4392, a proper request for it might be:
# <img src="/images/category4392.jpg" height=215 width=131 alt="Some i

%catData = (category     =>
                        {database => 'UFMCatalog',
                         table    => '_5',
                         field    => 'image',
                         noImage  => '../images/no-image-long.jpg',
                         mimetype => 'jpeg'},
            productLarge =>
                        {database => 'UFMCatalog',
                         table    => '_4',
                         field    => 'largeImage',
                         noImage  => '../images/no-image-big.jpg',
                         mimetype => 'jpeg'},
            productSmall =>
                        {database => 'UFMCatalog',
                         table    => '_4',
                         field    => 'smallImage',
                         noImage  => '../images/no-image-small.jpg',
                         mimetype => 'jpeg'},
            logo         =>
                        {database => 'ECinterface',
                         table    => 'logo',
                         field    => 'logo',
                         noImage  => '../images/1xshim.gif',
                         mimetype => 'format'}

$ENV{'QUERY_STRING'} =~ m!([a-zA-Z]+)(\d+)\.($types)$!;

# Creates a "broken image" if the form of the image request is wrong

$imageType = defined $1 ? $1 : exit;
$imageID   = defined $2 ? $2 : exit;
$extension = defined $3 ? $3 : exit;

# Creates a "broken image" if $imageType is not in %catData

if (! exists $catData{$imageType}{field} ) {

$image = getImage();
$image = getNoImage() if ! defined $image;

print "Content-type: image/$mimeType{$extension}\n\n";
print $image;

sub getImage {
    my $image;
    my $dbh = DBI->connect("dbi:ODBC:ourdb", 'ourdb', 'youwish', 
                {RaiseError => 1}) or die DBI->errstr;

    $dbh->{LongReadLen} = 200000;
    $dbh->{LongTruncOk} = 1;

    my $sql =     "SELECT $catData{$imageType}{field} " .
                "FROM $catData{$imageType}{database}..$catData{$imageT
+ype}{table} " . 
                "WHERE id = $imageID";

    my $sth = $dbh->prepare($sql);

    $image = $sth->fetchrow_array();

    return $image;

sub getNoImage {
    my ($chunk, $image);

    open IMAGEFILE, "<$catData{$imageType}{noImage}" 
        or die "Cannot open $catData{$imageType}{noImage}: $!\n";
    binmode IMAGEFILE;
    while (read(IMAGEFILE, $chunk, 1024)) {
        $image .= $chunk; 
    close IMAGEFILE;
    # Since we're not getting the image we expected, reset the extensi
+on to 
    # the noImage extension to guarantee the correct MIME type is sent
    $catData{$imageType}{noImage} =~ /\.(\w+)$/;
    $extension = $1;
    return $image;