Here is another Perl implementation, this time using the GD module. I have to say that this is quite slow, at least for my purposes. This runs on Windows and Linux.
In this code I call a number of support routines, but I
think it is clear what they do and so I leave replacement
as an exercise for the reader.
sub thumbnail
{
my($dir,$src_name) = @_;
my($target_width,$target_height,$minratio);
# You will have to fetch suitable parameters here
# in my software Attribute::get() assigns a value
# to the passed variable. You could have (for example)
#
# $target_width = 100;
Attribute::get("$dir/$src_name","thumb_file_width",
\$target_width,1);
Attribute::get("$dir/$src_name","thumb_file_height",
\$target_height,1);
Attribute::get("$dir/$src_name","thumb_file_minratio",
\$minratio,1);
$minratio = 9 if(!defined $minratio || $minratio < 1);
my($x_scale,$y_scale);
my $gd = GD::Image->new("$dir/$src_name");
if(!defined $gd)
{
# Again a magic routine, you could replace
# with carp()
::add_output("Failed to read image data from $dir/$src_name");
return undef;
}
my($src_width,$src_height) = $gd->getBounds();
if(!defined $target_width && !defined $target_height)
{
::add_output("Resizize must define either width or height");
return undef;
}
$target_width = int($src_width*$target_height/$src_height)
if(!defined $target_width || $target_width <= 0);
$target_height = int($src_height*$target_width/$src_width)
if(!defined $target_height || $target_height <= 0);
if($target_width <= 0 || $target_width >= 16000 ||
$target_height <= 0 || $target_height >= 16000)
{
::add_output("Cannot resize image to $target_width x $target_h
+eight");
return undef;
}
if((($src_width*$src_height)/($target_width*$target_height)) < $mi
+nratio)
{
# The thumbnail image does not save enough space to be worth c
+reating
return undef;
}
my $new_gd = GD::Image->new($target_width,
$target_height);
$new_gd->copyResampled($gd,0,0,0,0,
$target_width,$target_height,
$src_width,$src_height);
# Now lets save it
# I should keep a track of all the thumbnails
# and allocate new entries
# in order, but for the moment I will be a bit cruder
my $target_filename = GenName::obtain("$dir/$src_name",
"thumb",$dir);
return undef
if(!defined $target_filename);
if(default_type() eq "gif")
{
my $fh = IO::File->new(">$dir/$target_filename");
binmode $fh;
print $fh $new_gd->gif();
$fh->close();
}
else
{
::add_output("Cannot yet produce thumbnail in ".
default_type()." format\n");
return undef;
}
# We succeeded
FileCounts::inc('thumb');
::set_hidden("$dir/$target_filename")
if($::hide_wfolio);
return $target_filename;
}