Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Serving Images from Databases

by Ovid (Cardinal)
on Sep 23, 2000 at 00:51 UTC ( #33711=sourcecode: print w/ replies, xml ) Need Help??

Category: Web Stuff
Author/Contact Info ovid@easystreet.com
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
+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;
}

Comment on Serving Images from Databases
Download Code
Re: Serving Images from Databases
by Anonymous Monk on Apr 29, 2003 at 13:50 UTC
    Thanks so much for this code. Exactly what I was looking for!!

      Glad it's useful, though I have to confess that this code -- almost three years old -- is not something I would write today. Interesting how we evolve, eh?

      Cheers,
      Ovid

      New address of my CGI Course.
      Silence is Evil (feel free to copy and distribute widely - note copyright text)

        Ovid,

        I tried the code that you posted a while ago. I used it on a Win2k server and never had any problem. I switched onto Unix iPlanet and the code does not work anymore. The last line :

        print header(-type => 'image/gif', -Content_length => length $file), $file;

        causes the script to hang and never return... I am not too familiar with iPlanet ... can it be a problem with the web server ?

        Do you have any idea why ?

        ... use CGI qw(header path_info); my $file = getNoImage($SHOP); print header(-type => 'image/gif', -Content_length => length $file), $ +file; sub getNoImage { my $SHOP = shift || croak ("ProcessAction : Missing Shop data"); my ($chunk, $image); open IMAGEFILE, "$SHOP->{-TEMPLATE_PATH}/img/NoImage.gif" or die " +Cannot open $SHOP->{-TEMPLATE_PATH}/img/NoImage.gif: $!\n"; binmode IMAGEFILE; while (read(IMAGEFILE, $chunk, 1024)) { $image .= $chunk; } close IMAGEFILE; return $image; }

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://33711]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (6)
As of 2014-10-21 00:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (94 votes), past polls