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
