323 lines
10 KiB
Perl
323 lines
10 KiB
Perl
|
#------------------------------------------------------------------------------
|
||
|
|
# File: APP12.pm
|
||
|
|
#
|
||
|
|
# Description: Read APP12 meta information
|
||
|
|
#
|
||
|
|
# Revisions: 10/18/2005 - P. Harvey Created
|
||
|
|
#
|
||
|
|
# References: 1) Heinrich Giesen private communication
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
package Image::ExifTool::APP12;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use vars qw($VERSION);
|
||
|
|
use Image::ExifTool qw(:DataAccess :Utils);
|
||
|
|
|
||
|
|
$VERSION = '1.13';
|
||
|
|
|
||
|
|
sub ProcessAPP12($$$);
|
||
|
|
sub ProcessDucky($$$);
|
||
|
|
sub WriteDucky($$$);
|
||
|
|
|
||
|
|
# APP12 tags (ref PH)
|
||
|
|
%Image::ExifTool::APP12::PictureInfo = (
|
||
|
|
PROCESS_PROC => \&ProcessAPP12,
|
||
|
|
GROUPS => { 0 => 'APP12', 1 => 'PictureInfo', 2 => 'Image' },
|
||
|
|
PRIORITY => 0,
|
||
|
|
NOTES => q{
|
||
|
|
The JPEG APP12 "Picture Info" segment was used by some older cameras, and
|
||
|
|
contains ASCII-based meta information. Below are some tags which have been
|
||
|
|
observed Agfa and Polaroid images, however ExifTool will extract information
|
||
|
|
from any tags found in this segment.
|
||
|
|
},
|
||
|
|
FNumber => {
|
||
|
|
ValueConv => '$val=~s/^[A-Za-z ]*//;$val', # Agfa leads with an 'F'
|
||
|
|
PrintConv => 'sprintf("%.1f",$val)',
|
||
|
|
},
|
||
|
|
Aperture => {
|
||
|
|
PrintConv => 'sprintf("%.1f",$val)',
|
||
|
|
},
|
||
|
|
TimeDate => {
|
||
|
|
Name => 'DateTimeOriginal',
|
||
|
|
Description => 'Date/Time Original',
|
||
|
|
Groups => { 2 => 'Time' },
|
||
|
|
ValueConv => '$val=~/^\d+$/ ? ConvertUnixTime($val) : $val',
|
||
|
|
PrintConv => '$self->ConvertDateTime($val)',
|
||
|
|
},
|
||
|
|
Shutter => {
|
||
|
|
Name => 'ExposureTime',
|
||
|
|
ValueConv => '$val * 1e-6',
|
||
|
|
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||
|
|
},
|
||
|
|
shtr => {
|
||
|
|
Name => 'ExposureTime',
|
||
|
|
ValueConv => '$val * 1e-6',
|
||
|
|
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
|
||
|
|
},
|
||
|
|
'Serial#' => {
|
||
|
|
Name => 'SerialNumber',
|
||
|
|
Groups => { 2 => 'Camera' },
|
||
|
|
},
|
||
|
|
Flash => { PrintConv => { 0 => 'Off', 1 => 'On' } },
|
||
|
|
Macro => { PrintConv => { 0 => 'Off', 1 => 'On' } },
|
||
|
|
StrobeTime => { },
|
||
|
|
Ytarget => { Name => 'YTarget' },
|
||
|
|
ylevel => { Name => 'YLevel' },
|
||
|
|
FocusPos => { },
|
||
|
|
FocusMode => { },
|
||
|
|
Quality => { },
|
||
|
|
ExpBias => 'ExposureCompensation',
|
||
|
|
FWare => 'FirmwareVersion',
|
||
|
|
StrobeTime => { },
|
||
|
|
Resolution => { },
|
||
|
|
Protect => { },
|
||
|
|
ConTake => { },
|
||
|
|
ImageSize => { PrintConv => '$val=~tr/-/x/;$val' },
|
||
|
|
ColorMode => { },
|
||
|
|
Zoom => { },
|
||
|
|
ZoomPos => { },
|
||
|
|
LightS => { },
|
||
|
|
Type => {
|
||
|
|
Name => 'CameraType',
|
||
|
|
Groups => { 2 => 'Camera' },
|
||
|
|
DataMember => 'CameraType',
|
||
|
|
RawConv => '$self->{CameraType} = $val',
|
||
|
|
},
|
||
|
|
Version => { Groups => { 2 => 'Camera' } },
|
||
|
|
ID => { Groups => { 2 => 'Camera' } },
|
||
|
|
);
|
||
|
|
|
||
|
|
# APP12 segment written in Photoshop "Save For Web" images
|
||
|
|
# (from tests with Photoshop 7 files - PH/1)
|
||
|
|
%Image::ExifTool::APP12::Ducky = (
|
||
|
|
PROCESS_PROC => \&ProcessDucky,
|
||
|
|
WRITE_PROC => \&WriteDucky,
|
||
|
|
GROUPS => { 0 => 'Ducky', 1 => 'Ducky', 2 => 'Image' },
|
||
|
|
WRITABLE => 'string',
|
||
|
|
NOTES => q{
|
||
|
|
Photoshop uses the JPEG APP12 "Ducky" segment to store some information in
|
||
|
|
"Save for Web" images.
|
||
|
|
},
|
||
|
|
1 => { #PH
|
||
|
|
Name => 'Quality',
|
||
|
|
Priority => 0,
|
||
|
|
Avoid => 1,
|
||
|
|
Writable => 'int32u',
|
||
|
|
ValueConv => 'unpack("N",$val)', # 4-byte integer
|
||
|
|
ValueConvInv => 'pack("N",$val)',
|
||
|
|
PrintConv => '"$val%"',
|
||
|
|
PrintConvInv => '$val=~/(\d+)/ ? $1 : undef',
|
||
|
|
},
|
||
|
|
2 => { #1
|
||
|
|
Name => 'Comment',
|
||
|
|
Priority => 0,
|
||
|
|
Avoid => 1,
|
||
|
|
# (ignore 4-byte character count at start of value)
|
||
|
|
ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
|
||
|
|
ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
|
||
|
|
},
|
||
|
|
3 => { #PH
|
||
|
|
Name => 'Copyright',
|
||
|
|
Priority => 0,
|
||
|
|
Avoid => 1,
|
||
|
|
Groups => { 2 => 'Author' },
|
||
|
|
# (ignore 4-byte character count at start of value)
|
||
|
|
ValueConv => '$self->Decode(substr($val,4),"UCS2","MM")',
|
||
|
|
ValueConvInv => 'pack("N",length $val) . $self->Encode($val,"UCS2","MM")',
|
||
|
|
},
|
||
|
|
);
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Write APP12 Ducky segment
|
||
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
|
||
|
|
# Returns: New directory data or undefined on error
|
||
|
|
sub WriteDucky($$$)
|
||
|
|
{
|
||
|
|
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||
|
|
$et or return 1; # allow dummy access to autoload this package
|
||
|
|
my $dataPt = $$dirInfo{DataPt};
|
||
|
|
my $pos = $$dirInfo{DirStart};
|
||
|
|
my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
|
||
|
|
my @addTags = sort { $a <=> $b } keys(%$newTags);
|
||
|
|
my ($dirEnd, %doneTags);
|
||
|
|
if ($dataPt) {
|
||
|
|
$dirEnd = $pos + $$dirInfo{DirLen};
|
||
|
|
} else {
|
||
|
|
my $tmp = '';
|
||
|
|
$dataPt = \$tmp;
|
||
|
|
$pos = $dirEnd = 0;
|
||
|
|
}
|
||
|
|
my $newData = '';
|
||
|
|
SetByteOrder('MM');
|
||
|
|
# process all data blocks in Ducky segment
|
||
|
|
for (;;) {
|
||
|
|
my ($tag, $len, $val);
|
||
|
|
if ($pos + 4 <= $dirEnd) {
|
||
|
|
$tag = Get16u($dataPt, $pos);
|
||
|
|
$len = Get16u($dataPt, $pos + 2);
|
||
|
|
$pos += 4;
|
||
|
|
if ($pos + $len > $dirEnd) {
|
||
|
|
$et->Warn('Invalid Ducky block length');
|
||
|
|
return undef;
|
||
|
|
}
|
||
|
|
$val = substr($$dataPt, $pos, $len);
|
||
|
|
$pos += $len;
|
||
|
|
} else {
|
||
|
|
last unless @addTags;
|
||
|
|
$tag = pop @addTags;
|
||
|
|
next if $doneTags{$tag};
|
||
|
|
}
|
||
|
|
$doneTags{$tag} = 1;
|
||
|
|
my $tagInfo = $$newTags{$tag};
|
||
|
|
if ($tagInfo) {
|
||
|
|
my $nvHash = $et->GetNewValueHash($tagInfo);
|
||
|
|
my $isNew;
|
||
|
|
if (defined $val) {
|
||
|
|
if ($et->IsOverwriting($nvHash, $val)) {
|
||
|
|
$et->VerboseValue("- Ducky:$$tagInfo{Name}", $val);
|
||
|
|
$isNew = 1;
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
next unless $$nvHash{IsCreating};
|
||
|
|
$isNew = 1;
|
||
|
|
}
|
||
|
|
if ($isNew) {
|
||
|
|
$val = $et->GetNewValue($nvHash);
|
||
|
|
++$$et{CHANGED};
|
||
|
|
next unless defined $val; # next if tag is being deleted
|
||
|
|
$et->VerboseValue("+ Ducky:$$tagInfo{Name}", $val);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$newData .= pack('nn', $tag, length $val) . $val;
|
||
|
|
}
|
||
|
|
$newData .= "\0\0" if length $newData;
|
||
|
|
return $newData;
|
||
|
|
}
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Process APP12 Ducky segment (ref PH)
|
||
|
|
# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
|
||
|
|
# Returns: 1 on success, 0 if this wasn't a recognized Ducky segment
|
||
|
|
# Notes: This segment has the following format:
|
||
|
|
# 1) 5 bytes: "Ducky"
|
||
|
|
# 2) multiple data blocks (all integers are big endian):
|
||
|
|
# a) 2 bytes: block type (0=end, 1=Quality, 2=Comment, 3=Copyright)
|
||
|
|
# b) 2 bytes: block length (N)
|
||
|
|
# c) N bytes: block data
|
||
|
|
sub ProcessDucky($$$)
|
||
|
|
{
|
||
|
|
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||
|
|
my $dataPt = $$dirInfo{DataPt};
|
||
|
|
my $pos = $$dirInfo{DirStart};
|
||
|
|
my $dirEnd = $pos + $$dirInfo{DirLen};
|
||
|
|
SetByteOrder('MM');
|
||
|
|
# process all data blocks in Ducky segment
|
||
|
|
for (;;) {
|
||
|
|
last if $pos + 4 > $dirEnd;
|
||
|
|
my $tag = Get16u($dataPt, $pos);
|
||
|
|
my $len = Get16u($dataPt, $pos + 2);
|
||
|
|
$pos += 4;
|
||
|
|
if ($pos + $len > $dirEnd) {
|
||
|
|
$et->Warn('Invalid Ducky block length');
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
my $val = substr($$dataPt, $pos, $len);
|
||
|
|
$et->HandleTag($tagTablePtr, $tag, $val,
|
||
|
|
DataPt => $dataPt,
|
||
|
|
DataPos => $$dirInfo{DataPos},
|
||
|
|
Start => $pos,
|
||
|
|
Size => $len,
|
||
|
|
);
|
||
|
|
$pos += $len;
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Process APP12 Picture Info segment (ref PH)
|
||
|
|
# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
|
||
|
|
# Returns: 1 on success, 0 if this wasn't a recognized APP12
|
||
|
|
sub ProcessAPP12($$$)
|
||
|
|
{
|
||
|
|
my ($et, $dirInfo, $tagTablePtr) = @_;
|
||
|
|
my $dataPt = $$dirInfo{DataPt};
|
||
|
|
my $dirStart = $$dirInfo{DirStart} || 0;
|
||
|
|
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
|
||
|
|
if ($dirLen != $dirStart + length($$dataPt)) {
|
||
|
|
my $buff = substr($$dataPt, $dirStart, $dirLen);
|
||
|
|
$dataPt = \$buff;
|
||
|
|
} else {
|
||
|
|
pos($$dataPt) = $$dirInfo{DirStart};
|
||
|
|
}
|
||
|
|
my $verbose = $et->Options('Verbose');
|
||
|
|
my $success = 0;
|
||
|
|
my $section = '';
|
||
|
|
pos($$dataPt) = 0;
|
||
|
|
|
||
|
|
# this regular expression is a bit complex, but basically we are looking for
|
||
|
|
# section headers (eg. "[Camera Info]") and tag/value pairs (eg. "tag=value",
|
||
|
|
# where "value" may contain white space), separated by spaces or CR/LF.
|
||
|
|
# (APP12 uses CR/LF, but Olympus TextualInfo is similar and uses spaces)
|
||
|
|
while ($$dataPt =~ /(\[.*?\]|[\w#-]+=[\x20-\x7e]+?(?=\s*([\n\r\0]|[\w#-]+=|\[|$)))/g) {
|
||
|
|
my $token = $1;
|
||
|
|
# was this a section name?
|
||
|
|
if ($token =~ /^\[(.*)\]/) {
|
||
|
|
$et->VerboseDir($1) if $verbose;
|
||
|
|
$section = ($token =~ /\[(\S+) ?Info\]/i) ? $1 : '';
|
||
|
|
$success = 1;
|
||
|
|
next;
|
||
|
|
}
|
||
|
|
$et->VerboseDir($$dirInfo{DirName}) if $verbose and not $success;
|
||
|
|
$success = 1;
|
||
|
|
my ($tag, $val) = ($token =~ /(\S+)=(.+)/);
|
||
|
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
|
||
|
|
$verbose and $et->VerboseInfo($tag, $tagInfo, Value => $val);
|
||
|
|
unless ($tagInfo) {
|
||
|
|
# add new tag to table
|
||
|
|
$tagInfo = { Name => ucfirst $tag };
|
||
|
|
# put in Camera group if information in "Camera" section
|
||
|
|
$$tagInfo{Groups} = { 2 => 'Camera' } if $section =~ /camera/i;
|
||
|
|
AddTagToTable($tagTablePtr, $tag, $tagInfo);
|
||
|
|
}
|
||
|
|
$et->FoundTag($tagInfo, $val);
|
||
|
|
}
|
||
|
|
return $success;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
1; #end
|
||
|
|
|
||
|
|
__END__
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
Image::ExifTool::APP12 - Read APP12 meta information
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
This module is loaded automatically by Image::ExifTool when required.
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
This module contains definitions required by Image::ExifTool to interpret
|
||
|
|
APP12 meta information.
|
||
|
|
|
||
|
|
=head1 AUTHOR
|
||
|
|
|
||
|
|
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||
|
|
|
||
|
|
This library is free software; you can redistribute it and/or modify it
|
||
|
|
under the same terms as Perl itself.
|
||
|
|
|
||
|
|
=head1 ACKNOWLEDGEMENTS
|
||
|
|
|
||
|
|
Thanks to Heinrich Giesen for his help decoding APP12 "Ducky" information.
|
||
|
|
|
||
|
|
=head1 SEE ALSO
|
||
|
|
|
||
|
|
L<Image::ExifTool::TagNames/APP12 Tags>,
|
||
|
|
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||
|
|
|
||
|
|
=cut
|