Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

JPEG Files ReSize

by shadox (Priest)
on Aug 25, 2001 at 06:12 UTC ( #107772=perlcraft: print w/replies, xml ) Need Help??

   1: # This is a simple program to resize one jpeg size or all 
   2: # the jpeg files from a given directory
   3: # -d directory height width , will change all the 
   4: # files to that new size, 
   5: # script -a file.jpg height width , will change just a file
   6: # If a image is 100 x 200 then the program will try to 
   7: # adjust a given height and width to mantain the scale
   8: # I know this program must have some bug, or maybe i use    
   9: # too much code for something, but this was one of my first 
  10: # perl scripts :)
  11: # The script has some comments in spanish cuz here in Costa
  12: # Rica we speak spanish 
  14: use GD;
  15: use strict;
  17: sub changeSize{
  19:    if ( @_ ) {
  21:       my $file = "$_[0]" ;
  22:       my $newFile = "new".$file;
  23:       open(JPEG,">$newFile");
  24:       binmode JPEG;
  25:       my $newWidth = $_[1];
  26:       my $newHeight = $_[2];
  27:       my $quality = 100;
  28:       if ( $_[3] ) { $quality = $_[3] if ( $_[3] =~ /[1..100]/ ) ; }
  30:       my $myImage = newFromJpeg GD::Image($file);
  33:       my @size = $myImage->getBounds( ) ;
  34:       my $currentWidth = $size[0];
  35:       my $currentHeight = $size[1];
  39:       if ( $currentWidth != $currentHeight ) { 
  41:          my $factor = ($currentWidth / $currentHeight);
  42:          $factor = $newWidth / $factor;
  43: 	 $newHeight = int($factor);
  45:       }
  47:       my $newImage = new GD::Image($newWidth,$newHeight);
  50:       $newImage->copyResized($myImage,0,0,0,0,$newWidth,$newHeight,$currentWidth,$currentHeight);
  52:       print JPEG $newImage->jpeg($quality);
  53:       close(JPEG);
  56:    }
  58: }
  60: my $param = "$ARGV[0]";
  61: my $dir = "$ARGV[1]" ;
  62: my $newWidth = "$ARGV[2]" ;
  63: my $newHeight= "$ARGV[3]" ;
  64: my $newQuality = "$ARGV[4]" ;
  66: my @tmp = split(/\\/,$0);
  67: my $name = $tmp[-1];
  69: if ( $param eq "-a" ) {
  71:    if ( -f $dir ){
  73:       &changeSize($dir,$newWidth,$newHeight,$newQuality) if ( $dir =~ /.*\.jpg/);   
  76:    } else { print "Estas seguro que $dir es un archivo ? :) "; } 
  78: } elsif ( $param eq "-d" ) {
  80:    opendir(DIR,$dir) or die "Error abriendo directorio $dir\n";
  82:    my @onlyFiles = grep {-f "$dir/$_"} readdir(DIR); # I get this trick from the Q/A area :)
  84:    foreach my $file (@onlyFiles) {
  87:       if ( $file =~ /.*\.jpg/ ) {
  89:          &changeSize($file,$newWidth,$newHeight,$newQuality);
  91:       }
  94:    }
  96: } else { print "Error :( "; }

Replies are listed 'Best First'.
Re: JPEG Files ReSize
by John M. Dlugosz (Monsignor) on Aug 25, 2001 at 12:38 UTC
    Nice--I never realized that GD could do all that. I recall it using 8-bit paletted color only. Looks like it might be a light-duity replacement for Image::Magick now?

    Some comments:

    my $param = "$ARGV[0]";
    Why are you interpolating that into an otherwise empty string? You are using it in an ordinary way, so I don't see any point to it.

    How about writing lines 59-63 as

    my ($param,$dir,$newWidth,$newHeight,$newQuality)= @ARGV;
    on 65-66,
    my @tmp = split(/\\/,$0); my $name = $tmp[-1];
    You leave @tmp laying around even though you only needed it for the next line. There are various ways of not doing that. But, look at more specific ways of getting the basename (see File::Basename module). But since $name is never used anyway, why bother at all?

    Add use warnings; along with the use strict;. Replace comment block on lines 1-11 with POD.

    On line 18, if ( @_ ) { wraps the entire function. So, if passed no arguments it does nothing with no error? What if there's only 1 parameter? The check doesn't seem very useful. And if you do make it, don't wrap the whole thing like that, instead do something like

    croak "Wrong number of parameters at" unless @_ == 3;
    Also in that function, my $file = "$_[0]"; my $newWidth = $_[1]; again, what's with the quotes (sometimes)? The usual way is:
    my ($file, $newWidth, $newHeight) = @_;
    Ugh: my $newFile = "new".$file; try replacing 21-22 with simply
    that is, interpolate $file right where you need it. And don't forget the or croak "Cannot open [new$file] for writing. OS says $!"; Always follow open with "or die..." or other check.

    Take a look at if ( $_[3] ) { $quality = $_[3] if ( $_[3] =~ /[1..100]/ ) ; } If you're checking the range to be between 1 and 100 number, that won't do it! [1..100] is a character class, meaning the same as [10.] or matching any character that's a 1, 0, or dot. You will pass the test if your string contains any of those characters somewhere. So 43 fails, but "hi." passes.

    Give it a name, not $_[3]. Then, don't just silently ignore it if it doesn't match your needs!

    So, to rewrite that part, follow me:
    Start by adding $quality to the param list. If not passed in, it will be undef. Then, say $quality||=100; so it will be 100 if it was undef (or zero). Then, check for range: croak "quality must be 1..100 at" unless $quality >=1 && $quality <= 100; On 32-34, check this out: my ($currentWidth,$currentHeight)=$myImage->getBounds(); See, use multiple return values without using an array variable. Cool, huh?

    On lines 38-44, you correct the aspect ratio by changing the requested height to be consistant with the width, only if it wasn't square to begin with. You say if it was square, go ahead and allow arbitrary resizing? If that's a peculuarity of your problem, it should be noted in the comments at the top. If you remove the check, why even have the user specify a height? You always ignore it and figure it from the new width. Leave it out, or get fancier (ask me when you're ready).

    On line 72, don't put the & before the function name. That's really old syntax. For the pattern, japhy can tell you more about patterns. But I know that the leading .* is useless. Even without, it means the same thing: match if ".jpg" is present anywhere in the string. I think you want /\.jpg$/, to match the end. Better yet, /\.jpe?g$/i. Again, you silently do nothing but ignore the request if the file doesn't end in .jpg.

    It also seems to me that instead of doing tests to assure that the name's directoryness matches the -a/-d parameter, why not use the -f test to decide? That is, if the user give a file name do the file, if he gives a directory name do the directory! No need to have the first parameter in your script.

    if (-f $dir) { changesize ($dir ... } else { # do the loop
    Nice trick on the grep -f to get files. Why not do the same thing for the .jpg extension, instead of using the if statement?
    my @onlyFiles= grep {{-f "$dir/$_" and /jpe?g$/} readdir(DIR);

    I hope that's helpful. I went over this in detail since you said you are learning, and learning by jumping in and doing is the way I like best! Keep at it.


Re: JPEG Files ReSize
by bladx (Chaplain) on Aug 25, 2001 at 08:58 UTC
    Nice job, for your one of your earliest Perl scripts!

    I especially commend you for using as I have been learning it in detail lately, and enjoy seeing other code utilizing this great module.

    The only changes/modifications I would make if you felt like doing them, would have to just be:
    • Converting the Spanish text to English, (for easier readability for English-speaking persons. Or perhaps, the english equivilents maybe?) :)
    • Creating a more-detailed error message (at the end of the script - which is: else { print "Error :( "; } to let the user know what really went wrong, or what the user needs to do different.
    • Use -w otherwise known as warnings simply so you can check to make sure that everything is in good shape - I did check to make sure that it was fine, and it was in this scripts' case, but make sure to add this in future scripts. :)

    Otherwise, great job on your script! Keep up the great work, shadox!

    Andy Summers
      Andy, -w is not the same as use warnings.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlcraft [id://107772]
Approved by root
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (6)
As of 2022-08-16 09:27 GMT
Find Nodes?
    Voting Booth?

    No recent polls found