Tester utilities
This commit is contained in:
@@ -0,0 +1,322 @@
|
||||
#------------------------------------------------------------------------------
|
||||
# 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
|
||||
Reference in New Issue
Block a user