JPG Scaler Cropper CGI for the web

PerlMagick is an object-oriented Perl interface to ImageMagick. Use this forum to discuss, make suggestions about, or report bugs concerning PerlMagick.
Post Reply
mcm1303

JPG Scaler Cropper CGI for the web

Post by mcm1303 »

I wrote a CGI-based nifty scaler and cropper in perl. It takes a single file as input and conforms it one or more sizes by scaling up or down and cropping as needed so that the final output images are cropped from the center.

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
What the above URL does is takes corporative_1.jpg and scale/crops it 4 times with 4 different sizes. Each image is explicitly named.

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";
}

Post Reply