File Coverage

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