Main »

Thumbn

#!/usr/bin/perl -WT

# crawls down dir tree and generates thumbs/ dirs then generates and saves thumbnails to the thumbs/ dir.
# usage:
#    ls -1 *.JPG | xargs -i{} ./thumbn.pl {}
#    dir ./thumb must already created.
#
#   OR
#   find pics/ \( -iname *.jpg -o -iname *.jpeg -o -iname *.png -o -iname *.gif -o -iname *.tif -o -iname *.tiff \) -exec ./thumbn.pl {} \;
#
#   to remove all the 'thumbs' directories:
#       find pics/ -type d -name thumbs -exec rm -rf {} \;

use strict;
use warnings;
use Image::Magick;
use File::Spec::Functions qw(splitpath);

my $thumbX = 75;
my $thumbY = 50;

my $filename = shift;
my ($drive, $dir, $file) = splitpath ($filename);
if( $dir =~ /thumbs\/*$/ ){exit;}
print "  dir=$dir,   file=$file\n";
genDir($dir);
$file =~ s/(\..*?)$/_thumb$1/;
if($1 !~ /\.(gif|png|jpg|jpeg|tif|tiff)/i){exit;}

my $image = Image::Magick->new ();
$image->ReadImage ($filename);
my ($height, $width) = $image->Get ('height', 'width');
my ($x, $y) = $height < $width ? ($thumbX, $thumbY) : ($thumbY, $thumbX);

$image->Thumbnail (width=>$x, height=>$y);
$image->Write ("$dir/thumbs/$file");

sub genDir {
    my($dir) = @_;
    if(!-e "$dir/thumbs"){mkdir "$dir/thumbs";}
} # end sub genDir.


top level subjects:

Page last modified on December 26, 2009, at 07:04 PM

^