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

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

ExifTool added to cpan area to support metadata extraction from files such as JPEG. Primarily targetted as Image files (hence the Image folder name decided upon by the ExifTool author) it also can handle video such as flash and audio such as Wav
File size: 53.6 KB
Line 
1#------------------------------------------------------------------------------
2# File: FlashPix.pm
3#
4# Description: Read FlashPix meta information
5#
6# Revisions: 05/29/2006 - P. Harvey Created
7#
8# References: 1) http://www.exif.org/Exif2-2.PDF
9# 2) http://www.graphcomp.com/info/specs/livepicture/fpx.pdf
10# 3) http://search.cpan.org/~jdb/libwin32/
11# 4) http://msdn2.microsoft.com/en-us/library/aa380374.aspx
12#------------------------------------------------------------------------------
13
14package Image::ExifTool::FlashPix;
15
16use strict;
17use vars qw($VERSION);
18use Image::ExifTool qw(:DataAccess :Utils);
19use Image::ExifTool::Exif;
20use Image::ExifTool::ASF; # for GetGUID()
21
22$VERSION = '1.04';
23
24sub ProcessFPX($$);
25sub ProcessFPXR($$$);
26sub ProcessProperties($$$);
27sub ReadFPXValue($$$$$;$);
28sub ConvertTimeSpan($);
29sub ProcessHyperlinks($$);
30
31# sector type constants
32sub HDR_SIZE () { 512; }
33sub DIF_SECT () { 0xfffffffc; }
34sub FAT_SECT () { 0xfffffffd; }
35sub END_OF_CHAIN () { 0xfffffffe; }
36sub FREE_SECT () { 0xffffffff; }
37
38# format flags
39sub VT_VECTOR () { 0x1000; }
40sub VT_ARRAY () { 0x2000; }
41sub VT_BYREF () { 0x4000; }
42sub VT_RESERVED () { 0x8000; }
43
44# other constants
45sub VT_VARIANT () { 12; }
46sub VT_LPSTR () { 30; }
47
48# list of OLE format codes (unsupported codes commented out)
49my %oleFormat = (
50 0 => undef, # VT_EMPTY
51 1 => undef, # VT_NULL
52 2 => 'int16s', # VT_I2
53 3 => 'int32s', # VT_I4
54 4 => 'float', # VT_R4
55 5 => 'double', # VT_R8
56 6 => undef, # VT_CY
57 7 => 'VT_DATE', # VT_DATE (double, number of days since Dec 30, 1899)
58 8 => 'VT_BSTR', # VT_BSTR (int32u count, followed by binary string)
59# 9 => 'VT_DISPATCH',
60 10 => 'int32s', # VT_ERROR
61 11 => 'int16s', # VT_BOOL
62 12 => 'VT_VARIANT', # VT_VARIANT
63# 13 => 'VT_UNKNOWN',
64# 14 => 'VT_DECIMAL',
65 16 => 'int8s', # VT_I1
66 17 => 'int8u', # VT_UI1
67 18 => 'int16u', # VT_UI2
68 19 => 'int32u', # VT_UI4
69 20 => 'int64s', # VT_I8
70 21 => 'int64u', # VT_UI8
71# 22 => 'VT_INT',
72# 23 => 'VT_UINT',
73# 24 => 'VT_VOID',
74# 25 => 'VT_HRESULT',
75# 26 => 'VT_PTR',
76# 27 => 'VT_SAFEARRAY',
77# 28 => 'VT_CARRAY',
78# 29 => 'VT_USERDEFINED',
79 30 => 'VT_LPSTR', # VT_LPSTR (int32u count, followed by string)
80 31 => 'VT_LPWSTR', # VT_LPWSTR (int32u word count, followed by Unicode string)
81 64 => 'VT_FILETIME',# VT_FILETIME (int64u, number of nanoseconds since Jan 1, 1601)
82 65 => 'VT_BLOB', # VT_BLOB
83# 66 => 'VT_STREAM',
84# 67 => 'VT_STORAGE',
85# 68 => 'VT_STREAMED_OBJECT',
86# 69 => 'VT_STORED_OBJECT',
87# 70 => 'VT_BLOB_OBJECT',
88 71 => 'VT_CF', # VT_CF
89 72 => 'VT_CLSID', # VT_CLSID
90);
91
92# OLE flag codes (high nibble of property type)
93my %oleFlags = (
94 0x1000 => 'VT_VECTOR',
95 0x2000 => 'VT_ARRAY', # not yet supported
96 0x4000 => 'VT_BYREF', # ditto
97 0x8000 => 'VT_RESERVED',
98);
99
100# byte sizes for supported VT_* format and flag types
101my %oleFormatSize = (
102 VT_DATE => 8,
103 VT_BSTR => 4, # (+ string length)
104 VT_VARIANT => 4, # (+ data length)
105 VT_LPSTR => 4, # (+ string length)
106 VT_LPWSTR => 4, # (+ string character length)
107 VT_FILETIME => 8,
108 VT_BLOB => 4, # (+ data length)
109 VT_CF => 4, # (+ data length)
110 VT_CLSID => 16,
111 VT_VECTOR => 4, # (+ vector elements)
112);
113
114# names for each type of directory entry
115my @dirEntryType = qw(INVALID STORAGE STREAM LOCKBYTES PROPERTY ROOT);
116
117%Image::ExifTool::FlashPix::Main = (
118 PROCESS_PROC => \&ProcessFPXR,
119 GROUPS => { 2 => 'Image' },
120 NOTES => q{
121 The FlashPix file format, introduced in 1996, was developed by Kodak,
122 Hewlett-Packard and Microsoft. Internally the FPX file structure mimics
123 that of an old DOS disk with fixed-sized "sectors" (usually 512 bytes) and a
124 "file allocation table" (FAT). No wonder the format never became popular.
125
126 However, some of the structures used in FlashPix streams are part of the
127 EXIF specification, and are still being used in the APP2 FPXR segment of
128 JPEG images by some Kodak and Hewlett-Packard digital cameras.
129
130 ExifTool extracts FlashPix information from both FPX images and the APP2
131 FPXR segment of JPEG images. As well, FlashPix information is extracted
132 from DOC, XLS and PPT (Microsoft Word, Excel and PowerPoint) documents since
133 the FlashPix file format is closely related to the formats of these files.
134 },
135 "\x05SummaryInformation" => {
136 Name => 'SummaryInfo',
137 SubDirectory => {
138 TagTable => 'Image::ExifTool::FlashPix::SummaryInfo',
139 },
140 },
141 "\x05DocumentSummaryInformation" => {
142 Name => 'DocumentInfo',
143 Multi => 1, # flag to process UserDefined information after this
144 SubDirectory => {
145 TagTable => 'Image::ExifTool::FlashPix::DocumentInfo',
146 },
147 },
148 "\x01CompObj" => {
149 Name => 'CompObj',
150 SubDirectory => {
151 TagTable => 'Image::ExifTool::FlashPix::CompObj',
152 DirStart => 0x1c, # skip stream header
153 },
154 },
155 "\x05Image Info" => {
156 Name => 'ImageInfo',
157 SubDirectory => {
158 TagTable => 'Image::ExifTool::FlashPix::ImageInfo',
159 },
160 },
161 "\x05Image Contents" => {
162 Name => 'Image',
163 SubDirectory => {
164 TagTable => 'Image::ExifTool::FlashPix::Image',
165 },
166 },
167 "ICC Profile 0001" => {
168 Name => 'ICC_Profile',
169 SubDirectory => {
170 TagTable => 'Image::ExifTool::ICC_Profile::Main',
171 DirStart => 0x1c, # skip stream header
172 },
173 },
174 "\x05Extension List" => {
175 Name => 'Extensions',
176 SubDirectory => {
177 TagTable => 'Image::ExifTool::FlashPix::Extensions',
178 },
179 },
180 'Subimage 0000 Header' => {
181 Name => 'SubimageHdr',
182 SubDirectory => {
183 TagTable => 'Image::ExifTool::FlashPix::SubimageHdr',
184 DirStart => 0x1c, # skip stream header
185 },
186 },
187# 'Subimage 0000 Data'
188 "\x05Data Object" => { # plus instance number (ie. " 000000")
189 Name => 'DataObject',
190 SubDirectory => {
191 TagTable => 'Image::ExifTool::FlashPix::DataObject',
192 },
193 },
194# "\x05Data Object Store" => { # plus instance number (ie. " 000000")
195 "\x05Transform" => { # plus instance number (ie. " 000000")
196 Name => 'Transform',
197 SubDirectory => {
198 TagTable => 'Image::ExifTool::FlashPix::Transform',
199 },
200 },
201 "\x05Operation" => { # plus instance number (ie. " 000000")
202 Name => 'Operation',
203 SubDirectory => {
204 TagTable => 'Image::ExifTool::FlashPix::Operation',
205 },
206 },
207 "\x05Global Info" => {
208 Name => 'GlobalInfo',
209 SubDirectory => {
210 TagTable => 'Image::ExifTool::FlashPix::GlobalInfo',
211 },
212 },
213 "\x05Screen Nail" => { # plus class ID (ie. "_bd0100609719a180")
214 Name => 'ScreenNail',
215 Groups => { 2 => 'Other' },
216 # strip off stream header
217 ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
218 },
219 "\x05Audio Info" => {
220 Name => 'AudioInfo',
221 SubDirectory => {
222 TagTable => 'Image::ExifTool::FlashPix::AudioInfo',
223 },
224 },
225 'Audio Stream' => { # plus instance number (ie. " 000000")
226 Name => 'AudioStream',
227 Groups => { 2 => 'Audio' },
228 # strip off stream header
229 ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
230 },
231 "Current User" => { #PH
232 Name => 'CurrentUser',
233 # not sure what the rest of this data is, but extract ASCII name from it - PH
234 ValueConv => q{
235 return undef if length $val < 12;
236 my ($size,$pos) = unpack('x4VV', $val);
237 my $len = $size - $pos - 4;
238 return undef if $len < 0 or length $val < $size + 8;
239 return substr($val, 8 + $pos, $len);
240 },
241 },
242);
243
244# Summary Information properties
245%Image::ExifTool::FlashPix::SummaryInfo = (
246 PROCESS_PROC => \&ProcessProperties,
247 GROUPS => { 2 => 'Image' },
248 NOTES => q{
249 The Dictionary, CodePage and LocalIndicator tags are common to all FlashPix
250 property tables, even though they are only listed in the SummaryInfo table.
251 },
252 0x00 => { Name => 'Dictionary', Groups => { 2 => 'Other' }, Binary => 1 },
253 0x01 => { Name => 'CodePage', Groups => { 2 => 'Other' } },
254 0x02 => 'Title',
255 0x03 => 'Subject',
256 0x04 => { Name => 'Author', Groups => { 2 => 'Author' } },
257 0x05 => 'Keywords',
258 0x06 => 'Comments',
259 0x07 => 'Template',
260 0x08 => { Name => 'LastSavedBy',Groups => { 2 => 'Author' } },
261 0x09 => 'RevisionNumber',
262 0x0a => { Name => 'TotalEditTime', PrintConv => \&ConvertTimeSpan },
263 0x0b => 'LastPrinted',
264 0x0c => { Name => 'CreateDate', Groups => { 2 => 'Time' } },
265 0x0d => { Name => 'ModifyDate', Groups => { 2 => 'Time' } },
266 0x0e => 'PageCount',
267 0x0f => 'WordCount',
268 0x10 => 'CharCount',
269 0x11 => { Name => 'ThumbnailClip', Binary => 1 },
270 0x12 => 'Software',
271 0x13 => 'Security',
272 0x80000000 => { Name => 'LocaleIndicator', Groups => { 2 => 'Other' } },
273);
274
275# Document Summary Information properties (ref 4)
276%Image::ExifTool::FlashPix::DocumentInfo = (
277 PROCESS_PROC => \&ProcessProperties,
278 GROUPS => { 2 => 'Document' },
279 NOTES => q{
280 The DocumentSummaryInformation property set includes a UserDefined property
281 set for which only the Hyperlinks and HyperlinkBase tags are pre-defined.
282 However, ExifTool will also extract any other information found in the
283 UserDefined properties.
284 },
285 0x02 => 'Category',
286 0x03 => 'PresentationTarget',
287 0x04 => 'Bytes',
288 0x05 => 'Lines',
289 0x06 => 'Paragraphs',
290 0x07 => 'Slides',
291 0x08 => 'Notes',
292 0x09 => 'HiddenSlides',
293 0x0a => 'MMClips',
294 0x0b => 'ScaleCrop',
295 0x0c => 'HeadingPairs',
296 0x0d => 'TitleOfParts',
297 0x0e => 'Manager',
298 0x0f => 'Company',
299 0x10 => 'LinksUpToDate',
300 0x11 => 'CharCountWithSpaces',
301 # 0x12 ?
302 0x13 => 'SharedDoc', #PH (unconfirmed)
303 # 0x14 ?
304 # 0x15 ?
305 0x16 => 'HyperlinksChanged',
306 0x17 => { #PH (unconfirmed)
307 Name => 'AppVersion',
308 # (not sure what the lower 16 bits mean, so print them in hex inside brackets)
309 ValueConv => 'sprintf("%d (%.4x)",$val >> 16, $val & 0xffff)',
310 },
311 '_PID_LINKBASE' => 'HyperlinkBase',
312 '_PID_HLINKS' => {
313 Name => 'Hyperlinks',
314 RawConv => \&ProcessHyperlinks,
315 },
316);
317
318# Image Information properties
319%Image::ExifTool::FlashPix::ImageInfo = (
320 PROCESS_PROC => \&ProcessProperties,
321 GROUPS => { 2 => 'Image' },
322 0x21000000 => {
323 Name => 'FileSource',
324 PrintConv => {
325 1 => 'Film Scanner',
326 2 => 'Reflection Print Scanner',
327 3 => 'Digital Camera',
328 4 => 'Video Capture',
329 5 => 'Computer Graphics',
330 },
331 },
332 0x21000001 => {
333 Name => 'SceneType',
334 PrintConv => {
335 1 => 'Original Scene',
336 2 => 'Second Generation Scene',
337 3 => 'Digital Scene Generation',
338 },
339 },
340 0x21000002 => 'CreationPathVector',
341 0x21000003 => 'SoftwareRelease',
342 0x21000004 => 'UserDefinedID',
343 0x21000005 => 'SharpnessApproximation',
344 0x22000000 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
345 0x22000001 => { Name => 'OriginalImageBroker', Groups => { 2 => 'Author' } },
346 0x22000002 => { Name => 'DigitalImageBroker', Groups => { 2 => 'Author' } },
347 0x22000003 => { Name => 'Authorship', Groups => { 2 => 'Author' } },
348 0x22000004 => { Name => 'IntellectualPropertyNotes', Groups => { 2 => 'Author' } },
349 0x23000000 => {
350 Name => 'TestTarget',
351 PrintConv => {
352 1 => 'Color Chart',
353 2 => 'Gray Card',
354 3 => 'Grayscale',
355 4 => 'Resolution Chart',
356 5 => 'Inch Scale',
357 6 => 'Centimeter Scale',
358 7 => 'Millimeter Scale',
359 8 => 'Micrometer Scale',
360 },
361 },
362 0x23000002 => 'GroupCaption',
363 0x23000003 => 'CaptionText',
364 0x23000004 => 'People',
365 0x23000007 => 'Things',
366 0x2300000A => { Name => 'DateTimeOriginal', Groups => { 2 => 'Time' } },
367 0x2300000B => 'Events',
368 0x2300000C => 'Places',
369 0x2300000F => 'ContentDescriptionNotes',
370 0x24000000 => { Name => 'Make', Groups => { 2 => 'Camera' } },
371 0x24000001 => {
372 Name => 'Model',
373 Description => 'Camera Model Name',
374 Groups => { 2 => 'Camera' },
375 },
376 0x24000002 => { Name => 'SerialNumber', Groups => { 2 => 'Camera' } },
377 0x25000000 => { Name => 'CreateDate', Groups => { 2 => 'Time' } },
378 0x25000001 => {
379 Name => 'ExposureTime',
380 PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
381 },
382 0x25000002 => {
383 Name => 'FNumber',
384 PrintConv => 'sprintf("%.1f",$val)',
385 },
386 0x25000003 => {
387 Name => 'ExposureProgram',
388 Groups => { 2 => 'Camera' },
389 # use PrintConv of corresponding EXIF tag
390 PrintConv => $Image::ExifTool::Exif::Main{0x8822}->{PrintConv},
391 },
392 0x25000004 => 'BrightnessValue',
393 0x25000005 => 'ExposureCompensation',
394 0x25000006 => {
395 Name => 'SubjectDistance',
396 Groups => { 2 => 'Camera' },
397 PrintConv => 'sprintf("%.3f m", $val)',
398 },
399 0x25000007 => {
400 Name => 'MeteringMode',
401 Groups => { 2 => 'Camera' },
402 PrintConv => $Image::ExifTool::Exif::Main{0x9207}->{PrintConv},
403 },
404 0x25000008 => {
405 Name => 'LightSource',
406 Groups => { 2 => 'Camera' },
407 PrintConv => $Image::ExifTool::Exif::Main{0x9208}->{PrintConv},
408 },
409 0x25000009 => {
410 Name => 'FocalLength',
411 Groups => { 2 => 'Camera' },
412 PrintConv => 'sprintf("%.1fmm",$val)',
413 },
414 0x2500000A => {
415 Name => 'MaxApertureValue',
416 Groups => { 2 => 'Camera' },
417 ValueConv => '2 ** ($val / 2)',
418 PrintConv => 'sprintf("%.1f",$val)',
419 },
420 0x2500000B => {
421 Name => 'Flash',
422 Groups => { 2 => 'Camera' },
423 PrintConv => {
424 1 => 'No Flash',
425 2 => 'Flash Fired',
426 },
427 },
428 0x2500000C => {
429 Name => 'FlashEnergy',
430 Groups => { 2 => 'Camera' },
431 },
432 0x2500000D => {
433 Name => 'FlashReturn',
434 Groups => { 2 => 'Camera' },
435 PrintConv => {
436 1 => 'Subject Outside Flash Range',
437 2 => 'Subject Inside Flash Range',
438 },
439 },
440 0x2500000E => {
441 Name => 'BackLight',
442 PrintConv => {
443 1 => 'Front Lit',
444 2 => 'Back Lit 1',
445 3 => 'Back Lit 2',
446 },
447 },
448 0x2500000F => { Name => 'SubjectLocation', Groups => { 2 => 'Camera' } },
449 0x25000010 => 'ExposureIndex',
450 0x25000011 => {
451 Name => 'SpecialEffectsOpticalFilter',
452 PrintConv => {
453 1 => 'None',
454 2 => 'Colored',
455 3 => 'Diffusion',
456 4 => 'Multi-image',
457 5 => 'Polarizing',
458 6 => 'Split-field',
459 7 => 'Star',
460 },
461 },
462 0x25000012 => 'PerPictureNotes',
463 0x26000000 => {
464 Name => 'SensingMethod',
465 Groups => { 2 => 'Camera' },
466 PrintConv => $Image::ExifTool::Exif::Main{0x9217}->{PrintConv},
467 },
468 0x26000001 => { Name => 'FocalPlaneXResolution', Groups => { 2 => 'Camera' } },
469 0x26000002 => { Name => 'FocalPlaneYResolution', Groups => { 2 => 'Camera' } },
470 0x26000003 => {
471 Name => 'FocalPlaneResolutionUnit',
472 Groups => { 2 => 'Camera' },
473 PrintConv => $Image::ExifTool::Exif::Main{0xa210}->{PrintConv},
474 },
475 0x26000004 => 'SpatialFrequencyResponse',
476 0x26000005 => 'CFAPattern',
477 0x27000001 => {
478 Name => 'FilmCategory',
479 PrintConv => {
480 1 => 'Negative B&W',
481 2 => 'Negative Color',
482 3 => 'Reversal B&W',
483 4 => 'Reversal Color',
484 5 => 'Chromagenic',
485 6 => 'Internegative B&W',
486 7 => 'Internegative Color',
487 },
488 },
489 0x26000007 => 'ISO',
490 0x26000008 => 'Opto-ElectricConvFactor',
491 0x27000000 => 'FilmBrand',
492 0x27000001 => 'FilmCategory',
493 0x27000002 => 'FilmSize',
494 0x27000003 => 'FilmRollNumber',
495 0x27000004 => 'FilmFrameNumber',
496 0x29000000 => 'OriginalScannedImageSize',
497 0x29000001 => 'OriginalDocumentSize',
498 0x29000002 => {
499 Name => 'OriginalMedium',
500 PrintConv => {
501 1 => 'Continuous Tone Image',
502 2 => 'Halftone Image',
503 3 => 'Line Art',
504 },
505 },
506 0x29000003 => {
507 Name => 'TypeOfOriginal',
508 PrintConv => {
509 1 => 'B&W Print',
510 2 => 'Color Print',
511 3 => 'B&W Document',
512 4 => 'Color Document',
513 },
514 },
515 0x28000000 => 'ScannerMake',
516 0x28000001 => 'ScannerModel',
517 0x28000002 => 'ScannerSerialNumber',
518 0x28000003 => 'ScanSoftware',
519 0x28000004 => { Name => 'ScanSoftwareRevisionDate', Groups => { 2 => 'Time' } },
520 0x28000005 => 'ServiceOrganizationName',
521 0x28000006 => 'ScanOperatorID',
522 0x28000008 => { Name => 'ScanDate', Groups => { 2 => 'Time' } },
523 0x28000009 => { Name => 'ModifyDate', Groups => { 2 => 'Time' } },
524 0x2800000A => 'ScannerPixelSize',
525);
526
527# Image Contents properties
528%Image::ExifTool::FlashPix::Image = (
529 PROCESS_PROC => \&ProcessProperties,
530 GROUPS => { 2 => 'Image' },
531 # VARS storage is used as a hash lookup for tagID's which aren't constant.
532 # The key is a mask for significant bits of the tagID, and the value
533 # is a lookup for tagID's for which this mask is valid.
534 VARS => {
535 # ID's are different for each subimage
536 0xff00ffff => {
537 0x02000000=>1, 0x02000001=>1, 0x02000002=>1, 0x02000003=>1,
538 0x02000004=>1, 0x02000005=>1, 0x02000006=>1, 0x02000007=>1,
539 0x03000001=>1,
540 },
541 },
542 0x01000000 => 'NumberOfResolutions',
543 0x01000002 => 'ImageWidth', # width of highest resolution image
544 0x01000003 => 'ImageHeight',
545 0x01000004 => 'DefaultDisplayHeight',
546 0x01000005 => 'DefaultDisplayWidth',
547 0x01000006 => {
548 Name => 'DisplayUnits',
549 PrintConv => {
550 0 => 'inches',
551 1 => 'meters',
552 2 => 'cm',
553 3 => 'mm',
554 },
555 },
556 0x02000000 => 'SubimageWidth',
557 0x02000001 => 'SubimageHeight',
558 0x02000002 => {
559 Name => 'SubimageColor',
560 # decode only component count and color space of first component
561 ValueConv => 'sprintf("%.2x %.4x", unpack("x4vx4v",$val))',
562 PrintConv => {
563 '01 0000' => 'Opacity Only',
564 '01 8000' => 'Opacity Only (uncalibrated)',
565 '01 0001' => 'Monochrome',
566 '01 8001' => 'Monochrome (uncalibrated)',
567 '03 0002' => 'YCbCr',
568 '03 8002' => 'YCbCr (uncalibrated)',
569 '03 0003' => 'RGB',
570 '03 8003' => 'RGB (uncalibrated)',
571 '04 0002' => 'YCbCr with Opacity',
572 '04 8002' => 'YCbCr with Opacity (uncalibrated)',
573 '04 0003' => 'RGB with Opacity',
574 '04 8003' => 'RGB with Opacity (uncalibrated)',
575 },
576 },
577 0x02000003 => {
578 Name => 'SubimageNumericalFormat',
579 PrintConv => {
580 17 => '8-bit, Unsigned',
581 18 => '16-bit, Unsigned',
582 19 => '32-bit, Unsigned',
583 },
584 },
585 0x02000004 => {
586 Name => 'DecimationMethod',
587 PrintConv => {
588 0 => 'None (Full-sized Image)',
589 8 => '8-point Prefilter',
590 },
591 },
592 0x02000005 => 'DecimationPrefilterWidth',
593 0x02000007 => 'SubimageICC_Profile',
594 0x03000001 => { Name => 'JPEGTables', Binary => 1 },
595 0x03000002 => 'MaxJPEGTableIndex',
596);
597
598# Extension List properties
599%Image::ExifTool::FlashPix::Extensions = (
600 PROCESS_PROC => \&ProcessProperties,
601 GROUPS => { 2 => 'Other' },
602 VARS => {
603 # ID's are different for each extension type
604 0x0000ffff => {
605 0x0001=>1, 0x0002=>1, 0x0003=>1, 0x0004=>1,
606 0x0005=>1, 0x0006=>1, 0x0007=>1, 0x1000=>1,
607 0x2000=>1, 0x2001=>1, 0x3000=>1, 0x4000=>1,
608 },
609 0x0000f00f => { 0x3001=>1, 0x3002=>1 },
610 },
611 0x10000000 => 'UsedExtensionNumbers',
612 0x0001 => 'ExtensionName',
613 0x0002 => 'ExtensionClassID',
614 0x0003 => {
615 Name => 'ExtensionPersistence',
616 PrintConv => {
617 0 => 'Always Valid',
618 1 => 'Invalidated By Modification',
619 2 => 'Potentially Invalidated By Modification',
620 },
621 },
622 0x0004 => { Name => 'ExtensionCreateDate', Groups => { 2 => 'Time' } },
623 0x0005 => { Name => 'ExtensionModifyDate', Groups => { 2 => 'Time' } },
624 0x0006 => 'CreatingApplication',
625 0x0007 => 'ExtensionDescription',
626 0x1000 => 'Storage-StreamPathname',
627 0x2000 => 'FlashPixStreamPathname',
628 0x2001 => 'FlashPixStreamFieldOffset',
629 0x3000 => 'PropertySetPathname',
630 0x3001 => 'PropertySetIDCodes',
631 0x3002 => 'PropertyVectorElements',
632 0x4000 => 'SubimageResolutions',
633);
634
635# Subimage Header tags
636%Image::ExifTool::FlashPix::SubimageHdr = (
637 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
638 FORMAT => 'int32u',
639# 0 => 'HeaderLength',
640 1 => 'SubimageWidth',
641 2 => 'SubimageHeight',
642 3 => 'SubimageTileCount',
643 4 => 'SubimageTileWidth',
644 5 => 'SubimageTileHeight',
645 6 => 'NumChannels',
646# 7 => 'TileHeaderOffset',
647# 8 => 'TileHeaderLength',
648 # ... followed by tile header table
649);
650
651# Data Object properties
652%Image::ExifTool::FlashPix::DataObject = (
653 PROCESS_PROC => \&ProcessProperties,
654 GROUPS => { 2 => 'Other' },
655 0x00010000 => 'DataObjectID',
656 0x00010002 => 'LockedPropertyList',
657 0x00010003 => 'DataObjectTitle',
658 0x00010004 => 'LastModifier',
659 0x00010005 => 'RevisionNumber',
660 0x00010006 => { Name => 'DataCreateDate', Groups => { 2 => 'Time' } },
661 0x00010007 => { Name => 'DataModifyDate', Groups => { 2 => 'Time' } },
662 0x00010008 => 'CreatingApplication',
663 0x00010100 => {
664 Name => 'DataObjectStatus',
665 PrintConv => q{
666 ($val & 0x0000ffff ? 'Exists' : 'Does Not Exist') .
667 ', ' . ($val & 0xffff0000 ? 'Not ' : '') . 'Purgeable'
668 },
669 },
670 0x00010101 => {
671 Name => 'CreatingTransform',
672 PrintConv => '$val ? $val : "Source Image"',
673 },
674 0x00010102 => 'UsingTransforms',
675 0x10000000 => 'CachedImageHeight',
676 0x10000001 => 'CachedImageWidth',
677);
678
679# Transform properties
680%Image::ExifTool::FlashPix::Transform = (
681 PROCESS_PROC => \&ProcessProperties,
682 GROUPS => { 2 => 'Other' },
683 0x00010000 => 'TransformNodeID',
684 0x00010001 => 'OperationClassID',
685 0x00010002 => 'LockedPropertyList',
686 0x00010003 => 'TransformTitle',
687 0x00010004 => 'LastModifier',
688 0x00010005 => 'RevisionNumber',
689 0x00010006 => { Name => 'TransformCreateDate', Groups => { 2 => 'Time' } },
690 0x00010007 => { Name => 'TransformModifyDate', Groups => { 2 => 'Time' } },
691 0x00010008 => 'CreatingApplication',
692 0x00010100 => 'InputDataObjectList',
693 0x00010101 => 'OutputDataObjectList',
694 0x00010102 => 'OperationNumber',
695 0x10000000 => 'ResultAspectRatio',
696 0x10000001 => 'RectangleOfInterest',
697 0x10000002 => 'Filtering',
698 0x10000003 => 'SpatialOrientation',
699 0x10000004 => 'ColorTwistMatrix',
700 0x10000005 => 'ContrastAdjustment',
701);
702
703# Operation properties
704%Image::ExifTool::FlashPix::Operation = (
705 PROCESS_PROC => \&ProcessProperties,
706 0x00010000 => 'OperationID',
707);
708
709# Global Info properties
710%Image::ExifTool::FlashPix::GlobalInfo = (
711 PROCESS_PROC => \&ProcessProperties,
712 0x00010002 => 'LockedPropertyList',
713 0x00010003 => 'TransformedImageTitle',
714 0x00010004 => 'LastModifier',
715 0x00010100 => 'VisibleOutputs',
716 0x00010101 => 'MaximumImageIndex',
717 0x00010102 => 'MaximumTransformIndex',
718 0x00010103 => 'MaximumOperationIndex',
719);
720
721# Audio Info properties
722%Image::ExifTool::FlashPix::AudioInfo = (
723 PROCESS_PROC => \&ProcessProperties,
724 GROUPS => { 2 => 'Audio' },
725);
726
727# CompObj tags
728%Image::ExifTool::FlashPix::CompObj = (
729 PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
730 GROUPS => { 2 => 'Other' },
731 FORMAT => 'int32u',
732 0 => { Name => 'CompObjUserTypeLen' },
733 1 => { Name => 'CompObjUserType', Format => 'string[$val{0}]' },
734);
735
736# composite FlashPix tags
737%Image::ExifTool::FlashPix::Composite = (
738 GROUPS => { 2 => 'Image' },
739 PreviewImage => {
740 # extract JPEG preview from ScreenNail if possible
741 Require => {
742 0 => 'ScreenNail',
743 },
744 Binary => 1,
745 RawConv => q{
746 return undef unless $val[0] =~ /\xff\xd8\xff/g;
747 return substr($val[0], pos($val[0])-3);
748 },
749 },
750);
751
752# add our composite tags
753Image::ExifTool::AddCompositeTags('Image::ExifTool::FlashPix');
754
755#------------------------------------------------------------------------------
756# Process hyperlinks from PID_HYPERLINKS array
757# (ref http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnaro97ta/html/msdn_hyper97.asp)
758# Inputs: 0) value, 1) ExifTool ref
759# Returns: list of hyperlinks
760sub ProcessHyperlinks($$)
761{
762 my ($val, $exifTool) = @_;
763
764 # process as an array of VT_VARIANT's
765 my $dirEnd = length $val;
766 return undef if $dirEnd < 4;
767 my $num = Get32u(\$val, 0);
768 my $valPos = 4;
769 my ($i, @vals);
770 for ($i=0; $i<$num; ++$i) {
771 # read VT_BLOB entries as an array of VT_VARIANT's
772 my $value = ReadFPXValue($exifTool, \$val, $valPos, VT_VARIANT, $dirEnd);
773 last unless defined $value;
774 push @vals, $value;
775 }
776 # filter values to extract only the links
777 my @links;
778 for ($i=0; $i<@vals; $i+=6) {
779 push @links, $vals[$i+4]; # get address
780 $links[-1] .= '#' . $vals[$i+5] if length $vals[$i+5]; # add subaddress
781 }
782 return \@links;
783}
784
785#------------------------------------------------------------------------------
786# Print conversion for time span value
787sub ConvertTimeSpan($)
788{
789 my $val = shift;
790 if (Image::ExifTool::IsFloat($val) and $val != 0) {
791 if ($val < 60) {
792 $val = "$val seconds";
793 } elsif ($val < 3600) {
794 $val = sprintf("%.1f minutes", $val / 60);
795 } elsif ($val < 24 * 3600) {
796 $val = sprintf("%.1f hours", $val / 3600);
797 } else {
798 $val = sprintf("%.1f days", $val / (24 * 3600));
799 }
800 }
801 return $val;
802}
803
804#------------------------------------------------------------------------------
805# Read FlashPix value
806# Inputs: 0) ExifTool ref, 1) data ref, 2) value offset, 3) FPX format number,
807# 4) end offset, 5) options: 0x01=no padding, 0x02=translate to UTF8
808# Returns: converted value (or list of values in list context) and updates
809# value offset to end of value if successful, or returns undef on error
810sub ReadFPXValue($$$$$;$)
811{
812 my ($exifTool, $dataPt, $valPos, $type, $dirEnd, $opts) = @_;
813 $opts = 0 unless defined $opts;
814 my @vals;
815
816 my $format = $oleFormat{$type & 0x0fff};
817 while ($format) {
818 my $count = 1;
819 # handle VT_VECTOR types
820 my $flags = $type & 0xf000;
821 if ($flags) {
822 if ($flags == VT_VECTOR) {
823 $opts |= 0x01; # values don't seem to be padded inside vectors
824 my $size = $oleFormatSize{VT_VECTOR};
825 last if $valPos + $size > $dirEnd;
826 $count = Get32u($dataPt, $valPos);
827 push @vals, '' if $count == 0; # allow zero-element vector
828 $valPos += 4;
829 } else {
830 # can't yet handle this property flag
831 last;
832 }
833 }
834 unless ($format =~ /^VT_/) {
835 my $size = Image::ExifTool::FormatSize($format) * $count;
836 last if $valPos + $size > $dirEnd;
837 @vals = ReadValue($dataPt, $valPos, $format, $count, $size);
838 # update position to end of value plus padding
839 $valPos += ($count * $size + 3) & 0xfffffffc;
840 last;
841 }
842 my $size = $oleFormatSize{$format};
843 my ($item, $val);
844 for ($item=0; $item<$count; ++$item) {
845 last if $valPos + $size > $dirEnd;
846 if ($format eq 'VT_VARIANT') {
847 my $subType = Get32u($dataPt, $valPos);
848 $valPos += $size;
849 $val = ReadFPXValue($exifTool, $dataPt, $valPos, $subType, $dirEnd, $opts);
850 last unless defined $val;
851 push @vals, $val;
852 next; # avoid adding $size to $valPos again
853 } elsif ($format eq 'VT_FILETIME') {
854 # get time in seconds
855 $val = 1e-7 * Image::ExifTool::Get64u($dataPt, $valPos);
856 # print as date/time if value is greater than one year (PH hack)
857 if ($val > 365 * 24 * 3600) {
858 # shift from Jan 1, 1601 to Jan 1, 1970
859 $val -= 134774 * 24 * 3600 if $val != 0;
860 $val = Image::ExifTool::ConvertUnixTime($val);
861 }
862 } elsif ($format eq 'VT_DATE') {
863 $val = Image::ExifTool::GetDouble($dataPt, $valPos);
864 # shift zero from Dec 30, 1899 to Jan 1, 1970 and convert to secs
865 $val = ($val - 25569) * 24 * 3600 if $val != 0;
866 $val = Image::ExifTool::ConvertUnixTime($val);
867 } elsif ($format =~ /STR$/) {
868 my $len = Get32u($dataPt, $valPos);
869 $len *= 2 if $format eq 'VT_LPWSTR'; # convert to byte count
870 last if $valPos + $len + 4 > $dirEnd;
871 $val = substr($$dataPt, $valPos + 4, $len);
872 if ($format eq 'VT_LPWSTR') {
873 # convert wide string from Unicode
874 $val = $exifTool->Unicode2Charset($val);
875 } elsif ($opts & 0x02) {
876 # convert from Latin1 to UTF-8
877 $val = Image::ExifTool::Latin2Unicode($val,'v');
878 $val = Image::ExifTool::Unicode2UTF8($val,'v');
879 }
880 $val =~ s/\0.*//s; # truncate at null terminator
881 # update position for string length
882 # (the spec states that strings should be padded to align
883 # on even 32-bit boundaries, but this isn't always the case)
884 $valPos += ($opts & 0x01) ? $len : ($len + 3) & 0xfffffffc;
885 } elsif ($format eq 'VT_BLOB' or $format eq 'VT_CF') {
886 my $len = Get32u($dataPt, $valPos);
887 last if $valPos + $len + 4 > $dirEnd;
888 $val = substr($$dataPt, $valPos + 4, $len);
889 # update position for data length plus padding
890 # (does this padding disappear in arrays too?)
891 $valPos += ($len + 3) & 0xfffffffc;
892 } elsif ($format eq 'VT_CLSID') {
893 $val = Image::ExifTool::ASF::GetGUID(substr($$dataPt, $valPos, $size));
894 }
895 $valPos += $size; # update value pointer to end of value
896 push @vals, $val;
897 }
898 # join VT_ values with commas unless we want an array
899 @vals = ( join ', ', @vals ) if @vals > 1 and not wantarray;
900 last; # didn't really want to loop
901 }
902 $_[2] = $valPos; # return updated value position
903
904 if (wantarray) {
905 return @vals;
906 } elsif (@vals > 1) {
907 return join(' ', @vals);
908 } else {
909 return $vals[0];
910 }
911}
912
913#------------------------------------------------------------------------------
914# Check FPX byte order mark (BOM) and set byte order appropriately
915# Inputs: 0) data ref, 1) offset to BOM
916# Returns: true on success
917sub CheckBOM($$)
918{
919 my ($dataPt, $pos) = @_;
920 my $bom = Get16u($dataPt, $pos);
921 return 1 if $bom == 0xfffe;
922 return 0 unless $bom == 0xfeff;
923 ToggleByteOrder();
924 return 1;
925}
926
927#------------------------------------------------------------------------------
928# Process FlashPix properties
929# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
930# Returns: 1 on success
931sub ProcessProperties($$$)
932{
933 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
934 my $dataPt = $$dirInfo{DataPt};
935 my $pos = $$dirInfo{DirStart} || 0;
936 my $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $pos;
937 my $dirEnd = $pos + $dirLen;
938 my $verbose = $exifTool->Options('Verbose');
939 my ($out, $n);
940
941 if ($dirLen < 48) {
942 $exifTool->Warn('Truncated FPX properties');
943 return 0;
944 }
945 # check and set our byte order if necessary
946 unless (CheckBOM($dataPt, $pos)) {
947 $exifTool->Warn('Bad FPX property byte order mark');
948 return 0;
949 }
950 # get position of start of section
951 $pos = Get32u($dataPt, $pos + 44);
952 if ($pos < 48) {
953 $exifTool->Warn('Bad FPX property section offset');
954 return 0;
955 }
956 for ($n=0; $n<2; ++$n) {
957 my %dictionary; # dictionary to translate user-defined properties
958 my $opts = 0; # option flags for converting values
959 last if $pos + 8 > $dirEnd;
960 # read property section header
961 my $size = Get32u($dataPt, $pos);
962 last unless $size;
963 my $numEntries = Get32u($dataPt, $pos + 4);
964 $verbose and $exifTool->VerboseDir('Property Info', $numEntries, $size);
965 if ($pos + 8 + 8 * $numEntries > $dirEnd) {
966 $exifTool->Warn('Truncated property list');
967 last;
968 }
969 my $index;
970 for ($index=0; $index<$numEntries; ++$index) {
971 my $entry = $pos + 8 + 8 * $index;
972 my $tag = Get32u($dataPt, $entry);
973 my $offset = Get32u($dataPt, $entry + 4);
974 my $valStart = $pos + 4 + $offset;
975 last if $valStart >= $dirEnd;
976 my $valPos = $valStart;
977 my $type = Get32u($dataPt, $pos + $offset);
978 if ($tag == 0) {
979 # read dictionary to get tag name lookup for this property set
980 my $i;
981 for ($i=0; $i<$type; ++$i) {
982 last if $valPos + 8 > $dirEnd;
983 $tag = Get32u($dataPt, $valPos);
984 my $len = Get32u($dataPt, $valPos + 4);
985 $valPos += 8 + $len;
986 last if $valPos > $dirEnd;
987 my $name = substr($$dataPt, $valPos - $len, $len);
988 $name =~ s/\0.*//s;
989 next unless length $name;
990 $dictionary{$tag} = $name;
991 next if $$tagTablePtr{$name};
992 $tag = $name;
993 $name =~ tr/a-zA-Z0-9//dc;
994 next unless length $name;
995 Image::ExifTool::AddTagToTable($tagTablePtr, $tag, { Name => ucfirst($name) });
996 }
997 next;
998 }
999 # use tag name from dictionary if available
1000 my ($custom, $val);
1001 if (defined $dictionary{$tag}) {
1002 $tag = $dictionary{$tag};
1003 $custom = 1;
1004 }
1005 my @vals = ReadFPXValue($exifTool, $dataPt, $valPos, $type, $dirEnd, $opts);
1006 @vals or $exifTool->Warn('Error reading property value');
1007 $val = @vals > 1 ? \@vals : $vals[0];
1008 my $format = $type & 0x0fff;
1009 my $flags = $type & 0xf000;
1010 my $formStr = $oleFormat{$format} || "Type $format";
1011 $formStr .= '|' . ($oleFlags{$flags} || sprintf("0x%x",$flags)) if $flags;
1012 my $tagInfo;
1013 # check for common tag ID's: Dictionary, CodePage and LocaleIndicator
1014 # (must be done before masking because masked tags may overlap these ID's)
1015 if (not $custom and ($tag == 1 or $tag == 0x80000000)) {
1016 # get tagInfo from SummaryInfo table
1017 my $summaryTable = GetTagTable('Image::ExifTool::FlashPix::SummaryInfo');
1018 $tagInfo = $exifTool->GetTagInfo($summaryTable, $tag);
1019 if ($tag == 1 and $val == 1252 and $exifTool->Options('Charset') eq 'UTF8') {
1020 # set flag to translate 8-bit text only if
1021 # code page is cp1252 and Charset is UTF8
1022 $opts |= 0x02;
1023 }
1024 } elsif ($$tagTablePtr{$tag}) {
1025 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
1026 } elsif ($$tagTablePtr{VARS} and not $custom) {
1027 # mask off insignificant bits of tag ID if necessary
1028 my $masked = $$tagTablePtr{VARS};
1029 my $mask;
1030 foreach $mask (keys %$masked) {
1031 if ($masked->{$mask}->{$tag & $mask}) {
1032 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag & $mask);
1033 last;
1034 }
1035 }
1036 }
1037 $exifTool->HandleTag($tagTablePtr, $tag, $val,
1038 DataPt => $dataPt,
1039 Start => $valStart,
1040 Size => $valPos - $valStart,
1041 Format => $formStr,
1042 Index => $index,
1043 TagInfo => $tagInfo,
1044 Extra => ", type=$type",
1045 );
1046 }
1047 # issue warning if we hit end of property section prematurely
1048 $exifTool->Warn('Truncated property data') if $index < $numEntries;
1049 last unless $$dirInfo{Multi};
1050 $pos += $size;
1051 }
1052
1053 return 1;
1054}
1055
1056#------------------------------------------------------------------------------
1057# Load chain of sectors from file
1058# Inputs: 0) RAF ref, 1) first sector number, 2) FAT ref, 3) sector size, 4) header size
1059sub LoadChain($$$$$)
1060{
1061 my ($raf, $sect, $fatPt, $sectSize, $hdrSize) = @_;
1062 return undef unless $raf;
1063 my $chain = '';
1064 my ($buff, %loadedSect);
1065 for (;;) {
1066 last if $sect == END_OF_CHAIN;
1067 return undef if $loadedSect{$sect}; # avoid infinite loop
1068 $loadedSect{$sect} = 1;
1069 my $offset = $sect * $sectSize + $hdrSize;
1070 return undef unless $offset <= 0x7fffffff and
1071 $raf->Seek($offset, 0) and
1072 $raf->Read($buff, $sectSize) == $sectSize;
1073 $chain .= $buff;
1074 # step to next sector in chain
1075 return undef if $sect * 4 > length($$fatPt) - 4;
1076 $sect = Get32u($fatPt, $sect * 4);
1077 }
1078 return $chain;
1079}
1080
1081#------------------------------------------------------------------------------
1082# Extract information from a JPEG APP2 FPXR segment
1083# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
1084# Returns: 1 on success
1085sub ProcessFPXR($$$)
1086{
1087 my ($exifTool, $dirInfo, $tagTablePtr) = @_;
1088 my $dataPt = $$dirInfo{DataPt};
1089 my $dirStart = $$dirInfo{DirStart};
1090 my $dirLen = $$dirInfo{DirLen};
1091 my $verbose = $exifTool->Options('Verbose');
1092
1093 if ($dirLen < 13) {
1094 $exifTool->Warn('FPXR segment to small');
1095 return 0;
1096 }
1097
1098 # get version and segment type (version is 0 in all my samples)
1099 my ($vers, $type) = unpack('x5C2', $$dataPt);
1100
1101 if ($type == 1) { # a "Contents List" segment
1102
1103 $vers != 0 and $exifTool->Warn("Untested FPXR version $vers");
1104 if ($$exifTool{FPXR}) {
1105 $exifTool->Warn('Multiple FPXR contents lists');
1106 delete $$exifTool{FPXR};
1107 }
1108 my $numEntries = unpack('x7n', $$dataPt);
1109 my @contents;
1110 $verbose and $exifTool->VerboseDir('Contents List', $numEntries);
1111 my $pos = 9;
1112 my $entry;
1113 for ($entry = 0; $entry < $numEntries; ++$entry) {
1114 if ($pos + 4 > $dirLen) {
1115 $exifTool->Warn('Truncated FPXR contents');
1116 return 0;
1117 }
1118 my ($size, $default) = unpack("x${pos}Na", $$dataPt);
1119 pos($$dataPt) = $pos + 5;
1120 # according to the spec, this string is little-endian
1121 # (very odd, since the size word is big-endian),
1122 # and the first char must be '/'
1123 unless ($$dataPt =~ m{\G(/\0(..)*?)\0\0}sg) {
1124 $exifTool->Warn('Invalid FPXR stream name');
1125 return 0;
1126 }
1127 # convert stream pathname to ascii
1128 my $name = Image::ExifTool::Unicode2Latin($1, 'v');
1129 if ($verbose) {
1130 my $psize = ($size == 0xffffffff) ? 'storage' : "$size bytes";
1131 $exifTool->VPrint(0," | $entry) Name: '$name' [$psize]\n");
1132 }
1133 # remove directory specification
1134 $name =~ s{.*/}{}s;
1135 # read storage class ID if necessary
1136 my $classID;
1137 if ($size == 0xffffffff) {
1138 unless ($$dataPt =~ m{(.{16})}sg) {
1139 $exifTool->Warn('Truncated FPXR storage class ID');
1140 return 0;
1141 }
1142 # unpack class ID in case we want to use it sometime
1143 $classID = Image::ExifTool::ASF::GetGUID($1);
1144 }
1145 # update position in list
1146 $pos = pos($$dataPt);
1147 # add to our contents list
1148 push @contents, {
1149 Name => $name,
1150 Size => $size,
1151 Default => $default,
1152 ClassID => $classID,
1153 };
1154 }
1155 # save contents list as $exifTool member variable
1156 # (must do this last so we don't save list on error)
1157 $$exifTool{FPXR} = \@contents;
1158
1159 } elsif ($type == 2) { # a "Stream Data" segment
1160
1161 # get the contents list index and stream data offset
1162 my ($index, $offset) = unpack('x7nN', $$dataPt);
1163 my $fpxr = $$exifTool{FPXR};
1164 if ($fpxr and $$fpxr[$index]) {
1165 my $obj = $$fpxr[$index];
1166 # extract stream data (after 13-byte header)
1167 if (not defined $$obj{Stream}) {
1168 # ignore offset for first segment of this type
1169 # (in my sample images, this isn't always zero as one would expect)
1170 $$obj{Stream} = substr($$dataPt, $dirStart+13);
1171 } else {
1172 # add data to the stream at the proper offset
1173 my $pad = $offset - length($$obj{Stream});
1174 if ($pad >= 0) {
1175 if ($pad) {
1176 if ($pad > 0x10000) {
1177 $exifTool->Warn("Bad FPXR stream offset ($offset)");
1178 } else {
1179 # pad with default value to specified offset
1180 $exifTool->Warn("Padding FPXR stream with $pad default bytes",1);
1181 $$obj{Stream} .= ($$obj{Default} x $pad);
1182 }
1183 }
1184 # concatinate data with this stream
1185 $$obj{Stream} .= substr($$dataPt, $dirStart+13);
1186 } else {
1187 $exifTool->Warn("Duplicate FPXR stream data at offset $offset");
1188 substr($$obj{Stream}, $offset, -$pad) = substr($$dataPt, $dirStart+13);
1189 }
1190 }
1191 # save value for this tag if stream is complete
1192 my $len = length $$obj{Stream};
1193 if ($len >= $$obj{Size}) {
1194 if ($verbose) {
1195 $exifTool->VPrint(0, " + [FPXR stream, Contents index $index, $len bytes]\n");
1196 }
1197 if ($len > $$obj{Size}) {
1198 $exifTool->Warn('Extra data in FPXR segment (truncated)');
1199 $$obj{Stream} = substr($$obj{Stream}, 0, $$obj{Size});
1200 }
1201 my $tag = $$obj{Name};
1202 my $tagInfo;
1203 unless ($$tagTablePtr{$tag}) {
1204 # remove instance number or class ID from tag if necessary
1205 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $1) if
1206 ($tag =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
1207 ($tag =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
1208 }
1209 # save the data for this tag
1210 $exifTool->HandleTag($tagTablePtr, $tag, $$obj{Stream},
1211 DataPt => \$$obj{Stream},
1212 TagInfo => $tagInfo,
1213 );
1214 delete $$obj{Stream}; # done with this stream
1215 }
1216 } else {
1217 $exifTool->Warn("Unlisted FPXR segment (index $index)");
1218 }
1219
1220 } elsif ($type ne 3) { # not a "Reserved" segment
1221
1222 $exifTool->Warn("Unknown FPXR segment (type $type)");
1223
1224 }
1225
1226 # clean up if this was the last FPXR segment
1227 if ($$dirInfo{LastFPXR} and $$exifTool{FPXR}) {
1228 my $obj;
1229 my $i = 0;
1230 foreach $obj (@{$$exifTool{FPXR}}) {
1231 $exifTool->Warn("Missing stream for FPXR object $i") if defined $$obj{Stream};
1232 ++$i;
1233 }
1234 delete $$exifTool{FPXR}; # delete our temporary variables
1235 }
1236 return 1;
1237}
1238
1239#------------------------------------------------------------------------------
1240# Extract information from a FlashPix (FPX) file
1241# Inputs: 0) ExifTool object ref, 1) dirInfo ref
1242# Returns: 1 on success, 0 if this wasn't a valid FPX image
1243sub ProcessFPX($$)
1244{
1245 my ($exifTool, $dirInfo) = @_;
1246 my $raf = $$dirInfo{RAF};
1247 my ($buff, $out, %dumpParms, $oldIndent, $miniStreamBuff);
1248
1249 # read header
1250 return 0 unless $raf->Read($buff,HDR_SIZE) == HDR_SIZE;
1251 # check signature
1252 return 0 unless $buff =~ /^\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1/;
1253
1254 my $fileType = $exifTool->{FILE_EXT};
1255 $fileType = 'FPX' unless $fileType and $fileType =~ /^(DOC|XLS|PPT)$/;
1256 $exifTool->SetFileType($fileType);
1257 SetByteOrder(substr($buff, 0x1c, 2) eq "\xff\xfe" ? 'MM' : 'II');
1258 my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
1259 my $verbose = $exifTool->Options('Verbose');
1260
1261 my $sectSize = 1 << Get16u(\$buff, 0x1e);
1262 my $miniSize = 1 << Get16u(\$buff, 0x20);
1263 my $fatCount = Get32u(\$buff, 0x2c); # number of FAT sectors
1264 my $dirStart = Get32u(\$buff, 0x30); # first directory sector
1265 my $miniCutoff = Get32u(\$buff, 0x38); # minimum size for big-FAT streams
1266 my $miniStart = Get32u(\$buff, 0x3c); # first sector of mini-FAT
1267 my $miniCount = Get32u(\$buff, 0x40); # number of mini-FAT sectors
1268 my $difStart = Get32u(\$buff, 0x44); # first sector of DIF chain
1269 my $difCount = Get32u(\$buff, 0x48); # number of DIF sectors
1270
1271 if ($verbose) {
1272 $out = $exifTool->Options('TextOut');
1273 $dumpParms{MaxLen} = 96 if $verbose == 3;
1274 print $out " Sector size=$sectSize\n FAT: Count=$fatCount\n";
1275 print $out " DIR: Start=$dirStart\n";
1276 print $out " MiniFAT: Mini-sector size=$miniSize Start=$miniStart Count=$miniCount Cutoff=$miniCutoff\n";
1277 print $out " DIF FAT: Start=$difStart Count=$difCount\n";
1278 }
1279#
1280# load the FAT
1281#
1282 my $pos = 0x4c;
1283 my $endPos = length($buff);
1284 my $fat = '';
1285 my $fatCountCheck = 0;
1286 for (;;) {
1287 while ($pos <= $endPos - 4) {
1288 my $sect = Get32u(\$buff, $pos);
1289 $pos += 4;
1290 next if $sect == FREE_SECT;
1291 my $offset = $sect * $sectSize + HDR_SIZE;
1292 my $fatSect;
1293 unless ($raf->Seek($offset, 0) and
1294 $raf->Read($fatSect, $sectSize) == $sectSize)
1295 {
1296 $exifTool->Error("Error reading FAT from sector $sect");
1297 return 1;
1298 }
1299 $fat .= $fatSect;
1300 ++$fatCountCheck;
1301 }
1302 last if $difStart == END_OF_CHAIN;
1303 # read next DIF (Dual Indirect FAT) sector
1304 my $offset = $difStart * $sectSize + HDR_SIZE;
1305 unless ($raf->Seek($offset, 0) and $raf->Read($buff, $sectSize) == $sectSize) {
1306 $exifTool->Error("Error reading DIF sector $difStart");
1307 return 1;
1308 }
1309 # set end of sector information in this DIF
1310 $endPos = $sectSize - 4;
1311 # next time around we want to read next DIF in chain
1312 $difStart = Get32u(\$buff, $endPos);
1313 }
1314 if ($fatCountCheck != $fatCount) {
1315 $exifTool->Warn("Bad number of FAT sectors (expected $fatCount but found $fatCountCheck)");
1316 }
1317#
1318# load the mini-FAT and the directory
1319#
1320 my $miniFat = LoadChain($raf, $miniStart, \$fat, $sectSize, HDR_SIZE);
1321 my $dir = LoadChain($raf, $dirStart, \$fat, $sectSize, HDR_SIZE);
1322 unless (defined $miniFat and defined $dir) {
1323 $exifTool->Error('Error reading mini-FAT or directory stream');
1324 return 1;
1325 }
1326 if ($verbose) {
1327 print $out " FAT [",length($fat)," bytes]:\n";
1328 Image::ExifTool::HexDump(\$fat, undef, %dumpParms) if $verbose > 2;
1329 print $out " Mini-FAT [",length($miniFat)," bytes]:\n";
1330 Image::ExifTool::HexDump(\$miniFat, undef, %dumpParms) if $verbose > 2;
1331 print $out " Directory [",length($dir)," bytes]:\n";
1332 Image::ExifTool::HexDump(\$dir, undef, %dumpParms) if $verbose > 2;
1333 }
1334#
1335# process the directory
1336#
1337 if ($verbose) {
1338 $oldIndent = $exifTool->{INDENT};
1339 $exifTool->{INDENT} .= '| ';
1340 $exifTool->VerboseDir('FPX', undef, length $dir);
1341 }
1342 my $miniStream;
1343 $endPos = length($dir);
1344 my $index = 0;
1345
1346 for ($pos=0; $pos<=$endPos-128; $pos+=128) {
1347
1348 # get directory entry type
1349 # (0=invalid, 1=storage, 2=stream, 3=lockbytes, 4=property, 5=root)
1350 my $type = Get8u(\$dir, $pos + 0x42);
1351 next if $type == 0; # skip invalid entries
1352 if ($type > 5) {
1353 $exifTool->Warn("Invalid directory entry type $type");
1354 last; # rest of directory is probably garbage
1355 }
1356 # get entry name (note: this is supposed to be length in 2-byte
1357 # characters but this isn't what is done in my sample FPX file, so
1358 # be very tolerant of this count -- it's null terminated anyway)
1359 my $len = Get16u(\$dir, $pos + 0x40);
1360 $len > 32 and $len = 32;
1361 my $tag = Image::ExifTool::Unicode2Latin(substr($dir, $pos, $len * 2), 'v');
1362 $tag =~ s/\0.*//s; # truncate at null (in case length was wrong)
1363
1364 my $sect = Get32u(\$dir, $pos + 0x74); # start sector number
1365 my $size = Get32u(\$dir, $pos + 0x78); # stream length
1366
1367 # load Ministream (referenced from first directory entry)
1368 unless ($miniStream) {
1369 $miniStreamBuff = LoadChain($raf, $sect, \$fat, $sectSize, HDR_SIZE);
1370 unless (defined $miniStreamBuff) {
1371 $exifTool->Warn('Error loading Mini-FAT stream');
1372 last;
1373 }
1374 $miniStream = new File::RandomAccess(\$miniStreamBuff);
1375 }
1376
1377 my $tagInfo;
1378 if ($$tagTablePtr{$tag}) {
1379 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $tag);
1380 } else {
1381 # remove instance number or class ID from tag if necessary
1382 $tagInfo = $exifTool->GetTagInfo($tagTablePtr, $1) if
1383 ($tag =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
1384 ($tag =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
1385 }
1386
1387 next unless $tagInfo or $verbose;
1388
1389 # load the data for stream types
1390 my $extra = '';
1391 my $typeStr = $dirEntryType[$type] || $type;
1392 if ($typeStr eq 'STREAM') {
1393 if ($size >= $miniCutoff) {
1394 # stream is in the main FAT
1395 $buff = LoadChain($raf, $sect, \$fat, $sectSize, HDR_SIZE);
1396 } elsif ($size) {
1397 # stream is in the mini-FAT
1398 $buff = LoadChain($miniStream, $sect, \$miniFat, $miniSize, 0);
1399 } else {
1400 $buff = ''; # an empty stream
1401 }
1402 unless (defined $buff) {
1403 my $name = $tagInfo ? $$tagInfo{Name} : 'unknown';
1404 $exifTool->Warn("Error reading $name stream");
1405 $buff = '';
1406 }
1407 } elsif ($typeStr eq 'ROOT') {
1408 $buff = $miniStreamBuff;
1409 $extra .= ' (Ministream)';
1410 } else {
1411 $buff = '';
1412 undef $size;
1413 }
1414 if ($verbose) {
1415 my $flags = Get8u(\$dir, $pos + 0x43); # 0=red, 1=black
1416 my $lSib = Get32u(\$dir, $pos + 0x44); # left sibling
1417 my $rSib = Get32u(\$dir, $pos + 0x48); # right sibling
1418 my $chld = Get32u(\$dir, $pos + 0x4c); # child directory
1419 my $col = { 0 => 'Red', 1 => 'Black' }->{$flags} || $flags;
1420 $extra .= " Type=$typeStr Flags=$col";
1421 $extra .= " Left=$lSib" unless $lSib == FREE_SECT;
1422 $extra .= " Right=$rSib" unless $rSib == FREE_SECT;
1423 $extra .= " Child=$chld" unless $chld == FREE_SECT;
1424 $exifTool->VerboseInfo($tag, $tagInfo,
1425 Index => $index++,
1426 Value => $buff,
1427 DataPt => \$buff,
1428 Extra => $extra,
1429 Size => $size,
1430 );
1431 }
1432 if ($tagInfo and $buff) {
1433 if ($$tagInfo{SubDirectory}) {
1434 my %dirInfo = (
1435 DataPt => \$buff,
1436 DirStart => $tagInfo->{SubDirectory}->{DirStart},
1437 DirLen => length $buff,
1438 Multi => $$tagInfo{Multi},
1439 );
1440 my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
1441 $exifTool->ProcessDirectory(\%dirInfo, $subTablePtr);
1442 } else {
1443 $exifTool->FoundTag($tagInfo, $buff);
1444 }
1445 }
1446 }
1447 $exifTool->{INDENT} = $oldIndent if $verbose;
1448 return 1;
1449}
1450
14511; # end
1452
1453__END__
1454
1455=head1 NAME
1456
1457Image::ExifTool::FlashPix - Read FlashPix meta information
1458
1459=head1 SYNOPSIS
1460
1461This module is used by Image::ExifTool
1462
1463=head1 DESCRIPTION
1464
1465This module contains routines required by Image::ExifTool to extract
1466FlashPix meta information from FPX images, and from the APP2 FPXR segment of
1467JPEG images.
1468
1469=head1 AUTHOR
1470
1471Copyright 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
1472
1473This library is free software; you can redistribute it and/or modify it
1474under the same terms as Perl itself.
1475
1476=head1 REFERENCES
1477
1478=over 4
1479
1480=item L<http://www.exif.org/Exif2-2.PDF>
1481
1482=item L<http://www.graphcomp.com/info/specs/livepicture/fpx.pdf>
1483
1484=item L<http://search.cpan.org/~jdb/libwin32/>
1485
1486=back
1487
1488=head1 SEE ALSO
1489
1490L<Image::ExifTool::TagNames/FlashPix Tags>,
1491L<Image::ExifTool(3pm)|Image::ExifTool>
1492
1493=cut
1494
Note: See TracBrowser for help on using the repository browser.