File Coverage

blib/lib/Image/ExifTool/FlashPix.pm
Criterion Covered Total %
statement 385 639 60.2
branch 184 400 46.0
condition 47 136 34.5
subroutine 14 19 73.6
pod 0 14 0.0
total 630 1208 52.1


line stmt bran cond sub pod time code
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             # 5) http://www.cpan.org/modules/by-authors/id/H/HC/HCARVEY/File-MSWord-0.1.zip
13             # 6) https://msdn.microsoft.com/en-us/library/cc313153(v=office.12).aspx
14             #------------------------------------------------------------------------------
15              
16             package Image::ExifTool::FlashPix;
17              
18 6     6   3543 use strict;
  6         14  
  6         200  
19 6     6   29 use vars qw($VERSION);
  6         12  
  6         307  
20 6     6   33 use Image::ExifTool qw(:DataAccess :Utils);
  6         10  
  6         1397  
21 6     6   1048 use Image::ExifTool::Exif;
  6         55  
  6         146  
22 6     6   3172 use Image::ExifTool::ASF; # for GetGUID()
  6         29  
  6         46913  
23              
24             $VERSION = '1.39';
25              
26             sub ProcessFPX($$);
27             sub ProcessFPXR($$$);
28             sub ProcessProperties($$$);
29             sub ReadFPXValue($$$$$;$$);
30             sub ProcessHyperlinks($$);
31             sub ProcessContents($$$);
32             sub ProcessWordDocument($$$);
33             sub ProcessDocumentTable($);
34             sub ProcessCommentBy($$$);
35             sub ProcessLastSavedBy($$$);
36             sub SetDocNum($$;$$$);
37             sub ConvertDTTM($);
38              
39             # sector type constants
40             sub HDR_SIZE () { 512; }
41             sub DIF_SECT () { 0xfffffffc; }
42             sub FAT_SECT () { 0xfffffffd; }
43             sub END_OF_CHAIN () { 0xfffffffe; }
44             sub FREE_SECT () { 0xffffffff; }
45              
46             # format flags
47             sub VT_VECTOR () { 0x1000; }
48             sub VT_ARRAY () { 0x2000; }
49             sub VT_BYREF () { 0x4000; }
50             sub VT_RESERVED () { 0x8000; }
51              
52             # other constants
53             sub VT_VARIANT () { 12; }
54             sub VT_LPSTR () { 30; }
55              
56             # list of OLE format codes (unsupported codes commented out)
57             my %oleFormat = (
58             0 => undef, # VT_EMPTY
59             1 => undef, # VT_NULL
60             2 => 'int16s', # VT_I2
61             3 => 'int32s', # VT_I4
62             4 => 'float', # VT_R4
63             5 => 'double', # VT_R8
64             6 => undef, # VT_CY
65             7 => 'VT_DATE', # VT_DATE (double, number of days since Dec 30, 1899)
66             8 => 'VT_BSTR', # VT_BSTR (int32u count, followed by binary string)
67             # 9 => 'VT_DISPATCH',
68             10 => 'int32s', # VT_ERROR
69             11 => 'int16s', # VT_BOOL
70             12 => 'VT_VARIANT', # VT_VARIANT
71             # 13 => 'VT_UNKNOWN',
72             # 14 => 'VT_DECIMAL',
73             16 => 'int8s', # VT_I1
74             17 => 'int8u', # VT_UI1
75             18 => 'int16u', # VT_UI2
76             19 => 'int32u', # VT_UI4
77             20 => 'int64s', # VT_I8
78             21 => 'int64u', # VT_UI8
79             # 22 => 'VT_INT',
80             # 23 => 'VT_UINT',
81             # 24 => 'VT_VOID',
82             # 25 => 'VT_HRESULT',
83             # 26 => 'VT_PTR',
84             # 27 => 'VT_SAFEARRAY',
85             # 28 => 'VT_CARRAY',
86             # 29 => 'VT_USERDEFINED',
87             30 => 'VT_LPSTR', # VT_LPSTR (int32u count, followed by string)
88             31 => 'VT_LPWSTR', # VT_LPWSTR (int32u word count, followed by Unicode string)
89             64 => 'VT_FILETIME',# VT_FILETIME (int64u, 100 ns increments since Jan 1, 1601)
90             65 => 'VT_BLOB', # VT_BLOB
91             # 66 => 'VT_STREAM',
92             # 67 => 'VT_STORAGE',
93             # 68 => 'VT_STREAMED_OBJECT',
94             # 69 => 'VT_STORED_OBJECT',
95             # 70 => 'VT_BLOB_OBJECT',
96             71 => 'VT_CF', # VT_CF
97             72 => 'VT_CLSID', # VT_CLSID
98             );
99              
100             # OLE flag codes (high nibble of property type)
101             my %oleFlags = (
102             0x1000 => 'VT_VECTOR',
103             0x2000 => 'VT_ARRAY', # not yet supported
104             0x4000 => 'VT_BYREF', # ditto
105             0x8000 => 'VT_RESERVED',
106             );
107              
108             # byte sizes for supported VT_* format and flag types
109             my %oleFormatSize = (
110             VT_DATE => 8,
111             VT_BSTR => 4, # (+ string length)
112             VT_VARIANT => 4, # (+ data length)
113             VT_LPSTR => 4, # (+ string length)
114             VT_LPWSTR => 4, # (+ string character length)
115             VT_FILETIME => 8,
116             VT_BLOB => 4, # (+ data length)
117             VT_CF => 4, # (+ data length)
118             VT_CLSID => 16,
119             VT_VECTOR => 4, # (+ vector elements)
120             );
121              
122             # names for each type of directory entry
123             my @dirEntryType = qw(INVALID STORAGE STREAM LOCKBYTES PROPERTY ROOT);
124              
125             # list of code pages used by Microsoft
126             # (ref http://msdn.microsoft.com/en-us/library/dd317756(VS.85).aspx)
127             my %codePage = (
128             37 => 'IBM EBCDIC US-Canada',
129             437 => 'DOS United States',
130             500 => 'IBM EBCDIC International',
131             708 => 'Arabic (ASMO 708)',
132             709 => 'Arabic (ASMO-449+, BCON V4)',
133             710 => 'Arabic - Transparent Arabic',
134             720 => 'DOS Arabic (Transparent ASMO)',
135             737 => 'DOS Greek (formerly 437G)',
136             775 => 'DOS Baltic',
137             850 => 'DOS Latin 1 (Western European)',
138             852 => 'DOS Latin 2 (Central European)',
139             855 => 'DOS Cyrillic (primarily Russian)',
140             857 => 'DOS Turkish',
141             858 => 'DOS Multilingual Latin 1 with Euro',
142             860 => 'DOS Portuguese',
143             861 => 'DOS Icelandic',
144             862 => 'DOS Hebrew',
145             863 => 'DOS French Canadian',
146             864 => 'DOS Arabic',
147             865 => 'DOS Nordic',
148             866 => 'DOS Russian (Cyrillic)',
149             869 => 'DOS Modern Greek',
150             870 => 'IBM EBCDIC Multilingual/ROECE (Latin 2)',
151             874 => 'Windows Thai (same as 28605, ISO 8859-15)',
152             875 => 'IBM EBCDIC Greek Modern',
153             932 => 'Windows Japanese (Shift-JIS)',
154             936 => 'Windows Simplified Chinese (PRC, Singapore)',
155             949 => 'Windows Korean (Unified Hangul Code)',
156             950 => 'Windows Traditional Chinese (Taiwan)',
157             1026 => 'IBM EBCDIC Turkish (Latin 5)',
158             1047 => 'IBM EBCDIC Latin 1/Open System',
159             1140 => 'IBM EBCDIC US-Canada with Euro',
160             1141 => 'IBM EBCDIC Germany with Euro',
161             1142 => 'IBM EBCDIC Denmark-Norway with Euro',
162             1143 => 'IBM EBCDIC Finland-Sweden with Euro',
163             1144 => 'IBM EBCDIC Italy with Euro',
164             1145 => 'IBM EBCDIC Latin America-Spain with Euro',
165             1146 => 'IBM EBCDIC United Kingdom with Euro',
166             1147 => 'IBM EBCDIC France with Euro',
167             1148 => 'IBM EBCDIC International with Euro',
168             1149 => 'IBM EBCDIC Icelandic with Euro',
169             1200 => 'Unicode UTF-16, little endian',
170             1201 => 'Unicode UTF-16, big endian',
171             1250 => 'Windows Latin 2 (Central European)',
172             1251 => 'Windows Cyrillic',
173             1252 => 'Windows Latin 1 (Western European)',
174             1253 => 'Windows Greek',
175             1254 => 'Windows Turkish',
176             1255 => 'Windows Hebrew',
177             1256 => 'Windows Arabic',
178             1257 => 'Windows Baltic',
179             1258 => 'Windows Vietnamese',
180             1361 => 'Korean (Johab)',
181             10000 => 'Mac Roman (Western European)',
182             10001 => 'Mac Japanese',
183             10002 => 'Mac Traditional Chinese',
184             10003 => 'Mac Korean',
185             10004 => 'Mac Arabic',
186             10005 => 'Mac Hebrew',
187             10006 => 'Mac Greek',
188             10007 => 'Mac Cyrillic',
189             10008 => 'Mac Simplified Chinese',
190             10010 => 'Mac Romanian',
191             10017 => 'Mac Ukrainian',
192             10021 => 'Mac Thai',
193             10029 => 'Mac Latin 2 (Central European)',
194             10079 => 'Mac Icelandic',
195             10081 => 'Mac Turkish',
196             10082 => 'Mac Croatian',
197             12000 => 'Unicode UTF-32, little endian',
198             12001 => 'Unicode UTF-32, big endian',
199             20000 => 'CNS Taiwan',
200             20001 => 'TCA Taiwan',
201             20002 => 'Eten Taiwan',
202             20003 => 'IBM5550 Taiwan',
203             20004 => 'TeleText Taiwan',
204             20005 => 'Wang Taiwan',
205             20105 => 'IA5 (IRV International Alphabet No. 5, 7-bit)',
206             20106 => 'IA5 German (7-bit)',
207             20107 => 'IA5 Swedish (7-bit)',
208             20108 => 'IA5 Norwegian (7-bit)',
209             20127 => 'US-ASCII (7-bit)',
210             20261 => 'T.61',
211             20269 => 'ISO 6937 Non-Spacing Accent',
212             20273 => 'IBM EBCDIC Germany',
213             20277 => 'IBM EBCDIC Denmark-Norway',
214             20278 => 'IBM EBCDIC Finland-Sweden',
215             20280 => 'IBM EBCDIC Italy',
216             20284 => 'IBM EBCDIC Latin America-Spain',
217             20285 => 'IBM EBCDIC United Kingdom',
218             20290 => 'IBM EBCDIC Japanese Katakana Extended',
219             20297 => 'IBM EBCDIC France',
220             20420 => 'IBM EBCDIC Arabic',
221             20423 => 'IBM EBCDIC Greek',
222             20424 => 'IBM EBCDIC Hebrew',
223             20833 => 'IBM EBCDIC Korean Extended',
224             20838 => 'IBM EBCDIC Thai',
225             20866 => 'Russian/Cyrillic (KOI8-R)',
226             20871 => 'IBM EBCDIC Icelandic',
227             20880 => 'IBM EBCDIC Cyrillic Russian',
228             20905 => 'IBM EBCDIC Turkish',
229             20924 => 'IBM EBCDIC Latin 1/Open System with Euro',
230             20932 => 'Japanese (JIS 0208-1990 and 0121-1990)',
231             20936 => 'Simplified Chinese (GB2312)',
232             20949 => 'Korean Wansung',
233             21025 => 'IBM EBCDIC Cyrillic Serbian-Bulgarian',
234             21027 => 'Extended Alpha Lowercase (deprecated)',
235             21866 => 'Ukrainian/Cyrillic (KOI8-U)',
236             28591 => 'ISO 8859-1 Latin 1 (Western European)',
237             28592 => 'ISO 8859-2 (Central European)',
238             28593 => 'ISO 8859-3 Latin 3',
239             28594 => 'ISO 8859-4 Baltic',
240             28595 => 'ISO 8859-5 Cyrillic',
241             28596 => 'ISO 8859-6 Arabic',
242             28597 => 'ISO 8859-7 Greek',
243             28598 => 'ISO 8859-8 Hebrew (Visual)',
244             28599 => 'ISO 8859-9 Turkish',
245             28603 => 'ISO 8859-13 Estonian',
246             28605 => 'ISO 8859-15 Latin 9',
247             29001 => 'Europa 3',
248             38598 => 'ISO 8859-8 Hebrew (Logical)',
249             50220 => 'ISO 2022 Japanese with no halfwidth Katakana (JIS)',
250             50221 => 'ISO 2022 Japanese with halfwidth Katakana (JIS-Allow 1 byte Kana)',
251             50222 => 'ISO 2022 Japanese JIS X 0201-1989 (JIS-Allow 1 byte Kana - SO/SI)',
252             50225 => 'ISO 2022 Korean',
253             50227 => 'ISO 2022 Simplified Chinese',
254             50229 => 'ISO 2022 Traditional Chinese',
255             50930 => 'EBCDIC Japanese (Katakana) Extended',
256             50931 => 'EBCDIC US-Canada and Japanese',
257             50933 => 'EBCDIC Korean Extended and Korean',
258             50935 => 'EBCDIC Simplified Chinese Extended and Simplified Chinese',
259             50936 => 'EBCDIC Simplified Chinese',
260             50937 => 'EBCDIC US-Canada and Traditional Chinese',
261             50939 => 'EBCDIC Japanese (Latin) Extended and Japanese',
262             51932 => 'EUC Japanese',
263             51936 => 'EUC Simplified Chinese',
264             51949 => 'EUC Korean',
265             51950 => 'EUC Traditional Chinese',
266             52936 => 'HZ-GB2312 Simplified Chinese',
267             54936 => 'Windows XP and later: GB18030 Simplified Chinese (4 byte)',
268             57002 => 'ISCII Devanagari',
269             57003 => 'ISCII Bengali',
270             57004 => 'ISCII Tamil',
271             57005 => 'ISCII Telugu',
272             57006 => 'ISCII Assamese',
273             57007 => 'ISCII Oriya',
274             57008 => 'ISCII Kannada',
275             57009 => 'ISCII Malayalam',
276             57010 => 'ISCII Gujarati',
277             57011 => 'ISCII Punjabi',
278             65000 => 'Unicode (UTF-7)',
279             65001 => 'Unicode (UTF-8)',
280             );
281              
282             # test for file extensions which may be variants of the FPX format
283             # (have seen one password-protected DOCX file that is FPX-like, so assume
284             # that all the rest could be as well)
285             my %fpxFileType = (
286             DOC => 1, DOCX => 1, DOCM => 1,
287             DOT => 1, DOTX => 1, DOTM => 1,
288             POT => 1, POTX => 1, POTM => 1,
289             PPS => 1, PPSX => 1, PPSM => 1,
290             PPT => 1, PPTX => 1, PPTM => 1, THMX => 1,
291             XLA => 1, XLAM => 1,
292             XLS => 1, XLSX => 1, XLSM => 1, XLSB => 1,
293             XLT => 1, XLTX => 1, XLTM => 1,
294             # non MSOffice types
295             FLA => 1, VSD => 1,
296             );
297              
298             %Image::ExifTool::FlashPix::Main = (
299             PROCESS_PROC => \&ProcessFPXR,
300             GROUPS => { 2 => 'Image' },
301             NOTES => q{
302             The FlashPix file format, introduced in 1996, was developed by Kodak,
303             Hewlett-Packard and Microsoft. Internally the FPX file structure mimics
304             that of an old DOS disk with fixed-sized "sectors" (usually 512 bytes) and a
305             "file allocation table" (FAT). No wonder this image format never became
306             popular. However, some of the structures used in FlashPix streams are part
307             of the EXIF specification, and are still being used in the APP2 FPXR segment
308             of JPEG images by some digital cameras from manufacturers such as FujiFilm,
309             Hewlett-Packard, Kodak and Sanyo.
310              
311             ExifTool extracts FlashPix information from both FPX images and the APP2
312             FPXR segment of JPEG images. As well, FlashPix information is extracted
313             from DOC, PPT, XLS (Microsoft Word, PowerPoint and Excel) documents, VSD
314             (Microsoft Visio) drawings, and FLA (Macromedia/Adobe Flash project) files
315             since these are based on the same file format as FlashPix (the Windows
316             Compound Binary File format). Note that ExifTool identifies any
317             unrecognized Windows Compound Binary file as a FlashPix (FPX) file. See
318             L for the FlashPix
319             specification.
320             },
321             "\x05SummaryInformation" => {
322             Name => 'SummaryInfo',
323             SubDirectory => {
324             TagTable => 'Image::ExifTool::FlashPix::SummaryInfo',
325             },
326             },
327             "\x05DocumentSummaryInformation" => {
328             Name => 'DocumentInfo',
329             Multi => 1, # flag to process UserDefined information after this
330             SubDirectory => {
331             TagTable => 'Image::ExifTool::FlashPix::DocumentInfo',
332             },
333             },
334             "\x01CompObj" => {
335             Name => 'CompObj',
336             SubDirectory => {
337             TagTable => 'Image::ExifTool::FlashPix::CompObj',
338             DirStart => 0x1c, # skip stream header
339             },
340             },
341             "\x05Image Info" => {
342             Name => 'ImageInfo',
343             SubDirectory => {
344             TagTable => 'Image::ExifTool::FlashPix::ImageInfo',
345             },
346             },
347             "\x05Image Contents" => {
348             Name => 'Image',
349             SubDirectory => {
350             TagTable => 'Image::ExifTool::FlashPix::Image',
351             },
352             },
353             "Contents" => {
354             Name => 'Contents',
355             Notes => 'found in FLA files; may contain XMP',
356             SubDirectory => {
357             TagTable => 'Image::ExifTool::XMP::Main',
358             ProcessProc => \&ProcessContents,
359             },
360             },
361             "ICC Profile 0001" => {
362             Name => 'ICC_Profile',
363             SubDirectory => {
364             TagTable => 'Image::ExifTool::ICC_Profile::Main',
365             DirStart => 0x1c, # skip stream header
366             },
367             },
368             "\x05Extension List" => {
369             Name => 'Extensions',
370             SubDirectory => {
371             TagTable => 'Image::ExifTool::FlashPix::Extensions',
372             },
373             },
374             'Subimage 0000 Header' => {
375             Name => 'SubimageHdr',
376             SubDirectory => {
377             TagTable => 'Image::ExifTool::FlashPix::SubimageHdr',
378             DirStart => 0x1c, # skip stream header
379             },
380             },
381             # 'Subimage 0000 Data'
382             "\x05Data Object" => { # plus instance number (eg. " 000000")
383             Name => 'DataObject',
384             SubDirectory => {
385             TagTable => 'Image::ExifTool::FlashPix::DataObject',
386             },
387             },
388             # "\x05Data Object Store" => { # plus instance number (eg. " 000000")
389             "\x05Transform" => { # plus instance number (eg. " 000000")
390             Name => 'Transform',
391             SubDirectory => {
392             TagTable => 'Image::ExifTool::FlashPix::Transform',
393             },
394             },
395             "\x05Operation" => { # plus instance number (eg. " 000000")
396             Name => 'Operation',
397             SubDirectory => {
398             TagTable => 'Image::ExifTool::FlashPix::Operation',
399             },
400             },
401             "\x05Global Info" => {
402             Name => 'GlobalInfo',
403             SubDirectory => {
404             TagTable => 'Image::ExifTool::FlashPix::GlobalInfo',
405             },
406             },
407             "\x05Screen Nail" => { # plus class ID (eg. "_bd0100609719a180")
408             Name => 'ScreenNail',
409             Groups => { 2 => 'Other' },
410             # strip off stream header
411             ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
412             },
413             "\x05Audio Info" => {
414             Name => 'AudioInfo',
415             SubDirectory => {
416             TagTable => 'Image::ExifTool::FlashPix::AudioInfo',
417             },
418             },
419             'Audio Stream' => { # plus instance number (eg. " 000000")
420             Name => 'AudioStream',
421             Groups => { 2 => 'Audio' },
422             # strip off stream header
423             ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
424             },
425             'Current User' => { #PH
426             Name => 'CurrentUser',
427             # not sure what the rest of this data is, but extract ASCII name from it - PH
428             ValueConv => q{
429             return undef if length $val < 12;
430             my ($size,$pos) = unpack('x4VV', $val);
431             my $len = $size - $pos - 4;
432             return undef if $len < 0 or length $val < $size + 8;
433             return substr($val, 8 + $pos, $len);
434             },
435             },
436             'WordDocument' => {
437             Name => 'WordDocument',
438             SubDirectory => { TagTable => 'Image::ExifTool::FlashPix::WordDocument' },
439             },
440             # save these tables until after the WordDocument was processed
441             '0Table' => {
442             Name => 'Table0',
443             Hidden => 1, # (used only as temporary storage until table is processed)
444             Binary => 1,
445             },
446             '1Table' => {
447             Name => 'Table1',
448             Hidden => 1, # (used only as temporary storage until table is processed)
449             Binary => 1,
450             },
451             Preview => {
452             Name => 'PreviewImage',
453             Groups => { 2 => 'Preview' },
454             Binary => 1,
455             Notes => 'written by some FujiFilm models',
456             # skip 47-byte Fuji header
457             RawConv => q{
458             return undef unless length $val > 47;
459             $val = substr($val, 47);
460             return $val =~ /^\xff\xd8\xff/ ? $val : undef;
461             },
462             },
463             Property => {
464             Name => 'PreviewInfo',
465             SubDirectory => {
466             TagTable => 'Image::ExifTool::FlashPix::PreviewInfo',
467             ByteOrder => 'BigEndian',
468             },
469             },
470             );
471              
472             # Summary Information properties
473             %Image::ExifTool::FlashPix::SummaryInfo = (
474             PROCESS_PROC => \&ProcessProperties,
475             GROUPS => { 2 => 'Document' },
476             NOTES => q{
477             The Dictionary, CodePage and LocalIndicator tags are common to all FlashPix
478             property tables, even though they are only listed in the SummaryInfo table.
479             },
480             0x00 => { Name => 'Dictionary', Groups => { 2 => 'Other' }, Binary => 1 },
481             0x01 => {
482             Name => 'CodePage',
483             Groups => { 2 => 'Other' },
484             PrintConv => \%codePage,
485             },
486             0x02 => 'Title',
487             0x03 => 'Subject',
488             0x04 => { Name => 'Author', Groups => { 2 => 'Author' } },
489             0x05 => 'Keywords',
490             0x06 => 'Comments',
491             0x07 => 'Template',
492             0x08 => { Name => 'LastModifiedBy', Groups => { 2 => 'Author' } },
493             0x09 => 'RevisionNumber',
494             0x0a => { Name => 'TotalEditTime', PrintConv => 'ConvertTimeSpan($val)' }, # (in sec)
495             0x0b => { Name => 'LastPrinted', Groups => { 2 => 'Time' } },
496             0x0c => {
497             Name => 'CreateDate',
498             Groups => { 2 => 'Time' },
499             PrintConv => '$self->ConvertDateTime($val)',
500             },
501             0x0d => {
502             Name => 'ModifyDate',
503             Groups => { 2 => 'Time' },
504             PrintConv => '$self->ConvertDateTime($val)',
505             },
506             0x0e => 'Pages',
507             0x0f => 'Words',
508             0x10 => 'Characters',
509             0x11 => {
510             Name => 'ThumbnailClip',
511             # (not a displayable format, so not in the "Preview" group)
512             Binary => 1,
513             },
514             0x12 => {
515             Name => 'Software',
516             RawConv => '$$self{Software} = $val', # (use to determine file type)
517             },
518             0x13 => {
519             Name => 'Security',
520             # see http://msdn.microsoft.com/en-us/library/aa379255(VS.85).aspx
521             PrintConv => {
522             0 => 'None',
523             BITMASK => {
524             0 => 'Password protected',
525             1 => 'Read-only recommended',
526             2 => 'Read-only enforced',
527             3 => 'Locked for annotations',
528             },
529             },
530             },
531             0x22 => { Name => 'CreatedBy', Groups => { 2 => 'Author' } }, #PH (guess) (MAX files)
532             0x23 => 'DocumentID', # PH (guess) (MAX files)
533             # 0x25 ? seen values 1.0-1.97 (MAX files)
534             0x80000000 => { Name => 'LocaleIndicator', Groups => { 2 => 'Other' } },
535             );
536              
537             # Document Summary Information properties (ref 4)
538             %Image::ExifTool::FlashPix::DocumentInfo = (
539             PROCESS_PROC => \&ProcessProperties,
540             GROUPS => { 2 => 'Document' },
541             NOTES => q{
542             The DocumentSummaryInformation property set includes a UserDefined property
543             set for which only the Hyperlinks and HyperlinkBase tags are pre-defined.
544             However, ExifTool will also extract any other information found in the
545             UserDefined properties.
546             },
547             0x02 => 'Category',
548             0x03 => 'PresentationTarget',
549             0x04 => 'Bytes',
550             0x05 => 'Lines',
551             0x06 => 'Paragraphs',
552             0x07 => 'Slides',
553             0x08 => 'Notes',
554             0x09 => 'HiddenSlides',
555             0x0a => 'MMClips',
556             0x0b => {
557             Name => 'ScaleCrop',
558             PrintConv => { 0 => 'No', 1 => 'Yes' },
559             },
560             0x0c => 'HeadingPairs',
561             0x0d => {
562             Name => 'TitleOfParts',
563             # look for "3ds Max" software name at beginning of TitleOfParts
564             RawConv => q{
565             (ref $val eq 'ARRAY' ? $$val[0] : $val) =~ /^(3ds Max)/ and $$self{Software} = $1;
566             return $val;
567             }
568             },
569             0x0e => 'Manager',
570             0x0f => 'Company',
571             0x10 => {
572             Name => 'LinksUpToDate',
573             PrintConv => { 0 => 'No', 1 => 'Yes' },
574             },
575             0x11 => 'CharCountWithSpaces',
576             # 0x12 ? seen -32.1850395202637,-386.220672607422,-9.8100004196167,-9810,...
577             0x13 => { #PH (unconfirmed)
578             Name => 'SharedDoc',
579             PrintConv => { 0 => 'No', 1 => 'Yes' },
580             },
581             # 0x14 ? seen -1
582             # 0x15 ? seen 1
583             0x16 => {
584             Name => 'HyperlinksChanged',
585             PrintConv => { 0 => 'No', 1 => 'Yes' },
586             },
587             0x17 => { #PH (unconfirmed handling of lower 16 bits, not valid for MAX files)
588             Name => 'AppVersion',
589             ValueConv => 'sprintf("%d.%.4d",$val >> 16, $val & 0xffff)',
590             },
591             # 0x18 ? seen -1
592             # 0x19 ? seen 0
593             # 0x1a ? seen 0
594             # 0x1b ? seen 0
595             # 0x1c ? seen 0,1
596             # 0x1d ? seen 1
597             # 0x1e ? seen 1
598             # 0x1f ? seen 1,5
599             # 0x20 ? seen 0,5
600             # 0x21 ? seen -1
601             # 0x22 ? seen 0
602             '_PID_LINKBASE' => {
603             Name => 'HyperlinkBase',
604             ValueConv => '$self->Decode($val, "UCS2","II")',
605             },
606             '_PID_HLINKS' => {
607             Name => 'Hyperlinks',
608             RawConv => \&ProcessHyperlinks,
609             },
610             );
611              
612             # Image Information properties
613             %Image::ExifTool::FlashPix::ImageInfo = (
614             PROCESS_PROC => \&ProcessProperties,
615             GROUPS => { 2 => 'Image' },
616             0x21000000 => {
617             Name => 'FileSource',
618             PrintConv => {
619             1 => 'Film Scanner',
620             2 => 'Reflection Print Scanner',
621             3 => 'Digital Camera',
622             4 => 'Video Capture',
623             5 => 'Computer Graphics',
624             },
625             },
626             0x21000001 => {
627             Name => 'SceneType',
628             PrintConv => {
629             1 => 'Original Scene',
630             2 => 'Second Generation Scene',
631             3 => 'Digital Scene Generation',
632             },
633             },
634             0x21000002 => 'CreationPathVector',
635             0x21000003 => 'SoftwareRelease',
636             0x21000004 => 'UserDefinedID',
637             0x21000005 => 'SharpnessApproximation',
638             0x22000000 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
639             0x22000001 => { Name => 'OriginalImageBroker', Groups => { 2 => 'Author' } },
640             0x22000002 => { Name => 'DigitalImageBroker', Groups => { 2 => 'Author' } },
641             0x22000003 => { Name => 'Authorship', Groups => { 2 => 'Author' } },
642             0x22000004 => { Name => 'IntellectualPropertyNotes', Groups => { 2 => 'Author' } },
643             0x23000000 => {
644             Name => 'TestTarget',
645             PrintConv => {
646             1 => 'Color Chart',
647             2 => 'Gray Card',
648             3 => 'Grayscale',
649             4 => 'Resolution Chart',
650             5 => 'Inch Scale',
651             6 => 'Centimeter Scale',
652             7 => 'Millimeter Scale',
653             8 => 'Micrometer Scale',
654             },
655             },
656             0x23000002 => 'GroupCaption',
657             0x23000003 => 'CaptionText',
658             0x23000004 => 'People',
659             0x23000007 => 'Things',
660             0x2300000A => {
661             Name => 'DateTimeOriginal',
662             Description => 'Date/Time Original',
663             Groups => { 2 => 'Time' },
664             PrintConv => '$self->ConvertDateTime($val)',
665             },
666             0x2300000B => 'Events',
667             0x2300000C => 'Places',
668             0x2300000F => 'ContentDescriptionNotes',
669             0x24000000 => { Name => 'Make', Groups => { 2 => 'Camera' } },
670             0x24000001 => {
671             Name => 'Model',
672             Description => 'Camera Model Name',
673             Groups => { 2 => 'Camera' },
674             },
675             0x24000002 => { Name => 'SerialNumber', Groups => { 2 => 'Camera' } },
676             0x25000000 => {
677             Name => 'CreateDate',
678             Groups => { 2 => 'Time' },
679             PrintConv => '$self->ConvertDateTime($val)',
680             },
681             0x25000001 => {
682             Name => 'ExposureTime',
683             PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
684             },
685             0x25000002 => {
686             Name => 'FNumber',
687             PrintConv => 'sprintf("%.1f",$val)',
688             },
689             0x25000003 => {
690             Name => 'ExposureProgram',
691             Groups => { 2 => 'Camera' },
692             # use PrintConv of corresponding EXIF tag
693             PrintConv => $Image::ExifTool::Exif::Main{0x8822}->{PrintConv},
694             },
695             0x25000004 => 'BrightnessValue',
696             0x25000005 => 'ExposureCompensation',
697             0x25000006 => {
698             Name => 'SubjectDistance',
699             Groups => { 2 => 'Camera' },
700             PrintConv => 'sprintf("%.3f m", $val)',
701             },
702             0x25000007 => {
703             Name => 'MeteringMode',
704             Groups => { 2 => 'Camera' },
705             PrintConv => $Image::ExifTool::Exif::Main{0x9207}->{PrintConv},
706             },
707             0x25000008 => {
708             Name => 'LightSource',
709             Groups => { 2 => 'Camera' },
710             PrintConv => $Image::ExifTool::Exif::Main{0x9208}->{PrintConv},
711             },
712             0x25000009 => {
713             Name => 'FocalLength',
714             Groups => { 2 => 'Camera' },
715             PrintConv => 'sprintf("%.1f mm",$val)',
716             },
717             0x2500000A => {
718             Name => 'MaxApertureValue',
719             Groups => { 2 => 'Camera' },
720             ValueConv => '2 ** ($val / 2)',
721             PrintConv => 'sprintf("%.1f",$val)',
722             },
723             0x2500000B => {
724             Name => 'Flash',
725             Groups => { 2 => 'Camera' },
726             PrintConv => {
727             1 => 'No Flash',
728             2 => 'Flash Fired',
729             },
730             },
731             0x2500000C => {
732             Name => 'FlashEnergy',
733             Groups => { 2 => 'Camera' },
734             },
735             0x2500000D => {
736             Name => 'FlashReturn',
737             Groups => { 2 => 'Camera' },
738             PrintConv => {
739             1 => 'Subject Outside Flash Range',
740             2 => 'Subject Inside Flash Range',
741             },
742             },
743             0x2500000E => {
744             Name => 'BackLight',
745             PrintConv => {
746             1 => 'Front Lit',
747             2 => 'Back Lit 1',
748             3 => 'Back Lit 2',
749             },
750             },
751             0x2500000F => { Name => 'SubjectLocation', Groups => { 2 => 'Camera' } },
752             0x25000010 => 'ExposureIndex',
753             0x25000011 => {
754             Name => 'SpecialEffectsOpticalFilter',
755             PrintConv => {
756             1 => 'None',
757             2 => 'Colored',
758             3 => 'Diffusion',
759             4 => 'Multi-image',
760             5 => 'Polarizing',
761             6 => 'Split-field',
762             7 => 'Star',
763             },
764             },
765             0x25000012 => 'PerPictureNotes',
766             0x26000000 => {
767             Name => 'SensingMethod',
768             Groups => { 2 => 'Camera' },
769             PrintConv => $Image::ExifTool::Exif::Main{0x9217}->{PrintConv},
770             },
771             0x26000001 => { Name => 'FocalPlaneXResolution', Groups => { 2 => 'Camera' } },
772             0x26000002 => { Name => 'FocalPlaneYResolution', Groups => { 2 => 'Camera' } },
773             0x26000003 => {
774             Name => 'FocalPlaneResolutionUnit',
775             Groups => { 2 => 'Camera' },
776             PrintConv => $Image::ExifTool::Exif::Main{0xa210}->{PrintConv},
777             },
778             0x26000004 => 'SpatialFrequencyResponse',
779             0x26000005 => 'CFAPattern',
780             0x27000001 => {
781             Name => 'FilmCategory',
782             PrintConv => {
783             1 => 'Negative B&W',
784             2 => 'Negative Color',
785             3 => 'Reversal B&W',
786             4 => 'Reversal Color',
787             5 => 'Chromagenic',
788             6 => 'Internegative B&W',
789             7 => 'Internegative Color',
790             },
791             },
792             0x26000007 => 'ISO',
793             0x26000008 => 'Opto-ElectricConvFactor',
794             0x27000000 => 'FilmBrand',
795             0x27000001 => 'FilmCategory',
796             0x27000002 => 'FilmSize',
797             0x27000003 => 'FilmRollNumber',
798             0x27000004 => 'FilmFrameNumber',
799             0x29000000 => 'OriginalScannedImageSize',
800             0x29000001 => 'OriginalDocumentSize',
801             0x29000002 => {
802             Name => 'OriginalMedium',
803             PrintConv => {
804             1 => 'Continuous Tone Image',
805             2 => 'Halftone Image',
806             3 => 'Line Art',
807             },
808             },
809             0x29000003 => {
810             Name => 'TypeOfOriginal',
811             PrintConv => {
812             1 => 'B&W Print',
813             2 => 'Color Print',
814             3 => 'B&W Document',
815             4 => 'Color Document',
816             },
817             },
818             0x28000000 => 'ScannerMake',
819             0x28000001 => 'ScannerModel',
820             0x28000002 => 'ScannerSerialNumber',
821             0x28000003 => 'ScanSoftware',
822             0x28000004 => { Name => 'ScanSoftwareRevisionDate', Groups => { 2 => 'Time' } },
823             0x28000005 => 'ServiceOrganizationName',
824             0x28000006 => 'ScanOperatorID',
825             0x28000008 => {
826             Name => 'ScanDate',
827             Groups => { 2 => 'Time' },
828             PrintConv => '$self->ConvertDateTime($val)',
829             },
830             0x28000009 => {
831             Name => 'ModifyDate',
832             Groups => { 2 => 'Time' },
833             PrintConv => '$self->ConvertDateTime($val)',
834             },
835             0x2800000A => 'ScannerPixelSize',
836             );
837              
838             # Image Contents properties
839             %Image::ExifTool::FlashPix::Image = (
840             PROCESS_PROC => \&ProcessProperties,
841             GROUPS => { 2 => 'Image' },
842             # VARS storage is used as a hash lookup for tagID's which aren't constant.
843             # The key is a mask for significant bits of the tagID, and the value
844             # is a lookup for tagID's for which this mask is valid.
845             VARS => {
846             # ID's are different for each subimage
847             0xff00ffff => {
848             0x02000000=>1, 0x02000001=>1, 0x02000002=>1, 0x02000003=>1,
849             0x02000004=>1, 0x02000005=>1, 0x02000006=>1, 0x02000007=>1,
850             0x03000001=>1,
851             },
852             },
853             0x01000000 => 'NumberOfResolutions',
854             0x01000002 => 'ImageWidth', # width of highest resolution image
855             0x01000003 => 'ImageHeight',
856             0x01000004 => 'DefaultDisplayHeight',
857             0x01000005 => 'DefaultDisplayWidth',
858             0x01000006 => {
859             Name => 'DisplayUnits',
860             PrintConv => {
861             0 => 'inches',
862             1 => 'meters',
863             2 => 'cm',
864             3 => 'mm',
865             },
866             },
867             0x02000000 => 'SubimageWidth',
868             0x02000001 => 'SubimageHeight',
869             0x02000002 => {
870             Name => 'SubimageColor',
871             # decode only component count and color space of first component
872             ValueConv => 'sprintf("%.2x %.4x", unpack("x4vx4v",$val))',
873             PrintConv => {
874             '01 0000' => 'Opacity Only',
875             '01 8000' => 'Opacity Only (uncalibrated)',
876             '01 0001' => 'Monochrome',
877             '01 8001' => 'Monochrome (uncalibrated)',
878             '03 0002' => 'YCbCr',
879             '03 8002' => 'YCbCr (uncalibrated)',
880             '03 0003' => 'RGB',
881             '03 8003' => 'RGB (uncalibrated)',
882             '04 0002' => 'YCbCr with Opacity',
883             '04 8002' => 'YCbCr with Opacity (uncalibrated)',
884             '04 0003' => 'RGB with Opacity',
885             '04 8003' => 'RGB with Opacity (uncalibrated)',
886             },
887             },
888             0x02000003 => {
889             Name => 'SubimageNumericalFormat',
890             PrintConv => {
891             17 => '8-bit, Unsigned',
892             18 => '16-bit, Unsigned',
893             19 => '32-bit, Unsigned',
894             },
895             },
896             0x02000004 => {
897             Name => 'DecimationMethod',
898             PrintConv => {
899             0 => 'None (Full-sized Image)',
900             8 => '8-point Prefilter',
901             },
902             },
903             0x02000005 => 'DecimationPrefilterWidth',
904             0x02000007 => 'SubimageICC_Profile',
905             0x03000001 => { Name => 'JPEGTables', Binary => 1 },
906             0x03000002 => 'MaxJPEGTableIndex',
907             );
908              
909             # Extension List properties
910             %Image::ExifTool::FlashPix::Extensions = (
911             PROCESS_PROC => \&ProcessProperties,
912             GROUPS => { 2 => 'Other' },
913             VARS => {
914             # ID's are different for each extension type
915             0x0000ffff => {
916             0x0001=>1, 0x0002=>1, 0x0003=>1, 0x0004=>1,
917             0x0005=>1, 0x0006=>1, 0x0007=>1, 0x1000=>1,
918             0x2000=>1, 0x2001=>1, 0x3000=>1, 0x4000=>1,
919             },
920             0x0000f00f => { 0x3001=>1, 0x3002=>1 },
921             },
922             0x10000000 => 'UsedExtensionNumbers',
923             0x0001 => 'ExtensionName',
924             0x0002 => 'ExtensionClassID',
925             0x0003 => {
926             Name => 'ExtensionPersistence',
927             PrintConv => {
928             0 => 'Always Valid',
929             1 => 'Invalidated By Modification',
930             2 => 'Potentially Invalidated By Modification',
931             },
932             },
933             0x0004 => { Name => 'ExtensionCreateDate', Groups => { 2 => 'Time' } },
934             0x0005 => { Name => 'ExtensionModifyDate', Groups => { 2 => 'Time' } },
935             0x0006 => 'CreatingApplication',
936             0x0007 => 'ExtensionDescription',
937             0x1000 => 'Storage-StreamPathname',
938             0x2000 => 'FlashPixStreamPathname',
939             0x2001 => 'FlashPixStreamFieldOffset',
940             0x3000 => 'PropertySetPathname',
941             0x3001 => 'PropertySetIDCodes',
942             0x3002 => 'PropertyVectorElements',
943             0x4000 => 'SubimageResolutions',
944             );
945              
946             # Subimage Header tags
947             %Image::ExifTool::FlashPix::SubimageHdr = (
948             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
949             FORMAT => 'int32u',
950             # 0 => 'HeaderLength',
951             1 => 'SubimageWidth',
952             2 => 'SubimageHeight',
953             3 => 'SubimageTileCount',
954             4 => 'SubimageTileWidth',
955             5 => 'SubimageTileHeight',
956             6 => 'NumChannels',
957             # 7 => 'TileHeaderOffset',
958             # 8 => 'TileHeaderLength',
959             # ... followed by tile header table
960             );
961              
962             # Data Object properties
963             %Image::ExifTool::FlashPix::DataObject = (
964             PROCESS_PROC => \&ProcessProperties,
965             GROUPS => { 2 => 'Other' },
966             0x00010000 => 'DataObjectID',
967             0x00010002 => 'LockedPropertyList',
968             0x00010003 => 'DataObjectTitle',
969             0x00010004 => 'LastModifier',
970             0x00010005 => 'RevisionNumber',
971             0x00010006 => { Name => 'DataCreateDate', Groups => { 2 => 'Time' } },
972             0x00010007 => { Name => 'DataModifyDate', Groups => { 2 => 'Time' } },
973             0x00010008 => 'CreatingApplication',
974             0x00010100 => {
975             Name => 'DataObjectStatus',
976             PrintConv => q{
977             ($val & 0x0000ffff ? 'Exists' : 'Does Not Exist') .
978             ', ' . ($val & 0xffff0000 ? 'Not ' : '') . 'Purgeable'
979             },
980             },
981             0x00010101 => {
982             Name => 'CreatingTransform',
983             PrintConv => '$val ? $val : "Source Image"',
984             },
985             0x00010102 => 'UsingTransforms',
986             0x10000000 => 'CachedImageHeight',
987             0x10000001 => 'CachedImageWidth',
988             );
989              
990             # Transform properties
991             %Image::ExifTool::FlashPix::Transform = (
992             PROCESS_PROC => \&ProcessProperties,
993             GROUPS => { 2 => 'Other' },
994             0x00010000 => 'TransformNodeID',
995             0x00010001 => 'OperationClassID',
996             0x00010002 => 'LockedPropertyList',
997             0x00010003 => 'TransformTitle',
998             0x00010004 => 'LastModifier',
999             0x00010005 => 'RevisionNumber',
1000             0x00010006 => { Name => 'TransformCreateDate', Groups => { 2 => 'Time' } },
1001             0x00010007 => { Name => 'TransformModifyDate', Groups => { 2 => 'Time' } },
1002             0x00010008 => 'CreatingApplication',
1003             0x00010100 => 'InputDataObjectList',
1004             0x00010101 => 'OutputDataObjectList',
1005             0x00010102 => 'OperationNumber',
1006             0x10000000 => 'ResultAspectRatio',
1007             0x10000001 => 'RectangleOfInterest',
1008             0x10000002 => 'Filtering',
1009             0x10000003 => 'SpatialOrientation',
1010             0x10000004 => 'ColorTwistMatrix',
1011             0x10000005 => 'ContrastAdjustment',
1012             );
1013              
1014             # Operation properties
1015             %Image::ExifTool::FlashPix::Operation = (
1016             PROCESS_PROC => \&ProcessProperties,
1017             0x00010000 => 'OperationID',
1018             );
1019              
1020             # Global Info properties
1021             %Image::ExifTool::FlashPix::GlobalInfo = (
1022             PROCESS_PROC => \&ProcessProperties,
1023             0x00010002 => 'LockedPropertyList',
1024             0x00010003 => 'TransformedImageTitle',
1025             0x00010004 => 'LastModifier',
1026             0x00010100 => 'VisibleOutputs',
1027             0x00010101 => 'MaximumImageIndex',
1028             0x00010102 => 'MaximumTransformIndex',
1029             0x00010103 => 'MaximumOperationIndex',
1030             );
1031              
1032             # Audio Info properties
1033             %Image::ExifTool::FlashPix::AudioInfo = (
1034             PROCESS_PROC => \&ProcessProperties,
1035             GROUPS => { 2 => 'Audio' },
1036             );
1037              
1038             # MacroMedia flash contents
1039             %Image::ExifTool::FlashPix::Contents = (
1040             PROCESS_PROC => \&ProcessProperties,
1041             GROUPS => { 2 => 'Image' },
1042             );
1043              
1044             # CompObj tags
1045             %Image::ExifTool::FlashPix::CompObj = (
1046             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1047             GROUPS => { 2 => 'Other' },
1048             FORMAT => 'int32u',
1049             0 => { Name => 'CompObjUserTypeLen' },
1050             1 => {
1051             Name => 'CompObjUserType',
1052             Format => 'string[$val{0}]',
1053             RawConv => '$$self{CompObjUserType} = $val', # (use to determine file type)
1054             },
1055             );
1056              
1057             # decode Word document FIB header (ref [MS-DOC].pdf)
1058             %Image::ExifTool::FlashPix::WordDocument = (
1059             PROCESS_PROC => \&ProcessWordDocument,
1060             GROUPS => { 2 => 'Other' },
1061             FORMAT => 'int16u',
1062             NOTES => 'Tags extracted from the Microsoft Word document stream.',
1063             0 => {
1064             Name => 'Identification',
1065             PrintHex => 1,
1066             PrintConv => {
1067             0x6a62 => 'MS Word 97',
1068             0x626a => 'Word 98 Mac',
1069             0xa5dc => 'Word 6.0/7.0',
1070             0xa5ec => 'Word 8.0',
1071             },
1072             },
1073             3 => {
1074             Name => 'LanguageCode',
1075             PrintHex => 1,
1076             PrintConv => {
1077             0x0400 => 'None',
1078             0x0401 => 'Arabic',
1079             0x0402 => 'Bulgarian',
1080             0x0403 => 'Catalan',
1081             0x0404 => 'Traditional Chinese',
1082             0x0804 => 'Simplified Chinese',
1083             0x0405 => 'Czech',
1084             0x0406 => 'Danish',
1085             0x0407 => 'German',
1086             0x0807 => 'German (Swiss)',
1087             0x0408 => 'Greek',
1088             0x0409 => 'English (US)',
1089             0x0809 => 'English (British)',
1090             0x0c09 => 'English (Australian)',
1091             0x040a => 'Spanish (Castilian)',
1092             0x080a => 'Spanish (Mexican)',
1093             0x040b => 'Finnish',
1094             0x040c => 'French',
1095             0x080c => 'French (Belgian)',
1096             0x0c0c => 'French (Canadian)',
1097             0x100c => 'French (Swiss)',
1098             0x040d => 'Hebrew',
1099             0x040e => 'Hungarian',
1100             0x040f => 'Icelandic',
1101             0x0410 => 'Italian',
1102             0x0810 => 'Italian (Swiss)',
1103             0x0411 => 'Japanese',
1104             0x0412 => 'Korean',
1105             0x0413 => 'Dutch',
1106             0x0813 => 'Dutch (Belgian)',
1107             0x0414 => 'Norwegian (Bokmal)',
1108             0x0814 => 'Norwegian (Nynorsk)',
1109             0x0415 => 'Polish',
1110             0x0416 => 'Portuguese (Brazilian)',
1111             0x0816 => 'Portuguese',
1112             0x0417 => 'Rhaeto-Romanic',
1113             0x0418 => 'Romanian',
1114             0x0419 => 'Russian',
1115             0x041a => 'Croato-Serbian (Latin)',
1116             0x081a => 'Serbo-Croatian (Cyrillic)',
1117             0x041b => 'Slovak',
1118             0x041c => 'Albanian',
1119             0x041d => 'Swedish',
1120             0x041e => 'Thai',
1121             0x041f => 'Turkish',
1122             0x0420 => 'Urdu',
1123             0x0421 => 'Bahasa',
1124             0x0422 => 'Ukrainian',
1125             0x0423 => 'Byelorussian',
1126             0x0424 => 'Slovenian',
1127             0x0425 => 'Estonian',
1128             0x0426 => 'Latvian',
1129             0x0427 => 'Lithuanian',
1130             0x0429 => 'Farsi',
1131             0x042d => 'Basque',
1132             0x042f => 'Macedonian',
1133             0x0436 => 'Afrikaans',
1134             0x043e => 'Malaysian',
1135             },
1136             },
1137             5 => {
1138             Name => 'DocFlags',
1139             Mask => 0xff0f, # ignore save count
1140             RawConv => '$$self{DocFlags} = $val',
1141             PrintConv => { BITMASK => {
1142             0 => 'Template',
1143             1 => 'AutoText only',
1144             2 => 'Complex',
1145             3 => 'Has picture',
1146             # 4-7 = number of incremental saves
1147             8 => 'Encrypted',
1148             9 => '1Table',
1149             10 => 'Read only',
1150             11 => 'Passworded',
1151             12 => 'ExtChar',
1152             13 => 'Load override',
1153             14 => 'Far east',
1154             15 => 'Obfuscated',
1155             }},
1156             },
1157             9.1 => {
1158             Name => 'System',
1159             Mask => 0x0001,
1160             PrintConv => {
1161             0x0000 => 'Windows',
1162             0x0001 => 'Macintosh',
1163             },
1164             },
1165             9.2 => {
1166             Name => 'Word97',
1167             Mask => 0x0010,
1168             PrintConv => { 0 => 'No', 1 => 'Yes' },
1169             },
1170             );
1171              
1172             # tags decoded from Word document table
1173             %Image::ExifTool::FlashPix::DocTable = (
1174             GROUPS => { 1 => 'MS-DOC', 2 => 'Document' },
1175             NOTES => 'Tags extracted from the Microsoft Word document table.',
1176             VARS => { NO_ID => 1 },
1177             CommentBy => {
1178             Groups => { 2 => 'Author' },
1179             Notes => 'enable L option to extract all entries',
1180             },
1181             LastSavedBy => {
1182             Groups => { 2 => 'Author' },
1183             Notes => 'enable L option to extract history of up to 10 entries',
1184             },
1185             DOP => { SubDirectory => { TagTable => 'Image::ExifTool::FlashPix::DOP' } },
1186             ModifyDate => {
1187             Groups => { 2 => 'Time' },
1188             Format => 'int64u',
1189             Priority => 0,
1190             RawConv => q{
1191             $val = $val * 1e-7 - 11644473600; # convert to seconds since 1970
1192             return $val > 0 ? $val : undef;
1193             },
1194             ValueConv => 'ConvertUnixTime($val)',
1195             PrintConv => '$self->ConvertDateTime($val)',
1196             },
1197             #
1198             # tags below are used internally in intermediate steps to extract the tags above
1199             #
1200             TableOffsets => { Hidden => 1 }, # stores offsets to extract data from document table
1201             CommentByBlock => { # entire block of CommentBy entries
1202             SubDirectory => {
1203             TagTable => 'Image::ExifTool::FlashPix::DocTable',
1204             ProcessProc => \&ProcessCommentBy,
1205             },
1206             Hidden => 1,
1207             },
1208             LastSavedByBlock => { # entire block of LastSavedBy entries
1209             SubDirectory => {
1210             TagTable => 'Image::ExifTool::FlashPix::DocTable',
1211             ProcessProc => \&ProcessLastSavedBy,
1212             },
1213             Hidden => 1,
1214             },
1215             );
1216              
1217             # Microsoft Office Document Properties (ref [MS-DOC].pdf)
1218             %Image::ExifTool::FlashPix::DOP = (
1219             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1220             GROUPS => { 1 => 'MS-DOC', 2 => 'Document' },
1221             NOTES => 'Microsoft office document properties.',
1222             20 => {
1223             Name => 'CreateDate',
1224             Format => 'int32u',
1225             Groups => { 2 => 'Time' },
1226             Priority => 0,
1227             RawConv => \&ConvertDTTM,
1228             PrintConv => '$self->ConvertDateTime($val)',
1229             },
1230             24 => {
1231             Name => 'ModifyDate',
1232             Format => 'int32u',
1233             Groups => { 2 => 'Time' },
1234             Priority => 0,
1235             RawConv => \&ConvertDTTM,
1236             PrintConv => '$self->ConvertDateTime($val)',
1237             },
1238             28 => {
1239             Name => 'LastPrinted',
1240             Format => 'int32u',
1241             Groups => { 2 => 'Time' },
1242             RawConv => \&ConvertDTTM,
1243             PrintConv => '$self->ConvertDateTime($val)',
1244             },
1245             32 => { Name => 'RevisionNumber', Format => 'int16u' },
1246             34 => {
1247             Name => 'TotalEditTime',
1248             Format => 'int32u',
1249             PrintConv => 'ConvertTimeSpan($val,60)',
1250             },
1251             # (according to the MS-DOC specification, the following are accurate only if
1252             # flag 'X' is set, and flag 'u' specifies whether the main or subdoc tags are
1253             # used, but in my tests it seems that both are filled in with reasonable values,
1254             # so just extract the main counts and ignore the subdoc counts for now - PH)
1255             38 => { Name => 'Words', Format => 'int32u' },
1256             42 => { Name => 'Characters', Format => 'int32u' },
1257             46 => { Name => 'Pages', Format => 'int16u' },
1258             48 => { Name => 'Paragraphs', Format => 'int32u' },
1259             56 => { Name => 'Lines', Format => 'int32u' },
1260             #60 => { Name => 'WordsWithSubdocs', Format => 'int32u' },
1261             #64 => { Name => 'CharactersWithSubdocs', Format => 'int32u' },
1262             #68 => { Name => 'PagesWithSubdocs', Format => 'int16u' },
1263             #70 => { Name => 'ParagraphsWithSubdocs', Format => 'int32u' },
1264             #74 => { Name => 'LinesWithSubdocs', Format => 'int32u' },
1265             );
1266              
1267             # FujiFilm "Property" information (ref PH)
1268             %Image::ExifTool::FlashPix::PreviewInfo = (
1269             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1270             GROUPS => { 2 => 'Image' },
1271             NOTES => 'Preview information written by some FujiFilm models.',
1272             FIRST_ENTRY => 0,
1273             # values are all constant for for my samples except the two decoded tags
1274             # 0x0000: 01 01 00 00 02 01 00 00 00 00 00 00 00 xx xx 01
1275             # 0x0010: 01 00 00 00 00 00 00 xx xx 00 00 00 00 00 00 00
1276             # 0x0020: 00 00 00 00 00
1277             0x0d => {
1278             Name => 'PreviewImageWidth',
1279             Format => 'int16u',
1280             },
1281             0x17 => {
1282             Name => 'PreviewImageHeight',
1283             Format => 'int16u',
1284             },
1285             );
1286              
1287             # composite FlashPix tags
1288             %Image::ExifTool::FlashPix::Composite = (
1289             GROUPS => { 2 => 'Image' },
1290             PreviewImage => {
1291             Groups => { 2 => 'Preview' },
1292             # extract JPEG preview from ScreenNail if possible
1293             Require => {
1294             0 => 'ScreenNail',
1295             },
1296             Binary => 1,
1297             RawConv => q{
1298             return undef unless $val[0] =~ /\xff\xd8\xff/g;
1299             @grps = $self->GetGroup($$val{0}); # set groups from ScreenNail
1300             return substr($val[0], pos($val[0])-3);
1301             },
1302             },
1303             );
1304              
1305             # add our composite tags
1306             Image::ExifTool::AddCompositeTags('Image::ExifTool::FlashPix');
1307              
1308             #------------------------------------------------------------------------------
1309             # Convert Microsoft DTTM structure to date/time
1310             # Inputs: 0) DTTM value
1311             # Returns: EXIF-format date/time string ("0000:00:00 00:00:00" for zero date/time)
1312             sub ConvertDTTM($)
1313             {
1314 0     0 0 0 my $val = shift;
1315 0         0 my $yr = ($val >> 20) & 0x1ff;
1316 0         0 my $mon = ($val >> 16) & 0x0f;
1317 0         0 my $day = ($val >> 11) & 0x1f;
1318 0         0 my $hr = ($val >> 6) & 0x1f;
1319 0         0 my $min = ($val & 0x3f);
1320 0 0       0 $yr += 1900 if $val;
1321 0 0       0 return sprintf("%.4d:%.2d:%.2d %.2d:%.2d:00%s",$yr,$mon,$day,$hr,$min,$val ? 'Z' : '');
1322             }
1323              
1324             #------------------------------------------------------------------------------
1325             # Process hyperlinks from PID_HYPERLINKS array
1326             # (ref http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnaro97ta/html/msdn_hyper97.asp)
1327             # Inputs: 0) value, 1) ExifTool ref
1328             # Returns: list of hyperlinks
1329             sub ProcessHyperlinks($$)
1330             {
1331 1     1 0 3 my ($val, $et) = @_;
1332              
1333             # process as an array of VT_VARIANT's
1334 1         2 my $dirEnd = length $val;
1335 1 50       4 return undef if $dirEnd < 4;
1336 1         3 my $num = Get32u(\$val, 0);
1337 1         3 my $valPos = 4;
1338 1         1 my ($i, @vals);
1339 1         4 for ($i=0; $i<$num; ++$i) {
1340             # read VT_BLOB entries as an array of VT_VARIANT's
1341 18         32 my $value = ReadFPXValue($et, \$val, $valPos, VT_VARIANT, $dirEnd);
1342 18 50       30 last unless defined $value;
1343 18         40 push @vals, $value;
1344             }
1345             # filter values to extract only the links
1346 1         3 my @links;
1347 1         4 for ($i=0; $i<@vals; $i+=6) {
1348 3         5 push @links, $vals[$i+4]; # get address
1349 3 100       11 $links[-1] .= '#' . $vals[$i+5] if length $vals[$i+5]; # add subaddress
1350             }
1351 1         4 return \@links;
1352             }
1353              
1354             #------------------------------------------------------------------------------
1355             # Read FlashPix value
1356             # Inputs: 0) ExifTool ref, 1) data ref, 2) value offset, 3) FPX format number,
1357             # 4) end offset, 5) flag for no padding, 6) code page
1358             # Returns: converted value (or list of values in list context) and updates
1359             # value offset to end of value if successful, or returns undef on error
1360             sub ReadFPXValue($$$$$;$$)
1361             {
1362 310     310 0 591 my ($et, $dataPt, $valPos, $type, $dirEnd, $noPad, $codePage) = @_;
1363 310         366 my @vals;
1364              
1365 310         646 my $format = $oleFormat{$type & 0x0fff};
1366 310         613 while ($format) {
1367 310         370 my $count = 1;
1368             # handle VT_VECTOR types
1369 310         432 my $flags = $type & 0xf000;
1370 310 100       515 if ($flags) {
1371 46 50       115 if ($flags == VT_VECTOR) {
1372 46         74 $noPad = 1; # values sometimes aren't padded inside vectors!!
1373 46         102 my $size = $oleFormatSize{VT_VECTOR};
1374 46 50       123 if ($valPos + $size > $dirEnd) {
1375 0         0 $et->WarnOnce('Incorrect FPX VT_VECTOR size');
1376 0         0 last;
1377             }
1378 46         113 $count = Get32u($dataPt, $valPos);
1379 46 50       123 push @vals, '' if $count == 0; # allow zero-element vector
1380 46         91 $valPos += 4;
1381             } else {
1382             # can't yet handle this property flag
1383 0         0 $et->WarnOnce('Unknown FPX property');
1384 0         0 last;
1385             }
1386             }
1387 310 100       916 unless ($format =~ /^VT_/) {
1388 101         230 my $size = Image::ExifTool::FormatSize($format) * $count;
1389 101 50       212 if ($valPos + $size > $dirEnd) {
1390 0         0 $et->WarnOnce("Incorrect FPX $format size");
1391 0         0 last;
1392             }
1393 101         222 @vals = ReadValue($dataPt, $valPos, $format, $count, $size);
1394             # update position to end of value plus padding
1395 101         285 $valPos += ($count * $size + 3) & 0xfffffffc;
1396 101         147 last;
1397             }
1398 209         377 my $size = $oleFormatSize{$format};
1399 209         324 my ($item, $val, $len);
1400 209         444 for ($item=0; $item<$count; ++$item) {
1401 216 50       424 if ($valPos + $size > $dirEnd) {
1402 0         0 $et->WarnOnce("Truncated FPX $format value");
1403 0         0 last;
1404             }
1405             # sometimes VT_VECTOR items are padded to even 4-byte boundaries, and sometimes they aren't
1406 216 100 100     534 if ($noPad and defined $len and $len & 0x03) {
      66        
1407 2         5 my $pad = 4 - ($len & 0x03);
1408 2 50       4 if ($valPos + $pad + $size <= $dirEnd) {
1409             # skip padding if all zeros
1410 2 50       9 $valPos += $pad if substr($$dataPt, $valPos, $pad) eq "\0" x $pad;
1411             }
1412             }
1413 216         280 undef $len;
1414 216 100 66     1289 if ($format eq 'VT_VARIANT') {
    100          
    50          
    100          
    100          
    50          
1415 24         45 my $subType = Get32u($dataPt, $valPos);
1416 24         37 $valPos += $size;
1417 24         43 $val = ReadFPXValue($et, $dataPt, $valPos, $subType, $dirEnd, $noPad, $codePage);
1418 24 50       39 last unless defined $val;
1419 24         35 push @vals, $val;
1420 24         41 next; # avoid adding $size to $valPos again
1421             } elsif ($format eq 'VT_FILETIME') {
1422             # convert from time in 100 ns increments to time in seconds
1423 50         236 $val = 1e-7 * Image::ExifTool::Get64u($dataPt, $valPos);
1424             # print as date/time if value is greater than one year (PH hack)
1425 50         91 my $secDay = 24 * 3600;
1426 50 100       139 if ($val > 365 * $secDay) {
1427             # shift from Jan 1, 1601 to Jan 1, 1970
1428 49         75 my $unixTimeZero = 134774 * $secDay;
1429 49         74 $val -= $unixTimeZero;
1430             # there are a lot of bad programmers out there...
1431 49         83 my $sec100yr = 100 * 365 * $secDay;
1432 49 50 33     226 if ($val < 0 || $val > $sec100yr) {
1433             # some software writes the wrong byte order (but the proper word order)
1434 0         0 my @w = unpack("x${valPos}NN", $$dataPt);
1435 0         0 my $v2 = ($w[0] + $w[1] * 4294967296) * 1e-7 - $unixTimeZero;
1436 0 0 0     0 if ($v2 > 0 && $v2 < $sec100yr) {
    0 0        
1437 0         0 $val = $v2;
1438             # also check for wrong time base
1439             } elsif ($val < 0 && $val + $unixTimeZero > 0) {
1440 0         0 $val += $unixTimeZero;
1441             }
1442             }
1443 49         150 $val = Image::ExifTool::ConvertUnixTime($val);
1444             }
1445             } elsif ($format eq 'VT_DATE') {
1446 0         0 $val = Image::ExifTool::GetDouble($dataPt, $valPos);
1447             # shift zero from Dec 30, 1899 to Jan 1, 1970 and convert to secs
1448 0 0       0 $val = ($val - 25569) * 24 * 3600 if $val != 0;
1449 0         0 $val = Image::ExifTool::ConvertUnixTime($val);
1450             } elsif ($format =~ /STR$/) {
1451 117         261 $len = Get32u($dataPt, $valPos);
1452 117 100       262 $len *= 2 if $format eq 'VT_LPWSTR'; # convert to byte count
1453 117 50       272 if ($valPos + $len + 4 > $dirEnd) {
1454 0         0 $et->WarnOnce("Truncated $format value");
1455 0         0 last;
1456             }
1457 117         271 $val = substr($$dataPt, $valPos + 4, $len);
1458 117 100       218 if ($format eq 'VT_LPWSTR') {
    50          
1459             # convert wide string from Unicode
1460 98         266 $val = $et->Decode($val, 'UCS2');
1461             } elsif ($codePage) {
1462 19         36 my $charset = $Image::ExifTool::charsetName{"cp$codePage"};
1463 19 50       28 if ($charset) {
    0          
1464 19         38 $val = $et->Decode($val, $charset);
1465             } elsif ($codePage == 1200) { # UTF-16, little endian
1466 0         0 $val = $et->Decode($val, 'UCS2', 'II');
1467             }
1468             }
1469 117         258 $val =~ s/\0.*//s; # truncate at null terminator
1470             # update position for string length
1471             # (the spec states that strings should be padded to align
1472             # on even 32-bit boundaries, but this isn't always the case)
1473 117 100       262 $valPos += $noPad ? $len : ($len + 3) & 0xfffffffc;
1474             } elsif ($format eq 'VT_BLOB' or $format eq 'VT_CF') {
1475 2         5 my $len = Get32u($dataPt, $valPos); # (use local $len because we always expect padding)
1476 2 50       6 if ($valPos + $len + 4 > $dirEnd) {
1477 0         0 $et->WarnOnce("Truncated $format value");
1478 0         0 last;
1479             }
1480 2         7 $val = substr($$dataPt, $valPos + 4, $len);
1481             # update position for data length plus padding
1482             # (does this padding disappear in arrays too?)
1483 2         3 $valPos += ($len + 3) & 0xfffffffc;
1484             } elsif ($format eq 'VT_CLSID') {
1485 23         141 $val = Image::ExifTool::ASF::GetGUID(substr($$dataPt, $valPos, $size));
1486             }
1487 192         280 $valPos += $size; # update value pointer to end of value
1488 192         560 push @vals, $val;
1489             }
1490             # join VT_ values with commas unless we want an array
1491 209 50 66     444 @vals = ( join $et->Options('ListSep'), @vals ) if @vals > 1 and not wantarray;
1492 209         308 last; # didn't really want to loop
1493             }
1494 310         429 $_[2] = $valPos; # return updated value position
1495              
1496 310 100       509 if (wantarray) {
    50          
1497 268         573 return @vals;
1498             } elsif (@vals > 1) {
1499 0         0 return join(' ', @vals);
1500             } else {
1501 42         95 return $vals[0];
1502             }
1503             }
1504              
1505             #------------------------------------------------------------------------------
1506             # Scan for XMP in FLA Contents (ref PH)
1507             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1508             # Returns: 1 on success
1509             # Notes: FLA format is proprietary and I couldn't find any documentation,
1510             # so this routine is entirely based on observations from sample files
1511             sub ProcessContents($$$)
1512             {
1513 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1514 0         0 my $dataPt = $$dirInfo{DataPt};
1515 0         0 my $isFLA;
1516              
1517             # all of my FLA samples contain "Contents" data, and no other FPX-like samples have
1518             # this, but check the data for a familiar pattern to be sure this is FLA: the
1519             # Contents of all of my FLA samples start with two bytes (0x29,0x38,0x3f,0x43 or 0x47,
1520             # then 0x01) followed by a number of zero bytes (from 0x18 to 0x26 of them, related
1521             # somehow to the value of the first byte), followed by the string "DocumentPage"
1522 0 0       0 $isFLA = 1 if $$dataPt =~ /^..\0+\xff\xff\x01\0\x0d\0CDocumentPage/s;
1523              
1524             # do a brute-force scan of the "Contents" for UTF-16 XMP
1525             # (this may always be little-endian, but allow for either endianness)
1526 0 0       0 if ($$dataPt =~ /<\0\?\0x\0p\0a\0c\0k\0e\0t\0 \0b\0e\0g\0i\0n\0=\0['"](\0\xff\xfe|\xfe\xff)/g) {
1527 0         0 $$dirInfo{DirStart} = pos($$dataPt) - 36;
1528 0 0       0 if ($$dataPt =~ /<\0\?\0x\0p\0a\0c\0k\0e\0t\0 \0e\0n\0d\0=\0['"]\0[wr]\0['"]\0\?\0>\0?/g) {
1529 0         0 $$dirInfo{DirLen} = pos($$dataPt) - $$dirInfo{DirStart};
1530 0         0 Image::ExifTool::XMP::ProcessXMP($et, $dirInfo, $tagTablePtr);
1531             # override format if not already FLA but XMP-dc:Format indicates it is
1532             $isFLA = 1 if $$et{FILE_TYPE} ne 'FLA' and $$et{VALUE}{Format} and
1533 0 0 0     0 $$et{VALUE}{Format} eq 'application/vnd.adobe.fla';
      0        
1534             }
1535             }
1536 0 0       0 $et->OverrideFileType('FLA') if $isFLA;
1537 0         0 return 1;
1538             }
1539              
1540             #------------------------------------------------------------------------------
1541             # Process WordDocument stream of MSWord doc file (ref 6)
1542             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1543             # Returns: 1 on success
1544             sub ProcessWordDocument($$$)
1545             {
1546 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1547 0 0       0 my $dataPt = $$dirInfo{DataPt} or return 0;
1548 0         0 my $dirLen = length $$dataPt;
1549             # validate the FIB signature
1550 0 0 0     0 unless ($dirLen > 2 and Get16u($dataPt,0) == 0xa5ec) {
1551 0         0 $et->WarnOnce('Invalid FIB signature', 1);
1552 0         0 return 0;
1553             }
1554 0         0 $et->ProcessBinaryData($dirInfo, $tagTablePtr); # process FIB
1555             # continue parsing the WordDocument stream until we find the FibRgFcLcb
1556 0         0 my $pos = 32;
1557 0 0       0 return 0 if $pos + 2 > $dirLen;
1558 0         0 my $n = Get16u($dataPt, $pos); # read csw
1559 0         0 $pos += 2 + $n * 2; # skip fibRgW
1560 0 0       0 return 0 if $pos + 2 > $dirLen;
1561 0         0 $n = Get16u($dataPt, $pos); # read cslw
1562 0         0 $pos += 2 + $n * 4; # skip fibRgLw
1563 0 0       0 return 0 if $pos + 2 > $dirLen;
1564 0         0 $n = Get16u($dataPt, $pos); # read cbRgFcLcb
1565 0         0 $pos += 2; # point to start of fibRgFcLcbBlob
1566 0 0       0 return 0 if $pos + $n * 8 > $dirLen;
1567 0         0 my ($off, @tableOffsets);
1568             # save necessary entries for later processing of document table
1569             # (DOP, CommentBy, LastSavedBy)
1570 0         0 foreach $off (0xf8, 0x120, 0x238) {
1571 0 0       0 last if $off + 8 > $n * 8;
1572 0         0 push @tableOffsets, Get32u($dataPt, $pos + $off);
1573 0         0 push @tableOffsets, Get32u($dataPt, $pos + $off + 4);
1574             }
1575 0         0 my $tbl = GetTagTable('Image::ExifTool::FlashPix::DocTable');
1576             # extract ModifyDate if it exists
1577 0         0 $et->HandleTag($tbl, 'ModifyDate', undef,
1578             DataPt => $dataPt,
1579             Start => $pos + 0x2b8,
1580             Size => 8,
1581             );
1582 0         0 $et->HandleTag($tbl, TableOffsets => \@tableOffsets); # save for later
1583             # $pos += $n * 8; # skip fibRgFcLcbBlob
1584             # return 0 if $pos + 2 > $dirLen;
1585             # $n = Get16u($dataPt, $pos); # read cswNew
1586             # return 0 if $pos + 2 + $n * 2 > $dirLen;
1587             # my $nFib = Get16u($dataPt, 2 + ($n ? $pos : 0));
1588             # $pos += 2 + $n * 2; # skip fibRgCswNew
1589 0         0 return 1;
1590             }
1591              
1592             #------------------------------------------------------------------------------
1593             # Process Microsoft Word Document Table
1594             # Inputs: 0) ExifTool object ref
1595             sub ProcessDocumentTable($)
1596             {
1597 1     1 0 2 my $et = shift;
1598 1         2 my $value = $$et{VALUE};
1599 1         2 my $extra = $$et{TAG_EXTRA};
1600 1         2 my ($i, $j, $tag);
1601             # loop through TableOffsets for each sub-document
1602 1         2 for ($i=0; ; ++$i) {
1603 1 50       4 my $key = 'TableOffsets' . ($i ? " ($i)" : '');
1604 1         2 my $offsets = $$value{$key};
1605 1 50       4 last unless defined $offsets;
1606 0         0 my $doc;
1607 0 0       0 $doc = $$extra{$key}{G3} if $$extra{$key};
1608 0 0       0 $doc = '' unless $doc;
1609             # get DocFlags for this sub-document
1610 0         0 my ($docFlags, $docTable);
1611 0         0 for ($j=0; ; ++$j) {
1612 0 0       0 my $key = 'DocFlags' . ($j ? " ($j)" : '');
1613 0 0       0 last unless defined $$value{$key};
1614 0         0 my $tmp;
1615 0 0       0 $tmp = $$extra{$key}{G3} if $$extra{$key};
1616 0 0       0 $tmp = '' unless $tmp;
1617 0 0       0 if ($tmp eq $doc) {
1618 0         0 $docFlags = $$value{$key};
1619 0         0 last;
1620             }
1621             }
1622 0 0       0 next unless defined $docFlags;
1623 0 0       0 $tag = $docFlags & 0x200 ? 'Table1' : 'Table0';
1624             # get table for this sub-document
1625 0         0 for ($j=0; ; ++$j) {
1626 0 0       0 my $key = $tag . ($j ? " ($j)" : '');
1627 0 0       0 last unless defined $$value{$key};
1628 0         0 my $tmp;
1629 0 0       0 $tmp = $$extra{$key}{G3} if $$extra{$key};
1630 0 0       0 $tmp = '' unless $tmp;
1631 0 0       0 if ($tmp eq $doc) {
1632 0         0 $docTable = \$$value{$key};
1633 0         0 last;
1634             }
1635             }
1636 0 0       0 next unless defined $docTable;
1637             # extract DOP and LastSavedBy information from document table
1638 0         0 $$et{DOC_NUM} = $doc; # use same document number
1639 0         0 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::DocTable');
1640 0         0 foreach $tag (qw(DOP CommentByBlock LastSavedByBlock)) {
1641 0 0       0 last unless @$offsets;
1642 0         0 my $off = shift @$offsets;
1643 0         0 my $len = shift @$offsets;
1644 0 0 0     0 next unless $len and $off + $len <= length $$docTable;
1645 0         0 $et->HandleTag($tagTablePtr, $tag, undef,
1646             DataPt => $docTable,
1647             Start => $off,
1648             Size => $len,
1649             );
1650             }
1651 0         0 delete $$et{DOC_NUM};
1652             }
1653             # delete intermediate tags
1654 1         2 foreach $tag (qw(TableOffsets Table0 Table1)) {
1655 3         4 for ($i=0; ; ++$i) {
1656 3 50       7 my $key = $tag . ($i ? " ($i)" : '');
1657 3 50       7 last unless defined $$value{$key};
1658 0         0 $et->DeleteTag($key);
1659             }
1660             }
1661             }
1662              
1663             #------------------------------------------------------------------------------
1664             # Extract names of comment authors (ref 6)
1665             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1666             # Returns: 1 on success
1667             sub ProcessCommentBy($$$)
1668             {
1669 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1670 0         0 my $dataPt = $$dirInfo{DataPt};
1671 0         0 my $pos = $$dirInfo{DirStart};
1672 0         0 my $end = $$dirInfo{DirLen} + $pos;
1673 0         0 $et->VerboseDir($$dirInfo{DirName});
1674 0         0 while ($pos + 2 < $end) {
1675 0         0 my $len = Get16u($dataPt, $pos);
1676 0         0 $pos += 2;
1677 0 0       0 last if $pos + $len * 2 > $end;
1678 0         0 my $author = $et->Decode(substr($$dataPt, $pos, $len*2), 'UCS2');
1679 0         0 $pos += $len * 2;
1680 0         0 $et->HandleTag($tagTablePtr, CommentBy => $author);
1681             }
1682 0         0 return 1;
1683             }
1684              
1685             #------------------------------------------------------------------------------
1686             # Extract last-saved-by names (ref 5)
1687             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1688             # Returns: 1 on success
1689             sub ProcessLastSavedBy($$$)
1690             {
1691 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1692 0         0 my $dataPt = $$dirInfo{DataPt};
1693 0         0 my $pos = $$dirInfo{DirStart};
1694 0         0 my $end = $$dirInfo{DirLen} + $pos;
1695 0 0       0 return 0 if $pos + 6 > $end;
1696 0         0 $et->VerboseDir($$dirInfo{DirName});
1697 0         0 my $num = Get16u($dataPt, $pos+2);
1698 0         0 $pos += 6;
1699 0         0 while ($num >= 2) {
1700 0 0       0 last if $pos + 2 > $end;
1701 0         0 my $len = Get16u($dataPt, $pos);
1702 0         0 $pos += 2;
1703 0 0       0 last if $pos + $len * 2 > $end;
1704 0         0 my $author = $et->Decode(substr($$dataPt, $pos, $len*2), 'UCS2');
1705 0         0 $pos += $len * 2;
1706 0 0       0 last if $pos + 2 > $end;
1707 0         0 $len = Get16u($dataPt, $pos);
1708 0         0 $pos += 2;
1709 0 0       0 last if $pos + $len * 2 > $end;
1710 0         0 my $path = $et->Decode(substr($$dataPt, $pos, $len*2), 'UCS2');
1711 0         0 $pos += $len * 2;
1712 0         0 $et->HandleTag($tagTablePtr, LastSavedBy => "$author ($path)");
1713 0         0 $num -= 2;
1714             }
1715 0         0 return 1;
1716             }
1717              
1718             #------------------------------------------------------------------------------
1719             # Check FPX byte order mark (BOM) and set byte order appropriately
1720             # Inputs: 0) data ref, 1) offset to BOM
1721             # Returns: true on success
1722             sub CheckBOM($$)
1723             {
1724 25     25 0 89 my ($dataPt, $pos) = @_;
1725 25         122 my $bom = Get16u($dataPt, $pos);
1726 25 100       108 return 1 if $bom == 0xfffe;
1727 23 50       66 return 0 unless $bom == 0xfeff;
1728 23         78 ToggleByteOrder();
1729 23         94 return 1;
1730             }
1731              
1732             #------------------------------------------------------------------------------
1733             # Process FlashPix properties
1734             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1735             # Returns: 1 on success
1736             sub ProcessProperties($$$)
1737             {
1738 25     25 0 69 my ($et, $dirInfo, $tagTablePtr) = @_;
1739 25         59 my $dataPt = $$dirInfo{DataPt};
1740 25   50     116 my $pos = $$dirInfo{DirStart} || 0;
1741 25   66     108 my $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $pos;
1742 25         50 my $dirEnd = $pos + $dirLen;
1743 25         82 my $verbose = $et->Options('Verbose');
1744 25         56 my $n;
1745              
1746 25 50       95 if ($dirLen < 48) {
1747 0         0 $et->Warn('Truncated FPX properties');
1748 0         0 return 0;
1749             }
1750             # check and set our byte order if necessary
1751 25 50       104 unless (CheckBOM($dataPt, $pos)) {
1752 0         0 $et->Warn('Bad FPX property byte order mark');
1753 0         0 return 0;
1754             }
1755             # get position of start of section
1756 25         104 $pos = Get32u($dataPt, $pos + 44);
1757 25 50       96 if ($pos < 48) {
1758 0         0 $et->Warn('Bad FPX property section offset');
1759 0         0 return 0;
1760             }
1761 25         97 for ($n=0; $n<2; ++$n) {
1762 26         53 my %dictionary; # dictionary to translate user-defined properties
1763             my $codePage;
1764 26 50       74 last if $pos + 8 > $dirEnd;
1765             # read property section header
1766 26         71 my $size = Get32u($dataPt, $pos);
1767 26 50       66 last unless $size;
1768 26         79 my $numEntries = Get32u($dataPt, $pos + 4);
1769 26 50       71 $verbose and $et->VerboseDir('Property Info', $numEntries, $size);
1770 26 50       82 if ($pos + 8 + 8 * $numEntries > $dirEnd) {
1771 0         0 $et->Warn('Truncated property list');
1772 0         0 last;
1773             }
1774 26         44 my $index;
1775 26         101 for ($index=0; $index<$numEntries; ++$index) {
1776 269         480 my $entry = $pos + 8 + 8 * $index;
1777 269         541 my $tag = Get32u($dataPt, $entry);
1778 269         531 my $offset = Get32u($dataPt, $entry + 4);
1779 269         483 my $valStart = $pos + 4 + $offset;
1780 269 50       498 last if $valStart >= $dirEnd;
1781 269         324 my $valPos = $valStart;
1782 269         525 my $type = Get32u($dataPt, $pos + $offset);
1783 269 100       531 if ($tag == 0) {
1784             # read dictionary to get tag name lookup for this property set
1785 1         2 my $i;
1786 1         3 for ($i=0; $i<$type; ++$i) {
1787 6 50       12 last if $valPos + 8 > $dirEnd;
1788 6         10 $tag = Get32u($dataPt, $valPos);
1789 6         13 my $len = Get32u($dataPt, $valPos + 4);
1790 6         8 $valPos += 8 + $len;
1791 6 50       12 last if $valPos > $dirEnd;
1792 6         10 my $name = substr($$dataPt, $valPos - $len, $len);
1793 6         19 $name =~ s/\0.*//s;
1794 6 50       11 next unless length $name;
1795 6         14 $dictionary{$tag} = $name;
1796 6 100       12 next if $$tagTablePtr{$name};
1797 4         6 $tag = $name;
1798 4         15 $name =~ s/(^| )([a-z])/\U$2/g; # start with uppercase
1799 4         8 $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
1800 4 50       7 next unless length $name;
1801 4 50       9 $et->VPrint(0, "$$et{INDENT}\[adding $name]\n") if $verbose;
1802 4         10 AddTagToTable($tagTablePtr, $tag, { Name => $name });
1803             }
1804 1         3 next;
1805             }
1806             # use tag name from dictionary if available
1807 268         368 my ($custom, $val);
1808 268 100       537 if (defined $dictionary{$tag}) {
1809 6         13 $tag = $dictionary{$tag};
1810 6         7 $custom = 1;
1811             }
1812 268         541 my @vals = ReadFPXValue($et, $dataPt, $valPos, $type, $dirEnd, undef, $codePage);
1813 268 50       490 @vals or $et->Warn('Error reading property value');
1814 268 100       804 $val = @vals > 1 ? \@vals : $vals[0];
1815 268         379 my $format = $type & 0x0fff;
1816 268         335 my $flags = $type & 0xf000;
1817 268   33     582 my $formStr = $oleFormat{$format} || "Type $format";
1818 268 100 33     559 $formStr .= '|' . ($oleFlags{$flags} || sprintf("0x%x",$flags)) if $flags;
1819 268         320 my $tagInfo;
1820             # check for common tag ID's: Dictionary, CodePage and LocaleIndicator
1821             # (must be done before masking because masked tags may overlap these ID's)
1822 268 100 66     1524 if (not $custom and ($tag == 1 or $tag == 0x80000000)) {
    100 100        
    100 66        
1823             # get tagInfo from SummaryInfo table
1824 26         77 my $summaryTable = GetTagTable('Image::ExifTool::FlashPix::SummaryInfo');
1825 26         100 $tagInfo = $et->GetTagInfo($summaryTable, $tag);
1826 26 50       107 if ($tag == 1) {
1827 26 50       74 $val += 0x10000 if $val < 0; # (may be incorrectly stored as int16s)
1828 26         56 $codePage = $val; # save code page for translating values
1829             }
1830             } elsif ($$tagTablePtr{$tag}) {
1831 56         168 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1832             } elsif ($$tagTablePtr{VARS} and not $custom) {
1833             # mask off insignificant bits of tag ID if necessary
1834 184         317 my $masked = $$tagTablePtr{VARS};
1835 184         223 my $mask;
1836 184         419 foreach $mask (keys %$masked) {
1837 272 100       738 if ($masked->{$mask}->{$tag & $mask}) {
1838 184         509 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag & $mask);
1839 184         320 last;
1840             }
1841             }
1842             }
1843 268         988 $et->HandleTag($tagTablePtr, $tag, $val,
1844             DataPt => $dataPt,
1845             Start => $valStart,
1846             Size => $valPos - $valStart,
1847             Format => $formStr,
1848             Index => $index,
1849             TagInfo => $tagInfo,
1850             Extra => ", type=$type",
1851             );
1852             }
1853             # issue warning if we hit end of property section prematurely
1854 26 50       107 $et->Warn('Truncated property data') if $index < $numEntries;
1855 26 100       107 last unless $$dirInfo{Multi};
1856 2         6 $pos += $size;
1857             }
1858              
1859 25         85 return 1;
1860             }
1861              
1862             #------------------------------------------------------------------------------
1863             # Load chain of sectors from file
1864             # Inputs: 0) RAF ref, 1) first sector number, 2) FAT ref, 3) sector size, 4) header size
1865             sub LoadChain($$$$$)
1866             {
1867 6     6 0 14 my ($raf, $sect, $fatPt, $sectSize, $hdrSize) = @_;
1868 6 50       12 return undef unless $raf;
1869 6         12 my $chain = '';
1870 6         10 my ($buff, %loadedSect);
1871 6         9 for (;;) {
1872 39 100       65 last if $sect >= END_OF_CHAIN;
1873 33 50       57 return undef if $loadedSect{$sect}; # avoid infinite loop
1874 33         50 $loadedSect{$sect} = 1;
1875 33         38 my $offset = $sect * $sectSize + $hdrSize;
1876 33 50 33     96 return undef unless ($offset <= 0x7fffffff or $$raf{LargeFileSupport}) and
      33        
      33        
1877             $raf->Seek($offset, 0) and
1878             $raf->Read($buff, $sectSize) == $sectSize;
1879 33         63 $chain .= $buff;
1880             # step to next sector in chain
1881 33 50       58 return undef if $sect * 4 > length($$fatPt) - 4;
1882 33         63 $sect = Get32u($fatPt, $sect * 4);
1883             }
1884 6         19 return $chain;
1885             }
1886              
1887             #------------------------------------------------------------------------------
1888             # Extract information from a JPEG APP2 FPXR segment
1889             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1890             # Returns: 1 on success
1891             sub ProcessFPXR($$$)
1892             {
1893 67     67 0 151 my ($et, $dirInfo, $tagTablePtr) = @_;
1894 67         127 my $dataPt = $$dirInfo{DataPt};
1895 67         157 my $dirStart = $$dirInfo{DirStart};
1896 67         112 my $dirLen = $$dirInfo{DirLen};
1897 67         236 my $verbose = $et->Options('Verbose');
1898              
1899 67 50       189 if ($dirLen < 13) {
1900 0         0 $et->Warn('FPXR segment too small');
1901 0         0 return 0;
1902             }
1903              
1904             # get version and segment type (version is 0 in all my samples)
1905 67         232 my ($vers, $type) = unpack('x5C2', $$dataPt);
1906              
1907 67 100       293 if ($type == 1) { # a "Contents List" segment
    50          
    0          
1908              
1909 21 50       66 $vers != 0 and $et->Warn("Untested FPXR version $vers");
1910 21 50       79 if ($$et{FPXR}) {
1911 0         0 $et->Warn('Multiple FPXR contents lists');
1912 0         0 delete $$et{FPXR};
1913             }
1914 21         59 my $numEntries = unpack('x7n', $$dataPt);
1915 21         44 my @contents;
1916 21 50       59 $verbose and $et->VerboseDir('Contents List', $numEntries);
1917 21         44 my $pos = 9;
1918 21         40 my $entry;
1919 21         77 for ($entry = 0; $entry < $numEntries; ++$entry) {
1920 48 50       437 if ($pos + 4 > $dirLen) {
1921 0         0 $et->Warn('Truncated FPXR contents');
1922 0         0 return 0;
1923             }
1924 48         213 my ($size, $default) = unpack("x${pos}Na", $$dataPt);
1925 48         167 pos($$dataPt) = $pos + 5;
1926             # according to the spec, this string is little-endian
1927             # (very odd, since the size word is big-endian),
1928             # and the first char must be '/'
1929 48 50       357 unless ($$dataPt =~ m{\G(/\0(..)*?)\0\0}sg) {
1930 0         0 $et->Warn('Invalid FPXR stream name');
1931 0         0 return 0;
1932             }
1933             # convert stream pathname to ascii
1934 48         212 my $name = Image::ExifTool::Decode(undef, $1, 'UCS2', 'II', 'Latin');
1935 48 50       108 if ($verbose) {
1936 0 0       0 my $psize = ($size == 0xffffffff) ? 'storage' : "$size bytes";
1937 0         0 $et->VPrint(0," | $entry) Name: '${name}' [$psize]\n");
1938             }
1939             # remove directory specification
1940 48         214 $name =~ s{.*/}{}s;
1941             # read storage class ID if necessary
1942 48         118 my $classID;
1943 48 100       109 if ($size == 0xffffffff) {
1944 2 50       11 unless ($$dataPt =~ m{(.{16})}sg) {
1945 0         0 $et->Warn('Truncated FPXR storage class ID');
1946 0         0 return 0;
1947             }
1948             # unpack class ID in case we want to use it sometime
1949 2         10 $classID = Image::ExifTool::ASF::GetGUID($1);
1950             }
1951             # find the tagInfo if available
1952 48         71 my $tagInfo;
1953 48 100       155 unless ($$tagTablePtr{$name}) {
1954             # remove instance number or class ID from tag if necessary
1955             $tagInfo = $et->GetTagInfo($tagTablePtr, $1) if
1956             ($name =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
1957 25 100 66     382 ($name =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
      66        
      100        
1958             }
1959             # update position in list
1960 48         105 $pos = pos($$dataPt);
1961             # add to our contents list
1962 48         310 push @contents, {
1963             Name => $name,
1964             Size => $size,
1965             Default => $default,
1966             ClassID => $classID,
1967             TagInfo => $tagInfo,
1968             };
1969             }
1970             # save contents list as $et member variable
1971             # (must do this last so we don't save list on error)
1972 21         78 $$et{FPXR} = \@contents;
1973              
1974             } elsif ($type == 2) { # a "Stream Data" segment
1975              
1976             # get the contents list index and stream data offset
1977 46         143 my ($index, $offset) = unpack('x7nN', $$dataPt);
1978 46         95 my $fpxr = $$et{FPXR};
1979 46 50 33     216 if ($fpxr and $$fpxr[$index]) {
    0 0        
      0        
      0        
1980 46         83 my $obj = $$fpxr[$index];
1981             # extract stream data (after 13-byte header)
1982 46 50       126 if (not defined $$obj{Stream}) {
1983             # ignore offset for first segment of this type
1984             # (in my sample images, this isn't always zero as one would expect)
1985 46         281 $$obj{Stream} = substr($$dataPt, $dirStart+13);
1986             } else {
1987             # add data at the proper offset to the stream
1988 0         0 my $overlap = length($$obj{Stream}) - $offset;
1989 0         0 my $start = $dirStart + 13;
1990 0 0 0     0 if ($overlap < 0 or $dirLen - $overlap < 13) {
1991 0         0 $et->WarnOnce("Bad FPXR stream $index offset",1);
1992             } else {
1993             # ignore any overlapping data in this segment
1994             # (this seems to be the convention)
1995 0         0 $start += $overlap;
1996             }
1997             # concatenate data with this stream
1998 0         0 $$obj{Stream} .= substr($$dataPt, $start);
1999             }
2000             # save value for this tag if stream is complete
2001 46         103 my $len = length $$obj{Stream};
2002 46 50       134 if ($len >= $$obj{Size}) {
2003 46 50       115 $et->VPrint(0, " + [FPXR stream $index, $len bytes]\n") if $verbose;
2004 46 50       115 if ($len > $$obj{Size}) {
2005 0         0 $et->Warn('Extra data in FPXR segment (truncated)');
2006 0         0 $$obj{Stream} = substr($$obj{Stream}, 0, $$obj{Size});
2007             }
2008             # handle this tag
2009             $et->HandleTag($tagTablePtr, $$obj{Name}, $$obj{Stream},
2010             DataPt => \$$obj{Stream},
2011             TagInfo => $$obj{TagInfo},
2012 46         245 );
2013 46         127 delete $$obj{Stream}; # done with this stream
2014             }
2015             # hack for improperly stored FujiFilm PreviewImage (stored with no contents list)
2016             } elsif ($index == 512 and $dirLen > 60 and ($$et{FujiPreview} or
2017             ($dirLen > 64 and substr($$dataPt, $dirStart+60, 4) eq "\xff\xd8\xff\xdb")))
2018             {
2019 0 0       0 $$et{FujiPreview} = '' unless defined $$et{FujiPreview};
2020             # recombine PreviewImage, skipping 13-byte FPXR header + 47-byte Fuji header
2021 0         0 $$et{FujiPreview} .= substr($$dataPt, $dirStart+60);
2022             } else {
2023             # (Kodak uses index 255 for a free segment in images from some cameras)
2024 0 0       0 $et->Warn("Unlisted FPXR segment (index $index)") if $index != 255;
2025             }
2026              
2027             } elsif ($type != 3) { # not a "Reserved" segment
2028              
2029 0         0 $et->Warn("Unknown FPXR segment (type $type)");
2030              
2031             }
2032              
2033             # clean up if this was the last FPXR segment
2034 67 100       202 if ($$dirInfo{LastFPXR}) {
2035 21 50       87 if ($$et{FPXR}) {
2036 21         45 my $obj;
2037 21         40 foreach $obj (@{$$et{FPXR}}) {
  21         65  
2038 48 50 33     148 next unless defined $$obj{Stream} and length $$obj{Stream};
2039             # parse it even though it isn't the proper length
2040             $et->HandleTag($tagTablePtr, $$obj{Name}, $$obj{Stream},
2041             DataPt => \$$obj{Stream},
2042             TagInfo => $$obj{TagInfo},
2043 0         0 );
2044             }
2045 21         126 delete $$et{FPXR}; # delete our temporary variables
2046             }
2047 21 50       81 if ($$et{FujiPreview}) {
2048 0         0 $et->FoundTag('PreviewImage', $$et{FujiPreview});
2049 0         0 delete $$et{FujiPreview};
2050             }
2051             }
2052 67         163 return 1;
2053             }
2054              
2055             #------------------------------------------------------------------------------
2056             # Set document number for objects
2057             # Inputs: 0) object hierarchy hash ref, 1) object index, 2) doc number list ref,
2058             # 3) doc numbers used at each level, 4) flag set for metadata levels
2059             sub SetDocNum($$;$$$)
2060             {
2061 5     5 0 10 my ($hier, $index, $doc, $used, $meta) = @_;
2062 5 50       12 my $obj = $$hier{$index} or return;
2063 5 50       10 return if exists $$obj{DocNum};
2064 5         7 $$obj{DocNum} = $doc;
2065 5 100       14 SetDocNum($hier, $$obj{Left}, $doc, $used, $meta) if $$obj{Left};
2066 5 100       9 SetDocNum($hier, $$obj{Right}, $doc, $used, $meta) if $$obj{Right};
2067 5 100       13 if (defined $$obj{Child}) {
2068 1 50       3 $used or $used = [ ];
2069 1         2 my @subDoc;
2070 1 50       3 push @subDoc, @$doc if $doc;
2071             # we must dive down 2 levels for each sub-document, so use the
2072             # $meta flag to add a sub-document level only for every 2nd generation
2073 1 50       3 if ($meta) {
    50          
2074 0   0     0 my $subNum = ($$used[scalar @subDoc] || 0);
2075 0         0 $$used[scalar @subDoc] = $subNum;
2076 0         0 push @subDoc, $subNum;
2077             } elsif (@subDoc) {
2078 0         0 $subDoc[-1] = ++$$used[$#subDoc];
2079             }
2080 1         6 SetDocNum($hier, $$obj{Child}, \@subDoc, $used, not $meta);
2081             }
2082             }
2083              
2084             #------------------------------------------------------------------------------
2085             # Extract information from a FlashPix (FPX) file
2086             # Inputs: 0) ExifTool object ref, 1) dirInfo ref
2087             # Returns: 1 on success, 0 if this wasn't a valid FPX-format file
2088             sub ProcessFPX($$)
2089             {
2090 1     1 0 2 my ($et, $dirInfo) = @_;
2091 1         2 my $raf = $$dirInfo{RAF};
2092 1         4 my ($buff, $out, $oldIndent, $miniStreamBuff);
2093 1         0 my ($tag, %hier, %objIndex, %loadedDifSect);
2094              
2095             # read header
2096 1 50       3 return 0 unless $raf->Read($buff,HDR_SIZE) == HDR_SIZE;
2097             # check signature
2098 1 50       5 return 0 unless $buff =~ /^\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1/;
2099              
2100             # set FileType initially based on file extension (we may override this later)
2101 1         3 my $fileType = $$et{FILE_EXT};
2102 1 50 33     12 $fileType = 'FPX' unless $fileType and $fpxFileType{$fileType};
2103 1         5 $et->SetFileType($fileType);
2104 1 50       7 SetByteOrder(substr($buff, 0x1c, 2) eq "\xff\xfe" ? 'MM' : 'II');
2105 1         34 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
2106 1         3 my $verbose = $et->Options('Verbose');
2107             # copy LargeFileSupport option to RAF for use in LoadChain
2108 1         2 $$raf{LargeFileSupport} = $et->Options('LargeFileSupport');
2109              
2110 1         3 my $sectSize = 1 << Get16u(\$buff, 0x1e);
2111 1         3 my $miniSize = 1 << Get16u(\$buff, 0x20);
2112 1         3 my $fatCount = Get32u(\$buff, 0x2c); # number of FAT sectors
2113 1         17 my $dirStart = Get32u(\$buff, 0x30); # first directory sector
2114 1         3 my $miniCutoff = Get32u(\$buff, 0x38); # minimum size for big-FAT streams
2115 1         2 my $miniStart = Get32u(\$buff, 0x3c); # first sector of mini-FAT
2116 1         1 my $miniCount = Get32u(\$buff, 0x40); # number of mini-FAT sectors
2117 1         3 my $difStart = Get32u(\$buff, 0x44); # first sector of DIF chain
2118 1         2 my $difCount = Get32u(\$buff, 0x48); # number of DIF sectors
2119              
2120 1 50       3 if ($verbose) {
2121 0         0 $out = $et->Options('TextOut');
2122 0         0 print $out " Sector size=$sectSize\n FAT: Count=$fatCount\n";
2123 0         0 print $out " DIR: Start=$dirStart\n";
2124 0         0 print $out " MiniFAT: Mini-sector size=$miniSize Start=$miniStart Count=$miniCount Cutoff=$miniCutoff\n";
2125 0         0 print $out " DIF FAT: Start=$difStart Count=$difCount\n";
2126             }
2127             #
2128             # load the FAT
2129             #
2130 1         2 my $pos = 0x4c;
2131 1         1 my $endPos = length($buff);
2132 1         2 my $fat = '';
2133 1         1 my $fatCountCheck = 0;
2134 1         1 my $difCountCheck = 0;
2135 1 50       4 my $hdrSize = $sectSize > HDR_SIZE ? $sectSize : HDR_SIZE;
2136              
2137 1         1 for (;;) {
2138 1         9 while ($pos <= $endPos - 4) {
2139 109         158 my $sect = Get32u(\$buff, $pos);
2140 109         123 $pos += 4;
2141 109 100       204 next if $sect == FREE_SECT;
2142 1         2 my $offset = $sect * $sectSize + $hdrSize;
2143 1         2 my $fatSect;
2144 1 50 33     3 unless ($raf->Seek($offset, 0) and
2145             $raf->Read($fatSect, $sectSize) == $sectSize)
2146             {
2147 0         0 $et->Error("Error reading FAT from sector $sect");
2148 0         0 return 1;
2149             }
2150 1         3 $fat .= $fatSect;
2151 1         2 ++$fatCountCheck;
2152             }
2153 1 50       3 last if $difStart >= END_OF_CHAIN;
2154             # read next DIF (Dual Indirect FAT) sector
2155 0 0       0 if (++$difCountCheck > $difCount) {
2156 0         0 $et->Warn('Unterminated DIF FAT');
2157 0         0 last;
2158             }
2159 0 0       0 if ($loadedDifSect{$difStart}) {
2160 0         0 $et->Warn('Cyclical reference in DIF FAT');
2161 0         0 last;
2162             }
2163 0         0 my $offset = $difStart * $sectSize + $hdrSize;
2164 0 0 0     0 unless ($raf->Seek($offset, 0) and $raf->Read($buff, $sectSize) == $sectSize) {
2165 0         0 $et->Error("Error reading DIF sector $difStart");
2166 0         0 return 1;
2167             }
2168 0         0 $loadedDifSect{$difStart} = 1;
2169             # set end of sector information in this DIF
2170 0         0 $pos = 0;
2171 0         0 $endPos = $sectSize - 4;
2172             # next time around we want to read next DIF in chain
2173 0         0 $difStart = Get32u(\$buff, $endPos);
2174             }
2175 1 50       17 if ($fatCountCheck != $fatCount) {
2176 0         0 $et->Warn("Bad number of FAT sectors (expected $fatCount but found $fatCountCheck)");
2177             }
2178             #
2179             # load the mini-FAT and the directory
2180             #
2181 1         4 my $miniFat = LoadChain($raf, $miniStart, \$fat, $sectSize, $hdrSize);
2182 1         3 my $dir = LoadChain($raf, $dirStart, \$fat, $sectSize, $hdrSize);
2183 1 50 33     11 unless (defined $miniFat and defined $dir) {
2184 0         0 $et->Error('Error reading mini-FAT or directory stream');
2185 0         0 return 1;
2186             }
2187 1 50       4 if ($verbose) {
2188 0         0 print $out " FAT [",length($fat)," bytes]:\n";
2189 0         0 $et->VerboseDump(\$fat);
2190 0         0 print $out " Mini-FAT [",length($miniFat)," bytes]:\n";
2191 0         0 $et->VerboseDump(\$miniFat);
2192 0         0 print $out " Directory [",length($dir)," bytes]:\n";
2193 0         0 $et->VerboseDump(\$dir);
2194             }
2195             #
2196             # process the directory
2197             #
2198 1 50       3 if ($verbose) {
2199 0         0 $oldIndent = $$et{INDENT};
2200 0         0 $$et{INDENT} .= '| ';
2201 0         0 $et->VerboseDir('FPX', undef, length $dir);
2202             }
2203 1         1 my $miniStream;
2204 1         7 $endPos = length($dir);
2205 1         2 my $index = 0;
2206              
2207 1         4 for ($pos=0; $pos<=$endPos-128; $pos+=128, ++$index) {
2208              
2209             # get directory entry type
2210             # (0=invalid, 1=storage, 2=stream, 3=lockbytes, 4=property, 5=root)
2211 8         23 my $type = Get8u(\$dir, $pos + 0x42);
2212 8 100       20 next if $type == 0; # skip invalid entries
2213 5 50       9 if ($type > 5) {
2214 0         0 $et->Warn("Invalid directory entry type $type");
2215 0         0 last; # rest of directory is probably garbage
2216             }
2217             # get entry name (note: this is supposed to be length in 2-byte
2218             # characters but this isn't what is done in my sample FPX file, so
2219             # be very tolerant of this count -- it's null terminated anyway)
2220 5         11 my $len = Get16u(\$dir, $pos + 0x40);
2221 5 100       13 $len > 32 and $len = 32;
2222 5         74 $tag = Image::ExifTool::Decode(undef, substr($dir,$pos,$len*2), 'UCS2', 'II', 'Latin');
2223 5         11 $tag =~ s/\0.*//s; # truncate at null (in case length was wrong)
2224              
2225 5         13 my $sect = Get32u(\$dir, $pos + 0x74); # start sector number
2226 5         14 my $size = Get32u(\$dir, $pos + 0x78); # stream length
2227              
2228             # load Ministream (referenced from first directory entry)
2229 5 100       14 unless ($miniStream) {
2230 1         3 $miniStreamBuff = LoadChain($raf, $sect, \$fat, $sectSize, $hdrSize);
2231 1 50       3 unless (defined $miniStreamBuff) {
2232 0         0 $et->Warn('Error loading Mini-FAT stream');
2233 0         0 last;
2234             }
2235 1         6 $miniStream = new File::RandomAccess(\$miniStreamBuff);
2236             }
2237              
2238 5         8 my $tagInfo;
2239 5 100       16 if ($$tagTablePtr{$tag}) {
2240 3         9 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
2241             } else {
2242             # remove instance number or class ID from tag if necessary
2243             $tagInfo = $et->GetTagInfo($tagTablePtr, $1) if
2244             ($tag =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
2245 2 0 33     11 ($tag =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
      33        
      33        
2246             }
2247              
2248 5         12 my $lSib = Get32u(\$dir, $pos + 0x44); # left sibling
2249 5         12 my $rSib = Get32u(\$dir, $pos + 0x48); # right sibling
2250 5         12 my $chld = Get32u(\$dir, $pos + 0x4c); # child directory
2251              
2252             # save information about object hierarchy
2253 5         9 my ($obj, $sub);
2254 5 100       14 $obj = $hier{$index} or $obj = $hier{$index} = { };
2255 5 100       12 $$obj{Left} = $lSib unless $lSib == FREE_SECT;
2256 5 100       10 $$obj{Right} = $rSib unless $rSib == FREE_SECT;
2257 5 100       10 unless ($chld == FREE_SECT) {
2258 1         2 $$obj{Child} = $chld;
2259 1 50       4 $sub = $hier{$chld} or $sub = $hier{$chld} = { };
2260 1         2 $$sub{Parent} = $index;
2261             }
2262              
2263 5 100 66     23 next unless $tagInfo or $verbose;
2264              
2265             # load the data for stream types
2266 3         6 my $extra = '';
2267 3   33     8 my $typeStr = $dirEntryType[$type] || $type;
2268 3 50       8 if ($typeStr eq 'STREAM') {
    0          
2269 3 50       7 if ($size >= $miniCutoff) {
    50          
2270             # stream is in the main FAT
2271 0         0 $buff = LoadChain($raf, $sect, \$fat, $sectSize, $hdrSize);
2272             } elsif ($size) {
2273             # stream is in the mini-FAT
2274 3         6 $buff = LoadChain($miniStream, $sect, \$miniFat, $miniSize, 0);
2275             } else {
2276 0         0 $buff = ''; # an empty stream
2277             }
2278 3 50       7 unless (defined $buff) {
2279 0 0       0 my $name = $tagInfo ? $$tagInfo{Name} : 'unknown';
2280 0         0 $et->Warn("Error reading $name stream");
2281 0         0 $buff = '';
2282             }
2283             } elsif ($typeStr eq 'ROOT') {
2284 0         0 $buff = $miniStreamBuff;
2285 0         0 $extra .= ' (Ministream)';
2286             } else {
2287 0         0 $buff = '';
2288 0         0 undef $size;
2289             }
2290 3 50       5 if ($verbose) {
2291 0         0 my $flags = Get8u(\$dir, $pos + 0x43); # 0=red, 1=black
2292 0   0     0 my $col = { 0 => 'Red', 1 => 'Black' }->{$flags} || $flags;
2293 0         0 $extra .= " Type=$typeStr Flags=$col";
2294 0 0       0 $extra .= " Left=$lSib" unless $lSib == FREE_SECT;
2295 0 0       0 $extra .= " Right=$rSib" unless $rSib == FREE_SECT;
2296 0 0       0 $extra .= " Child=$chld" unless $chld == FREE_SECT;
2297 0         0 $et->VerboseInfo($tag, $tagInfo,
2298             Index => $index,
2299             Value => $buff,
2300             DataPt => \$buff,
2301             Extra => $extra,
2302             Size => $size,
2303             );
2304             }
2305 3 50 33     11 if ($tagInfo and $buff) {
2306 3         7 my $num = $$et{NUM_FOUND};
2307 3         5 my $subdir = $$tagInfo{SubDirectory};
2308 3 100       6 if ($subdir) {
2309             my %dirInfo = (
2310             DataPt => \$buff,
2311             DirStart => $$subdir{DirStart},
2312             DirLen => length $buff,
2313             Multi => $$tagInfo{Multi},
2314 2         11 );
2315 2         7 my $subTablePtr = GetTagTable($$subdir{TagTable});
2316 2         10 $et->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc});
2317             } else {
2318 1         3 $et->FoundTag($tagInfo, $buff);
2319             }
2320             # save object index number for all found tags
2321 3         9 my $num2 = $$et{NUM_FOUND};
2322 3         76 $objIndex{++$num} = $index while $num < $num2;
2323             }
2324             }
2325             # set document numbers for tags extracted from embedded documents
2326 1 50       4 unless ($$et{DOC_NUM}) {
2327             # initialize document number for all objects, beginning at root (index 0)
2328 1         4 SetDocNum(\%hier, 0);
2329             # set family 3 group name for all tags in embedded documents
2330 1         2 my $order = $$et{FILE_ORDER};
2331 1         2 my (@pri, $copy, $member);
2332 1         9 foreach $tag (keys %$order) {
2333 50         60 my $num = $$order{$tag};
2334 50 100 66     116 next unless defined $num and $objIndex{$num};
2335 39 50       64 my $obj = $hier{$objIndex{$num}} or next;
2336 39         41 my $docNums = $$obj{DocNum};
2337 39 50 33     82 next unless $docNums and @$docNums;
2338 0         0 $$et{TAG_EXTRA}{$tag}{G3} = join '-', @$docNums;
2339 0 0       0 push @pri, $tag unless $tag =~ / /; # save keys for priority sub-doc tags
2340             }
2341             # swap priority sub-document tags with main document tags if they exist
2342 1         5 foreach $tag (@pri) {
2343 0         0 for ($copy=1; ;++$copy) {
2344 0         0 my $key = "$tag ($copy)";
2345 0 0       0 last unless defined $$et{VALUE}{$key};
2346 0         0 my $extra = $$et{TAG_EXTRA}{$key};
2347 0 0 0     0 next if $extra and $$extra{G3}; # not Main if family 3 group is set
2348 0         0 foreach $member ('PRIORITY','VALUE','FILE_ORDER','TAG_INFO','TAG_EXTRA') {
2349 0         0 my $pHash = $$et{$member};
2350 0         0 my $t = $$pHash{$tag};
2351 0         0 $$pHash{$tag} = $$pHash{$key};
2352 0         0 $$pHash{$key} = $t;
2353             }
2354 0         0 last;
2355             }
2356             }
2357             }
2358 1 50       2 $$et{INDENT} = $oldIndent if $verbose;
2359             # try to better identify the file type
2360 1 50       4 if ($$et{VALUE}{FileType} eq 'FPX') {
2361 0   0     0 my $val = $$et{CompObjUserType} || $$et{Software};
2362 0 0       0 if ($val) {
2363 0         0 my %type = ( '^3ds Max' => 'MAX', Word => 'DOC', PowerPoint => 'PPT', Excel => 'XLS' );
2364 0         0 my $pat;
2365 0         0 foreach $pat (sort keys %type) {
2366 0 0       0 next unless $val =~ /$pat/;
2367 0         0 $et->OverrideFileType($type{$pat});
2368 0         0 last;
2369             }
2370             }
2371             }
2372             # process Word document table
2373 1         4 ProcessDocumentTable($et);
2374              
2375 1         16 return 1;
2376             }
2377              
2378             1; # end
2379              
2380             __END__