in reply to Pure Perl - Crop and Resize Jpeg Files

Alright.
I've done this a million times. I've coded thumbnailers and auto image thingie doers a bunch. It can be a pain.

Using imagemagick is not so hard.

image magick and the gd library are probably already in that box you are developing for/in/to. Do you have a shell account ? try this sh1t3:

convert -blur 8 /this/is/my/image.jpg /this/is/my/ouput_image2.jpg

Did it work? Muhahhahahhahah! H311 Y3ah! Ah.. open source.. waddyagonna do... let it give you a lap dance for free- she's sooo good...

So, anyway.. convert is actually imagemagick. Imagemagick has all these diff interfaces to it, perlmagick is one of them, there's stuff for C, for python, etc. Interfaces. What we used up there was a command line interface, convert is mad good, you have got to look at what it can do.. it's INSANE.. if you are doing anything with images on a linux box, don't be shooting yourself in the foot and think that this stuff is *too complex* and yadda yadda.. It's not complex. It has *options*! To let you do what you want it to do! The options make sense. (Think about it, you are letting code mess with an image, this is not your regular search and replace regex). Later on when you use something lighter you'll be wishing the options were there.

Don't be lazy, here- have some coffee- on me. Drink up. If my stupid 455 could, you can do it too!

I'm going to put a 800 line little tiny app I wrote called indexgallery, it lets you maintain an image gallery- this is not release worthy, this is just a script!, but it works, and it's cool.- but before I do let me focus on what may most interes you, the sub that makes a thumbnail with image magick:

#example usage:
# make_thumbnail_IM('/home/me/i.jpg', '/home/me/i2.jpg', 80, 'square',
+ 90);
# will make a 80x80 thumbnail (cropped) quality 90 for picture home/me
+/i.jpg, and save it to /home/me/i2.jpg

sub make_thumbnail_IM{
    # receives:
    #     file source (absolute path on machine)
    #     file target out (absolute path on machine)
    #    restriction (pixels)
    #    restriction type
    #    quality    
    
    my ($src,$out,$restriction,$restrict_type,$quality)=@_;

    # both        restrict to height and width :both won't go over thi
+s.. 
    # width        restrict to width
    # height    restrict to height
    # square    square - will crop sides or top and bottom to fit. nea
+t.

    
    
    my $img = Image::Magick->new; #blank     

    $img->Read($src); #read source file into blank
    my ($w,$h) = $img->Get('width','height'); # find dimensions

    #    #    #

    #if width is bigger then height, we use restrict to w
    if ($restrict_type eq 'both'){    
        if ($w>$h){
            $restrict_type='width';        
        } else {
            $restrict_type='height';
        }
    }


    my $newh; my $neww; # initialize new dimensions # not used if 'squ
+are'

    if ($restrict_type eq 'height')  {        
        $neww=(($w*$restriction)/$h);
        
        $img->Resize(width=>$neww, height=>$restriction);        
    }

    if ($restrict_type eq 'width')  {        
        $newh=(($h*$restriction)/$w);
        
        $img->Resize(width=>$restriction, height=>$newh);
    }

    if ($restrict_type eq 'square'){
        
        #
        my ($cut,$xcut,$ycut);
        if ($w>$h){
            $cut=$h;
            $xcut=(($w-$h)/2);
            $ycut=0;
        }
        if ($w<$h){
            $cut=$w;
            $xcut=0;
            $ycut=(($h-$w)/2);
        }    
        $img->Crop(width=>$cut,height=>$cut,x=>$xcut,y=>$ycut);    
        $img->Resize(width=>$restriction, height=>$restriction);
        #    
    }
    
    $img->Set(quality=>$quality);
    $img->Write($out);
    undef $img;
}

[download]
#same thing, using GD libary

