Perl script to batch compress pictures with ImageMagick

compress_pictures.pl

#!perl

#---------------------------------------------------------------------------------------------
#-------------------------- Prerequisites ----------------------------------------------------
#---------------------------------------------------------------------------------------------
# This Perl script is using Imagemagick to compress the pictures.
# This tool shall be downloaded and installed first.
#---------------------------------------------------------------------------------------------

#---------------------------------------------------------------------------------------------
#-------------------------- How to run it? ---------------------------------------------------
#---------------------------------------------------------------------------------------------
# perl compress_pictures.pl                         ->  run on the current folder
# perl compress_pictures.pl <name of the folder>    ->  run on the folder <name of the folder>
#---------------------------------------------------------------------------------------------




use FindBin '$Bin'; 
chdir "$Bin";

# Folder to start the compression of images
my $start_dir = shift;
-d $start_dir or $start_dir =".";

# List all the images
my %list; # list of jpg files (keys are the folder, values are pointer to arrays of files)
&list_jpg($start_dir, \%list);

# Redirect STDERR to STDOUT
open my $oldout, ">&STDOUT"     or die "Can't dup STDOUT: $!";
open OLDERR,     ">&", \*STDERR or die "Can't dup STDERR: $!";
open STDOUT, "| tee log_compress.out" or die "Can't duplicate STDOUT: $!";
open STDERR, ">&STDOUT" or die "Can't redirect STDERR $!";
select STDERR; $| = 1;  # make unbuffered
select STDOUT; $| = 1;  # make unbuffered

# Compress the images
foreach $dir (sort keys %list) { 
	print "DIRECTORY $dir:\n"; #Print the name of the file
	chdir "$Bin"; chdir "$dir" or die "chdir \"$dir\" failed!\n";
	foreach (@{$list{$dir}}) {
		next if $dir =~ /Skip/; #If the name of the folder contains skip 
		unless (-f $_) {
			print "file $_ not found\n";
			next;
		} 
		print "    - file $_\n";
		
		# Run Imagemagick
		system "mogrify -resize \"2048x2048>\" -quality 75 \"$_"; #compress the file
	}
}

close STDERR;


sub list_jpg {
	my ($root_dir,$rh_list_jpg)=@_;
	
	chdir "$root_dir";
	$root_dir =~ s%/*$%%; #delete the potential last "/" in the root dir 
	my @jpg = ();
	
	# Add the jpeg files
	map { $_!~m%\.jpe?g%i  or push(@jpg, $_) } (glob "*.*"); 
	
	# Add the files when the folder has a space
	map { $_!~m%\.jpe?g%i  or push(@jpg, $_) } (glob "*.*");
	
	# Copy the files
	@{$rh_list_jpg->{"$root_dir"}} = @jpg;

	# Recursive calls in the subfolders
	chdir "$Bin";
	foreach my $dir (glob "$root_dir/*/") {
		-d $dir or next;
		&list_jpg("$dir",$rh_list_jpg); 
	} #end of foreach

} #end of subroutine list_jpg