01: #! /usr/bin/perl
02: use warnings;
03: use strict;
04: use File::DosGlob();
05: use Image::Size();
06: use GD;
07: # --- Configuration ---
08: my $path = "images";          # where are the original images located
09: my $thumbnailPath = "thumbs"; # where to write the thumbnails
10: my $thumbnailWidth = 100;     # width of thumbnails
11: my $thumbnailQuality = 90;    # integer from 1 to 100
12: # --- Code ---
13: GD::Image->trueColor(1); # improves image quality: thx to Perli from www.perl.de
14: # loop over all files in directory
15: for my $filename (&File::DosGlob::glob("$path/*.*")) {
16:     # get thumbnail height and width and heigth of original image
17:     my ($thumbnailHeight, $width, $height) =
18:         &GetImageSize($filename, $thumbnailWidth)
19:     or next;
20: 
21:     # extract filetype and convert it to lowercase
22:     my ($ending) = $filename =~ /\.([^.]+?)$/; 
23:     $ending = lc($ending);
24:   
25:     # build target filename
26:     my $targetFilename = $filename;
27:     $targetFilename =~ s/\Q$path\E/$thumbnailPath/g;
28:   
29:     # do some debugging output
30:     print "$filename: ${width}x$height\t";
31:     print "=> $targetFilename: ${thumbnailWidth}x$thumbnailHeight\n";
32:     my $image; # try to read image
33:     if ($ending eq 'jpg' or $ending eq 'jpeg') {
34:         $image = GD::Image->newFromJpeg($filename);
35:     }
36:     elsif ($ending eq 'png') {
37:         $image = GD::Image->newFromPng($filename);
38:     }
39:     # check if reading was successful
40:     $image or warn ("Error: couldn't read $filename as $ending: $!\n"), next;
41:     # create thumbnail
42:     my $thumbnail = GD::Image->new($thumbnailWidth, $thumbnailHeight);
43:     $thumbnail->copyResized( $image, 0,0, 0,0,
44:                              $thumbnailWidth, $thumbnailHeight,
45:                              $width, $height,
46:                             );
47: 
48:     # open outfile
49:     open (OUT, ">$targetFilename") or
50:         warn("Error: couldn't create '$targetFilename': $!\n"), next;
51:         binmode (OUT);
52:     # write image to file
53:     if ($ending eq 'jpg' or $ending eq 'jpeg') {
54:         print OUT $thumbnail->jpeg($thumbnailQuality);
55:     }
56:     elsif ($ending eq 'png') {
57:         print OUT $thumbnail->png();
58:     }
59:     # close file and do error checking (e.g. disk full?)
60:     close (OUT) or warn "Error: couldn't write to file '$targetFilename': $!\n";
61:  
62:  } # for
63: # ------------------------------------------------------------
64: sub GetImageSize {
65:     my ($filename, $thumbnailWidth) = @_;
66:     my (@size) = &Image::Size::attr_imgsize($filename);
67:     unless ( $size[1] and $size[3]) {
68:         warn "Error: couldn't get imagesize of $filename\n";
69:         return ();
70:     } # unless
71:     my $thumbnailHeight = int $thumbnailWidth * $size[3] / $size[1];
72:     return ($thumbnailHeight, @size[1,3]);
73: } # GetImageSize
74: # ------------------------------------------------------------