I Initially started posting this because there was a bug that I couldn't seem to solve and I thought it was related to PerlMagick, but it was my own coding that was the culprit. Since I've gone to the trouble I thought I'd contribute it for others to use.
Here's how the CGI would be called if you wanted to generate four scaled images from one master:
Code: Select all
http://www.MyServer.net/scaleCropNImages.pl?nImages=4&sourceDir=portal_sch&destDir=portal_sch&sourceFile=corporative_1.jpg&destFile2=LG_20_1567.jpg&finalSizeX2=368&finalSizeY2=294&destFile3=MD_20_1567.jpg&finalSizeX3=183&finalSizeY3=148&destFile4=SM_20_1567.jpg&finalSizeX4=119&finalSizeY4=88&destFile1=TN_20_1567.jpg&finalSizeX1=71&finalSizeY1=71
The code below runs on IIS 6 and ActiveState Perl 5.8.4. You may or may not need line 9 depending on what HTTP server you run this in. Also, I don't normally call this directly, instead I call it via JavaScript Ajax as part of a Content Management System I'm writing. Note that there is a destination directory hard-coded in the code. I didn't write this for general consumption so you'll have to edit lines 16 and 17 plus lines 23 and 24 which specify the source/destination directories if you want to tailor it to your own installation.
Here's the code:
Code: Select all
use Image::Magick;
use CGI;
use CGI::Carp 'fatalsToBrowser';
my ($image, $result);
my ($nImages, $finalSizeX, $finalSizeY, $sourceFile, $destFile, $realSourceDir, $realDestDir);
my $query = new CGI;
print "Content-type: text/html\n\n";
my $sourceFile = $query->param('sourceFile');
my $nImages = $query->param('nImages');
my $sourceDir = $query->param('sourceDir');
my $realSourceDir;
my ($width, $height);
if ($sourceDir eq "portal_sch") {
$realSourceDir = 'C:\\inetpub\\wwwroot\\sch_net\\hotelImg\\';
} else { # For security sake, we strictly control the directory that can be read from. If it's not recognized, it comes from temp
$realSourceDir = 'C:\\temp\\';
}
my $destDir = $query->param("destDir");
my $realDestDir;
if ($destDir eq "portal_sch") {
$realDestDir = 'C:\\inetpub\\wwwroot\\sch_net\\hotelImg\\';
} else { # For security sake, we strictly control the directory that can be written to. If it's not recognized, it goes to temp.
$readDestDir = 'C:\\temp\\';
}
# First check for existence of file
if (-e $realSourceDir . $sourceFile) {
for ($img=0;$img<$nImages;$img++) {
$image = new Image::Magick;
$result = $image->Read(filename=>$realSourceDir . $sourceFile);
warn "$result" if "$result";
$width = $image->Get('columns');
$height = $image->Get('rows');
my $ii = $img+1;
my $finalSizeX = $query->param('finalSizeX' . $ii); # Can't be zero or less
my $finalSizeY = $query->param('finalSizeY' . $ii); # Can't be less than zero
my $destFile = $query->param('destFile' . $ii);
print "SourceFile=$realSourceDir$sourceFile, width = $width, height = $height\n";
print "<br>DestFile=$realDestDir$destFile\n";
warn "$result" if "$result";
my ($scaleCoef, $scale, $cropType);
print "<br><br>finalSizeX=$finalSizeX, finalSizeY=$finalSizeY, DestFile=$readDestDir$destFile\n";
$scaleCoef = ($width * $finalSizeY) / $finalSizeX;
if ($scaleCoef > $height) {
#Original is cropped, with vertical lines (left and right sides are lopped off). Also scale is based on yf/yo.
if ($height != 0) {
$scale = $finalSizeY/$height;
} else {
$scale = 1;
}
$cropType = "Y";
} else {
#Orignal is cropped with horizontal lines (top and bottom sections are lopped off). Also scale is based on xf/xo.
if ($width != 0) {
$scale = $finalSizeX/$width;
} else {
$scale = 1;
}
$cropType = "X";
}
my ($newWidth, $newHeight, $theCrop);
$newWidth = int($width*$scale);
$newHeight = int($height*$scale);
$image->Resize(width=>int($width*$scale), height=>int($height*$scale));
if ($cropType eq "Y") {
$theCrop = $finalSizeX . "x" . $finalSizeY . "+" . int(($newWidth - $finalSizeX) / 2) . "+0";
print "TheCrop=" . $theCrop;
} else {
$theCrop = $finalSizeX . "x" . $finalSizeY . "+0+" . int(($newHeight - $finalSizeY) / 2);
print "TheCrop=" . $theCrop;
}
$image->Mogrify('crop', $theCrop . "!");
$image->Set(page=>'+0+0');
$result = $image->Write($realDestDir . $destFile);
warn "$result" if "$result";
}
} else {
print "File not found, scaling cropping failed.<br>\n";
warn "File not found";
}