Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Image Server - Multi-functional

by Coruscate (Sexton)
on Feb 12, 2003 at 09:50 UTC ( #234633=sourcecode: print w/replies, xml ) Need Help??
Category: CGI Programming
Author/Contact Info /msg Coruscate
Description:

A script that allows you to serve images to html pages based on catagory. A catagory simply consists of one or more directories which contain related images. The two required parameters to the script are 'm' and 'c'. 'm' is the method of invocation, 'c' is the catagory. The script currently supports 3 methods of invocation:

  • script.pl?m=random&c=catagory: Serve a random image from the catagory specified by 'c'.

  • script.pl?m=rotate&c=catagory: Serve the next image within the rotation cycle of the specified catagory. Each image will be shown once before the cycle is restarted. Guarantees that all images get shown in equal proportions.

  • script.pl?m=image&c=catagory/filename: Allows you to point to a specific image within a catagory. Filename excludes the extension of the image file. So 'c=cars/toyota' will look for the first file within the 'cars' catagory that has the filename 'toyota.gif', 'toyota.jpg', 'toyota.jpeg', or 'toyota.png'.

Notes: To add an image to a page, simply use <img src="/cgi-bin/image.pl?m=random&c=all"> (replacing the arguments with your own). Catagory 'all' is added by default and consists of all the catagories. This allows you to display a random or image from all catagories, as well as rotating through the entire collection.

Caveats: The 'image' method of invocation will show the first image that it finds with the filename supplied. So if catagory 'cars' points to directories '/var/www/images/cars' and '/var/www/images/vehicles' and both of these directories contain a 'toyota.jpg' (perhaps these are two different images), there is currently no way to specify which image you want to show. You have to do 'c=cars/toyota', and the script will display the first one it finds.

Todo list: Improve code (if possible?), allow specific pointing to any image within a catagory (even if they have the same name) with the 'image' method of invocation (see 'Caveats' above for more info). Also, add File::Find to the mix to have catagories dive into all sub-directories of the specified directories. Last, make this help stuff into POD within the code to minimize this description :) I will be adding support for merlyn's suggestion (see below).

Updates:

  • Changed locking mechanism. Its removal will increase script performance, and its replacement with lock_store() and lock_retrieve will suffice for this script.

#!/usr/bin/perl -Tw
use strict;
use Storable qw/lock_store lock_retrieve/;
use CGI qw/:standard/;

#########################
# Begin Config

# File to store 'rotate' data in.
# CGI instance must have read/write access
my $data_file = '/var/www/images.dat';

# Image to show if there's an error
# ie: "Error", "404 Not Found" image
my $err_img = '/var/www/images/err.jpg';

# Catagories for 'rotate' and 'random'
# Keys are the catagory names to pass as 'c' argument,
# arrays are the directories for that catagory.
my $cat = {
 'banners' =>
   ['/home/user/imgs/banners', '/home/user/imgs/banners2'],
 'logos'   =>
   ['/home/user/imgs/logos', '/home/user/imgs/logos2']
};

#########################
# End Config

# Automatically generate an 'all' catagory
@{$cat->{'all'}} = map{@{$cat->{$_}}}keys %{$cat};

# Rotate the image number for a catagory
sub rotate_img {
 my $q = shift;

 my @imgs = get_imgs(@{$cat->{$q}});
 my $data = -e $data_file ? lock_retrieve($data_file) : {};
 $data->{$q} = 0 if $data->{$q}++ == $#imgs;
 lock_store $data, $data_file;
 return $imgs[$data->{$q}];
}

# Get list of images from directories
sub get_imgs {
 sort grep {-f && /(?:\.gif|jpe?g|png)$/i }
  map{ glob("$_/*") } @_
}

# Output an image to the browser
sub show_img {
 my $img = shift;
 my ($mime) = $img =~ /\.(gif|jpe?g|png)$/;
 $mime = 'jpeg' if $mime eq 'jpg';
 open my $fh, '<', $img
  or die "Could not open $img for read: $!";
 binmode $fh;
 my $img_data = do { local $/; <$fh> };
 close $fh;
 print header('image/' . $mime), $img_data;
 exit;
}

my $m = param('m') || ''; # Mode
my $c = param('c') || ''; # Catagory

# Rotated image
if ($m eq 'rotate') {
 show_img( $cat->{$c} ? rotate_img($c) : $err_img );
}

# Random image
elsif ($m eq 'random') {
 show_img($err_img) unless $cat->{$c};
 my @imgs = get_imgs(@{$cat->{$c}});
 show_img($imgs[rand @imgs]);
}

# Specific Image
elsif ($m eq 'image') {
 ($m,$c) = split(/\//, $c, 2);
 show_img($err_img) unless
  $cat->{$m} && $c;
 for ( get_imgs(@{$cat->{$m}}) ) {
  show_img($_) if m#/\Q$c\E\.(?:gif|jpe?g|png)$#;
 }
 show_img($err_img);
}

# Invalid Call
else {
 show_img($err_img);
}
Replies are listed 'Best First'.
•Re: Image Server - Multi-functional
by merlyn (Sage) on Feb 12, 2003 at 12:33 UTC
    # Output an image to the browser sub show_img { my $img = shift; my ($mime) = $img =~ /\.(gif|jpe?g|png)$/; $mime = 'jpeg' if $mime eq 'jpg'; open my $fh, '<', $img or die "Could not open $img for read: $!"; binmode $fh; my $img_data = do { local $/; <$fh> }; close $fh; print header('image/' . $mime), $img_data; exit; }
    Rather than pump the image yourself, I'd put the images somewhere in your www-server space (an unlinked unannounced directory), and then use an internal redirect:
    print redirect("/some/webpath/to/selected/image.jpg");
    The advantages are many:
    • The server is better than you at pumping data.
    • The values of last-modified and if-modified-since will be respected, allowing the server to avoid sending the data if the browser already has the image cached.
    • You won't ever be able to accidentally access something outside the normal htdoc tree, even from bad programming or malicious hacking.
    • Your CGI process goes away quicker.
    • The code will be eight lines shorter. {grin}

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

Re: Image Server - Multi-functional
by shotgunefx (Parson) on Feb 12, 2003 at 21:37 UTC
    You could also wrap this in HTTP::Daemon to make a mini forking (or not) server. Depending on what it does and your apache config, it can be much smaller than apache and you avoid firing up the CGI process so it can be faster as well.

    -Lee

    "To be civilized is to deny one's nature."

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (8)
As of 2021-01-24 23:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?