source: gsdl/trunk/perllib/cpan/Image/ExifTool/APP12.pm@ 16842

Last change on this file since 16842 was 16842, checked in by davidb, 16 years ago

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav

File size: 10.9 KB
Line 
1#------------------------------------------------------------------------------
2# File: APP12.pm
3#
4# Description: Read APP12 meta information
5#
6# Revisions: 10/18/2005 - P. Harvey Created
7#
8# References: 1) Heinrich Giesen private communication
9#------------------------------------------------------------------------------
10
11package Image::ExifTool::APP12;
12
13use strict;
14use vars qw($VERSION);
15use Image::ExifTool qw(:DataAccess);
16
17$VERSION = '1.06';
18
19sub ProcessAPP12($$$);
20sub ProcessDucky($$$);
21sub WriteDucky($$$);
22
23# APP12 tags (ref PH)
24%Image::ExifTool::APP12::PictureInfo = (
25 PROCESS_PROC => \&ProcessAPP12,
26 GROUPS => { 0 => 'APP12', 1 => 'PictureInfo', 2 => 'Image' },
27 NOTES => q{
28 The JPEG APP12 "Picture Info" segment was used by some older cameras, and
29 contains ASCII-based meta information. Below are some tags which have been
30 observed Agfa and Polaroid images, however ExifTool will extract information
31 from any tags found in this segment.
32 },
33 FNumber => {
34 ValueConv => '$val=~s/^[A-Za-z ]*//;$val', # Agfa leads with an 'F'
35 PrintConv => 'sprintf("%.1f",$val)',
36 },
37 Aperture => {
38 PrintConv => 'sprintf("%.1f",$val)',
39 },
40 TimeDate => {
41 Name => 'DateTimeOriginal',
42 Description => 'Date/Time Original',
43 Groups => { 2 => 'Time' },
44 ValueConv => '$val=~/^\d+$/ ? ConvertUnixTime($val) : $val',
45 PrintConv => '$self->ConvertDateTime($val)',
46 },
47 Shutter => {
48 Name => 'ExposureTime',
49 ValueConv => '$val * 1e-6',
50 PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
51 },
52 shtr => {
53 Name => 'ExposureTime',
54 ValueConv => '$val * 1e-6',
55 PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
56 },
57 'Serial#' => {
58 Name => 'SerialNumber',
59 Groups => { 2 => 'Camera' },
60 },
61 Flash => { PrintConv => { 0 => 'Off', 1 => 'On' } },
62 Macro => { PrintConv => { 0 => 'Off', 1 => 'On' } },
63 StrobeTime => { },
64 Ytarget => { Name => 'YTarget' },
65 ylevel => { Name => 'YLevel' },
66 FocusPos => { },
67 FocusMode => { },
68 Quality => { },
69 ExpBias => 'ExposureCompensation',
70 FWare => 'FirmwareVersion',
71 StrobeTime => { },
72 Resolution => { },
73 Protect => { },
74 ConTake => { },
75 ImageSize => { PrintConv => '$val=~tr/-/x/;$val' },
76 ColorMode => { },
77 Zoom => { },
78 ZoomPos => { },
79 LightS => { },
80 Type => {
81 Name => 'CameraType',
82 Groups => { 2 => 'Camera' },
83 DataMember => 'CameraType',
84 RawConv => '$self->{CameraType} = $val',
85 },
86 Version => { Groups => { 2 => 'Camera' } },
87 ID => { Groups => { 2 => 'Camera' } },
88);
89
90# APP12 segment written in Photoshop "Save For Web" images
91# (from tests with Photoshop 7 files - PH/1)
92%Image::ExifTool::APP12::Ducky = (
93 PROCESS_PROC => \&ProcessDucky,
94 WRITE_PROC => \&WriteDucky,
95 GROUPS => { 0 => 'Ducky', 1 => 'Ducky', 2 => 'Image' },
96 WRITABLE => 'string',
97 NOTES => q{
98 Photoshop uses the JPEG APP12 "Ducky" segment to store some information in
99 "Save for Web" images.
100 },
101 1 => { #PH
102 Name => 'Quality',
103 Priority => 0,
104 Avoid => 1,
105 Writable => 'int32u',
106 ValueConv => 'unpack("N",$val)', # 4-byte integer
107 ValueConvInv => 'pack("N",$val)',
108 PrintConv => '"$val%"',
109 PrintConvInv => '$val=~/(\d+)/ ? $1 : undef',
110 },
111 2 => { #1
112 Name => 'Comment',
113 Priority => 0,
114 Avoid => 1,
115 # (ignore 4-byte character count at start of value)
116 ValueConv => '$self->Unicode2Charset(substr($val,4),"MM")',
117 ValueConvInv => 'pack("N",length $val) . $self->Charset2Unicode($val,"MM")',
118 },
119 3 => { #PH
120 Name => 'Copyright',
121 Priority => 0,
122 Avoid => 1,
123 Groups => { 2 => 'Author' },
124 # (ignore 4-byte character count at start of value)
125 ValueConv => '$self->Unicode2Charset(substr($val,4),"MM")',
126 ValueConvInv => 'pack("N",length $val) . $self->Charset2Unicode($val,"MM")',
127 },
128);
129
130#------------------------------------------------------------------------------
131# Write APP12 Ducky segment
132# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
133# Returns: New directory data or undefined on error
134sub WriteDucky($$$)
135{
136 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
137 $exifTool or return 1; # allow dummy access to autoload this package
138 my $dataPt = $$dirInfo{DataPt};
139 my $pos = $$dirInfo{DirStart};
140 my $newTags = $exifTool->GetNewTagInfoHash($tagTablePtr);
141 my @addTags = sort { $a <=> $b } keys(%$newTags);
142 my $verbose = $exifTool->Options('Verbose');
143 my $out = $exifTool->Options('TextOut');
144 my ($dirEnd, %doneTags);
145 if ($dataPt) {
146 $dirEnd = $pos + $$dirInfo{DirLen};
147 } else {
148 my $tmp = '';
149 $dataPt = \$tmp;
150 $pos = $dirEnd = 0;
151 }
152 my $newData = '';
153 SetByteOrder('MM');
154 # process all data blocks in Ducky segment
155 for (;;) {
156 my ($tag, $len, $val);
157 if ($pos + 4 <= $dirEnd) {
158 $tag = Get16u($dataPt, $pos);
159 $len = Get16u($dataPt, $pos + 2);
160 $pos += 4;
161 if ($pos + $len > $dirEnd) {
162 $exifTool->Warn('Invalid Ducky block length');
163 return undef;
164 }
165 $val = substr($$dataPt, $pos, $len);
166 $pos += $len;
167 } else {
168 last unless @addTags;
169 $tag = pop @addTags;
170 next if $doneTags{$tag};
171 }
172 $doneTags{$tag} = 1;
173 my $tagInfo = $$newTags{$tag};
174 if ($tagInfo) {
175 my $newValueHash = $exifTool->GetNewValueHash($tagInfo);
176 my $isNew;
177 if (defined $val) {
178 if (Image::ExifTool::IsOverwriting($newValueHash, $val)) {
179 if ($verbose > 1) {
180 my $pval = $exifTool->Printable($val);
181 print $out " - Ducky:$$tagInfo{Name} = '$pval'\n";
182 }
183 $isNew = 1;
184 }
185 } else {
186 next unless Image::ExifTool::IsCreating($newValueHash);
187 $isNew = 1;
188 }
189 if ($isNew) {
190 $val = Image::ExifTool::GetNewValues($newValueHash);
191 ++$exifTool->{CHANGED};
192 next unless defined $val; # next if tag is being deleted
193 if ($verbose > 1) {
194 my $pval = $exifTool->Printable($val);
195 print $out " + Ducky:$$tagInfo{Name} = '$pval'\n";
196 }
197 }
198 }
199 $newData .= pack('nn', $tag, length $val) . $val;
200 }
201 $newData .= "\0\0" if length $newData;
202 return $newData;
203}
204
205#------------------------------------------------------------------------------
206# Process APP12 Ducky segment (ref PH)
207# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
208# Returns: 1 on success, 0 if this wasn't a recognized Ducky segment
209# Notes: This segment has the following format:
210# 1) 5 bytes: "Ducky"
211# 2) multiple data blocks (all integers are big endian):
212# a) 2 bytes: block type (0=end, 1=Quality, 2=Comment, 3=Copyright)
213# b) 2 bytes: block length (N)
214# c) N bytes: block data
215sub ProcessDucky($$$)
216{
217 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
218 my $dataPt = $$dirInfo{DataPt};
219 my $pos = $$dirInfo{DirStart};
220 my $dirEnd = $pos + $$dirInfo{DirLen};
221 SetByteOrder('MM');
222 # process all data blocks in Ducky segment
223 for (;;) {
224 last if $pos + 4 > $dirEnd;
225 my $tag = Get16u($dataPt, $pos);
226 my $len = Get16u($dataPt, $pos + 2);
227 $pos += 4;
228 if ($pos + $len > $dirEnd) {
229 $exifTool->Warn('Invalid Ducky block length');
230 last;
231 }
232 my $val = substr($$dataPt, $pos, $len);
233 $exifTool->HandleTag($tagTablePtr, $tag, $val,
234 DataPt => $dataPt,
235 DataPos => $$dirInfo{DataPos},
236 Start => $pos,
237 Size => $len,
238 );
239 $pos += $len;
240 }
241 return 1;
242}
243
244#------------------------------------------------------------------------------
245# Process APP12 Picture Info segment (ref PH)
246# Inputs: 0) ExifTool object reference, 1) Directory information ref, 2) tag table ref
247# Returns: 1 on success, 0 if this wasn't a recognized APP12
248sub ProcessAPP12($$$)
249{
250 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
251 my $dataPt = $$dirInfo{DataPt};
252 my $dirStart = $$dirInfo{DirStart} || 0;
253 my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
254 if ($dirLen != $dirStart + length($$dataPt)) {
255 my $buff = substr($$dataPt, $dirStart, $dirLen);
256 $dataPt = \$buff;
257 } else {
258 pos($$dataPt) = $$dirInfo{DirStart};
259 }
260 my $verbose = $exifTool->Options('Verbose');
261 my $success = 0;
262 my $section = '';
263 pos($$dataPt) = 0;
264
265 # this regular expression is a bit complex, but basically we are looking for
266 # section headers (ie. "[Camera Info]") and tag/value pairs (ie. "tag=value",
267 # where "value" may contain white space), separated by spaces or CR/LF.
268 # (APP12 uses CR/LF, but Olympus TextualInfo is similar and uses spaces)
269 while ($$dataPt =~ /(\[.*?\]|[\w#-]+=[\x20-\x7e]+?(?=\s*([\n\r\0]|[\w#-]+=|\[|$)))/g) {
270 my $token = $1;
271 # was this a section name?
272 if ($token =~ /^\[(.*)\]/) {
273 $exifTool->VerboseDir($1) if $verbose;
274 $section = ($token =~ /\[(\S+) ?Info\]/i) ? $1 : '';
275 $success = 1;
276 next;
277 }
278 $exifTool->VerboseDir($$dirInfo{DirName}) if $verbose and not $success;
279 $success = 1;
280 my ($tag, $val) = ($token =~ /(\S+)=(.+)/);
281 my $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
282 $verbose and $exifTool->VerboseInfo($tag, $tagInfo, Value => $val);
283 unless ($tagInfo) {
284 # add new tag to table
285 $tagInfo = { Name => $tag };
286 # put in Camera group if information in "Camera" section
287 $$tagInfo{Groups} = { 2 => 'Camera' } if $section =~ /camera/i;
288 Image::ExifTool::AddTagToTable($tagTablePtr, $tag, $tagInfo);
289 }
290 $exifTool->FoundTag($tagInfo, $val);
291 }
292 return $success;
293}
294
295
2961; #end
297
298__END__
299
300=head1 NAME
301
302Image::ExifTool::APP12 - Read APP12 meta information
303
304=head1 SYNOPSIS
305
306This module is loaded automatically by Image::ExifTool when required.
307
308=head1 DESCRIPTION
309
310This module contains definitions required by Image::ExifTool to interpret
311APP12 meta information.
312
313=head1 AUTHOR
314
315Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
316
317This library is free software; you can redistribute it and/or modify it
318under the same terms as Perl itself.
319
320=head1 ACKNOWLEDGEMENTS
321
322Thanks to Heinrich Giesen for his help decoding APP12 "Ducky" information.
323
324=head1 SEE ALSO
325
326L<Image::ExifTool::TagNames/APP12 Tags>,
327L<Image::ExifTool(3pm)|Image::ExifTool>
328
329=cut
Note: See TracBrowser for help on using the repository browser.