Il suffit de lancer ce script depuis le répertoire gal de SPGM.

S'il y a besoin de modifier les paramètres de configuration pour un répertoire donné et ses sous-répertoires, il est possible de le faire dans un fichier appelé .conf dans le répertoire en question (voir tout en bas). Ça ne fonctionne que pour des scalaires, pas pour des tableaux; donc c'est pas possible de modifier les différentes tailles, par exemple... sauf si quelqu'un me file un patch :-p.

create_thb.pl

#! /usr/bin/perl
#
# by Julien Wajsberg <flash@minet.net>
#
# January 2005
# GPLv2

use strict;
use warnings;

use Image::Magick;
use Image::EXIF;
use File::Find ();

#### conf ####

my $default_conf = {
	thumbnail_prefix =>  "_thb_",
	internal_pattern => qr/^_/,
	thumbnail_geometry_landscape => "160x120",
	thumbnail_geometry_portrait => "160x120",
	resizes_landscape =>  qw/800x600 1024x768/ ,
	resizes_portrait =>  qw/600x800 768x1024/ ,
	quality => 80,
};

my $conf_filename = ".conf";

my $conf = $default_conf;

##############

my @transprogram = qw/exiftran -ai/;

$| = 1;
my $image = new Image::Magick;

# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name   = *File::Find::name;
*dir    = *File::Find::dir;
*prune  = *File::Find::prune;

sub wanted;

File::Find::find({
	wanted => \&wanted,
	preprocess => \&preprocess,
	postprocess => \&postprocess,
	}, '.');
exit;

##############################
#
# "wanted" function for "find"
# 
sub wanted {
    doaction($_) unless -d;
}

###############################
#
# "preprocess" function for "find"
#
sub preprocess {
	print "*** Entering $File::Find::dir\n";

	# read config file for this directory
	if (-r $conf_filename) {
		open CONF, $conf_filename;
		while (<CONF>) {
			my ($key, $value) = /^\s*(\w+)\s*=\s*(\w+)$/;
			next unless $key and $value;
			$conf->{$key} = $value;
		}
		close CONF;
	}

	my @entries;

	while ($_ = shift) {
		next if /$conf->{internal_pattern}/;
		push @entries, $_ if /^.*\.jpg\z/is;
		push @entries, $_ if -d;
	}

	return @entries;
}

###############################
#
# "postprocess" function for "find"
#
sub postprocess {
	# reset conf
	$conf = $default_conf;
}

###################################
#
# this function is called by wanted
# 
# 1st arg : shortname of the file
# 
sub doaction($) {
	my $shortname = shift;
	my $x;
	my $thumbnail = $conf->{thumbnail_prefix} . $shortname;
	my $resizes;
	my $thumbnail_geometry;

	print $shortname, " :\n";

	# rotating if necessary
	if (need_rotation($shortname)) {
		print "  rotating";
		$x = dorotate($shortname);
		if ($x) {
			warn " : $x" if $x;
			print "  -> something strange happened, let's skip this file !\n";
			return;
		}
		print ".\n";
	} else {
		print "  already correctly oriented.\n";
	}

	# pinging the file, to get the dimensions
	my ($width, $height) = $image->Ping($shortname);

	# orientation : landscape or portrait
	if ($width < $height) {
		$resizes = $conf->{resizes_portrait};
		$thumbnail_geometry = $conf->{thumbnail_geometry_portrait};
	} else {
		$resizes = $conf->{resizes_landscape};
		$thumbnail_geometry = $conf->{thumbnail_geometry_landscape};
	}

	if (all_resizes_done($shortname, $resizes)) {
		print "  nothing left to do.\n";
		return;
	}
	
	# reading the file
	print "  reading";
	$x = $image->Read($shortname);
	if (defined $x and "$x") {
		warn " : $x";
		print "  -> something strange happened, let's skip this file !\n";
		return;
	}
	print ".\n";

	# thumbnail generation
	my $clone = $image->Clone();
	if (! ref $clone) {
		warn " : $clone";
		print "  -> something strange happened, let's skip this file !\n";
		return;
	}

	print '  thumbnail : resizing to ', $thumbnail_geometry;
	$x = doresize($clone, $thumbnail_geometry, $thumbnail);
	if (defined $x and "$x") {
		warn " : $x";
		print "  -> something strange happened, let's skip this file !\n";
		return;
	}
	
	# various geometries generations
	foreach my $geometry (@$resizes) {
		my $clone = $image->Clone();
		my $outputfile = '_' . $geometry . '_' . $shortname;
		print "  resizing to $geometry";

		$x = doresize($clone, $geometry, $outputfile);
		if (defined $x and "$x") {
			warn " : $x";
			print "  -> something strange happened, let's skip this file !\n";
			return;
		}
	}

	@$image = ();
}

#############################################
#
# resizes an image
# 
# 1st arg : imagemagick object
# 2nd arg : destination geometry
# 3rd arg : name of the file to write
# returns an error string if an error happens
# 
sub doresize($$$) {
	my ($image, $geometry, $outputfile) = @_;
	
	do { print " -> $outputfile already exists.\n"; return; } if (-f $outputfile);
	my ($destwidth, $destheight) = split /x/, $geometry;
	do { print " -> original image too small.\n"; return; }
		unless ($image->Get('width') > $destwidth or $image->Get('height') > $destheight);

	my $x = $image->Resize(geometry => $geometry);
	return "$x" if (defined $x and "$x");

	print ", writing file $outputfile";
	$x = $image->Write(filename => $outputfile, quality => $conf->{quality});
	return "$x" if (defined $x and "$x");
	print ".\n";
	return;
}

#################################################
#
# losslessly rotates an image using @transprogram
# 
# 1st arg : image filename
# 
sub dorotate($) {
	my $filename = shift;

	system "@transprogram $filename 1> /dev/null 2>&1";
	
	if ($? == -1) {
		return "failed to execute: $!";
	} elsif ($? & 127) {
		return sprintf ("child died with signal %d, %s coredump\n",
			   ($? & 127),  ($? & 128) ? 'with' : 'without');
	} else {
		my $value = $? >> 8;
		return "child exited with value $value" if ($value);
	}
	return;
}

#################################################
#
# looks for already existing resized files
#
# 1st arg : image filename
# 2nd arg : resizes array
#
sub all_resizes_done ($$) {
	my ($name, $resizes) = @_;

	# looking for the thumbnail
	my $thumbnail = $conf->{thumbnail_prefix} . $name;
	return 0 if ( ! -f $thumbnail);

	# looking for other versions
	foreach my $geometry (@$resizes) {
		my $version = '_' . $geometry . '_' . $name;
		return 0 if ( ! -f $version);
	}

	return 1;
}

#################################################
#
# returns true if the filename need to be rotated
#
# 1st arg : image filename
#
sub need_rotation ($) {
	my $filename = shift;
	my $exif = new Image::EXIF($filename);
	
	my $info = $exif->get_image_info();
	return 0 if  or ($info->{'Image Orientation'} eq 'Top, Left-Hand'));
	return 1;
}

Exemple de fichier .conf utilisé pour La Sélection

thumbnail_geometry_portrait = 384x512
thumbnail_geometry_landscape = 640x480
quality = 90