Mostrando resultados del 1 al 2 de 2

Tema: script perl para redimensionar masivamente JPEGs

  1. #1
    Fecha de Ingreso
    ene 2012
    Ubicación
    A un clic de ti...
    Mensajes
    13.468

    Predeterminado script perl para redimensionar masivamente JPEGs



    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.

    Código:
    #!/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...
    Clic, clic, clic...

  2. #2
    Fecha de Ingreso
    ene 2012
    Ubicación
    A un clic de ti...
    Mensajes
    13.468

    Predeterminado Mejora en el aspecto final de las fotos

    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.

    Código:
    #!/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);
    Clic, clic, clic...

Marcadores

Normas de Publicación

  • No puedes crear nuevos temas
  • No puedes responder temas
  • No puedes subir archivos adjuntos
  • No puedes editar tus mensajes
  •