¿Cómo puedo extraer datos EXIF ​​usando PerlMagick?

Question

Actualmente estoy usando Perl Magick http://www.imagemagick.org/script/perl-magick.php, la interfaz de Perl para Image Magick http://www.imagemagick.org, para procesar & convertir fotos que cargan nuestros usuarios del sitio. Me gustaría ser capaz de capturar también algunos de los datos EXIF ​​adjuntos a estas imágenes y he sido capaz de encontrar la manera de hacer esto utilizando la interfaz de línea de comandos para ImageMagick con el siguiente comando:

/usr/bin/identify -format "%[EXIF:*]" image.jpg 

que devuelve la siguiente información EXIF ​​de una foto en particular:

exif:ApertureValue=29/8 
exif:ColorSpace=1 
exif:CompressedBitsPerPixel=3/1 
exif:CustomRendered=0 
exif:DateTime=2002:10:08 19:49:52 
exif:DateTimeDigitized=2002:09:29 14:03:55 
exif:DateTimeOriginal=2002:09:29 14:03:55 
exif:DigitalZoomRatio=1/1 
exif:ExifImageLength=307 
exif:ExifImageWidth=410 
exif:ExifOffset=192 
exif:ExifVersion=48, 50, 50, 48 
exif:ExposureBiasValue=0/1 
exif:ExposureMode=0 
exif:ExposureTime=1/1000 
exif:Flash=24 
exif:FlashPixVersion=48, 49, 48, 48 
exif:FNumber=7/2 
exif:FocalLength=227/32 
exif:FocalPlaneResolutionUnit=2 
exif:FocalPlaneXResolution=235741/32 
exif:FocalPlaneYResolution=286622/39 
exif:Make=Canon 
exif:MaxApertureValue=12742/4289 
exif:MeteringMode=5 
exif:Model=Canon PowerShot S30 
exif:ResolutionUnit=2 
exif:SceneCaptureType=0 
exif:SensingMethod=2 
exif:ShutterSpeedValue=319/32 
exif:Software=Adobe Photoshop 7.0 
exif:WhiteBalance=0 
exif:XResolution=180/1 
exif:YResolution=180/1 

que he probado unos 100 maneras de conseguir el mismo resultado de Perl magia, pero no puedo averiguar cómo pasan los mismos parámetros que estoy usando el la línea de comando para que funcione correctamente. Aquí hay un par de variaciones que he probado ninguno de los cuales parece haber funcionado:

use Image::Magick; 
my $image = Image::Magick->new; 
my $exif = $image->Identify('image.jpg'); 
print $exif; 

$image->Read('image.jpg'); 
$exif = $image->Get('format "%[EXIF:*]"'); 
print $exif; 

Sé que hay otras maneras de extraer los datos EXIF ​​de un archivo de imagen en Perl, pero puesto que ya tenemos el módulo Perl Magia cargado No quiero perder más memoria al cargar un módulo adicional. Espero que alguien ya esté trabajando en su sitio y pueda compartir la solución. ¡Gracias de antemano por tu ayuda!

Answer 1

> cat im.pl 
use Image::Magick; 
my $image = Image::Magick->new(); 
$image->Read('/home/rjp/2009-02-18/DSC00343.JPG'); 
my $a = $image->Get('format', '%[EXIF:*]'); # two arguments 
my @exif = split(/[\r\n]/, $a); 
print join("\n", @exif); 
> perl im.pl 
exif:ColorSpace=1 
exif:ComponentsConfiguration=... 
exif:Compression=6 
exif:CustomRendered=0 
exif:DateTime=2009:02:13 16:18:15 
exif:DateTimeDigitized=2009:02:13 16:18:15 
... 

Eso parece funcionar.

Versión: ImageMagick 6.3.7 06/04/09 Q16 http://www.imagemagick.org

Answer 2

Le recomiendo que use Phil Harvey's ExifTool. Es completo y está bien documentado. Además, no lee toda la imagen en la memoria y, de acuerdo con la documentación, puede obtener la información Exif de la imagen simplemente pasando un identificador de archivo a un archivo de imagen abierto. Por lo tanto, no debería desperdiciar mucha memoria.

Answer 3

Editar: @rjp mostró cómo acceder a toda la información en lugar de las etiquetas individuales. Aquí es cómo poner los datos en un hash:

#!/usr/bin/perl 

use strict; 
use warnings; 

use Image::Magick; 

my $image = Image::Magick->new; 
$image->read('test.jpg'); 

my %exif = map { s/\s+\z//; $_ } 
      map { split /=/, $_ } 
      split /exif:/, $image->Get('format', '%[EXIF:*]'); 

use Data::Dumper; 
print Dumper \%exif;