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