NerveNet
25/11/16, 21:59:28
Un tema recurrente en el foro es el de las marcas de agua. No soy muy fan de ellas, más que nada por que apenas publico mis fotos y dado a que muchas veces son versiones para web (como mucho a 1200x800 puntos), versiones demasiado pequeñas como para usarlas fuera de la red.
Pero seguro que más de un Linuxero apurado encontrará ahora más fácil ponerle una marca de agua con este script Perl a todas sus fotos.
Os dejo de muestra el resultado que obtendréis.
http://static.canonistas.com/galerias/data/500/img_5987_new.jpg (http://www.canonistas.com/galerias/showphoto.php?photo=407486&title=marca-de-agua&cat=500)
Comentar que la foto de forma deliberada muestra una marca de agua inmensamente grande, se debe a que mi marca de agua mide 634x335 puntos y la foto en la cual la disolví mide 900x600, en fotos de 6 mpx se ve mucho más pequeña y discreta.
Lo primero que necesitas es un fichero gráfico con tu marca de agua.
Puedes hacer la marca de agua con tu programa favorito, en mi caso The Gimp, un tema importante es utilizar el menor número de colores, mejor sólo dos (blanco y negro), también es importante que el fondo sea transparente. El tamaño de la marca de agua debe estar en proporción con la foto, el script no reduce la foto, únicamente le colocará la marca de agua en el centro de la imagen.
Una vez que tienes tu marca de agua con el fondo transparente, la exportas a un fichero con formato PNG. El formato PNG soporta fondos transparentes, el formato GIF también lo soporta pero no he probado GIF con este script.
Ahora el script:
#!/usr/bin/perl
#
# Breve proceso que añade marcas de agua masivamente
#
# 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
#
# 20161125 por NerveNet
#
use strict;
use Cwd;
use Time::HiRes qw(gettimeofday);
use Image::Magick;
# Variables
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 $newquality = 95;
my $HELPTEXT = "Sintaxis:\n\n$0\t--logo=filename_and_path | [--help] |\n\t\t[--opacity=integer(0-100)]\n\nThis script adds a watermark to any jpeg file in the current directory.\n\n";
#
my $opacity = 20;
my $watermarkfile = '';
# ARG
if (@ARGV > 0) {
foreach(@ARGV) {
PARAMLOAD: {
/^--help$/ && do {print $HELPTEXT; exit(0);};
/^--logo=(.+)$/ && do {$watermarkfile = $1; last PARAMLOAD; };
/^--opacity=([0-9]+)$/ && do {$opacity = $1; last PARAMLOAD; };
print "Unknow or malformed parameter '".$_."'.\nPlease use --help to get more information.\n";
exit(1);
}
}
unless (-e $watermarkfile) {
print "File '$watermarkfile' doesn't exist!\n";
exit(2);
}
} else {
print "Missing --logo parameter.\nPlease use --help to get more information.\n";
exit(1);
}
# 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;
my $imgwatermark = Image::Magick->new;
$image->Read($oldpic);
$imgwatermark->Read($watermarkfile);
my ($cspace, $cols, $rows, $compr, $quality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
$image->Composite(
image => $imgwatermark,
compose => 'dissolve',
args => $opacity,
gravity => 'center'
);
# Saving new image
$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";
$k++;
}
}
$tinit = gettimeofday - $tinit;
print "$k JPEG files 'watermarked' in $tinit seconds.\n" if ($k);
exit(0);
El script lo guardas en un fichero de texto plano con extension .pl en tu carpeta ~/bin, recuerda otorgarle permisos de ejecución, recuerda también que necesitas comprobar que tengas instalado los módulo que indico en el script e ImageMagick 6.5 o posterior.
Es recomendable guardar en el directorio que contiene el script la marca de agua en formato PNG para no andarla buscando a todas horas.
Para ejecutar el script en cualquier carpeta, suponiendo que se llame watermark.pl:
watermark.pl --logo=/home/usuario/bin/marcagua.png --opacity=20
Esto usará el fichero /home/usuario/bin/marcagua.png como marca de agua con una opacidad del 20% sobre todas las imágenes JPEG que encuentre en la carpeta en la que estés en ese momento.
El script tratara todos los ficheros JPG de la carpeta actual, les pondrá la marca de agua y grabará el resultado en un fichero con el mismo nombre sin extensión .jpg pero acabado en .new.jpg.
Si tienes una foto llamada por ejemplo fulano.jpg esta no se tocará pero el resultado será otro fichero llamado fulano.new.jpg
Bueno, espero que lo disfrutéis.
P.D. El script puede hacerse funcionar bajo MacOS X y Windows, a ver si os animáis...
Pero seguro que más de un Linuxero apurado encontrará ahora más fácil ponerle una marca de agua con este script Perl a todas sus fotos.
Os dejo de muestra el resultado que obtendréis.
http://static.canonistas.com/galerias/data/500/img_5987_new.jpg (http://www.canonistas.com/galerias/showphoto.php?photo=407486&title=marca-de-agua&cat=500)
Comentar que la foto de forma deliberada muestra una marca de agua inmensamente grande, se debe a que mi marca de agua mide 634x335 puntos y la foto en la cual la disolví mide 900x600, en fotos de 6 mpx se ve mucho más pequeña y discreta.
Lo primero que necesitas es un fichero gráfico con tu marca de agua.
Puedes hacer la marca de agua con tu programa favorito, en mi caso The Gimp, un tema importante es utilizar el menor número de colores, mejor sólo dos (blanco y negro), también es importante que el fondo sea transparente. El tamaño de la marca de agua debe estar en proporción con la foto, el script no reduce la foto, únicamente le colocará la marca de agua en el centro de la imagen.
Una vez que tienes tu marca de agua con el fondo transparente, la exportas a un fichero con formato PNG. El formato PNG soporta fondos transparentes, el formato GIF también lo soporta pero no he probado GIF con este script.
Ahora el script:
#!/usr/bin/perl
#
# Breve proceso que añade marcas de agua masivamente
#
# 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
#
# 20161125 por NerveNet
#
use strict;
use Cwd;
use Time::HiRes qw(gettimeofday);
use Image::Magick;
# Variables
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 $newquality = 95;
my $HELPTEXT = "Sintaxis:\n\n$0\t--logo=filename_and_path | [--help] |\n\t\t[--opacity=integer(0-100)]\n\nThis script adds a watermark to any jpeg file in the current directory.\n\n";
#
my $opacity = 20;
my $watermarkfile = '';
# ARG
if (@ARGV > 0) {
foreach(@ARGV) {
PARAMLOAD: {
/^--help$/ && do {print $HELPTEXT; exit(0);};
/^--logo=(.+)$/ && do {$watermarkfile = $1; last PARAMLOAD; };
/^--opacity=([0-9]+)$/ && do {$opacity = $1; last PARAMLOAD; };
print "Unknow or malformed parameter '".$_."'.\nPlease use --help to get more information.\n";
exit(1);
}
}
unless (-e $watermarkfile) {
print "File '$watermarkfile' doesn't exist!\n";
exit(2);
}
} else {
print "Missing --logo parameter.\nPlease use --help to get more information.\n";
exit(1);
}
# 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;
my $imgwatermark = Image::Magick->new;
$image->Read($oldpic);
$imgwatermark->Read($watermarkfile);
my ($cspace, $cols, $rows, $compr, $quality) = $image->Get('colorspace', 'columns', 'rows', 'compression', 'quality');
$image->Composite(
image => $imgwatermark,
compose => 'dissolve',
args => $opacity,
gravity => 'center'
);
# Saving new image
$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";
$k++;
}
}
$tinit = gettimeofday - $tinit;
print "$k JPEG files 'watermarked' in $tinit seconds.\n" if ($k);
exit(0);
El script lo guardas en un fichero de texto plano con extension .pl en tu carpeta ~/bin, recuerda otorgarle permisos de ejecución, recuerda también que necesitas comprobar que tengas instalado los módulo que indico en el script e ImageMagick 6.5 o posterior.
Es recomendable guardar en el directorio que contiene el script la marca de agua en formato PNG para no andarla buscando a todas horas.
Para ejecutar el script en cualquier carpeta, suponiendo que se llame watermark.pl:
watermark.pl --logo=/home/usuario/bin/marcagua.png --opacity=20
Esto usará el fichero /home/usuario/bin/marcagua.png como marca de agua con una opacidad del 20% sobre todas las imágenes JPEG que encuentre en la carpeta en la que estés en ese momento.
El script tratara todos los ficheros JPG de la carpeta actual, les pondrá la marca de agua y grabará el resultado en un fichero con el mismo nombre sin extensión .jpg pero acabado en .new.jpg.
Si tienes una foto llamada por ejemplo fulano.jpg esta no se tocará pero el resultado será otro fichero llamado fulano.new.jpg
Bueno, espero que lo disfrutéis.
P.D. El script puede hacerse funcionar bajo MacOS X y Windows, a ver si os animáis...