sub make_thumbnail_GD{
    # receives:
    #     file source (absolute path on machine)
    #     file target out (absolute path on machine)
    #    restriction
    #    restriction type
    #    quality    
    
    my ($src,$out,$restriction,$restrict_type,$quality)=@_;

    # both        restrict to height and width :both won't go over thi
+s.. 
    # width        restrict to width
    # height    restrict to height
    # square    square - will crop sides or top and bottom to fit. nea
+t.

    my $img = GD::Image->newFromJpeg($src);
    my ($w,$h) = $img->getBounds(); # find dimensions

    #if width is bigger then height, we use restrict to w
    if ($restrict_type eq 'both'){    
        if ($w>$h){
            $restrict_type='width';        
        } else {
            $restrict_type='height';
        }
    }

    my $newh; my $neww; # initialize new dimensions # not used if 'squ
+are'

    if ($restrict_type eq 'height')  {        
        $neww=(($w*$restriction)/$h);
        $newh=$restriction;
    }

    if ($restrict_type eq 'width')  {        
        $newh=(($h*$restriction)/$w);
        $neww=$restriction;
    }
    
    if ($restrict_type ne 'square'){
        my $newimg = new GD::Image($neww,$newh);
        $newimg->copyResized($img,0,0,0,0,$neww,$newh,$w,$h);
        open(FILE, "> $out") || die;
        print FILE $newimg->jpeg;
        
    } else {
        #square
        my ($cut,$xcut,$ycut);
        if ($w>$h){
            $cut=$h;
            $xcut=(($w-$h)/2);
            $ycut=0;
        }
        if ($w<$h){
            $cut=$w;
            $xcut=0;
            $ycut=(($h-$w)/2);
        }
        
        my $newimg = new GD::Image($restriction,$restriction);
        $newimg->copyResized($img,0,0,$xcut,$ycut,$restriction,$restri
+ction,$cut,$cut);
        
        open(FILE, "> $out") || die;
        print FILE $newimg->jpeg;        
    }
    
}

[download]

index gallery script, help yourself- play with it. For a working example of this kind of script ( http://leocharre.com/paintings/index.cgi )- gain, this is *just* a script

#save it as index.cgi somewhere, chmod 0755
#!/usr/bin/perl

use strict;
use Cwd;

##########################################################
# GD Library
#my $il='G'; # comment if you are using ImageMagick instead
#use GD; # comment if you are using ImageMagick instead

##########################################################
# ImageMagick
my $il='I'; # comment if you are using GD library instead
use Image::Magick; # comment if using GD Library instead

BEGIN { 
    $|=1; use CGI::Carp('fatalsToBrowser');
}


=pod
INDEXGALLERY
Leo Charre
for help etc leo@leocharre.com

make sure to chmod 0755    
Requires:
    - Image Magick    
for more info, view readme.txt
=cut





# MAIN USER DEFINED VARS #


#how many to show per page
my $perpage=10;

# HOW DO YOU WANT THUMBS MADE

my $restrict_type='square';

    # both        restrict to height and width :both won't go over thi
+s.. 
    # width        restrict to width
    # height    restrict to height
    # square    square - will crop sides or top and bottom to fit. nea
+t.

my $restriction=50; #pixels to restrict by.

my $quality=85; #quality of thumbnails


# if you want to change this later on, you must delete all your .thumb
+nail files first



# DEVEL #

# how many thumbs to make per page. Others will say "reload to see thu
+mbnail". By default it is the same 
# as how many to show per page. This is restricted to 50.
my $make=$perpage;

# uncomment to custom select how many to make at a time 
#my $make=10; 

my $DEBUG_on=0; # set to 1 to see output.

#  #










# ugly hack to keep idiots from blowing up someobody's server
if ($make>50) {$make = 50;} # some kind of control. Please no comments
+ :/


# useful for devel
my $DEBUG;

my $PAGENOW; #present set of img/

my $q=$ENV{'QUERY_STRING'}; #get query string (everything after url?
if ($q=~m/p=(\d+)/){
    $PAGENOW=$1; #strip any extra shit (could be in archive)
} else {$PAGENOW=1;}


# accept debug from query string, uncomment to allow
if ($q=~m/debug=1/){
    $DEBUG_on=1;
} 



my $pwd = cwd;
my $docroot= $ENV{'DOCUMENT_ROOT'};


my $d; #where in htdocs, public_html, etc we will work
my $d=0; #if we are navigating subdir ???

if ($q=~m/d=([^=&]+)/){
    $d=$1; 
} else {
    $d = $pwd;
    $d=~ s/^$docroot//; # (example : now /home/user/web/dir is /dir ) 
+   
}

if ($DEBUG_on) { $DEBUG.=" - d is $d -\n"; }






#start subnavigation

# this allows navigation back and forth if there are multiple director
+ies
# where this script resides (sets), this is in regard to where we are 
+now

my $CURRENT_GALLERY_DIRECTORY;


#warning, stupid hack follows.. 

#if this is installed in /stuff/gallery  , we don't want to go up a di
+rectory..
my $sd=$pwd; #where script is
$sd=~s/^.*\///; #take out everything but gallery (in aforementioned ca
+se)
# now sd contains the name of the dir in which this cript resides, onl
+y that, no slashes

