123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322 |
- #------------------------------------------------------------------------------
- # 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-2016, 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
|