source: gs2-extensions/parallel-building/trunk/src/perllib/cpan/Image/ExifTool/FlashPix.pm@ 24626

Last change on this file since 24626 was 24626, checked in by jmt12, 13 years ago

An (almost) complete copy of the perllib directory from a (circa SEP2011) head checkout from Greenstone 2 trunk - in order to try and make merging in this extension a little easier later on (as there have been some major changes to buildcol.pl commited in the main trunk but not in the x64 branch)
File size: 68.8 KB
Line 
1#------------------------------------------------------------------------------
2# File: FlashPix.pm
3#
4# Description: Read FlashPix meta information
5#
6# Revisions: 05/29/2006 - P. Harvey Created
7#
8# References: 1) http://www.exif.org/Exif2-2.PDF
9# 2) http://www.graphcomp.com/info/specs/livepicture/fpx.pdf
10# 3) http://search.cpan.org/~jdb/libwin32/
11# 4) http://msdn.microsoft.com/en-us/library/aa380374.aspx
12#------------------------------------------------------------------------------
13
14package Image::ExifTool::FlashPix;
15
16use strict;
17use vars qw($VERSION);
18use Image::ExifTool qw(:DataAccess :Utils);
19use Image::ExifTool::Exif;
20use Image::ExifTool::ASF; # for GetGUID()
21
22$VERSION = '1.19';
23
24sub ProcessFPX($$);
25sub ProcessFPXR($$$);
26sub ProcessProperties($$$);
27sub ReadFPXValue($$$$$;$$);
28sub ProcessHyperlinks($$);
29sub ProcessContents($$$);
30sub SetDocNum($$;$$$);
31
32# sector type constants
33sub HDR_SIZE () { 512; }
34sub DIF_SECT () { 0xfffffffc; }
35sub FAT_SECT () { 0xfffffffd; }
36sub END_OF_CHAIN () { 0xfffffffe; }
37sub FREE_SECT () { 0xffffffff; }
38
39# format flags
40sub VT_VECTOR () { 0x1000; }
41sub VT_ARRAY () { 0x2000; }
42sub VT_BYREF () { 0x4000; }
43sub VT_RESERVED () { 0x8000; }
44
45# other constants
46sub VT_VARIANT () { 12; }
47sub VT_LPSTR () { 30; }
48
49# list of OLE format codes (unsupported codes commented out)
50my %oleFormat = (
51 0 => undef, # VT_EMPTY
52 1 => undef, # VT_NULL
53 2 => 'int16s', # VT_I2
54 3 => 'int32s', # VT_I4
55 4 => 'float', # VT_R4
56 5 => 'double', # VT_R8
57 6 => undef, # VT_CY
58 7 => 'VT_DATE', # VT_DATE (double, number of days since Dec 30, 1899)
59 8 => 'VT_BSTR', # VT_BSTR (int32u count, followed by binary string)
60# 9 => 'VT_DISPATCH',
61 10 => 'int32s', # VT_ERROR
62 11 => 'int16s', # VT_BOOL
63 12 => 'VT_VARIANT', # VT_VARIANT
64# 13 => 'VT_UNKNOWN',
65# 14 => 'VT_DECIMAL',
66 16 => 'int8s', # VT_I1
67 17 => 'int8u', # VT_UI1
68 18 => 'int16u', # VT_UI2
69 19 => 'int32u', # VT_UI4
70 20 => 'int64s', # VT_I8
71 21 => 'int64u', # VT_UI8
72# 22 => 'VT_INT',
73# 23 => 'VT_UINT',
74# 24 => 'VT_VOID',
75# 25 => 'VT_HRESULT',
76# 26 => 'VT_PTR',
77# 27 => 'VT_SAFEARRAY',
78# 28 => 'VT_CARRAY',
79# 29 => 'VT_USERDEFINED',
80 30 => 'VT_LPSTR', # VT_LPSTR (int32u count, followed by string)
81 31 => 'VT_LPWSTR', # VT_LPWSTR (int32u word count, followed by Unicode string)
82 64 => 'VT_FILETIME',# VT_FILETIME (int64u, number of nanoseconds since Jan 1, 1601)
83 65 => 'VT_BLOB', # VT_BLOB
84# 66 => 'VT_STREAM',
85# 67 => 'VT_STORAGE',
86# 68 => 'VT_STREAMED_OBJECT',
87# 69 => 'VT_STORED_OBJECT',
88# 70 => 'VT_BLOB_OBJECT',
89 71 => 'VT_CF', # VT_CF
90 72 => 'VT_CLSID', # VT_CLSID
91);
92
93# OLE flag codes (high nibble of property type)
94my %oleFlags = (
95 0x1000 => 'VT_VECTOR',
96 0x2000 => 'VT_ARRAY', # not yet supported
97 0x4000 => 'VT_BYREF', # ditto
98 0x8000 => 'VT_RESERVED',
99);
100
101# byte sizes for supported VT_* format and flag types
102my %oleFormatSize = (
103 VT_DATE => 8,
104 VT_BSTR => 4, # (+ string length)
105 VT_VARIANT => 4, # (+ data length)
106 VT_LPSTR => 4, # (+ string length)
107 VT_LPWSTR => 4, # (+ string character length)
108 VT_FILETIME => 8,
109 VT_BLOB => 4, # (+ data length)
110 VT_CF => 4, # (+ data length)
111 VT_CLSID => 16,
112 VT_VECTOR => 4, # (+ vector elements)
113);
114
115# names for each type of directory entry
116my @dirEntryType = qw(INVALID STORAGE STREAM LOCKBYTES PROPERTY ROOT);
117
118# list of code pages used by Microsoft
119# (ref http://msdn.microsoft.com/en-us/library/dd317756(VS.85).aspx)
120my %codePage = (
121 037 => 'IBM EBCDIC US-Canada',
122 437 => 'DOS United States',
123 500 => 'IBM EBCDIC International',
124 708 => 'Arabic (ASMO 708)',
125 709 => 'Arabic (ASMO-449+, BCON V4)',
126 710 => 'Arabic - Transparent Arabic',
127 720 => 'DOS Arabic (Transparent ASMO)',
128 737 => 'DOS Greek (formerly 437G)',
129 775 => 'DOS Baltic',
130 850 => 'DOS Latin 1 (Western European)',
131 852 => 'DOS Latin 2 (Central European)',
132 855 => 'DOS Cyrillic (primarily Russian)',
133 857 => 'DOS Turkish',
134 858 => 'DOS Multilingual Latin 1 with Euro',
135 860 => 'DOS Portuguese',
136 861 => 'DOS Icelandic',
137 862 => 'DOS Hebrew',
138 863 => 'DOS French Canadian',
139 864 => 'DOS Arabic',
140 865 => 'DOS Nordic',
141 866 => 'DOS Russian (Cyrillic)',
142 869 => 'DOS Modern Greek',
143 870 => 'IBM EBCDIC Multilingual/ROECE (Latin 2)',
144 874 => 'Windows Thai (same as 28605, ISO 8859-15)',
145 875 => 'IBM EBCDIC Greek Modern',
146 932 => 'Windows Japanese (Shift-JIS)',
147 936 => 'Windows Simplified Chinese (PRC, Singapore)',
148 949 => 'Windows Korean (Unified Hangul Code)',
149 950 => 'Windows Traditional Chinese (Taiwan)',
150 1026 => 'IBM EBCDIC Turkish (Latin 5)',
151 1047 => 'IBM EBCDIC Latin 1/Open System',
152 1140 => 'IBM EBCDIC US-Canada with Euro',
153 1141 => 'IBM EBCDIC Germany with Euro',
154 1142 => 'IBM EBCDIC Denmark-Norway with Euro',
155 1143 => 'IBM EBCDIC Finland-Sweden with Euro',
156 1144 => 'IBM EBCDIC Italy with Euro',
157 1145 => 'IBM EBCDIC Latin America-Spain with Euro',
158 1146 => 'IBM EBCDIC United Kingdom with Euro',
159 1147 => 'IBM EBCDIC France with Euro',
160 1148 => 'IBM EBCDIC International with Euro',
161 1149 => 'IBM EBCDIC Icelandic with Euro',
162 1200 => 'Unicode UTF-16, little endian',
163 1201 => 'Unicode UTF-16, big endian',
164 1250 => 'Windows Latin 2 (Central European)',
165 1251 => 'Windows Cyrillic',
166 1252 => 'Windows Latin 1 (Western European)',
167 1253 => 'Windows Greek',
168 1254 => 'Windows Turkish',
169 1255 => 'Windows Hebrew',
170 1256 => 'Windows Arabic',
171 1257 => 'Windows Baltic',
172 1258 => 'Windows Vietnamese',
173 1361 => 'Korean (Johab)',
174 10000 => 'Mac Roman (Western European)',
175 10001 => 'Mac Japanese',
176 10002 => 'Mac Traditional Chinese',
177 10003 => 'Mac Korean',
178 10004 => 'Mac Arabic',
179 10005 => 'Mac Hebrew',
180 10006 => 'Mac Greek',
181 10007 => 'Mac Cyrillic',
182 10008 => 'Mac Simplified Chinese',
183 10010 => 'Mac Romanian',
184 10017 => 'Mac Ukrainian',
185 10021 => 'Mac Thai',
186 10029 => 'Mac Latin 2 (Central European)',
187 10079 => 'Mac Icelandic',
188 10081 => 'Mac Turkish',
189 10082 => 'Mac Croatian',
190 12000 => 'Unicode UTF-32, little endian',
191 12001 => 'Unicode UTF-32, big endian',
192 20000 => 'CNS Taiwan',
193 20001 => 'TCA Taiwan',
194 20002 => 'Eten Taiwan',
195 20003 => 'IBM5550 Taiwan',
196 20004 => 'TeleText Taiwan',
197 20005 => 'Wang Taiwan',
198 20105 => 'IA5 (IRV International Alphabet No. 5, 7-bit)',
199 20106 => 'IA5 German (7-bit)',
200 20107 => 'IA5 Swedish (7-bit)',
201 20108 => 'IA5 Norwegian (7-bit)',
202 20127 => 'US-ASCII (7-bit)',
203 20261 => 'T.61',
204 20269 => 'ISO 6937 Non-Spacing Accent',
205 20273 => 'IBM EBCDIC Germany',
206 20277 => 'IBM EBCDIC Denmark-Norway',
207 20278 => 'IBM EBCDIC Finland-Sweden',
208 20280 => 'IBM EBCDIC Italy',
209 20284 => 'IBM EBCDIC Latin America-Spain',
210 20285 => 'IBM EBCDIC United Kingdom',
211 20290 => 'IBM EBCDIC Japanese Katakana Extended',
212 20297 => 'IBM EBCDIC France',
213 20420 => 'IBM EBCDIC Arabic',
214 20423 => 'IBM EBCDIC Greek',
215 20424 => 'IBM EBCDIC Hebrew',
216 20833 => 'IBM EBCDIC Korean Extended',
217 20838 => 'IBM EBCDIC Thai',
218 20866 => 'Russian/Cyrillic (KOI8-R)',
219 20871 => 'IBM EBCDIC Icelandic',
220 20880 => 'IBM EBCDIC Cyrillic Russian',
221 20905 => 'IBM EBCDIC Turkish',
222 20924 => 'IBM EBCDIC Latin 1/Open System with Euro',
223 20932 => 'Japanese (JIS 0208-1990 and 0121-1990)',
224 20936 => 'Simplified Chinese (GB2312)',
225 20949 => 'Korean Wansung',
226 21025 => 'IBM EBCDIC Cyrillic Serbian-Bulgarian',
227 21027 => 'Extended Alpha Lowercase (deprecated)',
228 21866 => 'Ukrainian/Cyrillic (KOI8-U)',
229 28591 => 'ISO 8859-1 Latin 1 (Western European)',
230 28592 => 'ISO 8859-2 (Central European)',
231 28593 => 'ISO 8859-3 Latin 3',
232 28594 => 'ISO 8859-4 Baltic',
233 28595 => 'ISO 8859-5 Cyrillic',
234 28596 => 'ISO 8859-6 Arabic',
235 28597 => 'ISO 8859-7 Greek',
236 28598 => 'ISO 8859-8 Hebrew (Visual)',
237 28599 => 'ISO 8859-9 Turkish',
238 28603 => 'ISO 8859-13 Estonian',
239 28605 => 'ISO 8859-15 Latin 9',
240 29001 => 'Europa 3',
241 38598 => 'ISO 8859-8 Hebrew (Logical)',
242 50220 => 'ISO 2022 Japanese with no halfwidth Katakana (JIS)',
243 50221 => 'ISO 2022 Japanese with halfwidth Katakana (JIS-Allow 1 byte Kana)',
244 50222 => 'ISO 2022 Japanese JIS X 0201-1989 (JIS-Allow 1 byte Kana - SO/SI)',
245 50225 => 'ISO 2022 Korean',
246 50227 => 'ISO 2022 Simplified Chinese',
247 50229 => 'ISO 2022 Traditional Chinese',
248 50930 => 'EBCDIC Japanese (Katakana) Extended',
249 50931 => 'EBCDIC US-Canada and Japanese',
250 50933 => 'EBCDIC Korean Extended and Korean',
251 50935 => 'EBCDIC Simplified Chinese Extended and Simplified Chinese',
252 50936 => 'EBCDIC Simplified Chinese',
253 50937 => 'EBCDIC US-Canada and Traditional Chinese',
254 50939 => 'EBCDIC Japanese (Latin) Extended and Japanese',
255 51932 => 'EUC Japanese',
256 51936 => 'EUC Simplified Chinese',
257 51949 => 'EUC Korean',
258 51950 => 'EUC Traditional Chinese',
259 52936 => 'HZ-GB2312 Simplified Chinese',
260 54936 => 'Windows XP and later: GB18030 Simplified Chinese (4 byte)',
261 57002 => 'ISCII Devanagari',
262 57003 => 'ISCII Bengali',
263 57004 => 'ISCII Tamil',
264 57005 => 'ISCII Telugu',
265 57006 => 'ISCII Assamese',
266 57007 => 'ISCII Oriya',
267 57008 => 'ISCII Kannada',
268 57009 => 'ISCII Malayalam',
269 57010 => 'ISCII Gujarati',
270 57011 => 'ISCII Punjabi',
271 65000 => 'Unicode (UTF-7)',
272 65001 => 'Unicode (UTF-8)',
273);
274
275# test for file extensions which may be variants of the FPX format
276# (have seen one password-protected DOCX file that is FPX-like, so assume
277# that all the rest could be as well)
278my %fpxFileType = (
279 DOC => 1, DOCX => 1, DOCM => 1,
280 DOT => 1, DOTX => 1, DOTM => 1,
281 POT => 1, POTX => 1, POTM => 1,
282 PPS => 1, PPSX => 1, PPSM => 1,
283 PPT => 1, PPTX => 1, PPTM => 1, THMX => 1,
284 XLA => 1, XLAM => 1,
285 XLS => 1, XLSX => 1, XLSM => 1, XLSB => 1,
286 XLT => 1, XLTX => 1, XLTM => 1,
287 # non MSOffice types
288 FLA => 1, VSD => 1,
289);
290
291%Image::ExifTool::FlashPix::Main = (
292 PROCESS_PROC => \&ProcessFPXR,
293 GROUPS => { 2 => 'Image' },
294 NOTES => q{
295 The FlashPix file format, introduced in 1996, was developed by Kodak,
296 Hewlett-Packard and Microsoft. Internally the FPX file structure mimics
297 that of an old DOS disk with fixed-sized "sectors" (usually 512 bytes) and a
298 "file allocation table" (FAT). No wonder this image format never became
299 popular. However, some of the structures used in FlashPix streams are part
300 of the EXIF specification, and are still being used in the APP2 FPXR segment
301 of JPEG images by some Kodak and Hewlett-Packard digital cameras.
302
303 ExifTool extracts FlashPix information from both FPX images and the APP2
304 FPXR segment of JPEG images. As well, FlashPix information is extracted
305 from DOC, PPT, XLS (Microsoft Word, PowerPoint and Excel) documents, VSD
306 (Microsoft Visio) drawings, and FLA (Macromedia/Adobe Flash project) files
307 since these are based on the same file format as FlashPix (the Windows
308 Compound Binary File format). See
309 L<http://graphcomp.com/info/specs/livepicture/fpx.pdf> for the FlashPix
310 specification.
311 },
312 "\x05SummaryInformation" => {
313 Name => 'SummaryInfo',
314 SubDirectory => {
315 TagTable => 'Image::ExifTool::FlashPix::SummaryInfo',
316 },
317 },
318 "\x05DocumentSummaryInformation" => {
319 Name => 'DocumentInfo',
320 Multi => 1, # flag to process UserDefined information after this
321 SubDirectory => {
322 TagTable => 'Image::ExifTool::FlashPix::DocumentInfo',
323 },
324 },
325 "\x01CompObj" => {
326 Name => 'CompObj',
327 SubDirectory => {
328 TagTable => 'Image::ExifTool::FlashPix::CompObj',
329 DirStart => 0x1c, # skip stream header
330 },
331 },
332 "\x05Image Info" => {
333 Name => 'ImageInfo',
334 SubDirectory => {
335 TagTable => 'Image::ExifTool::FlashPix::ImageInfo',
336 },
337 },
338 "\x05Image Contents" => {
339 Name => 'Image',
340 SubDirectory => {
341 TagTable => 'Image::ExifTool::FlashPix::Image',
342 },
343 },
344 "Contents" => {
345 Name => 'Contents',
346 Notes => 'found in FLA files; may contain XMP',
347 SubDirectory => {
348 TagTable => 'Image::ExifTool::XMP::Main',
349 ProcessProc => \&ProcessContents,
350 },
351 },
352 "ICC Profile 0001" => {
353 Name => 'ICC_Profile',
354 SubDirectory => {
355 TagTable => 'Image::ExifTool::ICC_Profile::Main',
356 DirStart => 0x1c, # skip stream header
357 },
358 },
359 "\x05Extension List" => {
360 Name => 'Extensions',
361 SubDirectory => {
362 TagTable => 'Image::ExifTool::FlashPix::Extensions',
363 },
364 },
365 'Subimage 0000 Header' => {
366 Name => 'SubimageHdr',
367 SubDirectory => {
368 TagTable => 'Image::ExifTool::FlashPix::SubimageHdr',
369 DirStart => 0x1c, # skip stream header
370 },
371 },
372# 'Subimage 0000 Data'
373 "\x05Data Object" => { # plus instance number (ie. " 000000")
374 Name => 'DataObject',
375 SubDirectory => {
376 TagTable => 'Image::ExifTool::FlashPix::DataObject',
377 },
378 },
379# "\x05Data Object Store" => { # plus instance number (ie. " 000000")
380 "\x05Transform" => { # plus instance number (ie. " 000000")
381 Name => 'Transform',
382 SubDirectory => {
383 TagTable => 'Image::ExifTool::FlashPix::Transform',
384 },
385 },
386 "\x05Operation" => { # plus instance number (ie. " 000000")
387 Name => 'Operation',
388 SubDirectory => {
389 TagTable => 'Image::ExifTool::FlashPix::Operation',
390 },
391 },
392 "\x05Global Info" => {
393 Name => 'GlobalInfo',
394 SubDirectory => {
395 TagTable => 'Image::ExifTool::FlashPix::GlobalInfo',
396 },
397 },
398 "\x05Screen Nail" => { # plus class ID (ie. "_bd0100609719a180")
399 Name => 'ScreenNail',
400 Groups => { 2 => 'Other' },
401 # strip off stream header
402 ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
403 },
404 "\x05Audio Info" => {
405 Name => 'AudioInfo',
406 SubDirectory => {
407 TagTable => 'Image::ExifTool::FlashPix::AudioInfo',
408 },
409 },
410 'Audio Stream' => { # plus instance number (ie. " 000000")
411 Name => 'AudioStream',
412 Groups => { 2 => 'Audio' },
413 # strip off stream header
414 ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
415 },
416 'Current User' => { #PH
417 Name => 'CurrentUser',
418 # not sure what the rest of this data is, but extract ASCII name from it - PH
419 ValueConv => q{
420 return undef if length $val < 12;
421 my ($size,$pos) = unpack('x4VV', $val);
422 my $len = $size - $pos - 4;
423 return undef if $len < 0 or length $val < $size + 8;
424 return substr($val, 8 + $pos, $len);
425 },
426 },
427);
428
429# Summary Information properties
430%Image::ExifTool::FlashPix::SummaryInfo = (
431 PROCESS_PROC => \&ProcessProperties,
432 GROUPS => { 2 => 'Document' },
433 NOTES => q{
434 The Dictionary, CodePage and LocalIndicator tags are common to all FlashPix
435 property tables, even though they are only listed in the SummaryInfo table.
436 },
437 0x00 => { Name => 'Dictionary', Groups => { 2 => 'Other' }, Binary => 1 },
438 0x01 => {
439 Name => 'CodePage',
440 Groups => { 2 => 'Other' },
441 PrintConv => \%codePage,
442 },
443 0x02 => 'Title',
444 0x03 => 'Subject',
445 0x04 => { Name => 'Author', Groups => { 2 => 'Author' } },
446 0x05 => 'Keywords',
447 0x06 => 'Comments',
448 0x07 => 'Template',
449 0x08 => { Name => 'LastModifiedBy', Groups => { 2 => 'Author' } },
450 0x09 => 'RevisionNumber',
451 0x0a => { Name => 'TotalEditTime', PrintConv => 'ConvertTimeSpan($val)' }, # (in sec)
452 0x0b => { Name => 'LastPrinted', Groups => { 2 => 'Time' } },
453 0x0c => {
454 Name => 'CreateDate',
455 Groups => { 2 => 'Time' },
456 PrintConv => '$self->ConvertDateTime($val)',
457 },
458 0x0d => {
459 Name => 'ModifyDate',
460 Groups => { 2 => 'Time' },
461 PrintConv => '$self->ConvertDateTime($val)',
462 },
463 0x0e => 'Pages',
464 0x0f => 'Words',
465 0x10 => 'Characters',
466 0x11 => { Name => 'ThumbnailClip', Binary => 1 },
467 0x12 => {
468 Name => 'Software',
469 RawConv => '$$self{Software} = $val', # (use to determine file type)
470 },
471 0x13 => {
472 Name => 'Security',
473 # see http://msdn.microsoft.com/en-us/library/aa379255(VS.85).aspx
474 PrintConv => {
475 0 => 'None',
476 1 => 'Password protected',
477 2 => 'Read-only recommended',
478 4 => 'Read-only enforced',
479 8 => 'Locked for annotations',
480 },
481 },
482 0x80000000 => { Name => 'LocaleIndicator', Groups => { 2 => 'Other' } },
483);
484
485# Document Summary Information properties (ref 4)
486%Image::ExifTool::FlashPix::DocumentInfo = (
487 PROCESS_PROC => \&ProcessProperties,
488 GROUPS => { 2 => 'Document' },
489 NOTES => q{
490 The DocumentSummaryInformation property set includes a UserDefined property
491 set for which only the Hyperlinks and HyperlinkBase tags are pre-defined.
492 However, ExifTool will also extract any other information found in the
493 UserDefined properties.
494 },
495 0x02 => 'Category',
496 0x03 => 'PresentationTarget',
497 0x04 => 'Bytes',
498 0x05 => 'Lines',
499 0x06 => 'Paragraphs',
500 0x07 => 'Slides',
501 0x08 => 'Notes',
502 0x09 => 'HiddenSlides',
503 0x0a => 'MMClips',
504 0x0b => {
505 Name => 'ScaleCrop',
506 PrintConv => { 0 => 'No', 1 => 'Yes' },
507 },
508 0x0c => 'HeadingPairs',
509 0x0d => 'TitleOfParts',
510 0x0e => 'Manager',
511 0x0f => 'Company',
512 0x10 => {
513 Name => 'LinksUpToDate',
514 PrintConv => { 0 => 'No', 1 => 'Yes' },
515 },
516 0x11 => 'CharCountWithSpaces',
517 # 0x12 ?
518 0x13 => { #PH (unconfirmed)
519 Name => 'SharedDoc',
520 PrintConv => { 0 => 'No', 1 => 'Yes' },
521 },
522 # 0x14 ?
523 # 0x15 ?
524 0x16 => {
525 Name => 'HyperlinksChanged',
526 PrintConv => { 0 => 'No', 1 => 'Yes' },
527 },
528 0x17 => { #PH (unconfirmed handling of lower 16 bits)
529 Name => 'AppVersion',
530 ValueConv => 'sprintf("%d.%.4d",$val >> 16, $val & 0xffff)',
531 },
532 '_PID_LINKBASE' => {
533 Name => 'HyperlinkBase',
534 ValueConv => '$self->Decode($val, "UCS2","II")',
535 },
536 '_PID_HLINKS' => {
537 Name => 'Hyperlinks',
538 RawConv => \&ProcessHyperlinks,
539 },
540);
541
542# Image Information properties
543%Image::ExifTool::FlashPix::ImageInfo = (
544 PROCESS_PROC => \&ProcessProperties,
545 GROUPS => { 2 => 'Image' },
546 0x21000000 => {
547 Name => 'FileSource',
548 PrintConv => {
549 1 => 'Film Scanner',
550 2 => 'Reflection Print Scanner',
551 3 => 'Digital Camera',
552 4 => 'Video Capture',
553 5 => 'Computer Graphics',
554 },
555 },
556 0x21000001 => {
557 Name => 'SceneType',
558 PrintConv => {
559 1 => 'Original Scene',
560 2 => 'Second Generation Scene',
561 3 => 'Digital Scene Generation',
562 },
563 },
564 0x21000002 => 'CreationPathVector',
565 0x21000003 => 'SoftwareRelease',
566 0x21000004 => 'UserDefinedID',
567 0x21000005 => 'SharpnessApproximation',
568 0x22000000 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
569 0x22000001 => { Name => 'OriginalImageBroker', Groups => { 2 => 'Author' } },
570 0x22000002 => { Name => 'DigitalImageBroker', Groups => { 2 => 'Author' } },
571 0x22000003 => { Name => 'Authorship', Groups => { 2 => 'Author' } },
572 0x22000004 => { Name => 'IntellectualPropertyNotes', Groups => { 2 => 'Author' } },
573 0x23000000 => {
574 Name => 'TestTarget',
575 PrintConv => {
576 1 => 'Color Chart',
577 2 => 'Gray Card',
578 3 => 'Grayscale',
579 4 => 'Resolution Chart',
580 5 => 'Inch Scale',
581 6 => 'Centimeter Scale',
582 7 => 'Millimeter Scale',
583 8 => 'Micrometer Scale',
584 },
585 },
586 0x23000002 => 'GroupCaption',
587 0x23000003 => 'CaptionText',
588 0x23000004 => 'People',
589 0x23000007 => 'Things',
590 0x2300000A => {
591 Name => 'DateTimeOriginal',
592 Description => 'Date/Time Original',
593 Groups => { 2 => 'Time' },
594 PrintConv => '$self->ConvertDateTime($val)',
595 },
596 0x2300000B => 'Events',
597 0x2300000C => 'Places',
598 0x2300000F => 'ContentDescriptionNotes',
599 0x24000000 => { Name => 'Make', Groups => { 2 => 'Camera' } },
600 0x24000001 => {
601 Name => 'Model',
602 Description => 'Camera Model Name',
603 Groups => { 2 => 'Camera' },
604 },
605 0x24000002 => { Name => 'SerialNumber', Groups => { 2 => 'Camera' } },
606 0x25000000 => {
607 Name => 'CreateDate',
608 Groups => { 2 => 'Time' },
609 PrintConv => '$self->ConvertDateTime($val)',
610 },
611 0x25000001 => {
612 Name => 'ExposureTime',
613 PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
614 },
615 0x25000002 => {
616 Name => 'FNumber',
617 PrintConv => 'sprintf("%.1f",$val)',
618 },
619 0x25000003 => {
620 Name => 'ExposureProgram',
621 Groups => { 2 => 'Camera' },
622 # use PrintConv of corresponding EXIF tag
623 PrintConv => $Image::ExifTool::Exif::Main{0x8822}->{PrintConv},
624 },
625 0x25000004 => 'BrightnessValue',
626 0x25000005 => 'ExposureCompensation',
627 0x25000006 => {
628 Name => 'SubjectDistance',
629 Groups => { 2 => 'Camera' },
630 PrintConv => 'sprintf("%.3f m", $val)',
631 },
632 0x25000007 => {
633 Name => 'MeteringMode',
634 Groups => { 2 => 'Camera' },
635 PrintConv => $Image::ExifTool::Exif::Main{0x9207}->{PrintConv},
636 },
637 0x25000008 => {
638 Name => 'LightSource',
639 Groups => { 2 => 'Camera' },
640 PrintConv => $Image::ExifTool::Exif::Main{0x9208}->{PrintConv},
641 },
642 0x25000009 => {
643 Name => 'FocalLength',
644 Groups => { 2 => 'Camera' },
645 PrintConv => 'sprintf("%.1f mm",$val)',
646 },
647 0x2500000A => {
648 Name => 'MaxApertureValue',
649 Groups => { 2 => 'Camera' },
650 ValueConv => '2 ** ($val / 2)',
651 PrintConv => 'sprintf("%.1f",$val)',
652 },
653 0x2500000B => {
654 Name => 'Flash',
655 Groups => { 2 => 'Camera' },
656 PrintConv => {
657 1 => 'No Flash',
658 2 => 'Flash Fired',
659 },
660 },
661 0x2500000C => {
662 Name => 'FlashEnergy',
663 Groups => { 2 => 'Camera' },
664 },
665 0x2500000D => {
666 Name => 'FlashReturn',
667 Groups => { 2 => 'Camera' },
668 PrintConv => {
669 1 => 'Subject Outside Flash Range',
670 2 => 'Subject Inside Flash Range',
671 },
672 },
673 0x2500000E => {
674 Name => 'BackLight',
675 PrintConv => {
676 1 => 'Front Lit',
677 2 => 'Back Lit 1',
678 3 => 'Back Lit 2',
679 },
680 },
681 0x2500000F => { Name => 'SubjectLocation', Groups => { 2 => 'Camera' } },
682 0x25000010 => 'ExposureIndex',
683 0x25000011 => {
684 Name => 'SpecialEffectsOpticalFilter',
685 PrintConv => {
686 1 => 'None',
687 2 => 'Colored',
688 3 => 'Diffusion',
689 4 => 'Multi-image',
690 5 => 'Polarizing',
691 6 => 'Split-field',
692 7 => 'Star',
693 },
694 },
695 0x25000012 => 'PerPictureNotes',
696 0x26000000 => {
697 Name => 'SensingMethod',
698 Groups => { 2 => 'Camera' },
699 PrintConv => $Image::ExifTool::Exif::Main{0x9217}->{PrintConv},
700 },
701 0x26000001 => { Name => 'FocalPlaneXResolution', Groups => { 2 => 'Camera' } },
702 0x26000002 => { Name => 'FocalPlaneYResolution', Groups => { 2 => 'Camera' } },
703 0x26000003 => {
704 Name => 'FocalPlaneResolutionUnit',
705 Groups => { 2 => 'Camera' },
706 PrintConv => $Image::ExifTool::Exif::Main{0xa210}->{PrintConv},
707 },
708 0x26000004 => 'SpatialFrequencyResponse',
709 0x26000005 => 'CFAPattern',
710 0x27000001 => {
711 Name => 'FilmCategory',
712 PrintConv => {
713 1 => 'Negative B&W',
714 2 => 'Negative Color',
715 3 => 'Reversal B&W',
716 4 => 'Reversal Color',
717 5 => 'Chromagenic',
718 6 => 'Internegative B&W',
719 7 => 'Internegative Color',
720 },
721 },
722 0x26000007 => 'ISO',
723 0x26000008 => 'Opto-ElectricConvFactor',
724 0x27000000 => 'FilmBrand',
725 0x27000001 => 'FilmCategory',
726 0x27000002 => 'FilmSize',
727 0x27000003 => 'FilmRollNumber',
728 0x27000004 => 'FilmFrameNumber',
729 0x29000000 => 'OriginalScannedImageSize',
730 0x29000001 => 'OriginalDocumentSize',
731 0x29000002 => {
732 Name => 'OriginalMedium',
733 PrintConv => {
734 1 => 'Continuous Tone Image',
735 2 => 'Halftone Image',
736 3 => 'Line Art',
737 },
738 },
739 0x29000003 => {
740 Name => 'TypeOfOriginal',
741 PrintConv => {
742 1 => 'B&W Print',
743 2 => 'Color Print',
744 3 => 'B&W Document',
745 4 => 'Color Document',
746 },
747 },
748 0x28000000 => 'ScannerMake',
749 0x28000001 => 'ScannerModel',
750 0x28000002 => 'ScannerSerialNumber',
751 0x28000003 => 'ScanSoftware',
752 0x28000004 => { Name => 'ScanSoftwareRevisionDate', Groups => { 2 => 'Time' } },
753 0x28000005 => 'ServiceOrganizationName',
754 0x28000006 => 'ScanOperatorID',
755 0x28000008 => {
756 Name => 'ScanDate',
757 Groups => { 2 => 'Time' },
758 PrintConv => '$self->ConvertDateTime($val)',
759 },
760 0x28000009 => {
761 Name => 'ModifyDate',
762 Groups => { 2 => 'Time' },
763 PrintConv => '$self->ConvertDateTime($val)',
764 },
765 0x2800000A => 'ScannerPixelSize',
766);
767
768# Image Contents properties
769%Image::ExifTool::FlashPix::Image = (
770 PROCESS_PROC => \&ProcessProperties,
771 GROUPS => { 2 => 'Image' },
772 # VARS storage is used as a hash lookup for tagID's which aren't constant.
773 # The key is a mask for significant bits of the tagID, and the value
774 # is a lookup for tagID's for which this mask is valid.
775 VARS => {
776 # ID's are different for each subimage
777 0xff00ffff => {
778 0x02000000=>1, 0x02000001=>1, 0x02000002=>1, 0x02000003=>1,
779 0x02000004=>1, 0x02000005=>1, 0x02000006=>1, 0x02000007=>1,
780 0x03000001=>1,
781 },
782 },
783 0x01000000 => 'NumberOfResolutions',
784 0x01000002 => 'ImageWidth', # width of highest resolution image
785 0x01000003 => 'ImageHeight',
786 0x01000004 => 'DefaultDisplayHeight',
787 0x01000005 => 'DefaultDisplayWidth',
788 0x01000006 => {
789 Name => 'DisplayUnits',
790 PrintConv => {
791 0 => 'inches',
792 1 => 'meters',
793 2 => 'cm',
794 3 => 'mm',
795 },
796 },
797 0x02000000 => 'SubimageWidth',
798 0x02000001 => 'SubimageHeight',
799 0x02000002 => {
800 Name => 'SubimageColor',
801 # decode only component count and color space of first component
802 ValueConv => 'sprintf("%.2x %.4x", unpack("x4vx4v",$val))',
803 PrintConv => {
804 '01 0000' => 'Opacity Only',
805 '01 8000' => 'Opacity Only (uncalibrated)',
806 '01 0001' => 'Monochrome',
807 '01 8001' => 'Monochrome (uncalibrated)',
808 '03 0002' => 'YCbCr',
809 '03 8002' => 'YCbCr (uncalibrated)',
810 '03 0003' => 'RGB',
811 '03 8003' => 'RGB (uncalibrated)',
812 '04 0002' => 'YCbCr with Opacity',
813 '04 8002' => 'YCbCr with Opacity (uncalibrated)',
814 '04 0003' => 'RGB with Opacity',
815 '04 8003' => 'RGB with Opacity (uncalibrated)',
816 },
817 },
818 0x02000003 => {
819 Name => 'SubimageNumericalFormat',
820 PrintConv => {
821 17 => '8-bit, Unsigned',
822 18 => '16-bit, Unsigned',
823 19 => '32-bit, Unsigned',
824 },
825 },
826 0x02000004 => {
827 Name => 'DecimationMethod',
828 PrintConv => {
829 0 => 'None (Full-sized Image)',
830 8 => '8-point Prefilter',
831 },
832 },
833 0x02000005 => 'DecimationPrefilterWidth',
834 0x02000007 => 'SubimageICC_Profile',
835 0x03000001 => { Name => 'JPEGTables', Binary => 1 },
836 0x03000002 => 'MaxJPEGTableIndex',
837);
838
839# Extension List properties
840%Image::ExifTool::FlashPix::Extensions = (
841 PROCESS_PROC => \&ProcessProperties,
842 GROUPS => { 2 => 'Other' },
843 VARS => {
844 # ID's are different for each extension type
845 0x0000ffff => {
846 0x0001=>1, 0x0002=>1, 0x0003=>1, 0x0004=>1,
847 0x0005=>1, 0x0006=>1, 0x0007=>1, 0x1000=>1,
848 0x2000=>1, 0x2001=>1, 0x3000=>1, 0x4000=>1,
849 },
850 0x0000f00f => { 0x3001=>1, 0x3002=>1 },
851 },
852 0x10000000 => 'UsedExtensionNumbers',
853 0x0001 => 'ExtensionName',
854 0x0002 => 'ExtensionClassID',
855 0x0003 => {
856 Name => 'ExtensionPersistence',
857 PrintConv => {
858 0 => 'Always Valid',
859 1 => 'Invalidated By Modification',
860 2 => 'Potentially Invalidated By Modification',
861 },
862 },
863 0x0004 => { Name => 'ExtensionCreateDate', Groups => { 2 => 'Time' } },
864 0x0005 => { Name => 'ExtensionModifyDate', Groups => { 2 => 'Time' } },
865 0x0006 => 'CreatingApplication',
866 0x0007 => 'ExtensionDescription',
867 0x1000 => 'Storage-StreamPathname',
868 0x2000 => 'FlashPixStreamPathname',
869 0x2001 => 'FlashPixStreamFieldOffset',
870 0x3000 => 'PropertySetPathname',
871 0x3001 => 'PropertySetIDCodes',
872 0x3002 => 'PropertyVectorElements',
873 0x4000 => 'SubimageResolutions',
874);
875
876# Subimage Header tags
877%Image::ExifTool::FlashPix::SubimageHdr = (
878 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
879 FORMAT => 'int32u',
880# 0 => 'HeaderLength',
881 1 => 'SubimageWidth',
882 2 => 'SubimageHeight',
883 3 => 'SubimageTileCount',
884 4 => 'SubimageTileWidth',
885 5 => 'SubimageTileHeight',
886 6 => 'NumChannels',
887# 7 => 'TileHeaderOffset',
888# 8 => 'TileHeaderLength',
889 # ... followed by tile header table
890);
891
892# Data Object properties
893%Image::ExifTool::FlashPix::DataObject = (
894 PROCESS_PROC => \&ProcessProperties,
895 GROUPS => { 2 => 'Other' },
896 0x00010000 => 'DataObjectID',
897 0x00010002 => 'LockedPropertyList',
898 0x00010003 => 'DataObjectTitle',
899 0x00010004 => 'LastModifier',
900 0x00010005 => 'RevisionNumber',
901 0x00010006 => { Name => 'DataCreateDate', Groups => { 2 => 'Time' } },
902 0x00010007 => { Name => 'DataModifyDate', Groups => { 2 => 'Time' } },
903 0x00010008 => 'CreatingApplication',
904 0x00010100 => {
905 Name => 'DataObjectStatus',
906 PrintConv => q{
907 ($val & 0x0000ffff ? 'Exists' : 'Does Not Exist') .
908 ', ' . ($val & 0xffff0000 ? 'Not ' : '') . 'Purgeable'
909 },
910 },
911 0x00010101 => {
912 Name => 'CreatingTransform',
913 PrintConv => '$val ? $val : "Source Image"',
914 },
915 0x00010102 => 'UsingTransforms',
916 0x10000000 => 'CachedImageHeight',
917 0x10000001 => 'CachedImageWidth',
918);
919
920# Transform properties
921%Image::ExifTool::FlashPix::Transform = (
922 PROCESS_PROC => \&ProcessProperties,
923 GROUPS => { 2 => 'Other' },
924 0x00010000 => 'TransformNodeID',
925 0x00010001 => 'OperationClassID',
926 0x00010002 => 'LockedPropertyList',
927 0x00010003 => 'TransformTitle',
928 0x00010004 => 'LastModifier',
929 0x00010005 => 'RevisionNumber',
930 0x00010006 => { Name => 'TransformCreateDate', Groups => { 2 => 'Time' } },
931 0x00010007 => { Name => 'TransformModifyDate', Groups => { 2 => 'Time' } },
932 0x00010008 => 'CreatingApplication',
933 0x00010100 => 'InputDataObjectList',
934 0x00010101 => 'OutputDataObjectList',
935 0x00010102 => 'OperationNumber',
936 0x10000000 => 'ResultAspectRatio',
937 0x10000001 => 'RectangleOfInterest',
938 0x10000002 => 'Filtering',
939 0x10000003 => 'SpatialOrientation',
940 0x10000004 => 'ColorTwistMatrix',
941 0x10000005 => 'ContrastAdjustment',
942);
943
944# Operation properties
945%Image::ExifTool::FlashPix::Operation = (
946 PROCESS_PROC => \&ProcessProperties,
947 0x00010000 => 'OperationID',
948);
949
950# Global Info properties
951%Image::ExifTool::FlashPix::GlobalInfo = (
952 PROCESS_PROC => \&ProcessProperties,
953 0x00010002 => 'LockedPropertyList',
954 0x00010003 => 'TransformedImageTitle',
955 0x00010004 => 'LastModifier',
956 0x00010100 => 'VisibleOutputs',
957 0x00010101 => 'MaximumImageIndex',
958 0x00010102 => 'MaximumTransformIndex',
959 0x00010103 => 'MaximumOperationIndex',
960);
961
962# Audio Info properties
963%Image::ExifTool::FlashPix::AudioInfo = (
964 PROCESS_PROC => \&ProcessProperties,
965 GROUPS => { 2 => 'Audio' },
966);
967
968# MacroMedia flash contents
969%Image::ExifTool::FlashPix::Contents = (
970 PROCESS_PROC => \&ProcessProperties,
971 GROUPS => { 2 => 'Image' },
972);
973
974# CompObj tags
975%Image::ExifTool::FlashPix::CompObj = (
976 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
977 GROUPS => { 2 => 'Other' },
978 FORMAT => 'int32u',
979 0 => { Name => 'CompObjUserTypeLen' },
980 1 => {
981 Name => 'CompObjUserType',
982 Format => 'string[$val{0}]',
983 RawConv => '$$self{CompObjUserType} = $val', # (use to determine file type)
984 },
985);
986
987# composite FlashPix tags
988%Image::ExifTool::FlashPix::Composite = (
989 GROUPS => { 2 => 'Image' },
990 PreviewImage => {
991 # extract JPEG preview from ScreenNail if possible
992 Require => {
993 0 => 'ScreenNail',
994 },
995 Binary => 1,
996 RawConv => q{
997 return undef unless $val[0] =~ /\xff\xd8\xff/g;
998 return substr($val[0], pos($val[0])-3);
999 },
1000 },
1001);
1002
1003# add our composite tags
1004Image::ExifTool::AddCompositeTags('Image::ExifTool::FlashPix');
1005
1006#------------------------------------------------------------------------------
1007# Process hyperlinks from PID_HYPERLINKS array
1008# (ref http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnaro97ta/html/msdn_hyper97.asp)
1009# Inputs: 0) value, 1) ExifTool ref
1010# Returns: list of hyperlinks
1011sub ProcessHyperlinks($$)
1012{
1013 my ($val, $exifTool) = @_;
1014
1015 # process as an array of VT_VARIANT's
1016 my $dirEnd = length $val;
1017 return undef if $dirEnd < 4;
1018 my $num = Get32u(\$val, 0);
1019 my $valPos = 4;
1020 my ($i, @vals);
1021 for ($i=0; $i<$num; ++$i) {
1022 # read VT_BLOB entries as an array of VT_VARIANT's
1023 my $value = ReadFPXValue($exifTool, \$val, $valPos, VT_VARIANT, $dirEnd);
1024 last unless defined $value;
1025 push @vals, $value;
1026 }
1027 # filter values to extract only the links
1028 my @links;
1029 for ($i=0; $i<@vals; $i+=6) {
1030 push @links, $vals[$i+4]; # get address
1031 $links[-1] .= '#' . $vals[$i+5] if length $vals[$i+5]; # add subaddress
1032 }
1033 return \@links;
1034}
1035
1036#------------------------------------------------------------------------------
1037# Read FlashPix value
1038# Inputs: 0) ExifTool ref, 1) data ref, 2) value offset, 3) FPX format number,
1039# 4) end offset, 5) flag for no padding, 6) code page
1040# Returns: converted value (or list of values in list context) and updates
1041# value offset to end of value if successful, or returns undef on error
1042sub ReadFPXValue($$$$$;$$)
1043{
1044 my ($exifTool, $dataPt, $valPos, $type, $dirEnd, $noPad, $codePage) = @_;
1045 my @vals;
1046
1047 my $format = $oleFormat{$type & 0x0fff};
1048 while ($format) {
1049 my $count = 1;
1050 # handle VT_VECTOR types
1051 my $flags = $type & 0xf000;
1052 if ($flags) {
1053 if ($flags == VT_VECTOR) {
1054 $noPad = 1; # values don't seem to be padded inside vectors
1055 my $size = $oleFormatSize{VT_VECTOR};
1056 last if $valPos + $size > $dirEnd;
1057 $count = Get32u($dataPt, $valPos);
1058 push @vals, '' if $count == 0; # allow zero-element vector
1059 $valPos += 4;
1060 } else {
1061 # can't yet handle this property flag
1062 last;
1063 }
1064 }
1065 unless ($format =~ /^VT_/) {
1066 my $size = Image::ExifTool::FormatSize($format) * $count;
1067 last if $valPos + $size > $dirEnd;
1068 @vals = ReadValue($dataPt, $valPos, $format, $count, $size);
1069 # update position to end of value plus padding
1070 $valPos += ($count * $size + 3) & 0xfffffffc;
1071 last;
1072 }
1073 my $size = $oleFormatSize{$format};
1074 my ($item, $val);
1075 for ($item=0; $item<$count; ++$item) {
1076 last if $valPos + $size > $dirEnd;
1077 if ($format eq 'VT_VARIANT') {
1078 my $subType = Get32u($dataPt, $valPos);
1079 $valPos += $size;
1080 $val = ReadFPXValue($exifTool, $dataPt, $valPos, $subType, $dirEnd, $noPad, $codePage);
1081 last unless defined $val;
1082 push @vals, $val;
1083 next; # avoid adding $size to $valPos again
1084 } elsif ($format eq 'VT_FILETIME') {
1085 # get time in seconds
1086 $val = 1e-7 * Image::ExifTool::Get64u($dataPt, $valPos);
1087 # print as date/time if value is greater than one year (PH hack)
1088 if ($val > 365 * 24 * 3600) {
1089 # shift from Jan 1, 1601 to Jan 1, 1970
1090 $val -= 134774 * 24 * 3600 if $val != 0;
1091 $val = Image::ExifTool::ConvertUnixTime($val);
1092 }
1093 } elsif ($format eq 'VT_DATE') {
1094 $val = Image::ExifTool::GetDouble($dataPt, $valPos);
1095 # shift zero from Dec 30, 1899 to Jan 1, 1970 and convert to secs
1096 $val = ($val - 25569) * 24 * 3600 if $val != 0;
1097 $val = Image::ExifTool::ConvertUnixTime($val);
1098 } elsif ($format =~ /STR$/) {
1099 my $len = Get32u($dataPt, $valPos);
1100 $len *= 2 if $format eq 'VT_LPWSTR'; # convert to byte count
1101 last if $valPos + $len + 4 > $dirEnd;
1102 $val = substr($$dataPt, $valPos + 4, $len);
1103 if ($format eq 'VT_LPWSTR') {
1104 # convert wide string from Unicode
1105 $val = $exifTool->Decode($val, 'UCS2');
1106 } elsif ($codePage) {
1107 my $charset = $Image::ExifTool::charsetName{"cp$codePage"};
1108 if ($charset) {
1109 $val = $exifTool->Decode($val, $charset);
1110 } elsif ($codePage eq 1200) { # UTF-16, little endian
1111 $val = $exifTool->Decode(undef, 'UCS2', 'II');
1112 }
1113 }
1114 $val =~ s/\0.*//s; # truncate at null terminator
1115 # update position for string length
1116 # (the spec states that strings should be padded to align
1117 # on even 32-bit boundaries, but this isn't always the case)
1118 $valPos += $noPad ? $len : ($len + 3) & 0xfffffffc;
1119 } elsif ($format eq 'VT_BLOB' or $format eq 'VT_CF') {
1120 my $len = Get32u($dataPt, $valPos);
1121 last if $valPos + $len + 4 > $dirEnd;
1122 $val = substr($$dataPt, $valPos + 4, $len);
1123 # update position for data length plus padding
1124 # (does this padding disappear in arrays too?)
1125 $valPos += ($len + 3) & 0xfffffffc;
1126 } elsif ($format eq 'VT_CLSID') {
1127 $val = Image::ExifTool::ASF::GetGUID(substr($$dataPt, $valPos, $size));
1128 }
1129 $valPos += $size; # update value pointer to end of value
1130 push @vals, $val;
1131 }
1132 # join VT_ values with commas unless we want an array
1133 @vals = ( join $exifTool->Options('ListSep'), @vals ) if @vals > 1 and not wantarray;
1134 last; # didn't really want to loop
1135 }
1136 $_[2] = $valPos; # return updated value position
1137
1138 if (wantarray) {
1139 return @vals;
1140 } elsif (@vals > 1) {
1141 return join(' ', @vals);
1142 } else {
1143 return $vals[0];
1144 }
1145}
1146
1147#------------------------------------------------------------------------------
1148# Scan for XMP in FLA Contents (ref PH)
1149# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1150# Returns: 1 on success
1151# Notes: FLA format is proprietary and I couldn't find any documentation,
1152# so this routine is entirely based on observations from sample files
1153sub ProcessContents($$$)
1154{
1155 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
1156 my $dataPt = $$dirInfo{DataPt};
1157 my $isFLA;
1158
1159 # all of my FLA samples contain "Contents" data, an no other FPX-like samples have
1160 # this, but check the data for a familiar pattern to be sure this is FLA: the
1161 # Contents of all of my FLA samples start with two bytes (0x29,0x38,0x3f,0x43 or 0x47,
1162 # then 0x01) followed by a number of zero bytes (from 0x18 to 0x26 of them, related
1163 # somehow to the value of the first byte), followed by the string "DocumentPage"
1164 $isFLA = 1 if $$dataPt =~ /^..\0+\xff\xff\x01\0\x0d\0CDocumentPage/;
1165
1166 # do a brute-force scan of the "Contents" for UTF-16 XMP
1167 # (this may always be little-endian, but allow for either endianness)
1168 if ($$dataPt =~ /<\0\?\0x\0p\0a\0c\0k\0e\0t\0 \0b\0e\0g\0i\0n\0=\0['"](\0\xff\xfe|\xfe\xff)/g) {
1169 $$dirInfo{DirStart} = pos($$dataPt) - 36;
1170 if ($$dataPt =~ /<\0\?\0x\0p\0a\0c\0k\0e\0t\0 \0e\0n\0d\0=\0['"]\0[wr]\0['"]\0\?\0>\0?/g) {
1171 $$dirInfo{DirLen} = pos($$dataPt) - $$dirInfo{DirStart};
1172 Image::ExifTool::XMP::ProcessXMP($exifTool, $dirInfo, $tagTablePtr);
1173 # override format if not already FLA but XMP-dc:Format indicates it is
1174 $isFLA = 1 if $$exifTool{FILE_TYPE} ne 'FLA' and $$exifTool{VALUE}{Format} and
1175 $$exifTool{VALUE}{Format} eq 'application/vnd.adobe.fla';
1176 }
1177 }
1178 $exifTool->OverrideFileType('FLA') if $isFLA;
1179 return 1;
1180}
1181
1182#------------------------------------------------------------------------------
1183# Check FPX byte order mark (BOM) and set byte order appropriately
1184# Inputs: 0) data ref, 1) offset to BOM
1185# Returns: true on success
1186sub CheckBOM($$)
1187{
1188 my ($dataPt, $pos) = @_;
1189 my $bom = Get16u($dataPt, $pos);
1190 return 1 if $bom == 0xfffe;
1191 return 0 unless $bom == 0xfeff;
1192 ToggleByteOrder();
1193 return 1;
1194}
1195
1196#------------------------------------------------------------------------------
1197# Process FlashPix properties
1198# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1199# Returns: 1 on success
1200sub ProcessProperties($$$)
1201{
1202 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
1203 my $dataPt = $$dirInfo{DataPt};
1204 my $pos = $$dirInfo{DirStart} || 0;
1205 my $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $pos;
1206 my $dirEnd = $pos + $dirLen;
1207 my $verbose = $exifTool->Options('Verbose');
1208 my $n;
1209
1210 if ($dirLen < 48) {
1211 $exifTool->Warn('Truncated FPX properties');
1212 return 0;
1213 }
1214 # check and set our byte order if necessary
1215 unless (CheckBOM($dataPt, $pos)) {
1216 $exifTool->Warn('Bad FPX property byte order mark');
1217 return 0;
1218 }
1219 # get position of start of section
1220 $pos = Get32u($dataPt, $pos + 44);
1221 if ($pos < 48) {
1222 $exifTool->Warn('Bad FPX property section offset');
1223 return 0;
1224 }
1225 for ($n=0; $n<2; ++$n) {
1226 my %dictionary; # dictionary to translate user-defined properties
1227 my $codePage;
1228 last if $pos + 8 > $dirEnd;
1229 # read property section header
1230 my $size = Get32u($dataPt, $pos);
1231 last unless $size;
1232 my $numEntries = Get32u($dataPt, $pos + 4);
1233 $verbose and $exifTool->VerboseDir('Property Info', $numEntries, $size);
1234 if ($pos + 8 + 8 * $numEntries > $dirEnd) {
1235 $exifTool->Warn('Truncated property list');
1236 last;
1237 }
1238 my $index;
1239 for ($index=0; $index<$numEntries; ++$index) {
1240 my $entry = $pos + 8 + 8 * $index;
1241 my $tag = Get32u($dataPt, $entry);
1242 my $offset = Get32u($dataPt, $entry + 4);
1243 my $valStart = $pos + 4 + $offset;
1244 last if $valStart >= $dirEnd;
1245 my $valPos = $valStart;
1246 my $type = Get32u($dataPt, $pos + $offset);
1247 if ($tag == 0) {
1248 # read dictionary to get tag name lookup for this property set
1249 my $i;
1250 for ($i=0; $i<$type; ++$i) {
1251 last if $valPos + 8 > $dirEnd;
1252 $tag = Get32u($dataPt, $valPos);
1253 my $len = Get32u($dataPt, $valPos + 4);
1254 $valPos += 8 + $len;
1255 last if $valPos > $dirEnd;
1256 my $name = substr($$dataPt, $valPos - $len, $len);
1257 $name =~ s/\0.*//s;
1258 next unless length $name;
1259 $dictionary{$tag} = $name;
1260 next if $$tagTablePtr{$name};
1261 $tag = $name;
1262 $name =~ s/(^| )([a-z])/\U$2/g; # start with uppercase
1263 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
1264 next unless length $name;
1265 $exifTool->VPrint(0, "$$exifTool{INDENT}\[adding $name]\n") if $verbose;
1266 Image::ExifTool::AddTagToTable($tagTablePtr, $tag, { Name => $name });
1267 }
1268 next;
1269 }
1270 # use tag name from dictionary if available
1271 my ($custom, $val);
1272 if (defined $dictionary{$tag}) {
1273 $tag = $dictionary{$tag};
1274 $custom = 1;
1275 }
1276 my @vals = ReadFPXValue($exifTool, $dataPt, $valPos, $type, $dirEnd, undef, $codePage);
1277 @vals or $exifTool->Warn('Error reading property value');
1278 $val = @vals > 1 ? \@vals : $vals[0];
1279 my $format = $type & 0x0fff;
1280 my $flags = $type & 0xf000;
1281 my $formStr = $oleFormat{$format} || "Type $format";
1282 $formStr .= '|' . ($oleFlags{$flags} || sprintf("0x%x",$flags)) if $flags;
1283 my $tagInfo;
1284 # check for common tag ID's: Dictionary, CodePage and LocaleIndicator
1285 # (must be done before masking because masked tags may overlap these ID's)
1286 if (not $custom and ($tag == 1 or $tag == 0x80000000)) {
1287 # get tagInfo from SummaryInfo table
1288 my $summaryTable = GetTagTable('Image::ExifTool::FlashPix::SummaryInfo');
1289 $tagInfo = $exifTool->GetTagInfo($summaryTable, $tag);
1290 if ($tag == 1) {
1291 $val += 0x10000 if $val < 0; # (may be incorrectly stored as int16s)
1292 $codePage = $val; # save code page for translating values
1293 }
1294 } elsif ($$tagTablePtr{$tag}) {
1295 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
1296 } elsif ($$tagTablePtr{VARS} and not $custom) {
1297 # mask off insignificant bits of tag ID if necessary
1298 my $masked = $$tagTablePtr{VARS};
1299 my $mask;
1300 foreach $mask (keys %$masked) {
1301 if ($masked->{$mask}->{$tag & $mask}) {
1302 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag & $mask);
1303 last;
1304 }
1305 }
1306 }
1307 $exifTool->HandleTag($tagTablePtr, $tag, $val,
1308 DataPt => $dataPt,
1309 Start => $valStart,
1310 Size => $valPos - $valStart,
1311 Format => $formStr,
1312 Index => $index,
1313 TagInfo => $tagInfo,
1314 Extra => ", type=$type",
1315 );
1316 }
1317 # issue warning if we hit end of property section prematurely
1318 $exifTool->Warn('Truncated property data') if $index < $numEntries;
1319 last unless $$dirInfo{Multi};
1320 $pos += $size;
1321 }
1322
1323 return 1;
1324}
1325
1326#------------------------------------------------------------------------------
1327# Load chain of sectors from file
1328# Inputs: 0) RAF ref, 1) first sector number, 2) FAT ref, 3) sector size, 4) header size
1329sub LoadChain($$$$$)
1330{
1331 my ($raf, $sect, $fatPt, $sectSize, $hdrSize) = @_;
1332 return undef unless $raf;
1333 my $chain = '';
1334 my ($buff, %loadedSect);
1335 for (;;) {
1336 last if $sect >= END_OF_CHAIN;
1337 return undef if $loadedSect{$sect}; # avoid infinite loop
1338 $loadedSect{$sect} = 1;
1339 my $offset = $sect * $sectSize + $hdrSize;
1340 return undef unless ($offset <= 0x7fffffff or $$raf{LargeFileSupport}) and
1341 $raf->Seek($offset, 0) and
1342 $raf->Read($buff, $sectSize) == $sectSize;
1343 $chain .= $buff;
1344 # step to next sector in chain
1345 return undef if $sect * 4 > length($$fatPt) - 4;
1346 $sect = Get32u($fatPt, $sect * 4);
1347 }
1348 return $chain;
1349}
1350
1351#------------------------------------------------------------------------------
1352# Extract information from a JPEG APP2 FPXR segment
1353# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1354# Returns: 1 on success
1355sub ProcessFPXR($$$)
1356{
1357 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
1358 my $dataPt = $$dirInfo{DataPt};
1359 my $dirStart = $$dirInfo{DirStart};
1360 my $dirLen = $$dirInfo{DirLen};
1361 my $verbose = $exifTool->Options('Verbose');
1362
1363 if ($dirLen < 13) {
1364 $exifTool->Warn('FPXR segment to small');
1365 return 0;
1366 }
1367
1368 # get version and segment type (version is 0 in all my samples)
1369 my ($vers, $type) = unpack('x5C2', $$dataPt);
1370
1371 if ($type == 1) { # a "Contents List" segment
1372
1373 $vers != 0 and $exifTool->Warn("Untested FPXR version $vers");
1374 if ($$exifTool{FPXR}) {
1375 $exifTool->Warn('Multiple FPXR contents lists');
1376 delete $$exifTool{FPXR};
1377 }
1378 my $numEntries = unpack('x7n', $$dataPt);
1379 my @contents;
1380 $verbose and $exifTool->VerboseDir('Contents List', $numEntries);
1381 my $pos = 9;
1382 my $entry;
1383 for ($entry = 0; $entry < $numEntries; ++$entry) {
1384 if ($pos + 4 > $dirLen) {
1385 $exifTool->Warn('Truncated FPXR contents');
1386 return 0;
1387 }
1388 my ($size, $default) = unpack("x${pos}Na", $$dataPt);
1389 pos($$dataPt) = $pos + 5;
1390 # according to the spec, this string is little-endian
1391 # (very odd, since the size word is big-endian),
1392 # and the first char must be '/'
1393 unless ($$dataPt =~ m{\G(/\0(..)*?)\0\0}sg) {
1394 $exifTool->Warn('Invalid FPXR stream name');
1395 return 0;
1396 }
1397 # convert stream pathname to ascii
1398 my $name = Image::ExifTool::Decode(undef, $1, 'UCS2', 'II', 'Latin');
1399 if ($verbose) {
1400 my $psize = ($size == 0xffffffff) ? 'storage' : "$size bytes";
1401 $exifTool->VPrint(0," | $entry) Name: '$name' [$psize]\n");
1402 }
1403 # remove directory specification
1404 $name =~ s{.*/}{}s;
1405 # read storage class ID if necessary
1406 my $classID;
1407 if ($size == 0xffffffff) {
1408 unless ($$dataPt =~ m{(.{16})}sg) {
1409 $exifTool->Warn('Truncated FPXR storage class ID');
1410 return 0;
1411 }
1412 # unpack class ID in case we want to use it sometime
1413 $classID = Image::ExifTool::ASF::GetGUID($1);
1414 }
1415 # update position in list
1416 $pos = pos($$dataPt);
1417 # add to our contents list
1418 push @contents, {
1419 Name => $name,
1420 Size => $size,
1421 Default => $default,
1422 ClassID => $classID,
1423 };
1424 }
1425 # save contents list as $exifTool member variable
1426 # (must do this last so we don't save list on error)
1427 $$exifTool{FPXR} = \@contents;
1428
1429 } elsif ($type == 2) { # a "Stream Data" segment
1430
1431 # get the contents list index and stream data offset
1432 my ($index, $offset) = unpack('x7nN', $$dataPt);
1433 my $fpxr = $$exifTool{FPXR};
1434 if ($fpxr and $$fpxr[$index]) {
1435 my $obj = $$fpxr[$index];
1436 # extract stream data (after 13-byte header)
1437 if (not defined $$obj{Stream}) {
1438 # ignore offset for first segment of this type
1439 # (in my sample images, this isn't always zero as one would expect)
1440 $$obj{Stream} = substr($$dataPt, $dirStart+13);
1441 } else {
1442 # add data to the stream at the proper offset
1443 my $pad = $offset - length($$obj{Stream});
1444 if ($pad >= 0) {
1445 if ($pad) {
1446 if ($pad > 0x10000) {
1447 $exifTool->Warn("Bad FPXR stream offset ($offset)");
1448 } else {
1449 # pad with default value to specified offset
1450 $exifTool->Warn("Padding FPXR stream with $pad default bytes",1);
1451 $$obj{Stream} .= ($$obj{Default} x $pad);
1452 }
1453 }
1454 # concatenate data with this stream
1455 $$obj{Stream} .= substr($$dataPt, $dirStart+13);
1456 } else {
1457 $exifTool->Warn("Duplicate FPXR stream data at offset $offset");
1458 substr($$obj{Stream}, $offset, -$pad) = substr($$dataPt, $dirStart+13);
1459 }
1460 }
1461 # save value for this tag if stream is complete
1462 my $len = length $$obj{Stream};
1463 if ($len >= $$obj{Size}) {
1464 if ($verbose) {
1465 $exifTool->VPrint(0, " + [FPXR stream, Contents index $index, $len bytes]\n");
1466 }
1467 if ($len > $$obj{Size}) {
1468 $exifTool->Warn('Extra data in FPXR segment (truncated)');
1469 $$obj{Stream} = substr($$obj{Stream}, 0, $$obj{Size});
1470 }
1471 my $tag = $$obj{Name};
1472 my $tagInfo;
1473 unless ($$tagTablePtr{$tag}) {
1474 # remove instance number or class ID from tag if necessary
1475 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $1) if
1476 ($tag =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
1477 ($tag =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
1478 }
1479 # save the data for this tag
1480 $exifTool->HandleTag($tagTablePtr, $tag, $$obj{Stream},
1481 DataPt => \$$obj{Stream},
1482 TagInfo => $tagInfo,
1483 );
1484 delete $$obj{Stream}; # done with this stream
1485 }
1486 # hack for improperly stored FujiFilm PreviewImage (stored with no contents list)
1487 } elsif ($index == 512 and $dirLen > 60 and ($$exifTool{FujiPreview} or
1488 ($dirLen > 64 and substr($$dataPt, $dirStart+60, 4) eq "\xff\xd8\xff\xdb")))
1489 {
1490 # recombine PreviewImage, skipping unknown 60 byte header
1491 if ($$exifTool{FujiPreview}) {
1492 $$exifTool{FujiPreview} .= substr($$dataPt, $dirStart+60);
1493 } else {
1494 $$exifTool{FujiPreview} = substr($$dataPt, $dirStart+60);
1495 }
1496 } else {
1497 # (Kodak uses index 255 for a free segment in images from some cameras)
1498 $exifTool->Warn("Unlisted FPXR segment (index $index)") if $index != 255;
1499 }
1500
1501 } elsif ($type ne 3) { # not a "Reserved" segment
1502
1503 $exifTool->Warn("Unknown FPXR segment (type $type)");
1504
1505 }
1506
1507 # clean up if this was the last FPXR segment
1508 if ($$dirInfo{LastFPXR}) {
1509 if ($$exifTool{FPXR}) {
1510 my $obj;
1511 my $i = 0;
1512 foreach $obj (@{$$exifTool{FPXR}}) {
1513 $exifTool->Warn("Missing stream for FPXR object $i") if defined $$obj{Stream};
1514 ++$i;
1515 }
1516 delete $$exifTool{FPXR}; # delete our temporary variables
1517 }
1518 if ($$exifTool{FujiPreview}) {
1519 $exifTool->FoundTag('PreviewImage', $$exifTool{FujiPreview});
1520 delete $$exifTool{FujiPreview};
1521 }
1522 }
1523 return 1;
1524}
1525
1526#------------------------------------------------------------------------------
1527# Set document number for objects
1528# Inputs: 0) object hierarchy hash ref, 1) object index, 2) doc number list ref,
1529# 3) doc numbers used at each level, 4) flag set for metadata levels
1530sub SetDocNum($$;$$$)
1531{
1532 my ($hier, $index, $doc, $used, $meta) = @_;
1533 my $obj = $$hier{$index} or return;
1534 return if exists $$obj{DocNum};
1535 $$obj{DocNum} = $doc;
1536 SetDocNum($hier, $$obj{Left}, $doc, $used, $meta) if $$obj{Left};
1537 SetDocNum($hier, $$obj{Right}, $doc, $used, $meta) if $$obj{Right};
1538 if (defined $$obj{Child}) {
1539 $used or $used = [ ];
1540 my @subDoc;
1541 push @subDoc, @$doc if $doc;
1542 # we must dive down 2 levels for each sub-document, so use the
1543 # $meta flag to add a sub-document level only for every 2nd generation
1544 if ($meta) {
1545 my $subNum = ($$used[scalar @subDoc] || 0);
1546 $$used[scalar @subDoc] = $subNum;
1547 push @subDoc, $subNum;
1548 } elsif (@subDoc) {
1549 $subDoc[-1] = ++$$used[$#subDoc];
1550 }
1551 SetDocNum($hier, $$obj{Child}, \@subDoc, $used, not $meta)
1552 }
1553}
1554
1555#------------------------------------------------------------------------------
1556# Extract information from a FlashPix (FPX) file
1557# Inputs: 0) ExifTool object ref, 1) dirInfo ref
1558# Returns: 1 on success, 0 if this wasn't a valid FPX-format file
1559sub ProcessFPX($$)
1560{
1561 my ($exifTool, $dirInfo) = @_;
1562 my $raf = $$dirInfo{RAF};
1563 my ($buff, $out, %dumpParms, $oldIndent, $miniStreamBuff);
1564 my ($tag, %hier, %objIndex);
1565
1566 # read header
1567 return 0 unless $raf->Read($buff,HDR_SIZE) == HDR_SIZE;
1568 # check signature
1569 return 0 unless $buff =~ /^\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1/;
1570
1571 # set FileType initially based on file extension (we may override this later)
1572 my $fileType = $exifTool->{FILE_EXT};
1573 $fileType = 'FPX' unless $fileType and $fpxFileType{$fileType};
1574 $exifTool->SetFileType($fileType);
1575 SetByteOrder(substr($buff, 0x1c, 2) eq "\xff\xfe" ? 'MM' : 'II');
1576 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
1577 my $verbose = $exifTool->Options('Verbose');
1578 # copy LargeFileSupport option to RAF for use in LoadChain
1579 $$raf{LargeFileSupport} = $exifTool->Options('LargeFileSupport');
1580
1581 my $sectSize = 1 << Get16u(\$buff, 0x1e);
1582 my $miniSize = 1 << Get16u(\$buff, 0x20);
1583 my $fatCount = Get32u(\$buff, 0x2c); # number of FAT sectors
1584 my $dirStart = Get32u(\$buff, 0x30); # first directory sector
1585 my $miniCutoff = Get32u(\$buff, 0x38); # minimum size for big-FAT streams
1586 my $miniStart = Get32u(\$buff, 0x3c); # first sector of mini-FAT
1587 my $miniCount = Get32u(\$buff, 0x40); # number of mini-FAT sectors
1588 my $difStart = Get32u(\$buff, 0x44); # first sector of DIF chain
1589 my $difCount = Get32u(\$buff, 0x48); # number of DIF sectors
1590
1591 if ($verbose) {
1592 $out = $exifTool->Options('TextOut');
1593 $dumpParms{Out} = $out;
1594 $dumpParms{MaxLen} = 96 if $verbose == 3;
1595 print $out " Sector size=$sectSize\n FAT: Count=$fatCount\n";
1596 print $out " DIR: Start=$dirStart\n";
1597 print $out " MiniFAT: Mini-sector size=$miniSize Start=$miniStart Count=$miniCount Cutoff=$miniCutoff\n";
1598 print $out " DIF FAT: Start=$difStart Count=$difCount\n";
1599 }
1600#
1601# load the FAT
1602#
1603 my $pos = 0x4c;
1604 my $endPos = length($buff);
1605 my $fat = '';
1606 my $fatCountCheck = 0;
1607 for (;;) {
1608 while ($pos <= $endPos - 4) {
1609 my $sect = Get32u(\$buff, $pos);
1610 $pos += 4;
1611 next if $sect == FREE_SECT;
1612 my $offset = $sect * $sectSize + HDR_SIZE;
1613 my $fatSect;
1614 unless ($raf->Seek($offset, 0) and
1615 $raf->Read($fatSect, $sectSize) == $sectSize)
1616 {
1617 $exifTool->Error("Error reading FAT from sector $sect");
1618 return 1;
1619 }
1620 $fat .= $fatSect;
1621 ++$fatCountCheck;
1622 }
1623 last if $difStart >= END_OF_CHAIN;
1624 # read next DIF (Dual Indirect FAT) sector
1625 my $offset = $difStart * $sectSize + HDR_SIZE;
1626 unless ($raf->Seek($offset, 0) and $raf->Read($buff, $sectSize) == $sectSize) {
1627 $exifTool->Error("Error reading DIF sector $difStart");
1628 return 1;
1629 }
1630 # set end of sector information in this DIF
1631 $pos = 0;
1632 $endPos = $sectSize - 4;
1633 # next time around we want to read next DIF in chain
1634 $difStart = Get32u(\$buff, $endPos);
1635 }
1636 if ($fatCountCheck != $fatCount) {
1637 $exifTool->Warn("Bad number of FAT sectors (expected $fatCount but found $fatCountCheck)");
1638 }
1639#
1640# load the mini-FAT and the directory
1641#
1642 my $miniFat = LoadChain($raf, $miniStart, \$fat, $sectSize, HDR_SIZE);
1643 my $dir = LoadChain($raf, $dirStart, \$fat, $sectSize, HDR_SIZE);
1644 unless (defined $miniFat and defined $dir) {
1645 $exifTool->Error('Error reading mini-FAT or directory stream');
1646 return 1;
1647 }
1648 if ($verbose) {
1649 print $out " FAT [",length($fat)," bytes]:\n";
1650 Image::ExifTool::HexDump(\$fat, undef, %dumpParms) if $verbose > 2;
1651 print $out " Mini-FAT [",length($miniFat)," bytes]:\n";
1652 Image::ExifTool::HexDump(\$miniFat, undef, %dumpParms) if $verbose > 2;
1653 print $out " Directory [",length($dir)," bytes]:\n";
1654 Image::ExifTool::HexDump(\$dir, undef, %dumpParms) if $verbose > 2;
1655 }
1656#
1657# process the directory
1658#
1659 if ($verbose) {
1660 $oldIndent = $exifTool->{INDENT};
1661 $exifTool->{INDENT} .= '| ';
1662 $exifTool->VerboseDir('FPX', undef, length $dir);
1663 }
1664 my $miniStream;
1665 $endPos = length($dir);
1666 my $index = 0;
1667
1668 for ($pos=0; $pos<=$endPos-128; $pos+=128, ++$index) {
1669
1670 # get directory entry type
1671 # (0=invalid, 1=storage, 2=stream, 3=lockbytes, 4=property, 5=root)
1672 my $type = Get8u(\$dir, $pos + 0x42);
1673 next if $type == 0; # skip invalid entries
1674 if ($type > 5) {
1675 $exifTool->Warn("Invalid directory entry type $type");
1676 last; # rest of directory is probably garbage
1677 }
1678 # get entry name (note: this is supposed to be length in 2-byte
1679 # characters but this isn't what is done in my sample FPX file, so
1680 # be very tolerant of this count -- it's null terminated anyway)
1681 my $len = Get16u(\$dir, $pos + 0x40);
1682 $len > 32 and $len = 32;
1683 $tag = Image::ExifTool::Decode(undef, substr($dir,$pos,$len*2), 'UCS2', 'II', 'Latin');
1684 $tag =~ s/\0.*//s; # truncate at null (in case length was wrong)
1685
1686 my $sect = Get32u(\$dir, $pos + 0x74); # start sector number
1687 my $size = Get32u(\$dir, $pos + 0x78); # stream length
1688
1689 # load Ministream (referenced from first directory entry)
1690 unless ($miniStream) {
1691 $miniStreamBuff = LoadChain($raf, $sect, \$fat, $sectSize, HDR_SIZE);
1692 unless (defined $miniStreamBuff) {
1693 $exifTool->Warn('Error loading Mini-FAT stream');
1694 last;
1695 }
1696 $miniStream = new File::RandomAccess(\$miniStreamBuff);
1697 }
1698
1699 my $tagInfo;
1700 if ($$tagTablePtr{$tag}) {
1701 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
1702 } else {
1703 # remove instance number or class ID from tag if necessary
1704 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $1) if
1705 ($tag =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
1706 ($tag =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
1707 }
1708
1709 my $lSib = Get32u(\$dir, $pos + 0x44); # left sibling
1710 my $rSib = Get32u(\$dir, $pos + 0x48); # right sibling
1711 my $chld = Get32u(\$dir, $pos + 0x4c); # child directory
1712
1713 # save information about object hierachy
1714 my ($obj, $sub);
1715 $obj = $hier{$index} or $obj = $hier{$index} = { };
1716 $$obj{Left} = $lSib unless $lSib == FREE_SECT;
1717 $$obj{Right} = $rSib unless $rSib == FREE_SECT;
1718 unless ($chld == FREE_SECT) {
1719 $$obj{Child} = $chld;
1720 $sub = $hier{$chld} or $sub = $hier{$chld} = { };
1721 $$sub{Parent} = $index;
1722 }
1723
1724 next unless $tagInfo or $verbose;
1725
1726 # load the data for stream types
1727 my $extra = '';
1728 my $typeStr = $dirEntryType[$type] || $type;
1729 if ($typeStr eq 'STREAM') {
1730 if ($size >= $miniCutoff) {
1731 # stream is in the main FAT
1732 $buff = LoadChain($raf, $sect, \$fat, $sectSize, HDR_SIZE);
1733 } elsif ($size) {
1734 # stream is in the mini-FAT
1735 $buff = LoadChain($miniStream, $sect, \$miniFat, $miniSize, 0);
1736 } else {
1737 $buff = ''; # an empty stream
1738 }
1739 unless (defined $buff) {
1740 my $name = $tagInfo ? $$tagInfo{Name} : 'unknown';
1741 $exifTool->Warn("Error reading $name stream");
1742 $buff = '';
1743 }
1744 } elsif ($typeStr eq 'ROOT') {
1745 $buff = $miniStreamBuff;
1746 $extra .= ' (Ministream)';
1747 } else {
1748 $buff = '';
1749 undef $size;
1750 }
1751 if ($verbose) {
1752 my $flags = Get8u(\$dir, $pos + 0x43); # 0=red, 1=black
1753 my $col = { 0 => 'Red', 1 => 'Black' }->{$flags} || $flags;
1754 $extra .= " Type=$typeStr Flags=$col";
1755 $extra .= " Left=$lSib" unless $lSib == FREE_SECT;
1756 $extra .= " Right=$rSib" unless $rSib == FREE_SECT;
1757 $extra .= " Child=$chld" unless $chld == FREE_SECT;
1758 $exifTool->VerboseInfo($tag, $tagInfo,
1759 Index => $index,
1760 Value => $buff,
1761 DataPt => \$buff,
1762 Extra => $extra,
1763 Size => $size,
1764 );
1765 }
1766 if ($tagInfo and $buff) {
1767 my $num = $$exifTool{NUM_FOUND};
1768 my $subdir = $$tagInfo{SubDirectory};
1769 if ($subdir) {
1770 my %dirInfo = (
1771 DataPt => \$buff,
1772 DirStart => $$subdir{DirStart},
1773 DirLen => length $buff,
1774 Multi => $$tagInfo{Multi},
1775 );
1776 my $subTablePtr = GetTagTable($$subdir{TagTable});
1777 $exifTool->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc});
1778 } else {
1779 $exifTool->FoundTag($tagInfo, $buff);
1780 }
1781 # save object index number for all found tags
1782 my $num2 = $$exifTool{NUM_FOUND};
1783 $objIndex{++$num} = $index while $num < $num2;
1784 }
1785 }
1786 # set document numbers for tags extracted from embedded documents
1787 unless ($$exifTool{DOC_NUM}) {
1788 # initialize document number for all objects, beginning at root (index 0)
1789 SetDocNum(\%hier, 0);
1790 # set family 3 group name for all tags in embedded documents
1791 my $order = $$exifTool{FILE_ORDER};
1792 my (@pri, $copy, $member);
1793 foreach $tag (keys %$order) {
1794 my $num = $$order{$tag};
1795 next unless defined $num and $objIndex{$num};
1796 my $obj = $hier{$objIndex{$num}} or next;
1797 my $docNums = $$obj{DocNum};
1798 next unless $docNums and @$docNums;
1799 $$exifTool{TAG_EXTRA}{$tag}{G3} = join '-', @$docNums;
1800 push @pri, $tag unless $tag =~ / /; # save keys for priority sub-doc tags
1801 }
1802 # swap priority sub-document tags with main document tags if they exist
1803 foreach $tag (@pri) {
1804 for ($copy=1; ;++$copy) {
1805 my $key = "$tag ($copy)";
1806 last unless defined $$exifTool{VALUE}{$key};
1807 my $extra = $$exifTool{TAG_EXTRA}{$key};
1808 next if $extra and $$extra{G3}; # not Main if family 3 group is set
1809 foreach $member ('PRIORITY','VALUE','FILE_ORDER','TAG_INFO','TAG_EXTRA') {
1810 my $pHash = $$exifTool{$member};
1811 my $t = $$pHash{$tag};
1812 $$pHash{$tag} = $$pHash{$key};
1813 $$pHash{$key} = $t;
1814 }
1815 last;
1816 }
1817 }
1818 }
1819 $exifTool->{INDENT} = $oldIndent if $verbose;
1820 # try to better identify the file type
1821 if ($$exifTool{VALUE}{FileType} eq 'FPX') {
1822 my $val = $$exifTool{CompObjUserType} || $$exifTool{Software};
1823 if ($val) {
1824 my %type = ( Word => 'DOC', PowerPoint => 'PPT', Excel => 'XLS' );
1825 my $pat;
1826 foreach $pat (sort keys %type) {
1827 next unless $val =~ /$pat/;
1828 $exifTool->OverrideFileType($type{$pat});
1829 last;
1830 }
1831 }
1832 }
1833 return 1;
1834}
1835
18361; # end
1837
1838__END__
1839
1840=head1 NAME
1841
1842Image::ExifTool::FlashPix - Read FlashPix meta information
1843
1844=head1 SYNOPSIS
1845
1846This module is used by Image::ExifTool
1847
1848=head1 DESCRIPTION
1849
1850This module contains routines required by Image::ExifTool to extract
1851FlashPix meta information from FPX images, and from the APP2 FPXR segment of
1852JPEG images.
1853
1854=head1 AUTHOR
1855
1856Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
1857
1858This library is free software; you can redistribute it and/or modify it
1859under the same terms as Perl itself.
1860
1861=head1 REFERENCES
1862
1863=over 4
1864
1865=item L<http://www.exif.org/Exif2-2.PDF>
1866
1867=item L<http://www.graphcomp.com/info/specs/livepicture/fpx.pdf>
1868
1869=item L<http://search.cpan.org/~jdb/libwin32/>
1870
1871=item L<http://msdn.microsoft.com/en-us/library/aa380374.aspx>
1872
1873=back
1874
1875=head1 SEE ALSO
1876
1877L<Image::ExifTool::TagNames/FlashPix Tags>,
1878L<Image::ExifTool::TagNames/OOXML Tags>,
1879L<Image::ExifTool(3pm)|Image::ExifTool>
1880
1881=cut
1882
Note: See TracBrowser for help on using the repository browser.