my $f=$d;
$f=~s/^(.*)\/$sd/$sd/; # now we have gallery (or gallery/setthis )
my $prepend=$1;

#end stupid hack

my @p=split('/',$f);
my $path;

foreach (@p){
    $path.="/$_";
    $CURRENT_GALLERY_DIRECTORY.=qq{<a href="index.cgi?d=$prepend$path"
+>$_</a> : };
}

#end subnavigation




#see what we have here..
# let's look inside and find our images to work with, and or optional 
+sub dirs
my @imgs; my @subdirs;
opendir(DIR,$docroot.$d);
while ($_=readdir(DIR)){
    if ($_=~m/\.jpg$|\.jpeg$|\.gif$/i && !($_=~m/^\.thumbnail_/)){
        if ($DEBUG_on){    $DEBUG.=" matched $_ --\n"; }
        push(@imgs,$_);
    } elsif (-d "$docroot$d/$_" && $_ ne '.' && $_ ne '..') {
        if ($DEBUG_on){    $DEBUG.=" sub dir found $_ --\n"; }
        push(@subdirs,$_);
    }    
}




#create paging if images found
my $PAGING; 

my $imgs_total = 0;
$imgs_total=scalar(@imgs);
my $control=$imgs_total;
my $img_start;

my $OUTPUT; #this will contain thumbnails etc.

