Perl script to reduce image dimensions

Posted:

Because I always seem to be rewriting this, I now post a copy of a script I used to reduce image sizes. It uses Image Magick to scale images to either a half or a quarter of their original size.

#!/usr/bin/perl -- -*-cperl-*-
#
# For a given image file, reduce the size by 50% or 25%
#
use strict;
use Image::Magick;
use Getopt::Std;

my $infile = pop @ARGV;
unless (-e $infile) {
  print usage();
  exit 1;
}
my $Opts = {};
getopts('o:24', $Opts);

if (-e $Opts->{'o'}) {
  print("'$Opts->{o}' already exists.  Overwrite?[y/N]\n");
  my $a = readline();
  if ($a !~ /y/i) {
    print("Halting.\n");
    exit;
  }
}

# always reduce image
my $factor = ($Opts->{'4'} ? 0.25 : 0.5);

my $I = Image::Magick->new();
$I->Read($infile);
my $height = $I->Get('height');
my $width = $I->Get('width');
my $err = $I->Resize(height => $height * $factor,
                     width => $width * $factor,);

if ($Opts->{'o'}) {
  $I->Write($Opts->{'o'});
} else {
  # Spew to STDOUT (from the Image::Magick website)
  my @pixels = $I->GetPixels(map=>'I',
                             height=>$height * $factor,
                             width =>$width * $factor,
                             normalize=>1,);
  binmode(STDOUT); # for win32
  print pack('B*', join('', @pixels));
}


sub usage {
  return qq[$0 - reduce an image size
$0 [OPTS] [FILENAME]

-o [FILE] Output file name
-2 Reduce image dimensions by half
-4 Reduce image dimensions by a fourth
];
}