File Coverage

blib/lib/Image/ExifTool/FlashPix.pm
Criterion Covered Total %
statement 388 676 57.4
branch 188 422 44.5
condition 52 160 32.5
subroutine 14 19 73.6
pod 0 14 0.0
total 642 1291 49.7


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