Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Generate small .jpeg file thumbnails using Image Magick

by GrandFather (Saint)
on Sep 27, 2005 at 11:27 UTC ( #495333=snippet: print w/replies, xml ) Need Help??
Description: This script uses the Thumbnail function provided by Image Magick's PerlMagick API to generate 4K thumbnail files. Thumbnail strips various "extra" information out of the image to reduce the file size from about 10K.
use strict;
use warnings;
use Image::Magick;
use File::Spec::Functions qw(splitpath);

my $thumbX = 100;
my $thumbY = 66;

my $filename = shift;
my $image = Image::Magick->new ();
$image->ReadImage ($filename);

my ($height, $width) = $image->Get ('height', 'width');
my ($x, $y) = $height < $width ? ($thumbX, $thumbY) : ($thumbY, $thumb
+X);
my ($drive, $dir, $file) = splitpath ($filename);
$file =~ s/(\..*?)$/_s$1/;

$image->Thumbnail (width=>$x, height=>$y);
$image->Write ("$drive${dir}$file");
Replies are listed 'Best First'.
Re: Generate small .jpeg file thumbnails using Image Magick
by b10m (Vicar) on Sep 28, 2005 at 11:04 UTC

    ... or just use any of the many, many Thumbnail modules on CPAN ...

    --
    b10m

    All code is usually tested, but rarely trusted.

      In true snippet fashion this trivial chunk of code represents something that took about three days to resolve with a lot of discussion in the CB. The bottom line is that by changing a ->Resize to a ->Thumbnail in this code I get much smaller files. The Image Magick docs do not lead you by the hand to discover this sort of thing!


      Perl is Huffman encoded by design.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://495333]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (1)
As of 2021-10-20 00:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (78 votes). Check out past polls.

    Notices?