if ($imgs_total){ #if imgs present

    #paging
    
    if ($control>$perpage){
        my $p=1;
        while ( ( $control > 0) ){
            $PAGING.=qq{<a href="index.cgi?p=$p&d=$d" title="Go To Pag
+e $p">[ Pg $p ]</a> };        
            $p++;
            $control=($control - $perpage);
        }
    }

    $img_start=(($PAGENOW*$perpage)-($perpage-1)); #what img to start 
+with 

    if ($DEBUG_on){
        $DEBUG.="- imgs_total: $imgs_total <br>perpage= $perpage<br> i
+mg_start= $img_start<br> pagenow= $PAGENOW";
    }
    


    #START OUTPUT

    my $which= ($img_start-1);
    my $control=0; #might be one instead

    until ( $perpage == $control || $which>$imgs_total){ 

        $_=$imgs[$which];

        my $name=$_; $name=~s/\.\w+$//;$name=~s/_|-/ /g;
        if (!-f "$docroot/$d/.thumbnail_$_"){ #check if thumb exists
        
            if ($make){
                if ($il eq 'GD'){
                    make_thumbnail_GD("$docroot/$d/$_","$docroot/$d/.t
+humbnail_$_",
                    $restriction,$restrict_type,$quality);
                } else {
                    make_thumbnail_IM("$docroot/$d/$_","$docroot/$d/.t
+humbnail_$_",
                    $restriction,$restrict_type,$quality);
                }
        
                $OUTPUT.=qq{<span class="item">
                <a href="$d/$_" target="_blank" title="$name">
                <img src="$d/.thumbnail_$_" alt="$name image"><br/>$na
+me</a> $which</span>};
                $make--; 
            } else {
                $OUTPUT.=qq{<span class="item">
                <a href="$d/$_" target="_blank" title="$name">(Reload 
+for Thumb)<br/>$name</a> $which</span>};
            }
        } else {
            $OUTPUT.=qq{<span class="item">
            <a href="$d/$_" target="_blank" title="$name">
            <img src="$d/.thumbnail_$_" alt="$name image"><br/>$name</
+a> $which</span>};
        }
        $which++;
        $control++;
        if ($which == $imgs_total ){ last;}
    }


} else {
    $OUTPUT= q{No images present in this directory.};
}








# create sub dir navigation if dirs found
my $dirs_total = 0;
$dirs_total=scalar(@subdirs);

my $SUBNAVIGATION;

if ($dirs_total){ #if dirs present
    $SUBNAVIGATION='Other Sets here:<br>';
    
    foreach ( @subdirs ){        
        $SUBNAVIGATION.=qq{<a href="index.cgi?d=$d/$_" title="Go To Se
+t $_">[ Set $_ ]</a><br>\n };        
    }
    
    if ($DEBUG_on) { 
        $DEBUG.="\n- subdirs_total: $dirs_total\n";
    }
}




#get template, check that css file is there...

my $html = &htmlcheck(); #will create if nonexistant, also will get ht
+ml source - this is so people can edit it.
&csscheck(); #will create if nonexistant- so people can edit it.

#see if there are includes
$html=~s/<!--#include\s+virtual="([^"]+)"\s*-->/slurp($docroot.$1)/eg;

# make replacements in template read
$html=~s/{PAGING}/$PAGING/;
$html=~s/{PAGENOW}/$PAGENOW/;
$html=~s/{SUBNAVIGATION}/$SUBNAVIGATION/;
$html=~s/{OUTPUT}/$OUTPUT/;
$html=~s/{CURRENT_GALLERY_DIRECTORY}/$CURRENT_GALLERY_DIRECTORY/;
$html=~s/{DEBUG}/$DEBUG/; #obviously if debug was not on, this replace
+s with nothing.

print qq{Content-type: text/html\n\n$html};

exit;









sub make_thumbnail_GD{
    # receives:
    #     file source (absolute path on machine)
    #     file target out (absolute path on machine)
    #    restriction
    #    restriction type
    #    quality    
    
    my ($src,$out,$restriction,$restrict_type,$quality)=@_;

    # both        restrict to height and width :both won't go over thi
+s.. 
    # width        restrict to width
    # height    restrict to height
    # square    square - will crop sides or top and bottom to fit. nea
+t.

    my $img = GD::Image->newFromJpeg($src);
    my ($w,$h) = $img->getBounds(); # find dimensions

    #if width is bigger then height, we use restrict to w
    if ($restrict_type eq 'both'){    
        if ($w>$h){
            $restrict_type='width';        
        } else {
            $restrict_type='height';
        }
    }

    my $newh; my $neww; # initialize new dimensions # not used if 'squ
+are'

    if ($restrict_type eq 'height')  {        
        $neww=(($w*$restriction)/$h);
        $newh=$restriction;
    }

    if ($restrict_type eq 'width')  {        
        $newh=(($h*$restriction)/$w);
        $neww=$restriction;
    }
    
    if ($restrict_type ne 'square'){
        my $newimg = new GD::Image($neww,$newh);
        $newimg->copyResized($img,0,0,0,0,$neww,$newh,$w,$h);
        open(FILE, "> $out") || die;
        print FILE $newimg->jpeg;
        
    } else {
        #square
        my ($cut,$xcut,$ycut);
        if ($w>$h){
            $cut=$h;
            $xcut=(($w-$h)/2);
            $ycut=0;
        }
        if ($w<$h){
            $cut=$w;
            $xcut=0;
            $ycut=(($h-$w)/2);
        }
        
        my $newimg = new GD::Image($restriction,$restriction);
        $newimg->copyResized($img,0,0,$xcut,$ycut,$restriction,$restri
+ction,$cut,$cut);
        
        open(FILE, "> $out") || die;
        print FILE $newimg->jpeg;        
    }
    
}


sub make_thumbnail_IM{
    # receives:
    #     file source (absolute path on machine)
    #     file target out (absolute path on machine)
    #    restriction
    #    restriction type
    #    quality    
    
    my ($src,$out,$restriction,$restrict_type,$quality)=@_;

    # both        restrict to height and width :both won't go over thi
+s.. 
    # width        restrict to width
    # height    restrict to height
    # square    square - will crop sides or top and bottom to fit. nea
+t.

    
    
    my $img = Image::Magick->new; #blank     

    $img->Read($src); #read source file into blank
    my ($w,$h) = $img->Get('width','height'); # find dimensions

    #    #    #

    #if width is bigger then height, we use restrict to w
    if ($restrict_type eq 'both'){    
        if ($w>$h){
            $restrict_type='width';        
        } else {
            $restrict_type='height';
        }
    }


    my $newh; my $neww; # initialize new dimensions # not used if 'squ
+are'

    if ($restrict_type eq 'height')  {        
        $neww=(($w*$restriction)/$h);
        
        $img->Resize(width=>$neww, height=>$restriction);        
    }

    if ($restrict_type eq 'width')  {        
        $newh=(($h*$restriction)/$w);
        
        $img->Resize(width=>$restriction, height=>$newh);
    }

    if ($restrict_type eq 'square'){
        
        #
        my ($cut,$xcut,$ycut);
        if ($w>$h){
            $cut=$h;
            $xcut=(($w-$h)/2);
            $ycut=0;
        }
        if ($w<$h){
            $cut=$w;
            $xcut=0;
            $ycut=(($h-$w)/2);
        }    
        $img->Crop(width=>$cut,height=>$cut,x=>$xcut,y=>$ycut);    
        $img->Resize(width=>$restriction, height=>$restriction);
        #    
    }
    
    $img->Set(quality=>$quality);
    $img->Write($out);
    undef $img;
}



sub htmlcheck {

    my $html=slurp("$pwd/indexgallery_template.html");

    unless ($html){
        
        $html=q|<html>
<head>
<title>IndexGallery</title>
<meta name="description" content="IndexGallery Perl Automatic Thumbnai
+l Maker Gallery.">
<meta name="keywords" content="Perl Thumbnail Maker,Perl Image Gallery
+,IndexGallery">
<link href="indexgallery.css" rel="stylesheet" type="text/css">
</head>
<body>

<h1>Gallery</h1>

<div id="cdg">{CURRENT_GALLERY_DIRECTORY} Page {PAGENOW}</div>

<div id="paging">{PAGING}</div>

{OUTPUT}

<div class="clear"></div>

<div id="subdirs">{SUBNAVIGATION}</div>

<div class="footer"><a href="http://b3thm00n.com/scripting/index_galle
+ry/" title="IndexGallery Perl Automatic Thumbnail Maker Gallery">Inde
+xGallery</a> Perl Automatic Thumbnail Maker Gallery</div>

<div class="debug">{DEBUG}</div>

<!--

this file called indexgallery_template.html, it is the template used b
+y IndexGallery (index.cgi)
it is created by that file (index.cgi) if it does not exist.

This file needs the CSS and OUTPUT places above. DEBUG is fed if you a
+sk for debug feedback, ignore it.

you may edit this file however you want. if you do something to it and
+ it screws up your layout, 
you can simply delete it. 
when index.cgi is run again, it will create this file anew for you.
for more info on IndexGallery go to http://b3thm00n.com

You are not required to keep that footer, you can do whatever you want
+. You can say you made it yourself.

-->

</body>
</html>|;

        save ($html, "$pwd/indexgallery_template.html");
    }

    return $html;
}




sub csscheck {

    unless (-f "$pwd/indexgallery.css"){ 
        
        my $css= q|/*this file called indexgallery.css, is created by 
+the file index.cgi if it does not exist.

you may edit this file however you want.

if you do something to it and it screws up your layout, 
you can simply delete it.

when index.cgi is run again, it will create this file anew for you.
for more info on IndexGallery go to http://b3thm00n.com */


/*body */

body {     font-family: arial,sans; 
    font-size:11px; color:#666 }

    
/* an item is the outermost div that encases a thumbnail and its info,
+ it is 'one image'  */

.item{ margin:4px; float:left; padding:4px; font-size:11px }




/* link text appearace */

a:link, a:active, a:visited  { color:#a33 }

a:hover { color:#f33 }



/* paging text */

#paging { font-weight:bold; }

#paging a {white-space:nowrap; margin-right:8px; margin-bottom:2px}




/* the current path, this is sort of the navigation */

#cdg { font-weight:bold; font-size:13px;}


/* other directories in this one.. subdirs.. or 'sets' section*/

#subdirs { font-weight:bold; font-size:11px;}





/* the main header text */

h1 { font-size:13px; font-weight:bold }

/* The .clear class is applied to a div between the output (the output
+ are
the thumbnails in the class="item" divs )
and the footer. If .item class is floated left, and #subdirs is right 
+then
this div should clear both */

.clear { clear:both }


/* footer */
.footer { font-size:9px; color:#aaa }|;

        save ($css, "$pwd/indexgallery.css");
    }
}
    


sub save{
        my $src = $_[0]; #the file content
        my $target = $_[1]; #the file path target

        if ( open(OUT,"> $target.tmp") ){
                print OUT $src;
                close (OUT);
                rename("$target.tmp",$target);
                return 1;
        }
}

[download]

Edit: g0n - readmore tags

In Section Seekers of Perl Wisdom