1#------------------------------------------------------------------------------
2# File:         ExifTool.pm
3#
4# Description:  Read and write meta information
5#
6# URL:          https://exiftool.org/
7#
8# Revisions:    Nov. 12/2003 - P. Harvey Created
9#               (See html/history.html for revision history)
10#
11# Legal:        Copyright (c) 2003-2021, Phil Harvey (philharvey66 at gmail.com)
12#               This library is free software; you can redistribute it and/or
13#               modify it under the same terms as Perl itself.
14#------------------------------------------------------------------------------
15
16package Image::ExifTool;
17
18use strict;
19require 5.004;  # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do)
20require Exporter;
21use File::RandomAccess;
22use overload;
23
24use vars qw($VERSION $RELEASE @ISA @EXPORT_OK %EXPORT_TAGS $AUTOLOAD @fileTypes
25            %allTables @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr
26            $psAPP13hdr $psAPP13old @loadAllTables %UserDefined $evalWarning
27            %noWriteFile %magicNumber @langs $defaultLang %langName %charsetName
28            %mimeType $swapBytes $swapWords $currentByteOrder %unpackStd
29            %jpegMarker %specialTags %fileTypeLookup $testLen $exePath);
30
31$VERSION = '12.14';
32$RELEASE = '';
33@ISA = qw(Exporter);
34%EXPORT_TAGS = (
35    # all public non-object-oriented functions:
36    Public => [qw(
37        ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags
38        GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate
39        AddUserDefinedTags
40    )],
41    # exports not part of the public API, but used by ExifTool modules:
42    DataAccess => [qw(
43        ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u
44        Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write
45        WriteValue Tell Set8u Set8s Set16u Set32u Set64u
46    )],
47    Utils => [qw(GetTagTable TagTableKeys GetTagInfoList AddTagToTable HexDump)],
48    Vars  => [qw(%allTables @tableOrder @fileTypes)],
49);
50
51# set all of our EXPORT_TAGS in EXPORT_OK
52Exporter::export_ok_tags(keys %EXPORT_TAGS);
53
54# test for problems that can arise if encoding.pm is used
55{ my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; }
56
57# The following functions defined in Image::ExifTool::Writer.pl are declared
58# here so their prototypes will be available.  These Writer routines will be
59# autoloaded when any of them is called.
60sub SetNewValue($;$$%);
61sub SetNewValuesFromFile($$;@);
62sub GetNewValue($$;$);
63sub GetNewValues($$;$);
64sub CountNewValues($);
65sub SaveNewValues($);
66sub RestoreNewValues($);
67sub WriteInfo($$;$$);
68sub SetFileModifyDate($$;$$$);
69sub SetFileName($$;$$$);
70sub SetSystemTags($$);
71sub GetAllTags(;$);
72sub GetWritableTags(;$);
73sub GetAllGroups($);
74sub GetNewGroups($);
75sub GetDeleteGroups();
76sub AddUserDefinedTags($%);
77# non-public routines below
78sub InsertTagValues($$$;$$$);
79sub IsWritable($);
80sub IsSameFile($$$);
81sub IsRawType($);
82sub GetNewFileName($$);
83sub LoadAllTables();
84sub GetNewTagInfoList($;$);
85sub GetNewTagInfoHash($@);
86sub GetLangInfo($$);
87sub Get64s($$);
88sub Get64u($$);
89sub GetFixed64s($$);
90sub GetExtended($$);
91sub Set64u(@);
92sub DecodeBits($$;$);
93sub EncodeBits($$;$$);
94sub Filter($$$);
95sub HexDump($;$%);
96sub DumpTrailer($$);
97sub DumpUnknownTrailer($$);
98sub VerboseInfo($$$%);
99sub VerboseValue($$$;$);
100sub VPrint($$@);
101sub Rationalize($;$);
102sub Write($@);
103sub WriteTrailerBuffer($$$);
104sub AddNewTrailers($;@);
105sub Tell($);
106sub WriteValue($$;$$$$);
107sub WriteDirectory($$$;$);
108sub WriteBinaryData($$$);
109sub CheckBinaryData($$$);
110sub WriteTIFF($$$);
111sub PackUTF8(@);
112sub UnpackUTF8($);
113sub SetPreferredByteOrder($;$);
114sub CopyBlock($$$);
115sub CopyFileAttrs($$$);
116sub TimeNow(;$$);
117sub NewGUID();
118sub MakeTiffHeader($$$$;$$);
119
120# other subroutine definitions
121sub SplitFileName($);
122sub EncodeFileName($$;$);
123sub Open($*$;$);
124sub Exists($$);
125sub IsDirectory($$);
126sub Rename($$$);
127sub Unlink($@);
128sub SetFileTime($$;$$$$);
129sub DoEscape($$);
130sub ConvertFileSize($);
131sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem)
132sub ReadValue($$$;$$$);
133
134# list of main tag tables to load in LoadAllTables() (sub-tables are recursed
135# automatically).  Note: They will appear in this order in the documentation
136# unless tweaked in BuildTagLookup::GetTableOrder().
137@loadAllTables = qw(
138    PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw Lytro MinoltaRaw PanasonicRaw
139    SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 BMP::Extra BPG BPG::Extensions
140    PICT PNG MNG FLIF DjVu DPX OpenEXR ZISRAW MIFF PCX PGF PSP PhotoCD Radiance
141    PDF PostScript Photoshop::Header Photoshop::Layers Photoshop::ImageData
142    FujiFilm::RAF FujiFilm::IFD Samsung::Trailer Sony::SRF2 Sony::SR2SubIFD
143    Sony::PMP ITC ID3 ID3::Lyrics3 FLAC Ogg Vorbis APE APE::NewHeader
144    APE::OldHeader Audible MPC MPEG::Audio MPEG::Video MPEG::Xing M2TS QuickTime
145    QuickTime::ImageFile QuickTime::Stream QuickTime::Tags360Fly Matroska MOI
146    MXF DV Flash Flash::FLV Real::Media Real::Audio Real::Metafile Red RIFF AIFF
147    ASF WTV DICOM FITS MIE JSON HTML XMP::SVG Palm Palm::MOBI Palm::EXTH Torrent
148    EXE EXE::PEVersion EXE::PEString EXE::MachO EXE::PEF EXE::ELF EXE::AR
149    EXE::CHM LNK Font VCard Text VCard::VCalendar RSRC Rawzor ZIP ZIP::GZIP
150    ZIP::RAR RTF OOXML iWork ISO FLIR::AFF FLIR::FPF MacOS MacOS::MDItem
151    FlashPix::DocTable
152);
153
154# alphabetical list of current Lang modules
155@langs = qw(cs de en en_ca en_gb es fi fr it ja ko nl pl ru sv tr zh_cn zh_tw);
156
157$defaultLang = 'en';    # default language
158
159# language names
160%langName = (
161    cs => 'Czech (Čeština)',
162    de => 'German (Deutsch)',
163    en => 'English',
164    en_ca => 'Canadian English',
165    en_gb => 'British English',
166    es => 'Spanish (Español)',
167    fi => 'Finnish (Suomi)',
168    fr => 'French (Français)',
169    it => 'Italian (Italiano)',
170    ja => 'Japanese (日本語)',
171    ko => 'Korean (한국어)',
172    nl => 'Dutch (Nederlands)',
173    pl => 'Polish (Polski)',
174    ru => 'Russian (Русский)',
175    sv => 'Swedish (Svenska)',
176   'tr'=> 'Turkish (Türkçe)',
177    zh_cn => 'Simplified Chinese (简体中文)',
178    zh_tw => 'Traditional Chinese (繁體中文)',
179);
180
181# recognized file types, in the order we test unknown files
182# Notes: 1) There is no need to test for like types separately here
183# 2) Put types with weak file signatures at end of list to avoid false matches
184# 3) PLIST must be in this list for the binary PLIST format, although it may
185#    cause a file to be checked twice for XML
186@fileTypes = qw(JPEG EXV CRW DR4 TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF
187                PSD XMP BMP BPG PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG
188                FLAC APE MPC MKV MXF DV PMP IND PGF ICC ITC FLIR FLIF FPF LFP
189                HTML VRD RTF FITS XCF DSS QTIF FPX PICT ZIP GZIP PLIST RAR BZ2
190                CZI TAR  EXE EXR HDR CHM LNK WMF AVC DEX DPX RAW Font RSRC M2TS
191                MacOS PHP PCX DCX DWF DWG WTV Torrent VCard LRI R3D AA PDB MOI
192                ISO ALIAS JSON MP3 DICOM PCD TXT);
193
194# file types that we can write (edit)
195my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM EPS
196                    X3F PS PDF ICC VRD DR4 JP2 EXIF AI AIT IND MOV EXV FLIF);
197my %writeTypes; # lookup for writable file types (hash filled if required)
198
199# file extensions that we can't write for various base types
200%noWriteFile = (
201    TIFF => [ qw(3FR DCR K25 KDC SRF) ],
202    XMP  => [ qw(SVG INX) ],
203    JP2  => [ qw(J2C JPC) ],
204    MOV  => [ qw(INSV) ],
205);
206
207# file types that we can create from scratch
208# - must update CanCreate() documentation if this list is changed!
209my %createTypes = map { $_ => 1 } qw(XMP ICC MIE VRD DR4 EXIF EXV);
210
211# file type lookup for all recognized file extensions (upper case)
212# (if extension may be more than one type, the type is a list where
213#  the writable type should come first if it exists)
214%fileTypeLookup = (
215   '360' => ['MOV',  'GoPro 360 video'],
216   '3FR' => ['TIFF', 'Hasselblad RAW format'],
217   '3G2' => ['MOV',  '3rd Gen. Partnership Project 2 audio/video'],
218   '3GP' => ['MOV',  '3rd Gen. Partnership Project audio/video'],
219   '3GP2'=>  '3G2',
220   '3GPP'=>  '3GP',
221    A    => ['EXE',  'Static library'],
222    AA   => ['AA',   'Audible Audiobook'],
223    AAE  => ['PLIST','Apple edit information'],
224    AAX  => ['MOV',  'Audible Enhanced Audiobook'],
225    ACR  => ['DICOM','American College of Radiology ACR-NEMA'],
226    ACFM => ['Font', 'Adobe Composite Font Metrics'],
227    AFM  => ['Font', 'Adobe Font Metrics'],
228    AMFM => ['Font', 'Adobe Multiple Master Font Metrics'],
229    AI   => [['PDF','PS'], 'Adobe Illustrator'],
230    AIF  =>  'AIFF',
231    AIFC => ['AIFF', 'Audio Interchange File Format Compressed'],
232    AIFF => ['AIFF', 'Audio Interchange File Format'],
233    AIT  =>  'AI',
234    ALIAS=> ['ALIAS','MacOS file alias'],
235    APE  => ['APE',  "Monkey's Audio format"],
236    APNG => ['PNG',  'Animated Portable Network Graphics'],
237    ARW  => ['TIFF', 'Sony Alpha RAW format'],
238    ARQ  => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'],
239    ASF  => ['ASF',  'Microsoft Advanced Systems Format'],
240    AVC  => ['AVC',  'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID)
241    AVI  => ['RIFF', 'Audio Video Interleaved'],
242    AVIF => ['MOV',  'AV1 Image File Format'],
243    AZW  =>  'MOBI', # (see http://wiki.mobileread.com/wiki/AZW)
244    AZW3 =>  'MOBI',
245    BMP  => ['BMP',  'Windows Bitmap'],
246    BPG  => ['BPG',  'Better Portable Graphics'],
247    BTF  => ['BTF',  'Big Tagged Image File Format'], #(unofficial)
248    BZ2  => ['BZ2',  'BZIP2 archive'],
249    CHM  => ['CHM',  'Microsoft Compiled HTML format'],
250    CIFF => ['CRW',  'Camera Image File Format'],
251    COS  => ['COS',  'Capture One Settings'],
252    CR2  => ['TIFF', 'Canon RAW 2 format'],
253    CR3  => ['MOV',  'Canon RAW 3 format'],
254    CRM  => ['MOV',  'Canon RAW Movie'],
255    CRW  => ['CRW',  'Canon RAW format'],
256    CS1  => ['PSD',  'Sinar CaptureShop 1-Shot RAW'],
257    CSV  => ['TXT',  'Comma-Separated Values'],
258    CZI  => ['CZI',  'Zeiss Integrated Software RAW'],
259    DC3  =>  'DICM',
260    DCM  =>  'DICM',
261    DCP  => ['TIFF', 'DNG Camera Profile'],
262    DCR  => ['TIFF', 'Kodak Digital Camera RAW'],
263    DCX  => ['DCX',  'Multi-page PC Paintbrush'],
264    DEX  => ['DEX',  'Dalvik Executable format'],
265    DFONT=> ['Font', 'Macintosh Data fork Font'],
266    DIB  => ['BMP',  'Device Independent Bitmap'],
267    DIC  =>  'DICM',
268    DICM => ['DICOM','Digital Imaging and Communications in Medicine'],
269    DIVX => ['ASF',  'DivX media format'],
270    DJV  =>  'DJVU',
271    DJVU => ['AIFF', 'DjVu image'],
272    DLL  => ['EXE',  'Windows Dynamic Link Library'],
273    DNG  => ['TIFF', 'Digital Negative'],
274    DOC  => ['FPX',  'Microsoft Word Document'],
275    DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'],
276    # Note: I have seen a password-protected DOCX file which was FPX-like, so I assume
277    # that any other MS Office file could be like this too.  The only difference is
278    # that the ZIP and FPX formats are checked first, so if this is wrong, no biggie.
279    DOCX => [['ZIP','FPX'], 'Office Open XML Document'],
280    DOT  => ['FPX',  'Microsoft Word Template'],
281    DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'],
282    DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'],
283    DPX  => ['DPX',  'Digital Picture Exchange' ],
284    DR4  => ['DR4',  'Canon VRD version 4 Recipe'],
285    DS2  => ['DSS',  'Digital Speech Standard 2'],
286    DSS  => ['DSS',  'Digital Speech Standard'],
287    DV   => ['DV',   'Digital Video'],
288    DVB  => ['MOV',  'Digital Video Broadcasting'],
289   'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'],
290    DWF  => ['DWF',  'Autodesk drawing (Design Web Format)'],
291    DWG  => ['DWG',  'AutoCAD Drawing'],
292    DYLIB=> ['EXE',  'Mach-O Dynamic Link Library'],
293    EIP  => ['ZIP',  'Capture One Enhanced Image Package'],
294    EPS  => ['EPS',  'Encapsulated PostScript Format'],
295    EPS2 =>  'EPS',
296    EPS3 =>  'EPS',
297    EPSF =>  'EPS',
298    EPUB => ['ZIP',  'Electronic Publication'],
299    ERF  => ['TIFF', 'Epson Raw Format'],
300    EXE  => ['EXE',  'Windows executable file'],
301    EXR  => ['EXR', 'Open EXR'],
302    EXIF => ['EXIF', 'Exchangable Image File Metadata'],
303    EXV  => ['EXV',  'Exiv2 metadata'],
304    F4A  => ['MOV',  'Adobe Flash Player 9+ Audio'],
305    F4B  => ['MOV',  'Adobe Flash Player 9+ audio Book'],
306    F4P  => ['MOV',  'Adobe Flash Player 9+ Protected'],
307    F4V  => ['MOV',  'Adobe Flash Player 9+ Video'],
308    FFF  => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'],
309    FIT  =>  'FITS',
310    FITS => ['FITS', 'Flexible Image Transport System'],
311    FLAC => ['FLAC', 'Free Lossless Audio Codec'],
312    FLA  => ['FPX',  'Macromedia/Adobe Flash project'],
313    FLIF => ['FLIF', 'Free Lossless Image Format'],
314    FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension)
315    FLV  => ['FLV',  'Flash Video'],
316    FPF  => ['FPF',  'FLIR Public image Format'],
317    FPX  => ['FPX',  'FlashPix'],
318    GIF  => ['GIF',  'Compuserve Graphics Interchange Format'],
319    GPR  => ['TIFF', 'GoPro RAW'],
320    GZ   =>  'GZIP',
321    GZIP => ['GZIP', 'GNU ZIP compressed archive'],
322    HDP  => ['TIFF', 'Windows HD Photo'],
323    HDR  => ['HDR',  'Radiance RGBE High Dynamic Range'],
324    HEIC => ['MOV',  'High Efficiency Image Format still image'],
325    HEIF => ['MOV',  'High Efficiency Image Format'],
326    HIF  =>  'HEIF',
327    HTM  =>  'HTML',
328    HTML => ['HTML', 'HyperText Markup Language'],
329    ICAL =>  'ICS',
330    ICC  => ['ICC',  'International Color Consortium'],
331    ICM  =>  'ICC',
332    ICS  => ['VCard','iCalendar Schedule'],
333    IDML => ['ZIP',  'Adobe InDesign Markup Language'],
334    IIQ  => ['TIFF', 'Phase One Intelligent Image Quality RAW'],
335    IND  => ['IND',  'Adobe InDesign'],
336    INDD => ['IND',  'Adobe InDesign Document'],
337    INDT => ['IND',  'Adobe InDesign Template'],
338    INSV => ['MOV',  'Insta360 Video'],
339    INSP => ['JPEG', 'Insta360 Picture'],
340    INX  => ['XMP',  'Adobe InDesign Interchange'],
341    ISO  => ['ISO',  'ISO 9660 disk image'],
342    ITC  => ['ITC',  'iTunes Cover Flow'],
343    J2C  => ['JP2',  'JPEG 2000 codestream'],
344    J2K  =>  'J2C',
345    JNG  => ['PNG',  'JPG Network Graphics'],
346    JP2  => ['JP2',  'JPEG 2000 file'],
347    # JP4? - looks like a JPEG but the image data is different
348    JPC  =>  'J2C',
349    JPE  =>  'JPEG',
350    JPEG => ['JPEG', 'Joint Photographic Experts Group'],
351    JPF  =>  'JP2',
352    JPG =>   'JPEG',
353    JPM  => ['JP2',  'JPEG 2000 compound image'],
354    JPX  => ['JP2',  'JPEG 2000 with extensions'],
355    JSON => ['JSON', 'JavaScript Object Notation'],
356    JXR  => ['TIFF', 'JPEG XR'],
357    K25  => ['TIFF', 'Kodak DC25 RAW'],
358    KDC  => ['TIFF', 'Kodak Digital Camera RAW'],
359    KEY  => ['ZIP',  'Apple Keynote presentation'],
360    KTH  => ['ZIP',  'Apple Keynote Theme'],
361    LA   => ['RIFF', 'Lossless Audio'],
362    LFP  => ['LFP',  'Lytro Light Field Picture'],
363    LFR  =>  'LFP', # (Light Field RAW)
364    LNK  => ['LNK',  'Windows shortcut'],
365    LRI  => ['LRI',  'Light RAW'],
366    LRV  => ['MOV',  'Low-Resolution Video'],
367    M2T  =>  'M2TS',
368    M2TS => ['M2TS', 'MPEG-2 Transport Stream'],
369    M2V  => ['MPEG', 'MPEG-2 Video'],
370    M4A  => ['MOV',  'MPEG-4 Audio'],
371    M4B  => ['MOV',  'MPEG-4 audio Book'],
372    M4P  => ['MOV',  'MPEG-4 Protected'],
373    M4V  => ['MOV',  'MPEG-4 Video'],
374    MAX  => ['FPX',  '3D Studio MAX'],
375    MEF  => ['TIFF', 'Mamiya (RAW) Electronic Format'],
376    MIE  => ['MIE',  'Meta Information Encapsulation format'],
377    MIF  =>  'MIFF',
378    MIFF => ['MIFF', 'Magick Image File Format'],
379    MKA  => ['MKV',  'Matroska Audio'],
380    MKS  => ['MKV',  'Matroska Subtitle'],
381    MKV  => ['MKV',  'Matroska Video'],
382    MNG  => ['PNG',  'Multiple-image Network Graphics'],
383    MOBI => ['PDB',  'Mobipocket electronic book'],
384    MODD => ['PLIST','Sony Picture Motion metadata'],
385    MOI  => ['MOI',  'MOD Information file'],
386    MOS  => ['TIFF', 'Creo Leaf Mosaic'],
387    MOV  => ['MOV',  'Apple QuickTime movie'],
388    MP3  => ['MP3',  'MPEG-1 Layer 3 audio'],
389    MP4  => ['MOV',  'MPEG-4 video'],
390    MPC  => ['MPC',  'Musepack Audio'],
391    MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'],
392    MPG  =>  'MPEG',
393    MPO  => ['JPEG', 'Extended Multi-Picture format'],
394    MQV  => ['MOV',  'Sony Mobile Quicktime Video'],
395    MRW  => ['MRW',  'Minolta RAW format'],
396    MTS  =>  'M2TS',
397    MXF  => ['MXF',  'Material Exchange Format'],
398  # NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'],
399    NEF  => ['TIFF', 'Nikon (RAW) Electronic Format'],
400    NEWER => 'COS',
401    NMBTEMPLATE => ['ZIP','Apple Numbers Template'],
402    NRW  => ['TIFF', 'Nikon RAW (2)'],
403    NUMBERS => ['ZIP','Apple Numbers spreadsheet'],
404    O    => ['EXE',  'Relocatable Object'],
405    ODB  => ['ZIP',  'Open Document Database'],
406    ODC  => ['ZIP',  'Open Document Chart'],
407    ODF  => ['ZIP',  'Open Document Formula'],
408    ODG  => ['ZIP',  'Open Document Graphics'],
409    ODI  => ['ZIP',  'Open Document Image'],
410    ODP  => ['ZIP',  'Open Document Presentation'],
411    ODS  => ['ZIP',  'Open Document Spreadsheet'],
412    ODT  => ['ZIP',  'Open Document Text file'],
413    OFR  => ['RIFF', 'OptimFROG audio'],
414    OGG  => ['OGG',  'Ogg Vorbis audio file'],
415    OGV  => ['OGG',  'Ogg Video file'],
416    ONP  => ['JSON', 'ON1 Presets'],
417    OPUS => ['OGG',  'Ogg Opus audio file'],
418    ORF  => ['ORF',  'Olympus RAW format'],
419    OTF  => ['Font', 'Open Type Font'],
420    PAC  => ['RIFF', 'Lossless Predictive Audio Compression'],
421    PAGES => ['ZIP', 'Apple Pages document'],
422    PBM  => ['PPM',  'Portable BitMap'],
423    PCD  => ['PCD',  'Kodak Photo CD Image Pac'],
424    PCT  =>  'PICT',
425    PCX  => ['PCX',  'PC Paintbrush'],
426    PDB  => ['PDB',  'Palm Database'],
427    PDF  => ['PDF',  'Adobe Portable Document Format'],
428    PEF  => ['TIFF', 'Pentax (RAW) Electronic Format'],
429    PFA  => ['Font', 'PostScript Font ASCII'],
430    PFB  => ['Font', 'PostScript Font Binary'],
431    PFM  => ['Font', 'Printer Font Metrics'],
432    PGF  => ['PGF',  'Progressive Graphics File'],
433    PGM  => ['PPM',  'Portable Gray Map'],
434    PHP  => ['PHP',  'PHP Hypertext Preprocessor'],
435    PHP3 =>  'PHP',
436    PHP4 =>  'PHP',
437    PHP5 =>  'PHP',
438    PHPS =>  'PHP',
439    PHTML=>  'PHP',
440    PICT => ['PICT', 'Apple PICTure'],
441    PLIST=> ['PLIST','Apple Property List'],
442    PMP  => ['PMP',  'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;)
443    PNG  => ['PNG',  'Portable Network Graphics'],
444    POT  => ['FPX',  'Microsoft PowerPoint Template'],
445    POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'],
446    POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'],
447    PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'],
448    PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'],
449    PPM  => ['PPM',  'Portable Pixel Map'],
450    PPS  => ['FPX',  'Microsoft PowerPoint Slideshow'],
451    PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'],
452    PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'],
453    PPT  => ['FPX',  'Microsoft PowerPoint Presentation'],
454    PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'],
455    PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'],
456    PRC  => ['PDB',  'Palm Database'],
457    PS   => ['PS',   'PostScript'],
458    PS2  =>  'PS',
459    PS3  =>  'PS',
460    PSB  => ['PSD',  'Photoshop Large Document'],
461    PSD  => ['PSD',  'Photoshop Document'],
462    PSDT => ['PSD',  'Photoshop Document Template'],
463    PSP  => ['PSP',  'Paint Shop Pro'],
464    PSPFRAME => 'PSP',
465    PSPIMAGE => 'PSP',
466    PSPSHAPE => 'PSP',
467    PSPTUBE  => 'PSP',
468    QIF  =>  'QTIF',
469    QT   =>  'MOV',
470    QTI  =>  'QTIF',
471    QTIF => ['QTIF', 'QuickTime Image File'],
472    R3D  => ['R3D',  'Redcode RAW Video'],
473    RA   => ['Real', 'Real Audio'],
474    RAF  => ['RAF',  'FujiFilm RAW Format'],
475    RAM  => ['Real', 'Real Audio Metafile'],
476    RAR  => ['RAR',  'RAR Archive'],
477    RAW  => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'],
478    RIF  =>  'RIFF',
479    RIFF => ['RIFF', 'Resource Interchange File Format'],
480    RM   => ['Real', 'Real Media'],
481    RMVB => ['Real', 'Real Media Variable Bitrate'],
482    RPM  => ['Real', 'Real Media Plug-in Metafile'],
483    RSRC => ['RSRC', 'Mac OS Resource'],
484    RTF  => ['RTF',  'Rich Text Format'],
485    RV   => ['Real', 'Real Video'],
486    RW2  => ['TIFF', 'Panasonic RAW 2'],
487    RWL  => ['TIFF', 'Leica RAW'],
488    RWZ  => ['RWZ',  'Rawzor compressed image'],
489    SEQ  => ['FLIR', 'FLIR image Sequence'],
490    SKETCH => ['ZIP', 'Sketch design file'],
491    SO   => ['EXE',  'Shared Object file'],
492    SR2  => ['TIFF', 'Sony RAW Format 2'],
493    SRF  => ['TIFF', 'Sony RAW Format'],
494    SRW  => ['TIFF', 'Samsung RAW format'],
495    SVG  => ['XMP',  'Scalable Vector Graphics'],
496    SWF  => ['SWF',  'Shockwave Flash'],
497    TAR  => ['TAR',  'TAR archive'],
498    THM  => ['JPEG', 'Thumbnail'],
499    THMX => [['ZIP','FPX'], 'Office Open XML Theme'],
500    TIF  =>  'TIFF',
501    TIFF => ['TIFF', 'Tagged Image File Format'],
502    TORRENT => ['Torrent', 'BitTorrent description file'],
503    TS   =>  'M2TS',
504    TTC  => ['Font', 'True Type Font Collection'],
505    TTF  => ['Font', 'True Type Font'],
506    TUB  => 'PSP',
507    TXT  => ['TXT',  'Text file'],
508    VCARD=> ['VCard','Virtual Card'],
509    VCF  => 'VCARD',
510    VOB  => ['MPEG', 'Video Object'],
511    VRD  => ['VRD',  'Canon VRD Recipe Data'],
512    VSD  => ['FPX',  'Microsoft Visio Drawing'],
513    WAV  => ['RIFF', 'WAVeform (Windows digital audio)'],
514    WDP  => ['TIFF', 'Windows Media Photo'],
515    WEBM => ['MKV',  'Google Web Movie'],
516    WEBP => ['RIFF', 'Google Web Picture'],
517    WMA  => ['ASF',  'Windows Media Audio'],
518    WMF  => ['WMF',  'Windows Metafile Format'],
519    WMV  => ['ASF',  'Windows Media Video'],
520    WV   => ['RIFF', 'WavePack lossless audio'],
521    X3F  => ['X3F',  'Sigma RAW format'],
522    MACOS=> ['MacOS','MacOS ._ sidecar file'],
523    XCF  => ['XCF',  'GIMP native image format'],
524    XHTML=> ['HTML', 'Extensible HyperText Markup Language'],
525    XLA  => ['FPX',  'Microsoft Excel Add-in'],
526    XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'],
527    XLS  => ['FPX',  'Microsoft Excel Spreadsheet'],
528    XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'],
529    XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'],
530    XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'],
531    XLT  => ['FPX',  'Microsoft Excel Template'],
532    XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'],
533    XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'],
534    XMP  => ['XMP',  'Extensible Metadata Platform'],
535    WOFF => ['Font', 'Web Open Font Format'],
536    WOFF2=> ['Font', 'Web Open Font Format2'],
537    WTV  => ['WTV',  'Windows recorded TV show'],
538    ZIP  => ['ZIP',  'ZIP archive'],
539);
540
541# typical extension for each file type (if different than FileType)
542# - case is not significant
543my %fileTypeExt = (
544    'Canon 1D RAW' => 'tif',
545    DICOM   => 'dcm',
546    FLIR    => 'fff',
547    GZIP    => 'gz',
548    JPEG    => 'jpg',
549    M2TS    => 'mts',
550    MPEG    => 'mpg',
551    TIFF    => 'tif',
552    VCard   => 'vcf',
553);
554
555# descriptions for file types not found in above file extension lookup
556my %fileDescription = (
557    DICOM => 'Digital Imaging and Communications in Medicine',
558    XML   => 'Extensible Markup Language',
559    'Win32 EXE' => 'Windows 32-bit Executable',
560    'Win32 DLL' => 'Windows 32-bit Dynamic Link Library',
561    'Win64 EXE' => 'Windows 64-bit Executable',
562    'Win64 DLL' => 'Windows 64-bit Dynamic Link Library',
563);
564
565# MIME types for applicable file types above
566# (missing entries default to 'application/unknown', but note that other MIME
567#  types may be specified by some modules, eg. QuickTime.pm and RIFF.pm)
568%mimeType = (
569   '3FR' => 'image/x-hasselblad-3fr',
570    AA   => 'audio/audible',
571    AAE  => 'application/vnd.apple.photos',
572    AI   => 'application/vnd.adobe.illustrator',
573    AIFF => 'audio/x-aiff',
574    ALIAS=> 'application/x-macos',
575    APE  => 'audio/x-monkeys-audio',
576    APNG => 'image/apng',
577    ASF  => 'video/x-ms-asf',
578    ARW  => 'image/x-sony-arw',
579    BMP  => 'image/bmp',
580    BPG  => 'image/bpg',
581    BTF  => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html)
582    BZ2  => 'application/bzip2',
583   'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension)
584    CHM  => 'application/x-chm',
585    COS  => 'application/octet-stream', #PH (NC)
586    CR2  => 'image/x-canon-cr2',
587    CR3  => 'image/x-canon-cr3',
588    CRM  => 'video/x-canon-crm',
589    CRW  => 'image/x-canon-crw',
590    CSV  => 'text/csv',
591    CZI  => 'image/x-zeiss-czi', #PH (NC)
592    DCP  => 'application/octet-stream', #PH (NC)
593    DCR  => 'image/x-kodak-dcr',
594    DCX  => 'image/dcx',
595    DEX  => 'application/octet-stream',
596    DFONT=> 'application/x-dfont',
597    DICOM=> 'application/dicom',
598    DIVX => 'video/divx',
599    DJVU => 'image/vnd.djvu',
600    DNG  => 'image/x-adobe-dng',
601    DOC  => 'application/msword',
602    DOCM => 'application/vnd.ms-word.document.macroEnabled',
603    DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document',
604    DOT  => 'application/msword',
605    DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate',
606    DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template',
607    DPX  => 'image/x-dpx',
608    DR4  => 'application/octet-stream', #PH (NC)
609    DS2  => 'audio/x-ds2',
610    DSS  => 'audio/x-dss',
611    DV   => 'video/x-dv',
612   'DVR-MS' => 'video/x-ms-dvr',
613    DWF  => 'model/vnd.dwf',
614    DWG  => 'image/vnd.dwg',
615    EIP  => 'application/x-captureone', #(NC)
616    EPS  => 'application/postscript',
617    ERF  => 'image/x-epson-erf',
618    EXE  => 'application/octet-stream',
619    EXR  => 'image/x-exr',
620    EXV  => 'image/x-exv',
621    FFF  => 'image/x-hasselblad-fff',
622    FITS => 'image/fits',
623    FLA  => 'application/vnd.adobe.fla',
624    FLAC => 'audio/flac',
625    FLIF => 'image/flif',
626    FLIR => 'image/x-flir-fff', #PH (NC)
627    FLV  => 'video/x-flv',
628    Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM)
629    FPF  => 'image/x-flir-fpf', #PH (NC)
630    FPX  => 'image/vnd.fpx',
631    GIF  => 'image/gif',
632    GPR  => 'image/x-gopro-gpr',
633    GZIP => 'application/x-gzip',
634    HDP  => 'image/vnd.ms-photo',
635    HDR  => 'image/vnd.radiance',
636    HTML => 'text/html',
637    ICC  => 'application/vnd.iccprofile',
638    ICS  => 'text/calendar',
639    IDML => 'application/vnd.adobe.indesign-idml-package',
640    IIQ  => 'image/x-raw',
641    IND  => 'application/x-indesign',
642    INX  => 'application/x-indesign-interchange', #PH (NC)
643    ISO  => 'application/x-iso9660-image',
644    ITC  => 'application/itunes',
645    J2C  => 'image/x-j2c', #PH (NC)
646    JNG  => 'image/jng',
647    JP2  => 'image/jp2',
648    JPEG => 'image/jpeg',
649    JPM  => 'image/jpm',
650    JPX  => 'image/jpx',
651    JSON => 'application/json',
652    JXR  => 'image/jxr',
653    K25  => 'image/x-kodak-k25',
654    KDC  => 'image/x-kodak-kdc',
655    KEY  => 'application/x-iwork-keynote-sffkey',
656    LFP  => 'image/x-lytro-lfp', #PH (NC)
657    LNK  => 'application/octet-stream',
658    LRI  => 'image/x-light-lri',
659    M2T  => 'video/mpeg',
660    M2TS => 'video/m2ts',
661    MAX  => 'application/x-3ds',
662    MEF  => 'image/x-mamiya-mef',
663    MIE  => 'application/x-mie',
664    MIFF => 'application/x-magick-image',
665    MKA  => 'audio/x-matroska',
666    MKS  => 'application/x-matroska',
667    MKV  => 'video/x-matroska',
668    MNG  => 'video/mng',
669    MOBI => 'application/x-mobipocket-ebook',
670    MOI  => 'application/octet-stream', #PH (NC)
671    MOS  => 'image/x-raw',
672    MOV  => 'video/quicktime',
673    MP3  => 'audio/mpeg',
674    MP4  => 'video/mp4',
675    MPC  => 'audio/x-musepack',
676    MPEG => 'video/mpeg',
677    MRW  => 'image/x-minolta-mrw',
678    MXF  => 'application/mxf',
679    NEF  => 'image/x-nikon-nef',
680    NRW  => 'image/x-nikon-nrw',
681    NUMBERS => 'application/x-iwork-numbers-sffnumbers',
682    ODB  => 'application/vnd.oasis.opendocument.database',
683    ODC  => 'application/vnd.oasis.opendocument.chart',
684    ODF  => 'application/vnd.oasis.opendocument.formula',
685    ODG  => 'application/vnd.oasis.opendocument.graphics',
686    ODI  => 'application/vnd.oasis.opendocument.image',
687    ODP  => 'application/vnd.oasis.opendocument.presentation',
688    ODS  => 'application/vnd.oasis.opendocument.spreadsheet',
689    ODT  => 'application/vnd.oasis.opendocument.text',
690    OGG  => 'audio/ogg',
691    OGV  => 'video/ogg',
692    ONP  => 'application/on1',
693    ORF  => 'image/x-olympus-orf',
694    OTF  => 'application/x-font-otf',
695    PAGES=> 'application/x-iwork-pages-sffpages',
696    PBM  => 'image/x-portable-bitmap',
697    PCD  => 'image/x-photo-cd',
698    PCX  => 'image/pcx',
699    PDB  => 'application/vnd.palm',
700    PDF  => 'application/pdf',
701    PEF  => 'image/x-pentax-pef',
702    PFA  => 'application/x-font-type1', # (needed if handled by PostScript module)
703    PGF  => 'image/pgf',
704    PGM  => 'image/x-portable-graymap',
705    PHP  => 'application/x-httpd-php',
706    PICT => 'image/pict',
707    PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time)
708    PMP  => 'image/x-sony-pmp', #PH (NC)
709    PNG  => 'image/png',
710    POT  => 'application/vnd.ms-powerpoint',
711    POTM => 'application/vnd.ms-powerpoint.template.macroEnabled',
712    POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template',
713    PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled',
714    PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented)
715    PPM  => 'image/x-portable-pixmap',
716    PPS  => 'application/vnd.ms-powerpoint',
717    PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled',
718    PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow',
719    PPT  => 'application/vnd.ms-powerpoint',
720    PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled',
721    PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation',
722    PS   => 'application/postscript',
723    PSD  => 'application/vnd.adobe.photoshop',
724    PSP  => 'image/x-paintshoppro', #(NC)
725    QTIF => 'image/x-quicktime',
726    R3D  => 'video/x-red-r3d', #PH (invented)
727    RA   => 'audio/x-pn-realaudio',
728    RAF  => 'image/x-fujifilm-raf',
729    RAM  => 'audio/x-pn-realaudio',
730    RAR  => 'application/x-rar-compressed',
731    RAW  => 'image/x-raw',
732    RM   => 'application/vnd.rn-realmedia',
733    RMVB => 'application/vnd.rn-realmedia-vbr',
734    RPM  => 'audio/x-pn-realaudio-plugin',
735    RSRC => 'application/ResEdit',
736    RTF  => 'text/rtf',
737    RV   => 'video/vnd.rn-realvideo',
738    RW2  => 'image/x-panasonic-rw2',
739    RWL  => 'image/x-leica-rwl',
740    RWZ  => 'image/x-rawzor', #(duplicated in Rawzor.pm)
741    SEQ  => 'image/x-flir-seq', #PH (NC)
742    SKETCH => 'application/sketch',
743    SR2  => 'image/x-sony-sr2',
744    SRF  => 'image/x-sony-srf',
745    SRW  => 'image/x-samsung-srw',
746    SVG  => 'image/svg+xml',
747    SWF  => 'application/x-shockwave-flash',
748    TAR  => 'application/x-tar',
749    THMX => 'application/vnd.ms-officetheme',
750    TIFF => 'image/tiff',
751    Torrent => 'application/x-bittorrent',
752    TTC  => 'application/x-font-ttf',
753    TTF  => 'application/x-font-ttf',
754    TXT  => 'text/plain',
755    VCard=> 'text/vcard',
756    VRD  => 'application/octet-stream', #PH (NC)
757    VSD  => 'application/x-visio',
758    WDP  => 'image/vnd.ms-photo',
759    WEBM => 'video/webm',
760    WMA  => 'audio/x-ms-wma',
761    WMF  => 'application/x-wmf',
762    WMV  => 'video/x-ms-wmv',
763    WTV  => 'video/x-ms-wtv',
764    X3F  => 'image/x-sigma-x3f',
765    XCF  => 'image/x-xcf',
766    XLA  => 'application/vnd.ms-excel',
767    XLAM => 'application/vnd.ms-excel.addin.macroEnabled',
768    XLS  => 'application/vnd.ms-excel',
769    XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled',
770    XLSM => 'application/vnd.ms-excel.sheet.macroEnabled',
771    XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
772    XLT  => 'application/vnd.ms-excel',
773    XLTM => 'application/vnd.ms-excel.template.macroEnabled',
774    XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template',
775    XML  => 'application/xml',
776    XMP  => 'application/rdf+xml',
777    ZIP  => 'application/zip',
778);
779
780# module names for processing routines of each file type
781# - undefined entries default to same module name as file type
782# - module name '' defaults to Image::ExifTool
783# - module name '0' indicates a recognized but unsupported file
784my %moduleName = (
785    AA   => 'Audible',
786    ALIAS=> 0,
787    AVC  => 0,
788    BTF  => 'BigTIFF',
789    BZ2  => 0,
790    CRW  => 'CanonRaw',
791    CHM  => 'EXE',
792    COS  => 'CaptureOne',
793    CZI  => 'ZISRAW',
794    DEX  => 0,
795    DOCX => 'OOXML',
796    DCX  => 0,
797    DR4  => 'CanonVRD',
798    DSS  => 'Olympus',
799    DWF  => 0,
800    DWG  => 0,
801    EPS  => 'PostScript',
802    EXIF => '',
803    EXR  => 'OpenEXR',
804    EXV  => '',
805    ICC  => 'ICC_Profile',
806    IND  => 'InDesign',
807    FLV  => 'Flash',
808    FPF  => 'FLIR',
809    FPX  => 'FlashPix',
810    GZIP => 'ZIP',
811    HDR  => 'Radiance',
812    JP2  => 'Jpeg2000',
813    JPEG => '',
814    LFP  => 'Lytro',
815    LRI  => 0,
816    MOV  => 'QuickTime',
817    MKV  => 'Matroska',
818    MP3  => 'ID3',
819    MRW  => 'MinoltaRaw',
820    OGG  => 'Ogg',
821    ORF  => 'Olympus',
822    PDB  => 'Palm',
823    PCD  => 'PhotoCD',
824    PHP  => 0,
825    PMP  => 'Sony',
826    PS   => 'PostScript',
827    PSD  => 'Photoshop',
828    QTIF => 'QuickTime',
829    R3D  => 'Red',
830    RAF  => 'FujiFilm',
831    RAR  => 'ZIP',
832    RAW  => 'KyoceraRaw',
833    RWZ  => 'Rawzor',
834    SWF  => 'Flash',
835    TAR  => 0,
836    TIFF => '',
837    TXT  => 'Text',
838    VRD  => 'CanonVRD',
839    WMF  => 0,
840    X3F  => 'SigmaRaw',
841    XCF  => 'GIMP',
842);
843
844$testLen = 1024;    # number of bytes to read when testing for magic number
845
846# quick "magic number" file test used to avoid loading module unnecessarily:
847# - regular expression evaluated on first $testLen bytes of file
848# - must match beginning at first byte in file
849# - this test must not be more stringent than module logic
850%magicNumber = (
851    AA   => '.{4}\x57\x90\x75\x36',
852    AIFF => '(FORM....AIF[FC]|AT&TFORM)',
853    ALIAS=> "book\0\0\0\0mark\0\0\0\0",
854    APE  => '(MAC |APETAGEX|ID3)',
855    ASF  => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c',
856    AVC  => '\+A\+V\+C\+',
857    Torrent => 'd\d+:\w+',
858    BMP  => 'BM',
859    BPG  => "BPG\xfb",
860    BTF  => '(II\x2b\0|MM\0\x2b)',
861    BZ2  => 'BZh[1-9]\x31\x41\x59\x26\x53\x59',
862    CHM  => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec',
863    CRW  => '(II|MM).{4}HEAP(CCDR|JPGM)',
864    CZI  => 'ZISRAWFILE\0{6}',
865    DCX  => '\xb1\x68\xde\x3a',
866    DEX  => "dex\n035\0",
867    DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)',
868    DOCX => 'PK\x03\x04',
869    DPX  => '(SDPX|XPDS)',
870    DR4  => 'IIII\x04\0\x04\0',
871    DSS  => '(\x02dss|\x03ds2)',
872    DV   => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized)
873    DWF  => '\(DWF V\d',
874    DWG  => 'AC10\d{2}\0',
875    EPS  => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
876    EXE  => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)',
877    EXIF => '(II\x2a\0|MM\0\x2a)',
878    EXR  => '\x76\x2f\x31\x01',
879    EXV  => '\xff\x01Exiv2',
880    FITS => 'SIMPLE  = {20}T',
881    FLAC => '(fLaC|ID3)',
882    FLIF => 'FLIF[0-\x6f][0-2]',
883    FLIR => '[AF]FF\0',
884    FLV  => 'FLV\x01',
885    Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' .
886            '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])',
887    FPF  => 'FPF Public Image Format\0',
888    FPX  => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1',
889    GIF  => 'GIF8[79]a',
890    GZIP => '\x1f\x8b\x08',
891    HDR  => '#\?(RADIANCE|RGBE)\x0a',
892    HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive)
893    ICC  => '.{12}(scnr|mntr|prtr|link|spac|abst|nmcl|nkpf)(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR){2}',
894    IND  => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d',
895  # ISO  =>  signature is at byte 32768
896    ITC  => '.{4}itch',
897    JP2  => '(\0\0\0\x0cjP(  |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)',
898    JPEG => '\xff\xd8\xff',
899    JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:',
900    LFP  => '\x89LFP\x0d\x0a\x1a\x0a',
901    LNK  => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46',
902    LRI  => 'LELR \0',
903    M2TS => '(....)?\x47',
904    MIE  => '~[\x10\x18]\x04.0MIE',
905    MIFF => 'id=ImageMagick',
906    MKV  => '\x1a\x45\xdf\xa3',
907    MOV  => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!)
908  # MP3  =>  difficult to rule out
909    MPC  => '(MP\+|ID3)',
910    MOI  => 'V6',
911    MPEG => '\0\0\x01[\xb0-\xbf]',
912    MRW  => '\0MR[MI]',
913    MXF  => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized)
914    OGG  => '(OggS|ID3)',
915    ORF  => '(II|MM)',
916    PDB  => '.{60}(\.pdfADBE|TEXtREAd|BVokBDIC|DB99DBOS|PNRdPPrs|DataPPrs|vIMGView|PmDBPmDB|InfoINDB|ToGoToGo|SDocSilX|JbDbJBas|JfDbJFil|DATALSdb|Mdb1Mdb1|BOOKMOBI|DataPlkr|DataSprd|SM01SMem|TEXtTlDc|InfoTlIf|DataTlMl|DataTlPt|dataTDBP|TdatTide|ToRaTRPW|zTXTGPlm|BDOCWrdS)',
917  # PCD  =>  signature is at byte 2048
918    PCX  => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]',
919    PDF  => '\s*%PDF-\d+\.\d+',
920    PGF  => 'PGF',
921    PHP  => '<\?php\s',
922    PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)',
923    PLIST=> '(bplist0|\s*<|\xfe\xff\x00)',
924    PMP  => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb',
925    PNG  => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n',
926    PPM  => 'P[1-6]\s+',
927    PS   => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
928    PSD  => '8BPS\0[\x01\x02]',
929    PSP  => 'Paint Shop Pro Image File\x0a\x1a\0{5}',
930    QTIF => '.{4}(idsc|idat|iicc)',
931    R3D  => '\0\0..RED(1|2)',
932    RAF  => 'FUJIFILM',
933    RAR  => 'Rar!\x1a\x07\0',
934    RAW  => '(.{25}ARECOYK|II|MM)',
935    Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)',
936    RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants
937    RSRC => '(....)?\0\0\x01\0',
938    RTF  => '[\n\r]*\\{[\n\r]*\\\\rtf',
939    RWZ  => 'rawzor',
940    SWF  => '[FC]WS[^\0]',
941    TAR  => '.{257}ustar(  )?\0', # (this doesn't catch old-style tar files)
942    TXT  => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)',
943    TIFF => '(II|MM)', # don't test magic number (some raw formats are different)
944    VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n',
945    VRD  => 'CANON OPTIONAL DATA\0',
946    WMF  => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)',
947    WTV  => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d',
948    X3F  => 'FOVb',
949    MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X        ',
950    XCF  => 'gimp xcf ',
951    XMP  => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<',
952    ZIP  => 'PK\x03\x04',
953);
954
955# file types with weak magic number recognition
956my %weakMagic = ( MP3 => 1 );
957
958# file types that are determined by the process proc when FastScan == 3
959# (when done, the process proc must exit after SetFileType if FastScan is 3)
960my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT);
961
962# Compact/XMPShorthand option settings
963my %compactOpt = (
964    nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline',
965    shorthand => 'Shorthand', onedesc => 'OneDesc',
966    all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'],
967    allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'],
968    # aliases to cover anticipated user typos
969    nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent',
970    nopad => 'NoPadding', onedescr => 'OneDesc',
971    # allow numerical settings for backward compatibility
972    0 => 'None',
973    1 => 'NoPadding',
974    2 => ['NoPadding','NoIndent'],
975    3 => ['NoPadding','NoIndent','OneDesc'],
976    4 => ['NoPadding','NoIndent','OneDesc','NoNewline'],
977    5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'],
978);
979my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] );
980
981# lookup for valid character set names (keys are all lower case)
982%charsetName = (
983    #   Charset setting                       alias(es)
984    # -------------------------   --------------------------------------------
985    utf8        => 'UTF8',        cp65001 => 'UTF8', 'utf-8' => 'UTF8',
986    latin       => 'Latin',       cp1252  => 'Latin', latin1 => 'Latin',
987    latin2      => 'Latin2',      cp1250  => 'Latin2',
988    cyrillic    => 'Cyrillic',    cp1251  => 'Cyrillic', russian => 'Cyrillic',
989    greek       => 'Greek',       cp1253  => 'Greek',
990    turkish     => 'Turkish',     cp1254  => 'Turkish',
991    hebrew      => 'Hebrew',      cp1255  => 'Hebrew',
992    arabic      => 'Arabic',      cp1256  => 'Arabic',
993    baltic      => 'Baltic',      cp1257  => 'Baltic',
994    vietnam     => 'Vietnam',     cp1258  => 'Vietnam',
995    thai        => 'Thai',        cp874   => 'Thai',
996    doslatinus  => 'DOSLatinUS',  cp437   => 'DOSLatinUS',
997    doslatin1   => 'DOSLatin1',   cp850   => 'DOSLatin1',
998    doscyrillic => 'DOSCyrillic', cp866   => 'DOSCyrillic',
999    macroman    => 'MacRoman',    cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman',
1000    maclatin2   => 'MacLatin2',   cp10029 => 'MacLatin2',
1001    maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic',
1002    macgreek    => 'MacGreek',    cp10006 => 'MacGreek',
1003    macturkish  => 'MacTurkish',  cp10081 => 'MacTurkish',
1004    macromanian => 'MacRomanian', cp10010 => 'MacRomanian',
1005    maciceland  => 'MacIceland',  cp10079 => 'MacIceland',
1006    maccroatian => 'MacCroatian', cp10082 => 'MacCroatian',
1007);
1008
1009# default family 0 group priority for writing
1010# (NOTE: tags in groups not specified here will not be written unless
1011#  overridden by the module or specified when writing)
1012my @defaultWriteGroups = qw(
1013    EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe
1014);
1015
1016# group hash for ExifTool-generated tags
1017my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' );
1018
1019# special tag names (not used for tag info)
1020%specialTags = map { $_ => 1 } qw(
1021    TABLE_NAME       SHORT_NAME  PROCESS_PROC  WRITE_PROC  CHECK_PROC
1022    GROUPS           FORMAT      FIRST_ENTRY   TAG_PREFIX  PRINT_CONV
1023    WRITABLE         TABLE_DESC  NOTES         IS_OFFSET   IS_SUBDIR
1024    EXTRACT_UNKNOWN  NAMESPACE   PREFERRED     SRC_TABLE   PRIORITY
1025    AVOID            WRITE_GROUP LANG_INFO     VARS        DATAMEMBER
1026    SET_GROUP1       PERMANENT   INIT_TABLE
1027);
1028
1029# headers for various segment types
1030$exifAPP1hdr = "Exif\0\0";
1031$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0";
1032$xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0";
1033$psAPP13hdr = "Photoshop 3.0\0";
1034$psAPP13old = 'Adobe_Photoshop2.5:';
1035
1036sub DummyWriteProc { return 1; }
1037
1038# lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses
1039%Image::ExifTool::userLens = ( );
1040
1041# queued plug-in tags to add to lookup
1042@Image::ExifTool::pluginTags = ( );
1043%Image::ExifTool::pluginTags = ( );
1044
1045my %systemTagsNotes = (
1046    Notes => q{
1047        extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
1048        option is set
1049    },
1050);
1051
1052# tag information for preview image -- this should be used for all
1053# PreviewImage tags so they are handled properly when reading/writing
1054%Image::ExifTool::previewImageTagInfo = (
1055    Name => 'PreviewImage',
1056    Writable => 'undef',
1057    # a value of 'none' is ok...
1058    WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)',
1059    DataTag => 'PreviewImage',
1060    # accept either scalar or scalar reference
1061    RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
1062    # we allow preview image to be set to '', but we don't want a zero-length value
1063    # in the IFD, so set it temporarily to 'none'.  Note that the length is <= 4,
1064    # so this value will fit in the IFD so the preview fixup won't be generated.
1065    ValueConvInv => '$val eq "" and $val="none"; $val',
1066);
1067
1068# extra tags that aren't truly EXIF tags, but are generated by the script
1069# Note: any tag in this list with a name corresponding to a Group0 name is
1070#       used to write the entire corresponding directory as a block.
1071%Image::ExifTool::Extra = (
1072    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
1073    VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
1074    WRITE_PROC => \&DummyWriteProc,
1075    Error   => {
1076        Priority => 0,
1077        Groups => \%allGroupsExifTool,
1078        Notes => q{
1079            returns errors that may have occurred while reading or writing a file.  Any
1080            Error will prevent the file from being processed.  Minor errors may be
1081            downgraded to warnings with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors> option
1082        },
1083    },
1084    Warning => {
1085        Priority => 0,
1086        Groups => \%allGroupsExifTool,
1087        Notes => q{
1088            returns warnings that may have occurred while reading or writing a file.
1089            Use the -a or L<Duplicates|../ExifTool.html#Duplicates> option to see all warnings if more than one
1090            occurred. Minor warnings may be ignored with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors>
1091            option.  Minor warnings with a capital "M" in the "[Minor]" designation
1092            indicate that the processing is affected by ignoring the warning
1093        },
1094    },
1095    Comment => {
1096        Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image',
1097        Writable => 1,
1098        WriteGroup => 'Comment',
1099        Priority => 0,  # to preserve order of JPEG COM segments
1100    },
1101    Directory => {
1102        Groups => { 1 => 'System', 2 => 'Other' },
1103        Notes => q{
1104            the directory of the file as specified in the call to ExifTool, or "." if no
1105            directory was specified.  May be written to move the file to another
1106            directory that will be created if doesn't already exist
1107        },
1108        Writable => 1,
1109        WritePseudo => 1,
1110        DelCheck => q{"Can't delete"},
1111        Protected => 1,
1112        RawConv => '$self->ConvertFileName($val)',
1113        # translate backslashes in directory names and add trailing '/'
1114        ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_',
1115    },
1116    FileName => {
1117        Groups => { 1 => 'System', 2 => 'Other' },
1118        Writable => 1,
1119        WritePseudo => 1,
1120        DelCheck => q{"Can't delete"},
1121        Protected => 1,
1122        Notes => q{
1123            may be written with a full path name to set FileName and Directory in one
1124            operation.  This is such a powerful feature that a TestName tag is provided
1125            to allow dry-run tests before actually writing the file name.  See
1126            L<filename.html|../filename.html> for more information on writing the
1127            FileName, Directory and TestName tags
1128        },
1129        RawConv => '$self->ConvertFileName($val)',
1130        ValueConvInv => '$self->InverseFileName($val)',
1131    },
1132    FilePath => {
1133        Groups => { 1 => 'System', 2 => 'Other' },
1134        Notes => q{
1135            absolute path of source file. Not generated unless specifically requested or
1136            the L<RequestAll|../ExifTool.html#RequestAll> API option is set.  Does not support Windows Unicode file
1137            names
1138        },
1139    },
1140    TestName => {
1141        Writable => 1,
1142        WritePseudo => 1,
1143        DelCheck => q{"Can't delete"},
1144        Protected => 1,
1145        WriteOnly => 1,
1146        Notes => q{
1147            this write-only tag may be used instead of FileName for dry-run tests of the
1148            file renaming feature.  Writing this tag prints the old and new file names
1149            to the console, but does not affect the file itself
1150        },
1151        ValueConvInv => '$self->InverseFileName($val)',
1152    },
1153    FileSequence => {
1154        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
1155        Notes => q{
1156            sequence number for each source file when extracting or copying information,
1157            including files that fail the -if condition of the command-line application,
1158            beginning at 0 for the first file.  Not generated unless specifically
1159            requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set
1160        },
1161    },
1162    FileSize => {
1163        Groups => { 1 => 'System', 2 => 'Other' },
1164        Notes => q{
1165            note that the print conversion for this tag uses historic prefixes: 1 kB =
1166            1024 bytes, etc.
1167        },
1168        PrintConv => \&ConvertFileSize,
1169    },
1170    ResourceForkSize => {
1171        Groups => { 1 => 'System', 2 => 'Other' },
1172        Notes => q{
1173            size of the file's resource fork if it contains data.  Mac OS only.  If this
1174            tag is generated the L<ExtractEmbedded|../ExifTool.html#ExtractEmbedded> option may be used to extract
1175            resource-fork information as a sub-document.  When writing, the resource
1176            fork is preserved by default, but it may be deleted with C<-rsrc:all=> on
1177            the command line
1178        },
1179        PrintConv => \&ConvertFileSize,
1180    },
1181    FileType => {
1182        Groups => { 2 => 'Other' },
1183        Notes => q{
1184            a short description of the file type.  For many file types this is the just
1185            the uppercase file extension
1186        },
1187    },
1188    FileTypeExtension => {
1189        Groups => { 2 => 'Other' },
1190        Notes => q{
1191            a common lowercase extension for this file type, or uppercase with the -n
1192            option
1193        },
1194        PrintConv => 'lc $val',
1195    },
1196    FileModifyDate => {
1197        Description => 'File Modification Date/Time',
1198        Notes => q{
1199            the filesystem modification date/time.  Note that ExifTool may not be able
1200            to handle filesystem dates before 1970 depending on the limitations of the
1201            system's standard libraries
1202        },
1203        Groups => { 1 => 'System', 2 => 'Time' },
1204        Writable => 1,
1205        WritePseudo => 1,
1206        DelCheck => q{"Can't delete"},
1207        # all writable pseudo-tags must be protected so -tagsfromfile fails with
1208        # unrecognized files unless a pseudo tag is specified explicitly
1209        Protected => 1,
1210        Shift => 'Time',
1211        ValueConv => 'ConvertUnixTime($val,1)',
1212        ValueConvInv => 'GetUnixTime($val,1)',
1213        PrintConv => '$self->ConvertDateTime($val)',
1214        PrintConvInv => '$self->InverseDateTime($val)',
1215    },
1216    FileAccessDate => {
1217        Description => 'File Access Date/Time',
1218        Notes => q{
1219            the date/time of last access of the file.  Note that this access time is
1220            updated whenever any software, including ExifTool, reads the file
1221        },
1222        Groups => { 1 => 'System', 2 => 'Time' },
1223        ValueConv => 'ConvertUnixTime($val,1)',
1224        PrintConv => '$self->ConvertDateTime($val)',
1225    },
1226    FileCreateDate => {
1227        Description => 'File Creation Date/Time',
1228        Notes => q{
1229            the filesystem creation date/time.  Windows/Mac only.  In Windows, the file
1230            creation date/time is preserved by default when writing if Win32API::File
1231            and Win32::API are available.  On Mac, this tag is extracted only if it or
1232            the MacOS group is specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is
1233            set to 2 or higher.  Requires "setfile" for writing on Mac, which may be
1234            installed by typing C<xcode-select --install> in the Terminal
1235        },
1236        Groups => { 1 => 'System', 2 => 'Time' },
1237        Writable => 1,
1238        WritePseudo => 1,
1239        DelCheck => q{"Can't delete"},
1240        Protected => 1, # all writable pseudo-tags must be protected!
1241        Shift => 'Time',
1242        ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)',
1243        ValueConvInv => q{
1244            return GetUnixTime($val,1) if $^O eq 'MSWin32';
1245            return $val if $^O eq 'darwin';
1246            warn "This tag is Windows/Mac only\n";
1247            return undef;
1248        },
1249        PrintConv => '$self->ConvertDateTime($val)',
1250        PrintConvInv => '$self->InverseDateTime($val)',
1251    },
1252    FileInodeChangeDate => {
1253        Description => 'File Inode Change Date/Time',
1254        Notes => q{
1255            the date/time when the file's directory information was last changed.
1256            Non-Windows systems only
1257        },
1258        Groups => { 1 => 'System', 2 => 'Time' },
1259        ValueConv => 'ConvertUnixTime($val,1)',
1260        PrintConv => '$self->ConvertDateTime($val)',
1261    },
1262    FilePermissions => {
1263        Groups => { 1 => 'System', 2 => 'Other' },
1264        Notes => q{
1265            r=read, w=write and x=execute permissions for the file owner, group and
1266            others.  The ValueConv value is an octal number so bit test operations on
1267            this value should be done in octal, eg. 'oct($filePermissions#) & 0200'
1268        },
1269        Writable => 1,
1270        WritePseudo => 1,
1271        DelCheck => q{"Can't delete"},
1272        Protected => 1, # all writable pseudo-tags must be protected!
1273        ValueConv => 'sprintf("%.3o", $val & 0777)',
1274        ValueConvInv => 'oct($val)',
1275        PrintConv => sub {
1276            my ($mask, $str, $val) = (0400, '', oct(shift));
1277            while ($mask) {
1278                foreach (qw(r w x)) {
1279                    $str .= $val & $mask ? $_ : '-';
1280                    $mask >>= 1;
1281                }
1282            }
1283            return $str;
1284        },
1285        PrintConvInv => sub {
1286            my ($bit, $val, $str) = (8, 0, shift);
1287            return undef if length($str) != 9;
1288            while ($bit >= 0) {
1289                foreach (qw(r w x)) {
1290                    $val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_;
1291                    --$bit;
1292                }
1293            }
1294            return sprintf('%.3o', $val);
1295        },
1296    },
1297    FileAttributes => {
1298        Groups => { 1 => 'System', 2 => 'Other' },
1299        Notes => q{
1300            extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
1301            option is set.  2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows
1302            attribute bits if Win32API::File is available
1303        },
1304        PrintHex => 1,
1305        PrintConvColumns => 2,
1306        PrintConv => [{ # stat device types (bitmask 0xf000)
1307            0x0000 => 'Unknown',
1308            0x1000 => 'FIFO',
1309            0x2000 => 'Character',
1310            0x3000 => 'Mux Character',
1311            0x4000 => 'Directory',
1312            0x5000 => 'XENIX Named',
1313            0x6000 => 'Block',
1314            0x7000 => 'Mux Block',
1315            0x8000 => 'Regular',
1316            0x9000 => 'VxFS Compressed',
1317            0xa000 => 'Symbolic Link',
1318            0xb000 => 'Solaris Shadow Inode',
1319            0xc000 => 'Socket',
1320            0xd000 => 'Solaris Door',
1321            0xe000 => 'BSD Whiteout',
1322        },{ BITMASK => { # stat attribute bits (bitmask 0x0e00)
1323            9 => 'Sticky',
1324            10 => 'Set Group ID',
1325            11 => 'Set User ID',
1326        }},{ BITMASK => { # Windows attribute bits
1327            0 => 'Read Only',
1328            1 => 'Hidden',
1329            2 => 'System',
1330            3 => 'Volume Label',
1331            4 => 'Directory',
1332            5 => 'Archive',
1333            6 => 'Device',
1334            7 => 'Normal',
1335            8 => 'Temporary',
1336            9 => 'Sparse File',
1337            10 => 'Reparse Point',
1338            11 => 'Compressed',
1339            12 => 'Offline',
1340            13 => 'Not Content Indexed',
1341            14 => 'Encrypted',
1342        }}],
1343    },
1344    FileDeviceID => {
1345        Groups => { 1 => 'System', 2 => 'Other' },
1346        %systemTagsNotes,
1347        PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor)
1348    },
1349    FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
1350    FileInodeNumber  => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
1351    FileHardLinks    => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
1352    FileUserID => {
1353        Groups => { 1 => 'System', 2 => 'Other' },
1354        Notes => q{
1355            extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
1356            option is set.  Returns user ID number with the -n option, or name
1357            otherwise.  May be written with either user name or number
1358        },
1359        Writable => 1,
1360        WritePseudo => 1,
1361        DelCheck => q{"Can't delete"},
1362        Protected => 1, # all writable pseudo-tags must be protected!
1363        PrintConv => 'eval { getpwuid($val) } || $val',
1364        PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)',
1365    },
1366    FileGroupID => {
1367        Groups => { 1 => 'System', 2 => 'Other' },
1368        Notes => q{
1369            extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
1370            option is set.  Returns group ID number with the -n option, or name
1371            otherwise.  May be written with either group name or number
1372        },
1373        Writable => 1,
1374        WritePseudo => 1,
1375        DelCheck => q{"Can't delete"},
1376        Protected => 1, # all writable pseudo-tags must be protected!
1377        PrintConv => 'eval { getgrgid($val) } || $val',
1378        PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)',
1379    },
1380    FileBlockSize    => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
1381    FileBlockCount   => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
1382    HardLink => {
1383        Writable => 1,
1384        DelCheck => q{"Can't delete"},
1385        WriteOnly => 1,
1386        WritePseudo => 1,
1387        Protected => 1,
1388        Notes => q{
1389            this write-only tag is used to create a hard link with the specified name to
1390            the source file.  If the source file is edited, copied, renamed or moved in
1391            the same operation as writing HardLink, then the link is made to the updated
1392            file.  Note that subsequent editing of either hard-linked file by exiftool
1393            will break the link unless the -overwrite_original_in_place option is used
1394        },
1395        ValueConvInv => '$val=~tr/\\\\/\//; $val',
1396    },
1397    SymLink => {
1398        Writable => 1,
1399        DelCheck => q{"Can't delete"},
1400        WriteOnly => 1,
1401        WritePseudo => 1,
1402        Protected => 1,
1403        Notes => q{
1404            this write-only tag is used to create a symbolic link with the specified
1405            name to the source file.  If the source file is edited, copied, renamed or
1406            moved in the same operation as writing SymLink, then the link is made to the
1407            updated file.  The link uses an absolute path unless it is created in the
1408            current working directory.  Valid only for file systems that support
1409            symbolic links.  Note that subsequent editing of the file via the symbolic
1410            link by exiftool will cause the link to be replaced by the edited file
1411            without changing the original unless the -overwrite_original_in_place option
1412            is used
1413        },
1414        ValueConvInv => '$val=~tr/\\\\/\//; $val',
1415    },
1416    MIMEType    => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } },
1417    ImageWidth  => { Notes => 'the width of the image in number of pixels' },
1418    ImageHeight => { Notes => 'the height of the image in number of pixels' },
1419    XResolution => { Notes => 'the horizontal pixel resolution' },
1420    YResolution => { Notes => 'the vertical pixel resolution' },
1421    MaxVal      => { Notes => 'maximum pixel value in PPM or PGM image' },
1422    EXIF => {
1423        Notes => q{
1424            the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag
1425            is generated only if specifically requested
1426        },
1427        Groups => { 0 => 'EXIF', 1 => 'EXIF' },
1428        Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'],
1429        WriteCheck => q{
1430            return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/;
1431            return 'Invalid EXIF data';
1432        },
1433    },
1434    IPTC => {
1435        Notes => q{
1436            the full IPTC data block.  This tag is generated only if specifically
1437            requested
1438        },
1439        Groups => { 0 => 'IPTC', 1 => 'IPTC' },
1440        Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'],
1441        Priority => 0,  # so main IPTC (which hopefully comes first) takes priority
1442        WriteCheck => q{
1443            return undef if $val =~ /^(\x1c|\0+$)/;
1444            return 'Invalid IPTC data';
1445        },
1446    },
1447    XMP => {
1448        Notes => q{
1449            the XMP data block, but note that extended XMP in JPEG images may be split
1450            into multiple blocks.  This tag is generated only if specifically requested
1451        },
1452        Groups => { 0 => 'XMP', 1 => 'XMP' },
1453        Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'],
1454        Priority => 0,  # so main xmp (which usually comes first) takes priority
1455        WriteCheck => q{
1456            require Image::ExifTool::XMP;
1457            return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val);
1458        },
1459    },
1460    XML => {
1461        Notes => 'the XML data block, extracted for some file types',
1462        Groups => { 0 => 'XML', 1 => 'XML' },
1463        Binary => 1,
1464    },
1465    ICC_Profile => {
1466        Notes => q{
1467            the full ICC_Profile data block.  This tag is generated only if specifically
1468            requested
1469        },
1470        Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' },
1471        Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'],
1472        WriteCheck => q{
1473            require Image::ExifTool::ICC_Profile;
1474            return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
1475        },
1476    },
1477    CanonVRD => {
1478        Notes => q{
1479            the full Canon DPP VRD trailer block.  This tag is generated only if
1480            specifically requested
1481        },
1482        Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
1483        Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'],
1484        Permanent => 0, # (this is 1 by default for MakerNotes tags)
1485        WriteCheck => q{
1486            return undef if $val =~ /^CANON OPTIONAL DATA\0/;
1487            return 'Invalid CanonVRD data';
1488        },
1489    },
1490    CanonDR4 => {
1491        Notes => q{
1492            the full Canon DPP version 4 DR4 block.  This tag is generated only if
1493            specifically requested
1494        },
1495        Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
1496        Flags => ['Writable' ,'Protected', 'Binary'],
1497        Permanent => 0, # (this is 1 by default for MakerNotes tags)
1498        WriteCheck => q{
1499            return undef if $val =~ /^IIII\x04\0\x04\0/;
1500            return 'Invalid CanonDR4 data';
1501        },
1502    },
1503    Adobe => {
1504        Notes => q{
1505            the JPEG APP14 Adobe segment.  Extracted only if specified. See the
1506            L<JPEG Adobe Tags|JPEG.html#Adobe> for more information
1507        },
1508        Groups => { 0 => 'APP14', 1 => 'Adobe' },
1509        WriteGroup => 'Adobe',
1510        Flags => ['Writable' ,'Protected', 'Binary'],
1511    },
1512    CurrentIPTCDigest => {
1513        Notes => q{
1514            MD5 digest of existing IPTC data.  All zeros if IPTC exists but Digest::MD5
1515            is not installed.  Only calculated for IPTC in the standard location as
1516            specified by the L<MWG|http://www.metadataworkinggroup.org/>.  ExifTool
1517            automates the handling of this tag in the MWG module -- see the
1518            L<MWG Composite Tags|MWG.html> for details
1519        },
1520        ValueConv => 'unpack("H*", $val)',
1521    },
1522    PreviewImage => {
1523        Notes => 'JPEG-format embedded preview image',
1524        Groups => { 2 => 'Preview' },
1525        Writable => 1,
1526        WriteCheck => '$self->CheckImage(\$val)',
1527        WriteGroup => 'All',
1528        # can't delete, so set to empty string and return no error
1529        DelCheck => '$val = ""; return undef',
1530        # accept either scalar or scalar reference
1531        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
1532    },
1533    ThumbnailImage => {
1534        Groups => { 2 => 'Preview' },
1535        Notes => 'JPEG-format embedded thumbnail image',
1536        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
1537    },
1538    OtherImage => {
1539        Groups => { 2 => 'Preview' },
1540        Notes => 'other JPEG-format embedded image',
1541        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
1542    },
1543    PreviewPNG => {
1544        Groups => { 2 => 'Preview' },
1545        Notes => 'PNG-format embedded preview image',
1546        Binary => 1,
1547    },
1548    PreviewWMF => {
1549        Groups => { 2 => 'Preview' },
1550        Notes => 'WMF-format embedded preview image',
1551        Binary => 1,
1552    },
1553    PreviewTIFF => {
1554        Groups => { 2 => 'Preview' },
1555        Notes => 'TIFF-format embedded preview image',
1556        Binary => 1,
1557    },
1558    PreviewPDF => {
1559        Groups => { 2 => 'Preview' },
1560        Notes => 'PDF-format embedded preview image',
1561        Binary => 1,
1562    },
1563    ExifByteOrder => {
1564        Writable => 1,
1565        DelCheck => q{"Can't delete"},
1566        Notes => q{
1567            represents the byte order of EXIF information.  May be written to set the
1568            byte order only for newly created EXIF segments
1569        },
1570        PrintConv => {
1571            II => 'Little-endian (Intel, II)',
1572            MM => 'Big-endian (Motorola, MM)',
1573        },
1574    },
1575    ExifUnicodeByteOrder => {
1576        Writable => 1,
1577        WriteOnly => 1,
1578        DelCheck => q{"Can't delete"},
1579        Notes => q{
1580            specifies the byte order to use when writing EXIF Unicode text.  The EXIF
1581            specification is particularly vague about this byte ordering, and different
1582            applications use different conventions.  By default ExifTool writes Unicode
1583            text in EXIF byte order, but this write-only tag may be used to force a
1584            specific order.  Applies to the EXIF UserComment tag when writing special
1585            characters
1586        },
1587        PrintConv => {
1588            II => 'Little-endian (Intel, II)',
1589            MM => 'Big-endian (Motorola, MM)',
1590        },
1591    },
1592    ExifToolVersion => {
1593        Description => 'ExifTool Version Number',
1594        Groups => \%allGroupsExifTool,
1595        Notes => 'the version of ExifTool currently running',
1596    },
1597    ProcessingTime => {
1598        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
1599        Notes => q{
1600            the clock time in seconds taken by ExifTool to extract information from this
1601            file.  Not generated unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API
1602            option is set.  Requires Time::HiRes
1603        },
1604        PrintConv => 'sprintf("%.3g s", $val)',
1605    },
1606    RAFVersion => { Notes => 'RAF file version number' },
1607    JPEGDigest => {
1608        Notes => q{
1609            an MD5 digest of the JPEG quantization tables is combined with the component
1610            sub-sampling values to generate the value of this tag.  The result is
1611            compared to known values in an attempt to deduce the originating software
1612            based only on the JPEG image data.  For performance reasons, this tag is
1613            generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set
1614            to 3 or higher
1615        },
1616    },
1617    JPEGQualityEstimate => {
1618        Notes => q{
1619            an estimate of the IJG JPEG quality setting for the image, calculated from
1620            the quantization tables.  For performance reasons, this tag is generated
1621            only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set to 3 or
1622            higher
1623        },
1624    },
1625    JPEGImageLength => {
1626        Notes => q{
1627            byte length of JPEG image without metadata.  For performance reasons, this
1628            tag is generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option
1629            is set to 3 or higher
1630        },
1631    },
1632    # Validate (added from Validate.pm)
1633    Now => {
1634        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' },
1635        Notes => q{
1636            the current date/time.  Useful when setting the tag values, eg.
1637            C<"-modifydate<now">.  Not generated unless specifically requested or the
1638            L<RequestAll|../ExifTool.html#RequestAll> API option is set
1639        },
1640        PrintConv => '$self->ConvertDateTime($val)',
1641    },
1642    NewGUID => {
1643        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
1644        Notes => q{
1645            generates a new, random GUID with format
1646            YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour,
1647            M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and
1648            R=random hex number; without dashes with the -n option.  Not generated
1649            unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set
1650        },
1651        PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val',
1652    },
1653    ID3Size     => { Notes => 'size of the ID3 data block' },
1654    Geotag => {
1655        Writable => 1,
1656        WriteOnly => 1,
1657        WriteNothing => 1,
1658        AllowGroup => '(exif|gps|xmp|xmp-exif)',
1659        Notes => q{
1660            this write-only tag is used to define the GPS track log data or track log
1661            file name.  Currently supported track log formats are GPX, NMEA RMC/GGA/GLL,
1662            KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus
1663            Beacon text, and Bramor gEO log files.  May be set to the special value of
1664            "DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points
1665            are available.  See L<geotag.html|../geotag.html> for details
1666        },
1667        DelCheck => q{
1668            require Image::ExifTool::Geotag;
1669            # delete associated tags
1670            Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup);
1671        },
1672        ValueConvInv => q{
1673            require Image::ExifTool::Geotag;
1674            # always warn because this tag is never set (warning is "\n" on success)
1675            my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val);
1676            return '' if not defined $result;   # deleting geo tags
1677            return $result if ref $result;      # geotag data hash reference
1678            warn "$result\n";                   # error string
1679        },
1680    },
1681    Geotime => {
1682        Writable => 1,
1683        WriteOnly => 1,
1684        AllowGroup => '(exif|gps|xmp|xmp-exif)',
1685        Notes => q{
1686            this write-only tag is used to define a date/time for interpolating a
1687            position in the GPS track specified by the Geotag tag.  Writing this tag
1688            causes GPS information to be written into the EXIF or XMP of the target
1689            files.  The local system timezone is assumed if the date/time value does not
1690            contain a timezone.  May be deleted to delete associated GPS tags.  A group
1691            name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP
1692            GPS tags
1693        },
1694        DelCheck => q{
1695            require Image::ExifTool::Geotag;
1696            # delete associated tags
1697            Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup);
1698        },
1699        ValueConvInv => q{
1700            require Image::ExifTool::Geotag;
1701            warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n";
1702            return undef;
1703        },
1704    },
1705    Geosync => {
1706        Writable => 1,
1707        WriteOnly => 1,
1708        WriteNothing => 1,
1709        AllowGroup => '(exif|gps|xmp|xmp-exif)',
1710        Shift => 'Time', # enables "+=" syntax as well as "=+"
1711        Notes => q{
1712            this write-only tag specifies a time difference to add to Geotime for
1713            synchronization with the GPS clock.  For example, set this to "-12" if the
1714            camera clock is 12 seconds faster than GPS time.  Input format is
1715            "[+-][[[DD ]HH:]MM:]SS[.ss]".  Additional features allow calculation of time
1716            differences and time drifts, and extraction of synchronization times from
1717            image files.  See the L<geotagging documentation|../geotag.html> for details
1718        },
1719        ValueConvInv => q{
1720            require Image::ExifTool::Geotag;
1721            return Image::ExifTool::Geotag::ConvertGeosync($self, $val);
1722        },
1723    },
1724    ForceWrite => {
1725        Groups => { 0 => '*', 1 => '*', 2 => '*' },
1726        Writable => 1,
1727        WriteOnly => 1,
1728        Notes => q{
1729            write-only tag used to force metadata in a file to be rewritten even if no
1730            tag values are changed.  May be set to "EXIF", "IPTC", "XMP" or "PNG" to
1731            force the corresponding metadata type to be rewritten, "FixBase" to cause
1732            EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All"
1733            to rewrite all of these metadata types.  Values are case insensitive, and
1734            multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp>
1735        },
1736    },
1737    EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } },
1738    Trailer => {
1739        Groups => { 0 => 'Trailer' },
1740        Notes => 'the full JPEG trailer data block.  Extracted only if specifically requested',
1741        Writable => 1,
1742        Protected => 1,
1743    },
1744);
1745
1746# tags defined by UserParam option (added at runtime)
1747%Image::ExifTool::UserParam = (
1748    GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' },
1749    PRIORITY => 0,
1750);
1751
1752# YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP)
1753%Image::ExifTool::JPEG::yCbCrSubSampling = (
1754    '1 1' => 'YCbCr4:4:4 (1 1)', #PH
1755    '2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm
1756    '2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm
1757    '4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm
1758    '4 2' => 'YCbCr4:1:0 (4 2)', #PH
1759    '1 2' => 'YCbCr4:4:0 (1 2)', #PH
1760    '1 4' => 'YCbCr4:4:1 (1 4)', #JD
1761    '2 4' => 'YCbCr4:2:1 (2 4)', #JD
1762);
1763
1764# define common JPEG segments here to avoid overhead of loading JPEG module
1765
1766# JPEG SOF (start of frame) tags
1767# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf)
1768%Image::ExifTool::JPEG::SOF = (
1769    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
1770    NOTES => 'This information is extracted from the JPEG Start Of Frame segment.',
1771    VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
1772    EncodingProcess => {
1773        PrintHex => 1,
1774        PrintConv => {
1775            0x0 => 'Baseline DCT, Huffman coding',
1776            0x1 => 'Extended sequential DCT, Huffman coding',
1777            0x2 => 'Progressive DCT, Huffman coding',
1778            0x3 => 'Lossless, Huffman coding',
1779            0x5 => 'Sequential DCT, differential Huffman coding',
1780            0x6 => 'Progressive DCT, differential Huffman coding',
1781            0x7 => 'Lossless, Differential Huffman coding',
1782            0x9 => 'Extended sequential DCT, arithmetic coding',
1783            0xa => 'Progressive DCT, arithmetic coding',
1784            0xb => 'Lossless, arithmetic coding',
1785            0xd => 'Sequential DCT, differential arithmetic coding',
1786            0xe => 'Progressive DCT, differential arithmetic coding',
1787            0xf => 'Lossless, differential arithmetic coding',
1788        }
1789    },
1790    BitsPerSample    => { },
1791    ImageHeight      => { },
1792    ImageWidth       => { },
1793    ColorComponents  => { },
1794    YCbCrSubSampling => {
1795        Notes => 'calculated from components table',
1796        PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling,
1797    },
1798);
1799
1800# JPEG JFIF APP0 definitions
1801%Image::ExifTool::JFIF::Main = (
1802    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
1803    WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
1804    CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
1805    GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
1806    DATAMEMBER => [ 2, 3, 5 ],
1807    0 => {
1808        Name => 'JFIFVersion',
1809        Format => 'int8u[2]',
1810        PrintConv => 'sprintf("%d.%.2d", split(" ",$val))',
1811        Mandatory => 1,
1812    },
1813    2 => {
1814        Name => 'ResolutionUnit',
1815        Writable => 1,
1816        RawConv => '$$self{JFIFResolutionUnit} = $val',
1817        PrintConv => {
1818            0 => 'None',
1819            1 => 'inches',
1820            2 => 'cm',
1821        },
1822        Priority => -1,
1823        Mandatory => 1,
1824    },
1825    3 => {
1826        Name => 'XResolution',
1827        Format => 'int16u',
1828        Writable => 1,
1829        Priority => -1,
1830        RawConv => '$$self{JFIFXResolution} = $val',
1831        Mandatory => 1,
1832    },
1833    5 => {
1834        Name => 'YResolution',
1835        Format => 'int16u',
1836        Writable => 1,
1837        Priority => -1,
1838        RawConv => '$$self{JFIFYResolution} = $val',
1839        Mandatory => 1,
1840    },
1841    7 => {
1842        Name => 'ThumbnailWidth',
1843        RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef',
1844    },
1845    8 => {
1846        Name => 'ThumbnailHeight',
1847        RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef',
1848    },
1849    9 => {
1850        Name => 'ThumbnailTIFF',
1851        Groups => { 2 => 'Preview' },
1852        Format => 'undef[3*($val{7}||0)*($val{8}||0)]',
1853        Notes => 'raw RGB thumbnail data, extracted as a TIFF image',
1854        RawConv => 'length($val) ? $val : undef',
1855        ValueConv => sub {
1856            my ($val, $et) = @_;
1857            my $len = length $val;
1858            return \ "Binary data $len bytes" unless $et->Options('Binary');
1859            my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val;
1860            return \$img;
1861        },
1862    },
1863);
1864%Image::ExifTool::JFIF::Extension = (
1865    GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' },
1866    NOTES => 'Thumbnail images extracted from the JFXX segment.',
1867    0x10 => {
1868        Name => 'ThumbnailImage',
1869        Groups => { 2 => 'Preview' },
1870        Notes => 'JPEG-format thumbnail image',
1871        RawConv => '$self->ValidateImage(\$val,$tag)',
1872    },
1873    0x11 => { # (untested)
1874        Name => 'ThumbnailTIFF',
1875        Groups => { 2 => 'Preview' },
1876        Notes => 'raw palette-color thumbnail data, extracted as a TIFF image',
1877        RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef',
1878        ValueConv => sub {
1879            my ($val, $et) = @_;
1880            my $len = length $val;
1881            return \ "Binary data $len bytes" unless $et->Options('Binary');
1882            my ($w, $h) = unpack('CC', $val);
1883            my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770);
1884            return \$img;
1885        },
1886    },
1887    0x13 => {
1888        Name => 'ThumbnailTIFF',
1889        Groups => { 2 => 'Preview' },
1890        Notes => 'raw RGB thumbnail data, extracted as a TIFF image',
1891        RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef',
1892        ValueConv => sub {
1893            my ($val, $et) = @_;
1894            my $len = length $val;
1895            return \ "Binary data $len bytes" unless $et->Options('Binary');
1896            my ($w, $h) = unpack('CC', $val);
1897            my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2);
1898            return \$img;
1899        },
1900    },
1901);
1902
1903# Composite tags (accumulation of all Composite tag tables)
1904%Image::ExifTool::Composite = (
1905    GROUPS => { 0 => 'Composite', 1 => 'Composite' },
1906    TABLE_NAME => 'Image::ExifTool::Composite',
1907    SHORT_NAME => 'Composite',
1908    VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags
1909    WRITE_PROC => \&DummyWriteProc,
1910);
1911
1912my %compositeID;    # lookup for new ID's of Composite tags based on original ID
1913
1914# static private ExifTool variables
1915
1916%allTables = ( );   # list of all tables loaded (except Composite tags)
1917@tableOrder = ( );  # order the tables were loaded
1918
1919#------------------------------------------------------------------------------
1920# Warning handler routines (warning string stored in $evalWarning)
1921#
1922# Set warning message
1923# Inputs: 0) warning string (undef to reset warning)
1924sub SetWarning($) { $evalWarning = $_[0]; }
1925
1926# Get warning message
1927sub GetWarning()  { return $evalWarning; }
1928
1929# Clean unnecessary information (line number, LF) from warning
1930# Inputs: 0) warning string or undef to use $evalWarning
1931# Returns: cleaned warning
1932sub CleanWarning(;$)
1933{
1934    my $str = shift;
1935    unless (defined $str) {
1936        return undef unless defined $evalWarning;
1937        $str = $evalWarning;
1938    }
1939    $str = $1 if $str =~ /(.*) at /s;
1940    $str =~ s/\s+$//s;
1941    return $str;
1942}
1943
1944#==============================================================================
1945# New - create new ExifTool object
1946# Inputs: 0) reference to exiftool object or ExifTool class name
1947# Returns: blessed ExifTool object ref
1948sub new
1949{
1950    local $_;
1951    my $that = shift;
1952    my $class = ref($that) || $that || 'Image::ExifTool';
1953    my $self = bless {}, $class;
1954
1955    # make sure our main Exif tag table has been loaded
1956    GetTagTable("Image::ExifTool::Exif::Main");
1957
1958    $self->ClearOptions();      # create default options hash
1959    $$self{VALUE} = { };        # must initialize this for warning messages
1960    $$self{PATH} = [ ];         # (this too)
1961    $$self{DEL_GROUP} = { };    # lookup for groups to delete when writing
1962    $$self{SAVE_COUNT} = 0;     # count calls to SaveNewValues()
1963    $$self{FILE_SEQUENCE} = 0;  # sequence number for files when reading
1964
1965    # initialize our new groups for writing
1966    $self->SetNewGroups(@defaultWriteGroups);
1967
1968    return $self;
1969}
1970
1971#------------------------------------------------------------------------------
1972# ImageInfo - return specified information from image file
1973# Inputs: 0) [optional] ExifTool object reference
1974#         1) filename, file reference, or scalar data reference
1975#         2-N) list of tag names to find (or tag list reference or options reference)
1976# Returns: reference to hash of tag/value pairs (with "Error" entry on error)
1977# Notes:
1978#   - if no tags names are specified, the values of all tags are returned
1979#   - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv
1980#   - can pass a reference to list of tags to find, in which case the list will
1981#     be updated with the tags found in the proper case and in the specified order.
1982#   - can pass reference to hash specifying options
1983#   - returned tag values may be scalar references indicating binary data
1984#   - see ClearOptions() below for a list of options and their default values
1985# Examples:
1986#   use Image::ExifTool 'ImageInfo';
1987#   my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize');
1988#    - or -
1989#   my $et = new Image::ExifTool;
1990#   my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} );
1991sub ImageInfo($;@)
1992{
1993    local $_;
1994    # get our ExifTool object ($self) or create one if necessary
1995    my $self;
1996    if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) {
1997        $self = shift;
1998    } else {
1999        $self = new Image::ExifTool;
2000    }
2001    my %saveOptions = %{$$self{OPTIONS}};   # save original options
2002
2003    # initialize file information
2004    $$self{FILENAME} = $$self{RAF} = undef;
2005
2006    $self->ParseArguments(@_);              # parse our function arguments
2007    $self->ExtractInfo(undef);              # extract meta information from image
2008    my $info = $self->GetInfo(undef);       # get requested information
2009
2010    $$self{OPTIONS} = \%saveOptions;        # restore original options
2011
2012    return $info;   # return requested information
2013}
2014
2015#------------------------------------------------------------------------------
2016# Get/set ExifTool options
2017# Inputs: 0) ExifTool object reference,
2018#         1) Parameter name (case insensitive), 2) Value to set the option
2019#         3-N) More parameter/value pairs
2020# Returns: original value of last option specified
2021sub Options($$;@)
2022{
2023    local $_;
2024    my $self = shift;
2025    my $options = $$self{OPTIONS};
2026    my $oldVal;
2027
2028    while (@_) {
2029        my $param = shift;
2030        # fix parameter case if necessary
2031        unless (exists $$options{$param}) {
2032            my ($fixed) = grep /^$param$/i, keys %$options;
2033            if ($fixed) {
2034                $param = $fixed;
2035            } else {
2036                $param =~ s/^Group(\d*)$/Group$1/i;
2037            }
2038        }
2039        $oldVal = $$options{$param};
2040        if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) {
2041            # get previous Compact/XMPShorthand setting
2042            $oldVal = $$oldVal{$param};
2043        }
2044        last unless @_;
2045        my $newVal = shift;
2046        if ($param eq 'Lang') {
2047            # allow this to be set to undef to select the default language
2048            $newVal = $defaultLang unless defined $newVal;
2049            if ($newVal eq $defaultLang) {
2050                $$options{$param} = $newVal;
2051                delete $$self{CUR_LANG};
2052            # make sure the language is available
2053            } elsif (eval "require Image::ExifTool::Lang::$newVal") {
2054                my $xlat = "Image::ExifTool::Lang::${newVal}::Translate";
2055                no strict 'refs';
2056                if (%$xlat) {
2057                    $$self{CUR_LANG} = \%$xlat;
2058                    $$options{$param} = $newVal;
2059                }
2060            } # else don't change Lang
2061        } elsif ($param eq 'Exclude' and defined $newVal) {
2062            # clone Exclude list and expand shortcuts
2063            my @exclude;
2064            if (ref $newVal eq 'ARRAY') {
2065                @exclude = @$newVal;
2066            } else {
2067                @exclude = ($newVal);
2068            }
2069            ExpandShortcuts(\@exclude, 1);  # (also remove '#' suffix)
2070            $$options{$param} = \@exclude;
2071        } elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') {
2072            # only allow valid character sets to be set
2073            if ($newVal) {
2074                my $charset = $charsetName{lc $newVal};
2075                if ($charset) {
2076                    $$options{$param} = $charset;
2077                    # maintain backward-compatibility with old IPTCCharset option
2078                    $$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset';
2079                } else {
2080                    warn "Invalid Charset $newVal\n";
2081                }
2082            } elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') {
2083                $$options{$param} = $newVal;    # only these may be set to a false value
2084            } elsif ($param eq 'CharsetQuickTime') {
2085                $$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman
2086            } else {
2087                $$options{$param} = 'Latin';    # all others default to Latin
2088            }
2089        } elsif ($param eq 'UserParam') {
2090            # clear options if $newVal is undef
2091            defined $newVal or $$options{$param} = {}, next;
2092            my $table = GetTagTable('Image::ExifTool::UserParam');
2093            # allow initialization of entire UserParam hash
2094            if (ref $newVal eq 'HASH') {
2095                my %newParams;
2096                foreach (sort keys %$newVal) {
2097                    my $lcTag = lc $_;
2098                    $newParams{$lcTag} = $$newVal{$_};
2099                    delete $$table{$lcTag};
2100                    AddTagToTable($table, $lcTag, $_);
2101                }
2102                $$options{$param} = \%newParams;
2103                next;
2104            }
2105            my ($force, $paramName);
2106            # set/reset single UserParam parameter
2107            if ($newVal =~ /(.*?)=(.*)/s) {
2108                $paramName = $1;
2109                $newVal = $2;
2110                $force = 1 if $paramName =~ s/\^$//;
2111                $paramName =~ tr/-_a-zA-Z0-9#//dc;
2112                $param = lc $paramName;
2113            } else {
2114                ($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc;
2115                undef $newVal;
2116            }
2117            delete $$table{$param};
2118            $oldVal = $$options{UserParam}{$param};
2119            if (defined $newVal) {
2120                if (length $newVal or $force) {
2121                    $$options{UserParam}{$param} = $newVal;
2122                    AddTagToTable($table, $param, $paramName);
2123                } else {
2124                    delete $$options{UserParam}{$param};
2125                }
2126            }
2127            # remove alternate version of tag
2128            $param .= '#' unless $param =~ s/#$//;
2129            delete $$table{$param};
2130            delete $$options{UserParam}{$param};
2131        } elsif ($param eq 'RequestTags') {
2132            if (defined $newVal) {
2133                # parse list from delimited string if necessary
2134                my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g);
2135                ExpandShortcuts(\@reqList);
2136                # add to existing list
2137                $$options{$param} or $$options{$param} = [ ];
2138                foreach (@reqList) {
2139                    /^(.*:)?([-\w?*]*)#?$/ or next;
2140                    push @{$$options{$param}}, lc($2) if $2;
2141                    next unless $1;
2142                    # add requested groups with trailing colon
2143                    push @{$$options{$param}}, lc($_).':' foreach split /:/, $1;
2144                }
2145            } else {
2146                $$options{$param} = undef;  # clear the list
2147            }
2148        } elsif ($param eq 'ListJoin') {
2149            $$options{$param} = $newVal;
2150            # set the old List and ListSep options for backward compatibility
2151            if (defined $newVal) {
2152                $$options{List} = 0;
2153                $$options{ListSep} = $newVal;
2154            } else {
2155                $$options{List} = 1;
2156                # (ListSep must be defined)
2157            }
2158        } elsif ($param eq 'List') {
2159            $$options{$param} = $newVal;
2160            # set the new ListJoin option for forward compatibility
2161            $$options{ListJoin} = $newVal ? undef : $$options{ListSep};
2162        } elsif ($param eq 'Compact' or $param eq 'XMPShorthand') {
2163            # set Compact and XMPShorthand options, preserving backward compatibility
2164            my ($p, %compact);
2165            foreach $p ('Compact','XMPShorthand') {
2166                my $val = $param eq $p ? $newVal : $$options{Compact}{$p};
2167                if (defined $val) {
2168                    my @v = ($val =~ /\w+/g);
2169                    my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt;
2170                    foreach (@v) {
2171                        my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal;
2172                        ref $set or $compact{$set} = 1, next;
2173                        $compact{$_} = 1 foreach @$set;
2174                    }
2175                }
2176                $compact{$p} = $val; # preserve most recent setting
2177            }
2178            $$options{Compact} = $$options{XMPShorthand} = \%compact;
2179        } else {
2180            if ($param eq 'Escape') {
2181                # set ESCAPE_PROC
2182                if (defined $newVal and $newVal eq 'XML') {
2183                    require Image::ExifTool::XMP;
2184                    $$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML;
2185                } elsif (defined $newVal and $newVal eq 'HTML') {
2186                    require Image::ExifTool::HTML;
2187                    $$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML;
2188                } else {
2189                    delete $$self{ESCAPE_PROC};
2190                }
2191                # must forget saved values since they depend on Escape method
2192                $$self{BOTH} = { };
2193            } elsif ($param eq 'GlobalTimeShift') {
2194                delete $$self{GLOBAL_TIME_OFFSET};  # reset our calculated offset
2195            } elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) {
2196                $ENV{TZ} = $newVal;
2197                eval { require POSIX; POSIX::tzset() };
2198            } elsif ($param eq 'Validate') {
2199                # load Validate module if Validate option enabled
2200                $newVal and require Image::ExifTool::Validate;
2201            }
2202            $$options{$param} = $newVal;
2203        }
2204    }
2205    return $oldVal;
2206}
2207
2208#------------------------------------------------------------------------------
2209# ClearOptions - set options to default values
2210# Inputs: 0) ExifTool object reference
2211sub ClearOptions($)
2212{
2213    local $_;
2214    my $self = shift;
2215
2216    # create options hash with default values
2217    # +-----------------------------------------------------+
2218    # ! DON'T FORGET!!  When adding any new option, must    !
2219    # ! decide how it is handled in SetNewValuesFromFile()  !
2220    # +-----------------------------------------------------+
2221    # (Note: All options must exist in this lookup, even if undefined,
2222    # to facilitate case-insensitive options. 'Group#' is handled specially)
2223    $$self{OPTIONS} = {
2224        Binary      => undef,   # flag to extract binary values even if tag not specified
2225        ByteOrder   => undef,   # default byte order when creating EXIF information
2226        Charset     => 'UTF8',  # character set for converting Unicode characters
2227        CharsetEXIF => undef,   # internal EXIF "ASCII" string encoding
2228        CharsetFileName => undef,   # external encoding for file names
2229        CharsetID3  => 'Latin', # internal ID3v1 character set
2230        CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet
2231        CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names
2232        CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding
2233        CharsetRIFF => 0,       # internal RIFF string encoding (0=default to Latin)
2234        Compact     => { },     # write compact XMP
2235        Composite   => 1,       # flag to calculate Composite tags
2236        Compress    => undef,   # flag to write new values as compressed if possible
2237        CoordFormat => undef,   # GPS lat/long coordinate format
2238        DateFormat  => undef,   # format for date/time
2239        Duplicates  => 1,       # flag to save duplicate tag values
2240        Escape      => undef,   # escape special characters
2241        Exclude     => undef,   # tags to exclude
2242        ExtendedXMP => 1,       # strategy for reading extended XMP
2243        ExtractEmbedded =>undef,# flag to extract information from embedded documents
2244        FastScan    => undef,   # flag to avoid scanning for trailer
2245        Filter      => undef,   # output filter for all tag values
2246        FilterW     => undef,   # input filter when writing tag values
2247        FixBase     => undef,   # fix maker notes base offsets
2248        GeoMaxIntSecs => 1800,  # geotag maximum interpolation time (secs)
2249        GeoMaxExtSecs => 1800,  # geotag maximum extrapolation time (secs)
2250        GeoMaxHDOP  => undef,   # geotag maximum HDOP
2251        GeoMaxPDOP  => undef,   # geotag maximum PDOP
2252        GeoMinSats  => undef,   # geotag minimum satellites
2253        GeoSpeedRef => undef,   # geotag GPSSpeedRef
2254        GlobalTimeShift => undef,   # apply time shift to all extracted date/time values
2255    #   Group#      => undef,   # return tags for specified groups in family #
2256        HexTagIDs   => 0,       # use hex tag ID's in family 7 group names
2257        HtmlDump    => 0,       # HTML dump (0-3, higher # = bigger limit)
2258        HtmlDumpBase => undef,  # base address for HTML dump
2259        IgnoreMinorErrors => undef, # ignore minor errors when reading/writing
2260        Lang        => $defaultLang,# localized language for descriptions etc
2261        LargeFileSupport => undef,  # flag indicating support of 64-bit file offsets
2262        List        => undef,   # extract lists of PrintConv values into arrays [no longer documented]
2263        ListItem    => undef,   # used to return a specific item from lists
2264        ListJoin    => ', ',    # join lists together with this separator
2265        ListSep     => ', ',    # list item separator [no longer documented]
2266        ListSplit   => undef,   # regex for splitting list-type tag values when writing
2267        MakerNotes  => undef,   # extract maker notes as a block
2268        MDItemTags  => undef,   # extract MacOS metadata item tags
2269        MissingTagValue =>undef,# value for missing tags when expanded in expressions
2270        NoMultiExif => undef,   # raise error when writing multi-segment EXIF
2271        NoPDFList   => undef,   # flag to avoid splitting PDF List-type tag values
2272        Password    => undef,   # password for password-protected PDF documents
2273        PrintConv   => 1,       # flag to enable print conversion
2274        QuickTimeHandler => undef,  # flag to add mdir Handler to newly created Meta box
2275        QuickTimeUTC=> undef,   # assume that QuickTime date/time tags are stored as UTC
2276        RequestAll  => undef,   # extract all tags that must be specifically requested
2277        RequestTags => undef,   # extra tags to request (on top of those in the tag list)
2278        SaveFormat  => undef,   # save family 6 tag TIFF format
2279        SavePath    => undef,   # save family 5 location path
2280        ScanForXMP  => undef,   # flag to scan for XMP information in all files
2281        Sort        => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#)
2282        Sort2       => 'File',  # secondary sort order for tags in a group (File, Tag, Descr)
2283        StrictDate  => undef,   # flag to return undef for invalid date conversions
2284        Struct      => undef,   # return structures as hash references
2285        SystemTags  => undef,   # extract additional File System tags
2286        TextOut     => \*STDOUT,# file for Verbose/HtmlDump output
2287        TimeZone    => undef,   # local time zone
2288        Unknown     => 0,       # flag to get values of unknown tags (0-2)
2289        UserParam   => { },     # user parameters for additional user-defined tag values
2290        Validate    => undef,   # perform additional validation
2291        Verbose     => 0,       # print verbose messages (0-5, higher # = more verbose)
2292        WriteMode   => 'wcg',   # enable all write modes by default
2293        XAttrTags   => undef,   # extract MacOS extended attribute tags
2294        XMPAutoConv => 1,       # automatic conversion of unknown XMP tag values
2295        XMPShorthand=> 0,       # (unused, but needed for backward compatibility)
2296    };
2297    # keep necessary member variables in sync with options
2298    delete $$self{CUR_LANG};
2299    delete $$self{ESCAPE_PROC};
2300
2301    # load user-defined default options
2302    if (%Image::ExifTool::UserDefined::Options) {
2303        foreach (keys %Image::ExifTool::UserDefined::Options) {
2304            $self->Options($_, $Image::ExifTool::UserDefined::Options{$_});
2305        }
2306    }
2307}
2308
2309#------------------------------------------------------------------------------
2310# Extract meta information from image
2311# Inputs: 0) ExifTool object reference
2312#         1-N) Same as ImageInfo()
2313# Returns: 1 if this was a valid image, 0 otherwise
2314# Notes: pass an undefined value to avoid parsing arguments
2315# Internal 'ReEntry' option allows this routine to be called recursively
2316sub ExtractInfo($;@)
2317{
2318    local $_;
2319    my $self = shift;
2320    my $options = $$self{OPTIONS};      # pointer to current options
2321    my $fast = $$options{FastScan} || 0;
2322    my $req = $$self{REQ_TAG_LOOKUP};
2323    my $reqAll = $$options{RequestAll} || 0;
2324    my (%saveOptions, $reEntry, $rsize, $type, @startTime, $saveOrder);
2325
2326    # check for internal ReEntry option to allow recursive calls to ExtractInfo
2327    if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and
2328       (ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB'))
2329    {
2330        # save necessary members for restoring later
2331        $reEntry = {
2332            RAF       => $$self{RAF},
2333            PROCESSED => $$self{PROCESSED},
2334            EXIF_DATA => $$self{EXIF_DATA},
2335            EXIF_POS  => $$self{EXIF_POS},
2336            FILE_TYPE => $$self{FILE_TYPE},
2337        };
2338        $saveOrder = GetByteOrder(),
2339        $$self{RAF} = new File::RandomAccess($_[0]);
2340        $$self{PROCESSED} = { };
2341        delete $$self{EXIF_DATA};
2342        delete $$self{EXIF_POS};
2343    } else {
2344        if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) {
2345            %saveOptions = %$options;       # save original options
2346
2347            # require duplicates for html dump
2348            $self->Options(Duplicates => 1) if $$options{HtmlDump};
2349            # enable Validate option if Validate tag is requested
2350            $self->Options(Validate => 1) if $$req{validate};
2351
2352            if (defined $_[0]) {
2353                # only initialize filename if called with arguments
2354                $$self{FILENAME} = undef;   # name of file (or '' if we didn't open it)
2355                $$self{RAF} = undef;        # RandomAccess object reference
2356
2357                $self->ParseArguments(@_);  # initialize from our arguments
2358            }
2359        }
2360        # initialize ExifTool object members
2361        $self->Init();
2362
2363        delete $$self{MAKER_NOTE_FIXUP};    # fixup information for extracted maker notes
2364        delete $$self{MAKER_NOTE_BYTE_ORDER};
2365
2366        # return our version number
2367        $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
2368        $self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll;
2369        $self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll;
2370        # generate sequence number if necessary
2371        $self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll;
2372
2373        if ($$req{processingtime} or $reqAll) {
2374            eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() };
2375            if (not @startTime and $$req{processingtime}) {
2376                $self->WarnOnce('Install Time::HiRes to generate ProcessingTime');
2377            }
2378        }
2379
2380        ++$$self{FILE_SEQUENCE};        # count files read
2381    }
2382
2383    my $filename = $$self{FILENAME};    # image file name ('' if already open)
2384    my $raf = $$self{RAF};              # RandomAccess object
2385
2386    local *EXIFTOOL_FILE;   # avoid clashes with global namespace
2387
2388    my $realname = $filename;
2389    unless ($raf) {
2390        # save file name
2391        if (defined $filename and $filename ne '') {
2392            unless ($filename eq '-') {
2393                # extract file name from pipe if necessary
2394                $realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s;
2395                my ($dir, $name) = SplitFileName($realname);
2396                $self->FoundTag('FileName', $name);
2397                $self->FoundTag('Directory', $dir) if defined $dir and length $dir;
2398                if ($$req{filepath} or
2399                   ($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath}))
2400                {
2401                    local $SIG{'__WARN__'} = \&SetWarning;
2402                    if (eval { require Cwd }) {
2403                        my $path = eval { Cwd::abs_path($filename) };
2404                        $self->FoundTag('FilePath', $path) if defined $path;
2405                    } elsif ($$req{filepath}) {
2406                        $self->WarnOnce('The Perl Cwd module must be installed to use FilePath');
2407                    }
2408                }
2409                # get size of resource fork on Mac OS
2410                $rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE};
2411            }
2412            # open the file
2413            if ($self->Open(\*EXIFTOOL_FILE, $filename)) {
2414                # create random access file object
2415                $raf = new File::RandomAccess(\*EXIFTOOL_FILE);
2416                # patch to force pipe to be buffered because seek returns success
2417                # in Windows cmd shell pipe even though it really failed
2418                $$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/;
2419                $$self{RAF} = $raf;
2420            } else {
2421                $self->Error('Error opening file');
2422            }
2423        } else {
2424            $self->Error('No file specified');
2425        }
2426    }
2427
2428    while ($raf) {
2429        my (@stat, $fileSize);
2430        if ($reEntry) {
2431            # we already set these tags
2432        } elsif (not $$raf{FILE_PT}) {
2433            # get file size from image in memory
2434            $self->FoundTag('FileSize', length ${$$raf{BUFF_PT}});
2435        } elsif (-f $$raf{FILE_PT}) {
2436            # get file tags if this is a plain file
2437            $fileSize = -s _;
2438            @stat = stat _;
2439            my ($aTime, $mTime, $cTime) = $self->GetFileTime($$raf{FILE_PT});
2440            $self->FoundTag('FileSize', $fileSize) if defined $fileSize;
2441            $self->FoundTag('ResourceForkSize', $rsize) if $rsize;
2442            $self->FoundTag('FileModifyDate', $mTime) if defined $mTime;
2443            $self->FoundTag('FileAccessDate', $aTime) if defined $aTime;
2444            my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate';
2445            $self->FoundTag($cTag, $cTime) if defined $cTime;
2446            $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2];
2447        } else {
2448            @stat = stat $$raf{FILE_PT};
2449        }
2450        # extract more system info if SystemTags option is set
2451        if (@stat) {
2452            my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags});
2453            if ($sys or $$req{fileattributes}) {
2454                my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00);
2455                # add Windows file attributes if available
2456                if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') {
2457                    local $SIG{'__WARN__'} = \&SetWarning;
2458                    if (eval { require Win32API::File }) {
2459                        my $wattr;
2460                        my $file = $filename;
2461                        if ($self->EncodeFileName($file)) {
2462                            $wattr = eval { Win32API::File::GetFileAttributesW($file) };
2463                        } else {
2464                            $wattr = eval { Win32API::File::GetFileAttributes($file) };
2465                        }
2466                        push @attr, $wattr if defined $wattr and $wattr != 0xffffffff;
2467                    }
2468                }
2469                $self->FoundTag('FileAttributes', "@attr");
2470            }
2471            $self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber};
2472            $self->FoundTag('FileInodeNumber', $stat[1])  if $sys or $$req{fileinodenumber};
2473            $self->FoundTag('FileHardLinks', $stat[3])    if $sys or $$req{filehardlinks};
2474            $self->FoundTag('FileUserID', $stat[4])       if $sys or $$req{fileuserid};
2475            $self->FoundTag('FileGroupID', $stat[5])      if $sys or $$req{filegroupid};
2476            $self->FoundTag('FileDeviceID', $stat[6])     if $sys or $$req{filedeviceid};
2477            $self->FoundTag('FileBlockSize', $stat[11])   if $sys or $$req{fileblocksize};
2478            $self->FoundTag('FileBlockCount', $stat[12])  if $sys or $$req{fileblockcount};
2479        }
2480        # extract MDItem tags if requested (only on plain files)
2481        if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) {
2482            my $reqMacOS = ($reqAll > 1 or $$req{'macos:'});
2483            my $crDate = ($reqMacOS || $$req{filecreatedate});
2484            my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req);
2485            my $xattr  = ($reqMacOS || $$options{XAttrTags}  || grep /^xattr/,  keys %$req);
2486            if ($crDate or $mdItem or $xattr) {
2487                require Image::ExifTool::MacOS;
2488                Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate;
2489                Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem;
2490                Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr;
2491            }
2492        }
2493
2494        # get list of file types to check
2495        my ($tiffType, %noMagic, $recognizedExt);
2496        my $ext = $$self{FILE_EXT} = GetFileExtension($realname);
2497        # set $recognizedExt if this file type is recognized by extension only
2498        $recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and
2499                                 defined $moduleName{$ext} and not $moduleName{$ext};
2500        my @fileTypeList = GetFileType($realname);
2501        if ($fast >= 4) {
2502            if (@fileTypeList) {
2503                $type = shift @fileTypeList;
2504                $self->SetFileType($$self{FILE_TYPE} = $type);
2505            } else {
2506                $self->Error('Unknown file type');
2507            }
2508            $self->BuildCompositeTags() if $fast == 4 and $$options{Composite};
2509            last;   # don't read the file
2510        }
2511        if (@fileTypeList) {
2512            # add remaining types to end of list so we test them all
2513            my $pat = join '|', @fileTypeList;
2514            push @fileTypeList, grep(!/^($pat)$/, @fileTypes);
2515            $tiffType = $$self{FILE_EXT};
2516            unless ($fast == 3) {
2517                $noMagic{MXF} = 1;  # don't do magic number test on MXF or DV files
2518                $noMagic{DV} = 1;
2519            }
2520        } else {
2521            # scan through all recognized file types
2522            @fileTypeList = @fileTypes;
2523            $tiffType = 'TIFF';
2524        }
2525        push @fileTypeList, ''; # end of list marker
2526        # initialize the input file for seeking in binary data
2527        $raf->BinMode();    # set binary mode before we start reading
2528        my $pos = $raf->Tell(); # get file position so we can rewind
2529        # loop through list of file types to test
2530        my ($buff, $seekErr);
2531        my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff );
2532        # read start of file for testing
2533        $raf->Read($buff, $testLen) or $buff = '';
2534        $raf->Seek($pos, 0) or $seekErr = 1;
2535        until ($seekErr) {
2536            my $unkHeader;
2537            $type = shift @fileTypeList;
2538            if ($type) {
2539                if ($magicNumber{$type}) {
2540                    # do quick test for this file type to avoid loading module unnecessarily
2541                    next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type};
2542                } else {
2543                    # keep checking for other types if we recognize this file only by extension
2544                    next if defined $moduleName{$type} and not $moduleName{$type};
2545                    next if $fast > 2;  # keep checking if we aren't processing the file
2546                }
2547                next if $weakMagic{$type} and defined $recognizedExt;
2548            } elsif (not defined $type) {
2549                last;
2550            } elsif ($recognizedExt) {
2551                $type = $recognizedExt; # set type from recognized file extension only
2552            } else {
2553                # last ditch effort to scan past unknown header for JPEG/TIFF
2554                next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g;
2555                $type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF';
2556                my $skip = pos($buff) - length($1);
2557                $dirInfo{Base} = $pos + $skip;
2558                $raf->Seek($pos + $skip, 0) or $seekErr = 1, last;
2559                $self->Warn("Processing $type-like data after unknown $skip-byte header");
2560                $unkHeader = 1 unless $$self{DOC_NUM};
2561            }
2562            # save file type in member variable
2563            $$self{FILE_TYPE} = $type;
2564            $dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type;
2565            # don't process the file when FastScan == 3
2566            if ($fast == 3 and not $processType{$type}) {
2567                unless ($weakMagic{$type} and (not $ext or $ext ne $type)) {
2568                    $self->SetFileType($dirInfo{Parent});
2569                }
2570                last;
2571            }
2572            my $module = $moduleName{$type};
2573            $module = $type unless defined $module;
2574            my $func = "Process$type";
2575
2576            # load module if necessary
2577            if ($module) {
2578                require "Image/ExifTool/$module.pm";
2579                $func = "Image::ExifTool::${module}::$func";
2580            } elsif ($module eq '0') {
2581                $self->SetFileType();
2582                $self->Warn('Unsupported file type');
2583                last;
2584            }
2585            push @{$$self{PATH}}, $type;    # save file type in metadata PATH
2586
2587            # process the file
2588            no strict 'refs';
2589            my $result = &$func($self, \%dirInfo);
2590            use strict 'refs';
2591
2592            pop @{$$self{PATH}};
2593
2594            if ($result) {  # all done if successful
2595                if ($unkHeader) {
2596                    $self->DeleteTag('FileType');
2597                    $self->DeleteTag('FileTypeExtension');
2598                    $self->DeleteTag('MIMEType');
2599                    $self->VPrint(0,"Reset file type due to unknown header\n");
2600                }
2601                last;
2602            }
2603            # seek back to try again from the same position in the file
2604            $raf->Seek($pos, 0) or $seekErr = 1, last;
2605        }
2606        if (not defined $type and not $$self{DOC_NUM}) {
2607            # if we were given a single image with a known type there
2608            # must be a format error since we couldn't read it, otherwise
2609            # it is likely we don't support images of this type
2610            my $fileType = GetFileType($realname) || '';
2611            my $err;
2612            if (not length $buff) {
2613                $err = 'File is empty';
2614            } else {
2615                my $ch = substr($buff, 0, 1);
2616                if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) {
2617                    if ($fileType eq 'RAW') {
2618                        $err = 'Unsupported RAW file type';
2619                    } elsif ($fileType) {
2620                        $err = 'File format error';
2621                    } else {
2622                        $err = 'Unknown file type';
2623                    }
2624                } else {
2625                    # provide some insight into the content of some corrupted files
2626                    if ($$self{OPTIONS}{FastScan}) {
2627                        $err = 'File header is all';
2628                    } else {
2629                        my $num = 0;
2630                        for (;;) {
2631                            $raf->Read($buff, 65536) or undef($num), last;
2632                            $buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last;
2633                            $num += length($buff);
2634                        }
2635                        if ($num) {
2636                            $err = 'First ' . ConvertFileSize($num) . ' of file is';
2637                        } else {
2638                            $err = 'Entire file is';
2639                        }
2640                    }
2641                    if ($ch eq "\0") {
2642                        $err .= ' binary zeros';
2643                    } elsif ($ch eq ' ') {
2644                        $err .= ' ASCII spaces';
2645                    } elsif ($ch =~ /[a-zA-Z0-9]/) {
2646                        $err .= " ASCII '${ch}' characters";
2647                    } else {
2648                        $err .= sprintf(" binary 0x%.2x's", ord $ch);
2649                    }
2650                }
2651            }
2652            $self->Error($err);
2653        }
2654        if ($seekErr) {
2655            $self->Error('Error seeking in file');
2656        } elsif ($self->Options('ScanForXMP') and (not defined $type or
2657            (not $fast and not $$self{FoundXMP})))
2658        {
2659            # scan for XMP
2660            $raf->Seek($pos, 0);
2661            require Image::ExifTool::XMP;
2662            Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = '';
2663        }
2664        # extract binary EXIF data block only if requested
2665        if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and
2666            ($$req{exif} or
2667            # (not extracted normally, so check TAGS_FROM_FILE)
2668            ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif})))
2669        {
2670            $self->FoundTag('EXIF', $$self{EXIF_DATA});
2671        }
2672        unless ($reEntry) {
2673            $$self{PATH} = [ ];     # reset PATH
2674            # calculate Composite tags
2675            $self->BuildCompositeTags() if $$options{Composite};
2676            # do our HTML dump if requested
2677            if ($$self{HTML_DUMP}) {
2678                $raf->Seek(0, 2);   # seek to end of file
2679                $$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
2680                my $pos = $$options{HtmlDumpBase};
2681                $pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos;
2682                my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef;
2683                undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS};
2684                undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous
2685                my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos,
2686                    $$options{TextOut}, $$options{HtmlDump},
2687                    $$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump');
2688                $self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0;
2689            }
2690        }
2691        if ($filename) {
2692            $raf->Close();  # close the file if we opened it
2693            # process the resource fork as an embedded file on Mac filesystems
2694            if ($rsize and $$options{ExtractEmbedded}) {
2695                local *RESOURCE_FILE;
2696                if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) {
2697                    $$self{DOC_NUM} = $$self{DOC_COUNT} + 1;
2698                    $$self{IN_RESOURCE} = 1;
2699                    $self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 });
2700                    close RESOURCE_FILE;
2701                    delete $$self{IN_RESOURCE};
2702                } else {
2703                    $self->Warn('Error opening resource fork');
2704                }
2705            }
2706        }
2707        last;   # (loop was a cheap "goto")
2708    }
2709
2710    # generate Validate tag if requested
2711    if ($$options{Validate} and not $reEntry) {
2712        Image::ExifTool::Validate::FinishValidate($self, $$req{validate});
2713    }
2714
2715    @startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime));
2716
2717    # add user-defined parameters that ended with '!'
2718    if (%{$$options{UserParam}}) {
2719        my $doMsg = $$options{Verbose};
2720        my $table = GetTagTable('Image::ExifTool::UserParam');
2721        foreach (sort keys %{$$options{UserParam}}) {
2722            next unless /#$/;
2723            if ($doMsg) {
2724                $self->VPrint(0, "UserParam tags:\n");
2725                undef $doMsg;
2726            }
2727            $self->HandleTag($table, $_, $$options{UserParam}{$_});
2728        }
2729    }
2730
2731    # restore original options
2732    %saveOptions and $$self{OPTIONS} = \%saveOptions;
2733
2734    if ($reEntry) {
2735        # restore necessary members when exiting re-entrant code
2736        $$self{$_} = $$reEntry{$_} foreach keys %$reEntry;
2737        SetByteOrder($saveOrder);
2738    }
2739
2740    # ($type may be undef without an Error when processing sub-documents)
2741    return 0 if not defined $type or exists $$self{VALUE}{Error};
2742    return 1;
2743}
2744
2745#------------------------------------------------------------------------------
2746# Get hash of extracted meta information
2747# Inputs: 0) ExifTool object reference
2748#         1-N) options hash reference, tag list reference or tag names
2749# Returns: Reference to information hash
2750# Notes: - pass an undefined value to avoid parsing arguments
2751#        - If groups are specified, first groups take precedence if duplicate
2752#          tags found but Duplicates option not set.
2753#        - tag names may end in '#' to extract ValueConv value
2754sub GetInfo($;@)
2755{
2756    local $_;
2757    my $self = shift;
2758    my %saveOptions;
2759
2760    unless (@_ and not defined $_[0]) {
2761        %saveOptions = %{$$self{OPTIONS}}; # save original options
2762        # must set FILENAME so it isn't parsed from the arguments
2763        $$self{FILENAME} = '' unless defined $$self{FILENAME};
2764        $self->ParseArguments(@_);
2765    }
2766
2767    # get reference to list of tags for which we will return info
2768    my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags();
2769
2770    # build hash of tag information
2771    my (%info, %ignored);
2772    my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
2773    foreach (@$rtnTags) {
2774        my $val = $self->GetValue($_, $conv);
2775        defined $val or $ignored{$_} = 1, next;
2776        $info{$_} = $val;
2777    }
2778
2779    # override specified tags with ValueConv value if necessary
2780    if (@$byValue) {
2781        # first determine the number of times each non-ValueConv value is used
2782        my %nonVal;
2783        $nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags;
2784        --$nonVal{$$rtnTags[$_]} foreach @$byValue;
2785        # loop through ValueConv tags, updating tag keys and returned values
2786        foreach (@$byValue) {
2787            my $tag = $$rtnTags[$_];
2788            my $val = $self->GetValue($tag, 'ValueConv');
2789            next unless defined $val;
2790            my $vtag = $tag;
2791            # generate a new tag key like "Tag #" or "Tag #(1)"
2792            $vtag =~ s/( |$)/ #/;
2793            unless (defined $$self{VALUE}{$vtag}) {
2794                $$self{VALUE}{$vtag} = $$self{VALUE}{$tag};
2795                $$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag};
2796                $$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag};
2797                $$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag};
2798                # remove existing PrintConv entry unless we are using it too
2799                delete $info{$tag} unless $nonVal{$tag};
2800            }
2801            $$rtnTags[$_] = $vtag;  # store ValueConv value with new tag key
2802            $info{$vtag} = $val;    # return ValueConv value
2803        }
2804    }
2805
2806    # remove ignored tags from the list
2807    my $reqTags = $$self{REQUESTED_TAGS} || [ ];
2808    if (%ignored) {
2809        if (not @$reqTags) {
2810            my @goodTags;
2811            foreach (@$rtnTags) {
2812                push @goodTags, $_ unless $ignored{$_};
2813            }
2814            $rtnTags = $$self{FOUND_TAGS} = \@goodTags;
2815        } elsif (@$wildTags) {
2816            # only remove tags specified by wildcard
2817            my @goodTags;
2818            my $i = 0;
2819            foreach (@$rtnTags) {
2820                if (@$wildTags and $i == $$wildTags[0]) {
2821                    shift @$wildTags;
2822                    push @goodTags, $_ unless $ignored{$_};
2823                } else {
2824                    push @goodTags, $_;
2825                }
2826                ++$i;
2827            }
2828            $rtnTags = $$self{FOUND_TAGS} = \@goodTags;
2829        }
2830    }
2831
2832    # return sorted tag list if provided with a list reference
2833    if ($$self{IO_TAG_LIST}) {
2834        # use file order by default if no tags specified
2835        # (no such thing as 'Input' order in this case)
2836        my $sort = $$self{OPTIONS}{Sort};
2837        $sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input');
2838        # return tags in specified sort order
2839        @{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2});
2840    }
2841
2842    # restore original options
2843    %saveOptions and $$self{OPTIONS} = \%saveOptions;
2844
2845    return \%info;
2846}
2847
2848#------------------------------------------------------------------------------
2849# Inputs: 0) ExifTool object reference
2850#         1) [optional] reference to info hash or tag list ref (default is found tags)
2851#         2) [optional] sort order ('File', 'Input', ...)
2852#         3) [optional] secondary sort order
2853# Returns: List of tags in specified order
2854sub GetTagList($;$$$)
2855{
2856    local $_;
2857    my ($self, $info, $sort, $sort2) = @_;
2858
2859    my $foundTags;
2860    if (ref $info eq 'HASH') {
2861        my @tags = keys %$info;
2862        $foundTags = \@tags;
2863    } elsif (ref $info eq 'ARRAY') {
2864        $foundTags = $info;
2865    }
2866    my $fileOrder = $$self{FILE_ORDER};
2867
2868    if ($foundTags) {
2869        # make sure a FILE_ORDER entry exists for all tags
2870        # (note: already generated bogus entries for FOUND_TAGS case below)
2871        foreach (@$foundTags) {
2872            next if defined $$fileOrder{$_};
2873            $$fileOrder{$_} = 999;
2874        }
2875    } else {
2876        $sort = $info if $info and not $sort;
2877        $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef;
2878    }
2879    $sort or $sort = $$self{OPTIONS}{Sort};
2880
2881    # return original list if no sort order specified
2882    return @$foundTags unless $sort and $sort ne 'Input';
2883
2884    if ($sort eq 'Tag' or $sort eq 'Alpha') {
2885        return sort @$foundTags;
2886    } elsif ($sort =~ /^Group(\d*(:\d+)*)/) {
2887        my $family = $1 || 0;
2888        # want to maintain a basic file order with the groups
2889        # ordered in the way they appear in the file
2890        my (%groupCount, %groupOrder);
2891        my $numGroups = 0;
2892        my $tag;
2893        foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) {
2894            my $group = $self->GetGroup($tag, $family);
2895            my $num = $groupCount{$group};
2896            $num or $num = $groupCount{$group} = ++$numGroups;
2897            $groupOrder{$tag} = $num;
2898        }
2899        $sort2 or $sort2 = $$self{OPTIONS}{Sort2};
2900        if ($sort2) {
2901            if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') {
2902                return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags;
2903            } elsif ($sort2 eq 'Descr') {
2904                my $desc = $self->GetDescriptions($foundTags);
2905                return sort { $groupOrder{$a} <=> $groupOrder{$b} or
2906                              $$desc{$a} cmp $$desc{$b} } @$foundTags;
2907            }
2908        }
2909        return sort { $groupOrder{$a} <=> $groupOrder{$b} or
2910                      $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
2911    } elsif ($sort eq 'Descr') {
2912        my $desc = $self->GetDescriptions($foundTags);
2913        return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags;
2914    } else {
2915        return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
2916    }
2917}
2918
2919#------------------------------------------------------------------------------
2920# Get list of found tags in specified sort order
2921# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...)
2922#         2) secondary sort order
2923# Returns: List of tag keys in specified order
2924# Notes: If not specified, sort order is taken from OPTIONS
2925sub GetFoundTags($;$$)
2926{
2927    local $_;
2928    my ($self, $sort, $sort2) = @_;
2929    my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef;
2930    return $self->GetTagList($foundTags, $sort, $sort2);
2931}
2932
2933#------------------------------------------------------------------------------
2934# Get list of requested tags
2935# Inputs: 0) ExifTool object reference
2936# Returns: List of requested tag keys
2937sub GetRequestedTags($)
2938{
2939    local $_;
2940    return @{$_[0]{REQUESTED_TAGS}};
2941}
2942
2943#------------------------------------------------------------------------------
2944# Get tag value
2945# Inputs: 0) ExifTool object reference
2946#         1) tag key or tag name with optional group names (case sensitive)
2947#            (or flattened tagInfo for getting field values, not part of public API)
2948#         2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default
2949#            is PrintConv or ValueConv, depending on the PrintConv option setting
2950#         3) raw field value (not part of public API)
2951# Returns: Scalar context: tag value or undefined
2952#          List context: list of values or empty list
2953sub GetValue($$;$)
2954{
2955    local $_;
2956    my ($self, $tag, $type) = @_; # plus: ($fieldValue)
2957    my (@convTypes, $tagInfo, $valueConv, $both);
2958    my $rawValue = $$self{VALUE};
2959
2960    # get specific tag key if tag has a group name
2961    if ($tag =~ /^(.*):(.+)/) {
2962        my ($gp, $tg) = ($1, $2);
2963        my ($i, $key, @keys);
2964        # build list of tag keys in the order of priority (no index
2965        # is top priority, otherwise higher index is higher priority)
2966        for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) {
2967            push @keys, $key if defined $$rawValue{$key};
2968            last if $i <= 0;
2969            $key = "$tg ($i)";
2970        }
2971        if (@keys) {
2972            $key = $self->GroupMatches($gp, \@keys);
2973            $tag = $key if $key;
2974        }
2975    }
2976    # figure out what conversions to do
2977    if ($type) {
2978        return $$self{RATIONAL}{$tag} if $type eq 'Rational';
2979    } else {
2980        $type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
2981    }
2982
2983    # start with the raw value
2984    my $value = $$rawValue{$tag};
2985    if (not defined $value) {
2986        return () unless ref $tag;
2987        # get the value of a structure field
2988        $tagInfo = $tag;
2989        $tag = $$tagInfo{Name};
2990        $value = $_[3];
2991        # (note: type "Both" is not allowed for structure fields)
2992        if ($type ne 'Raw') {
2993            push @convTypes, 'ValueConv';
2994            push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
2995        }
2996    } else {
2997        $tagInfo = $$self{TAG_INFO}{$tag};
2998        if ($$tagInfo{Struct} and ref $value) {
2999            # must load XMPStruct.pl just in case (should already be loaded if
3000            # a structure was extracted, but we could also arrive here if a simple
3001            # list of values was stored incorrectly in a Struct tag)
3002            require 'Image/ExifTool/XMPStruct.pl';
3003            # convert strucure field values
3004            unless ($type eq 'Both') {
3005                # (note: ConvertStruct handles the filtering and escaping too if necessary)
3006                return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type);
3007            }
3008            $valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv');
3009            $value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv');
3010            # (must not save these in $$self{BOTH} because the values may have been escaped)
3011            return ($valueConv, $value);
3012        }
3013        if ($type ne 'Raw') {
3014            # use values we calculated already if we stored them
3015            $both = $$self{BOTH}{$tag};
3016            if ($both) {
3017                if ($type eq 'PrintConv') {
3018                    $value = $$both[1];
3019                } elsif ($type eq 'ValueConv') {
3020                    $value = $$both[0];
3021                    $value = $$both[1] unless defined $value;
3022                } else {
3023                    ($valueConv, $value) = @$both;
3024                }
3025            } else {
3026                push @convTypes, 'ValueConv';
3027                push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
3028            }
3029        }
3030    }
3031
3032    # do the conversions
3033    my (@val, @prt, @raw, $convType);
3034    foreach $convType (@convTypes) {
3035        # don't convert a scalar reference or structure
3036        last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary};
3037        my $conv = $$tagInfo{$convType};
3038        unless (defined $conv) {
3039            if ($convType eq 'ValueConv') {
3040                next unless $$tagInfo{Binary};
3041                $conv = '\$val';  # return scalar reference for binary values
3042            } else {
3043                # use PRINT_CONV from tag table if PrintConv doesn't exist
3044                next unless defined($conv = $$tagInfo{Table}{PRINT_CONV});
3045                next if exists $$tagInfo{$convType};
3046            }
3047        }
3048        # save old ValueConv value if we want Both
3049        $valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv';
3050        my ($i, $val, $vals, @values, $convList);
3051        # split into list if conversion is an array
3052        if (ref $conv eq 'ARRAY') {
3053            $convList = $conv;
3054            $conv = $$convList[0];
3055            my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value;
3056            # reorganize list if specified (Note: The writer currently doesn't
3057            # relist values, so they may be grouped but the order must not change)
3058            my $relist = $$tagInfo{Relist};
3059            if ($relist) {
3060                my (@newList, $oldIndex);
3061                foreach $oldIndex (@$relist) {
3062                    my ($newVal, @join);
3063                    if (ref $oldIndex) {
3064                        foreach (@$oldIndex) {
3065                            push @join, $valList[$_] if defined $valList[$_];
3066                        }
3067                        $newVal = join(' ', @join) if @join;
3068                    } else {
3069                        $newVal = $valList[$oldIndex];
3070                    }
3071                    push @newList, $newVal if defined $newVal;
3072                }
3073                $value = \@newList;
3074            } else {
3075                $value = \@valList;
3076            }
3077            return () unless @$value;
3078        }
3079        # initialize array so we can iterate over values in list
3080        if (ref $value eq 'ARRAY') {
3081            if (defined $$tagInfo{RawJoin}) {
3082                $val = join ' ', @$value;
3083            } else {
3084                $i = 0;
3085                $vals = $value;
3086                $val = $$vals[0];
3087            }
3088        } else {
3089            $val = $value;
3090        }
3091        # loop through all values in list
3092        for (;;) {
3093            if (defined $conv) {
3094                # get values of required tags if this is a Composite tag
3095                if (ref $val eq 'HASH' and not @val) {
3096                    # disable escape of source values so we don't double escape them
3097                    my $oldEscape = $$self{ESCAPE_PROC};
3098                    delete $$self{ESCAPE_PROC};
3099                    # temporarily delete filter so it isn't applied to the Require'd values
3100                    my $oldFilter = $$self{OPTIONS}{Filter};
3101                    delete $$self{OPTIONS}{Filter};
3102                    foreach (keys %$val) {
3103                        next unless defined $$val{$_};
3104                        $raw[$_] = $$rawValue{$$val{$_}};
3105                        ($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both');
3106                        next if defined $val[$_] or not $$tagInfo{Require}{$_};
3107                        $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter;
3108                        $$self{ESCAPE_PROC} = $oldEscape;
3109                        return ();
3110                    }
3111                    $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter;
3112                    $$self{ESCAPE_PROC} = $oldEscape;
3113                    # set $val to $val[0], or \@val for a CODE ref conversion
3114                    $val = ref $conv eq 'CODE' ? \@val : $val[0];
3115                }
3116                if (ref $conv eq 'HASH') {
3117                    # look up converted value in hash
3118                    if (not defined($value = $$conv{$val})) {
3119                        if ($$conv{BITMASK}) {
3120                            $value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord});
3121                        } else {
3122                             # use alternate conversion routine if available
3123                            if ($$conv{OTHER}) {
3124                                local $SIG{'__WARN__'} = \&SetWarning;
3125                                undef $evalWarning;
3126                                $value = &{$$conv{OTHER}}($val, undef, $conv);
3127                                $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning;
3128                            }
3129                            if (not defined $value) {
3130                                if ($$tagInfo{PrintHex} and $val and IsInt($val) and
3131                                    $convType eq 'PrintConv')
3132                                {
3133                                    $value = sprintf('Unknown (0x%x)',$val);
3134                                } else {
3135                                    $value = "Unknown ($val)";
3136                                }
3137                            }
3138                        }
3139                    }
3140                    # override with our localized language PrintConv if available
3141                    my $tmp;
3142                    if ($$self{CUR_LANG} and $convType eq 'PrintConv' and
3143                        # (no need to check for lang-alt tag names -- they won't have a PrintConv)
3144                        ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and
3145                        ($tmp = $$tmp{PrintConv}))
3146                    {
3147                        if ($$conv{BITMASK} and not defined $$conv{$val}) {
3148                            my @vals = split ', ', $value;
3149                            foreach (@vals) {
3150                                $_ = $$tmp{$_} if defined $$tmp{$_};
3151                            }
3152                            $value = join ', ', @vals;
3153                        } elsif (defined($tmp = $$tmp{$value})) {
3154                            $value = $self->Decode($tmp, 'UTF8');
3155                        }
3156                    }
3157                } else {
3158                    # call subroutine or do eval to convert value
3159                    local $SIG{'__WARN__'} = \&SetWarning;
3160                    undef $evalWarning;
3161                    if (ref $conv eq 'CODE') {
3162                        $value = &$conv($val, $self);
3163                    } else {
3164                        #### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw)
3165                        $value = eval $conv;
3166                        $@ and $evalWarning = $@;
3167                    }
3168                    $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning;
3169                }
3170            } else {
3171                $value = $val;
3172            }
3173            last unless $vals;
3174            # must store a separate copy of each binary data value in the list
3175            if (ref $value eq 'SCALAR') {
3176                my $tval = $$value;
3177                $value = \$tval;
3178            }
3179            # save this converted value and step to next value in list
3180            push @values, $value if defined $value;
3181            if (++$i >= scalar(@$vals)) {
3182                $value = \@values if @values;
3183                last;
3184            }
3185            $val = $$vals[$i];
3186            if ($convList) {
3187                my $nextConv = $$convList[$i];
3188                if ($nextConv and $nextConv eq 'REPEAT') {
3189                    undef $convList;
3190                } else {
3191                    $conv = $nextConv;
3192                }
3193            }
3194        }
3195        # return undefined now if no value
3196        return () unless defined $value;
3197        # join back into single value if split for conversion list
3198        if ($convList and ref $value eq 'ARRAY') {
3199            $value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value);
3200        }
3201    }
3202    if ($type eq 'Both') {
3203        # save both (unescaped) values because we often need them again
3204        # (Composite tags need "Both" and often Require one tag for various Composite tags)
3205        $$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both;
3206        # escape values if necessary
3207        if ($$self{ESCAPE_PROC}) {
3208            DoEscape($value, $$self{ESCAPE_PROC});
3209            if (defined $valueConv) {
3210                DoEscape($valueConv, $$self{ESCAPE_PROC});
3211            } else {
3212                $valueConv = $value;
3213            }
3214        } elsif (not defined $valueConv) {
3215            # $valueConv is undefined if there was no print conversion done
3216            $valueConv = $value;
3217        }
3218        $self->Filter($$self{OPTIONS}{Filter}, \$value);
3219        # return Both values as a list (ValueConv, PrintConv)
3220        return ($valueConv, $value);
3221    }
3222    # escape value if necessary
3223    DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
3224
3225    # filter if necessary
3226    $self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv';
3227
3228    if (ref $value eq 'ARRAY') {
3229        if (defined $$self{OPTIONS}{ListItem}) {
3230            $value = $$value[$$self{OPTIONS}{ListItem}];
3231        } elsif (wantarray) {
3232            # return array if requested
3233            return @$value;
3234        } elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) {
3235            # join PrintConv values in comma-separated string if List option not used
3236            # and list contains simple scalars (otherwise return ARRAY ref)
3237            $value = join $$self{OPTIONS}{ListSep}, @$value;
3238        }
3239    }
3240    return $value;
3241}
3242
3243#------------------------------------------------------------------------------
3244# Get tag identification number
3245# Inputs: 0) ExifTool object reference, 1) tag key
3246# Returns: Scalar context: tag ID if available, otherwise ''
3247#          List context: 0) tag ID (or ''), 1) language code (or undef)
3248sub GetTagID($$)
3249{
3250    my ($self, $tag) = @_;
3251    my $tagInfo = $$self{TAG_INFO}{$tag};
3252    return '' unless $tagInfo and defined $$tagInfo{TagID};
3253    return ($$tagInfo{TagID}, $$tagInfo{LangCode}) if wantarray;
3254    return $$tagInfo{TagID};
3255}
3256
3257#------------------------------------------------------------------------------
3258# Get description for specified tag
3259# Inputs: 0) ExifTool object reference, 1) tag key
3260# Returns: Tag description
3261# Notes: Will always return a defined value, even if description isn't available
3262sub GetDescription($$)
3263{
3264    local $_;
3265    my ($self, $tag) = @_;
3266    my ($desc, $name);
3267    my $tagInfo = $$self{TAG_INFO}{$tag};
3268    # ($tagInfo won't be defined for missing tags extracted with -f)
3269    if ($tagInfo) {
3270        # use alternate language description if available
3271        while ($$self{CUR_LANG}) {
3272            $desc = $$self{CUR_LANG}{$$tagInfo{Name}};
3273            if ($desc) {
3274                # must look up Description if this tag also has a PrintConv
3275                $desc = $$desc{Description} or last if ref $desc;
3276            } else {
3277                # look up default language of lang-alt tag
3278                last unless $$tagInfo{LangCode} and
3279                    ($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and
3280                    $desc = $$self{CUR_LANG}{$name};
3281                $desc = $$desc{Description} or last if ref $desc;
3282                $desc .= " ($$tagInfo{LangCode})";
3283            }
3284            # escape description if necessary
3285            DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
3286            # return description in proper Charset
3287            return $self->Decode($desc, 'UTF8');
3288        }
3289        $desc = $$tagInfo{Description};
3290    }
3291    # just make the tag more readable if description doesn't exist
3292    unless ($desc) {
3293        $desc = MakeDescription(GetTagName($tag));
3294        # save description in tag information
3295        $$tagInfo{Description} = $desc if $tagInfo;
3296    }
3297    return $desc;
3298}
3299
3300#------------------------------------------------------------------------------
3301# Get group name for specified tag
3302# Inputs: 0) ExifTool object reference
3303#         1) tag key (or reference to tagInfo hash, not part of the public API)
3304#         2) [optional] group family (-1 to get extended group list, or multiple
3305#            families separated by colons to return multiple groups as a string)
3306# Returns: Scalar context: group name (for family 0 if not otherwise specified)
3307#          List context: group name if family specified, otherwise list of
3308#          group names for each family.  Returns '' for undefined tag.
3309# Notes: Multiple families may be specified with ':' in family argument (eg. '1:2')
3310sub GetGroup($$;$)
3311{
3312    local $_;
3313    my ($self, $tag, $family) = @_;
3314    my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID);
3315    if (ref $tag eq 'HASH') {
3316        $tagInfo = $tag;
3317        $tag = $$tagInfo{Name};
3318        # set flag so we don't get extra information for an extracted tag
3319        $byTagInfo = 1;
3320    } else {
3321        $tagInfo = $$self{TAG_INFO}{$tag} || { };
3322        $ex = $$self{TAG_EXTRA}{$tag};
3323    }
3324    my $groups = $$tagInfo{Groups};
3325    # fill in default groups unless already done
3326    # (after this, Groups 0-2 in tagInfo are guaranteed to be defined)
3327    unless ($$tagInfo{GotGroups}) {
3328        my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } };
3329        # construct our group list
3330        $groups or $groups = $$tagInfo{Groups} = { };
3331        # fill in default groups
3332        foreach (0..2) {
3333            $$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_};
3334        }
3335        # set flag indicating group list was built
3336        $$tagInfo{GotGroups} = 1;
3337    }
3338    if (defined $family and $family ne '-1') {
3339        if ($family =~ /[^\d]/) {
3340            @families = ($family =~ /\d+/g);
3341            return(($ex && $$ex{G0}) || $$groups{0}) unless @families;
3342            $simplify = 1 unless $family =~ /^:/;
3343            undef $family;
3344            foreach (0..2) { $groups[$_] = $$groups{$_}; }
3345            $noID = 1 if @families == 1 and $families[0] != 7;
3346        } else {
3347            return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2;
3348            $groups[1] = $$groups{1};
3349        }
3350    } else {
3351        return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray;
3352        foreach (0..2) { $groups[$_] = $$groups{$_}; }
3353    }
3354    $groups[3] = 'Main';
3355    $groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : '';
3356    # handle dynamic group names if necessary
3357    unless ($byTagInfo) {
3358        if ($ex) {
3359            $groups[0] = $$ex{G0} if $$ex{G0};
3360            $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1};
3361            $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3};
3362            $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5};
3363            if (defined $$ex{G6}) {
3364                $groups[5] = '' unless defined $groups[5];  # (can't leave a hole in the array)
3365                $groups[6] = $$ex{G6};
3366            }
3367        }
3368        # generate tag ID group names unless obviously not needed
3369        unless ($noID) {
3370            my $id = $$tagInfo{TagID};
3371            if (not defined $id) {
3372                $id = '';   # (just to be safe)
3373            } elsif ($id =~ /^\d+$/) {
3374                $id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs};
3375            } else {
3376                $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge;
3377            }
3378            $groups[7] = 'ID-' . $id;
3379            defined $groups[$_] or $groups[$_] = '' foreach (5,6);
3380        }
3381    }
3382    if ($family) {
3383        return $groups[$family] || '' if $family > 0;
3384        # add additional matching group names to list
3385        # eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1
3386        # and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc
3387        if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) {
3388            push @groups, 'MIE' . ($1 || '1');
3389            push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3";
3390            push @groups, "MIE$1-$2" . ($3 ? '' : '1');
3391            push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1');
3392        }
3393    }
3394    if (@families) {
3395        my @grps;
3396        # create list of group names (without identical adjacent groups if simplifying)
3397        foreach (@families) {
3398            my $grp = $groups[$_];
3399            unless ($grp) {
3400                next if $simplify;
3401                $grp = '';
3402            }
3403            push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1];
3404        }
3405        # remove leading "Main:" if simplifying
3406        shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main';
3407        # return colon-separated string of group names
3408        return join ':', @grps;
3409    }
3410    return @groups;
3411}
3412
3413#------------------------------------------------------------------------------
3414# Get group names for specified tags
3415# Inputs: 0) ExifTool object reference
3416#         1) [optional] information hash reference (default all extracted info)
3417#         2) [optional] group family (default 0)
3418# Returns: List of group names in alphabetical order
3419sub GetGroups($;$$)
3420{
3421    local $_;
3422    my $self = shift;
3423    my $info = shift;
3424    my $family;
3425
3426    # figure out our arguments
3427    if (ref $info ne 'HASH') {
3428        $family = $info;
3429        $info = $$self{VALUE};
3430    } else {
3431        $family = shift;
3432    }
3433    $family = 0 unless defined $family;
3434
3435    # get a list of all groups in specified information
3436    my ($tag, %groups);
3437    foreach $tag (keys %$info) {
3438        $groups{ $self->GetGroup($tag, $family) } = 1;
3439    }
3440    return sort keys %groups;
3441}
3442
3443#------------------------------------------------------------------------------
3444# Set priority for group where new values are written
3445# Inputs: 0) ExifTool object reference,
3446#         1-N) group names (reset to default if no groups specified)
3447# - used when new tag values are set (ie. before files are written)
3448sub SetNewGroups($;@)
3449{
3450    local $_;
3451    my ($self, @groups) = @_;
3452    @groups or @groups = @defaultWriteGroups;
3453    my $count = @groups * 10;
3454    my %priority;
3455    foreach (@groups) {
3456        $priority{lc($_)} = $count;
3457        $count -= 10;
3458    }
3459    $priority{file} = 500;      # 'File' group is always written (Comment)
3460    $priority{composite} = 500; # 'Composite' group is always written
3461    # set write priority (higher # is higher priority)
3462    $$self{WRITE_PRIORITY} = \%priority;
3463    $$self{WRITE_GROUPS} = \@groups;
3464}
3465
3466#------------------------------------------------------------------------------
3467# Build Composite tags from Require'd/Desire'd tags
3468# Inputs: 0) ExifTool object reference
3469# Note: Tag values are calculated in alphabetical order unless a tag Require's
3470#       or Desire's another Composite tag, in which case the calculation is
3471#       deferred until after the other tag is calculated.
3472sub BuildCompositeTags($)
3473{
3474    local $_;
3475    my $self = shift;
3476
3477    $$self{BuildingComposite} = 1;
3478
3479    my $compTable = GetTagTable('Image::ExifTool::Composite');
3480    my @tagList = sort keys %$compTable;
3481    my $rawValue = $$self{VALUE};
3482    my $compKeys = $$self{COMP_KEYS};
3483    my (%cache, $allBuilt);
3484
3485    for (;;) {
3486        my (%notBuilt, $tag, @deferredTags);
3487        foreach (@tagList) {
3488            $notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_};
3489        }
3490COMPOSITE_TAG:
3491        foreach $tag (@tagList) {
3492            next if $specialTags{$tag};
3493            my $tagInfo = $self->GetTagInfo($compTable, $tag);
3494            next unless $tagInfo;
3495            my $tagName = $$compTable{$tag}{Name};
3496            # put required tags into array and make sure they all exist
3497            my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT});
3498            my $require = $$tagInfo{Require} || { };
3499            my $desire  = $$tagInfo{Desire}  || { };
3500            my $inhibit = $$tagInfo{Inhibit} || { };
3501            # loop through sub-documents if necessary
3502            my $docNum = 0;
3503            for (;;) {
3504                my (%tagKey, $found, $index);
3505                # save Require'd and Desire'd tag values in list
3506                for ($index=0; ; ++$index) {
3507                    my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index};
3508                    unless ($reqTag) {
3509                        # allow Composite with no Require'd or Desire'd tags
3510                        $found = 1 if $index == 0;
3511                        last;
3512                    }
3513                    if ($subDoc) {
3514                        # handle SubDoc tags specially to cache tag keys for faster
3515                        # processing when there are a large number of sub-documents
3516                        # - get document number from the tag groups if specified,
3517                        #   otherwise we are looping through all documents for this tag
3518                        my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum;
3519                        # make fast lookup for keys of this tag with specified groups other than doc group
3520                        # (similar to code in InsertTagValues(), but this is case-sensitive)
3521                        my $cacheTag = $cache{$reqTag};
3522                        unless ($cacheTag) {
3523                            $cacheTag = $cache{$reqTag} = [ ];
3524                            my $reqGroup;
3525                            $reqTag =~ s/^(.*):// and $reqGroup = $1;
3526                            my ($i, $key, @keys);
3527                            # build list of tag keys in order of precedence
3528                            for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) {
3529                                push @keys, $key if defined $$rawValue{$key};
3530                                last if $i <= 0;
3531                                $key = "$reqTag ($i)";
3532                            }
3533                            @keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup;
3534                            if (@keys) {
3535                                my $ex = $$self{TAG_EXTRA};
3536                                # loop through tags in reverse order of precedence so the higher
3537                                # priority tag will win in the case of duplicates within a doc
3538                                $$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys;
3539                            }
3540                        }
3541                        # (set $reqTag to a bogus key if not found)
3542                        $reqTag = $$cacheTag[$doc] || "$reqTag (0)";
3543                    } elsif ($reqTag =~ /^(.*):(.+)/) {
3544                        my ($reqGroup, $name) = ($1, $2);
3545                        if ($reqGroup eq 'Composite' and $notBuilt{$name}) {
3546                            # defer only until all other tags are built if
3547                            # we are inhibiting based on another Composite tag
3548                            unless ($$inhibit{$index} and $allBuilt) {
3549                                push @deferredTags, $tag;
3550                                next COMPOSITE_TAG;
3551                            }
3552                        }
3553                        # (CAREFUL! keys may not be sequential if one was deleted)
3554                        my ($i, $key, @keys);
3555                        for ($key=$name, $i=$$self{DUPL_TAG}{$name} || 0; ; --$i) {
3556                            push @keys, $key if defined $$rawValue{$key};
3557                            last if $i <= 0;
3558                            $key = "$name ($i)";
3559                        }
3560                        # find first matching tag
3561                        $key = $self->GroupMatches($reqGroup, \@keys);
3562                        $reqTag = $key || "$name (0)";
3563                    } elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) {
3564                        # calculate this tag later if it relies on another
3565                        # Composite tag which hasn't been calculated yet
3566                        push @deferredTags, $tag;
3567                        next COMPOSITE_TAG;
3568                    }
3569                    if (defined $$rawValue{$reqTag}) {
3570                        if ($$inhibit{$index}) {
3571                            $found = 0;
3572                            last;
3573                        } else {
3574                            $found = 1;
3575                        }
3576                    } elsif ($$require{$index}) {
3577                        $found = 0;
3578                        last;   # don't continue since we require this tag
3579                    }
3580                    $tagKey{$index} = $reqTag;
3581                }
3582                if ($docNum) {
3583                    if ($found) {
3584                        $$self{DOC_NUM} = $docNum;
3585                        # save pointers to all used tag keys
3586                        foreach (keys %tagKey) {
3587                            $$compKeys{$_} or $$compKeys{$_} = [ ];
3588                            push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ];
3589                        }
3590                        $self->FoundTag($tagInfo, \%tagKey);
3591                        delete $$self{DOC_NUM};
3592                    }
3593                    next if ++$docNum <= $$self{DOC_COUNT};
3594                    last;
3595                } elsif ($found) {
3596                    delete $notBuilt{$tagName}; # this tag is OK to build now
3597                    # keep track of all Require'd tag keys
3598                    foreach (keys %tagKey) {
3599                        # only tag keys with same name as a Composite tag
3600                        # can be replaced (also eliminates keys with
3601                        # instance numbers which can't be replaced either)
3602                        next unless $compositeID{$tagKey{$_}};
3603                    }
3604                    # save pointers to all used tag keys
3605                    foreach (keys %tagKey) {
3606                        $$compKeys{$_} or $$compKeys{$_} = [ ];
3607                        push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ];
3608                    }
3609                    # save reference to tag key lookup as value for Composite tag
3610                    my $key = $self->FoundTag($tagInfo, \%tagKey);
3611                } elsif (not defined $found) {
3612                    delete $notBuilt{$tagName}; # tag can't be built anyway
3613                }
3614                last unless $subDoc;
3615                # don't process sub-documents if there is no chance to build this tag
3616                # (can be very time-consuming if there are many docs)
3617                if (%$require) {
3618                    foreach (keys %$require) {
3619                        my $reqTag = $$require{$_};
3620                        $reqTag =~ s/.*://;
3621                        next COMPOSITE_TAG unless defined $$rawValue{$reqTag};
3622                    }
3623                    $docNum = 1;   # go ahead and process the 1st sub-document
3624                } else {
3625                    my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire;
3626                    # at least one of the specified desire tags must exist
3627                    foreach (@try) {
3628                        my $desTag = $$desire{$_} or next;
3629                        $desTag =~ s/.*://;
3630                        defined $$rawValue{$desTag} and $docNum = 1, last;
3631                    }
3632                    last unless $docNum;
3633                }
3634            }
3635        }
3636        last unless @deferredTags;
3637        if (@deferredTags == @tagList) {
3638            if ($allBuilt) {
3639                # everything was deferred in the last pass,
3640                # must be a circular dependency
3641                warn "Circular dependency in Composite tags\n";
3642                last;
3643            }
3644            $allBuilt = 1;  # try once more, ignoring Composite Inhibit tags
3645        }
3646        @tagList = @deferredTags; # calculate deferred tags now
3647    }
3648    delete $$self{BuildingComposite};
3649}
3650
3651#------------------------------------------------------------------------------
3652# Get reference to Composite tag info hash
3653# Inputs: 0) case-sensitive Composite tag name
3654# Returns: tagInfo hash or undef
3655sub GetCompositeTagInfo($)
3656{
3657    my $tag = shift;
3658    return undef unless $compositeID{$tag};
3659    return $Image::ExifTool::Composite{$compositeID{$tag}[0]};
3660}
3661
3662#------------------------------------------------------------------------------
3663# Get tag name (removes copy index)
3664# Inputs: 0) Tag key
3665# Returns: Tag name
3666sub GetTagName($)
3667{
3668    local $_;
3669    $_[0] =~ /^(\S+)/;
3670    return $1;
3671}
3672
3673#------------------------------------------------------------------------------
3674# Get list of shortcuts
3675# Returns: Shortcut list (sorted alphabetically)
3676sub GetShortcuts()
3677{
3678    local $_;
3679    require Image::ExifTool::Shortcuts;
3680    return sort keys %Image::ExifTool::Shortcuts::Main;
3681}
3682
3683#------------------------------------------------------------------------------
3684# Get file type for specified extension
3685# Inputs: 0) file name or extension (case is not significant),
3686#            or FileType value if a description is requested
3687#         1) flag to return long description instead of type ('0' to return any recognized type)
3688# Returns: File type (or desc) or undef if extension not supported or if
3689#          description is the same as the input FileType.  In list context,
3690#          may return more than one file type if the file may be different formats.
3691#          Returns list of all supported extensions if no file specified
3692sub GetFileType(;$$)
3693{
3694    local $_;
3695    my ($file, $desc) = @_;
3696    unless (defined $file) {
3697        my @types;
3698        if (defined $desc and $desc eq '0') {
3699            # return all recognized types
3700            @types = sort keys %fileTypeLookup;
3701        } else {
3702            # return all supported types
3703            foreach (sort keys %fileTypeLookup) {
3704                my $module = $moduleName{$_};
3705                $module = $moduleName{$fileTypeLookup{$_}} unless defined $module;
3706                push @types, $_ unless defined $module and $module eq '0';
3707            }
3708        }
3709        return @types;
3710    }
3711    my ($fileType, $subType);
3712    my $fileExt = GetFileExtension($file);
3713    unless ($fileExt) {
3714        if ($file =~ s/ \((.*)\)$//) {
3715            $subType = $1;
3716            $fileExt = GetFileExtension($file);
3717        }
3718        $fileExt = uc($file) unless $fileExt;
3719    }
3720    $fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type
3721    $fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType;
3722    # return description if specified
3723    # (allow input $file to be a FileType for this purpose)
3724    if ($desc) {
3725        $desc = $fileType ? $$fileType[1] : $fileDescription{$file};
3726        $desc .= ", $subType" if $subType;
3727        return $desc;
3728    } elsif ($fileType and (not defined $desc or $desc ne '0')) {
3729        # return only supported file types
3730        my $mod = $moduleName{$$fileType[0]};
3731        undef $fileType if defined $mod and $mod eq '0';
3732    }
3733    $fileType or return ();
3734    $fileType = $$fileType[0];      # get file type (or list of types)
3735    if (wantarray) {
3736        return @$fileType if ref $fileType eq 'ARRAY';
3737    } elsif ($fileType) {
3738        $fileType = $fileExt if ref $fileType eq 'ARRAY';
3739    }
3740    return $fileType;
3741}
3742
3743#------------------------------------------------------------------------------
3744# Return true if we can write the specified file type
3745# Inputs: 0) file name or ext
3746# Returns: true if writable, 0 if not writable, undef if unrecognized
3747sub CanWrite($)
3748{
3749    local $_;
3750    my $file = shift or return undef;
3751    my ($type) = GetFileType($file) or return undef;
3752    if ($noWriteFile{$type}) {
3753        # can't write TIFF files with certain extensions (various RAW formats)
3754        my $ext = GetFileExtension($file) || uc($file);
3755        return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext;
3756    }
3757    unless (%writeTypes) {
3758        $writeTypes{$_} = 1 foreach @writeTypes;
3759    }
3760    return $writeTypes{$type};
3761}
3762
3763#------------------------------------------------------------------------------
3764# Return true if we can create the specified file type
3765# Inputs: 0) file name or ext
3766# Returns: true if creatable, 0 if not writable, undef if unrecognized
3767sub CanCreate($)
3768{
3769    local $_;
3770    my $file = shift or return undef;
3771    my $ext = GetFileExtension($file) || uc($file);
3772    my $type = GetFileType($file) or return undef;
3773    return 1 if $createTypes{$ext} or $createTypes{$type};
3774    return 0;
3775}
3776
3777#==============================================================================
3778# Functions below this are not part of the public API
3779
3780# Initialize member variables for reading or writing a new file
3781# Inputs: 0) ExifTool object reference
3782sub Init($)
3783{
3784    local $_;
3785    my $self = shift;
3786    # delete all DataMember variables (lower-case names)
3787    foreach (keys %$self) {
3788        /[a-z]/ and delete $$self{$_};
3789    }
3790    delete $$self{FOUND_TAGS};      # list of found tags
3791    delete $$self{EXIF_DATA};       # the EXIF data block
3792    delete $$self{EXIF_POS};        # EXIF position in file
3793    delete $$self{FIRST_EXIF_POS};  # position of first EXIF in file
3794    delete $$self{HTML_DUMP};       # html dump information
3795    delete $$self{SET_GROUP0};      # group0 name override
3796    delete $$self{SET_GROUP1};      # group1 name override
3797    delete $$self{DOC_NUM};         # current embedded document number
3798    $$self{DOC_COUNT}  = 0;         # count of embedded documents processed
3799    $$self{BASE}       = 0;         # base for offsets from start of file
3800    $$self{FILE_ORDER} = { };       # * hash of tag order in file ('*' = based on tag key)
3801    $$self{VALUE}      = { };       # * hash of raw tag values
3802    $$self{BOTH}       = { };       # * hash for Value/PrintConv values of Require'd tags
3803    $$self{RATIONAL}   = { };       # * hash of original rational components
3804    $$self{TAG_INFO}   = { };       # * hash of tag information
3805    $$self{TAG_EXTRA}  = { };       # * hash of extra tag information (dynamic group names)
3806    $$self{PRIORITY}   = { };       # * priority of current tags
3807    $$self{LIST_TAGS}  = { };       # hash of tagInfo refs for active List-type tags
3808    $$self{PROCESSED}  = { };       # hash of processed directory start positions
3809    $$self{DIR_COUNT}  = { };       # count various types of directories
3810    $$self{DUPL_TAG}   = { };       # last-used index for duplicate-tag keys
3811    $$self{WARNED_ONCE}= { };       # WarnOnce() warnings already issued
3812    $$self{WRITTEN}    = { };       # list of tags written (selected tags only)
3813    $$self{FORCE_WRITE}= { };       # ForceWrite lookup (set from ForceWrite tag)
3814    $$self{FOUND_DIR}  = { };       # hash of directory names found in file
3815    $$self{COMP_KEYS}  = { };       # lookup for tag keys used in Composite tags
3816    $$self{PATH}       = [ ];       # current subdirectory path in file when reading
3817    $$self{NUM_FOUND}  = 0;         # total number of tags found (incl. duplicates)
3818    $$self{CHANGED}    = 0;         # number of tags changed (writer only)
3819    $$self{INDENT}     = '  ';      # initial indent for verbose messages
3820    $$self{PRIORITY_DIR} = '';      # the priority directory name
3821    $$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories
3822    $$self{TIFF_TYPE}  = '';        # type of TIFF data (APP1, TIFF, NEF, etc...)
3823    $$self{FMT_EXPR}   = undef;     # current advanced formatting expression
3824    $$self{Make}       = '';        # camera make
3825    $$self{Model}      = '';        # camera model
3826    $$self{CameraType} = '';        # Olympus camera type
3827    $$self{FileType}   = '';        # identified file type
3828    if ($self->Options('HtmlDump')) {
3829        require Image::ExifTool::HtmlDump;
3830        $$self{HTML_DUMP} = new Image::ExifTool::HtmlDump;
3831    }
3832    # make sure our TextOut is a file reference
3833    $$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut};
3834}
3835
3836#------------------------------------------------------------------------------
3837# Combine information from a list of info hashes
3838# Unless Duplicates is enabled, first entry found takes priority
3839# Inputs: 0) ExifTool object reference, 1-N) list of info hash references
3840# Returns: Combined information hash reference
3841sub CombineInfo($;@)
3842{
3843    local $_;
3844    my $self = shift;
3845    my (%combinedInfo, $info, $tag, %haveInfo);
3846
3847    if ($$self{OPTIONS}{Duplicates}) {
3848        while ($info = shift) {
3849            foreach $tag (keys %$info) {
3850                $combinedInfo{$tag} = $$info{$tag};
3851            }
3852        }
3853    } else {
3854        while ($info = shift) {
3855            foreach $tag (keys %$info) {
3856                my $tagName = GetTagName($tag);
3857                next if $haveInfo{$tagName};
3858                $haveInfo{$tagName} = 1;
3859                $combinedInfo{$tag} = $$info{$tag};
3860            }
3861        }
3862    }
3863    return \%combinedInfo;
3864}
3865
3866#------------------------------------------------------------------------------
3867# Get tag table name
3868# Inputs: 0) ExifTool object reference, 1) tag key
3869# Returns: Table name if available, otherwise ''
3870sub GetTableName($$)
3871{
3872    my ($self, $tag) = @_;
3873    my $tagInfo = $$self{TAG_INFO}{$tag} or return '';
3874    return $$tagInfo{Table}{SHORT_NAME};
3875}
3876
3877#------------------------------------------------------------------------------
3878# Get tag index number
3879# Inputs: 0) ExifTool object reference, 1) tag key
3880# Returns: Table index number, or undefined if this tag isn't indexed
3881sub GetTagIndex($$)
3882{
3883    my ($self, $tag) = @_;
3884    my $tagInfo = $$self{TAG_INFO}{$tag} or return undef;
3885    return $$tagInfo{Index};
3886}
3887
3888#------------------------------------------------------------------------------
3889# Find value for specified tag
3890# Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1)
3891# Returns: value or undef
3892sub FindValue($$$)
3893{
3894    my ($et, $tag, $grp) = @_;
3895    my ($i, $val);
3896    my $value = $$et{VALUE};
3897    for ($i=0; ; ++$i) {
3898        my $key = $tag . ($i ? " ($i)" : '');
3899        last unless defined $$value{$key};
3900        if ($et->GetGroup($key, 1) eq $grp) {
3901            $val = $$value{$key};
3902            last;
3903        }
3904    }
3905    return $val;
3906}
3907
3908#------------------------------------------------------------------------------
3909# Get tag key for next existing tag
3910# Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name
3911# Returns: Key of next existing tag, or undef if no more
3912# Notes: This routine is provided for iterating through duplicate tags in the
3913#        ValueConv of Composite tags.
3914sub NextTagKey($$)
3915{
3916    my ($self, $tag) = @_;
3917    my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1;
3918    $tag = "$tag ($i)";
3919    return $tag if defined $$self{VALUE}{$tag};
3920    return undef;
3921}
3922
3923#------------------------------------------------------------------------------
3924# Split file name into directory and name parts
3925# Inptus: 0) file name
3926# Returns: 0) directory, 1) filename
3927sub SplitFileName($)
3928{
3929    my $file = shift;
3930    my ($dir, $name);
3931    if (eval { require File::Basename }) {
3932        $dir = File::Basename::dirname($file);
3933        $name = File::Basename::basename($file);
3934    } else {
3935        ($name = $file) =~ tr/\\/\//;
3936        # remove path
3937        $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///;
3938    }
3939    return ($dir, $name);
3940}
3941
3942#------------------------------------------------------------------------------
3943# Encode file name for calls to system i/o routines
3944# Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion
3945# Returns: true if Windows Unicode routines should be used (in which case
3946#          the file name will be encoded as a null-terminated UTF-16LE string)
3947sub EncodeFileName($$;$)
3948{
3949    my ($self, $file, $force) = @_;
3950    my $enc = $$self{OPTIONS}{CharsetFileName};
3951    if ($enc) {
3952        if ($file =~ /[\x80-\xff]/ or $force) {
3953            # encode for use in Windows Unicode functions if necessary
3954            if ($^O eq 'MSWin32') {
3955                local $SIG{'__WARN__'} = \&SetWarning;
3956                if (eval { require Win32API::File }) {
3957                    # recode as UTF-16LE and add null terminator
3958                    $_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0";
3959                    return 1;
3960                }
3961                $self->WarnOnce('Install Win32API::File for Windows Unicode file support');
3962            } else {
3963                # recode as UTF-8 for other platforms if necessary
3964                $_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8';
3965            }
3966        }
3967    } elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) {
3968        require Image::ExifTool::XMP;
3969        if (Image::ExifTool::XMP::IsUTF8(\$file) < 0) {
3970            $self->WarnOnce('FileName encoding not specified');
3971        }
3972    }
3973    return 0;
3974}
3975
3976#------------------------------------------------------------------------------
3977# Modified perl open() routine to properly handle special characters in file names
3978# Inputs: 0) ExifTool ref, 1) filehandle, 2) filename,
3979#         3) mode: '<' or undef = read, '>' = write, '+<' = update
3980# Returns: true on success
3981# Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid
3982#       "unopened filehandle" errors due to a change in scope of the filehandle
3983sub Open($*$;$)
3984{
3985    my ($self, $fh, $file, $mode) = @_;
3986
3987    $file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand
3988    # default to read mode ('<') unless input is a pipe
3989    $mode = ($file =~ /\|$/ ? '' : '<') unless $mode;
3990    if ($mode) {
3991        if ($self->EncodeFileName($file)) {
3992            # handle Windows Unicode file name
3993            local $SIG{'__WARN__'} = \&SetWarning;
3994            my ($access, $create);
3995            if ($mode eq '>') {
3996                eval {
3997                    $access  = Win32API::File::GENERIC_WRITE();
3998                    $create  = Win32API::File::CREATE_ALWAYS();
3999                }
4000            } else {
4001                eval {
4002                    $access  = Win32API::File::GENERIC_READ();
4003                    $access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update
4004                    $create  = Win32API::File::OPEN_EXISTING();
4005                }
4006            }
4007            my $share = 0;
4008            eval {
4009                unless ($access & Win32API::File::GENERIC_WRITE()) {
4010                    $share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE();
4011                }
4012            };
4013            my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) };
4014            return undef unless $wh;
4015            my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) };
4016            if (not defined $fd or $fd < 0) {
4017                eval { Win32API::File::CloseHandle($wh) };
4018                return undef;
4019            }
4020            $file = "&=$fd";    # specify file by descriptor
4021        } else {
4022            # add leading space to protect against leading characters like '>'
4023            # in file name, and trailing "\0" to protect trailing spaces
4024            $file = " $file\0";
4025        }
4026    }
4027    return open $fh, "$mode$file";
4028}
4029
4030#------------------------------------------------------------------------------
4031# Check to see if a file exists (with Windows Unicode support)
4032# Inputs: 0) ExifTool ref, 1) file name
4033# Returns: true if file exists
4034sub Exists($$)
4035{
4036    my ($self, $file) = @_;
4037
4038    if ($self->EncodeFileName($file)) {
4039        local $SIG{'__WARN__'} = \&SetWarning;
4040        my $wh = eval { Win32API::File::CreateFileW($file,
4041                        Win32API::File::GENERIC_READ(),
4042                        Win32API::File::FILE_SHARE_READ(), [],
4043                        Win32API::File::OPEN_EXISTING(), 0, []) };
4044        return 0 unless $wh;
4045        eval { Win32API::File::CloseHandle($wh) };
4046    } else {
4047        return -e $file;
4048    }
4049    return 1;
4050}
4051
4052#------------------------------------------------------------------------------
4053# Return true if file is a directory (with Windows Unicode support)
4054# Inputs: 0) ExifTool ref, 1) file name
4055# Returns: true if file is a directory (false if file isn't, or doesn't exist)
4056sub IsDirectory($$)
4057{
4058    my ($et, $file) = @_;
4059    if ($et->EncodeFileName($file)) {
4060        local $SIG{'__WARN__'} = \&SetWarning;
4061        my $attrs = eval { Win32API::File::GetFileAttributesW($file) };
4062        my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0;
4063        return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit;
4064    } else {
4065        return -d $file;
4066    }
4067    return 0;
4068}
4069
4070#------------------------------------------------------------------------------
4071# Get file times (Unix seconds since the epoch)
4072# Inputs: 0) ExifTool ref, 1) file name or ref
4073# Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error)
4074my $k32GetFileTime;
4075sub GetFileTime($$)
4076{
4077    my ($self, $file) = @_;
4078
4079    # open file by name if necessary
4080    unless (ref $file) {
4081        local *FH;
4082        $self->Open(\*FH, $file) or $self->Warn("GetFileTime error for '${file}'"), return ();
4083        $file = *FH;  # (not \*FH, so *FH will be kept open until $file goes out of scope)
4084    }
4085    # on Windows, try to work around incorrect file times when daylight saving time is in effect
4086    if ($^O eq 'MSWin32') {
4087        if (not eval { require Win32::API }) {
4088            $self->WarnOnce('Install Win32::API for proper handling of Windows file times');
4089        } elsif (not eval { require Win32API::File }) {
4090            $self->WarnOnce('Install Win32API::File for proper handling of Windows file times');
4091        } else {
4092            # get Win32 handle, needed for GetFileTime
4093            my $win32Handle = eval { Win32API::File::GetOsFHandle($file) };
4094            unless ($win32Handle) {
4095                $self->Warn("Win32API::File::GetOsFHandle returned invalid handle");
4096                return ();
4097            }
4098            # get FILETIME structs
4099            my ($atime, $mtime, $ctime, $time);
4100            $atime = $mtime = $ctime = pack 'LL', 0, 0;
4101            unless ($k32GetFileTime) {
4102                return () if defined $k32GetFileTime;
4103                $k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I');
4104                unless ($k32GetFileTime) {
4105                    $self->Warn('Error calling Win32::API::GetFileTime');
4106                    $k32GetFileTime = 0;
4107                    return ();
4108                }
4109            }
4110            unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) {
4111                $self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError());
4112                return ();
4113            }
4114            # convert FILETIME structs to Unix seconds
4115            foreach $time ($atime, $mtime, $ctime) {
4116                my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct
4117                # FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601
4118                # (89 leap years between 1601 and 1970)
4119                $time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600);
4120            }
4121            return ($atime, $mtime, $ctime);
4122        }
4123    }
4124    # other os (or Windows fallback)
4125    return (stat $file)[8, 9, 10];
4126}
4127
4128#------------------------------------------------------------------------------
4129# Parse function arguments and set member variables accordingly
4130# Inputs: Same as ImageInfo()
4131# - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS
4132sub ParseArguments($;@)
4133{
4134    my $self = shift;
4135    my $options = $$self{OPTIONS};
4136    my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}};
4137    my (@exclude, $wasExcludeOpt);
4138
4139    $$self{REQUESTED_TAGS}  = [ ];
4140    $$self{REQ_TAG_LOOKUP}  = { };
4141    $$self{EXCL_TAG_LOOKUP} = { };
4142    $$self{IO_TAG_LIST} = undef;
4143
4144    # handle our input arguments
4145    while (@_) {
4146        my $arg = shift;
4147        if (ref $arg and not overload::Method($arg, q[""])) {
4148            if (ref $arg eq 'ARRAY') {
4149                $$self{IO_TAG_LIST} = $arg;
4150                foreach (@$arg) {
4151                    if (/^-(.*)/) {
4152                        push @exclude, $1;
4153                    } else {
4154                        push @{$$self{REQUESTED_TAGS}}, $_;
4155                    }
4156                }
4157            } elsif (ref $arg eq 'HASH') {
4158                my $opt;
4159                foreach $opt (keys %$arg) {
4160                    # a single new group option overrides all old group options
4161                    if (@oldGroupOpts and $opt =~ /^Group/) {
4162                        foreach (@oldGroupOpts) {
4163                            delete $$options{$_};
4164                        }
4165                        undef @oldGroupOpts;
4166                    }
4167                    $self->Options($opt, $$arg{$opt});
4168                    $opt eq 'Exclude' and $wasExcludeOpt = 1;
4169                }
4170            } elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) {
4171                next if defined $$self{RAF};
4172                # convert image data from UTF-8 to character stream if necessary
4173                # (patches RHEL 3 UTF8 LANG problem)
4174                if (ref $arg eq 'SCALAR' and $] >= 5.006 and
4175                    (eval { require Encode; Encode::is_utf8($$arg) } or $@))
4176                {
4177                    # repack by hand if Encode isn't available
4178                    my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg);
4179                    $arg = \$buff;
4180                }
4181                $$self{RAF} = new File::RandomAccess($arg);
4182                # set filename to empty string to indicate that
4183                # we have a file but we didn't open it
4184                $$self{FILENAME} = '';
4185            } elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) {
4186                $$self{RAF} = $arg;
4187                $$self{FILENAME} = '';
4188            } else {
4189                warn "Don't understand ImageInfo argument $arg\n";
4190            }
4191        } elsif (defined $$self{FILENAME}) {
4192            if ($arg =~ /^-(.*)/) {
4193                push @exclude, $1;
4194            } else {
4195                push @{$$self{REQUESTED_TAGS}}, $arg;
4196            }
4197        } else {
4198            $$self{FILENAME} = $arg;
4199        }
4200    }
4201    # add additional requested tags to lookup
4202    if ($$options{RequestTags}) {
4203        $$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}};
4204    }
4205    # expand shortcuts in tag arguments if provided
4206    if (@{$$self{REQUESTED_TAGS}}) {
4207        ExpandShortcuts($$self{REQUESTED_TAGS});
4208        # initialize lookup for requested tags
4209        foreach (@{$$self{REQUESTED_TAGS}}) {
4210            /^(.*:)?([-\w?*]*)#?$/ or next;
4211            $$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2;
4212            next unless $1;
4213            $$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1;
4214        }
4215    }
4216    if (@exclude or $wasExcludeOpt) {
4217        # must add existing excluded tags
4218        push @exclude, @{$$options{Exclude}} if $$options{Exclude};
4219        $$options{Exclude} = \@exclude;
4220        # expand shortcuts in new exclude list
4221        ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix)
4222    }
4223    # generate lookup for excluded tags
4224    if ($$options{Exclude}) {
4225        foreach (@{$$options{Exclude}}) {
4226            /([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc($1)} = 1;
4227        }
4228        # exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set
4229        undef $$options{Exclude} if $$self{TAGS_FROM_FILE};
4230    }
4231}
4232
4233#------------------------------------------------------------------------------
4234# Does group name match the tag ID?
4235# Inputs: 0) tag ID, 1) group name (with "ID-" removed)
4236# Returns: true on success
4237sub IsSameID($$)
4238{
4239    my ($id, $grp) = @_;
4240    return 1 if $grp eq $id;    # decimal ID's or raw ID's
4241    if ($id =~ /^\d+$/) {       # numerical numerical ID's may be in hex
4242        return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id);
4243    } else {                    # other ID's may conform to ExifTool group name conventions
4244        return 1 if $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $id;
4245    }
4246    return 0;
4247}
4248
4249#------------------------------------------------------------------------------
4250# Get list of tags in specified group
4251# Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys
4252# Returns: list of matching tags in list context, or first match in scalar context
4253# Notes: Group spec may contain multiple groups separated by colons, each
4254#        possibly with a leading family number
4255sub GroupMatches($$$)
4256{
4257    my ($self, $group, $tagList) = @_;
4258    $tagList = [ $tagList ] unless ref $tagList;
4259    my ($tag, @matches);
4260    # check each group name individually (eg. "Author:1IPTC")
4261    my @grps = split ':', $group;
4262    my (@fmys, $g);
4263    for ($g=0; $g<@grps; ++$g) {
4264        if ($grps[$g] =~ s/^(\d*)(id-)?//i) {
4265            $fmys[$g] = $1 if length $1;
4266            if ($2) {
4267                $fmys[$g] = 7;
4268                next;   # (don't convert tag ID's to lower case)
4269            }
4270        }
4271        $grps[$g] = lc $grps[$g];
4272        $grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag
4273    }
4274    foreach $tag (@$tagList) {
4275        my @groups = $self->GetGroup($tag, -1);
4276        for ($g=0; $g<@grps; ++$g) {
4277            my $grp = $grps[$g];
4278            next if $grp eq '*' or $grp eq 'all';
4279            my $f;
4280            if (defined($f = $fmys[$g])) {
4281                last unless defined $groups[$f];
4282                if ($f == 7) {
4283                    next if IsSameID($self->GetTagID($tag), $grp);
4284                } else {
4285                    next if $grp eq lc $groups[$f];
4286                }
4287                last;
4288            } else {
4289                last unless grep /^$grp$/i, @groups;
4290            }
4291        }
4292        if ($g == @grps) {
4293            return $tag unless wantarray;
4294            push @matches, $tag;
4295        }
4296    }
4297    return wantarray ? @matches : $matches[0];
4298}
4299
4300#------------------------------------------------------------------------------
4301# Remove specified tags from returned tag list, updating indices in other lists
4302# Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref,
4303#         4) true to include tags from hash instead of excluding
4304# Returns: nothing, but updates input lists
4305sub RemoveTagsFromList($$$$;$)
4306{
4307    local $_;
4308    my ($tags, $list1, $list2, $exclude, $inv) = @_;
4309    my @filteredTags;
4310
4311    if (@$list1 or @$list2) {
4312        while (@$tags) {
4313            my $tag = pop @$tags;
4314            my $i = @$tags;
4315            if ($$exclude{$tag} xor $inv) {
4316                # remove index of excluded tag from each list
4317                @$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1;
4318                @$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2;
4319            } else {
4320                unshift @filteredTags, $tag;
4321            }
4322        }
4323    } else {
4324        foreach (@$tags) {
4325            push @filteredTags, $_ unless $$exclude{$_} xor $inv;
4326        }
4327    }
4328    $_[0] = \@filteredTags;     # update tag list
4329}
4330
4331#------------------------------------------------------------------------------
4332# Set list of found tags from previously requested tags
4333# Inputs: 0) ExifTool object reference
4334# Returns: 0) Reference to list of found tag keys (in order of requested tags)
4335#          1) Reference to list of indices for tags requested by value
4336#          2) Reference to list of indices for tags specified by wildcard or "all"
4337# Notes: index lists are returned in increasing order
4338sub SetFoundTags($)
4339{
4340    my $self = shift;
4341    my $options = $$self{OPTIONS};
4342    my $reqTags = $$self{REQUESTED_TAGS} || [ ];
4343    my $duplicates = $$options{Duplicates};
4344    my $exclude = $$options{Exclude};
4345    my $fileOrder = $$self{FILE_ORDER};
4346    my @groupOptions = sort grep /^Group/, keys %$options;
4347    my $doDups = $duplicates || $exclude || @groupOptions;
4348    my ($tag, $rtnTags, @byValue, @wildTags);
4349
4350    # only return requested tags if specified
4351    if (@$reqTags) {
4352        $rtnTags or $rtnTags = [ ];
4353        # scan through the requested tags and generate a list of tags we found
4354        my $tagHash = $$self{VALUE};
4355        my $reqTag;
4356        foreach $reqTag (@$reqTags) {
4357            my (@matches, $group, $allGrp, $allTag, $byValue);
4358            if ($reqTag =~ /^(.*):(.+)/) {
4359                ($group, $tag) = ($1, $2);
4360                if ($group =~ /^(\*|all)$/i) {
4361                    $allGrp = 1;
4362                } elsif ($group !~ /^[-\w:]*$/) {
4363                    $self->Warn("Invalid group name '${group}'");
4364                    $group = 'invalid';
4365                }
4366            } else {
4367                $tag = $reqTag;
4368            }
4369            $byValue = 1 if $tag =~ s/#$// and $$options{PrintConv};
4370            if (defined $$tagHash{$reqTag} and not $doDups) {
4371                $matches[0] = $tag;
4372            } elsif ($tag =~ /^(\*|all)$/i) {
4373                # tag name of '*' or 'all' matches all tags
4374                if ($doDups or $allGrp) {
4375                    @matches = grep(!/#/, keys %$tagHash);
4376                } else {
4377                    @matches = grep(!/ /, keys %$tagHash);
4378                }
4379                next unless @matches;   # don't want entry in list for '*' tag
4380                $allTag = 1;
4381            } elsif ($tag =~ /[*?]/) {
4382                # allow wildcards in tag names
4383                $tag =~ s/\*/[-\\w]*/g;
4384                $tag =~ s/\?/[-\\w]/g;
4385                $tag .= '( \\(.*)?' if $doDups or $allGrp;
4386                @matches = grep(/^$tag$/i, keys %$tagHash);
4387                next unless @matches;   # don't want entry in list for wildcard tags
4388                $allTag = 1;
4389            } elsif ($doDups or defined $group) {
4390                # must also look for tags like "Tag (1)"
4391                # (but be sure not to match temporary ValueConv entries like "Tag #")
4392                @matches = grep(/^$tag( \(|$)/i, keys %$tagHash);
4393            } elsif ($tag =~ /^[-\w]+$/) {
4394                # find first matching value
4395                # (use in list context to return value instead of count)
4396                ($matches[0]) = grep /^$tag$/i, keys %$tagHash;
4397                defined $matches[0] or undef @matches;
4398            } else {
4399                $self->Warn("Invalid tag name '${tag}'");
4400            }
4401            if (defined $group and not $allGrp) {
4402                # keep only specified group
4403                @matches = $self->GroupMatches($group, \@matches);
4404                next unless @matches or not $allTag;
4405            }
4406            if (@matches > 1) {
4407                # maintain original file order for multiple tags
4408                @matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches;
4409                # return only the highest priority tag unless duplicates wanted
4410                unless ($doDups or $allTag or $allGrp) {
4411                    $tag = shift @matches;
4412                    my $oldPriority = $$self{PRIORITY}{$tag} || 1;
4413                    foreach (@matches) {
4414                        my $priority = $$self{PRIORITY}{$_};
4415                        $priority = 1 unless defined $priority;
4416                        next unless $priority >= $oldPriority;
4417                        $tag = $_;
4418                        $oldPriority = $priority || 1;
4419                    }
4420                    @matches = ( $tag );
4421                }
4422            } elsif (not @matches) {
4423                # put entry in return list even without value (value is undef)
4424                $matches[0] = $byValue ? "$tag #(0)" : "$tag (0)";
4425                # bogus file order entry to avoid warning if sorting in file order
4426                $$self{FILE_ORDER}{$matches[0]} = 9999;
4427            }
4428            # save indices of tags extracted by value
4429            push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue;
4430            # save indices of wildcard tags
4431            push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag;
4432            push @$rtnTags, @matches;
4433        }
4434    } else {
4435        # no requested tags, so we want all tags
4436        my @allTags;
4437        if ($doDups) {
4438            @allTags = keys %{$$self{VALUE}};
4439        } else {
4440            # only include tag if it doesn't end in a copy number
4441            @allTags = grep(!/ /, keys %{$$self{VALUE}});
4442        }
4443        $rtnTags = \@allTags;
4444    }
4445
4446    # filter excluded tags and group options
4447    while (($exclude or @groupOptions) and @$rtnTags) {
4448        if ($exclude) {
4449            my ($pat, %exclude);
4450            foreach $pat (@$exclude) {
4451                my $group;
4452                if ($pat =~ /^(.*):(.+)/) {
4453                    ($group, $tag) = ($1, $2);
4454                    if ($group =~ /^(\*|all)$/i) {
4455                        undef $group;
4456                    } elsif ($group !~ /^[-\w:]*$/) {
4457                        $self->Warn("Invalid group name '${group}'");
4458                        $group = 'invalid';
4459                    }
4460                } else {
4461                    $tag = $pat;
4462                }
4463                my @matches;
4464                if ($tag =~ /^(\*|all)$/i) {
4465                    @matches = @$rtnTags;
4466                } else {
4467                    # allow wildcards in tag names
4468                    $tag =~ s/\*/[-\\w]*/g;
4469                    $tag =~ s/\?/[-\\w]/g;
4470                    @matches = grep(/^$tag( |$)/i, @$rtnTags);
4471                }
4472                @matches = $self->GroupMatches($group, \@matches) if $group and @matches;
4473                $exclude{$_} = 1 foreach @matches;
4474            }
4475            if (%exclude) {
4476                # remove excluded tags from return list(s)
4477                RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude);
4478                last unless @$rtnTags;      # all done if nothing left
4479            }
4480            last if $duplicates and not @groupOptions;
4481        }
4482        # filter groups if requested, or to remove duplicates
4483        my (%keepTags, %wantGroup, $family, $groupOpt);
4484        my $allGroups = 1;
4485        # build hash of requested/excluded group names for each group family
4486        my $wantOrder = 0;
4487        foreach $groupOpt (@groupOptions) {
4488            $groupOpt =~ /^Group(\d*(:\d+)*)/ or next;
4489            $family = $1 || 0;
4490            $wantGroup{$family} or $wantGroup{$family} = { };
4491            my $groupList;
4492            if (ref $$options{$groupOpt} eq 'ARRAY') {
4493                $groupList = $$options{$groupOpt};
4494            } else {
4495                $groupList = [ $$options{$groupOpt} ];
4496            }
4497            foreach (@$groupList) {
4498                # groups have priority in order they were specified
4499                ++$wantOrder;
4500                my ($groupName, $want);
4501                if (/^-(.*)/) {
4502                    # excluded group begins with '-'
4503                    $groupName = $1;
4504                    $want = 0;          # we don't want tags in this group
4505                } else {
4506                    $groupName = $_;
4507                    $want = $wantOrder; # we want tags in this group
4508                    $allGroups = 0;     # don't want all groups if we requested one
4509                }
4510                $wantGroup{$family}{$groupName} = $want;
4511            }
4512        }
4513        # loop through all tags and decide which ones we want
4514        my (@tags, %bestTag);
4515GR_TAG: foreach $tag (@$rtnTags) {
4516            my $wantTag = $allGroups;   # want tag by default if want all groups
4517            foreach $family (keys %wantGroup) {
4518                my $group = $self->GetGroup($tag, $family);
4519                my $wanted = $wantGroup{$family}{$group};
4520                next unless defined $wanted;
4521                next GR_TAG unless $wanted;     # skip tag if group excluded
4522                # take lowest non-zero want flag
4523                next if $wantTag and $wantTag < $wanted;
4524                $wantTag = $wanted;
4525            }
4526            next unless $wantTag;
4527            $duplicates and $keepTags{$tag} = 1, next;
4528            # determine which tag we want to keep
4529            my $tagName = GetTagName($tag);
4530            my $bestTag = $bestTag{$tagName};
4531            if (defined $bestTag) {
4532                next if $wantTag > $keepTags{$bestTag};
4533                if ($wantTag == $keepTags{$bestTag}) {
4534                    # want two tags with the same name -- keep the latest one
4535                    if ($tag =~ / \((\d+)\)$/) {
4536                        my $tagNum = $1;
4537                        next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum;
4538                    }
4539                }
4540                # this tag is better, so delete old best tag
4541                delete $keepTags{$bestTag};
4542            }
4543            $keepTags{$tag} = $wantTag;     # keep this tag (for now...)
4544            $bestTag{$tagName} = $tag;      # this is our current best tag
4545        }
4546        # include only tags we want to keep in return lists
4547        RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1);
4548        last;
4549    }
4550    $$self{FOUND_TAGS} = $rtnTags;      # save found tags
4551
4552    # return reference to found tag keys (and list of indices of tags to extract by value)
4553    return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags;
4554}
4555
4556#------------------------------------------------------------------------------
4557# Utility to load our write routines if required (called via AUTOLOAD)
4558# Inputs: 0) autoload function, 1-N) function arguments
4559# Returns: result of function or dies if function not available
4560sub DoAutoLoad(@)
4561{
4562    my $autoload = shift;
4563    my @callInfo = split(/::/, $autoload);
4564    my $file = 'Image/ExifTool/Write';
4565
4566    return if $callInfo[$#callInfo] eq 'DESTROY';
4567    if (@callInfo == 4) {
4568        # load Image/ExifTool/WriteMODULE.pl
4569        $file .= "$callInfo[2].pl";
4570    } elsif ($callInfo[-1] eq 'ShiftTime') {
4571        $file = 'Image/ExifTool/Shift.pl';  # load Shift.pl
4572    } else {
4573        # load Image/ExifTool/Writer.pl
4574        $file .= 'r.pl';
4575    }
4576    # attempt to load the package
4577    eval { require $file } or die "Error while attempting to call $autoload\n$@\n";
4578    unless (defined &$autoload) {
4579        my @caller = caller(0);
4580        # reproduce Perl's standard 'undefined subroutine' message:
4581        die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n";
4582    }
4583    no strict 'refs';
4584    return &$autoload(@_);     # call the function
4585}
4586
4587#------------------------------------------------------------------------------
4588# AutoLoad our writer routines when necessary
4589#
4590sub AUTOLOAD
4591{
4592    return DoAutoLoad($AUTOLOAD, @_);
4593}
4594
4595#------------------------------------------------------------------------------
4596# Add warning tag
4597# Inputs: 0) ExifTool object reference, 1) warning message
4598#         2) true if minor (2 if behaviour changes when warning is ignored,
4599#            or 3 if warning shouldn't be issued when Validate option is used)
4600# Returns: true if warning tag was added
4601sub Warn($$;$)
4602{
4603    my ($self, $str, $ignorable) = @_;
4604    if ($ignorable) {
4605        return 0 if $$self{OPTIONS}{IgnoreMinorErrors};
4606        return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate};
4607        $str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str";
4608    }
4609    $self->FoundTag('Warning', $str);
4610    return 1;
4611}
4612
4613#------------------------------------------------------------------------------
4614# Add warning tag only once per processed file
4615# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor
4616# Returns: true if warning tag was added
4617sub WarnOnce($$;$)
4618{
4619    my ($self, $str, $ignorable) = @_;
4620    return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors};
4621    unless ($$self{WARNED_ONCE}{$str}) {
4622        $self->Warn($str, $ignorable);
4623        $$self{WARNED_ONCE}{$str} = 1;
4624    }
4625    return 1;
4626}
4627
4628#------------------------------------------------------------------------------
4629# Add error tag
4630# Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor
4631# Returns: true if error tag was added, otherwise warning was added
4632sub Error($$;$)
4633{
4634    my ($self, $str, $ignorable) = @_;
4635    if ($$self{DemoteErrors}) {
4636        $self->Warn($str) and ++$$self{DemoteErrors};
4637        return 1;
4638    } elsif ($ignorable) {
4639        $$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0;
4640        $str = "[minor] $str";
4641    }
4642    $self->FoundTag('Error', $str);
4643    return 1;
4644}
4645
4646#------------------------------------------------------------------------------
4647# Expand shortcuts
4648# Inputs: 0) reference to list of tags, 1) set to remove trailing '#'
4649# Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv,
4650#        multiple group names, and redirected tags
4651sub ExpandShortcuts($;$)
4652{
4653    my ($tagList, $removeSuffix) = @_;
4654    return unless $tagList and @$tagList;
4655
4656    require Image::ExifTool::Shortcuts;
4657
4658    # expand shortcuts
4659    my $suffix = $removeSuffix ? '' : '#';
4660    my @expandedTags;
4661    my ($entry, $tag, $excl);
4662    foreach $entry (@$tagList) {
4663        # skip things like options hash references in list
4664        if (ref $entry) {
4665            push @expandedTags, $entry;
4666            next;
4667        }
4668        # remove leading '-'
4669        ($excl, $tag) = $entry =~ /^(-?)(.*)/s;
4670        my ($post, @post, $pre, $v);
4671        # handle redirection
4672        if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) {
4673            ($tag, $post) = ($1, $2);
4674            if ($post =~ /^[-+]?>/ or $post !~ /\$/) {
4675                # expand shortcuts in postfix (rhs of redirection)
4676                my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/);
4677                $p2 = '' unless defined $p2;
4678                $v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix
4679                my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main;
4680                if ($match) {
4681                    foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
4682                        /^-/ and next;  # ignore excluded tags
4683                        if ($p2 and /(.+:)(.+)/) {
4684                            push @post, "$op$_$v";
4685                        } else {
4686                            push @post, "$op$p2$_$v";
4687                        }
4688                    }
4689                    next unless @post;
4690                    $post = shift @post;
4691                }
4692            }
4693        } else {
4694            $post = '';
4695        }
4696        # handle group names
4697        if ($tag =~ /(.+:)(.+)/) {
4698            ($pre, $tag) = ($1, $2);
4699        } else {
4700            $pre = '';
4701        }
4702        $v = ($tag =~ s/#$//) ? $suffix : '';   # ValueConv suffix
4703        # loop over all postfixes
4704        for (;;) {
4705            # expand the tag name
4706            my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main;
4707            if ($match) {
4708                if ($excl) {
4709                    # entry starts with '-', so exclude all tags in this shortcut
4710                    foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
4711                        /^-/ and next;  # ignore excluded exclude tags
4712                        # group of expanded tag takes precedence
4713                        if ($pre and /(.+:)(.+)/) {
4714                            push @expandedTags, "$excl$_";
4715                        } else {
4716                            push @expandedTags, "$excl$pre$_";
4717                        }
4718                    }
4719                } elsif (length $pre or length $post or $v) {
4720                    foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
4721                        /(-?)(.+:)?(.+)/;
4722                        if ($2) {
4723                            # group from expanded tag takes precedence
4724                            push @expandedTags, "$_$v$post";
4725                        } else {
4726                            push @expandedTags, "$1$pre$3$v$post";
4727                        }
4728                    }
4729                } else {
4730                    push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}};
4731                }
4732            } else {
4733                push @expandedTags, "$excl$pre$tag$v$post";
4734            }
4735            last unless @post;
4736            $post = shift @post;
4737        }
4738    }
4739    @$tagList = @expandedTags;
4740}
4741
4742#------------------------------------------------------------------------------
4743# Add hash of Composite tags to our composites
4744# Inputs: 0) hash reference to table of Composite tags to add or module name,
4745#         1) override existing tag definition
4746sub AddCompositeTags($;$)
4747{
4748    local $_;
4749    my ($add, $override) = @_;
4750    my ($module, $prefix, $tagID);
4751    unless (ref $add) {
4752        ($prefix = $add) =~ s/.*:://;
4753        $module = $add;
4754        $add .= '::Composite';
4755        no strict 'refs';
4756        $add = \%$add;
4757        $prefix .= '-';
4758    } else {
4759        $prefix = 'UserDefined-';
4760    }
4761    my $defaultGroups = $$add{GROUPS};
4762    my $compTable = GetTagTable('Image::ExifTool::Composite');
4763
4764    # make sure default groups are defined in families 0 and 1
4765    if ($defaultGroups) {
4766        $$defaultGroups{0} or $$defaultGroups{0} = 'Composite';
4767        $$defaultGroups{1} or $$defaultGroups{1} = 'Composite';
4768        $$defaultGroups{2} or $$defaultGroups{2} = 'Other';
4769    } else {
4770        $defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' };
4771    }
4772    SetupTagTable($add);    # generate Name, TagID, etc
4773    foreach $tagID (sort keys %$add) {
4774        next if $specialTags{$tagID};   # must skip special tags
4775        my $tagInfo = $$add{$tagID};
4776        my $new = $prefix . $tagID;     # new tag ID for Composite table
4777        $$tagInfo{Module} = $module if $$tagInfo{Writable};
4778        $$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override};
4779        $$tagInfo{IsComposite} = 1;
4780        # handle Composite tags with the same name
4781        if ($compositeID{$tagID}) {
4782            # determine if we want to override this tag
4783            # (=0 keep both, >0 override, <0 keep existing)
4784            my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0);
4785            next if $over < 0;
4786            if ($over) {
4787                # remove existing tags with this ID
4788                delete $$compTable{$_} foreach @{$compositeID{$tagID}};
4789                delete $compositeID{$tagID};
4790            }
4791        }
4792        # make sure new TagID is unique by adding index if necessary
4793        # (could only happen for UserDefined tags now that module name is added to tag ID)
4794        my $n = 0;
4795        while ($$compTable{$new}) {
4796            $new =~ s/-\d+$// if $n++;
4797            $new .= "-$n";
4798        }
4799        # use new ID and save it so we can use it in TagLookup
4800        $$tagInfo{NewTagID} = $new unless $tagID eq $new;
4801
4802        # add new ID to lookup of Composite tag ID's
4803        $compositeID{$tagID} = [ ] unless $compositeID{$tagID};
4804        unshift @{$compositeID{$tagID}}, $new;  # (most recent one first)
4805
4806        # convert scalar Require/Desire/Inhibit entries
4807        my ($type, @hashes, @scalars, %used);
4808        foreach $type ('Require','Desire','Inhibit') {
4809            my $req = $$tagInfo{$type} or next;
4810            push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type;
4811        }
4812        if (@scalars) {
4813            # make lookup for indices that are used
4814            foreach $type (@hashes) {
4815                $used{$_} = 1 foreach keys %{$$tagInfo{$type}};
4816            }
4817            my $next = 0;
4818            foreach $type (@scalars) {
4819                ++$next while $used{$next};
4820                $$tagInfo{$type} = { $next++ => $$tagInfo{$type} };
4821            }
4822        }
4823        # add this Composite tag to our main Composite table
4824        $$tagInfo{Table} = $compTable;
4825        # (use the original TagID, even if we changed it, so don't do this:)
4826        $$tagInfo{TagID} = $new;
4827        # save tag under new ID in Composite table
4828        $$compTable{$new} = $tagInfo;
4829        # set all default groups in tag
4830        my $groups = $$tagInfo{Groups};
4831        $groups or $groups = $$tagInfo{Groups} = { };
4832        # fill in default groups
4833        foreach (keys %$defaultGroups) {
4834            $$groups{$_} or $$groups{$_} = $$defaultGroups{$_};
4835        }
4836        # set flag indicating group list was built
4837        $$tagInfo{GotGroups} = 1;
4838    }
4839}
4840
4841#------------------------------------------------------------------------------
4842# Add tags to TagLookup (used for writing)
4843# Inputs: 0) source hash of tag definitions, 1) name of destination tag table
4844sub AddTagsToLookup($$)
4845{
4846    my ($tagHash, $table) = @_;
4847    if (defined &Image::ExifTool::TagLookup::AddTags) {
4848        Image::ExifTool::TagLookup::AddTags($tagHash, $table);
4849    } elsif (not $Image::ExifTool::pluginTags{$tagHash}) {
4850        # queue these tags until TagLookup is loaded
4851        push @Image::ExifTool::pluginTags, [ $tagHash, $table ];
4852        # set flag so we don't load same tags twice
4853        $Image::ExifTool::pluginTags{$tagHash} = 1;
4854    }
4855}
4856
4857#------------------------------------------------------------------------------
4858# Expand tagInfo Flags
4859# Inputs: 0) tagInfo hash ref
4860# Notes: $$tagInfo{Flags} must be defined to call this routine
4861sub ExpandFlags($)
4862{
4863    my $tagInfo = shift;
4864    my $flags = $$tagInfo{Flags};
4865    if (ref $flags eq 'ARRAY') {
4866        foreach (@$flags) {
4867            $$tagInfo{$_} = 1;
4868        }
4869    } elsif (ref $flags eq 'HASH') {
4870        my $key;
4871        foreach $key (keys %$flags) {
4872            $$tagInfo{$key} = $$flags{$key};
4873        }
4874    } else {
4875        $$tagInfo{$flags} = 1;
4876    }
4877}
4878
4879#------------------------------------------------------------------------------
4880# Set up tag table (must be done once for each tag table used)
4881# Inputs: 0) Reference to tag table
4882# Notes: - generates 'Name' field from key if it doesn't exist
4883#        - stores 'Table' pointer and 'TagID' value
4884#        - expands 'Flags' for quick lookup
4885sub SetupTagTable($)
4886{
4887    my $tagTablePtr = shift;
4888    my $avoid = $$tagTablePtr{AVOID};
4889    my ($tagID, $tagInfo);
4890    foreach $tagID (TagTableKeys($tagTablePtr)) {
4891        my @infoArray = GetTagInfoList($tagTablePtr,$tagID);
4892        # process conditional tagInfo arrays
4893        foreach $tagInfo (@infoArray) {
4894            $$tagInfo{Table} = $tagTablePtr;
4895            $$tagInfo{TagID} = $tagID;
4896            $$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID);
4897            $$tagInfo{Flags} and ExpandFlags($tagInfo);
4898            $$tagInfo{Avoid} = $avoid if defined $avoid;
4899            # calculate BitShift from Mask if necessary
4900            if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) {
4901                my ($mask, $bitShift) = ($$tagInfo{Mask}, 0);
4902                ++$bitShift until $mask & (1 << $bitShift);
4903                $$tagInfo{BitShift} = $bitShift;
4904            }
4905        }
4906        next unless @infoArray > 1;
4907        # add an "Index" member to each tagInfo in a list
4908        my $index = 0;
4909        foreach $tagInfo (@infoArray) {
4910            $$tagInfo{Index} = $index++;
4911        }
4912    }
4913}
4914
4915#------------------------------------------------------------------------------
4916# Utilities to check for numerical types
4917# Inputs: 0) value;  Returns: true if value is a numerical type
4918# Notes: May change commas to decimals in floats for use in other locales
4919sub IsFloat($) {
4920    return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
4921    # allow comma separators (for other locales)
4922    return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/;
4923    $_[0] =~ tr/,/./;   # but translate ',' to '.'
4924    return 1;
4925}
4926sub IsInt($)      { return scalar($_[0] =~ /^[+-]?\d+$/); }
4927sub IsHex($)      { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); }
4928sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); }
4929
4930# round floating point value to specified number of significant digits
4931# Inputs: 0) value, 1) number of sig digits;  Returns: rounded number
4932sub RoundFloat($$)
4933{
4934    my ($val, $sig) = @_;
4935    return sprintf("%.${sig}g", $val);
4936}
4937
4938# Convert strings to floating point numbers (or undef)
4939# Inputs: 0-N) list of strings (may be undef)
4940# Returns: last value converted
4941sub ToFloat(@)
4942{
4943    local $_;
4944    foreach (@_) {
4945        next unless defined $_;
4946        # (add 0 to convert "0.0" to "0" for tests)
4947        $_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef;
4948    }
4949    return $_[-1];
4950}
4951
4952#------------------------------------------------------------------------------
4953# Utility routines to for reading binary data values from file
4954
4955my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' );
4956my %unpackIntel    = ( S => 'v', L => 'V', C => 'C', c => 'c' );
4957my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' );
4958
4959# the following 4 variables are defined in 'use vars' instead of using 'my'
4960# because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my'
4961# variables from within subroutines (ref communication with Pavel Merdin):
4962# $swapBytes - set if EXIF header is not native byte ordering
4963# $swapWords - swap 32-bit words in doubles (ARM quirk)
4964$currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM')
4965%unpackStd = %unpackMotorola;
4966
4967# Swap bytes in data if necessary
4968# Inputs: 0) data, 1) number of bytes
4969# Returns: swapped data
4970sub SwapBytes($$)
4971{
4972    return $_[0] unless $swapBytes;
4973    my ($val, $bytes) = @_;
4974    my $newVal = '';
4975    $newVal .= substr($val, $bytes, 1) while $bytes--;
4976    return $newVal;
4977}
4978# Swap words.  Inputs: 8 bytes of data, Returns: swapped data
4979sub SwapWords($)
4980{
4981    return $_[0] unless $swapWords and length($_[0]) == 8;
4982    return substr($_[0],4,4) . substr($_[0],0,4)
4983}
4984
4985# Unpack value, letting unpack() handle byte swapping
4986# Inputs: 0) unpack template, 1) data reference, 2) offset
4987# Returns: unpacked number
4988# - uses value of %unpackStd to determine the unpack template
4989# - can only be called for 'S' or 'L' templates since these are the only
4990#   templates for which you can specify the byte ordering.
4991sub DoUnpackStd(@)
4992{
4993    $_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]});
4994    return unpack($unpackStd{$_[0]}, ${$_[1]});
4995}
4996# same, but with reversed byte order
4997sub DoUnpackRev(@)
4998{
4999    my $fmt = $unpackRev{$unpackStd{$_[0]}};
5000    $_[2] and return unpack("x$_[2] $fmt", ${$_[1]});
5001    return unpack($fmt, ${$_[1]});
5002}
5003# Pack value
5004# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref)
5005# Returns: packed value
5006sub DoPackStd(@)
5007{
5008    my $val = pack($unpackStd{$_[0]}, $_[1]);
5009    $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
5010    return $val;
5011}
5012# same, but with reversed byte order
5013sub DoPackRev(@)
5014{
5015    my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]);
5016    $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
5017    return $val;
5018}
5019
5020# Unpack value, handling the byte swapping manually
5021# Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset
5022# Returns: unpacked number
5023# - uses value of $swapBytes to determine byte ordering
5024sub DoUnpack(@)
5025{
5026    my ($bytes, $template, $dataPt, $pos) = @_;
5027    my $val;
5028    if ($swapBytes) {
5029        $val = '';
5030        $val .= substr($$dataPt,$pos+$bytes,1) while $bytes--;
5031    } else {
5032        $val = substr($$dataPt,$pos,$bytes);
5033    }
5034    defined($val) or return undef;
5035    return unpack($template,$val);
5036}
5037
5038# Unpack double value
5039# Inputs: 0) unpack template, 1) data reference, 2) offset
5040# Returns: unpacked number
5041sub DoUnpackDbl(@)
5042{
5043    my ($template, $dataPt, $pos) = @_;
5044    my $val = substr($$dataPt,$pos,8);
5045    defined($val) or return undef;
5046    # swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value
5047    return unpack($template, SwapWords(SwapBytes($val, 8)));
5048}
5049
5050# Inputs: 0) data reference, 1) offset into data
5051sub Get8s($$)     { return DoUnpackStd('c', @_); }
5052sub Get8u($$)     { return DoUnpackStd('C', @_); }
5053sub Get16s($$)    { return DoUnpack(2, 's', @_); }
5054sub Get16u($$)    { return DoUnpackStd('S', @_); }
5055sub Get32s($$)    { return DoUnpack(4, 'l', @_); }
5056sub Get32u($$)    { return DoUnpackStd('L', @_); }
5057sub GetFloat($$)  { return DoUnpack(4, 'f', @_); }
5058sub GetDouble($$) { return DoUnpackDbl('d', @_); }
5059sub Get16uRev($$) { return DoUnpackRev('S', @_); }
5060sub Get32uRev($$) { return DoUnpackRev('L', @_); }
5061
5062# rationals may be a floating point number, 'inf' or 'undef'
5063my ($ratNumer, $ratDenom);
5064sub GetRational32s($$)
5065{
5066    my ($dataPt, $pos) = @_;
5067    $ratNumer = Get16s($dataPt,$pos);
5068    $ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef';
5069    # round off to a reasonable number of significant figures
5070    return RoundFloat($ratNumer / $ratDenom, 7);
5071}
5072sub GetRational32u($$)
5073{
5074    my ($dataPt, $pos) = @_;
5075    $ratNumer = Get16u($dataPt,$pos);
5076    $ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef';
5077    return RoundFloat($ratNumer / $ratDenom, 7);
5078}
5079sub GetRational64s($$)
5080{
5081    my ($dataPt, $pos) = @_;
5082    $ratNumer = Get32s($dataPt,$pos);
5083    $ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef';
5084    return RoundFloat($ratNumer / $ratDenom, 10);
5085}
5086sub GetRational64u($$)
5087{
5088    my ($dataPt, $pos) = @_;
5089    $ratNumer = Get32u($dataPt,$pos);
5090    $ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef';
5091    return RoundFloat($ratNumer / $ratDenom, 10);
5092}
5093sub GetFixed16s($$)
5094{
5095    my ($dataPt, $pos) = @_;
5096    my $val = Get16s($dataPt, $pos) / 0x100;
5097    return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000;
5098}
5099sub GetFixed16u($$)
5100{
5101    my ($dataPt, $pos) = @_;
5102    return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000;
5103}
5104sub GetFixed32s($$)
5105{
5106    my ($dataPt, $pos) = @_;
5107    my $val = Get32s($dataPt, $pos) / 0x10000;
5108    # remove insignificant digits
5109    return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5;
5110}
5111sub GetFixed32u($$)
5112{
5113    my ($dataPt, $pos) = @_;
5114    # remove insignificant digits
5115    return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5;
5116}
5117# Inputs: 0) value, 1) data ref, 2) offset
5118sub Set8s(@)  { return DoPackStd('c', @_); }
5119sub Set8u(@)  { return DoPackStd('C', @_); }
5120sub Set16u(@) { return DoPackStd('S', @_); }
5121sub Set32u(@) { return DoPackStd('L', @_); }
5122sub Set16uRev(@) { return DoPackRev('S', @_); }
5123
5124#------------------------------------------------------------------------------
5125# Get current byte order ('II' or 'MM')
5126sub GetByteOrder() { return $currentByteOrder; }
5127
5128#------------------------------------------------------------------------------
5129# Set byte ordering
5130# Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian')
5131# Returns: 1 on success
5132sub SetByteOrder($)
5133{
5134    my $order = shift;
5135
5136    if ($order eq 'MM') {       # big endian (Motorola)
5137        %unpackStd = %unpackMotorola;
5138    } elsif ($order eq 'II') {  # little endian (Intel)
5139        %unpackStd = %unpackIntel;
5140    } elsif ($order =~ /^Big/i) {
5141        $order = 'MM';
5142        %unpackStd = %unpackMotorola;
5143    } elsif ($order =~ /^Little/i) {
5144        $order = 'II';
5145        %unpackStd = %unpackIntel;
5146    } else {
5147        return 0;
5148    }
5149    my $val = unpack('S','A ');
5150    my $nativeOrder;
5151    if ($val == 0x4120) {       # big endian
5152        $nativeOrder = 'MM';
5153    } elsif ($val == 0x2041) {  # little endian
5154        $nativeOrder = 'II';
5155    } else {
5156        warn sprintf("Unknown native byte order! (pattern %x)\n",$val);
5157        return 0;
5158    }
5159    $currentByteOrder = $order;  # save current byte order
5160
5161    # swap bytes if our native CPU byte ordering is not the same as the EXIF
5162    $swapBytes = ($order ne $nativeOrder);
5163
5164    # little-endian ARM has big-endian words for doubles (thanks Riku Voipio)
5165    # (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since
5166    # 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?)
5167    my $pack1d = pack('d', 1);
5168    $swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or
5169                  $pack1d eq "\0\0\xf0\x3f\0\0\0\0");
5170    return 1;
5171}
5172
5173#------------------------------------------------------------------------------
5174# Change byte order
5175sub ToggleByteOrder()
5176{
5177    SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II');
5178}
5179
5180#------------------------------------------------------------------------------
5181# hash lookups for reading values from data
5182my %formatSize = (
5183    int8s => 1,
5184    int8u => 1,
5185    int16s => 2,
5186    int16u => 2,
5187    int16uRev => 2,
5188    int32s => 4,
5189    int32u => 4,
5190    int32uRev => 4,
5191    int64s => 8,
5192    int64u => 8,
5193    rational32s => 4,
5194    rational32u => 4,
5195    rational64s => 8,
5196    rational64u => 8,
5197    fixed16s => 2,
5198    fixed16u => 2,
5199    fixed32s => 4,
5200    fixed32u => 4,
5201    fixed64s => 8,
5202    float => 4,
5203    double => 8,
5204    extended => 10,
5205    unicode => 2,
5206    complex => 8,
5207    string => 1,
5208    binary => 1,
5209   'undef' => 1,
5210    ifd => 4,
5211    ifd64 => 8,
5212    ue7 => 1,
5213);
5214my %readValueProc = (
5215    int8s => \&Get8s,
5216    int8u => \&Get8u,
5217    int16s => \&Get16s,
5218    int16u => \&Get16u,
5219    int16uRev => \&Get16uRev,
5220    int32s => \&Get32s,
5221    int32u => \&Get32u,
5222    int32uRev => \&Get32uRev,
5223    int64s => \&Get64s,
5224    int64u => \&Get64u,
5225    rational32s => \&GetRational32s,
5226    rational32u => \&GetRational32u,
5227    rational64s => \&GetRational64s,
5228    rational64u => \&GetRational64u,
5229    fixed16s => \&GetFixed16s,
5230    fixed16u => \&GetFixed16u,
5231    fixed32s => \&GetFixed32s,
5232    fixed32u => \&GetFixed32u,
5233    fixed64s => \&GetFixed64s,
5234    float => \&GetFloat,
5235    double => \&GetDouble,
5236    extended => \&GetExtended,
5237    ifd => \&Get32u,
5238    ifd64 => \&Get64u,
5239);
5240# lookup for all rational types
5241my %isRational = (
5242    rational32u => 1,
5243    rational32s => 1,
5244    rational64u => 1,
5245    rational64s => 1,
5246);
5247sub FormatSize($) { return $formatSize{$_[0]}; }
5248
5249#------------------------------------------------------------------------------
5250# Read value from binary data (with current byte ordering)
5251# Inputs: 0) data reference, 1) value offset, 2) format string,
5252#         3) number of values (or undef to use all data),
5253#         4) valid data length relative to offset (or undef to use all data),
5254#         5) optional pointer to returned rational
5255# Returns: converted value, or undefined if data isn't there
5256#          or list of values in list context
5257sub ReadValue($$$;$$$)
5258{
5259    my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_;
5260
5261    my $len = $formatSize{$format};
5262    unless ($len) {
5263        warn "Unknown format $format";
5264        $len = 1;
5265    }
5266    $size = length($$dataPt) - $offset unless defined $size;
5267    unless ($count) {
5268        return '' if defined $count or $size < $len;
5269        $count = int($size / $len);
5270    }
5271    # make sure entry is inside data
5272    if ($len * $count > $size) {
5273        $count = int($size / $len);     # shorten count if necessary
5274        $count < 1 and return undef;    # return undefined if no data
5275    }
5276    my @vals;
5277    my $proc = $readValueProc{$format};
5278    if (not $proc) {
5279        # handle undef/binary/string (also unsupported unicode/complex)
5280        $vals[0] = substr($$dataPt, $offset, $count * $len);
5281        # truncate string at null terminator if necessary
5282        $vals[0] =~ s/\0.*//s if $format eq 'string';
5283    } elsif ($isRational{$format} and $ratPt) {
5284        # store rationals separately as string fractions
5285        my @rat;
5286        for (;;) {
5287            push @vals, &$proc($dataPt, $offset);
5288            push @rat, "$ratNumer/$ratDenom";
5289            last if --$count <= 0;
5290            $offset += $len;
5291        }
5292        $$ratPt = join(' ',@rat);
5293    } else {
5294        for (;;) {
5295            push @vals, &$proc($dataPt, $offset);
5296            last if --$count <= 0;
5297            $offset += $len;
5298        }
5299    }
5300    return @vals if wantarray;
5301    return join(' ', @vals) if @vals > 1;
5302    return $vals[0];
5303}
5304
5305#------------------------------------------------------------------------------
5306# Decode string with specified encoding
5307# Inputs: 0) ExifTool object ref, 1) string to decode
5308#         2) source character set name (undef for current Charset)
5309#         3) optional source byte order (2-byte and 4-byte fixed-width sets only)
5310#         4) optional destination character set (defaults to Charset setting)
5311#         5) optional destination byte order (2-byte and 4-byte fixed-width only)
5312# Returns: string in destination encoding
5313# Note: ExifTool ref may be undef if character both character sets are provided
5314#       (but in this case no warnings will be issued)
5315sub Decode($$$;$$$)
5316{
5317    my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_;
5318    $from or $from = $$self{OPTIONS}{Charset};
5319    $to or $to = $$self{OPTIONS}{Charset};
5320    if ($from ne $to and length $val) {
5321        require Image::ExifTool::Charset;
5322        my $cs1 = $Image::ExifTool::Charset::csType{$from};
5323        my $cs2 = $Image::ExifTool::Charset::csType{$to};
5324        if ($cs1 and $cs2 and not $cs2 & 0x002) {
5325            # treat as straight ASCII if no character will need remapping
5326            if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) {
5327                my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder);
5328                $val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder);
5329            }
5330        } elsif ($self) {
5331            my $set = $cs1 ? $to : $from;
5332            unless ($$self{"DecodeWarn$set"}) {
5333                $self->Warn("Unsupported character set ($set)");
5334                $$self{"DecodeWarn$set"} = 1;
5335            }
5336        }
5337    }
5338    return $val;
5339}
5340
5341#------------------------------------------------------------------------------
5342# Encode string with specified encoding
5343# Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name,
5344#         3) optional destination byte order (2-byte and 4-byte fixed-width sets only)
5345# Returns: string in specified encoding
5346sub Encode($$$;$)
5347{
5348    my ($self, $val, $to, $toOrder) = @_;
5349    return $self->Decode($val, undef, undef, $to, $toOrder);
5350}
5351
5352#------------------------------------------------------------------------------
5353# Decode bit mask
5354# Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef)
5355#         2) optional bits per word (defaults to 32)
5356sub DecodeBits($$;$)
5357{
5358    my ($vals, $lookup, $bits) = @_;
5359    $bits or $bits = 32;
5360    my ($val, $i, @bitList);
5361    my $num = 0;
5362    foreach $val (split ' ', $vals) {
5363        for ($i=0; $i<$bits; ++$i) {
5364            next unless $val & (1 << $i);
5365            my $n = $i + $num;
5366            if (not $lookup) {
5367                push @bitList, $n;
5368            } elsif ($$lookup{$n}) {
5369                push @bitList, $$lookup{$n};
5370            } else {
5371                push @bitList, "[$n]";
5372            }
5373        }
5374        $num += $bits;
5375    }
5376    return '(none)' unless @bitList;
5377    return join($lookup ? ', ' : ',', @bitList);
5378}
5379
5380#------------------------------------------------------------------------------
5381# Validate an extracted image and repair if necessary
5382# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key
5383# Returns: image reference or undef if it wasn't valid
5384# Note: should be called from RawConv, not ValueConv
5385sub ValidateImage($$$)
5386{
5387    my ($self, $imagePt, $tag) = @_;
5388    return undef if $$imagePt eq 'none';
5389    unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or
5390            # the first byte of the preview of some Minolta cameras is wrong,
5391            # so check for this and set it back to 0xff if necessary
5392            $$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or
5393            $self->Options('IgnoreMinorErrors'))
5394    {
5395        # issue warning only if the tag was specifically requested
5396        if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) {
5397            $self->Warn("$tag is not a valid JPEG image",1);
5398            return undef;
5399        }
5400    }
5401    return $imagePt;
5402}
5403
5404#------------------------------------------------------------------------------
5405# Validate a tag name argument (including group name and wildcards, etc)
5406# Inputs: 0) tag name
5407# Returns: true if tag name is valid
5408# - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9]
5409# - tag names may contain wildcards [?*], and end with a hash [#]
5410# - may have group name prefixes (which may have family number prefix), separated by colons
5411# - a group name may be zero or more characters
5412sub ValidTagName($)
5413{
5414    my $tag = shift;
5415    return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/;
5416}
5417
5418#------------------------------------------------------------------------------
5419# Generate a valid tag name based on the tag ID or name
5420# Inputs: 0) tag ID or name
5421# Returns: valid tag name
5422sub MakeTagName($)
5423{
5424    my $name = shift;
5425    $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
5426    $name = ucfirst $name;          # capitalize first letter
5427    $name = "Tag$name" if length($name) < 2; # must at least 2 characters long
5428    return $name;
5429}
5430
5431#------------------------------------------------------------------------------
5432# Make description from a tag name
5433# Inputs: 0) tag name 1) optional tagID to add at end of description
5434# Returns: description
5435sub MakeDescription($;$)
5436{
5437    my ($tag, $tagID) = @_;
5438    # start with the tag name and force first letter to be upper case
5439    my $desc = ucfirst($tag);
5440    # translate underlines to spaces
5441    $desc =~ tr/_/ /;
5442    # remove hex TagID from name (to avoid inserting spaces in the number)
5443    $desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID;
5444    # put a space between lower/UPPER case and lower/number combinations
5445    $desc =~ s/([a-z])([A-Z\d])/$1 $2/g;
5446    # put a space between acronyms and words
5447    $desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g;
5448    # put spaces after numbers (if more than one character follows the number)
5449    $desc =~ s/(\d)([A-Z]\S)/$1 $2/g;
5450    # add TagID to description
5451    $desc .= ' ' . $tagID if defined $tagID;
5452    return $desc;
5453}
5454
5455#------------------------------------------------------------------------------
5456# Get descriptions for all tags in an array
5457# Inputs: 0) ExifTool ref, 1) reference to list of tag keys
5458# Returns: reference to hash lookup for descriptions
5459# Note: Returned descriptions are NOT escaped by ESCAPE_PROC
5460sub GetDescriptions($$)
5461{
5462    local $_;
5463    my ($self, $tags) = @_;
5464    my %desc;
5465    my $oldEscape = $$self{ESCAPE_PROC};
5466    delete $$self{ESCAPE_PROC};
5467    $desc{$_} = $self->GetDescription($_) foreach @$tags;
5468    $$self{ESCAPE_PROC} = $oldEscape;
5469    return \%desc;
5470}
5471
5472#------------------------------------------------------------------------------
5473# Apply filter to value(s) if necessary
5474# Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter
5475# Returns: true unless a filter returned undef; changes value if necessary
5476sub Filter($$$)
5477{
5478    local $_;
5479    my ($self, $filter, $valPt) = @_;
5480    return 1 unless defined $filter and defined $$valPt;
5481    my $rtnVal;
5482    if (not ref $$valPt) {
5483        $_ = $$valPt;
5484        #### eval Filter ($_, $self)
5485        eval $filter;
5486        if (defined $_) {
5487            $$valPt = $_;
5488            $rtnVal = 1;
5489        }
5490    } elsif (ref $$valPt eq 'SCALAR') {
5491        my $val = $$$valPt; # make a copy to avoid filtering twice
5492        $rtnVal = $self->Filter($filter, \$val);
5493        $$valPt = \$val;
5494    } elsif (ref $$valPt eq 'ARRAY') {
5495        my @val = @{$$valPt}; # make a copy to avoid filtering twice
5496        $self->Filter($filter, \$_) and $rtnVal = 1 foreach @val;
5497        $$valPt = \@val;
5498    } elsif (ref $$valPt eq 'HASH') {
5499        my %val = %{$$valPt}; # make a copy to avoid filtering twice
5500        $self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val;
5501        $$valPt = \%val;
5502    } else {
5503        $rtnVal = 1;
5504    }
5505    return $rtnVal;
5506}
5507
5508#------------------------------------------------------------------------------
5509# Return printable value
5510# Inputs: 0) ExifTool object reference
5511#         1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited)
5512sub Printable($;$)
5513{
5514    my ($self, $outStr, $maxLen) = @_;
5515    return '(undef)' unless defined $outStr;
5516    $outStr =~ tr/\x01-\x1f\x7f-\xff/./;
5517    $outStr =~ s/\x00//g;
5518    my $verbose = $$self{OPTIONS}{Verbose};
5519    if ($verbose < 4) {
5520        if ($maxLen) {
5521            $maxLen = 20 if $maxLen < 20;   # minimum length is 20
5522        } elsif (defined $maxLen) {
5523            $maxLen = length $outStr;       # 0 is unlimited
5524        } else {
5525            $maxLen = 60;                   # default maximum is 60
5526        }
5527    } else {
5528        $maxLen = length $outStr;
5529        # limit to 2048 characters if verbose < 5
5530        $maxLen = 2048 if $maxLen > 2048 and $verbose < 5;
5531    }
5532
5533    # limit length if necessary
5534    $outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen;
5535    return $outStr;
5536}
5537
5538#------------------------------------------------------------------------------
5539# Convert date/time from Exif format
5540# Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format
5541# Returns: Formatted date/time string
5542sub ConvertDateTime($$)
5543{
5544    my ($self, $date) = @_;
5545    my $fmt = $$self{OPTIONS}{DateFormat};
5546    my $shift = $$self{OPTIONS}{GlobalTimeShift};
5547    if ($shift) {
5548        my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1;
5549        my $offset = $$self{GLOBAL_TIME_OFFSET};
5550        $offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { };
5551        ShiftTime($date, $shift, $dir, $offset);
5552    }
5553    # only convert date if a format was specified and the date is recognizable
5554    if ($fmt) {
5555        # separate time zone if it exists
5556        my $tz;
5557        $date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1;
5558        # a few cameras use incorrect date/time formatting:
5559        # - slashes instead of colons in date (RolleiD330, ImpressCam)
5560        # - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar)
5561        # - single-digit seconds with leading space (HP scanners)
5562        my @a = reverse ($date =~ /\d+/g);  # be very flexible about date/time format
5563        if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) {
5564            shift @a while @a > 6;      # remove superfluous entries
5565            unshift @a, 1 while @a < 3; # add month and day if necessary
5566            unshift @a, 0 while @a < 6; # add h,m,s if necessary
5567            $a[4] -= 1;                 # base month is 1
5568            # parse %z and %s ourself (to handle time zones properly)
5569            if ($fmt =~ /%[sz]/) {
5570                # use system time zone unless otherwise specified
5571                $tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local };
5572                # remove colon, setting to UTC if time zone is not numeric
5573                $tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000';
5574                $fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g;      # convert '%z' format codes
5575                if ($fmt =~ /%s/ and eval { require Time::Local }) {
5576                    # calculate seconds since the Epoch, UTC
5577                    my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40);
5578                    $fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g;   # convert '%s' format codes
5579                }
5580            }
5581            $a[5] -= 1900;  # strftime year starts from 1900
5582            $date = POSIX::strftime($fmt, @a);  # generate the formatted date/time
5583        } elsif ($$self{OPTIONS}{StrictDate}) {
5584            undef $date;
5585        }
5586    }
5587    return $date;
5588}
5589
5590#------------------------------------------------------------------------------
5591# Print conversion for time span value
5592# Inputs: 0) time ticks, 1) number of seconds per tick (default 1)
5593# Returns: readable time
5594sub ConvertTimeSpan($;$)
5595{
5596    my ($val, $mult) = @_;
5597    if (Image::ExifTool::IsFloat($val) and $val != 0) {
5598        $val *= $mult if $mult;
5599        if ($val < 60) {
5600            $val = "$val seconds";
5601        } elsif ($val < 3600) {
5602            my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f';
5603            my $s = ($val == 60 and $mult) ? '' : 's';
5604            $val = sprintf("$fmt minute$s", $val / 60);
5605        } elsif ($val < 24 * 3600) {
5606            $val = sprintf("%.1f hours", $val / 3600);
5607        } else {
5608            $val = sprintf("%.1f days", $val / (24 * 3600));
5609        }
5610    }
5611    return $val;
5612}
5613
5614#------------------------------------------------------------------------------
5615# Patched timelocal() that fixes ActivePerl timezone bug
5616# Inputs/Returns: same as timelocal()
5617# Notes: must 'require Time::Local' before calling this routine
5618sub TimeLocal(@)
5619{
5620    my $tm = Time::Local::timelocal(@_);
5621    if ($^O eq 'MSWin32') {
5622        # patch for ActivePerl timezone bug
5623        my @t2 = localtime($tm);
5624        my $t2 = Time::Local::timelocal(@t2);
5625        # adjust timelocal() return value to be consistent with localtime()
5626        $tm += $tm - $t2;
5627    }
5628    return $tm;
5629}
5630
5631#------------------------------------------------------------------------------
5632# Get time zone in minutes
5633# Inputs: 0) localtime array ref, 1) gmtime array ref
5634# Returns: time zone offset in minutes
5635sub GetTimeZone($$)
5636{
5637    my ($tm, $gm) = @_;
5638    # compute the number of minutes between localtime and gmtime
5639    my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]);
5640    if ($$tm[3] != $$gm[3]) {
5641        # account for case where one date wraps to the first of the next month
5642        $$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1;
5643        # adjust for the +/- one day difference
5644        $min += ($$tm[3] - $$gm[3]) * 24 * 60;
5645    }
5646    # MirBSD patch to round to the nearest 30 minutes because
5647    # it includes leap seconds in localtime but not gmtime
5648    $min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd';
5649    return $min;
5650}
5651
5652#------------------------------------------------------------------------------
5653# Get time zone string
5654# Inputs: 0) time zone offset in minutes
5655#     or  0) localtime array ref, 1) corresponding time value
5656# Returns: time zone string ("+/-HH:MM")
5657sub TimeZoneString($;$)
5658{
5659    my $min = shift;
5660    if (ref $min) {
5661        my @gm = gmtime(shift);
5662        $min = GetTimeZone($min, \@gm);
5663    }
5664    my $sign = '+';
5665    $min < 0 and $sign = '-', $min = -$min;
5666    $min = int($min + 0.5); # round off to nearest minute
5667    my $h = int($min / 60);
5668    return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60);
5669}
5670
5671#------------------------------------------------------------------------------
5672# Convert Unix time to EXIF date/time string
5673# Inputs: 0) Unix time value, 1) non-zero to convert to local time,
5674#         2) number of digits after the decimal for fractional seconds
5675# Returns: EXIF date/time string (with timezone for local times)
5676sub ConvertUnixTime($;$$)
5677{
5678    my ($time, $toLocal, $dec) = @_;
5679    return '0000:00:00 00:00:00' if $time == 0;
5680    my (@tm, $tz);
5681    if ($dec) {
5682        my $frac = $time - int($time);
5683        $time = int($time);
5684        $frac < 0 and $frac += 1, $time -= 1;
5685        $dec = sprintf('%.*f', $dec, $frac);
5686        # remove number before decimal and increment integer time if it was rounded up
5687        $dec =~ s/^(\d)// and $1 eq '1' and $time += 1;
5688    } else {
5689        $time = int($time + 1e-6) if $time != int($time);  # avoid round-off errors
5690        $dec = '';
5691    }
5692    if ($toLocal) {
5693        @tm = localtime($time);
5694        $tz = TimeZoneString(\@tm, $time);
5695    } else {
5696        @tm = gmtime($time);
5697        $tz = '';
5698    }
5699    my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s",
5700                      $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz);
5701    return $str;
5702}
5703
5704#------------------------------------------------------------------------------
5705# Get Unix time from EXIF-formatted date/time string with optional timezone
5706# Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC
5707# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error
5708sub GetUnixTime($;$)
5709{
5710    my ($timeStr, $isLocal) = @_;
5711    return 0 if $timeStr eq '0000:00:00 00:00:00';
5712    my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(.*)/);
5713    return undef unless @tm == 7 and eval { require Time::Local };
5714    my ($tzStr, $tzSec) = (pop(@tm), 0);
5715    # use specified timezone offset (if given) instead of local system time
5716    # if we are converting a local time value
5717    if ($isLocal) {
5718        if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) {
5719            # use specified timezone if one exists
5720            $tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1;
5721            undef $isLocal; # convert using GMT corrected for specified timezone
5722        } elsif ($isLocal eq '2') {
5723            undef $isLocal;
5724        }
5725    }
5726    $tm[1] -= 1;        # convert month
5727    @tm = reverse @tm;  # change to order required by timelocal()
5728    my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec;
5729    # handle fractional seconds
5730    $val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/;
5731    return $val;
5732}
5733
5734#------------------------------------------------------------------------------
5735# Print conversion for file size
5736# Inputs: 0) file size in bytes
5737# Returns: converted file size
5738sub ConvertFileSize($)
5739{
5740    my $val = shift;
5741    $val < 2048 and return "$val bytes";
5742    $val < 10240 and return sprintf('%.1f KiB', $val / 1024);
5743    $val < 2097152 and return sprintf('%.0f KiB', $val / 1024);
5744    $val < 10485760 and return sprintf('%.1f MiB', $val / 1048576);
5745    $val < 2147483648 and return sprintf('%.0f MiB', $val / 1048576);
5746    $val < 10737418240 and return sprintf('%.1f GiB', $val / 1073741824);
5747    return sprintf('%.0f GiB', $val / 1073741824);
5748}
5749
5750#------------------------------------------------------------------------------
5751# Convert seconds to duration string (handles negative durations)
5752# Inputs: 0) floating point seconds
5753# Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS"
5754sub ConvertDuration($)
5755{
5756    my $time = shift;
5757    return $time unless IsFloat($time);
5758    return '0 s' if $time == 0;
5759    my $sign = ($time > 0 ? '' : (($time = -$time), '-'));
5760    return sprintf("$sign%.2f s", $time) if $time < 30;
5761    $time += 0.5;   # to round off to nearest second
5762    my $h = int($time / 3600);
5763    $time -= $h * 3600;
5764    my $m = int($time / 60);
5765    $time -= $m * 60;
5766    if ($h > 24) {
5767        my $d = int($h / 24);
5768        $h -= $d * 24;
5769        $sign = "$sign$d days ";
5770    }
5771    return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time));
5772}
5773
5774#------------------------------------------------------------------------------
5775# Print conversion for bitrate values
5776# Inputs: 0) bitrate in bits per second
5777# Returns: human-readable bitrate string
5778# Notes: returns input value without formatting if it isn't numerical
5779sub ConvertBitrate($)
5780{
5781    my $bitrate = shift;
5782    IsFloat($bitrate) or return $bitrate;
5783    my @units = ('bps', 'kbps', 'Mbps', 'Gbps');
5784    for (;;) {
5785        my $units = shift @units;
5786        $bitrate >= 1000 and @units and $bitrate /= 1000, next;
5787        my $fmt = $bitrate < 100 ? '%.3g' : '%.0f';
5788        return sprintf("$fmt $units", $bitrate);
5789    }
5790}
5791
5792#------------------------------------------------------------------------------
5793# Convert file name for printing
5794# Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set
5795# Returns: converted file name in external character set
5796sub ConvertFileName($$)
5797{
5798    my ($self, $val) = @_;
5799    my $enc = $$self{OPTIONS}{CharsetFileName};
5800    $val = $self->Decode($val, $enc) if $enc;
5801    return $val;
5802}
5803
5804#------------------------------------------------------------------------------
5805# Inverse conversion for file name (encode in CharsetFileName)
5806# Inputs: 0) ExifTool ref, 1) file name in external character set
5807# Returns: file name in CharsetFileName character set
5808sub InverseFileName($$)
5809{
5810    my ($self, $val) = @_;
5811    my $enc = $$self{OPTIONS}{CharsetFileName};
5812    $val = $self->Encode($val, $enc) if $enc;
5813    $val =~ tr/\\/\//;  # make sure we are using forward slashes
5814    return $val;
5815}
5816
5817#------------------------------------------------------------------------------
5818# Save information for HTML dump
5819# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size
5820#         3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name
5821sub HDump($$$$;$$$)
5822{
5823    my $self = shift;
5824    $$self{HTML_DUMP} or return;
5825    my ($pos, $len, $com, $tip, $flg, $ifd) = @_;
5826    $pos += $$self{BASE} if $$self{BASE};
5827    # skip structural data blocks which have been removed from the middle of this dump
5828    # (SkipData list contains ordered [start,end+1] offsets to skip)
5829    if ($$self{SkipData}) {
5830        my $end = $pos + $len;
5831        my $skip;
5832        foreach $skip (@{$$self{SkipData}}) {
5833            $end <= $$skip[0] and last;
5834            $pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next;
5835            if ($pos != $$skip[0]) {
5836                $$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd);
5837                $len -= $$skip[0] - $pos;
5838                $tip = 'SAME';
5839            }
5840            $pos = $$skip[1];
5841        }
5842    }
5843    $$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd);
5844}
5845
5846#------------------------------------------------------------------------------
5847# Identify trailer ending at specified offset from end of file
5848# Inputs: 0) RAF reference, 1) offset from end of file (0 by default)
5849# Returns: Trailer info hash (with RAF and DirName set),
5850#          or undef if no recognized trailer was found
5851# Notes: leaves file position unchanged
5852sub IdentifyTrailer($;$)
5853{
5854    my $raf = shift;
5855    my $offset = shift || 0;
5856    my $pos = $raf->Tell();
5857    my ($buff, $type, $len);
5858    while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) {
5859        # read up to 64 bytes before specified offset from end of file
5860        $len = 64 if $len > 64;
5861        $raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last;
5862        if ($buff =~ /AXS(!|\*).{8}$/s) {
5863            $type = 'AFCP';
5864        } elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) {
5865            $type = 'FotoStation';
5866        } elsif ($buff =~ /cbipcbbl$/) {
5867            $type = 'PhotoMechanic';
5868        } elsif ($buff =~ /^CANON OPTIONAL DATA\0/) {
5869            $type = 'CanonVRD';
5870        } elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or
5871                 $buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s)
5872        {
5873            $type = 'MIE';
5874        } elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) {
5875            $type = 'Samsung';
5876        } elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) {
5877            $type = 'Insta360';
5878        }
5879        last;
5880    }
5881    $raf->Seek($pos, 0);    # restore original file position
5882    return $type ? { RAF => $raf, DirName => $type } : undef;
5883}
5884
5885#------------------------------------------------------------------------------
5886# Read/rewrite trailer information (including multiple trailers)
5887# Inputs: 0) ExifTool object ref, 1) DirInfo ref:
5888# - requires RAF and DirName
5889# - OutFile is a scalar reference for writing
5890# - scans from current file position if ScanForAFCP is set
5891# Returns: 1 if trailer was processed or couldn't be processed (or written OK)
5892#          0 if trailer was recognized but offsets need fixing (or write error)
5893# - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated
5894# - preserves current file position and byte order
5895sub ProcessTrailers($$)
5896{
5897    my ($self, $dirInfo) = @_;
5898    my $dirName = $$dirInfo{DirName};
5899    my $outfile = $$dirInfo{OutFile};
5900    my $offset = $$dirInfo{Offset} || 0;
5901    my $fixup = $$dirInfo{Fixup};
5902    my $raf = $$dirInfo{RAF};
5903    my $pos = $raf->Tell();
5904    my $byteOrder = GetByteOrder();
5905    my $success = 1;
5906    my $path = $$self{PATH};
5907
5908    for (;;) { # loop through all trailers
5909        my ($proc, $outBuff);
5910        if ($dirName eq 'Insta360') {
5911            require "Image/ExifTool/QuickTimeStream.pl";
5912            $proc = 'Image::ExifTool::QuickTime::ProcessInsta360';
5913        } else {
5914            require "Image/ExifTool/$dirName.pm";
5915            $proc = "Image::ExifTool::${dirName}::Process$dirName";
5916        }
5917        if ($outfile) {
5918            # write to local buffer so we can add trailer in proper order later
5919            $$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = '';
5920            # must generate new fixup if necessary so we can shift
5921            # the old fixup separately after we prepend this trailer
5922            delete $$dirInfo{Fixup};
5923        }
5924        delete $$dirInfo{DirLen};       # reset trailer length
5925        $$dirInfo{Offset} = $offset;    # set offset from end of file
5926        $$dirInfo{Trailer} = 1;         # set Trailer flag in case proc cares
5927        # add trailer and DirName to SubDirectory PATH
5928        push @$path, 'Trailer', $dirName;
5929
5930        # read or write this trailer
5931        # (proc takes Offset as positive offset from end of trailer to end of file,
5932        #  and returns DataPos and DirLen, and Fixup if applicable, and updates
5933        #  OutFile when writing)
5934        no strict 'refs';
5935        my $result = &$proc($self, $dirInfo);
5936        use strict 'refs';
5937
5938        # restore PATH (pop last 2 items)
5939        splice @$path, -2;
5940
5941        # check result
5942        if ($outfile) {
5943            if ($result > 0) {
5944                if ($outBuff) {
5945                    # write trailers to OutFile in original order
5946                    $$outfile = $outBuff . $$outfile;
5947                    # must adjust old fixup start if it exists
5948                    $$fixup{Start} += length($outBuff) if $fixup;
5949                    $outBuff = '';      # free memory
5950                }
5951                if ($$dirInfo{Fixup}) {
5952                    if ($fixup) {
5953                        # add fixup for subsequent trailers to the fixup for this trailer
5954                        # (but first we must adjust for the new start position)
5955                        $$fixup{Shift} += $$dirInfo{Fixup}{Start};
5956                        $$fixup{Start} -= $$dirInfo{Fixup}{Start};
5957                        $$dirInfo{Fixup}->AddFixup($fixup);
5958                    }
5959                    $fixup = $$dirInfo{Fixup};  # save fixup
5960                }
5961            } else {
5962                $success = 0 if $self->Error("Error rewriting $dirName trailer", 2);
5963                last;
5964            }
5965        } elsif ($result < 0) {
5966            # can't continue if we must scan for this trailer
5967            $success = 0;
5968            last;
5969        }
5970        last unless $result > 0 and $$dirInfo{DirLen};
5971        # look for next trailer
5972        $offset += $$dirInfo{DirLen};
5973        my $nextTrail = IdentifyTrailer($raf, $offset) or last;
5974        $dirName = $$dirInfo{DirName} = $$nextTrail{DirName};
5975        $raf->Seek($pos, 0);
5976    }
5977    SetByteOrder($byteOrder);       # restore original byte order
5978    $raf->Seek($pos, 0);            # restore original file position
5979    $$dirInfo{OutFile} = $outfile;  # restore original outfile
5980    $$dirInfo{Offset} = $offset;    # return offset from EOF to start of first trailer
5981    $$dirInfo{Fixup} = $fixup;      # return fixup information
5982    return $success;
5983}
5984
5985#------------------------------------------------------------------------------
5986# JPEG constants
5987
5988# JPEG marker names
5989%jpegMarker = (
5990    0x00 => 'NULL',
5991    0x01 => 'TEM',
5992    0xc0 => 'SOF0', # to SOF15, with a few exceptions below
5993    0xc4 => 'DHT',
5994    0xc8 => 'JPGA',
5995    0xcc => 'DAC',
5996    0xd0 => 'RST0', # to RST7
5997    0xd8 => 'SOI',
5998    0xd9 => 'EOI',
5999    0xda => 'SOS',
6000    0xdb => 'DQT',
6001    0xdc => 'DNL',
6002    0xdd => 'DRI',
6003    0xde => 'DHP',
6004    0xdf => 'EXP',
6005    0xe0 => 'APP0', # to APP15
6006    0xf0 => 'JPG0',
6007    0xfe => 'COM',
6008);
6009
6010# lookup for size of JPEG marker length word
6011# (2 bytes assumed unless specified here)
6012my %markerLenBytes = (
6013    0x00 => 0,  0x01 => 0,
6014    0xd0 => 0,  0xd1 => 0,  0xd2 => 0,  0xd3 => 0,  0xd4 => 0,  0xd5 => 0,  0xd6 => 0,  0xd7 => 0,
6015    0xd8 => 0,  0xd9 => 0,  0xda => 0,
6016    # J2C
6017    0x30 => 0,  0x31 => 0,  0x32 => 0,  0x33 => 0,  0x34 => 0,  0x35 => 0,  0x36 => 0,  0x37 => 0,
6018    0x38 => 0,  0x39 => 0,  0x3a => 0,  0x3b => 0,  0x3c => 0,  0x3d => 0,  0x3e => 0,  0x3f => 0,
6019    0x4f => 0,
6020    0x92 => 0,  0x93 => 0,
6021    # J2C extensions
6022    0x74 => 4, 0x75 => 4, 0x77 => 4,
6023);
6024
6025#------------------------------------------------------------------------------
6026# Get JPEG marker name
6027# Inputs: 0) Jpeg number
6028# Returns: marker name
6029sub JpegMarkerName($)
6030{
6031    my $marker = shift;
6032    my $markerName = $jpegMarker{$marker};
6033    unless ($markerName) {
6034        $markerName = $jpegMarker{$marker & 0xf0};
6035        if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) {
6036            $markerName = $1 . ($marker & 0x0f);
6037        } else {
6038            $markerName = sprintf("marker 0x%.2x", $marker);
6039        }
6040    }
6041    return $markerName;
6042}
6043
6044#------------------------------------------------------------------------------
6045# Adjust directory start position
6046# Inputs: 0) dirInfo ref, 1) start offset
6047#         2) Base for offsets (relative to DataPos, defaults to absolute Base of 0)
6048sub DirStart($$;$)
6049{
6050    my ($dirInfo, $start, $base) = @_;
6051    $$dirInfo{DirStart} = $start;
6052    $$dirInfo{DirLen} -= $start;
6053    if (defined $base) {
6054        $$dirInfo{Base} = $$dirInfo{DataPos} + $base;
6055        $$dirInfo{DataPos} = -$base;    # (relative to Base!)
6056    }
6057}
6058
6059#------------------------------------------------------------------------------
6060# Extract metadata from a jpg image
6061# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
6062# Returns: 1 on success, 0 if this wasn't a valid JPEG file
6063sub ProcessJPEG($$)
6064{
6065    local $_;
6066    my ($self, $dirInfo) = @_;
6067    my ($ch, $s, $length);
6068    my $options = $$self{OPTIONS};
6069    my $verbose = $$options{Verbose};
6070    my $out = $$options{TextOut};
6071    my $fast = $$options{FastScan} || 0;
6072    my $raf = $$dirInfo{RAF};
6073    my $htmlDump = $$self{HTML_DUMP};
6074    my %dumpParms = ( Out => $out );
6075    my ($success, $wantTrailer, $trailInfo, $foundSOS);
6076    my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal);
6077    my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP);
6078
6079    # check to be sure this is a valid JPG (or J2C, or EXV) file
6080    return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/;
6081    if ($s eq "\xff\x01") {
6082        return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2';
6083        $$self{FILE_TYPE} = 'EXV';
6084    }
6085    my $appBytes = 0;
6086    my $calcImageLen = $$self{REQ_TAG_LOOKUP}{jpegimagelength};
6087    if ($$options{RequestAll} and $$options{RequestAll} > 2) {
6088        $calcImageLen = 1;
6089    }
6090    if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) {
6091        $self->SetFileType();               # set FileType tag
6092        return 1 if $fast == 3;             # don't process file when FastScan == 3
6093        $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags
6094    }
6095    $$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode
6096
6097    $dumpParms{MaxLen} = 128 if $verbose < 4;
6098    if ($htmlDump) {
6099        $dumpEnd = $raf->Tell();
6100        my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI');
6101        my $pos = $dumpEnd - $n;
6102        $self->HDump(0, $pos, '[unknown header]') if $pos;
6103        $self->HDump($pos, $n, "$t header", "$m Marker");
6104    }
6105    my $path = $$self{PATH};
6106    my $pn = scalar @$path;
6107
6108    # set input record separator to 0xff (the JPEG marker) to make reading quicker
6109    local $/ = "\xff";
6110
6111    my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData);
6112
6113    # read file until we reach an end of image (EOI) or start of scan (SOS)
6114    Marker: for (;;) {
6115        # set marker and data pointer for current segment
6116        my $marker = $nextMarker;
6117        my $segDataPt = $nextSegDataPt;
6118        my $segPos = $nextSegPos;
6119        undef $nextMarker;
6120        undef $nextSegDataPt;
6121#
6122# read ahead to the next segment unless we have reached EOI, SOS or SOD
6123#
6124        unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) {
6125            # read up to next marker (JPEG markers begin with 0xff)
6126            my $buff;
6127            $raf->ReadLine($buff) or last;
6128            # JPEG markers can be padded with unlimited 0xff's
6129            for (;;) {
6130                $raf->Read($ch, 1) or last Marker;
6131                $nextMarker = ord($ch);
6132                last unless $nextMarker == 0xff;
6133            }
6134            # read segment data if it exists
6135            if (not defined $markerLenBytes{$nextMarker}) {
6136                # read record length word
6137                last unless $raf->Read($s, 2) == 2;
6138                my $len = unpack('n',$s);   # get data length
6139                last unless defined($len) and $len >= 2;
6140                $nextSegPos = $raf->Tell();
6141                $len -= 2;  # subtract size of length word
6142                last unless $raf->Read($buff, $len) == $len;
6143                $nextSegDataPt = \$buff;    # set pointer to our next data
6144            } elsif ($markerLenBytes{$nextMarker} == 4) {
6145                # handle J2C extensions with 4-byte length word
6146                last unless $raf->Read($s, 4) == 4;
6147                my $len = unpack('N',$s);   # get data length
6148                last unless defined($len) and $len >= 4;
6149                $nextSegPos = $raf->Tell();
6150                $len -= 4;  # subtract size of length word
6151                last unless $raf->Seek($len, 1);
6152            }
6153            # read second segment too if this was the first
6154            next unless defined $marker;
6155        }
6156        # set some useful variables for the current segment
6157        my $markerName = JpegMarkerName($marker);
6158        $$path[$pn] = $markerName;
6159#
6160# parse the current segment
6161#
6162        # handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc)
6163        if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) {
6164            $length = length $$segDataPt;
6165            if ($verbose) {
6166                print $out "JPEG $markerName ($length bytes):\n";
6167                HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2;
6168            } elsif ($htmlDump) {
6169                $self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08);
6170                $dumpEnd = $segPos + $length;
6171            }
6172            next unless $length >= 6;
6173            # extract some useful information
6174            my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt);
6175            my $sof = GetTagTable('Image::ExifTool::JPEG::SOF');
6176            $self->HandleTag($sof, 'ImageWidth', $w);
6177            $self->HandleTag($sof, 'ImageHeight', $h);
6178            $self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0);
6179            $self->HandleTag($sof, 'BitsPerSample', $p);
6180            $self->HandleTag($sof, 'ColorComponents', $n);
6181            next unless $n == 3 and $length >= 15;
6182            my ($i, $hmin, $hmax, $vmin, $vmax);
6183            # loop through all components to determine sampling frequency
6184            $subSampling = '';
6185            for ($i=0; $i<$n; ++$i) {
6186                my $sf = Get8u($segDataPt, 7 + 3 * $i);
6187                $subSampling .= sprintf('%.2x', $sf);
6188                # isolate horizontal and vertical components
6189                my ($hf, $vf) = ($sf >> 4, $sf & 0x0f);
6190                unless ($i) {
6191                    $hmin = $hmax = $hf;
6192                    $vmin = $vmax = $vf;
6193                    next;
6194                }
6195                # determine min/max frequencies
6196                $hmin = $hf if $hf < $hmin;
6197                $hmax = $hf if $hf > $hmax;
6198                $vmin = $vf if $vf < $vmin;
6199                $vmax = $vf if $vf > $vmax;
6200            }
6201            if ($hmin and $vmin) {
6202                my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin);
6203                $self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs");
6204            }
6205            next;
6206        } elsif ($marker == 0xd9) {         # EOI
6207            pop @$path;
6208            $verbose and print $out "JPEG EOI\n";
6209            my $pos = $raf->Tell();
6210            if ($htmlDump and $dumpEnd) {
6211                $self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08);
6212                $self->HDump($pos-2, 2, 'JPEG EOI', undef);
6213                $dumpEnd = 0;
6214            }
6215            if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') {
6216                $success = 1;
6217            } else {
6218                $self->Warn('Missing JPEG SOS');
6219            }
6220            if ($$self{REQ_TAG_LOOKUP}{trailer}) {
6221                # read entire trailer into memory
6222                if ($raf->Seek(0,2)) {
6223                    my $len = $raf->Tell() - $pos;
6224                    if ($len) {
6225                        my $buff;
6226                        $raf->Seek($pos, 0);
6227                        $self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len;
6228                        $raf->Seek($pos, 0);
6229                    }
6230                } else {
6231                    $self->Warn('Error seeking in file');
6232                }
6233            }
6234            # we are here because we are looking for trailer information
6235            if ($wantTrailer) {
6236                my $start = $$self{PreviewImageStart};
6237                if ($start or $$options{ExtractEmbedded}) {
6238                    my $buff;
6239                    # most previews start right after the JPEG EOI, but the Olympus E-20
6240                    # preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is
6241                    # 979 bytes in, and Sony previews can start up to 32 kB into the trailer.
6242                    # (and Minolta and Sony previews can have a random first byte...)
6243                    my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024;
6244                    if ($raf->Read($buff, $scanLen)) {
6245                        if ($buff =~ /^.{4}ftyp/s) {
6246                            my $val;
6247                            if ($raf->Seek(0,2)) {
6248                                my $len = $raf->Tell() - $pos;
6249                                if ($$options{Binary}) {
6250                                    $val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len;
6251                                } else {
6252                                    $val = \ "Binary data $len bytes";
6253                                }
6254                                if ($val) {
6255                                    $self->FoundTag('EmbeddedVideo', $val);
6256                                } else {
6257                                    $self->Warn('Error reading trailer');
6258                                }
6259                            } else {
6260                                $self->Warn('Error seeking to end of file');
6261                            }
6262                        } elsif ($buff =~ /\xff\xd8\xff./g or
6263                           ($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g))
6264                        {
6265                            # adjust PreviewImageStart to this location
6266                            my $actual = $pos + pos($buff) - 4;
6267                            if ($start and $start ne $actual and $verbose > 1) {
6268                                print $out "(Fixed PreviewImage location: $start -> $actual)\n";
6269                            }
6270                            # update preview image offsets
6271                            if ($start) {
6272                                $$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart};
6273                                $$self{PreviewImageStart} = $actual;
6274                            }
6275                            # load preview now if we tried and failed earlier
6276                            if ($$self{PreviewError} and $$self{PreviewImageLength}) {
6277                                if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) {
6278                                    $self->FoundTag('PreviewImage', $buff);
6279                                    delete $$self{PreviewError};
6280                                }
6281                            }
6282                        }
6283                    }
6284                    $raf->Seek($pos, 0);
6285                }
6286            }
6287            # process trailer now or finish processing trailers
6288            # and scan for AFCP if necessary
6289            my $fromEnd = 0;
6290            if ($trailInfo) {
6291                $$trailInfo{ScanForAFCP} = 1;   # scan now if necessary
6292                $self->ProcessTrailers($trailInfo);
6293                # save offset from end of file to start of first trailer
6294                $fromEnd = $$trailInfo{Offset};
6295                undef $trailInfo;
6296            }
6297            if ($$self{LeicaTrailer}) {
6298                $raf->Seek(0, 2);
6299                $$self{LeicaTrailer}{TrailPos} = $pos;
6300                $$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd;
6301                Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
6302            }
6303            # finally, dump remaining information in JPEG trailer
6304            if ($verbose or $htmlDump) {
6305                my $endPos = $$self{LeicaTrailerPos};
6306                unless ($endPos) {
6307                    $raf->Seek(0, 2);
6308                    $endPos = $raf->Tell() - $fromEnd;
6309                }
6310                $self->DumpUnknownTrailer({
6311                    RAF => $raf,
6312                    DataPos => $pos,
6313                    DirLen => $endPos - $pos
6314                }) if $endPos > $pos;
6315            }
6316            $self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen;
6317            last;       # all done parsing file
6318        } elsif ($marker == 0xda) {         # SOS
6319            pop @$path;
6320            $foundSOS = 1;
6321            # all done with meta information unless we have a trailer
6322            $verbose and print $out "JPEG SOS\n";
6323            unless ($fast) {
6324                $trailInfo = IdentifyTrailer($raf);
6325                # process trailer now unless we are doing verbose dump
6326                if ($trailInfo and $verbose < 3 and not $htmlDump) {
6327                    # process trailers (keep trailInfo to finish processing later
6328                    # only if we can't finish without scanning from end of file)
6329                    $self->ProcessTrailers($trailInfo) and undef $trailInfo;
6330                }
6331                if ($wantTrailer and $$self{PreviewImageStart}) {
6332                    # seek ahead and validate preview image
6333                    my $buff;
6334                    my $curPos = $raf->Tell();
6335                    if ($raf->Seek($$self{PreviewImageStart}, 0) and
6336                        $raf->Read($buff, 4) == 4 and
6337                        $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/)
6338                    {
6339                        undef $wantTrailer;
6340                    }
6341                    $raf->Seek($curPos, 0) or last;
6342                }
6343                # seek ahead and process Leica trailer
6344                if ($$self{LeicaTrailer}) {
6345                    require Image::ExifTool::Panasonic;
6346                    Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
6347                    $wantTrailer = 1 if $$self{LeicaTrailer};
6348                } else {
6349                    $wantTrailer = 1 if $$options{ExtractEmbedded};
6350                }
6351                next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump;
6352            }
6353            # must scan to EOI if Validate or JpegCompressionFactor used
6354            next if $$options{Validate} or $calcImageLen or $$self{REQ_TAG_LOOKUP}{trailer};
6355            # nothing interesting to parse after start of scan (SOS)
6356            $success = 1;
6357            last;   # all done parsing file
6358        } elsif ($marker == 0x93) {
6359            pop @$path;
6360            $verbose and print $out "JPEG SOD\n";
6361            $success = 1;
6362            next if $verbose > 2 or $htmlDump;
6363            last;   # all done parsing file
6364        } elsif (defined $markerLenBytes{$marker}) {
6365            # handle other stand-alone markers and segments we skipped over
6366            $verbose and $marker and print $out "JPEG $markerName\n";
6367            next;
6368        } elsif ($marker == 0xdb and length($$segDataPt) and    # DQT
6369            # save the DQT data only if JPEGDigest has been requested
6370            # (Note: since we aren't checking the RequestAll API option here, the application
6371            #  must use the RequestTags option to generate these tags if they have not been
6372            #  specifically requested.  The reason is that there is too much overhead involved
6373            #  in the calculation of this tag to make this worth the CPU time.)
6374            ($$self{REQ_TAG_LOOKUP}{jpegdigest} or $$self{REQ_TAG_LOOKUP}{jpegqualityestimate}
6375            or ($$options{RequestAll} and $$options{RequestAll} > 2)))
6376        {
6377            my $num = unpack('C',$$segDataPt) & 0x0f;   # get table index
6378            $dqt[$num] = $$segDataPt if $num < 4;       # save for MD5 calculation
6379        }
6380        # handle all other markers
6381        my $dumpType = '';
6382        my ($desc, $tip, $xtra);
6383        $length = length $$segDataPt;
6384        $appBytes += $length + 4 if ($marker & 0xf0) == 0xe0;  # total size of APP segments
6385        if ($verbose) {
6386            print $out "JPEG $markerName ($length bytes):\n";
6387            if ($verbose > 2) {
6388                my %extraParms = ( Addr => $segPos );
6389                $extraParms{MaxLen} = 128 if $verbose == 4;
6390                HexDump($segDataPt, undef, %dumpParms, %extraParms);
6391            }
6392        }
6393        # prepare dirInfo hash for processing this information
6394        my %dirInfo = (
6395            Parent   => $markerName,
6396            DataPt   => $segDataPt,
6397            DataPos  => $segPos,
6398            DataLen  => $length,
6399            DirStart => 0,
6400            DirLen   => $length,
6401            Base     => 0,
6402        );
6403        if ($marker == 0xe0) {              # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad)
6404            if ($$segDataPt =~ /^JFIF\0/) {
6405                $dumpType = 'JFIF';
6406                DirStart(\%dirInfo, 5); # start at byte 5
6407                SetByteOrder('MM');
6408                my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
6409                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6410            } elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) {
6411                my $tag = ord $1;
6412                $dumpType = 'JFXX';
6413                my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension');
6414                my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag);
6415                $self->FoundTag($tagInfo, substr($$segDataPt, 6));
6416            } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) {
6417                next if $fast > 1;      # skip processing for very fast
6418                $dumpType = 'CIFF';
6419                my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) );
6420                $$self{SET_GROUP1} = 'CIFF';
6421                push @{$$self{PATH}}, 'CIFF';
6422                require Image::ExifTool::CanonRaw;
6423                Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo);
6424                pop @{$$self{PATH}};
6425                delete $$self{SET_GROUP1};
6426            } elsif ($$segDataPt =~ /^(AVI1|Ocad)/) {
6427                $dumpType = $1;
6428                SetByteOrder('MM');
6429                my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType");
6430                DirStart(\%dirInfo, 4);
6431                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6432            }
6433        } elsif ($marker == 0xe1) {         # APP1 (EXIF, XMP, QVCI, PARROT)
6434            # (some Kodak cameras don't put a second "\0", and I have seen an
6435            #  example where there was a second 4-byte APP1 segment header)
6436            if ($$segDataPt =~ /^(.{0,4})Exif\0/is) {
6437                undef $dumpType;    # (will be dumped here)
6438                # this is EXIF data --
6439                # get the data block (into a common variable)
6440                my $hdrLen = length($exifAPP1hdr);
6441                if (length $1) {
6442                    $hdrLen += length $1;
6443                    $self->Warn('Unknown garbage at start of EXIF segment',1);
6444                } elsif ($$segDataPt !~ /^Exif\0/) {
6445                    $self->Warn('Incorrect EXIF segment identifier',1);
6446                }
6447                if ($htmlDump) {
6448                    $self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes");
6449                    $self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif');
6450                    $dumpEnd = $segPos + $length;
6451                }
6452                my $dataPt = $segDataPt;
6453                if (defined $combinedSegData) {
6454                    push @skipData, [ $segPos-4, $segPos+$hdrLen ];
6455                    $combinedSegData .= substr($$segDataPt,$hdrLen);
6456                    undef $$segDataPt;
6457                    $dataPt = \$combinedSegData;
6458                    $segPos = $firstSegPos;
6459                }
6460                # peek ahead to see if the next segment is extended EXIF
6461                if ($nextMarker == $marker and
6462                    $$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/)
6463                {
6464                    # initialize combined data if necessary
6465                    unless (defined $combinedSegData) {
6466                        $combinedSegData = $$segDataPt;
6467                        undef $$segDataPt;
6468                        $firstSegPos = $segPos;
6469                        $self->Warn('File contains multi-segment EXIF',1);
6470                        $$self{ExtendedEXIF} = 1;
6471                    }
6472                    next;
6473                }
6474                $dirInfo{DataPt} = $dataPt;
6475                $dirInfo{DataPos} = $segPos;
6476                $dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt;
6477                DirStart(\%dirInfo, $hdrLen, $hdrLen);
6478                $$self{SkipData} = \@skipData if @skipData;
6479                # extract the EXIF information (it is in standard TIFF format)
6480                $self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment');
6481                # avoid looking for preview unless necessary because it really slows
6482                # us down -- only look for it if we found pointer, and preview is
6483                # outside EXIF, and PreviewImage is specifically requested
6484                my $start = $self->GetValue('PreviewImageStart', 'ValueConv');
6485                my $plen = $self->GetValue('PreviewImageLength', 'ValueConv');
6486                if (not $start or not $plen and $$self{PreviewError}) {
6487                    $start = $$self{PreviewImageStart};
6488                    $plen = $$self{PreviewImageLength};
6489                }
6490                if ($start and $plen and IsInt($start) and IsInt($plen) and
6491                    $start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and
6492                    ($$self{REQ_TAG_LOOKUP}{previewimage} or
6493                    # (extracted normally, so check Binary option)
6494                    ($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage})))
6495                {
6496                    $$self{PreviewImageStart} = $start;
6497                    $$self{PreviewImageLength} = $plen;
6498                    $wantTrailer = 1;
6499                }
6500                if (@skipData) {
6501                    undef @skipData;
6502                    delete $$self{SkipData};
6503                }
6504                undef $$dataPt;
6505                next;
6506            } elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) {
6507                # off len -- extended XMP header (75 bytes total):
6508                #   0  35 bytes - signature
6509                #  35  32 bytes - GUID (MD5 hash of full extended XMP data in ASCII)
6510                #  67   4 bytes - total size of extended XMP data
6511                #  71   4 bytes - offset for this XMP data portion
6512                $dumpType = 'Extended XMP';
6513                if ($length > 75) {
6514                    my ($size, $off) = unpack('x67N2', $$segDataPt);
6515                    my $guid = substr($$segDataPt, 35, 32);
6516                    if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase)
6517                        $self->WarnOnce($tip = 'Invalid extended XMP GUID');
6518                    } else {
6519                        my $extXMP = $extendedXMP{$guid};
6520                        if (not $extXMP) {
6521                            $extXMP = $extendedXMP{$guid} = { };
6522                        } elsif ($size != $$extXMP{Size}) {
6523                            $self->WarnOnce('Inconsistent extended XMP size');
6524                        }
6525                        $$extXMP{Size} = $size;
6526                        $$extXMP{$off} = substr($$segDataPt, 75);
6527                        $tip = "Full length: $size\nChunk offset: $off\nChunk length: " .
6528                            ($length - 75) . "\nGUID: $guid";
6529                        # (delay processing extended XMP until after reading all segments)
6530                    }
6531                } else {
6532                    $self->WarnOnce($tip = 'Invalid extended XMP segment');
6533                }
6534            } elsif ($$segDataPt =~ /^QVCI\0/) {
6535                $dumpType = 'QVCI';
6536                my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI');
6537                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6538            } elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) {
6539                $dumpType = 'FLIR';
6540                # must concatenate FLIR chunks (note: handle the case where
6541                # some software erroneously writes zeros for the chunk counts)
6542                my $chunkNum = Get8u($segDataPt, 6);
6543                my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!)
6544                $verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n",
6545                                    $chunkNum + 1, $chunksTot;
6546                if (defined $flirTotal) {
6547                    # abort parsing FLIR if the total chunk count is inconsistent
6548                    undef $flirCount if $chunksTot != $flirTotal;
6549                } else {
6550                    $flirCount = 0;
6551                    $flirTotal = $chunksTot;
6552                }
6553                if (defined $flirCount) {
6554                    if (defined $flirChunk[$chunkNum]) {
6555                        $self->WarnOnce('Duplicate FLIR chunk number(s)');
6556                        $flirChunk[$chunkNum] .= substr($$segDataPt, 8);
6557                    } else {
6558                        $flirChunk[$chunkNum] = substr($$segDataPt, 8);
6559                    }
6560                    # process the FLIR information if we have all of the chunks
6561                    if (++$flirCount >= $flirTotal) {
6562                        my $flir = '';
6563                        defined $_ and $flir .= $_ foreach @flirChunk;
6564                        undef @flirChunk;   # free memory
6565                        my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF');
6566                        my %dirInfo = (
6567                            DataPt   => \$flir,
6568                            Parent   => $markerName,
6569                            DirName  => 'FLIR',
6570                        );
6571                        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6572                        undef $flirCount;   # prevent reprocessing
6573                    }
6574                } else {
6575                    $self->WarnOnce('Invalid or extraneous FLIR chunk(s)');
6576                }
6577            } elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) {
6578                # (don't know if this could span multiple segments)
6579                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main');
6580                $self->HandleTag($tagTablePtr, 'APP1', $$segDataPt);
6581                $dumpType = 'Parrot';
6582            } else {
6583                # Hmmm.  Could be XMP, let's see
6584                my $processed;
6585                if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) {
6586                    $dumpType = 'XMP';
6587                    # also try to parse XMP with a non-standard header
6588                    # (note: this non-standard XMP is ignored when writing)
6589                    my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0;
6590                    my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
6591                    DirStart(\%dirInfo, $start);
6592                    $dirInfo{DirName} = $start ? 'XMP' : 'XML',
6593                    $processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6594                    if ($processed and not $start) {
6595                        $self->Warn('Non-standard header for APP1 XMP segment');
6596                    }
6597                }
6598                if ($verbose and not $processed) {
6599                    $self->Warn("Ignored APP1 segment length $length (unknown header)");
6600                }
6601            }
6602        } elsif ($marker == 0xe2) {         # APP2 (ICC Profile, FPXR, MPF, PreviewImage)
6603            if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) {
6604                $dumpType = 'ICC_Profile';
6605                # must concatenate profile chunks (note: handle the case where
6606                # some software erroneously writes zeros for the chunk counts)
6607                my $chunkNum = Get8u($segDataPt, 12);
6608                my $chunksTot = Get8u($segDataPt, 13);
6609                $verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n";
6610                if (defined $iccChunksTotal) {
6611                    # abort parsing ICC_Profile if the total chunk count is inconsistent
6612                    undef $iccChunkCount if $chunksTot != $iccChunksTotal;
6613                } else {
6614                    $iccChunkCount = 0;
6615                    $iccChunksTotal = $chunksTot;
6616                    $self->Warn('ICC_Profile chunk count is zero') if !$chunksTot;
6617                }
6618                if (defined $iccChunkCount) {
6619                    if (defined $iccChunk[$chunkNum]) {
6620                        $self->WarnOnce('Duplicate ICC_Profile chunk number(s)');
6621                        $iccChunk[$chunkNum] .= substr($$segDataPt, 14);
6622                    } else {
6623                        $iccChunk[$chunkNum] = substr($$segDataPt, 14);
6624                    }
6625                    # process profile if we have all of the chunks
6626                    if (++$iccChunkCount >= $iccChunksTotal) {
6627                        my $icc_profile = '';
6628                        defined $_ and $icc_profile .= $_ foreach @iccChunk;
6629                        undef @iccChunk;   # free memory
6630                        my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
6631                        my %dirInfo = (
6632                            DataPt   => \$icc_profile,
6633                            DataPos  => $segPos + 14,
6634                            DataLen  => length($icc_profile),
6635                            DirStart => 0,
6636                            DirLen   => length($icc_profile),
6637                            Parent   => $markerName,
6638                        );
6639                        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6640                        undef $iccChunkCount;     # prevent reprocessing
6641                    }
6642                } else {
6643                    $self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)');
6644                }
6645            } elsif ($$segDataPt =~ /^FPXR\0/) {
6646                next if $fast > 1;      # skip processing for very fast
6647                $dumpType = 'FPXR';
6648                my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
6649                # set flag if this is the last FPXR segment
6650                $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
6651                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6652            } elsif ($$segDataPt =~ /^MPF\0/) {
6653                undef $dumpType;    # (will be dumped here)
6654                DirStart(\%dirInfo, 4, 4);
6655                $dirInfo{Multi} = 1;    # the MP Attribute IFD will be MPF1
6656                if ($htmlDump) {
6657                    $self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes");
6658                    $self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF');
6659                    $dumpEnd = $segPos + $length;
6660                }
6661                # extract the MPF information (it is in standard TIFF format)
6662                my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main');
6663                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
6664            } elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) {
6665                # Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0",
6666                # Digilife DDC-690/Rollei="BGTH"
6667                $dumpType = 'Preview Image';
6668                $preview = substr($$segDataPt, length($1));
6669            } elsif ($preview) {
6670                $dumpType = 'Preview Image';
6671                $preview .= $$segDataPt;
6672            }
6673            if ($preview and $nextMarker ne $marker) {
6674                $self->FoundTag('PreviewImage', $preview);
6675                undef $preview;
6676            }
6677        } elsif ($marker == 0xe3) {         # APP3 (Kodak "Meta", Stim)
6678            if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) {
6679                undef $dumpType;    # (will be dumped here)
6680                DirStart(\%dirInfo, 6, 6);
6681                if ($htmlDump) {
6682                    $self->HDump($segPos-4, 10, 'APP3 Meta header');
6683                    $dumpEnd = $segPos + $length;
6684                }
6685                my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta');
6686                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
6687            } elsif ($$segDataPt =~ /^Stim\0/) {
6688                undef $dumpType;    # (will be dumped here)
6689                DirStart(\%dirInfo, 6, 6);
6690                if ($htmlDump) {
6691                    $self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes");
6692                    $self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim');
6693                    $dumpEnd = $segPos + $length;
6694                }
6695                # extract the Stim information (it is in standard TIFF format)
6696                my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main');
6697                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
6698            } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) {
6699                $dumpType = 'PreviewImage'; # (Samsung, HP, BenQ)
6700                $preview = $$segDataPt;
6701            }
6702            if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4
6703                $self->FoundTag('PreviewImage', $preview);
6704                undef $preview;
6705            }
6706        } elsif ($marker == 0xe4) {         # APP4 ("SCALADO", FPXR, PreviewImage)
6707            if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) {
6708                $dumpType = 'SCALADO';
6709                my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt);
6710                # assume that the segments are in order and just concatinate them
6711                $scalado = '' unless defined $scalado;
6712                $scalado .= substr($$segDataPt, 16);
6713                if ($idx == $num - 1) {
6714                    if ($len != length $scalado) {
6715                        $self->Warn('Possibly corrupted APP4 SCALADO data', 1);
6716                    }
6717                    my %dirInfo = (
6718                        Parent => $markerName,
6719                        DataPt => \$scalado,
6720                    );
6721                    my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main');
6722                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6723                    undef $scalado;
6724                }
6725            } elsif ($$segDataPt =~ /^FPXR\0/) {
6726                next if $fast > 1;      # skip processing for very fast
6727                $dumpType = 'FPXR';
6728                my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
6729                # set flag if this is the last FPXR segment
6730                $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
6731                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6732            } elsif ($preview) {
6733                # continued Samsung S1060 preview from APP3
6734                $dumpType = 'PreviewImage';
6735                $preview .= $$segDataPt;
6736            }
6737            # (also seen "QTI Debug Metadata\0" segment in some newer Samsung images)
6738            # BenQ DC E1050 continues preview in APP5
6739            if ($preview and $nextMarker ne 0xe5) {
6740                $self->FoundTag('PreviewImage', $preview);
6741                undef $preview;
6742            }
6743        } elsif ($marker == 0xe5) {         # APP5 (Ricoh "RMETA")
6744            if ($$segDataPt =~ /^RMETA\0/) {
6745                # (NOTE: apparently these may span multiple segments, but I haven't seen
6746                # a sample like this, so multi-segment support hasn't yet been implemented)
6747                $dumpType = 'Ricoh RMETA';
6748                DirStart(\%dirInfo, 6, 6);
6749                my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA');
6750                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6751            } elsif ($$segDataPt =~ /^ssuniqueid\0/) {
6752                my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5');
6753                $self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11));
6754            } elsif ($preview) {
6755                $dumpType = 'PreviewImage';
6756                $preview .= $$segDataPt;
6757                $self->FoundTag('PreviewImage', $preview);
6758                undef $preview;
6759            }
6760        } elsif ($marker == 0xe6) {         # APP6 (Toshiba EPPIM, NITF, HP_TDHD)
6761            if ($$segDataPt =~ /^EPPIM\0/) {
6762                undef $dumpType;    # (will be dumped here)
6763                DirStart(\%dirInfo, 6, 6);
6764                if ($htmlDump) {
6765                    $self->HDump($segPos-4, 10, 'APP6 EPPIM header');
6766                    $dumpEnd = $segPos + $length;
6767                }
6768                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM');
6769                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
6770            } elsif ($$segDataPt =~ /^NITF\0/) {
6771                $dumpType = 'NITF';
6772                SetByteOrder('MM');
6773                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF');
6774                DirStart(\%dirInfo, 5);
6775                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6776            } elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) {
6777                # HP Photosmart R837 APP6 "TDHD" segment
6778                $dumpType = 'TDHD';
6779                my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD');
6780                # (ignore first TDHD element because size includes 12-byte tag header)
6781                DirStart(\%dirInfo, 12);
6782                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6783            } elsif ($$segDataPt =~ /^GoPro\0/) {
6784                # GoPro segment
6785                $dumpType = 'GoPro';
6786                my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF');
6787                DirStart(\%dirInfo, 6);
6788                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6789            }
6790        } elsif ($marker == 0xe7) {         # APP7 (Pentax, Huawei, Qualcomm)
6791            if ($$segDataPt =~ /^PENTAX \0(II|MM)/) {
6792                # found in K-3 images (is this multi-segment??)
6793                SetByteOrder($1);
6794                undef $dumpType; # (dump this ourself)
6795                my $hdrLen = 10;
6796                my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main');
6797                DirStart(\%dirInfo, $hdrLen, 0);
6798                $dirInfo{DirName} = 'Pentax APP7';
6799                if ($htmlDump) {
6800                    $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes");
6801                    $self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax');
6802                    $dumpEnd = $segPos + $length;
6803                }
6804                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6805            } elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) {
6806                SetByteOrder($1);
6807                undef $dumpType; # (dump this ourself)
6808                my $hdrLen = 16;
6809                my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main');
6810                DirStart(\%dirInfo, $hdrLen, 8);
6811                $dirInfo{DirName} = 'Huawei APP7';
6812                if ($htmlDump) {
6813                    $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes");
6814                    $self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei');
6815                    $dumpEnd = $segPos + $length;
6816                }
6817                $$self{SET_GROUP0} = 'APP7';
6818                $$self{SET_GROUP1} = 'Huawei';
6819                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6820                delete $$self{SET_GROUP0};
6821                delete $$self{SET_GROUP1};
6822            } elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) {
6823                # found in HP iPAQ_VoiceMessenger
6824                $dumpType = 'Qualcomm';
6825                my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main');
6826                DirStart(\%dirInfo, 27);
6827                $dirInfo{DirName} = 'Qualcomm';
6828                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6829            }
6830        } elsif ($marker == 0xe8) {         # APP8 (SPIFF)
6831            # my sample SPIFF has 32 bytes of data, but spec states 30
6832            if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) {
6833                $dumpType = 'SPIFF';
6834                DirStart(\%dirInfo, 6);
6835                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF');
6836                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6837            }
6838        } elsif ($marker == 0xe9) {         # APP9 (Media Jukebox)
6839            if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) {
6840                $dumpType = 'MediaJukebox';
6841                # (start parsing after the "<MJMD>")
6842                DirStart(\%dirInfo, 22);
6843                $dirInfo{DirName} = 'MediaJukebox';
6844                require Image::ExifTool::XMP;
6845                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox');
6846                $self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP);
6847            }
6848        } elsif ($marker == 0xea) {         # APP10 (PhotoStudio Unicode comments)
6849            if ($$segDataPt =~ /^UNICODE\0/) {
6850                $dumpType = 'PhotoStudio';
6851                my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM');
6852                $self->FoundTag('Comment', $comment);
6853            } elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) {
6854                # iPhone "AROT" segment containing integrated intensity per 16 scan lines
6855                # (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz)
6856                $xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')';
6857            }
6858        } elsif ($marker == 0xeb) {         # APP11 (JPEG-HDR)
6859            if ($$segDataPt =~ /^HDR_RI /) {
6860                $dumpType = 'JPEG-HDR';
6861                my $dataPt = $segDataPt;
6862                if (defined $combinedSegData) {
6863                    if ($$segDataPt =~ /~\0/g) {
6864                        $combinedSegData .= substr($$segDataPt,pos($$segDataPt));
6865                    } else {
6866                        $self->Warn('Invalid format for JPEG-HDR extended segment');
6867                    }
6868                    $dataPt = \$combinedSegData;
6869                }
6870                if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) {
6871                    $combinedSegData = $$segDataPt unless defined $combinedSegData;
6872                } else {
6873                    my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR');
6874                    my %dirInfo = ( DataPt => $dataPt );
6875                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6876                    undef $combinedSegData;
6877                }
6878            }
6879        } elsif ($marker == 0xec) {         # APP12 (Ducky, Picture Info)
6880            if ($$segDataPt =~ /^Ducky/) {
6881                $dumpType = 'Ducky';
6882                DirStart(\%dirInfo, 5);
6883                my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
6884                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6885            } else {
6886                my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo');
6887                $self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info';
6888            }
6889        } elsif ($marker == 0xed) {         # APP13 (Photoshop, Adobe_CM)
6890            my $isOld;
6891            if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) {
6892                $dumpType = 'Photoshop';
6893                # add this data to the combined data if it exists
6894                my $dataPt = $segDataPt;
6895                if (defined $combinedSegData) {
6896                    $combinedSegData .= substr($$segDataPt,length($psAPP13hdr));
6897                    $dataPt = \$combinedSegData;
6898                }
6899                # peek ahead to see if the next segment is photoshop data too
6900                if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) {
6901                    # initialize combined data if necessary
6902                    $combinedSegData = $$segDataPt unless defined $combinedSegData;
6903                    # (will handle the Photoshop data the next time around)
6904                } else {
6905                    my $hdrLen = $isOld ? 27 : 14;
6906                    # process APP13 Photoshop record
6907                    my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
6908                    my %dirInfo = (
6909                        DataPt   => $dataPt,
6910                        DataPos  => $segPos,
6911                        DataLen  => length $$dataPt,
6912                        DirStart => $hdrLen,    # directory starts after identifier
6913                        DirLen   => length($$dataPt) - $hdrLen,
6914                        Parent   => $markerName,
6915                    );
6916                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6917                    undef $combinedSegData;
6918                }
6919            } elsif ($$segDataPt =~ /^Adobe_CM/) {
6920                $dumpType = 'Adobe_CM';
6921                SetByteOrder('MM');
6922                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM');
6923                DirStart(\%dirInfo, 8);
6924                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6925            }
6926        } elsif ($marker == 0xee) {         # APP14 (Adobe)
6927            if ($$segDataPt =~ /^Adobe/) {
6928                # extract as a block if requested, or if copying tags from file
6929                if ($$self{REQ_TAG_LOOKUP}{adobe} or
6930                    # (not extracted normally, so check TAGS_FROM_FILE)
6931                    ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe}))
6932                {
6933                    $self->FoundTag('Adobe', $$segDataPt);
6934                }
6935                $dumpType = 'Adobe';
6936                SetByteOrder('MM');
6937                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe');
6938                DirStart(\%dirInfo, 5);
6939                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
6940            }
6941        } elsif ($marker == 0xef) {         # APP15 (GraphicConverter)
6942            if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) {
6943                $dumpType = 'GraphicConverter';
6944                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv');
6945                $self->HandleTag($tagTablePtr, 'Q', $1);
6946            }
6947        } elsif ($marker == 0xfe) {         # COM (JPEG comment)
6948            $dumpType = 'Comment';
6949            $$segDataPt =~ s/\0+$//;    # some dumb softwares add null terminators
6950            $self->FoundTag('Comment', $$segDataPt);
6951        } elsif ($marker == 0x64) {         # CME (J2C comment and extension)
6952            $dumpType = 'Comment';
6953            if ($length > 2) {
6954                my $reg = unpack('n', $$segDataPt); # get registration value
6955                my $val = substr($$segDataPt, 2);
6956                $val = $self->Decode($val, 'Latin') if $reg == 1;
6957                # (actually an extension for $reg==65535, but store as binary comment)
6958                $self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val);
6959            }
6960        } elsif ($marker == 0x51) {         # SIZ (J2C)
6961            my ($w, $h) = unpack('x2N2', $$segDataPt);
6962            $self->FoundTag('ImageWidth', $w);
6963            $self->FoundTag('ImageHeight', $h);
6964        } elsif (($marker & 0xf0) != 0xe0) {
6965            $dumpType = "$markerName segment";
6966            $desc = "[JPEG $markerName]";   # (other known JPEG segments)
6967        }
6968        if (defined $dumpType) {
6969            if (not $dumpType and ($$options{Unknown} or $$options{Validate})) {
6970                my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : '';
6971                $xtra = 'segment' unless $xtra;
6972                $self->Warn("Unknown $markerName$str $xtra", 1);
6973            }
6974            if ($htmlDump) {
6975                $desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
6976                $self->HDump($segPos-4, $length+4, $desc, $tip, 0x08);
6977                $dumpEnd = $segPos + $length;
6978            }
6979        }
6980        undef $$segDataPt;
6981    }
6982    # process extended XMP now if it existed
6983    if (%extendedXMP) {
6984        my $guid;
6985        # GUID indicated by the last main XMP segment
6986        my $goodGuid = $$self{VALUE}{HasExtendedXMP} || '';
6987        # GUID of the extended XMP that we will process ('2' for all)
6988        my $readGuid = $$options{ExtendedXMP} || 0;
6989        $readGuid = $goodGuid if $readGuid eq '1';
6990        foreach $guid (sort keys %extendedXMP) {
6991            next unless length $guid == 32;     # ignore other (internal) keys
6992            my $extXMP = $extendedXMP{$guid};
6993            my ($off, @offsets, $warn);
6994            # make sure we have all chunks, and create a list of sorted offsets
6995            for ($off=0; $off<$$extXMP{Size}; ) {
6996                last unless defined $$extXMP{$off};
6997                push @offsets, $off;
6998                $off += length $$extXMP{$off};
6999            }
7000            unless ($off == $$extXMP{Size}) {
7001                $self->Warn("Incomplete extended XMP (GUID $guid)");
7002                next;
7003            }
7004            if ($guid eq $readGuid or $readGuid eq '2') {
7005                $warn = 'Reading non-' if $guid ne $goodGuid;
7006                my $buff = '';
7007                # assemble XMP all together
7008                $buff .= $$extXMP{$_} foreach @offsets;
7009                my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
7010                my %dirInfo = (
7011                    DataPt      => \$buff,
7012                    Parent      => 'APP1',
7013                    IsExtended  => 1,
7014                );
7015                $$path[$pn] = 'APP1';
7016                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
7017                pop @$path;
7018            } else {
7019                $warn = 'Ignored ';
7020                $warn .= 'non-' if $guid ne $goodGuid;
7021            }
7022            $self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn;
7023            delete $extendedXMP{$guid};
7024        }
7025    }
7026    # calculate JPEGDigest if requested
7027    if (@dqt) {
7028        require Image::ExifTool::JPEGDigest;
7029        Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling);
7030    }
7031    # issue necessary warnings
7032    $self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount;
7033    $self->Warn('Incomplete FLIR record', 1) if defined $flirCount;
7034    $self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError};
7035    $success or $self->Warn('JPEG format error');
7036    pop @$path if @$path > $pn;
7037    return 1;
7038}
7039
7040#------------------------------------------------------------------------------
7041# Extract metadata from an Exiv2 EXV file
7042# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
7043# Returns: 1 on success, 0 if this wasn't a valid JPEG file
7044sub ProcessEXV($$)
7045{
7046    my ($self, $dirInfo) = @_;
7047    return $self->ProcessJPEG($dirInfo);
7048}
7049
7050#------------------------------------------------------------------------------
7051# Process EXIF file
7052# Inputs/Returns: same as ProcessTIFF
7053sub ProcessEXIF($$;$)
7054{
7055    my ($self, $dirInfo, $tagTablePtr) = @_;
7056    return $self->ProcessTIFF($dirInfo, $tagTablePtr);
7057}
7058
7059#------------------------------------------------------------------------------
7060# Process TIFF data (wrapper for DoProcessTIFF to allow re-entry)
7061# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
7062# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
7063sub ProcessTIFF($$;$)
7064{
7065    my ($self, $dirInfo, $tagTablePtr) = @_;
7066    my $exifData = $$self{EXIF_DATA};
7067    my $exifPos = $$self{EXIF_POS};
7068    my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr);
7069    # restore original EXIF information (in case ProcessTIFF is nested)
7070    if (defined $exifData) {
7071        $$self{EXIF_DATA} = $exifData;
7072        $$self{EXIF_POS} = $exifPos;
7073    }
7074    return $rtnVal;
7075}
7076
7077#------------------------------------------------------------------------------
7078# Process TIFF data
7079# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
7080# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
7081sub DoProcessTIFF($$;$)
7082{
7083    my ($self, $dirInfo, $tagTablePtr) = @_;
7084    my $dataPt = $$dirInfo{DataPt};
7085    my $fileType = $$dirInfo{Parent} || '';
7086    my $raf = $$dirInfo{RAF};
7087    my $base = $$dirInfo{Base} || 0;
7088    my $outfile = $$dirInfo{OutFile};
7089    my ($err, $sig, $canonSig, $otherSig);
7090
7091    # attempt to read TIFF header
7092    $$self{EXIF_DATA} = '';
7093    if ($raf) {
7094        if ($outfile) {
7095            $raf->Seek(0, 0) or return 0;
7096            if ($base) {
7097                $raf->Read($$dataPt, $base) == $base or return 0;
7098                Write($outfile, $$dataPt) or $err = 1;
7099            }
7100        } else {
7101            $raf->Seek($base, 0) or return 0;
7102        }
7103        # extract full EXIF block (for block copy) from EXIF file
7104        my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8;
7105        my $n = $raf->Read($$self{EXIF_DATA}, $amount);
7106        if ($n < 8) {
7107            return 0 if $n or not $outfile or $fileType ne 'EXIF';
7108            # create EXIF file from scratch
7109            delete $$self{EXIF_DATA};
7110            undef $raf;
7111        }
7112        if ($n > 8) {
7113            $raf->Seek(8, 0);
7114            if ($n == $amount) {
7115                $$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8);
7116                $self->Warn('EXIF too large to extract as a block'); #(shouldn't happen)
7117            }
7118        }
7119    } elsif ($dataPt and length $$dataPt) {
7120        # save a copy of the EXIF data
7121        my $dirStart = $$dirInfo{DirStart} || 0;
7122        my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
7123        $$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen);
7124        $self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2;
7125    } elsif ($outfile) {
7126        delete $$self{EXIF_DATA};  # create from scratch
7127    } else {
7128        $$self{EXIF_DATA} = '';
7129    }
7130    unless (defined $$self{EXIF_DATA}) {
7131        # set default byte order for creating new GPS in CR3 images
7132        my $defaultByteOrder;
7133        if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') {
7134            $defaultByteOrder = $$self{SaveExifByteOrder};
7135        }
7136        # create TIFF information from scratch
7137        if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') {
7138            $$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
7139        } else {
7140            $$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0";
7141        }
7142    }
7143    $$self{EXIF_POS} = $base + $$self{BASE};
7144    $$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS};
7145    $dataPt = \$$self{EXIF_DATA};
7146
7147    # set byte ordering
7148    my $byteOrder = substr($$dataPt,0,2);
7149    SetByteOrder($byteOrder) or return 0;
7150
7151    # verify the byte ordering
7152    my $identifier = Get16u($dataPt, 2);
7153    # identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF)
7154  # no longer do this because various files use different values
7155  # (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????)
7156  #  return 0 unless $identifier == 0x2a;
7157    $self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a;
7158
7159    # get offset to IFD0
7160    return 0 if length $$dataPt < 8;
7161    my $offset = Get32u($dataPt, 4);
7162    $offset >= 8 or return 0;
7163
7164    if ($raf) {
7165        # check for canon or EXIF signature
7166        # (Canon CR2 images should have an offset of 16, but it may be
7167        #  greater if edited by PhotoMechanic)
7168        if ($identifier == 0x2a and $offset >= 16) {
7169            $raf->Read($sig, 8) == 8 or return 0;
7170            $$dataPt .= $sig;
7171            if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) {
7172                if ($sig eq 'ExifMeta') {
7173                    $self->SetFileType($fileType = 'EXIF');
7174                    $otherSig = $sig;
7175                } else {
7176                    $fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW';
7177                    $canonSig = $sig;
7178                }
7179                $self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP};
7180            }
7181        } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) {
7182            # panasonic RAW, RW2 or RWL file
7183            my $magic;
7184            # test for RW2/RWL magic number
7185            if ($offset >= 0x18 and $raf->Read($magic, 16) and
7186                $magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a")
7187            {
7188                $fileType = 'RW2' unless $fileType eq 'RWL';
7189                $self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP};
7190                $otherSig = $magic; # save signature for writing
7191            } else {
7192                $fileType = 'RAW';
7193            }
7194            $tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main');
7195        } elsif ($fileType eq 'TIFF') {
7196            if ($identifier == 0x2b) {
7197                # this looks like a BigTIFF image
7198                $raf->Seek(0);
7199                require Image::ExifTool::BigTIFF;
7200                return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
7201            } elsif ($identifier == 0x4f52 or $identifier == 0x5352) {
7202                # Olympus ORF image (set FileType now because base type is 'ORF')
7203                $self->SetFileType($fileType = 'ORF');
7204            } elsif ($identifier == 0x4352) {
7205                $fileType = 'DCP';
7206            } elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) {
7207                $fileType = 'HDP';  # Windows HD Photo file
7208                # check version number
7209                my $ver = Get8u($dataPt, 3);
7210                if ($ver > 1) {
7211                    $self->Error("Windows HD Photo version $ver files not yet supported");
7212                    return 1;
7213                }
7214            }
7215        }
7216        # we have a valid TIFF (or whatever) file
7217        if ($fileType and not $$self{VALUE}{FileType}) {
7218            my $lookup = $fileTypeLookup{$fileType};
7219            $lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup;
7220            # use file extension to pre-determine type if extension is TIFF-based or type is RAW
7221            my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : '';
7222            my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef;
7223            $self->SetFileType($t);
7224        }
7225        # don't process file if FastScan == 3
7226        return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3;
7227    }
7228    # (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level)
7229    my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0';
7230    if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') {
7231        $self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile;
7232    } elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes)
7233        $ifdName = $$tagTablePtr{GROUPS}{0};
7234    } else {
7235        $ifdName = $$tagTablePtr{GROUPS}{1};
7236    }
7237    if ($$self{HTML_DUMP}) {
7238        my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x",
7239                          ($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset);
7240        $self->HDump($base, 8, 'TIFF header', $tip, 0);
7241    }
7242    # remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...)
7243    $$self{TIFF_TYPE} = $fileType;
7244
7245    # get reference to the main EXIF table
7246    $tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main');
7247
7248    # build directory information hash
7249    my %dirInfo = (
7250        Base     => $base,
7251        DataPt   => $dataPt,
7252        DataLen  => length $$dataPt,
7253        DataPos  => 0,
7254        DirStart => $offset,
7255        DirLen   => length($$dataPt) - $offset,
7256        RAF      => $raf,
7257        DirName  => $ifdName,
7258        Parent   => $fileType,
7259        ImageData=> 'Main', # set flag to get information to copy main image data later
7260        Multi    => $$dirInfo{Multi},
7261    );
7262
7263    # extract information from the image
7264    unless ($outfile) {
7265        # process the directory
7266        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
7267        # process GeoTiff information if available
7268        if ($$self{VALUE}{GeoTiffDirectory}) {
7269            require Image::ExifTool::GeoTiff;
7270            Image::ExifTool::GeoTiff::ProcessGeoTiff($self);
7271        }
7272        # process information in recognized trailers
7273        if ($raf) {
7274            my $trailInfo = IdentifyTrailer($raf);
7275            if ($trailInfo) {
7276                $$trailInfo{ScanForAFCP} = 1;   # scan to find AFCP if necessary
7277                $self->ProcessTrailers($trailInfo);
7278            }
7279            # dump any other known trailer (eg. A100 RAW Data)
7280            if ($$self{HTML_DUMP} and $$self{KnownTrailer}) {
7281                my $known = $$self{KnownTrailer};
7282                $raf->Seek(0, 2);
7283                my $len = $raf->Tell() - $$known{Start};
7284                $len -= $$trailInfo{Offset} if $trailInfo;  # account for other trailers
7285                $self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0;
7286           }
7287        }
7288        # update FileType if necessary now that we know more about the file
7289        if ($$self{DNGVersion} and $$self{VALUE}{FileType} !~ /^(DNG|GPR)$/) {
7290            # override whatever FileType we set since we now know it is DNG
7291            $self->OverrideFileType($$self{TIFF_TYPE} = 'DNG');
7292        }
7293        return 1;
7294    }
7295#
7296# rewrite the image
7297#
7298    if ($$dirInfo{NoTiffEnd}) {
7299        delete $$self{TIFF_END};
7300    } else {
7301        # initialize TIFF_END so it will be updated by WriteExif()
7302        $$self{TIFF_END} = 0;
7303    }
7304    if ($canonSig) {
7305        # write Canon CR2 specially because it has a header we want to preserve,
7306        # and possibly trailers added by the Canon utilities and/or PhotoMechanic
7307        $dirInfo{OutFile} = $outfile;
7308        require Image::ExifTool::CanonRaw;
7309        Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1;
7310    } else {
7311        # write TIFF header (8 bytes [plus optional signature] followed by IFD)
7312        if ($fileType eq 'EXIF') {
7313            $otherSig = 'ExifMeta'; # force this signature for all EXIF files
7314        } elsif (not defined $otherSig) {
7315            $otherSig = '';
7316        }
7317        my $offset = 8 + length($otherSig);
7318        # construct tiff header
7319        my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig;
7320        $dirInfo{NewDataPos} = $offset;
7321        $dirInfo{HeaderPtr} = \$header;
7322        # preserve padding between image data blocks in ORF images
7323        # (otherwise dcraw has problems because it assumes fixed block spacing)
7324        $dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a;
7325        my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr);
7326        if (not defined $newData) {
7327            $err = 1;
7328        } elsif (length($newData)) {
7329            # update header length in case more was added
7330            my $hdrLen = length $header;
7331            if ($hdrLen != 8) {
7332                Set32u($hdrLen, \$header, 4);
7333                # also update preview fixup if necessary
7334                my $pi = $$self{PREVIEW_INFO};
7335                $$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup};
7336            }
7337            if ($$self{TIFF_TYPE} eq 'ARW' and not $err) {
7338                # write any required ARW trailer and patch other ARW quirks
7339                require Image::ExifTool::Sony;
7340                my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData,
7341                                                              $dirInfo{ImageData});
7342                $errStr and $self->Error($errStr);
7343                delete $dirInfo{ImageData}; # (was copied by FinishARW)
7344            } else {
7345                Write($outfile, $header, $newData) or $err = 1;
7346            }
7347            undef $newData; # free memory
7348        }
7349        # copy over image data now if necessary
7350        if (ref $dirInfo{ImageData} and not $err) {
7351            $self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1;
7352            delete $dirInfo{ImageData};
7353        }
7354    }
7355    # make local copy of TIFF_END now (it may be reset when processing trailers)
7356    my $tiffEnd = $$self{TIFF_END};
7357    delete $$self{TIFF_END};
7358
7359    # rewrite trailers if they exist
7360    if ($raf and $tiffEnd and not $err) {
7361        my ($buf, $trailInfo);
7362        $raf->Seek(0, 2) or $err = 1;
7363        my $extra = $raf->Tell() - $tiffEnd;
7364        # check for trailer and process if possible
7365        for (;;) {
7366            last unless $extra > 12;
7367            $raf->Seek($tiffEnd);  # seek back to end of image
7368            $trailInfo = IdentifyTrailer($raf);
7369            last unless $trailInfo;
7370            my $tbuf = '';
7371            $$trailInfo{OutFile} = \$tbuf;  # rewrite trailer(s)
7372            $$trailInfo{ScanForAFCP} = 1;   # scan for AFCP if necessary
7373            # rewrite all trailers to buffer
7374            unless ($self->ProcessTrailers($trailInfo)) {
7375                undef $trailInfo;
7376                $err = 1;
7377                last;
7378            }
7379            # calculate unused bytes before trailer
7380            $extra = $$trailInfo{DataPos} - $tiffEnd;
7381            last; # yes, the 'for' loop was just a cheap 'goto'
7382        }
7383        # ignore a single zero byte if used for padding
7384        if ($extra > 0 and $tiffEnd & 0x01) {
7385            $raf->Seek($tiffEnd, 0) or $err = 1;
7386            $raf->Read($buf, 1) or $err = 1;
7387            defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd;
7388        }
7389        if ($extra > 0) {
7390            my $known = $$self{KnownTrailer};
7391            if ($$self{DEL_GROUP}{Trailer} and not $known) {
7392                $self->VPrint(0, "  Deleting unknown trailer ($extra bytes)\n");
7393                ++$$self{CHANGED};
7394            } elsif ($known) {
7395                $self->VPrint(0, "  Copying $$known{Name} ($extra bytes)\n");
7396                $raf->Seek($tiffEnd, 0) or $err = 1;
7397                CopyBlock($raf, $outfile, $extra) or $err = 1;
7398            } else {
7399                $raf->Seek($tiffEnd, 0) or $err = 1;
7400                # preserve unknown trailer only if it contains non-null data
7401                # (Photoshop CS adds a trailer with 2 null bytes)
7402                my $size = $extra;
7403                for (;;) {
7404                    my $n = $size > 65536 ? 65536 : $size;
7405                    $raf->Read($buf, $n) == $n or $err = 1, last;
7406                    if ($buf =~ /[^\0]/) {
7407                        $self->VPrint(0, "  Preserving unknown trailer ($extra bytes)\n");
7408                        # copy the trailer since it contains non-null data
7409                        Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra;
7410                        Write($outfile, $buf) or $err = 1, last;
7411                        CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n;
7412                        last;
7413                    }
7414                    $size -= $n;
7415                    next if $size > 0;
7416                    $self->VPrint(0, "  Deleting blank trailer ($extra bytes)\n");
7417                    last;
7418                }
7419            }
7420        }
7421        # write trailer buffer if necessary
7422        $self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo;
7423        # add any new trailers we are creating
7424        my $trailPt = $self->AddNewTrailers();
7425        Write($outfile, $$trailPt) or $err = 1 if $trailPt;
7426    }
7427    # check DNG version
7428    if ($$self{DNGVersion}) {
7429        my $ver = $$self{DNGVersion};
7430        # currently support up to DNG version 1.5
7431        unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.5) {
7432            $ver =~ tr/ /./;
7433            $self->Error("DNG Version $ver not yet tested", 1);
7434        }
7435    }
7436    return $err ? -1 : 1;
7437}
7438
7439#------------------------------------------------------------------------------
7440# Return list of tag table keys (ignoring special keys)
7441# Inputs: 0) reference to tag table
7442# Returns: List of table keys (unsorted)
7443sub TagTableKeys($)
7444{
7445    local $_;
7446    my $tagTablePtr = shift;
7447    my @keyList;
7448    foreach (keys %$tagTablePtr) {
7449        push(@keyList, $_) unless $specialTags{$_};
7450    }
7451    return @keyList;
7452}
7453
7454#------------------------------------------------------------------------------
7455# GetTagTable
7456# Inputs: 0) table name
7457# Returns: tag table reference, or undefined if not found
7458# Notes: Always use this function instead of requiring module and using table
7459# directly since this function also does the following the first time the table
7460# is loaded:
7461# - requires new module if necessary
7462# - generates default GROUPS hash and Group 0 name from module name
7463# - registers Composite tags if Composite table found
7464# - saves descriptions for tags in specified table
7465# - generates default TAG_PREFIX to be used for unknown tags
7466sub GetTagTable($)
7467{
7468    my $tableName = shift or return undef;
7469    my $table = $allTables{$tableName};
7470
7471    unless ($table) {
7472        no strict 'refs';
7473        unless (%$tableName) {
7474            # try to load module for this table
7475            if ($tableName =~ /(.*)::/) {
7476                my $module = $1;
7477                if (eval "require $module") {
7478                    # load additional modules if required
7479                    if (not %$tableName) {
7480                        if ($module eq 'Image::ExifTool::XMP') {
7481                            require 'Image/ExifTool/XMP2.pl';
7482                        } elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') {
7483                            require 'Image/ExifTool/QuickTimeStream.pl';
7484                        }
7485                    }
7486                } else {
7487                    $@ and warn $@;
7488                }
7489            }
7490            unless (%$tableName) {
7491                warn "Can't find table $tableName\n";
7492                return undef;
7493            }
7494        }
7495        no strict 'refs';
7496        $table = \%$tableName;
7497        use strict 'refs';
7498        &{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE};
7499        $$table{TABLE_NAME} = $tableName;   # set table name
7500        ($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://;
7501        # set default group 0 and 1 from module name unless already specified
7502        my $defaultGroups = $$table{GROUPS};
7503        $defaultGroups or $defaultGroups = $$table{GROUPS} = { };
7504        unless ($$defaultGroups{0} and $$defaultGroups{1}) {
7505            if ($tableName =~ /Image::.*?::([^:]*)/) {
7506                $$defaultGroups{0} = $1 unless $$defaultGroups{0};
7507                $$defaultGroups{1} = $1 unless $$defaultGroups{1};
7508            } else {
7509                $$defaultGroups{0} = $tableName unless $$defaultGroups{0};
7510                $$defaultGroups{1} = $tableName unless $$defaultGroups{1};
7511            }
7512        }
7513        $$defaultGroups{2} = 'Other' unless $$defaultGroups{2};
7514        if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) {
7515            # initialize some XMP table defaults
7516            require Image::ExifTool::XMP;
7517            Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces
7518            # set default write/check procs
7519            $$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC};
7520            $$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC};
7521            $$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO};
7522        }
7523        # generate a tag prefix for unknown tags if necessary
7524        unless (defined $$table{TAG_PREFIX}) {
7525            my $tagPrefix;
7526            if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) {
7527                ($tagPrefix = $1) =~ s/::/_/g;
7528            } else {
7529                $tagPrefix = $tableName;
7530            }
7531            $$table{TAG_PREFIX} = $tagPrefix;
7532        }
7533        # set up the new table
7534        SetupTagTable($table);
7535        # add any user-defined tags (except Composite tags, which are handled specially)
7536        if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) {
7537            my $tagID;
7538            foreach $tagID (TagTableKeys($UserDefined{$tableName})) {
7539                next if $specialTags{$tagID};
7540                delete $$table{$tagID}; # replace any existing entry
7541                AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1);
7542            }
7543        }
7544        # remember order we loaded the tables in
7545        push @tableOrder, $tableName;
7546        # insert newly loaded table into list
7547        $allTables{$tableName} = $table;
7548    }
7549    # must check each time to add UserDefined Composite tags because the Composite table
7550    # may be loaded before the UserDefined tags are available
7551    if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and
7552        %UserDefined and $UserDefined{$tableName})
7553    {
7554        my $userComp = $UserDefined{$tableName};
7555        delete $UserDefined{$tableName};        # (must delete first to avoid infinite recursion)
7556        AddCompositeTags($userComp, 1);
7557        $UserDefined{$tableName} = $userComp;   # (add back again for adding writable tags later)
7558        $$table{VARS}{LOADED_USERDEFINED} = 1;  # set flag to avoid doing this again
7559    }
7560    return $table;
7561}
7562
7563#------------------------------------------------------------------------------
7564# Process an image directory
7565# Inputs: 0) ExifTool object reference, 1) directory information reference
7566#         2) tag table reference, 3) optional reference to processing procedure
7567# Returns: Result from processing (1=success)
7568sub ProcessDirectory($$$;$)
7569{
7570    my ($self, $dirInfo, $tagTablePtr, $proc) = @_;
7571
7572    return 0 unless $tagTablePtr and $dirInfo;
7573    # use default proc from tag table or EXIF proc as fallback if no proc specified
7574    $proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif;
7575    # set directory name from default group0 name if not done already
7576    my $dirName = $$dirInfo{DirName};
7577    unless ($dirName) {
7578        $dirName = $$tagTablePtr{GROUPS}{0};
7579        $dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name)
7580        $$dirInfo{DirName} = $dirName;
7581    }
7582
7583    # guard against cyclical recursion into the same directory
7584    if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and
7585        # directories don't overlap if the length is zero
7586        ($$dirInfo{DirLen} or not defined $$dirInfo{DirLen}))
7587    {
7588        my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE};
7589        if ($$self{PROCESSED}{$addr}) {
7590            $self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory");
7591            # patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer
7592            return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD';
7593        }
7594        $$self{PROCESSED}{$addr} = $dirName;
7595    }
7596    my $oldOrder = GetByteOrder();
7597    my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'};
7598    $$self{LIST_TAGS} = { };    # don't build lists across different directories
7599    $$self{INDENT} .= '| ';
7600    $$self{DIR_NAME} = $dirName;
7601    push @{$$self{PATH}}, $dirName;
7602    $$self{FOUND_DIR}{$dirName} = 1;
7603
7604    # process the directory
7605    no strict 'refs';
7606    my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr);
7607    use strict 'refs';
7608
7609    pop @{$$self{PATH}};
7610    @$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save;
7611    SetByteOrder($oldOrder);
7612    return $rtnVal;
7613}
7614
7615#------------------------------------------------------------------------------
7616# Get Metadata path
7617# Inputs: 0) ExifTool object ref
7618# Return: Metadata path string
7619sub MetadataPath($)
7620{
7621    my $self = shift;
7622    return join '-', @{$$self{PATH}}
7623}
7624
7625#------------------------------------------------------------------------------
7626# Get standardized file extension
7627# Inputs: 0) file name
7628# Returns: standardized extension (all uppercase), or undefined if no extension
7629sub GetFileExtension($)
7630{
7631    my $filename = shift;
7632    my $fileExt;
7633    if ($filename and $filename =~ /^.*\.([^.]+)$/s) {
7634        $fileExt = uc($1);   # change extension to upper case
7635        # convert TIF extension to TIFF because we use the
7636        # extension for the file type tag of TIFF images
7637        $fileExt eq 'TIF' and $fileExt = 'TIFF';
7638    }
7639    return $fileExt;
7640}
7641
7642#------------------------------------------------------------------------------
7643# Get list of tag information hashes for given tag ID
7644# Inputs: 0) Tag table reference, 1) tag ID
7645# Returns: Array of tag information references
7646# Notes: Generates tagInfo hash if necessary
7647sub GetTagInfoList($$)
7648{
7649    my ($tagTablePtr, $tagID) = @_;
7650    my $tagInfo = $$tagTablePtr{$tagID};
7651
7652    if ($specialTags{$tagID}) {
7653        # (hopefully this won't happen)
7654        warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n";
7655    } elsif (ref $tagInfo eq 'HASH') {
7656        return ($tagInfo);
7657    } elsif (ref $tagInfo eq 'ARRAY') {
7658        return @$tagInfo;
7659    } elsif ($tagInfo) {
7660        # create hash with name
7661        $tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo };
7662        return ($tagInfo);
7663    }
7664    return ();
7665}
7666
7667#------------------------------------------------------------------------------
7668# Find tag information, processing conditional tags
7669# Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID
7670#         3) optional value reference, 4) optional format type, 5) optional value count
7671# Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed
7672# Notes: You should always call this routine to find a tag in a table because
7673# this routine will evaluate conditional tags.
7674# Arguments 3-5 are only required if the information type allows $valPt, $format and/or
7675# $count in a Condition, and if not given when needed this routine returns ''.
7676sub GetTagInfo($$$;$$$)
7677{
7678    my ($self, $tagTablePtr, $tagID) = @_;
7679    my ($valPt, $format, $count);
7680
7681    my @infoArray = GetTagInfoList($tagTablePtr, $tagID);
7682    # evaluate condition
7683    my $tagInfo;
7684    foreach $tagInfo (@infoArray) {
7685        my $condition = $$tagInfo{Condition};
7686        if ($condition) {
7687            ($valPt, $format, $count) = splice(@_, 3) if @_ > 3;
7688            return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt;
7689            # set old value for use in condition if needed
7690            local $SIG{'__WARN__'} = \&SetWarning;
7691            undef $evalWarning;
7692            #### eval Condition ($self, [$valPt, $format, $count])
7693            unless (eval $condition) {
7694                $@ and $evalWarning = $@;
7695                $self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning;
7696                next;
7697            }
7698        }
7699        if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and
7700            not $$self{OPTIONS}{Verbose} and not $$self{HTML_DUMP})
7701        {
7702            # don't return Unknown tags unless that option is set
7703            return undef;
7704        }
7705        # return the tag information we found
7706        return $tagInfo;
7707    }
7708    # generate information for unknown tags (numerical only) if required
7709    if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and
7710        $tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN})
7711    {
7712        my $printConv;
7713        if (defined $$tagTablePtr{PRINT_CONV}) {
7714            $printConv = $$tagTablePtr{PRINT_CONV};
7715        } else {
7716            # limit length of printout (can be very long)
7717            $printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val';
7718        }
7719        my $hex = sprintf("0x%.4x", $tagID);
7720        my $prefix = $$tagTablePtr{TAG_PREFIX};
7721        $tagInfo = {
7722            Name => "${prefix}_$hex",
7723            Description => MakeDescription($prefix, $hex),
7724            Unknown => 1,
7725            Writable => 0,  # can't write unknown tags
7726            PrintConv => $printConv,
7727        };
7728        # add tag information to table
7729        AddTagToTable($tagTablePtr, $tagID, $tagInfo);
7730    } else {
7731        undef $tagInfo;
7732    }
7733    return $tagInfo;
7734}
7735
7736#------------------------------------------------------------------------------
7737# Add new tag to table (must use this routine to add new tags to a table)
7738# Inputs: 0) reference to tag table, 1) tag ID
7739#         2) [optional] tag name or reference to tag information hash
7740#         3) [optional] flag to avoid adding prefix when generating tag name
7741# Returns: tagInfo ref
7742# Notes: - will not override existing entry in table
7743# - info need contain no entries when this routine is called
7744# - tag name is cleaned if necessary
7745sub AddTagToTable($$;$$)
7746{
7747    my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_;
7748
7749    # generate tag info hash if necessary
7750    $tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH';
7751
7752    # define necessary entries in information hash
7753    if ($$tagInfo{Groups}) {
7754        # fill in default groups from table GROUPS
7755        foreach (keys %{$$tagTablePtr{GROUPS}}) {
7756            next if $$tagInfo{Groups}{$_};
7757            $$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_};
7758        }
7759    } else {
7760        $$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} };
7761    }
7762    $$tagInfo{Flags} and ExpandFlags($tagInfo);
7763    $$tagInfo{GotGroups} = 1,
7764    $$tagInfo{Table} = $tagTablePtr;
7765    $$tagInfo{TagID} = $tagID;
7766    if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) {
7767        $$tagInfo{Avoid} = $$tagTablePtr{AVOID};
7768    }
7769
7770    my $name = $$tagInfo{Name};
7771    $name = $tagID unless defined $name;
7772    $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
7773    $name = ucfirst $name;          # capitalize first letter
7774    # add tag-name prefix if specified and tag name not provided
7775    unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) {
7776        # make description to prevent tagID from getting mangled by MakeDescription()
7777        $$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name);
7778        $name = "$$tagTablePtr{TAG_PREFIX}_$name";
7779    }
7780    # tag names must be at least 2 characters long and prefer them to start with a letter
7781    $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i;
7782    $$tagInfo{Name} = $name;
7783    # add tag to table, but never override existing entries (could potentially happen
7784    # if someone thinks there isn't any tagInfo because a condition wasn't satisfied)
7785    unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) {
7786        $$tagTablePtr{$tagID} = $tagInfo;
7787    }
7788    return $tagInfo;
7789}
7790
7791#------------------------------------------------------------------------------
7792# Handle simple extraction of new tag information
7793# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value,
7794#         4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent,
7795#              TagInfo, ProcessProc, RAF, Format, Count
7796# Returns: tag key or undef if tag not found
7797# Notes: if value is not defined, it is extracted from DataPt using TagInfo
7798#        Format and Count if provided
7799sub HandleTag($$$$;%)
7800{
7801    my ($self, $tagTablePtr, $tag, $val, %parms) = @_;
7802    my $verbose = $$self{OPTIONS}{Verbose};
7803    my $pfmt = $parms{Format};
7804    my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count});
7805    my $dataPt = $parms{DataPt};
7806    my ($subdir, $format, $noTagInfo, $rational);
7807
7808    if ($tagInfo) {
7809        $subdir = $$tagInfo{SubDirectory};
7810    } else {
7811        return undef unless $verbose;
7812        $tagInfo = { Name => "tag $tag" };  # create temporary tagInfo hash
7813        $noTagInfo = 1;
7814    }
7815    # read value if not done already (not necessary for subdir)
7816    unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) {
7817        my $start = $parms{Start} || 0;
7818        my $dLen = $dataPt ? length($$dataPt) : -1;
7819        my $size = $parms{Size};
7820        $size = $dLen unless defined $size;
7821        # read from data in memory if possible
7822        if ($start >= 0 and $start + $size <= $dLen) {
7823            $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT};
7824            $format = $pfmt if not $format and $pfmt and $formatSize{$pfmt};
7825            if ($format) {
7826                $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational);
7827            } else {
7828                $val = substr($$dataPt, $start, $size);
7829            }
7830        } else {
7831            $self->Warn("Error extracting value for $$tagInfo{Name}");
7832            return undef;
7833        }
7834    }
7835    # do verbose print if necessary
7836    if ($verbose) {
7837        undef $tagInfo if $noTagInfo;
7838        $parms{Value} = $val;
7839        $parms{Value} .= " ($rational)" if defined $rational;
7840        $parms{Table} = $tagTablePtr;
7841        if ($format) {
7842            my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1));
7843            $parms{Format} = $format . "[$count]";
7844        }
7845        $self->VerboseInfo($tag, $tagInfo, %parms);
7846    }
7847    if ($tagInfo) {
7848        if ($subdir) {
7849            my $subdirStart = $parms{Start};
7850            my $subdirLen = $parms{Size};
7851            if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) {
7852                my $conv = $$tagInfo{RawConv};
7853                local $SIG{'__WARN__'} = \&SetWarning;
7854                undef $evalWarning;
7855                if (ref $conv eq 'CODE') {
7856                    $val = &$conv($val, $self);
7857                } else {
7858                    my ($priority, @grps);
7859                    # NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm
7860                    #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps)
7861                    $val = eval $conv;
7862                    $@ and $evalWarning = $@;
7863                }
7864                $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning;
7865                return undef unless defined $val;
7866                $val = $$val if ref $val eq 'SCALAR';
7867                $dataPt = \$val;
7868                $subdirStart = 0;
7869                $subdirLen = length $val;
7870            }
7871            if ($$subdir{Start}) {
7872                my $valuePtr = 0;
7873                #### eval Start ($valuePtr)
7874                my $off = eval $$subdir{Start};
7875                $subdirStart += $off;
7876                $subdirLen -= $off;
7877            }
7878            $dataPt or $dataPt = \$val;
7879            # process subdirectory information
7880            my %dirInfo = (
7881                DirName  => $$subdir{DirName} || $$tagInfo{Name},
7882                DataPt   => $dataPt,
7883                DataLen  => length $$dataPt,
7884                DataPos  => $parms{DataPos},
7885                DirStart => $subdirStart,
7886                DirLen   => $subdirLen,
7887                Parent   => $parms{Parent},
7888                Base     => $parms{Base},
7889                Multi    => $$subdir{Multi},
7890                TagInfo  => $tagInfo,
7891                RAF      => $parms{RAF},
7892            );
7893            my $oldOrder = GetByteOrder();
7894            if ($$subdir{ByteOrder}) {
7895                if ($$subdir{ByteOrder} eq 'Unknown') {
7896                    if ($subdirStart + 2 <= $subdirLen) {
7897                        # attempt to determine the byte ordering of an IFD-style subdirectory
7898                        my $num = Get16u($dataPt, $subdirStart);
7899                        ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff);
7900                    }
7901                } else {
7902                    SetByteOrder($$subdir{ByteOrder});
7903                }
7904            }
7905            my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
7906            $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc});
7907            SetByteOrder($oldOrder);
7908            # return now unless directory is writable as a block
7909            return undef unless $$tagInfo{Writable};
7910        }
7911        my $key = $self->FoundTag($tagInfo, $val);
7912        # save original components of rational numbers
7913        $$self{RATIONAL}{$key} = $rational if defined $rational and defined $key;
7914        return $key;
7915    }
7916    return undef;
7917}
7918
7919#------------------------------------------------------------------------------
7920# Add tag to hash of extracted information
7921# Inputs: 0) ExifTool object reference
7922#         1) reference to tagInfo hash or tag name
7923#         2) data value (or reference to require hash if Composite)
7924#         3) optional family 0 group, 4) optional family 1 group
7925# Returns: tag key or undef if no value
7926sub FoundTag($$$;@)
7927{
7928    local $_;
7929    my ($self, $tagInfo, $value, @grps) = @_;
7930    my ($tag, $noListDel);
7931    my $options = $$self{OPTIONS};
7932
7933    if (ref $tagInfo eq 'HASH') {
7934        $tag = $$tagInfo{Name} or warn("No tag name\n"), return undef;
7935    } else {
7936        $tag = $tagInfo;
7937        # look for tag in Extra
7938        $tagInfo = $self->GetTagInfo(GetTagTable('Image::ExifTool::Extra'), $tag);
7939        # make temporary hash if tag doesn't exist in Extra
7940        # (not advised to do this since the tag won't show in list)
7941        $tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool };
7942        $$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
7943    }
7944    # get tag priority
7945    my $priority = $$tagInfo{Priority};
7946    unless (defined $priority) {
7947        $priority = $$tagInfo{Table}{PRIORITY};
7948        $priority = 0 if not defined $priority and $$tagInfo{Avoid};
7949    }
7950    $grps[0] or $grps[0] = $$self{SET_GROUP0};
7951    $grps[1] or $grps[1] = $$self{SET_GROUP1};
7952    my $valueHash = $$self{VALUE};
7953
7954    if ($$tagInfo{RawConv}) {
7955        # initialize @val for use in Composite RawConv expressions
7956        my @val;
7957        if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) {
7958            foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; }
7959        }
7960        my $conv = $$tagInfo{RawConv};
7961        local $SIG{'__WARN__'} = \&SetWarning;
7962        undef $evalWarning;
7963        if (ref $conv eq 'CODE') {
7964            $value = &$conv($value, $self);
7965            $$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps};
7966        } else {
7967            my $val = $value;   # do this so eval can use $val
7968            # NOTE: RawConv is also evaluated in Writer.pl
7969            #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps)
7970            $value = eval $conv;
7971            $@ and $evalWarning = $@;
7972        }
7973        $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning;
7974        return undef unless defined $value;
7975    }
7976    # handle duplicate tag names
7977    if (defined $$valueHash{$tag}) {
7978        # add to list if there is an active list for this tag
7979        if ($$self{LIST_TAGS}{$tagInfo}) {
7980            $tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag
7981            if (defined $$self{NO_LIST}) {
7982                # accumulate list in TAG_EXTRA "NoList" element
7983                if (defined $$self{TAG_EXTRA}{$tag}{NoList}) {
7984                    push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value;
7985                } else {
7986                    $$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ];
7987                }
7988                $noListDel = 1; # set flag to delete this tag if re-listed
7989            } else {
7990                if (ref $$valueHash{$tag} ne 'ARRAY') {
7991                    $$valueHash{$tag} = [ $$valueHash{$tag} ];
7992                }
7993                push @{$$valueHash{$tag}}, $value;
7994                return $tag;    # return without creating a new entry
7995            }
7996        }
7997        # get next available tag key
7998        my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1;
7999        my $nextTag = "$tag ($nextInd)";
8000#
8001# take tag with highest priority
8002#
8003        # promote existing 0-priority tag so it takes precedence over a new 0-tag
8004        # (unless old tag was a sub-document and new tag isn't.  Also, never override
8005        #  a Warning tag because they may be added by ValueConv, which could be confusing)
8006        my $oldPriority = $$self{PRIORITY}{$tag};
8007        unless ($oldPriority) {
8008            if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or
8009                                   not $$self{TAG_EXTRA}{$tag}{G3})
8010            {
8011                $oldPriority = 1;
8012            } else {
8013                $oldPriority = 0; # don't promote sub-document tag over main document
8014            }
8015        }
8016        # set priority for this tag
8017        if (defined $priority) {
8018            # increase 0-priority tags if this is the priority directory
8019            $priority = 1 if not $priority and $$self{DIR_NAME} and
8020                             $$self{DIR_NAME} eq $$self{PRIORITY_DIR};
8021        } elsif ($$self{LOW_PRIORITY_DIR}{'*'} or
8022            ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}}))
8023        {
8024            $priority = 0;  # default is 0 for a LOW_PRIORITY_DIR
8025        } else {
8026            $priority = 1;  # the normal default
8027        }
8028        if ($priority >= $oldPriority and (not $$self{DOC_NUM} or
8029            ($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and
8030             $$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel)
8031        {
8032            # move existing tag out of the way since this tag is higher priority
8033            # (NOTE: any new members added here must also be added to DeleteTag())
8034            $$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag};
8035            $$valueHash{$nextTag} = $$valueHash{$tag};
8036            $$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag};
8037            my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag};
8038            foreach ('TAG_EXTRA','RATIONAL') {
8039                if ($$self{$_}{$tag}) {
8040                    $$self{$_}{$nextTag} = $$self{$_}{$tag};
8041                    delete $$self{$_}{$tag};
8042                }
8043            }
8044            delete $$self{BOTH}{$tag};
8045            # update tag key for list if necessary
8046            $$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo};
8047            # update this key if used in a Composite tag
8048            if ($$self{COMP_KEYS}{$tag}) {
8049                $$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}};
8050                $$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag};
8051                delete $$self{COMP_KEYS}{$tag};
8052            }
8053        } else {
8054            $tag = $nextTag;        # don't override the existing tag
8055        }
8056        $$self{PRIORITY}{$tag} = $priority;
8057        $$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel;
8058    } elsif ($priority) {
8059        # set tag priority (only if exists and is non-zero)
8060        $$self{PRIORITY}{$tag} = $priority;
8061    }
8062
8063    # save the raw value, file order, tagInfo ref, group1 name,
8064    # and tag key for lists if necessary
8065    $$valueHash{$tag} = $value;
8066    $$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND};
8067    $$self{TAG_INFO}{$tag} = $tagInfo;
8068    # set dynamic groups 0, 1 and 3 if necessary
8069    $$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0];
8070    $$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1];
8071    if ($$self{DOC_NUM}) {
8072        $$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM};
8073        if ($$self{DOC_NUM} =~ /^(\d+)/) {
8074            # keep track of maximum 1st-level sub-document number
8075            $$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1;
8076        }
8077    }
8078    # save path if requested
8079    $$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath};
8080
8081    # remember this tagInfo if we will be accumulating values in a list
8082    # (but don't override earlier list if this may be deleted by NoListDel flag)
8083    if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) {
8084        $$self{LIST_TAGS}{$tagInfo} = $tag;
8085    }
8086
8087    # validate tag if requested (but only for simple values -- could result
8088    # in infinite recursion if called for a Composite tag (HASH ref value)
8089    # because FoundTag is called in the middle of building Composite tags
8090    if ($$options{Validate} and not ref $value) {
8091        Image::ExifTool::Validate::ValidateRaw($self, $tag, $value);
8092    }
8093
8094    return $tag;
8095}
8096
8097#------------------------------------------------------------------------------
8098# Make current directory the priority directory if not set already
8099# Inputs: 0) ExifTool object reference
8100sub SetPriorityDir($)
8101{
8102    my $self = shift;
8103    $$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR};
8104}
8105
8106#------------------------------------------------------------------------------
8107# Set family 0 or 1 group name specific to this tag instance
8108# Inputs: 0) ExifTool ref, 1) tag key, 2) group name, 3) family (default 1)
8109sub SetGroup($$$;$)
8110{
8111    my ($self, $tagKey, $extra, $fam) = @_;
8112    $$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra;
8113}
8114
8115#------------------------------------------------------------------------------
8116# Delete specified tag
8117# Inputs: 0) ExifTool object ref, 1) tag key
8118sub DeleteTag($$)
8119{
8120    my ($self, $tag) = @_;
8121    delete $$self{VALUE}{$tag};
8122    delete $$self{FILE_ORDER}{$tag};
8123    delete $$self{TAG_INFO}{$tag};
8124    delete $$self{TAG_EXTRA}{$tag};
8125    delete $$self{PRIORITY}{$tag};
8126    delete $$self{RATIONAL}{$tag};
8127    delete $$self{BOTH}{$tag};
8128}
8129
8130#------------------------------------------------------------------------------
8131# Escape all elements of a value
8132# Inputs: 0) value, 1) escape proc
8133sub DoEscape($$)
8134{
8135    my ($val, $key);
8136    if (not ref $_[0]) {
8137        $_[0] = &{$_[1]}($_[0]);
8138    } elsif (ref $_[0] eq 'ARRAY') {
8139        foreach $val (@{$_[0]}) {
8140            DoEscape($val, $_[1]);
8141        }
8142    } elsif (ref $_[0] eq 'HASH') {
8143        foreach $key (keys %{$_[0]}) {
8144            DoEscape($_[0]{$key}, $_[1]);
8145        }
8146    }
8147}
8148
8149#------------------------------------------------------------------------------
8150# Set the FileType and MIMEType tags
8151# Inputs: 0) ExifTool object reference
8152#         1) Optional file type (uses FILE_TYPE if not specified)
8153#         2) Optional MIME type (uses our lookup if not specified)
8154#         3) Optional recommended extension (converted to lower case; uses FileType if undef)
8155# Notes:  Will NOT set file type twice (subsequent calls ignored)
8156sub SetFileType($;$$$)
8157{
8158    my ($self, $fileType, $mimeType, $normExt) = @_;
8159    unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) {
8160        my $baseType = $$self{FILE_TYPE};
8161        my $ext = $$self{FILE_EXT};
8162        $fileType or $fileType = $baseType;
8163        # handle sub-types which are identified by extension
8164        if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) {
8165            my ($f,$e) = @fileTypeLookup{$fileType,$ext};
8166            if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) {
8167                # make sure $fileType was a root type and not another sub-type
8168                $fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]};
8169            }
8170        }
8171        $mimeType or $mimeType = $mimeType{$fileType};
8172        # use base file type if necessary (except if 'TIFF', which is a special case)
8173        $mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF';
8174        unless (defined $normExt) {
8175            $normExt = $fileTypeExt{$fileType};
8176            $normExt = $fileType unless defined $normExt;
8177        }
8178        $$self{FileType} = $fileType;
8179        $self->FoundTag('FileType', $fileType);
8180        $self->FoundTag('FileTypeExtension', uc $normExt);
8181        $self->FoundTag('MIMEType', $mimeType || 'application/unknown');
8182    }
8183}
8184
8185#------------------------------------------------------------------------------
8186# Override the FileType and MIMEType tags
8187# Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension
8188# Notes:  does nothing if FileType was not previously defined (ie. when writing)
8189sub OverrideFileType($$;$$)
8190{
8191    my ($self, $fileType, $mimeType, $normExt) = @_;
8192    if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) {
8193        $$self{FileType} = $fileType;
8194        $$self{VALUE}{FileType} = $fileType;
8195        unless (defined $normExt) {
8196            $normExt = $fileTypeExt{$fileType};
8197            $normExt = $fileType unless defined $normExt;
8198        }
8199        $$self{VALUE}{FileTypeExtension} = uc $normExt;
8200        $mimeType or $mimeType = $mimeType{$fileType};
8201        $$self{VALUE}{MIMEType} = $mimeType if $mimeType;
8202        if ($$self{OPTIONS}{Verbose}) {
8203            $self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n");
8204            $self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n");
8205            $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType;
8206        }
8207    }
8208}
8209
8210#------------------------------------------------------------------------------
8211# Modify the value of the MIMEType tag
8212# Inputs: 0) ExifTool object reference, 1) file or MIME type
8213# Notes: combines existing type with new type: ie) a/b + c/d => c/b-d
8214sub ModifyMimeType($;$)
8215{
8216    my ($self, $mime) = @_;
8217    $mime =~ m{/} or $mime = $mimeType{$mime} or return;
8218    my $old = $$self{VALUE}{MIMEType};
8219    if (defined $old) {
8220        my ($a, $b) = split '/', $old;
8221        my ($c, $d) = split '/', $mime;
8222        $d =~ s/^x-//;
8223        $$self{VALUE}{MIMEType} = "$c/$b-$d";
8224        $self->VPrint(0, "  Modified MIMEType = $c/$b-$d\n");
8225    } else {
8226        $self->FoundTag('MIMEType', $mime);
8227    }
8228}
8229
8230#------------------------------------------------------------------------------
8231# Print verbose output
8232# Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args
8233sub VPrint($$@)
8234{
8235    my $self = shift;
8236    my $level = shift;
8237    if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) {
8238        my $out = $$self{OPTIONS}{TextOut};
8239        print $out @_;
8240        print $out "\n" unless $_[-1] =~ /\n$/;
8241    }
8242}
8243
8244#------------------------------------------------------------------------------
8245# Print verbose directory information
8246# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref
8247#         2) number of entries in directory (or 0 if unknown)
8248#         3) optional size of directory in bytes
8249sub VerboseDir($$;$$)
8250{
8251    my ($self, $name, $entries, $size) = @_;
8252    return unless $$self{OPTIONS}{Verbose};
8253    if (ref $name eq 'HASH') {
8254        $size = $$name{DirLen} unless $size;
8255        $name = $$name{Name} || $$name{DirName};
8256    }
8257    my $indent = substr($$self{INDENT}, 0, -2);
8258    my $out = $$self{OPTIONS}{TextOut};
8259    my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : '';
8260    $str .= ", $size bytes" if $size;
8261    print $out "$indent+ [$name directory$str]\n";
8262}
8263
8264#------------------------------------------------------------------------------
8265# Verbose dump
8266# Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options
8267sub VerboseDump($$;%)
8268{
8269    my $self = shift;
8270    my $dataPt = shift;
8271    my $verbose = $$self{OPTIONS}{Verbose};
8272    if ($verbose and $verbose > 2) {
8273        my %parms = (
8274            Prefix => $$self{INDENT},
8275            Out    => $$self{OPTIONS}{TextOut},
8276            MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef,
8277        );
8278        HexDump($dataPt, undef, %parms, @_);
8279    }
8280}
8281
8282#------------------------------------------------------------------------------
8283# Print data in hex
8284# Inputs: 0) data
8285# Returns: hex string
8286# (this is a convenience function for use in debugging PrintConv statements)
8287sub PrintHex($)
8288{
8289    my $val = shift;
8290    return join(' ', unpack('H2' x length($val), $val));
8291}
8292
8293#------------------------------------------------------------------------------
8294# Extract binary data from file
8295# 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional
8296# Returns: binary data, or undef on error
8297# Notes: Returns "Binary data #### bytes" instead of data unless tag is
8298#        specifically requested or the Binary option is set
8299sub ExtractBinary($$$;$)
8300{
8301    my ($self, $offset, $length, $tag) = @_;
8302    my ($isPreview, $buff);
8303
8304    if ($tag) {
8305        if ($tag eq 'PreviewImage') {
8306            # save PreviewImage start/length in case we want to dump trailer
8307            $$self{PreviewImageStart} = $offset;
8308            $$self{PreviewImageLength} = $length;
8309            $isPreview = 1;
8310        }
8311        my $lcTag = lc $tag;
8312        if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and
8313             not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag})
8314        {
8315            return "Binary data $length bytes";
8316        }
8317    }
8318    unless ($$self{RAF}->Seek($offset,0)
8319        and $$self{RAF}->Read($buff, $length) == $length)
8320    {
8321        $tag or $tag = 'binary data';
8322        if ($isPreview and not $$self{BuildingComposite}) {
8323            $$self{PreviewError} = 1;
8324        } else {
8325            $self->Warn("Error reading $tag from file", $isPreview);
8326        }
8327        return undef;
8328    }
8329    return $buff;
8330}
8331
8332#------------------------------------------------------------------------------
8333# Process binary data
8334# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref
8335# Returns: 1 on success
8336# Notes: dirInfo may contain VarFormatData (reference to empty list) to return
8337#        details about any variable-length-format tags in the table (used when writing)
8338sub ProcessBinaryData($$$)
8339{
8340    my ($self, $dirInfo, $tagTablePtr) = @_;
8341    my $dataPt = $$dirInfo{DataPt};
8342    my $offset = $$dirInfo{DirStart} || 0;
8343    my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset);
8344    my $base = $$dirInfo{Base} || 0;
8345    my $verbose = $$self{OPTIONS}{Verbose};
8346    my $unknown = $$self{OPTIONS}{Unknown};
8347    my $dataPos = $$dirInfo{DataPos} || 0;
8348
8349    # get default format ('int8u' unless specified)
8350    my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u';
8351    my $increment = $formatSize{$defaultFormat};
8352    unless ($increment) {
8353        warn "Unknown format $defaultFormat\n";
8354        $defaultFormat = 'int8u';
8355        $increment = $formatSize{$defaultFormat};
8356    }
8357    # prepare list of tag numbers to extract
8358    my (@tags, $topIndex);
8359    if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) {
8360        # don't create a stupid number of tags if data is huge
8361        my $sizeLimit = $size < 65536 ? $size : 65536;
8362        # scan through entire binary table
8363        $topIndex = int($sizeLimit/$increment);
8364        @tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1));
8365        # add in floating point tag ID's if they exist
8366        my @ftags = grep /\./, TagTableKeys($tagTablePtr);
8367        @tags = sort { $a <=> $b } @tags, @ftags if @ftags;
8368    } elsif ($$dirInfo{DataMember}) {
8369        @tags = @{$$dirInfo{DataMember}};
8370        $verbose = 0;   # no verbose output of extracted values when writing
8371    } elsif ($$dirInfo{MixedTags}) {
8372        # process sorted integer-ID tags only
8373        @tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr);
8374    } else {
8375        # extract known tags in numerical order
8376        @tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr);
8377    }
8378    $self->VerboseDir('BinaryData', undef, $size) if $verbose;
8379    # avoid creating unknown tags for tags that fail condition if Unknown is 1
8380    $$self{NO_UNKNOWN} = 1 if $unknown < 2;
8381    my ($index, %val);
8382    my $nextIndex = 0;
8383    my $varSize = 0;
8384    foreach $index (@tags) {
8385        my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational);
8386        if ($$tagTablePtr{$index}) {
8387            $tagInfo = $self->GetTagInfo($tagTablePtr, $index);
8388            unless ($tagInfo) {
8389                next unless defined $tagInfo;
8390                my $entry = int($index) * $increment + $varSize;
8391                if ($entry < 0) {
8392                    $entry += $size;
8393                    next if $entry < 0;
8394                }
8395                next if $entry >= $size;
8396                my $more = $size - $entry;
8397                $more = 128 if $more > 128;
8398                my $v = substr($$dataPt, $entry+$offset, $more);
8399                $tagInfo = $self->GetTagInfo($tagTablePtr, $index, \$v);
8400                next unless $tagInfo;
8401            }
8402            next if $$tagInfo{Unknown} and
8403                   ($$tagInfo{Unknown} > $unknown or $index < $nextIndex);
8404        } elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) {
8405            $tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next;
8406        } else {
8407            # don't generate unknown tags in binary tables unless Unknown > 1
8408            next unless $unknown > 1;
8409            next if $index < $nextIndex;    # skip if data already used
8410            $tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next;
8411            $$tagInfo{Unknown} = 2;    # set unknown to 2 for binary unknowns
8412        }
8413        # get relative offset of this entry
8414        my $entry = int($index) * $increment + $varSize;
8415        # allow negative indices to represent bytes from end
8416        if ($entry < 0) {
8417            $entry += $size;
8418            next if $entry < 0;
8419        }
8420        my $more = $size - $entry;
8421        last if $more <= 0;     # all done if we have reached the end of data
8422        my $count = 1;
8423        my $format = $$tagInfo{Format};
8424        if (not $format) {
8425            $format = $defaultFormat;
8426        } elsif ($format eq 'string') {
8427            # string with no specified count runs to end of block
8428            $count = $more;
8429        } elsif ($format eq 'pstring') {
8430            $format = 'string';
8431            $count = Get8u($dataPt, ($entry++)+$offset);
8432            --$more;
8433        } elsif (not $formatSize{$format}) {
8434            if ($format =~ /(.*)\[(.*)\]/) {
8435                # handle format count field
8436                $format = $1;
8437                $count = $2;
8438                # evaluate count to allow count to be based on previous values
8439                #### eval Format size (%val, $size, $self)
8440                $count = eval $count;
8441                $@ and warn("Format $$tagInfo{Name}: $@"), next;
8442                next if $count < 0;
8443                # allow a variable-length value of any format
8444                # (note: the next incremental index points to data immediately after
8445                #  this value, regardless of the size of this value, even if it is zero)
8446                if ($format =~ s/^var_//) {
8447                    $varSize += $count * ($formatSize{$format} || 1) - $increment;
8448                    $wasVar = 1;
8449                    # save variable size data if required for writing
8450                    if ($$dirInfo{VarFormatData}) {
8451                        push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
8452                    }
8453                    # don't extract value if large and we wanted it just to get
8454                    # the variable-format information when writing
8455                    next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData};
8456                }
8457            } elsif ($format =~ /^var_/) {
8458                # handle variable-length string formats
8459                $format = substr($format, 4);
8460                pos($$dataPt) = $entry + $offset;
8461                undef $count;
8462                if ($format eq 'ustring') {
8463                    $count = pos($$dataPt) - ($entry+$offset) if $$dataPt =~ /\G(..)*?\0\0/sg;
8464                    $varSize -= 2;  # ($count includes base size of 2 bytes)
8465                } elsif ($format eq 'pstring') {
8466                    $count = Get8u($dataPt, ($entry++)+$offset);
8467                    --$more;
8468                } elsif ($format eq 'pstr32' or $format eq 'ustr32') {
8469                    last if $more < 4;
8470                    $count = Get32u($dataPt, $entry + $offset);
8471                    $count *= 2 if $format eq 'ustr32';
8472                    $entry += 4;
8473                    $more -= 4;
8474                    $nextIndex += 4 / $increment;   # (increment next index for int32u)
8475                } elsif ($format eq 'int16u') {
8476                    # int16u size of binary data to follow
8477                    last if $more < 2;
8478                    $count = Get16u($dataPt, $entry + $offset) + 2;
8479                    $varSize -= 2;  # ($count includes size word)
8480                    $format = 'undef';
8481                } elsif ($format eq 'ue7') {
8482                    require Image::ExifTool::BPG;
8483                    ($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $offset);
8484                    last unless defined $val;
8485                    --$varSize;     # ($count includes base size of 1 byte)
8486                } elsif ($$dataPt =~ /\0/g) {
8487                    $count = pos($$dataPt) - ($entry+$offset);
8488                    --$varSize;     # ($count includes base size of 1 byte)
8489                }
8490                $count = $more if not defined $count or $count > $more;
8491                $varSize += $count; # shift subsequent indices
8492                unless (defined $val) {
8493                    $val = substr($$dataPt, $entry+$offset, $count);
8494                    $val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32';
8495                    $val =~ s/\0.*//s unless $format eq 'undef';  # truncate at null
8496                }
8497                $wasVar = 1;
8498                # save variable size data if required for writing
8499                if ($$dirInfo{VarFormatData}) {
8500                    push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
8501                }
8502            }
8503        }
8504        # hook to allow format, etc to be set dynamically
8505        if (defined $$tagInfo{Hook}) {
8506            my $oldVarSize = $varSize;
8507            my $pos = $entry + $offset;
8508            #### eval Hook ($format, $varSize, $size, $dataPt, $pos)
8509            eval $$tagInfo{Hook};
8510            # save variable size data if required for writing (in case changed by Hook)
8511            if ($$dirInfo{VarFormatData}) {
8512                $#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag
8513                push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
8514            } elsif ($varSize != $oldVarSize and $verbose > 2) {
8515                my ($tmp, $sign) = ($varSize, '+');
8516                $tmp < 0 and $tmp = -$tmp, $sign = '-';
8517                $self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index));
8518            }
8519        }
8520        if ($unknown > 1) {
8521            # calculate next valid index for unknown tag
8522            my $ni = int $index;
8523            $ni += (($formatSize{$format} || 1) * $count) / $increment unless $wasVar;
8524            $saveNextIndex = $nextIndex;
8525            $nextIndex = $ni unless $nextIndex > $ni;
8526        }
8527        # allow large tags to be excluded from extraction
8528        # (provides a work-around for some tight memory situations)
8529        next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}};
8530        # read value now if necessary
8531        unless (defined $val and not $$tagInfo{SubDirectory}) {
8532            $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational);
8533            $mask = $$tagInfo{Mask};
8534            $val = ($val & $mask) >> $$tagInfo{BitShift} if $mask;
8535        }
8536        if ($verbose and not $$tagInfo{Hidden}) {
8537            if (not $$tagInfo{SubDirectory} or $$tagInfo{Format}) {
8538                $len = $count * ($formatSize{$format} || 1);
8539                $len = $more if $len > $more;
8540            } else {
8541                $len = $more;
8542            }
8543            $self->VerboseInfo($index, $tagInfo,
8544                Table  => $tagTablePtr,
8545                Value  => $val,
8546                DataPt => $dataPt,
8547                Size   => $len,
8548                Start  => $entry+$offset,
8549                Addr   => $entry+$offset+$base+$dataPos,
8550                Format => $format,
8551                Count  => $count,
8552                Extra  => $mask ? sprintf(', mask 0x%.2x',$mask) : undef,
8553            );
8554        }
8555        # parse nested BinaryData directories
8556        if ($$tagInfo{SubDirectory}) {
8557            my $subdir = $$tagInfo{SubDirectory};
8558            my $subTablePtr = GetTagTable($$subdir{TagTable});
8559            # use specified subdirectory length if given
8560            if ($$tagInfo{Format} and $formatSize{$format}) {
8561                $len = $count * $formatSize{$format};
8562                $len = $more if $len > $more;
8563            } else {
8564                $len = $more;   # directory size is all of remaining data
8565                if ($$subTablePtr{PROCESS_PROC} and
8566                    $$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData)
8567                {
8568                    # the rest of the data will be printed in the subdirectory
8569                    $nextIndex = $size / $increment;
8570                }
8571            }
8572            my $subdirBase = $base;
8573            if (defined $$subdir{Base}) {
8574                #### eval Base ($start,$base)
8575                my $start = $entry + $offset + $dataPos;
8576                $subdirBase = eval($$subdir{Base}) + $base;
8577            }
8578            my $start = $$subdir{Start} || 0;
8579            my %subdirInfo = (
8580                DataPt   => $dataPt,
8581                DataPos  => $dataPos,
8582                DataLen  => length $$dataPt,
8583                DirStart => $entry + $offset + $start,
8584                DirLen   => $len - $start,
8585                Base     => $subdirBase,
8586            );
8587            delete $$self{NO_UNKNOWN};
8588            $self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc});
8589            $$self{NO_UNKNOWN} = 1 if $unknown < 2;
8590            next;
8591        }
8592        if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') {
8593            my $et = $self;
8594            #### eval IsOffset ($val, $et)
8595            $val += $base + $$self{BASE} if eval $$tagInfo{IsOffset};
8596        }
8597        $val{$index} = $val;
8598        my $oldBase;
8599        if ($$tagInfo{SetBase}) {
8600            $oldBase = $$self{BASE};
8601            $$self{BASE} += $base;
8602        }
8603        my $key = $self->FoundTag($tagInfo,$val);
8604        $$self{BASE} = $oldBase if defined $oldBase;
8605        if ($key) {
8606            $$self{RATIONAL}{$key} = $rational if defined $rational;
8607        } else {
8608            # don't increment nextIndex if we didn't extract a tag
8609            $nextIndex = $saveNextIndex if defined $saveNextIndex;
8610        }
8611    }
8612    delete $$self{NO_UNKNOWN};
8613    return 1;
8614}
8615
8616#..............................................................................
8617# Load .ExifTool_config file from user's home directory
8618# (use of noConfig is now deprecated, use configFile = '' instead)
8619until ($Image::ExifTool::noConfig) {
8620    my $config = $Image::ExifTool::configFile;
8621    my $file;
8622    if (not defined $config) {
8623        $config = '.ExifTool_config';
8624        # get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell)
8625        my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} ||
8626                   ($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.';
8627        # look for the config file in 1) the home directory, 2) the program dir
8628        $file = "$home/$config";
8629    } else {
8630        length $config or last; # filename of "" disables configuration
8631        $file = $config;
8632    }
8633    # also check executable directory unless path is absolute
8634    $exePath = $0 unless defined $exePath; # (undocumented $exePath setting)
8635    -r $file or $config =~ /^\// or $file = ($exePath =~ /(.*[\\\/])/ ? $1 : './') . $config;
8636    unless (-r $file) {
8637        warn("Config file not found\n") if defined $Image::ExifTool::configFile;
8638        last;
8639    }
8640    unshift @INC, '.';      # look in current directory first
8641    eval { require $file }; # load the config file
8642    shift @INC;
8643    # print warning (minus "Compilation failed" part)
8644    $@ and $_=$@, s/Compilation failed.*//s, warn $_;
8645    last;
8646}
8647# read user-defined lenses (may have been defined by script instead of config file)
8648if (@Image::ExifTool::UserDefined::Lenses) {
8649    foreach (@Image::ExifTool::UserDefined::Lenses) {
8650        $Image::ExifTool::userLens{$_} = 1;
8651    }
8652}
8653# add user-defined file types
8654if (%Image::ExifTool::UserDefined::FileTypes) {
8655    foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) {
8656        my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_};
8657        my $type = uc $_;
8658        ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next;
8659        my $baseType = $$fileInfo{BaseType};
8660        if ($baseType) {
8661            if ($$fileInfo{Description}) {
8662                $fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ];
8663            } else {
8664                $fileTypeLookup{$type} = $baseType;
8665            }
8666            if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) {
8667                # first make sure we are using an actual base type and not a derived type
8668                $baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType};
8669                # mark this type as not writable
8670                $noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ];
8671                push @{$noWriteFile{$baseType}}, $type;
8672            }
8673        } else {
8674            $fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ];
8675            $moduleName{$type} = 0; # not supported
8676            if ($$fileInfo{Magic}) {
8677                $magicNumber{$type} = $$fileInfo{Magic};
8678                push @fileTypes, $type unless grep /^$type$/, @fileTypes;
8679            }
8680        }
8681        $mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType};
8682    }
8683}
8684
8685#------------------------------------------------------------------------------
86861;  # end
8687