package Apache::Thumbnail;
use Apache::Constants qw(:common);
use Image::Magick ();
use File::Path ();

use strict;

use vars qw($VERSION);

$VERSION = '0.5';

sub handler {
	my $r = shift;

	my $root = $r->document_root();
	my $dest = $r->dir_config('Thumbnail_Directory') || '/thumbnails';
	my $geom = $r->dir_config('Thumbnail_Geometry') || '100x100';
	my $img = $r->filename().$r->path_info();
	$img =~ s/^$root\/[^\/]+//;

	# get thumbnail name
	my $thumb = $img;

	# final filenames
	my $srcFile = "$root$img";
	my $destFile = "$root$dest$thumb";

	# already cached?
	if (-f $destFile and -r _) {
		if (-C _ < -C $srcFile) {
			$r->internal_redirect("$dest$thumb");
			return OK;
		}
	}
	
	# is source image there?
	if (-s "$srcFile") {
		# yes, create thumbnail
		my $e;
		my $i = new Image::Magick;
		# read source
		$e = $i->Read("$srcFile");
		if ($e) {
			$r->log_error("Couldn't read '$srcFile': $e");
			return SERVER_ERROR;
		}
		# scale it
		$e = $i->Scale(geometry => $geom);
		if ($e) {
			$r->log_error("Couldn't scale '$srcFile': $e");
			return SERVER_ERROR;
		}
		# check directory tree is in place...
		my $path = $destFile;
		$path =~ s/\/[^\/]+$//o;
		if (!-d $path) {
			File::Path::mkpath $path ||
				($r->log_error("Couldn't create directory '$path': $!") && return SERVER_ERROR);
		}
		# write thumbnail
		$e = $i->Write($destFile);
		if ($e) {
			$r->log_error("Couldn't write '$destFile': $e");
			return SERVER_ERROR;
		}
		# and send to browser
		$r->internal_redirect("$dest$thumb");
		return OK;
	}
	
	# couldn't find source image
	return NOT_FOUND;
}

1;

__END__

=head1 NAME

Apache::Thumbnail - Generate image thumbnails on the fly

=head1 SYNOPSIS

   # in httpd.conf or similar

   <Location /thumbs/>
      SetHandler perl-script
      PerlSetVar Thumbnail_Directory "/thumbnails"
      PerlSetVar Thumbnail_Geometry "100x100"
      PerlHandler Apache::Thumbnail
      order allow,deny
      allow from all
   </Location>

   <Location /smallpics/>
      SetHandler perl-script
      PerlSetVar Thumbnail_Directory "/smallpics/"
      PerlSetVar Thumbnail_Geometry "200x200"
      PerlHandler Apache::Thumbnail
      order allow,deny
      allow from all
   </Location>

=head1 DESCRIPTION

This module automatically generates thumbnail images on the fly, caching
them in the specified thumbnail directory in a tree structure matching
that of the source images.

To use, set up a C<<Location>> directive as above. For any image on the
web server, a corresponding thumbnail is available by prepending that
location to the path - eg.

 Image at /images/staff/john.jpg

 Thumbnail at /thumbs/images/staff/john.jpg

That's it! The first time a thumbnail is requested, it'll be generated
and cached; subsequent requests will return the cached image immediately.
If the source image is newer than the thumbnail, the thumbnail will
automatically be regenerated.

=head1 OPTIONS

=over 4

=item Thumbnail_Directory

The directory in which the finished thumbnails are cached, relative to the
webserver document root. If unspecified, the default is C</thumbnails>.

 PerlSetVar Thumbnail_Directory "/thumbnails"

=item Thumbnail_Geometry

The maximum size of the thumbnail images. The proportions always remain
unchanged - see C<Image::Magick::Scale()> for details. If unspecified,
the default is 100x100 pixels.

 PerlSetVar Thumbnail_Geometry "100x100"

=back 4

=head1 BUGS

Doesn't currently check if the source image is smaller than the thumbnail
size, so tiny images would look nasty scaled up. Could add this, but it'd
be slightly slower, and probably not all that useful?

Another other bugs or suggestions, let me know!

=head1 PREREQUISITES

=item *
mod_perl L<http://perl.apache.org/>

=item *
Image::Magick L<http://www.simplesystems.org/ImageMagick/>

=head1 AUTHOR

Rufus Cable ruf@rcable.co.uk

=cut