Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
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 examining the Monastery: (9)
As of 2014-07-11 04:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    When choosing user names for websites, I prefer to use:








    Results (218 votes), past polls