Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

shrink.pl - Scales down images

by Vortacist (Pilgrim)
on Jan 21, 2001 at 23:28 UTC ( #53367=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info Vortacist
Description: This is my first major perlscript (with help from Falkkin)--it scales down the size of images in a specified directory and all of its subdirectories. This is not a compression algorithm--it simply resizes the images based on command-line options. The user may specify size (as "xx%" or a number of pixels), starting directory, and which types of image files to resize. The user is required to specify a size; if none is given, the online help message is printed. Please see this message for more info.

I tend to do a lot of image-resizing for CD-ROM scrapbooks and thumbnails and thought other people might find this script useful for similar tasks.

I would appreciate any suggestions on how to make this script more efficient, and I'd also like to know if the help text is clear enough. Thanks!

Update: Changed code as per merlyn's suggestion below, with one slight difference (see my reply).

#!/usr/bin/perl -w
use strict;
use Image::Magick;
use File::Find;
use Getopt::Long;

# Declares defaults
my($size, $dir, $exts, $is_percent, $help) = 
    ("foo", './', "bmp gif jpg jpeg mng pcd pcx png tga tiff xpm", 0, 
+0);

# Changes defaults if specified on command line
GetOptions ('size=s' => \$size, 'directory=s' => \$dir,
        'extensions=s' => \$exts, 'help' => \$help);

# Gives help if indicated
help() if $help || $size eq "foo";

# Creates a hash of valid image extensions
my(@exts) = split(" ", $exts);
my(%exts);
foreach (@exts) {
    $_ = lc;
    $exts{$_} = 1;
}

# Formats the $size as the max dimension for the shrink()
# subroutine later, unless it was given as a percentage.
$size = "${size}x$size" unless $size =~ /%$/;

# Recurses, starting from within the current directory, 
# and shrinks every valid pic it can find
find (\&get_img, $dir);

# Displays help
sub help {
  print <<DONE;

Usage: shrink.pl -s <SIZE> [OPTIONS]
Scales down image files in a directory and all of its subdirectories.

Required parameter is:
-s, --size        May be given as a percentage or as a number of pixel
+s.
                  If a percentage is given, the image will be scaled t
+o 
                  that percentage. If a number is given, the image wil
+l be
                  scaled so that its largest dimension (height or widt
+h)
                  is not greater than the given number in pixels.

Valid options are:
-d, --directory   Directory to begin looking for files in.  Defaults t
+o: ./
-e, --extensions  Only shrink files that end with the given extensions
+.  
                  The list of extensions should be quoted, each extens
+ion 
                  separated by a space.  Valid extensions are all thos
+e file 
                  types supported by PerlMagick.  
                  Defaults to: "bmp gif jpg jpeg mng pcd pcx png tga t
+iff xpm"
-h, --help        Display this help message.

Examples:
shrink.pl -d ~/pics -s 400 -e "jpg gif"  
Shrinks all .jpg and .gif files in the ~/pics directory and its subdir
+ectories 
so that no image has a height or width greater than 400 pixels.

shrink.pl -s 40% -e "bmp"
Shrinks all .bmp files in the current directory and its subdirectories
+ to 40% 
of their original size.

DONE
    exit;
}

# If the current item is a file of a valid extension, shrinks it
sub get_img() {
    if (-f) {
    my($ext) = $_;
    $ext =~ s/.*\.(.+)/$1/;
    shrink($_) if $exts{$ext};
    }
}   

# Loads the given image and shrinks it to be within the given size or 
+percentage
sub shrink() {
    my($name) = shift;
    my($img) = new Image::Magick;
    print "I got to $name!\n";
    print $size;
    $img->Read($name);
    $img->Resize('geometry' => $size);
    $img->Write($name);
}

Comment on shrink.pl - Scales down images
Download Code
Re: shrink.pl - Scales down images
by merlyn (Sage) on Jan 22, 2001 at 00:59 UTC
    Boy, are you gonna be surprised to find out that you can replace most of your logic with...
    ... main code ... $size = "${size}x$size" unless $size =~ /%$/; ... sub shrink { my $name = shift; my $img = Image::Magick->new; $img->Read($name); $img->Mogrify('geometry' => $size); $img->Write($name); }
    And then let $size be either "50%" or "72" at the top there. The former will make a half-size picture. The latter will make the largest image that fits into 72x72, while keeping the proportions, as all your code attempts to do.

    Yeah, the ImageMagick docs are a real pain to get into, but once you've got the good tricks, it's rather nice.

    -- Randal L. Schwartz, Perl hacker

      I appreciate the help, and have updated my code accordingly. I would like to mention, though, that I don't think you can use Mogrify in:

      $img->Mogrify('geometry' => $size);

      You have to use Resize in order to get it to work...or at least I did.

Re: shrink.pl - Scales down images
by strredwolf (Chaplain) on Jan 24, 2001 at 07:40 UTC
    I've found that normal Resize doesn't do "fuzzy" rescaling (aka cubic interpolation). However (as an example)...

    $src->Resize(geometry=>"720x720",filter=>"Cubic",blur=>.5);

    helps out image quality, even with thumbnails.

    --
    $Stalag99{"URL"}="http://stalag99.keenspace.com";

      I just recently stumbled across this script and it doesn't seem to be working for me.. Is this how i call the script?: shrink.pl -d My/Directory -s 120 Thanks ~Chuckles
        my cgi shrink image it is necessary to use javascript
        #!/usr/bin/perl -wT use strict; use Image::Magick; use CGI qw(:standard escapeHTML); use CGI::Carp qw(fatalsToBrowser); # Declares defaults my ( $dir,$file,$img) = ('/home/renelacroute/imagepublic',"",""); my $q = new CGI; my $r = param("r"); my $hauteur = param("hauteur"); my $largueur = param("largeur"); $file = random_file ($dir, '\\.(png|PNG||jpg|JPG|jpeg|JPEG|gif)$' ); print $q->header( -type => "image/png", -expires => "-1d" ); binmode STDOUT; $img = &shrink($file,$hauteur,$largueur); sub random_file { my( $dir,$mask ) = @_; my $i = 0; my ($file); local( *DIR); opendir DIR, $dir or die "Cannot open $dir: $!"; while ( defined ( $_ = readdir DIR ) ) { /$mask/o or next if defined $mask; rand ++$i < 1 and $file = $_; } closedir DIR; return "$dir/$file"; } # Load the given image ans shrinks it to be within the given size # or percentage sub shrink () { my($name,$hauteur,$largueur) = @_; my($img) = new Image::Magick; print "i got to $name!\n"; ## print $size; my $x = $img->Read($name); warn "$x" if $x; my $y = $img->Resize('width' => $hauteur , 'height' => $largueur ) +; warn "$y" if $y; my $z = $img->Write('png:-'); warn "$z" if $z; undef $img; }

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2014-08-21 03:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (127 votes), past polls