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);
}
|
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 | [reply] [d/l] |
|
| [reply] [d/l] |
|
| [reply] |
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";
| [reply] [d/l] |
|
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
| [reply] |
|
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;
}
| [reply] [d/l] |
|
|