[Israel.pm] Creating image thumbnails

Mikhael Goikhman migo at homemail.com
Sun Apr 25 14:57:53 PDT 2004


On 25 Apr 2004 11:58:03 +0200, Ran Eilam wrote:
> 
> These are some questions for a friend who wants to create image
> thumbnails and is considering Perl:
> 
> 1) What is the best, simplest, module for doing this?

It just came to me that I once wrote a perl script that uses Gimp module
to scale jpg images and I sometimes use it instead of ImageMagick convert.

I attach this script, it has 13 command line options and may be used like:

  % reduce-image --scale 0.25 --savedir thumb *.jpg

I don't know the meaning of some options, but such options like
--addshadow, --quality and --smoothing should be obvious, see --help.

You don't need to explicitly start GIMP or any Perl-scripts server,
like Shlomi suggested, in order to run this script.

P.S. I sent a normal multipart/mixed message with one inline text/plain
part and one text/plain attachment, and it was refused by the mailing
list, so I post the perl script inline at the bottom of this message.
I don't think the mailing list should refuse plain text attachments.

Regards,
Mikhael.

-- 
perl -e 'print+chr(64+hex)for+split//,d9b815c07f9b8d1e'



# ---------------------------------------------------------------------------

#!/usr/bin/perl -w

# reduce-image - simple jpg image reducer, Copyright (C) 2003 Mikhael Goikhman
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
our @ARGV_ORIG;
BEGIN { @ARGV_ORIG = @ARGV; @ARGV = (); }

use Gimp;
use File::Basename;
Gimp::init;

my %o = (
	scale => 0.3,
	savedir => "../reduced",
	prefix => "",
	addshadow => 0,
	quality => 0.83,
	smoothing => 0,
	optimize => 1,
	progressive => 0,
	comment => "reduced by $ENV{USER}",
	subsmp => 0,
	baseline => 1,
	restart => 0,
	dst => 2,
);

@ARGV = @ARGV_ORIG;
while (@ARGV && $ARGV[0] =~ /^--(.*)$/) {
	shift;
	if ($1 eq "help" || $1 eq "info") {
		print "Usage $0 OPTIONS FILES|DIRS\n";
		print "\t--$_ ($o{$_})\n" foreach sort keys %o;
		exit(0);
	}
	if (exists $o{$1}) {
		$o{$1} = shift;
	} else {
		die "Unknown option --$1\n";
	}
}

$o{scale} /= 100 if $o{scale} >= 1;

while (@ARGV) {
	my $fileName = shift @ARGV;
	if (-d $fileName) {
		opendir(DIR, $fileName);
		my @files = grep {
			$_ ne "." and $_ ne ".." and $_ = "$fileName/$_"
		} readdir(DIR);
		unshift @ARGV, @files;
		next;
	}
	-r $fileName || die "Can't find readable $fileName\n";
	my ($name, $path) = fileparse($fileName);
	$path = "" if $path eq "./" || $o{savedir} =~ /^[\/\.]/;
	my $newDir = "$path$o{savedir}";
	-d $newDir || die "No directory $newDir to save image\n";
	my $newFileName = "$newDir/$o{prefix}$name";

	my $image = Gimp->file_jpeg_load($fileName, $fileName);
	$image->scale($image->width * $o{scale}, $image->height * $o{scale});
	my $layer = $image->get_active_layer();

	if ($o{addshadow}) {
		Gimp->plug_in_sharpen($image, $layer, 10);
		$layer = $image->get_active_layer();
		Gimp->script_fu_drop_shadow($image, $layer, 10, 10, 15, 'black', 80, 1);
		sleep(10);
		$image->merge_visible_layers(2);
		$layer = $image->get_active_layer();
		$image->flatten();
		$layer = $image->get_active_layer();
		#$image->add_layer($layer, 0);
	}

	Gimp->file_jpeg_save($image, $layer, $newFileName, $newFileName,
		$o{quality}, $o{smoothing}, $o{optimize},
		$o{progressive}, $o{comment}, $o{subsmp},
		$o{baseline}, $o{restart}, $o{dst});

	print "$fileName reduced to $newFileName\n";
}





More information about the Perl mailing list