#!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
+cript
# 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
+veloper
# know that there's a typo in the image format.
#
# If the image is in the proper form, the script queries the appropria
+te
# database to see if the image is there.  If it is, the image is serve
+d.
#
# If it is not, the appropriate noImage path is pulled from %catData 
# and this image is served instead, letting the developer know that th
+e
# 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
+ype
# 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
+e
# mimetype    -- If an explicit mime type is not listed, this represen
+ts
#                the fieldname in table that the mime type is stored i
+n
#                This probably will not be used, but is included on th
+e
#                off chance that this is necessary in the future.
# Thus, if in our UFMCatalog database, in table _5, we have an image w
+ith
#  an ID of 4392, a proper request for it might be:
# <img src="/images/category4392.jpg" height=215 width=131 alt="Some i
+mage">

%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} ) {
    exit;
}

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

    $sth->execute;
    $image = $sth->fetchrow_array();
    $sth->finish();

    $dbh->disconnect;
    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;
}
[download]