1: # This is a simple program to resize one jpeg size or all 
   2: # the jpeg files from a given directory
   3: # script.pl -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 
  13: 
  14: use GD;
  15: use strict;
  16: 
  17: sub changeSize{
  18: 
  19:    if ( @_ ) {
  20:       
  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]/ ) ; }
  29:         
  30:       my $myImage = newFromJpeg GD::Image($file);
  31: 
  32: 
  33:       my @size = $myImage->getBounds( ) ;
  34:       my $currentWidth = $size[0];
  35:       my $currentHeight = $size[1];
  36: 
  37: 
  38: 
  39:       if ( $currentWidth != $currentHeight ) { 
  40: 
  41:          my $factor = ($currentWidth / $currentHeight);
  42:          $factor = $newWidth / $factor;
  43: 	 $newHeight = int($factor);
  44: 
  45:       }
  46: 
  47:       my $newImage = new GD::Image($newWidth,$newHeight);
  48: 
  49: 
  50:       $newImage->copyResized($myImage,0,0,0,0,$newWidth,$newHeight,$currentWidth,$currentHeight);
  51: 
  52:       print JPEG $newImage->jpeg($quality);
  53:       close(JPEG);
  54:       
  55:             
  56:    }
  57: 
  58: }
  59: 
  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]" ;
  65: 
  66: my @tmp = split(/\\/,$0);
  67: my $name = $tmp[-1];
  68: 
  69: if ( $param eq "-a" ) {
  70: 
  71:    if ( -f $dir ){
  72: 
  73:       &changeSize($dir,$newWidth,$newHeight,$newQuality) if ( $dir =~ /.*\.jpg/);   
  74: 
  75: 
  76:    } else { print "Estas seguro que $dir es un archivo ? :) "; } 
  77: 
  78: } elsif ( $param eq "-d" ) {
  79: 
  80:    opendir(DIR,$dir) or die "Error abriendo directorio $dir\n";
  81: 
  82:    my @onlyFiles = grep {-f "$dir/$_"} readdir(DIR); # I get this trick from the Q/A area :)
  83: 
  84:    foreach my $file (@onlyFiles) {
  85: 
  86: 
  87:       if ( $file =~ /.*\.jpg/ ) {
  88: 
  89:          &changeSize($file,$newWidth,$newHeight,$newQuality);
  90: 
  91:       }
  92: 
  93: 
  94:    }
  95: 
  96: } else { print "Error :( "; }
  97: