Script Perl para añadir un borde a la imagen con datos EXIF de la toma

[NerveNet]

Continuo dándole a los scripts con Perl y el módulo Image::Magick, hoy comparto con vosotros uno que redimensiona las imagenes a 900x600 ó 600x900, agrega un borde a la imagen y añade texto con los datos EXIF de la toma. Está basado en un script que publiqué hace un par de días al que he añadido la extracción de los datos EXIF.

Al igual que el anterior script, si lo ejecutas en una carpeta con varios JPG los pasará a todos por la batidora...

Os dejo una foto de muestra de como queda tras procesarla con el script.
http://www.canonistas.com/galerias/data/503/img_9185s_s.jpg (http://www.canonistas.com/galerias/showphoto.php?photo=377328&title=united-colors-oflavapies&cat=503)
Canon EOS 5D + Canon EF 135mm f/2.8 SF


He de reconocer que me basé en el resultado de otro script que anda por estos lares... Este es para los que usamos Linux...


#!/usr/bin/perl
#
# Breve proceso que redimensiona imágenes
# Agrega un borde a la imagen y añade texto con algunos datos EXIF
#
# 20150220 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 = 900;
my $newheight = 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.'s.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->Border(width=>2, height=>2, fill=>'black');
$image->Border(width=>20, height=>20, fill=>'white');
$image->Border(width=>1, height=>1, fill=>'black');
$image->Set(quality=>$newquality);
my @exif = split(/[\r\n]/, $image->Get('format', '%[EXIF:*]'));
my $cameramodel='';
my $focal='';
my $Av='';
my $Tv='';
my $ISO='';
foreach (@exif) {
if (/exif:Model=/) {
($cameramodel = $_) =~ s/^exif:Model=//;
} elsif (/exif:FNumber=/) {
($Av = $_) =~ s/^exif:FNumber=//;
$Av =~ s/f\///;
$Av =~ s/\/.*$//;
} elsif (/exif:ExposureTime=/) {
($Tv = $_) =~ s/^exif:ExposureTime=//;
} elsif (/exif:ISOSpeedRatings=/) {
($ISO = $_) =~ s/^exif:ISOSpeedRatings=//;
} elsif (/exif:FocalLength=/) {
($focal = $_) =~ s/^exif:FocalLength=//;
$focal =~ s/\/.*$//;
}
}
my $pos;
if ($cols > $rows) {
$pos=$newheight + 36;
} else {
$pos=$newwidth + 36;
}
$image->Annotate(font=>'Generic.ttf',fill=>'black', pointsize=>10, text=>"$cameramodel [$focal mm, ISO $ISO, f/$Av, $Tv]",geometry=>"+30+$pos");
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";
# print join("\n", @exif); # Muestra todos los datos EXIF en pantalla
$k++;
}
}
$tinit = gettimeofday - $tinit;
print "Se han tratado $k ficheros JPEG en $tinit segundos.\n" if ($k);
exit(0);