Comment puis-je extraire des données EXIF ​​à l'aide de PerlMagick?

Question

J'utilise actuellement Perl Magick http://www.imagemagick.org/script/perl-magick.php, l'interface perl pour Image Magick http://www.imagemagick.org, pour traiter & convertir les photos que nos utilisateurs du site uploadent. Je voudrais être en mesure de saisir aussi quelques-unes des données EXIF ​​attachées à ces images et je suis en mesure de comprendre comment faire en utilisant l'interface de ligne de commande à l'image Magick avec la commande suivante:

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

qui renvoie les informations suivantes EXIF ​​pour une photo particulière:

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 

J'ai essayé sur 100 façons d'obtenir ce même résultat de Perl Magick mais ne peut pas comprendre comment passer les mêmes paramètres que je utilise sur la ligne de commande pour le faire fonctionner correctement. Voici quelques variations que j'ai essayé dont aucun ne semble avoir fonctionné:

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; 

Je sais qu'il ya d'autres façons d'extraire les données EXIF ​​à partir d'un fichier image en Perl, mais puisque nous avons déjà le module Magick Perl chargé Je ne veux plus perdre de mémoire en chargeant un module supplémentaire. J'espère que quelqu'un a déjà travaillé sur leur site et peut partager la solution. Merci d'avance pour votre aide!

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

Cela semble fonctionner.

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

Answer 2

Je vous recommande fortement d'utiliser le ExifTool de Phil Harvey. C'est complet et bien documenté. En outre, il ne lit pas l'intégralité de l'image en mémoire et, selon la documentation, vous pouvez obtenir les informations Exif de l'image simplement en lui passant un descripteur de fichier dans un fichier image ouvert. Donc ça ne devrait pas gaspiller beaucoup de mémoire.

Answer 3

Edit: @rjp a montré comment accéder à toutes les informations plutôt que des étiquettes individuelles. Voici comment mettre les données dans un hachage:

#!/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;