Come posso estrarre i dati EXIF ​​usando PerlMagick?

Question

Attualmente sto usando Perl Magick http://www.imagemagick.org/script/perl-magick.php, l'interfaccia perl di Image Magick http://www.imagemagick.org, per elaborare le immagini convertite che gli utenti del nostro sito caricano nelle immagini &. Mi piacerebbe essere in grado di catturare anche alcuni dei dati EXIF ​​attaccati a queste immagini e sono stato in grado di capire come fare questo utilizzando l'interfaccia a riga di comando per ImageMagick con il seguente comando:

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

che restituisce le seguenti informazioni EXIF ​​per un particolare foto:

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 

ho provato circa 100 modi per ottenere questo stesso risultato da Perl Magick, ma non riesco a capire come passare gli stessi parametri che sto usando su la riga di comando per farlo funzionare correttamente. Qui ci sono un paio di varianti che ho provato nessuno dei quali sembra aver funzionato:

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; 

So che ci sono altri modi per estrarre dati EXIF ​​da un file immagine in perl ma dal momento che abbiamo già il modulo Perl Magick caricato non voglio sprecare altra memoria caricando un modulo aggiuntivo. Spero che qualcuno là fuori abbia già questo lavoro sul loro sito e possa condividere la soluzione. Grazie in anticipo per il vostro aiuto!

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 
... 

Sembra funzionare.

Versione: ImageMagick 6.3.7 06/04/09 Q16 http://www.imagemagick.org

Answer 2

Consiglio vivamente di utilizzare Phil Harvey ExifTool. È completo e ben documentato. Inoltre, non legge l'intera immagine in memoria e, in base alla documentazione, è possibile ottenere le informazioni Exif dall'immagine semplicemente passandole a un file di immagine aperto. Quindi non dovrebbe sprecare un sacco di memoria.

Answer 3

Edit: @rjp ha mostrato come accedere tutte le informazioni, piuttosto che singoli tag. Ecco come mettere i dati in 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;