123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935 |
- #------------------------------------------------------------------------------
- # File: FlashPix.pm
- #
- # Description: Read FlashPix meta information
- #
- # Revisions: 05/29/2006 - P. Harvey Created
- #
- # References: 1) http://www.exif.org/Exif2-2.PDF
- # 2) http://www.graphcomp.com/info/specs/livepicture/fpx.pdf
- # 3) http://search.cpan.org/~jdb/libwin32/
- # 4) http://msdn.microsoft.com/en-us/library/aa380374.aspx
- #------------------------------------------------------------------------------
- package Image::ExifTool::FlashPix;
- use strict;
- use vars qw($VERSION);
- use Image::ExifTool qw(:DataAccess :Utils);
- use Image::ExifTool::Exif;
- use Image::ExifTool::ASF; # for GetGUID()
- $VERSION = '1.26';
- sub ProcessFPX($$);
- sub ProcessFPXR($$$);
- sub ProcessProperties($$$);
- sub ReadFPXValue($$$$$;$$);
- sub ProcessHyperlinks($$);
- sub ProcessContents($$$);
- sub SetDocNum($$;$$$);
- # sector type constants
- sub HDR_SIZE () { 512; }
- sub DIF_SECT () { 0xfffffffc; }
- sub FAT_SECT () { 0xfffffffd; }
- sub END_OF_CHAIN () { 0xfffffffe; }
- sub FREE_SECT () { 0xffffffff; }
- # format flags
- sub VT_VECTOR () { 0x1000; }
- sub VT_ARRAY () { 0x2000; }
- sub VT_BYREF () { 0x4000; }
- sub VT_RESERVED () { 0x8000; }
- # other constants
- sub VT_VARIANT () { 12; }
- sub VT_LPSTR () { 30; }
- # list of OLE format codes (unsupported codes commented out)
- my %oleFormat = (
- 0 => undef, # VT_EMPTY
- 1 => undef, # VT_NULL
- 2 => 'int16s', # VT_I2
- 3 => 'int32s', # VT_I4
- 4 => 'float', # VT_R4
- 5 => 'double', # VT_R8
- 6 => undef, # VT_CY
- 7 => 'VT_DATE', # VT_DATE (double, number of days since Dec 30, 1899)
- 8 => 'VT_BSTR', # VT_BSTR (int32u count, followed by binary string)
- # 9 => 'VT_DISPATCH',
- 10 => 'int32s', # VT_ERROR
- 11 => 'int16s', # VT_BOOL
- 12 => 'VT_VARIANT', # VT_VARIANT
- # 13 => 'VT_UNKNOWN',
- # 14 => 'VT_DECIMAL',
- 16 => 'int8s', # VT_I1
- 17 => 'int8u', # VT_UI1
- 18 => 'int16u', # VT_UI2
- 19 => 'int32u', # VT_UI4
- 20 => 'int64s', # VT_I8
- 21 => 'int64u', # VT_UI8
- # 22 => 'VT_INT',
- # 23 => 'VT_UINT',
- # 24 => 'VT_VOID',
- # 25 => 'VT_HRESULT',
- # 26 => 'VT_PTR',
- # 27 => 'VT_SAFEARRAY',
- # 28 => 'VT_CARRAY',
- # 29 => 'VT_USERDEFINED',
- 30 => 'VT_LPSTR', # VT_LPSTR (int32u count, followed by string)
- 31 => 'VT_LPWSTR', # VT_LPWSTR (int32u word count, followed by Unicode string)
- 64 => 'VT_FILETIME',# VT_FILETIME (int64u, 100 ns increments since Jan 1, 1601)
- 65 => 'VT_BLOB', # VT_BLOB
- # 66 => 'VT_STREAM',
- # 67 => 'VT_STORAGE',
- # 68 => 'VT_STREAMED_OBJECT',
- # 69 => 'VT_STORED_OBJECT',
- # 70 => 'VT_BLOB_OBJECT',
- 71 => 'VT_CF', # VT_CF
- 72 => 'VT_CLSID', # VT_CLSID
- );
- # OLE flag codes (high nibble of property type)
- my %oleFlags = (
- 0x1000 => 'VT_VECTOR',
- 0x2000 => 'VT_ARRAY', # not yet supported
- 0x4000 => 'VT_BYREF', # ditto
- 0x8000 => 'VT_RESERVED',
- );
- # byte sizes for supported VT_* format and flag types
- my %oleFormatSize = (
- VT_DATE => 8,
- VT_BSTR => 4, # (+ string length)
- VT_VARIANT => 4, # (+ data length)
- VT_LPSTR => 4, # (+ string length)
- VT_LPWSTR => 4, # (+ string character length)
- VT_FILETIME => 8,
- VT_BLOB => 4, # (+ data length)
- VT_CF => 4, # (+ data length)
- VT_CLSID => 16,
- VT_VECTOR => 4, # (+ vector elements)
- );
- # names for each type of directory entry
- my @dirEntryType = qw(INVALID STORAGE STREAM LOCKBYTES PROPERTY ROOT);
- # list of code pages used by Microsoft
- # (ref http://msdn.microsoft.com/en-us/library/dd317756(VS.85).aspx)
- my %codePage = (
- 037 => 'IBM EBCDIC US-Canada',
- 437 => 'DOS United States',
- 500 => 'IBM EBCDIC International',
- 708 => 'Arabic (ASMO 708)',
- 709 => 'Arabic (ASMO-449+, BCON V4)',
- 710 => 'Arabic - Transparent Arabic',
- 720 => 'DOS Arabic (Transparent ASMO)',
- 737 => 'DOS Greek (formerly 437G)',
- 775 => 'DOS Baltic',
- 850 => 'DOS Latin 1 (Western European)',
- 852 => 'DOS Latin 2 (Central European)',
- 855 => 'DOS Cyrillic (primarily Russian)',
- 857 => 'DOS Turkish',
- 858 => 'DOS Multilingual Latin 1 with Euro',
- 860 => 'DOS Portuguese',
- 861 => 'DOS Icelandic',
- 862 => 'DOS Hebrew',
- 863 => 'DOS French Canadian',
- 864 => 'DOS Arabic',
- 865 => 'DOS Nordic',
- 866 => 'DOS Russian (Cyrillic)',
- 869 => 'DOS Modern Greek',
- 870 => 'IBM EBCDIC Multilingual/ROECE (Latin 2)',
- 874 => 'Windows Thai (same as 28605, ISO 8859-15)',
- 875 => 'IBM EBCDIC Greek Modern',
- 932 => 'Windows Japanese (Shift-JIS)',
- 936 => 'Windows Simplified Chinese (PRC, Singapore)',
- 949 => 'Windows Korean (Unified Hangul Code)',
- 950 => 'Windows Traditional Chinese (Taiwan)',
- 1026 => 'IBM EBCDIC Turkish (Latin 5)',
- 1047 => 'IBM EBCDIC Latin 1/Open System',
- 1140 => 'IBM EBCDIC US-Canada with Euro',
- 1141 => 'IBM EBCDIC Germany with Euro',
- 1142 => 'IBM EBCDIC Denmark-Norway with Euro',
- 1143 => 'IBM EBCDIC Finland-Sweden with Euro',
- 1144 => 'IBM EBCDIC Italy with Euro',
- 1145 => 'IBM EBCDIC Latin America-Spain with Euro',
- 1146 => 'IBM EBCDIC United Kingdom with Euro',
- 1147 => 'IBM EBCDIC France with Euro',
- 1148 => 'IBM EBCDIC International with Euro',
- 1149 => 'IBM EBCDIC Icelandic with Euro',
- 1200 => 'Unicode UTF-16, little endian',
- 1201 => 'Unicode UTF-16, big endian',
- 1250 => 'Windows Latin 2 (Central European)',
- 1251 => 'Windows Cyrillic',
- 1252 => 'Windows Latin 1 (Western European)',
- 1253 => 'Windows Greek',
- 1254 => 'Windows Turkish',
- 1255 => 'Windows Hebrew',
- 1256 => 'Windows Arabic',
- 1257 => 'Windows Baltic',
- 1258 => 'Windows Vietnamese',
- 1361 => 'Korean (Johab)',
- 10000 => 'Mac Roman (Western European)',
- 10001 => 'Mac Japanese',
- 10002 => 'Mac Traditional Chinese',
- 10003 => 'Mac Korean',
- 10004 => 'Mac Arabic',
- 10005 => 'Mac Hebrew',
- 10006 => 'Mac Greek',
- 10007 => 'Mac Cyrillic',
- 10008 => 'Mac Simplified Chinese',
- 10010 => 'Mac Romanian',
- 10017 => 'Mac Ukrainian',
- 10021 => 'Mac Thai',
- 10029 => 'Mac Latin 2 (Central European)',
- 10079 => 'Mac Icelandic',
- 10081 => 'Mac Turkish',
- 10082 => 'Mac Croatian',
- 12000 => 'Unicode UTF-32, little endian',
- 12001 => 'Unicode UTF-32, big endian',
- 20000 => 'CNS Taiwan',
- 20001 => 'TCA Taiwan',
- 20002 => 'Eten Taiwan',
- 20003 => 'IBM5550 Taiwan',
- 20004 => 'TeleText Taiwan',
- 20005 => 'Wang Taiwan',
- 20105 => 'IA5 (IRV International Alphabet No. 5, 7-bit)',
- 20106 => 'IA5 German (7-bit)',
- 20107 => 'IA5 Swedish (7-bit)',
- 20108 => 'IA5 Norwegian (7-bit)',
- 20127 => 'US-ASCII (7-bit)',
- 20261 => 'T.61',
- 20269 => 'ISO 6937 Non-Spacing Accent',
- 20273 => 'IBM EBCDIC Germany',
- 20277 => 'IBM EBCDIC Denmark-Norway',
- 20278 => 'IBM EBCDIC Finland-Sweden',
- 20280 => 'IBM EBCDIC Italy',
- 20284 => 'IBM EBCDIC Latin America-Spain',
- 20285 => 'IBM EBCDIC United Kingdom',
- 20290 => 'IBM EBCDIC Japanese Katakana Extended',
- 20297 => 'IBM EBCDIC France',
- 20420 => 'IBM EBCDIC Arabic',
- 20423 => 'IBM EBCDIC Greek',
- 20424 => 'IBM EBCDIC Hebrew',
- 20833 => 'IBM EBCDIC Korean Extended',
- 20838 => 'IBM EBCDIC Thai',
- 20866 => 'Russian/Cyrillic (KOI8-R)',
- 20871 => 'IBM EBCDIC Icelandic',
- 20880 => 'IBM EBCDIC Cyrillic Russian',
- 20905 => 'IBM EBCDIC Turkish',
- 20924 => 'IBM EBCDIC Latin 1/Open System with Euro',
- 20932 => 'Japanese (JIS 0208-1990 and 0121-1990)',
- 20936 => 'Simplified Chinese (GB2312)',
- 20949 => 'Korean Wansung',
- 21025 => 'IBM EBCDIC Cyrillic Serbian-Bulgarian',
- 21027 => 'Extended Alpha Lowercase (deprecated)',
- 21866 => 'Ukrainian/Cyrillic (KOI8-U)',
- 28591 => 'ISO 8859-1 Latin 1 (Western European)',
- 28592 => 'ISO 8859-2 (Central European)',
- 28593 => 'ISO 8859-3 Latin 3',
- 28594 => 'ISO 8859-4 Baltic',
- 28595 => 'ISO 8859-5 Cyrillic',
- 28596 => 'ISO 8859-6 Arabic',
- 28597 => 'ISO 8859-7 Greek',
- 28598 => 'ISO 8859-8 Hebrew (Visual)',
- 28599 => 'ISO 8859-9 Turkish',
- 28603 => 'ISO 8859-13 Estonian',
- 28605 => 'ISO 8859-15 Latin 9',
- 29001 => 'Europa 3',
- 38598 => 'ISO 8859-8 Hebrew (Logical)',
- 50220 => 'ISO 2022 Japanese with no halfwidth Katakana (JIS)',
- 50221 => 'ISO 2022 Japanese with halfwidth Katakana (JIS-Allow 1 byte Kana)',
- 50222 => 'ISO 2022 Japanese JIS X 0201-1989 (JIS-Allow 1 byte Kana - SO/SI)',
- 50225 => 'ISO 2022 Korean',
- 50227 => 'ISO 2022 Simplified Chinese',
- 50229 => 'ISO 2022 Traditional Chinese',
- 50930 => 'EBCDIC Japanese (Katakana) Extended',
- 50931 => 'EBCDIC US-Canada and Japanese',
- 50933 => 'EBCDIC Korean Extended and Korean',
- 50935 => 'EBCDIC Simplified Chinese Extended and Simplified Chinese',
- 50936 => 'EBCDIC Simplified Chinese',
- 50937 => 'EBCDIC US-Canada and Traditional Chinese',
- 50939 => 'EBCDIC Japanese (Latin) Extended and Japanese',
- 51932 => 'EUC Japanese',
- 51936 => 'EUC Simplified Chinese',
- 51949 => 'EUC Korean',
- 51950 => 'EUC Traditional Chinese',
- 52936 => 'HZ-GB2312 Simplified Chinese',
- 54936 => 'Windows XP and later: GB18030 Simplified Chinese (4 byte)',
- 57002 => 'ISCII Devanagari',
- 57003 => 'ISCII Bengali',
- 57004 => 'ISCII Tamil',
- 57005 => 'ISCII Telugu',
- 57006 => 'ISCII Assamese',
- 57007 => 'ISCII Oriya',
- 57008 => 'ISCII Kannada',
- 57009 => 'ISCII Malayalam',
- 57010 => 'ISCII Gujarati',
- 57011 => 'ISCII Punjabi',
- 65000 => 'Unicode (UTF-7)',
- 65001 => 'Unicode (UTF-8)',
- );
- # test for file extensions which may be variants of the FPX format
- # (have seen one password-protected DOCX file that is FPX-like, so assume
- # that all the rest could be as well)
- my %fpxFileType = (
- DOC => 1, DOCX => 1, DOCM => 1,
- DOT => 1, DOTX => 1, DOTM => 1,
- POT => 1, POTX => 1, POTM => 1,
- PPS => 1, PPSX => 1, PPSM => 1,
- PPT => 1, PPTX => 1, PPTM => 1, THMX => 1,
- XLA => 1, XLAM => 1,
- XLS => 1, XLSX => 1, XLSM => 1, XLSB => 1,
- XLT => 1, XLTX => 1, XLTM => 1,
- # non MSOffice types
- FLA => 1, VSD => 1,
- );
- %Image::ExifTool::FlashPix::Main = (
- PROCESS_PROC => \&ProcessFPXR,
- GROUPS => { 2 => 'Image' },
- NOTES => q{
- The FlashPix file format, introduced in 1996, was developed by Kodak,
- Hewlett-Packard and Microsoft. Internally the FPX file structure mimics
- that of an old DOS disk with fixed-sized "sectors" (usually 512 bytes) and a
- "file allocation table" (FAT). No wonder this image format never became
- popular. However, some of the structures used in FlashPix streams are part
- of the EXIF specification, and are still being used in the APP2 FPXR segment
- of JPEG images by some digital cameras from manufacturers such as FujiFilm,
- Hewlett-Packard, Kodak and Sanyo.
- ExifTool extracts FlashPix information from both FPX images and the APP2
- FPXR segment of JPEG images. As well, FlashPix information is extracted
- from DOC, PPT, XLS (Microsoft Word, PowerPoint and Excel) documents, VSD
- (Microsoft Visio) drawings, and FLA (Macromedia/Adobe Flash project) files
- since these are based on the same file format as FlashPix (the Windows
- Compound Binary File format). See
- L<http://graphcomp.com/info/specs/livepicture/fpx.pdf> for the FlashPix
- specification.
- },
- "\x05SummaryInformation" => {
- Name => 'SummaryInfo',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::SummaryInfo',
- },
- },
- "\x05DocumentSummaryInformation" => {
- Name => 'DocumentInfo',
- Multi => 1, # flag to process UserDefined information after this
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::DocumentInfo',
- },
- },
- "\x01CompObj" => {
- Name => 'CompObj',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::CompObj',
- DirStart => 0x1c, # skip stream header
- },
- },
- "\x05Image Info" => {
- Name => 'ImageInfo',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::ImageInfo',
- },
- },
- "\x05Image Contents" => {
- Name => 'Image',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::Image',
- },
- },
- "Contents" => {
- Name => 'Contents',
- Notes => 'found in FLA files; may contain XMP',
- SubDirectory => {
- TagTable => 'Image::ExifTool::XMP::Main',
- ProcessProc => \&ProcessContents,
- },
- },
- "ICC Profile 0001" => {
- Name => 'ICC_Profile',
- SubDirectory => {
- TagTable => 'Image::ExifTool::ICC_Profile::Main',
- DirStart => 0x1c, # skip stream header
- },
- },
- "\x05Extension List" => {
- Name => 'Extensions',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::Extensions',
- },
- },
- 'Subimage 0000 Header' => {
- Name => 'SubimageHdr',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::SubimageHdr',
- DirStart => 0x1c, # skip stream header
- },
- },
- # 'Subimage 0000 Data'
- "\x05Data Object" => { # plus instance number (eg. " 000000")
- Name => 'DataObject',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::DataObject',
- },
- },
- # "\x05Data Object Store" => { # plus instance number (eg. " 000000")
- "\x05Transform" => { # plus instance number (eg. " 000000")
- Name => 'Transform',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::Transform',
- },
- },
- "\x05Operation" => { # plus instance number (eg. " 000000")
- Name => 'Operation',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::Operation',
- },
- },
- "\x05Global Info" => {
- Name => 'GlobalInfo',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::GlobalInfo',
- },
- },
- "\x05Screen Nail" => { # plus class ID (eg. "_bd0100609719a180")
- Name => 'ScreenNail',
- Groups => { 2 => 'Other' },
- # strip off stream header
- ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
- },
- "\x05Audio Info" => {
- Name => 'AudioInfo',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::AudioInfo',
- },
- },
- 'Audio Stream' => { # plus instance number (eg. " 000000")
- Name => 'AudioStream',
- Groups => { 2 => 'Audio' },
- # strip off stream header
- ValueConv => 'length($val) > 0x1c and $val = substr($val, 0x1c); \$val',
- },
- 'Current User' => { #PH
- Name => 'CurrentUser',
- # not sure what the rest of this data is, but extract ASCII name from it - PH
- ValueConv => q{
- return undef if length $val < 12;
- my ($size,$pos) = unpack('x4VV', $val);
- my $len = $size - $pos - 4;
- return undef if $len < 0 or length $val < $size + 8;
- return substr($val, 8 + $pos, $len);
- },
- },
- Preview => {
- Name => 'PreviewImage',
- Groups => { 2 => 'Preview' },
- Binary => 1,
- Notes => 'written by some FujiFilm models',
- # skip 47-byte Fuji header
- RawConv => q{
- return undef unless length $val > 47;
- $val = substr($val, 47);
- return $val =~ /^\xff\xd8\xff/ ? $val : undef;
- },
- },
- Property => {
- Name => 'PreviewInfo',
- SubDirectory => {
- TagTable => 'Image::ExifTool::FlashPix::PreviewInfo',
- ByteOrder => 'BigEndian',
- },
- },
- );
- # Summary Information properties
- %Image::ExifTool::FlashPix::SummaryInfo = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Document' },
- NOTES => q{
- The Dictionary, CodePage and LocalIndicator tags are common to all FlashPix
- property tables, even though they are only listed in the SummaryInfo table.
- },
- 0x00 => { Name => 'Dictionary', Groups => { 2 => 'Other' }, Binary => 1 },
- 0x01 => {
- Name => 'CodePage',
- Groups => { 2 => 'Other' },
- PrintConv => \%codePage,
- },
- 0x02 => 'Title',
- 0x03 => 'Subject',
- 0x04 => { Name => 'Author', Groups => { 2 => 'Author' } },
- 0x05 => 'Keywords',
- 0x06 => 'Comments',
- 0x07 => 'Template',
- 0x08 => { Name => 'LastModifiedBy', Groups => { 2 => 'Author' } },
- 0x09 => 'RevisionNumber',
- 0x0a => { Name => 'TotalEditTime', PrintConv => 'ConvertTimeSpan($val)' }, # (in sec)
- 0x0b => { Name => 'LastPrinted', Groups => { 2 => 'Time' } },
- 0x0c => {
- Name => 'CreateDate',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- 0x0d => {
- Name => 'ModifyDate',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- 0x0e => 'Pages',
- 0x0f => 'Words',
- 0x10 => 'Characters',
- 0x11 => {
- Name => 'ThumbnailClip',
- # (not a displayable format, so not in the "Preview" group)
- Binary => 1,
- },
- 0x12 => {
- Name => 'Software',
- RawConv => '$$self{Software} = $val', # (use to determine file type)
- },
- 0x13 => {
- Name => 'Security',
- # see http://msdn.microsoft.com/en-us/library/aa379255(VS.85).aspx
- PrintConv => {
- 0 => 'None',
- 1 => 'Password protected',
- 2 => 'Read-only recommended',
- 4 => 'Read-only enforced',
- 8 => 'Locked for annotations',
- },
- },
- 0x80000000 => { Name => 'LocaleIndicator', Groups => { 2 => 'Other' } },
- );
- # Document Summary Information properties (ref 4)
- %Image::ExifTool::FlashPix::DocumentInfo = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Document' },
- NOTES => q{
- The DocumentSummaryInformation property set includes a UserDefined property
- set for which only the Hyperlinks and HyperlinkBase tags are pre-defined.
- However, ExifTool will also extract any other information found in the
- UserDefined properties.
- },
- 0x02 => 'Category',
- 0x03 => 'PresentationTarget',
- 0x04 => 'Bytes',
- 0x05 => 'Lines',
- 0x06 => 'Paragraphs',
- 0x07 => 'Slides',
- 0x08 => 'Notes',
- 0x09 => 'HiddenSlides',
- 0x0a => 'MMClips',
- 0x0b => {
- Name => 'ScaleCrop',
- PrintConv => { 0 => 'No', 1 => 'Yes' },
- },
- 0x0c => 'HeadingPairs',
- 0x0d => 'TitleOfParts',
- 0x0e => 'Manager',
- 0x0f => 'Company',
- 0x10 => {
- Name => 'LinksUpToDate',
- PrintConv => { 0 => 'No', 1 => 'Yes' },
- },
- 0x11 => 'CharCountWithSpaces',
- # 0x12 ?
- 0x13 => { #PH (unconfirmed)
- Name => 'SharedDoc',
- PrintConv => { 0 => 'No', 1 => 'Yes' },
- },
- # 0x14 ?
- # 0x15 ?
- 0x16 => {
- Name => 'HyperlinksChanged',
- PrintConv => { 0 => 'No', 1 => 'Yes' },
- },
- 0x17 => { #PH (unconfirmed handling of lower 16 bits)
- Name => 'AppVersion',
- ValueConv => 'sprintf("%d.%.4d",$val >> 16, $val & 0xffff)',
- },
- '_PID_LINKBASE' => {
- Name => 'HyperlinkBase',
- ValueConv => '$self->Decode($val, "UCS2","II")',
- },
- '_PID_HLINKS' => {
- Name => 'Hyperlinks',
- RawConv => \&ProcessHyperlinks,
- },
- );
- # Image Information properties
- %Image::ExifTool::FlashPix::ImageInfo = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Image' },
- 0x21000000 => {
- Name => 'FileSource',
- PrintConv => {
- 1 => 'Film Scanner',
- 2 => 'Reflection Print Scanner',
- 3 => 'Digital Camera',
- 4 => 'Video Capture',
- 5 => 'Computer Graphics',
- },
- },
- 0x21000001 => {
- Name => 'SceneType',
- PrintConv => {
- 1 => 'Original Scene',
- 2 => 'Second Generation Scene',
- 3 => 'Digital Scene Generation',
- },
- },
- 0x21000002 => 'CreationPathVector',
- 0x21000003 => 'SoftwareRelease',
- 0x21000004 => 'UserDefinedID',
- 0x21000005 => 'SharpnessApproximation',
- 0x22000000 => { Name => 'Copyright', Groups => { 2 => 'Author' } },
- 0x22000001 => { Name => 'OriginalImageBroker', Groups => { 2 => 'Author' } },
- 0x22000002 => { Name => 'DigitalImageBroker', Groups => { 2 => 'Author' } },
- 0x22000003 => { Name => 'Authorship', Groups => { 2 => 'Author' } },
- 0x22000004 => { Name => 'IntellectualPropertyNotes', Groups => { 2 => 'Author' } },
- 0x23000000 => {
- Name => 'TestTarget',
- PrintConv => {
- 1 => 'Color Chart',
- 2 => 'Gray Card',
- 3 => 'Grayscale',
- 4 => 'Resolution Chart',
- 5 => 'Inch Scale',
- 6 => 'Centimeter Scale',
- 7 => 'Millimeter Scale',
- 8 => 'Micrometer Scale',
- },
- },
- 0x23000002 => 'GroupCaption',
- 0x23000003 => 'CaptionText',
- 0x23000004 => 'People',
- 0x23000007 => 'Things',
- 0x2300000A => {
- Name => 'DateTimeOriginal',
- Description => 'Date/Time Original',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- 0x2300000B => 'Events',
- 0x2300000C => 'Places',
- 0x2300000F => 'ContentDescriptionNotes',
- 0x24000000 => { Name => 'Make', Groups => { 2 => 'Camera' } },
- 0x24000001 => {
- Name => 'Model',
- Description => 'Camera Model Name',
- Groups => { 2 => 'Camera' },
- },
- 0x24000002 => { Name => 'SerialNumber', Groups => { 2 => 'Camera' } },
- 0x25000000 => {
- Name => 'CreateDate',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- 0x25000001 => {
- Name => 'ExposureTime',
- PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
- },
- 0x25000002 => {
- Name => 'FNumber',
- PrintConv => 'sprintf("%.1f",$val)',
- },
- 0x25000003 => {
- Name => 'ExposureProgram',
- Groups => { 2 => 'Camera' },
- # use PrintConv of corresponding EXIF tag
- PrintConv => $Image::ExifTool::Exif::Main{0x8822}->{PrintConv},
- },
- 0x25000004 => 'BrightnessValue',
- 0x25000005 => 'ExposureCompensation',
- 0x25000006 => {
- Name => 'SubjectDistance',
- Groups => { 2 => 'Camera' },
- PrintConv => 'sprintf("%.3f m", $val)',
- },
- 0x25000007 => {
- Name => 'MeteringMode',
- Groups => { 2 => 'Camera' },
- PrintConv => $Image::ExifTool::Exif::Main{0x9207}->{PrintConv},
- },
- 0x25000008 => {
- Name => 'LightSource',
- Groups => { 2 => 'Camera' },
- PrintConv => $Image::ExifTool::Exif::Main{0x9208}->{PrintConv},
- },
- 0x25000009 => {
- Name => 'FocalLength',
- Groups => { 2 => 'Camera' },
- PrintConv => 'sprintf("%.1f mm",$val)',
- },
- 0x2500000A => {
- Name => 'MaxApertureValue',
- Groups => { 2 => 'Camera' },
- ValueConv => '2 ** ($val / 2)',
- PrintConv => 'sprintf("%.1f",$val)',
- },
- 0x2500000B => {
- Name => 'Flash',
- Groups => { 2 => 'Camera' },
- PrintConv => {
- 1 => 'No Flash',
- 2 => 'Flash Fired',
- },
- },
- 0x2500000C => {
- Name => 'FlashEnergy',
- Groups => { 2 => 'Camera' },
- },
- 0x2500000D => {
- Name => 'FlashReturn',
- Groups => { 2 => 'Camera' },
- PrintConv => {
- 1 => 'Subject Outside Flash Range',
- 2 => 'Subject Inside Flash Range',
- },
- },
- 0x2500000E => {
- Name => 'BackLight',
- PrintConv => {
- 1 => 'Front Lit',
- 2 => 'Back Lit 1',
- 3 => 'Back Lit 2',
- },
- },
- 0x2500000F => { Name => 'SubjectLocation', Groups => { 2 => 'Camera' } },
- 0x25000010 => 'ExposureIndex',
- 0x25000011 => {
- Name => 'SpecialEffectsOpticalFilter',
- PrintConv => {
- 1 => 'None',
- 2 => 'Colored',
- 3 => 'Diffusion',
- 4 => 'Multi-image',
- 5 => 'Polarizing',
- 6 => 'Split-field',
- 7 => 'Star',
- },
- },
- 0x25000012 => 'PerPictureNotes',
- 0x26000000 => {
- Name => 'SensingMethod',
- Groups => { 2 => 'Camera' },
- PrintConv => $Image::ExifTool::Exif::Main{0x9217}->{PrintConv},
- },
- 0x26000001 => { Name => 'FocalPlaneXResolution', Groups => { 2 => 'Camera' } },
- 0x26000002 => { Name => 'FocalPlaneYResolution', Groups => { 2 => 'Camera' } },
- 0x26000003 => {
- Name => 'FocalPlaneResolutionUnit',
- Groups => { 2 => 'Camera' },
- PrintConv => $Image::ExifTool::Exif::Main{0xa210}->{PrintConv},
- },
- 0x26000004 => 'SpatialFrequencyResponse',
- 0x26000005 => 'CFAPattern',
- 0x27000001 => {
- Name => 'FilmCategory',
- PrintConv => {
- 1 => 'Negative B&W',
- 2 => 'Negative Color',
- 3 => 'Reversal B&W',
- 4 => 'Reversal Color',
- 5 => 'Chromagenic',
- 6 => 'Internegative B&W',
- 7 => 'Internegative Color',
- },
- },
- 0x26000007 => 'ISO',
- 0x26000008 => 'Opto-ElectricConvFactor',
- 0x27000000 => 'FilmBrand',
- 0x27000001 => 'FilmCategory',
- 0x27000002 => 'FilmSize',
- 0x27000003 => 'FilmRollNumber',
- 0x27000004 => 'FilmFrameNumber',
- 0x29000000 => 'OriginalScannedImageSize',
- 0x29000001 => 'OriginalDocumentSize',
- 0x29000002 => {
- Name => 'OriginalMedium',
- PrintConv => {
- 1 => 'Continuous Tone Image',
- 2 => 'Halftone Image',
- 3 => 'Line Art',
- },
- },
- 0x29000003 => {
- Name => 'TypeOfOriginal',
- PrintConv => {
- 1 => 'B&W Print',
- 2 => 'Color Print',
- 3 => 'B&W Document',
- 4 => 'Color Document',
- },
- },
- 0x28000000 => 'ScannerMake',
- 0x28000001 => 'ScannerModel',
- 0x28000002 => 'ScannerSerialNumber',
- 0x28000003 => 'ScanSoftware',
- 0x28000004 => { Name => 'ScanSoftwareRevisionDate', Groups => { 2 => 'Time' } },
- 0x28000005 => 'ServiceOrganizationName',
- 0x28000006 => 'ScanOperatorID',
- 0x28000008 => {
- Name => 'ScanDate',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- 0x28000009 => {
- Name => 'ModifyDate',
- Groups => { 2 => 'Time' },
- PrintConv => '$self->ConvertDateTime($val)',
- },
- 0x2800000A => 'ScannerPixelSize',
- );
- # Image Contents properties
- %Image::ExifTool::FlashPix::Image = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Image' },
- # VARS storage is used as a hash lookup for tagID's which aren't constant.
- # The key is a mask for significant bits of the tagID, and the value
- # is a lookup for tagID's for which this mask is valid.
- VARS => {
- # ID's are different for each subimage
- 0xff00ffff => {
- 0x02000000=>1, 0x02000001=>1, 0x02000002=>1, 0x02000003=>1,
- 0x02000004=>1, 0x02000005=>1, 0x02000006=>1, 0x02000007=>1,
- 0x03000001=>1,
- },
- },
- 0x01000000 => 'NumberOfResolutions',
- 0x01000002 => 'ImageWidth', # width of highest resolution image
- 0x01000003 => 'ImageHeight',
- 0x01000004 => 'DefaultDisplayHeight',
- 0x01000005 => 'DefaultDisplayWidth',
- 0x01000006 => {
- Name => 'DisplayUnits',
- PrintConv => {
- 0 => 'inches',
- 1 => 'meters',
- 2 => 'cm',
- 3 => 'mm',
- },
- },
- 0x02000000 => 'SubimageWidth',
- 0x02000001 => 'SubimageHeight',
- 0x02000002 => {
- Name => 'SubimageColor',
- # decode only component count and color space of first component
- ValueConv => 'sprintf("%.2x %.4x", unpack("x4vx4v",$val))',
- PrintConv => {
- '01 0000' => 'Opacity Only',
- '01 8000' => 'Opacity Only (uncalibrated)',
- '01 0001' => 'Monochrome',
- '01 8001' => 'Monochrome (uncalibrated)',
- '03 0002' => 'YCbCr',
- '03 8002' => 'YCbCr (uncalibrated)',
- '03 0003' => 'RGB',
- '03 8003' => 'RGB (uncalibrated)',
- '04 0002' => 'YCbCr with Opacity',
- '04 8002' => 'YCbCr with Opacity (uncalibrated)',
- '04 0003' => 'RGB with Opacity',
- '04 8003' => 'RGB with Opacity (uncalibrated)',
- },
- },
- 0x02000003 => {
- Name => 'SubimageNumericalFormat',
- PrintConv => {
- 17 => '8-bit, Unsigned',
- 18 => '16-bit, Unsigned',
- 19 => '32-bit, Unsigned',
- },
- },
- 0x02000004 => {
- Name => 'DecimationMethod',
- PrintConv => {
- 0 => 'None (Full-sized Image)',
- 8 => '8-point Prefilter',
- },
- },
- 0x02000005 => 'DecimationPrefilterWidth',
- 0x02000007 => 'SubimageICC_Profile',
- 0x03000001 => { Name => 'JPEGTables', Binary => 1 },
- 0x03000002 => 'MaxJPEGTableIndex',
- );
- # Extension List properties
- %Image::ExifTool::FlashPix::Extensions = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Other' },
- VARS => {
- # ID's are different for each extension type
- 0x0000ffff => {
- 0x0001=>1, 0x0002=>1, 0x0003=>1, 0x0004=>1,
- 0x0005=>1, 0x0006=>1, 0x0007=>1, 0x1000=>1,
- 0x2000=>1, 0x2001=>1, 0x3000=>1, 0x4000=>1,
- },
- 0x0000f00f => { 0x3001=>1, 0x3002=>1 },
- },
- 0x10000000 => 'UsedExtensionNumbers',
- 0x0001 => 'ExtensionName',
- 0x0002 => 'ExtensionClassID',
- 0x0003 => {
- Name => 'ExtensionPersistence',
- PrintConv => {
- 0 => 'Always Valid',
- 1 => 'Invalidated By Modification',
- 2 => 'Potentially Invalidated By Modification',
- },
- },
- 0x0004 => { Name => 'ExtensionCreateDate', Groups => { 2 => 'Time' } },
- 0x0005 => { Name => 'ExtensionModifyDate', Groups => { 2 => 'Time' } },
- 0x0006 => 'CreatingApplication',
- 0x0007 => 'ExtensionDescription',
- 0x1000 => 'Storage-StreamPathname',
- 0x2000 => 'FlashPixStreamPathname',
- 0x2001 => 'FlashPixStreamFieldOffset',
- 0x3000 => 'PropertySetPathname',
- 0x3001 => 'PropertySetIDCodes',
- 0x3002 => 'PropertyVectorElements',
- 0x4000 => 'SubimageResolutions',
- );
- # Subimage Header tags
- %Image::ExifTool::FlashPix::SubimageHdr = (
- PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
- FORMAT => 'int32u',
- # 0 => 'HeaderLength',
- 1 => 'SubimageWidth',
- 2 => 'SubimageHeight',
- 3 => 'SubimageTileCount',
- 4 => 'SubimageTileWidth',
- 5 => 'SubimageTileHeight',
- 6 => 'NumChannels',
- # 7 => 'TileHeaderOffset',
- # 8 => 'TileHeaderLength',
- # ... followed by tile header table
- );
- # Data Object properties
- %Image::ExifTool::FlashPix::DataObject = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Other' },
- 0x00010000 => 'DataObjectID',
- 0x00010002 => 'LockedPropertyList',
- 0x00010003 => 'DataObjectTitle',
- 0x00010004 => 'LastModifier',
- 0x00010005 => 'RevisionNumber',
- 0x00010006 => { Name => 'DataCreateDate', Groups => { 2 => 'Time' } },
- 0x00010007 => { Name => 'DataModifyDate', Groups => { 2 => 'Time' } },
- 0x00010008 => 'CreatingApplication',
- 0x00010100 => {
- Name => 'DataObjectStatus',
- PrintConv => q{
- ($val & 0x0000ffff ? 'Exists' : 'Does Not Exist') .
- ', ' . ($val & 0xffff0000 ? 'Not ' : '') . 'Purgeable'
- },
- },
- 0x00010101 => {
- Name => 'CreatingTransform',
- PrintConv => '$val ? $val : "Source Image"',
- },
- 0x00010102 => 'UsingTransforms',
- 0x10000000 => 'CachedImageHeight',
- 0x10000001 => 'CachedImageWidth',
- );
- # Transform properties
- %Image::ExifTool::FlashPix::Transform = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Other' },
- 0x00010000 => 'TransformNodeID',
- 0x00010001 => 'OperationClassID',
- 0x00010002 => 'LockedPropertyList',
- 0x00010003 => 'TransformTitle',
- 0x00010004 => 'LastModifier',
- 0x00010005 => 'RevisionNumber',
- 0x00010006 => { Name => 'TransformCreateDate', Groups => { 2 => 'Time' } },
- 0x00010007 => { Name => 'TransformModifyDate', Groups => { 2 => 'Time' } },
- 0x00010008 => 'CreatingApplication',
- 0x00010100 => 'InputDataObjectList',
- 0x00010101 => 'OutputDataObjectList',
- 0x00010102 => 'OperationNumber',
- 0x10000000 => 'ResultAspectRatio',
- 0x10000001 => 'RectangleOfInterest',
- 0x10000002 => 'Filtering',
- 0x10000003 => 'SpatialOrientation',
- 0x10000004 => 'ColorTwistMatrix',
- 0x10000005 => 'ContrastAdjustment',
- );
- # Operation properties
- %Image::ExifTool::FlashPix::Operation = (
- PROCESS_PROC => \&ProcessProperties,
- 0x00010000 => 'OperationID',
- );
- # Global Info properties
- %Image::ExifTool::FlashPix::GlobalInfo = (
- PROCESS_PROC => \&ProcessProperties,
- 0x00010002 => 'LockedPropertyList',
- 0x00010003 => 'TransformedImageTitle',
- 0x00010004 => 'LastModifier',
- 0x00010100 => 'VisibleOutputs',
- 0x00010101 => 'MaximumImageIndex',
- 0x00010102 => 'MaximumTransformIndex',
- 0x00010103 => 'MaximumOperationIndex',
- );
- # Audio Info properties
- %Image::ExifTool::FlashPix::AudioInfo = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Audio' },
- );
- # MacroMedia flash contents
- %Image::ExifTool::FlashPix::Contents = (
- PROCESS_PROC => \&ProcessProperties,
- GROUPS => { 2 => 'Image' },
- );
- # CompObj tags
- %Image::ExifTool::FlashPix::CompObj = (
- PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
- GROUPS => { 2 => 'Other' },
- FORMAT => 'int32u',
- 0 => { Name => 'CompObjUserTypeLen' },
- 1 => {
- Name => 'CompObjUserType',
- Format => 'string[$val{0}]',
- RawConv => '$$self{CompObjUserType} = $val', # (use to determine file type)
- },
- );
- # FujiFilm "Property" information (ref PH)
- %Image::ExifTool::FlashPix::PreviewInfo = (
- PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
- GROUPS => { 2 => 'Image' },
- NOTES => 'Preview information written by some FujiFilm models.',
- FIRST_ENTRY => 0,
- # values are all constant for for my samples except the two decoded tags
- # 0x0000: 01 01 00 00 02 01 00 00 00 00 00 00 00 xx xx 01
- # 0x0010: 01 00 00 00 00 00 00 xx xx 00 00 00 00 00 00 00
- # 0x0020: 00 00 00 00 00
- 0x0d => {
- Name => 'PreviewImageWidth',
- Format => 'int16u',
- },
- 0x17 => {
- Name => 'PreviewImageHeight',
- Format => 'int16u',
- },
- );
- # composite FlashPix tags
- %Image::ExifTool::FlashPix::Composite = (
- GROUPS => { 2 => 'Image' },
- PreviewImage => {
- Groups => { 2 => 'Preview' },
- # extract JPEG preview from ScreenNail if possible
- Require => {
- 0 => 'ScreenNail',
- },
- Binary => 1,
- RawConv => q{
- return undef unless $val[0] =~ /\xff\xd8\xff/g;
- return substr($val[0], pos($val[0])-3);
- },
- },
- );
- # add our composite tags
- Image::ExifTool::AddCompositeTags('Image::ExifTool::FlashPix');
- #------------------------------------------------------------------------------
- # Process hyperlinks from PID_HYPERLINKS array
- # (ref http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnaro97ta/html/msdn_hyper97.asp)
- # Inputs: 0) value, 1) ExifTool ref
- # Returns: list of hyperlinks
- sub ProcessHyperlinks($$)
- {
- my ($val, $et) = @_;
- # process as an array of VT_VARIANT's
- my $dirEnd = length $val;
- return undef if $dirEnd < 4;
- my $num = Get32u(\$val, 0);
- my $valPos = 4;
- my ($i, @vals);
- for ($i=0; $i<$num; ++$i) {
- # read VT_BLOB entries as an array of VT_VARIANT's
- my $value = ReadFPXValue($et, \$val, $valPos, VT_VARIANT, $dirEnd);
- last unless defined $value;
- push @vals, $value;
- }
- # filter values to extract only the links
- my @links;
- for ($i=0; $i<@vals; $i+=6) {
- push @links, $vals[$i+4]; # get address
- $links[-1] .= '#' . $vals[$i+5] if length $vals[$i+5]; # add subaddress
- }
- return \@links;
- }
- #------------------------------------------------------------------------------
- # Read FlashPix value
- # Inputs: 0) ExifTool ref, 1) data ref, 2) value offset, 3) FPX format number,
- # 4) end offset, 5) flag for no padding, 6) code page
- # Returns: converted value (or list of values in list context) and updates
- # value offset to end of value if successful, or returns undef on error
- sub ReadFPXValue($$$$$;$$)
- {
- my ($et, $dataPt, $valPos, $type, $dirEnd, $noPad, $codePage) = @_;
- my @vals;
- my $format = $oleFormat{$type & 0x0fff};
- while ($format) {
- my $count = 1;
- # handle VT_VECTOR types
- my $flags = $type & 0xf000;
- if ($flags) {
- if ($flags == VT_VECTOR) {
- $noPad = 1; # values don't seem to be padded inside vectors
- my $size = $oleFormatSize{VT_VECTOR};
- last if $valPos + $size > $dirEnd;
- $count = Get32u($dataPt, $valPos);
- push @vals, '' if $count == 0; # allow zero-element vector
- $valPos += 4;
- } else {
- # can't yet handle this property flag
- last;
- }
- }
- unless ($format =~ /^VT_/) {
- my $size = Image::ExifTool::FormatSize($format) * $count;
- last if $valPos + $size > $dirEnd;
- @vals = ReadValue($dataPt, $valPos, $format, $count, $size);
- # update position to end of value plus padding
- $valPos += ($count * $size + 3) & 0xfffffffc;
- last;
- }
- my $size = $oleFormatSize{$format};
- my ($item, $val);
- for ($item=0; $item<$count; ++$item) {
- last if $valPos + $size > $dirEnd;
- if ($format eq 'VT_VARIANT') {
- my $subType = Get32u($dataPt, $valPos);
- $valPos += $size;
- $val = ReadFPXValue($et, $dataPt, $valPos, $subType, $dirEnd, $noPad, $codePage);
- last unless defined $val;
- push @vals, $val;
- next; # avoid adding $size to $valPos again
- } elsif ($format eq 'VT_FILETIME') {
- # convert from time in 100 ns increments to time in seconds
- $val = 1e-7 * Image::ExifTool::Get64u($dataPt, $valPos);
- # print as date/time if value is greater than one year (PH hack)
- my $secDay = 24 * 3600;
- if ($val > 365 * $secDay) {
- # shift from Jan 1, 1601 to Jan 1, 1970
- my $unixTimeZero = 134774 * $secDay;
- $val -= $unixTimeZero;
- # there are a lot of bad programmers out there...
- my $sec100yr = 100 * 365 * $secDay;
- if ($val < 0 || $val > $sec100yr) {
- # some software writes the wrong byte order (but the proper word order)
- my @w = unpack("x${valPos}NN", $$dataPt);
- my $v2 = ($w[0] + $w[1] * 4294967296) * 1e-7 - $unixTimeZero;
- if ($v2 > 0 && $v2 < $sec100yr) {
- $val = $v2;
- # also check for wrong time base
- } elsif ($val < 0 && $val + $unixTimeZero > 0) {
- $val += $unixTimeZero;
- }
- }
- $val = Image::ExifTool::ConvertUnixTime($val);
- }
- } elsif ($format eq 'VT_DATE') {
- $val = Image::ExifTool::GetDouble($dataPt, $valPos);
- # shift zero from Dec 30, 1899 to Jan 1, 1970 and convert to secs
- $val = ($val - 25569) * 24 * 3600 if $val != 0;
- $val = Image::ExifTool::ConvertUnixTime($val);
- } elsif ($format =~ /STR$/) {
- my $len = Get32u($dataPt, $valPos);
- $len *= 2 if $format eq 'VT_LPWSTR'; # convert to byte count
- last if $valPos + $len + 4 > $dirEnd;
- $val = substr($$dataPt, $valPos + 4, $len);
- if ($format eq 'VT_LPWSTR') {
- # convert wide string from Unicode
- $val = $et->Decode($val, 'UCS2');
- } elsif ($codePage) {
- my $charset = $Image::ExifTool::charsetName{"cp$codePage"};
- if ($charset) {
- $val = $et->Decode($val, $charset);
- } elsif ($codePage eq 1200) { # UTF-16, little endian
- $val = $et->Decode(undef, 'UCS2', 'II');
- }
- }
- $val =~ s/\0.*//s; # truncate at null terminator
- # update position for string length
- # (the spec states that strings should be padded to align
- # on even 32-bit boundaries, but this isn't always the case)
- $valPos += $noPad ? $len : ($len + 3) & 0xfffffffc;
- } elsif ($format eq 'VT_BLOB' or $format eq 'VT_CF') {
- my $len = Get32u($dataPt, $valPos);
- last if $valPos + $len + 4 > $dirEnd;
- $val = substr($$dataPt, $valPos + 4, $len);
- # update position for data length plus padding
- # (does this padding disappear in arrays too?)
- $valPos += ($len + 3) & 0xfffffffc;
- } elsif ($format eq 'VT_CLSID') {
- $val = Image::ExifTool::ASF::GetGUID(substr($$dataPt, $valPos, $size));
- }
- $valPos += $size; # update value pointer to end of value
- push @vals, $val;
- }
- # join VT_ values with commas unless we want an array
- @vals = ( join $et->Options('ListSep'), @vals ) if @vals > 1 and not wantarray;
- last; # didn't really want to loop
- }
- $_[2] = $valPos; # return updated value position
- if (wantarray) {
- return @vals;
- } elsif (@vals > 1) {
- return join(' ', @vals);
- } else {
- return $vals[0];
- }
- }
- #------------------------------------------------------------------------------
- # Scan for XMP in FLA Contents (ref PH)
- # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
- # Returns: 1 on success
- # Notes: FLA format is proprietary and I couldn't find any documentation,
- # so this routine is entirely based on observations from sample files
- sub ProcessContents($$$)
- {
- my ($et, $dirInfo, $tagTablePtr) = @_;
- my $dataPt = $$dirInfo{DataPt};
- my $isFLA;
- # all of my FLA samples contain "Contents" data, an no other FPX-like samples have
- # this, but check the data for a familiar pattern to be sure this is FLA: the
- # Contents of all of my FLA samples start with two bytes (0x29,0x38,0x3f,0x43 or 0x47,
- # then 0x01) followed by a number of zero bytes (from 0x18 to 0x26 of them, related
- # somehow to the value of the first byte), followed by the string "DocumentPage"
- $isFLA = 1 if $$dataPt =~ /^..\0+\xff\xff\x01\0\x0d\0CDocumentPage/s;
- # do a brute-force scan of the "Contents" for UTF-16 XMP
- # (this may always be little-endian, but allow for either endianness)
- if ($$dataPt =~ /<\0\?\0x\0p\0a\0c\0k\0e\0t\0 \0b\0e\0g\0i\0n\0=\0['"](\0\xff\xfe|\xfe\xff)/g) {
- $$dirInfo{DirStart} = pos($$dataPt) - 36;
- if ($$dataPt =~ /<\0\?\0x\0p\0a\0c\0k\0e\0t\0 \0e\0n\0d\0=\0['"]\0[wr]\0['"]\0\?\0>\0?/g) {
- $$dirInfo{DirLen} = pos($$dataPt) - $$dirInfo{DirStart};
- Image::ExifTool::XMP::ProcessXMP($et, $dirInfo, $tagTablePtr);
- # override format if not already FLA but XMP-dc:Format indicates it is
- $isFLA = 1 if $$et{FILE_TYPE} ne 'FLA' and $$et{VALUE}{Format} and
- $$et{VALUE}{Format} eq 'application/vnd.adobe.fla';
- }
- }
- $et->OverrideFileType('FLA') if $isFLA;
- return 1;
- }
- #------------------------------------------------------------------------------
- # Check FPX byte order mark (BOM) and set byte order appropriately
- # Inputs: 0) data ref, 1) offset to BOM
- # Returns: true on success
- sub CheckBOM($$)
- {
- my ($dataPt, $pos) = @_;
- my $bom = Get16u($dataPt, $pos);
- return 1 if $bom == 0xfffe;
- return 0 unless $bom == 0xfeff;
- ToggleByteOrder();
- return 1;
- }
- #------------------------------------------------------------------------------
- # Process FlashPix properties
- # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
- # Returns: 1 on success
- sub ProcessProperties($$$)
- {
- my ($et, $dirInfo, $tagTablePtr) = @_;
- my $dataPt = $$dirInfo{DataPt};
- my $pos = $$dirInfo{DirStart} || 0;
- my $dirLen = $$dirInfo{DirLen} || length($$dataPt) - $pos;
- my $dirEnd = $pos + $dirLen;
- my $verbose = $et->Options('Verbose');
- my $n;
- if ($dirLen < 48) {
- $et->Warn('Truncated FPX properties');
- return 0;
- }
- # check and set our byte order if necessary
- unless (CheckBOM($dataPt, $pos)) {
- $et->Warn('Bad FPX property byte order mark');
- return 0;
- }
- # get position of start of section
- $pos = Get32u($dataPt, $pos + 44);
- if ($pos < 48) {
- $et->Warn('Bad FPX property section offset');
- return 0;
- }
- for ($n=0; $n<2; ++$n) {
- my %dictionary; # dictionary to translate user-defined properties
- my $codePage;
- last if $pos + 8 > $dirEnd;
- # read property section header
- my $size = Get32u($dataPt, $pos);
- last unless $size;
- my $numEntries = Get32u($dataPt, $pos + 4);
- $verbose and $et->VerboseDir('Property Info', $numEntries, $size);
- if ($pos + 8 + 8 * $numEntries > $dirEnd) {
- $et->Warn('Truncated property list');
- last;
- }
- my $index;
- for ($index=0; $index<$numEntries; ++$index) {
- my $entry = $pos + 8 + 8 * $index;
- my $tag = Get32u($dataPt, $entry);
- my $offset = Get32u($dataPt, $entry + 4);
- my $valStart = $pos + 4 + $offset;
- last if $valStart >= $dirEnd;
- my $valPos = $valStart;
- my $type = Get32u($dataPt, $pos + $offset);
- if ($tag == 0) {
- # read dictionary to get tag name lookup for this property set
- my $i;
- for ($i=0; $i<$type; ++$i) {
- last if $valPos + 8 > $dirEnd;
- $tag = Get32u($dataPt, $valPos);
- my $len = Get32u($dataPt, $valPos + 4);
- $valPos += 8 + $len;
- last if $valPos > $dirEnd;
- my $name = substr($$dataPt, $valPos - $len, $len);
- $name =~ s/\0.*//s;
- next unless length $name;
- $dictionary{$tag} = $name;
- next if $$tagTablePtr{$name};
- $tag = $name;
- $name =~ s/(^| )([a-z])/\U$2/g; # start with uppercase
- $name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters
- next unless length $name;
- $et->VPrint(0, "$$et{INDENT}\[adding $name]\n") if $verbose;
- AddTagToTable($tagTablePtr, $tag, { Name => $name });
- }
- next;
- }
- # use tag name from dictionary if available
- my ($custom, $val);
- if (defined $dictionary{$tag}) {
- $tag = $dictionary{$tag};
- $custom = 1;
- }
- my @vals = ReadFPXValue($et, $dataPt, $valPos, $type, $dirEnd, undef, $codePage);
- @vals or $et->Warn('Error reading property value');
- $val = @vals > 1 ? \@vals : $vals[0];
- my $format = $type & 0x0fff;
- my $flags = $type & 0xf000;
- my $formStr = $oleFormat{$format} || "Type $format";
- $formStr .= '|' . ($oleFlags{$flags} || sprintf("0x%x",$flags)) if $flags;
- my $tagInfo;
- # check for common tag ID's: Dictionary, CodePage and LocaleIndicator
- # (must be done before masking because masked tags may overlap these ID's)
- if (not $custom and ($tag == 1 or $tag == 0x80000000)) {
- # get tagInfo from SummaryInfo table
- my $summaryTable = GetTagTable('Image::ExifTool::FlashPix::SummaryInfo');
- $tagInfo = $et->GetTagInfo($summaryTable, $tag);
- if ($tag == 1) {
- $val += 0x10000 if $val < 0; # (may be incorrectly stored as int16s)
- $codePage = $val; # save code page for translating values
- }
- } elsif ($$tagTablePtr{$tag}) {
- $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
- } elsif ($$tagTablePtr{VARS} and not $custom) {
- # mask off insignificant bits of tag ID if necessary
- my $masked = $$tagTablePtr{VARS};
- my $mask;
- foreach $mask (keys %$masked) {
- if ($masked->{$mask}->{$tag & $mask}) {
- $tagInfo = $et->GetTagInfo($tagTablePtr, $tag & $mask);
- last;
- }
- }
- }
- $et->HandleTag($tagTablePtr, $tag, $val,
- DataPt => $dataPt,
- Start => $valStart,
- Size => $valPos - $valStart,
- Format => $formStr,
- Index => $index,
- TagInfo => $tagInfo,
- Extra => ", type=$type",
- );
- }
- # issue warning if we hit end of property section prematurely
- $et->Warn('Truncated property data') if $index < $numEntries;
- last unless $$dirInfo{Multi};
- $pos += $size;
- }
- return 1;
- }
- #------------------------------------------------------------------------------
- # Load chain of sectors from file
- # Inputs: 0) RAF ref, 1) first sector number, 2) FAT ref, 3) sector size, 4) header size
- sub LoadChain($$$$$)
- {
- my ($raf, $sect, $fatPt, $sectSize, $hdrSize) = @_;
- return undef unless $raf;
- my $chain = '';
- my ($buff, %loadedSect);
- for (;;) {
- last if $sect >= END_OF_CHAIN;
- return undef if $loadedSect{$sect}; # avoid infinite loop
- $loadedSect{$sect} = 1;
- my $offset = $sect * $sectSize + $hdrSize;
- return undef unless ($offset <= 0x7fffffff or $$raf{LargeFileSupport}) and
- $raf->Seek($offset, 0) and
- $raf->Read($buff, $sectSize) == $sectSize;
- $chain .= $buff;
- # step to next sector in chain
- return undef if $sect * 4 > length($$fatPt) - 4;
- $sect = Get32u($fatPt, $sect * 4);
- }
- return $chain;
- }
- #------------------------------------------------------------------------------
- # Extract information from a JPEG APP2 FPXR segment
- # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
- # Returns: 1 on success
- sub ProcessFPXR($$$)
- {
- my ($et, $dirInfo, $tagTablePtr) = @_;
- my $dataPt = $$dirInfo{DataPt};
- my $dirStart = $$dirInfo{DirStart};
- my $dirLen = $$dirInfo{DirLen};
- my $verbose = $et->Options('Verbose');
- if ($dirLen < 13) {
- $et->Warn('FPXR segment too small');
- return 0;
- }
- # get version and segment type (version is 0 in all my samples)
- my ($vers, $type) = unpack('x5C2', $$dataPt);
- if ($type == 1) { # a "Contents List" segment
- $vers != 0 and $et->Warn("Untested FPXR version $vers");
- if ($$et{FPXR}) {
- $et->Warn('Multiple FPXR contents lists');
- delete $$et{FPXR};
- }
- my $numEntries = unpack('x7n', $$dataPt);
- my @contents;
- $verbose and $et->VerboseDir('Contents List', $numEntries);
- my $pos = 9;
- my $entry;
- for ($entry = 0; $entry < $numEntries; ++$entry) {
- if ($pos + 4 > $dirLen) {
- $et->Warn('Truncated FPXR contents');
- return 0;
- }
- my ($size, $default) = unpack("x${pos}Na", $$dataPt);
- pos($$dataPt) = $pos + 5;
- # according to the spec, this string is little-endian
- # (very odd, since the size word is big-endian),
- # and the first char must be '/'
- unless ($$dataPt =~ m{\G(/\0(..)*?)\0\0}sg) {
- $et->Warn('Invalid FPXR stream name');
- return 0;
- }
- # convert stream pathname to ascii
- my $name = Image::ExifTool::Decode(undef, $1, 'UCS2', 'II', 'Latin');
- if ($verbose) {
- my $psize = ($size == 0xffffffff) ? 'storage' : "$size bytes";
- $et->VPrint(0," | $entry) Name: '$name' [$psize]\n");
- }
- # remove directory specification
- $name =~ s{.*/}{}s;
- # read storage class ID if necessary
- my $classID;
- if ($size == 0xffffffff) {
- unless ($$dataPt =~ m{(.{16})}sg) {
- $et->Warn('Truncated FPXR storage class ID');
- return 0;
- }
- # unpack class ID in case we want to use it sometime
- $classID = Image::ExifTool::ASF::GetGUID($1);
- }
- # find the tagInfo if available
- my $tagInfo;
- unless ($$tagTablePtr{$name}) {
- # remove instance number or class ID from tag if necessary
- $tagInfo = $et->GetTagInfo($tagTablePtr, $1) if
- ($name =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
- ($name =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
- }
- # update position in list
- $pos = pos($$dataPt);
- # add to our contents list
- push @contents, {
- Name => $name,
- Size => $size,
- Default => $default,
- ClassID => $classID,
- TagInfo => $tagInfo,
- };
- }
- # save contents list as $et member variable
- # (must do this last so we don't save list on error)
- $$et{FPXR} = \@contents;
- } elsif ($type == 2) { # a "Stream Data" segment
- # get the contents list index and stream data offset
- my ($index, $offset) = unpack('x7nN', $$dataPt);
- my $fpxr = $$et{FPXR};
- if ($fpxr and $$fpxr[$index]) {
- my $obj = $$fpxr[$index];
- # extract stream data (after 13-byte header)
- if (not defined $$obj{Stream}) {
- # ignore offset for first segment of this type
- # (in my sample images, this isn't always zero as one would expect)
- $$obj{Stream} = substr($$dataPt, $dirStart+13);
- } else {
- # add data at the proper offset to the stream
- my $overlap = length($$obj{Stream}) - $offset;
- my $start = $dirStart + 13;
- if ($overlap < 0 or $dirLen - $overlap < 13) {
- $et->WarnOnce("Bad FPXR stream $index offset",1);
- } else {
- # ignore any overlapping data in this segment
- # (this seems to be the convention)
- $start += $overlap;
- }
- # concatenate data with this stream
- $$obj{Stream} .= substr($$dataPt, $start);
- }
- # save value for this tag if stream is complete
- my $len = length $$obj{Stream};
- if ($len >= $$obj{Size}) {
- $et->VPrint(0, " + [FPXR stream $index, $len bytes]\n") if $verbose;
- if ($len > $$obj{Size}) {
- $et->Warn('Extra data in FPXR segment (truncated)');
- $$obj{Stream} = substr($$obj{Stream}, 0, $$obj{Size});
- }
- # handle this tag
- $et->HandleTag($tagTablePtr, $$obj{Name}, $$obj{Stream},
- DataPt => \$$obj{Stream},
- TagInfo => $$obj{TagInfo},
- );
- delete $$obj{Stream}; # done with this stream
- }
- # hack for improperly stored FujiFilm PreviewImage (stored with no contents list)
- } elsif ($index == 512 and $dirLen > 60 and ($$et{FujiPreview} or
- ($dirLen > 64 and substr($$dataPt, $dirStart+60, 4) eq "\xff\xd8\xff\xdb")))
- {
- $$et{FujiPreview} = '' unless defined $$et{FujiPreview};
- # recombine PreviewImage, skipping 13-byte FPXR header + 47-byte Fuji header
- $$et{FujiPreview} .= substr($$dataPt, $dirStart+60);
- } else {
- # (Kodak uses index 255 for a free segment in images from some cameras)
- $et->Warn("Unlisted FPXR segment (index $index)") if $index != 255;
- }
- } elsif ($type ne 3) { # not a "Reserved" segment
- $et->Warn("Unknown FPXR segment (type $type)");
- }
- # clean up if this was the last FPXR segment
- if ($$dirInfo{LastFPXR}) {
- if ($$et{FPXR}) {
- my $obj;
- foreach $obj (@{$$et{FPXR}}) {
- next unless defined $$obj{Stream} and length $$obj{Stream};
- # parse it even though it isn't the proper length
- $et->HandleTag($tagTablePtr, $$obj{Name}, $$obj{Stream},
- DataPt => \$$obj{Stream},
- TagInfo => $$obj{TagInfo},
- );
- }
- delete $$et{FPXR}; # delete our temporary variables
- }
- if ($$et{FujiPreview}) {
- $et->FoundTag('PreviewImage', $$et{FujiPreview});
- delete $$et{FujiPreview};
- }
- }
- return 1;
- }
- #------------------------------------------------------------------------------
- # Set document number for objects
- # Inputs: 0) object hierarchy hash ref, 1) object index, 2) doc number list ref,
- # 3) doc numbers used at each level, 4) flag set for metadata levels
- sub SetDocNum($$;$$$)
- {
- my ($hier, $index, $doc, $used, $meta) = @_;
- my $obj = $$hier{$index} or return;
- return if exists $$obj{DocNum};
- $$obj{DocNum} = $doc;
- SetDocNum($hier, $$obj{Left}, $doc, $used, $meta) if $$obj{Left};
- SetDocNum($hier, $$obj{Right}, $doc, $used, $meta) if $$obj{Right};
- if (defined $$obj{Child}) {
- $used or $used = [ ];
- my @subDoc;
- push @subDoc, @$doc if $doc;
- # we must dive down 2 levels for each sub-document, so use the
- # $meta flag to add a sub-document level only for every 2nd generation
- if ($meta) {
- my $subNum = ($$used[scalar @subDoc] || 0);
- $$used[scalar @subDoc] = $subNum;
- push @subDoc, $subNum;
- } elsif (@subDoc) {
- $subDoc[-1] = ++$$used[$#subDoc];
- }
- SetDocNum($hier, $$obj{Child}, \@subDoc, $used, not $meta);
- }
- }
- #------------------------------------------------------------------------------
- # Extract information from a FlashPix (FPX) file
- # Inputs: 0) ExifTool object ref, 1) dirInfo ref
- # Returns: 1 on success, 0 if this wasn't a valid FPX-format file
- sub ProcessFPX($$)
- {
- my ($et, $dirInfo) = @_;
- my $raf = $$dirInfo{RAF};
- my ($buff, $out, %dumpParms, $oldIndent, $miniStreamBuff);
- my ($tag, %hier, %objIndex);
- # read header
- return 0 unless $raf->Read($buff,HDR_SIZE) == HDR_SIZE;
- # check signature
- return 0 unless $buff =~ /^\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1/;
- # set FileType initially based on file extension (we may override this later)
- my $fileType = $$et{FILE_EXT};
- $fileType = 'FPX' unless $fileType and $fpxFileType{$fileType};
- $et->SetFileType($fileType);
- SetByteOrder(substr($buff, 0x1c, 2) eq "\xff\xfe" ? 'MM' : 'II');
- my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
- my $verbose = $et->Options('Verbose');
- # copy LargeFileSupport option to RAF for use in LoadChain
- $$raf{LargeFileSupport} = $et->Options('LargeFileSupport');
- my $sectSize = 1 << Get16u(\$buff, 0x1e);
- my $miniSize = 1 << Get16u(\$buff, 0x20);
- my $fatCount = Get32u(\$buff, 0x2c); # number of FAT sectors
- my $dirStart = Get32u(\$buff, 0x30); # first directory sector
- my $miniCutoff = Get32u(\$buff, 0x38); # minimum size for big-FAT streams
- my $miniStart = Get32u(\$buff, 0x3c); # first sector of mini-FAT
- my $miniCount = Get32u(\$buff, 0x40); # number of mini-FAT sectors
- my $difStart = Get32u(\$buff, 0x44); # first sector of DIF chain
- my $difCount = Get32u(\$buff, 0x48); # number of DIF sectors
- if ($verbose) {
- $out = $et->Options('TextOut');
- $dumpParms{Out} = $out;
- $dumpParms{MaxLen} = 96 if $verbose == 3;
- print $out " Sector size=$sectSize\n FAT: Count=$fatCount\n";
- print $out " DIR: Start=$dirStart\n";
- print $out " MiniFAT: Mini-sector size=$miniSize Start=$miniStart Count=$miniCount Cutoff=$miniCutoff\n";
- print $out " DIF FAT: Start=$difStart Count=$difCount\n";
- }
- #
- # load the FAT
- #
- my $pos = 0x4c;
- my $endPos = length($buff);
- my $fat = '';
- my $fatCountCheck = 0;
- for (;;) {
- while ($pos <= $endPos - 4) {
- my $sect = Get32u(\$buff, $pos);
- $pos += 4;
- next if $sect == FREE_SECT;
- my $offset = $sect * $sectSize + HDR_SIZE;
- my $fatSect;
- unless ($raf->Seek($offset, 0) and
- $raf->Read($fatSect, $sectSize) == $sectSize)
- {
- $et->Error("Error reading FAT from sector $sect");
- return 1;
- }
- $fat .= $fatSect;
- ++$fatCountCheck;
- }
- last if $difStart >= END_OF_CHAIN;
- # read next DIF (Dual Indirect FAT) sector
- my $offset = $difStart * $sectSize + HDR_SIZE;
- unless ($raf->Seek($offset, 0) and $raf->Read($buff, $sectSize) == $sectSize) {
- $et->Error("Error reading DIF sector $difStart");
- return 1;
- }
- # set end of sector information in this DIF
- $pos = 0;
- $endPos = $sectSize - 4;
- # next time around we want to read next DIF in chain
- $difStart = Get32u(\$buff, $endPos);
- }
- if ($fatCountCheck != $fatCount) {
- $et->Warn("Bad number of FAT sectors (expected $fatCount but found $fatCountCheck)");
- }
- #
- # load the mini-FAT and the directory
- #
- my $miniFat = LoadChain($raf, $miniStart, \$fat, $sectSize, HDR_SIZE);
- my $dir = LoadChain($raf, $dirStart, \$fat, $sectSize, HDR_SIZE);
- unless (defined $miniFat and defined $dir) {
- $et->Error('Error reading mini-FAT or directory stream');
- return 1;
- }
- if ($verbose) {
- print $out " FAT [",length($fat)," bytes]:\n";
- HexDump(\$fat, undef, %dumpParms) if $verbose > 2;
- print $out " Mini-FAT [",length($miniFat)," bytes]:\n";
- HexDump(\$miniFat, undef, %dumpParms) if $verbose > 2;
- print $out " Directory [",length($dir)," bytes]:\n";
- HexDump(\$dir, undef, %dumpParms) if $verbose > 2;
- }
- #
- # process the directory
- #
- if ($verbose) {
- $oldIndent = $$et{INDENT};
- $$et{INDENT} .= '| ';
- $et->VerboseDir('FPX', undef, length $dir);
- }
- my $miniStream;
- $endPos = length($dir);
- my $index = 0;
- for ($pos=0; $pos<=$endPos-128; $pos+=128, ++$index) {
- # get directory entry type
- # (0=invalid, 1=storage, 2=stream, 3=lockbytes, 4=property, 5=root)
- my $type = Get8u(\$dir, $pos + 0x42);
- next if $type == 0; # skip invalid entries
- if ($type > 5) {
- $et->Warn("Invalid directory entry type $type");
- last; # rest of directory is probably garbage
- }
- # get entry name (note: this is supposed to be length in 2-byte
- # characters but this isn't what is done in my sample FPX file, so
- # be very tolerant of this count -- it's null terminated anyway)
- my $len = Get16u(\$dir, $pos + 0x40);
- $len > 32 and $len = 32;
- $tag = Image::ExifTool::Decode(undef, substr($dir,$pos,$len*2), 'UCS2', 'II', 'Latin');
- $tag =~ s/\0.*//s; # truncate at null (in case length was wrong)
- my $sect = Get32u(\$dir, $pos + 0x74); # start sector number
- my $size = Get32u(\$dir, $pos + 0x78); # stream length
- # load Ministream (referenced from first directory entry)
- unless ($miniStream) {
- $miniStreamBuff = LoadChain($raf, $sect, \$fat, $sectSize, HDR_SIZE);
- unless (defined $miniStreamBuff) {
- $et->Warn('Error loading Mini-FAT stream');
- last;
- }
- $miniStream = new File::RandomAccess(\$miniStreamBuff);
- }
- my $tagInfo;
- if ($$tagTablePtr{$tag}) {
- $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
- } else {
- # remove instance number or class ID from tag if necessary
- $tagInfo = $et->GetTagInfo($tagTablePtr, $1) if
- ($tag =~ /(.*) \d{6}$/s and $$tagTablePtr{$1}) or
- ($tag =~ /(.*)_[0-9a-f]{16}$/s and $$tagTablePtr{$1});
- }
- my $lSib = Get32u(\$dir, $pos + 0x44); # left sibling
- my $rSib = Get32u(\$dir, $pos + 0x48); # right sibling
- my $chld = Get32u(\$dir, $pos + 0x4c); # child directory
- # save information about object hierachy
- my ($obj, $sub);
- $obj = $hier{$index} or $obj = $hier{$index} = { };
- $$obj{Left} = $lSib unless $lSib == FREE_SECT;
- $$obj{Right} = $rSib unless $rSib == FREE_SECT;
- unless ($chld == FREE_SECT) {
- $$obj{Child} = $chld;
- $sub = $hier{$chld} or $sub = $hier{$chld} = { };
- $$sub{Parent} = $index;
- }
- next unless $tagInfo or $verbose;
- # load the data for stream types
- my $extra = '';
- my $typeStr = $dirEntryType[$type] || $type;
- if ($typeStr eq 'STREAM') {
- if ($size >= $miniCutoff) {
- # stream is in the main FAT
- $buff = LoadChain($raf, $sect, \$fat, $sectSize, HDR_SIZE);
- } elsif ($size) {
- # stream is in the mini-FAT
- $buff = LoadChain($miniStream, $sect, \$miniFat, $miniSize, 0);
- } else {
- $buff = ''; # an empty stream
- }
- unless (defined $buff) {
- my $name = $tagInfo ? $$tagInfo{Name} : 'unknown';
- $et->Warn("Error reading $name stream");
- $buff = '';
- }
- } elsif ($typeStr eq 'ROOT') {
- $buff = $miniStreamBuff;
- $extra .= ' (Ministream)';
- } else {
- $buff = '';
- undef $size;
- }
- if ($verbose) {
- my $flags = Get8u(\$dir, $pos + 0x43); # 0=red, 1=black
- my $col = { 0 => 'Red', 1 => 'Black' }->{$flags} || $flags;
- $extra .= " Type=$typeStr Flags=$col";
- $extra .= " Left=$lSib" unless $lSib == FREE_SECT;
- $extra .= " Right=$rSib" unless $rSib == FREE_SECT;
- $extra .= " Child=$chld" unless $chld == FREE_SECT;
- $et->VerboseInfo($tag, $tagInfo,
- Index => $index,
- Value => $buff,
- DataPt => \$buff,
- Extra => $extra,
- Size => $size,
- );
- }
- if ($tagInfo and $buff) {
- my $num = $$et{NUM_FOUND};
- my $subdir = $$tagInfo{SubDirectory};
- if ($subdir) {
- my %dirInfo = (
- DataPt => \$buff,
- DirStart => $$subdir{DirStart},
- DirLen => length $buff,
- Multi => $$tagInfo{Multi},
- );
- my $subTablePtr = GetTagTable($$subdir{TagTable});
- $et->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc});
- } else {
- $et->FoundTag($tagInfo, $buff);
- }
- # save object index number for all found tags
- my $num2 = $$et{NUM_FOUND};
- $objIndex{++$num} = $index while $num < $num2;
- }
- }
- # set document numbers for tags extracted from embedded documents
- unless ($$et{DOC_NUM}) {
- # initialize document number for all objects, beginning at root (index 0)
- SetDocNum(\%hier, 0);
- # set family 3 group name for all tags in embedded documents
- my $order = $$et{FILE_ORDER};
- my (@pri, $copy, $member);
- foreach $tag (keys %$order) {
- my $num = $$order{$tag};
- next unless defined $num and $objIndex{$num};
- my $obj = $hier{$objIndex{$num}} or next;
- my $docNums = $$obj{DocNum};
- next unless $docNums and @$docNums;
- $$et{TAG_EXTRA}{$tag}{G3} = join '-', @$docNums;
- push @pri, $tag unless $tag =~ / /; # save keys for priority sub-doc tags
- }
- # swap priority sub-document tags with main document tags if they exist
- foreach $tag (@pri) {
- for ($copy=1; ;++$copy) {
- my $key = "$tag ($copy)";
- last unless defined $$et{VALUE}{$key};
- my $extra = $$et{TAG_EXTRA}{$key};
- next if $extra and $$extra{G3}; # not Main if family 3 group is set
- foreach $member ('PRIORITY','VALUE','FILE_ORDER','TAG_INFO','TAG_EXTRA') {
- my $pHash = $$et{$member};
- my $t = $$pHash{$tag};
- $$pHash{$tag} = $$pHash{$key};
- $$pHash{$key} = $t;
- }
- last;
- }
- }
- }
- $$et{INDENT} = $oldIndent if $verbose;
- # try to better identify the file type
- if ($$et{VALUE}{FileType} eq 'FPX') {
- my $val = $$et{CompObjUserType} || $$et{Software};
- if ($val) {
- my %type = ( Word => 'DOC', PowerPoint => 'PPT', Excel => 'XLS' );
- my $pat;
- foreach $pat (sort keys %type) {
- next unless $val =~ /$pat/;
- $et->OverrideFileType($type{$pat});
- last;
- }
- }
- }
- return 1;
- }
- 1; # end
- __END__
- =head1 NAME
- Image::ExifTool::FlashPix - Read FlashPix meta information
- =head1 SYNOPSIS
- This module is used by Image::ExifTool
- =head1 DESCRIPTION
- This module contains routines required by Image::ExifTool to extract
- FlashPix meta information from FPX images, and from the APP2 FPXR segment of
- JPEG images.
- =head1 AUTHOR
- Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
- This library is free software; you can redistribute it and/or modify it
- under the same terms as Perl itself.
- =head1 REFERENCES
- =over 4
- =item L<http://www.exif.org/Exif2-2.PDF>
- =item L<http://www.graphcomp.com/info/specs/livepicture/fpx.pdf>
- =item L<http://search.cpan.org/~jdb/libwin32/>
- =item L<http://msdn.microsoft.com/en-us/library/aa380374.aspx>
- =back
- =head1 SEE ALSO
- L<Image::ExifTool::TagNames/FlashPix Tags>,
- L<Image::ExifTool::TagNames/OOXML Tags>,
- L<Image::ExifTool(3pm)|Image::ExifTool>
- =cut
|