script perl para redimensionar masivamente JPEGs

[NerveNet]

Os dejo un script Perl para los Linuxeros de pro aunque debería funcionar también bajo Windows y Mac si tienes Perl y los módulos necesarios instalados.

Redimensiona por lotes una tanda de ficheros jpg de un directorio.

El script es para ser ejecutado desde la línea de comando.

#!/usr/bin/perl
#
# Breve proceso que redimensiona imágenes
# Redimensiona una carpeta de JPG a 3000x2000 y los guarda con el mismo nombre agregando .new.jpg al mismo.
# Redimensiona nuevamente el JPG a 900x600 y los guarda con el mismo nombre agregando .icon.jpg al mismo a modo de muestra.
#
# El script es lineal sin funciones adicionales salvo las estrictamente necesarias.
#
# Requerimientos:
#    Perl 5.10 o posterior
#    Módulo Time::HiRes
#    Módulo Image::Magick
#    ImageMagick 6.5 o posterior
#
# 20150217 por NerveNet
#
use strict;
use Cwd;
use Time::HiRes qw(gettimeofday);
use Image::Magick;
# Variables
my $image = Image::Magick->new;
my $path=getcwd;    # Obtengo el directorio de trabajo
my $k = 0;        # Un contador
my @files;        # Contendrá la lista de ficheros a comprobar
my $tinit = gettimeofday;
# Constantes
my $newwidth = 3000;
my $newheight = 2000;
my $newsmallwidth = 900;
my $newsmallheight = 600;
my $newquality = 95;
# Obtengo los ficheros a comprobar y los ordeno
opendir(DIR, $path);
@files = grep { /\.[jJ][pP][gG]$/ } readdir (DIR);
closedir(DIR);
if (@files == 0) {
    print "En la ruta '$path' no se han encontrado ficheros jpg que tratar.\n";
    exit(1);
}
@files = sort (@files);
# Proceso cada fichero
foreach (@files) {
    if (-e $_) {
        my $oldpic = $_;
        my $newpic = $_;
        $newpic =~ s/[jJ][pP][gG]$//;
        $newpic = $newpic.'new.jpg';
        my $image = Image::Magick->new;
        $image->Read($oldpic);
        my ($cspace, $cols, $rows, $compr, $quality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
        if ($cols > $rows) {
            $image->Resize( 
                width => $newwidth,
                height => $newheight,
                filter => 'Lanczos',
                blur=>0.5
            ) if ($cols > $newwidth);
        } else {
            $image->Resize(
                width => $newheight,
                height => $newwidth,
                filter => 'Lanczos',
                blur=>0.5
            ) if ($rows > $newwidth);
        }
        $image->Set(quality=>$newquality);
        my ($ncspace, $ncols, $nrows, $ncompr, $nquality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
        $image->Write($newpic);
        print "$oldpic ($cols x $rows: $cspace - $compr [$quality])-> $newpic ($ncols x $nrows: $ncspace - $ncompr [$nquality])\n";
        #
        $newpic = $oldpic;
        $newpic =~ s/[jJ][pP][gG]$//;
        $newpic = $newpic.'icon.jpg';
        if ($cols > $rows) {
            $image->Resize( 
                width => $newsmallwidth,
                height => $newsmallheight,
                filter => 'Lanczos',
                blur=>0.5
            ) if ($cols > $newsmallwidth);
        } else {
            $image->Resize(
                width => $newsmallheight,
                height => $newsmallwidth,
                filter => 'Lanczos',
                blur=>0.5
            ) if ($rows > $newsmallwidth);
        }
        $image->Set(quality=>$newquality);
        ($ncspace, $ncols, $nrows, $ncompr, $nquality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
        $image->Write($newpic);
        print "$oldpic ($cols x $rows: $cspace - $compr [$quality])-> $newpic ($ncols x $nrows: $ncspace - $ncompr [$nquality])\n";
        $k++;
    }
}
$tinit = gettimeofday - $tinit;
print "Se han tratado $k ficheros JPEG en $tinit segundos.\n" if ($k);
exit(0);

Espero haber picado a alguno y que se anime a publicar sus scripts...

[NerveNet]

Después de un par de semanas usando este script he notado que en algunas fotos se introduce un efecto desagradable. En las áreas de grandes contrastes aparece un escalonamiento quedando poco natural la foto.

He añadido una constante llamada $blur que define el grado de nitidez de las fotos durante el redimensionamiento, originalmente usaba el valor de 0.5 y cambiándolo a 0.7 las fotos tienen un aspecto mejor.

#!/usr/bin/perl
#
# Breve proceso que redimensiona imágenes
# Redimensiona una carpeta de JPG a 3000x2000 y los guarda con el mismo nombre agregando .new.jpg al mismo.
# Redimensiona nuevamente el JPG a 900x600 y los guarda con el mismo nombre agregando .icon.jpg al mismo a modo de muestra.
#
# El script es lineal sin funciones adicionales salvo las estrictamente necesarias.
#
# Requerimientos:
#    Perl 5.10 o posterior
#    Módulo Time::HiRes
#    Módulo Image::Magick
#    ImageMagick 6.5 o posterior
#
# 20150217-20150302 por NerveNet
#
use strict;
use Cwd;
use Time::HiRes qw(gettimeofday);
use Image::Magick;
# Variables
my $image = Image::Magick->new;
my $path=getcwd;    # Obtengo el directorio de trabajo
my $k = 0;        # Un contador
my @files;        # Contendrá la lista de ficheros a comprobar
my $tinit = gettimeofday;
# Constantes
my $newwidth = 3000;
my $newheight = 2000;
my $newsmallwidth = 900;
my $newsmallheight = 600;
my $newquality = 95;
my $blur = 0.7;
# Obtengo los ficheros a comprobar y los ordeno
opendir(DIR, $path);
@files = grep { /\.[jJ][pP][gG]$/ } readdir (DIR);
closedir(DIR);
if (@files == 0) {
    print "En la ruta '$path' no se han encontrado ficheros jpg que tratar.\n";
    exit(1);
}
@files = sort (@files);
# Proceso cada fichero
foreach (@files) {
    if (-e $_) {
        my $oldpic = $_;
        my $newpic = $_;
        $newpic =~ s/[jJ][pP][gG]$//;
        $newpic = $newpic.'new.jpg';
        my $image = Image::Magick->new;
        $image->Read($oldpic);
        my ($cspace, $cols, $rows, $compr, $quality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
        if ($cols > $rows) {
            $image->Resize( 
                width => $newwidth,
                height => $newheight,
                filter => 'Lanczos',
                blur=> $blur
            ) if ($cols > $newwidth);
        } else {
            $image->Resize(
                width => $newheight,
                height => $newwidth,
                filter => 'Lanczos',
                blur=> $blur
            ) if ($rows > $newwidth);
        }
        $image->Set(quality=>$newquality);
        my ($ncspace, $ncols, $nrows, $ncompr, $nquality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
        $image->Write($newpic);
        print "$oldpic ($cols x $rows: $cspace - $compr [$quality])-> $newpic ($ncols x $nrows: $ncspace - $ncompr [$nquality])\n";
        #
        $newpic = $oldpic;
        $newpic =~ s/[jJ][pP][gG]$//;
        $newpic = $newpic.'icon.jpg';
        if ($cols > $rows) {
            $image->Resize( 
                width => $newsmallwidth,
                height => $newsmallheight,
                filter => 'Lanczos',
                blur=> $blur
            ) if ($cols > $newsmallwidth);
        } else {
            $image->Resize(
                width => $newsmallheight,
                height => $newsmallwidth,
                filter => 'Lanczos',
                blur=> $blur
            ) if ($rows > $newsmallwidth);
        }
        $image->Set(quality=>$newquality);
        ($ncspace, $ncols, $nrows, $ncompr, $nquality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
        $image->Write($newpic);
        print "$oldpic ($cols x $rows: $cspace - $compr [$quality])-> $newpic ($ncols x $nrows: $ncspace - $ncompr [$nquality])\n";
        $k++;
    }
}
$tinit = gettimeofday - $tinit;
print "Se han tratado $k ficheros JPEG en $tinit segundos.\n" if ($k);
exit(0);