#! /usr/bin/perl
use warnings;
use strict;
use File::DosGlob();
use Image::Size();
use GD;
# --- Configuration ---
my $path = "images";          # where are the original images located
my $thumbnailPath = "thumbs"; # where to write the thumbnails
my $thumbnailWidth = 100;     # width of thumbnails
my $thumbnailQuality = 90;    # integer from 1 to 100
# --- Code ---
GD::Image->trueColor(1); # improves image quality: thx to Perli from www.perl.de
# loop over all files in directory
for my $filename (&File::DosGlob::glob("$path/*.*")) {
    # get thumbnail height and width and heigth of original image
    my ($thumbnailHeight, $width, $height) =
        &GetImageSize($filename, $thumbnailWidth)
    or next;

    # extract filetype and convert it to lowercase
    my ($ending) = $filename =~ /\.([^.]+?)$/; 
    $ending = lc($ending);
  
    # build target filename
    my $targetFilename = $filename;
    $targetFilename =~ s/\Q$path\E/$thumbnailPath/g;
  
    # do some debugging output
    print "$filename: ${width}x$height\t";
    print "=> $targetFilename: ${thumbnailWidth}x$thumbnailHeight\n";
    my $image; # try to read image
    if ($ending eq 'jpg' or $ending eq 'jpeg') {
        $image = GD::Image->newFromJpeg($filename);
    }
    elsif ($ending eq 'png') {
        $image = GD::Image->newFromPng($filename);
    }
    # check if reading was successful
    $image or warn ("Error: couldn't read $filename as $ending: $!\n"), next;
    # create thumbnail
    my $thumbnail = GD::Image->new($thumbnailWidth, $thumbnailHeight);
    $thumbnail->copyResized( $image, 0,0, 0,0,
                             $thumbnailWidth, $thumbnailHeight,
                             $width, $height,
                            );

    # open outfile
    open (OUT, ">$targetFilename") or
        warn("Error: couldn't create '$targetFilename': $!\n"), next;
        binmode (OUT);
    # write image to file
    if ($ending eq 'jpg' or $ending eq 'jpeg') {
        print OUT $thumbnail->jpeg($thumbnailQuality);
    }
    elsif ($ending eq 'png') {
        print OUT $thumbnail->png();
    }
    # close file and do error checking (e.g. disk full?)
    close (OUT) or warn "Error: couldn't write to file '$targetFilename': $!\n";
 
 } # for
# ------------------------------------------------------------
sub GetImageSize {
    my ($filename, $thumbnailWidth) = @_;
    my (@size) = &Image::Size::attr_imgsize($filename);
    unless ( $size[1] and $size[3]) {
        warn "Error: couldn't get imagesize of $filename\n";
        return ();
    } # unless
    my $thumbnailHeight = int $thumbnailWidth * $size[3] / $size[1];
    return ($thumbnailHeight, @size[1,3]);
} # GetImageSize
# ------------------------------------------------------------