Ignore:
Timestamp:
2021-02-26T19:39:51+13:00 (3 years ago)
Author:
anupama
Message:

Committing the improvements to EmbeddedMetaPlugin's processing of Keywords vs other metadata fields. Keywords were literally stored as arrays of words rather than phrases in PDFs (at least in Diego's sample PDF), whereas other meta fields like Subjects and Creators stored them as arrays of phrases. To get both to work, Kathy updated EXIF to a newer version, to retrieve the actual EXIF values stored in the PDF. And Kathy and Dr Bainbridge came up with a new option that I added called apply_join_before_split_to_metafields that's a regex which can list the metadata fields to apply the join_before_split to and whcih previously always got applied to all metadata fields. Now it's applied to any *Keywords metafields by default, as that's the metafield we have experience of that behaves differently to the others, as it stores by word instead of phrases. Tested on Diego's sample PDF. Diego has double-checked it to works on his sample PDF too, setting the split char to ; and turning on the join_before_split and leaving apply_join_before_split_to_metafields at its default of .*Keywords. File changes are strings.properties for the tooltip, the plugin introducing the option and working with it and Kathy's EXIF updates affecting cpan/File and cpan/Image.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • main/trunk/greenstone2/perllib/cpan/Image/ExifTool.pm

    r24107 r34921  
    44# Description:  Read and write meta information
    55#
    6 # URL:          http://owl.phy.queensu.ca/~phil/exiftool/
     6# URL:          https://exiftool.org/
    77#
    88# Revisions:    Nov. 12/2003 - P. Harvey Created
    99#               (See html/history.html for revision history)
    1010#
    11 # Legal:        Copyright (c) 2003-2010, Phil Harvey (phil at owl.phy.queensu.ca)
     11# Legal:        Copyright (c) 2003-2021, Phil Harvey (philharvey66 at gmail.com)
    1212#               This library is free software; you can redistribute it and/or
    1313#               modify it under the same terms as Perl itself.
     
    2020require Exporter;
    2121use File::RandomAccess;
    22 
    23 use vars qw($VERSION $RELEASE @ISA %EXPORT_TAGS $AUTOLOAD @fileTypes %allTables
    24             @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr $psAPP13hdr
    25             $psAPP13old @loadAllTables %UserDefined $evalWarning %noWriteFile
    26             %magicNumber @langs $defaultLang %langName %charsetName %mimeType
    27             $swapBytes $swapWords $currentByteOrder %unpackStd);
    28 
    29 $VERSION = '8.57';
     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.19';
    3032$RELEASE = '';
    3133@ISA = qw(Exporter);
     
    3537        ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags
    3638        GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate
     39        AddUserDefinedTags
    3740    )],
    3841    # exports not part of the public API, but used by ExifTool modules:
     
    4043        ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u
    4144        Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write
    42         WriteValue Tell Set8u Set8s Set16u Set32u
     45        WriteValue Tell Set8u Set8s Set16u Set32u Set64u
    4346    )],
    44     Utils => [qw(GetTagTable TagTableKeys GetTagInfoList)],
     47    Utils => [qw(GetTagTable TagTableKeys GetTagInfoList AddTagToTable HexDump)],
    4548    Vars  => [qw(%allTables @tableOrder @fileTypes)],
    4649);
     50
    4751# set all of our EXPORT_TAGS in EXPORT_OK
    4852Exporter::export_ok_tags(keys %EXPORT_TAGS);
     
    5155{ my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; }
    5256
    53 # The following functions defined in Image::ExifTool::Writer are declared
     57# The following functions defined in Image::ExifTool::Writer.pl are declared
    5458# here so their prototypes will be available.  These Writer routines will be
    5559# autoloaded when any of them is called.
    5660sub SetNewValue($;$$%);
    5761sub SetNewValuesFromFile($$;@);
    58 sub GetNewValues($;$$);
     62sub GetNewValue($$;$);
     63sub GetNewValues($$;$);
    5964sub CountNewValues($);
    6065sub SaveNewValues($);
    6166sub RestoreNewValues($);
    6267sub WriteInfo($$;$$);
    63 sub SetFileModifyDate($$;$);
    64 sub SetFileName($$;$);
     68sub SetFileModifyDate($$;$$$);
     69sub SetFileName($$;$$$);
     70sub SetSystemTags($$);
    6571sub GetAllTags(;$);
    6672sub GetWritableTags(;$);
    67 sub GetAllGroups($);
     73sub GetAllGroups($;$);
    6874sub GetNewGroups($);
    6975sub GetDeleteGroups();
     76sub AddUserDefinedTags($%);
    7077# non-public routines below
    71 sub InsertTagValues($$$;$);
     78sub InsertTagValues($$$;$$$);
    7279sub IsWritable($);
     80sub IsSameFile($$$);
     81sub IsRawType($);
    7382sub GetNewFileName($$);
    74 sub NextTagKey($$);
    7583sub LoadAllTables();
    7684sub GetNewTagInfoList($;$);
     
    7987sub Get64s($$);
    8088sub Get64u($$);
     89sub GetFixed64s($$);
    8190sub GetExtended($$);
     91sub Set64u(@);
    8292sub DecodeBits($$;$);
    8393sub EncodeBits($$;$$);
     94sub Filter($$$);
    8495sub HexDump($;$%);
    8596sub DumpTrailer($$);
    8697sub DumpUnknownTrailer($$);
    8798sub VerboseInfo($$$%);
    88 sub VerboseDir($$;$$);
    8999sub VerboseValue($$$;$);
    90100sub VPrint($$@);
     
    101111sub PackUTF8(@);
    102112sub UnpackUTF8($);
    103 sub SetPreferredByteOrder($);
     113sub SetPreferredByteOrder($;$);
    104114sub CopyBlock($$$);
    105 sub CopyFileAttrs($$);
     115sub CopyFileAttrs($$$);
     116sub TimeNow(;$$);
     117sub NewGUID();
     118sub MakeTiffHeader($$$$;$$);
    106119
    107120# other subroutine definitions
     121sub SplitFileName($);
     122sub EncodeFileName($$;$);
     123sub Open($*$;$);
     124sub Exists($$);
     125sub IsDirectory($$);
     126sub Rename($$$);
     127sub Unlink($@);
     128sub SetFileTime($$;$$$$);
    108129sub DoEscape($$);
    109130sub ConvertFileSize($);
    110131sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem)
     132sub ReadValue($$$;$$$);
    111133
    112134# list of main tag tables to load in LoadAllTables() (sub-tables are recursed
     
    114136# unless tweaked in BuildTagLookup::GetTableOrder().
    115137@loadAllTables = qw(
    116     PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw MinoltaRaw PanasonicRaw
    117     SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 PICT PNG MNG DjVu PGF MIFF PSP
    118     PDF PostScript Photoshop::Header FujiFilm::RAF Sony::SRF2 Sony::SR2SubIFD
    119     Sony::PMP ITC ID3 Vorbis FLAC APE APE::NewHeader APE::OldHeader MPC
    120     MPEG::Audio MPEG::Video MPEG::Xing M2TS QuickTime QuickTime::ImageFile
    121     Matroska MXF DV Flash Flash::FLV Real::Media Real::Audio Real::Metafile RIFF
    122     AIFF ASF DICOM MIE HTML XMP::SVG EXE EXE::PEVersion EXE::PEString EXE::MachO
    123     EXE::PEF EXE::ELF LNK Font RSRC Rawzor ZIP ZIP::GZIP ZIP::RAR RTF OOXML
    124     iWork
     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
    125152);
    126153
    127154# alphabetical list of current Lang modules
    128 @langs = qw(cs de en en_ca en_gb es fr it ja ko nl pl ru sv tr zh_cn zh_tw);
     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);
    129156
    130157$defaultLang = 'en';    # default language
     
    138165    en_gb => 'British English',
    139166    es => 'Spanish (Español)',
     167    fi => 'Finnish (Suomi)',
    140168    fr => 'French (Français)',
    141169    it => 'Italian (Italiano)',
     
    154182# Notes: 1) There is no need to test for like types separately here
    155183# 2) Put types with weak file signatures at end of list to avoid false matches
    156 @fileTypes = qw(JPEG CRW TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF PSD XMP
    157                 BMP PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG FLAC APE MPC
    158                 MKV MXF DV PMP IND PGF ICC ITC HTML VRD RTF XCF QTIF FPX PICT
    159                 ZIP GZIP RAR BZ2 TAR RWZ EXE LNK RAW Font RSRC M2TS MP3 DICM);
     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);
    160193
    161194# file types that we can write (edit)
    162 my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM
    163                     EPS X3F PS PDF ICC VRD JP2 EXIF AI AIT IND);
     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)
    164198
    165199# file extensions that we can't write for various base types
    166200%noWriteFile = (
    167201    TIFF => [ qw(3FR DCR K25 KDC SRF) ],
    168     XMP  => [ 'SVG' ],
     202    XMP  => [ qw(SVG INX) ],
     203    JP2  => [ qw(J2C JPC) ],
     204    MOV  => [ qw(INSV) ],
    169205);
    170206
    171207# file types that we can create from scratch
    172208# - must update CanCreate() documentation if this list is changed!
    173 my %createTypes = (XMP=>1, ICC=>1, MIE=>1, VRD=>1, EXIF=>1);
    174 
    175 # file type lookup for all recognized file extensions
    176 my %fileTypeLookup = (
     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'],
    177216   '3FR' => ['TIFF', 'Hasselblad RAW format'],
    178217   '3G2' => ['MOV',  '3rd Gen. Partnership Project 2 audio/video'],
     
    180219   '3GP2'=>  '3G2',
    181220   '3GPP'=>  '3GP',
    182     ACR  => ['DICM', 'American College of Radiology ACR-NEMA'],
     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'],
    183226    ACFM => ['Font', 'Adobe Composite Font Metrics'],
    184227    AFM  => ['Font', 'Adobe Font Metrics'],
     
    189232    AIFF => ['AIFF', 'Audio Interchange File Format'],
    190233    AIT  =>  'AI',
     234    ALIAS=> ['ALIAS','MacOS file alias'],
    191235    APE  => ['APE',  "Monkey's Audio format"],
     236    APNG => ['PNG',  'Animated Portable Network Graphics'],
    192237    ARW  => ['TIFF', 'Sony Alpha RAW format'],
     238    ARQ  => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'],
    193239    ASF  => ['ASF',  'Microsoft Advanced Systems Format'],
     240    AVC  => ['AVC',  'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID)
    194241    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',
    195245    BMP  => ['BMP',  'Windows Bitmap'],
     246    BPG  => ['BPG',  'Better Portable Graphics'],
    196247    BTF  => ['BTF',  'Big Tagged Image File Format'], #(unofficial)
    197248    BZ2  => ['BZ2',  'BZIP2 archive'],
     249    CHM  => ['CHM',  'Microsoft Compiled HTML format'],
    198250    CIFF => ['CRW',  'Camera Image File Format'],
    199251    COS  => ['COS',  'Capture One Settings'],
    200252    CR2  => ['TIFF', 'Canon RAW 2 format'],
     253    CR3  => ['MOV',  'Canon RAW 3 format'],
     254    CRM  => ['MOV',  'Canon RAW Movie'],
    201255    CRW  => ['CRW',  'Canon RAW format'],
    202256    CS1  => ['PSD',  'Sinar CaptureShop 1-Shot RAW'],
     257    CSV  => ['TXT',  'Comma-Separated Values'],
     258    CZI  => ['CZI',  'Zeiss Integrated Software RAW'],
    203259    DC3  =>  'DICM',
    204260    DCM  =>  'DICM',
    205261    DCP  => ['TIFF', 'DNG Camera Profile'],
    206262    DCR  => ['TIFF', 'Kodak Digital Camera RAW'],
     263    DCX  => ['DCX',  'Multi-page PC Paintbrush'],
     264    DEX  => ['DEX',  'Dalvik Executable format'],
    207265    DFONT=> ['Font', 'Macintosh Data fork Font'],
    208266    DIB  => ['BMP',  'Device Independent Bitmap'],
    209267    DIC  =>  'DICM',
    210     DICM => ['DICM', 'Digital Imaging and Communications in Medicine'],
     268    DICM => ['DICOM','Digital Imaging and Communications in Medicine'],
     269    DIR  => ['DIR',  'Directory'],
    211270    DIVX => ['ASF',  'DivX media format'],
    212271    DJV  =>  'DJVU',
     
    223282    DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'],
    224283    DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'],
     284    DPX  => ['DPX',  'Digital Picture Exchange' ],
     285    DR4  => ['DR4',  'Canon VRD version 4 Recipe'],
     286    DS2  => ['DSS',  'Digital Speech Standard 2'],
     287    DSS  => ['DSS',  'Digital Speech Standard'],
    225288    DV   => ['DV',   'Digital Video'],
    226289    DVB  => ['MOV',  'Digital Video Broadcasting'],
     290   'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'],
     291    DWF  => ['DWF',  'Autodesk drawing (Design Web Format)'],
     292    DWG  => ['DWG',  'AutoCAD Drawing'],
    227293    DYLIB=> ['EXE',  'Mach-O Dynamic Link Library'],
    228294    EIP  => ['ZIP',  'Capture One Enhanced Image Package'],
     
    231297    EPS3 =>  'EPS',
    232298    EPSF =>  'EPS',
     299    EPUB => ['ZIP',  'Electronic Publication'],
    233300    ERF  => ['TIFF', 'Epson Raw Format'],
    234301    EXE  => ['EXE',  'Windows executable file'],
     302    EXR  => ['EXR', 'Open EXR'],
    235303    EXIF => ['EXIF', 'Exchangable Image File Metadata'],
     304    EXV  => ['EXV',  'Exiv2 metadata'],
    236305    F4A  => ['MOV',  'Adobe Flash Player 9+ Audio'],
    237306    F4B  => ['MOV',  'Adobe Flash Player 9+ audio Book'],
    238307    F4P  => ['MOV',  'Adobe Flash Player 9+ Protected'],
    239308    F4V  => ['MOV',  'Adobe Flash Player 9+ Video'],
     309    FFF  => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'],
     310    FIT  =>  'FITS',
     311    FITS => ['FITS', 'Flexible Image Transport System'],
    240312    FLAC => ['FLAC', 'Free Lossless Audio Codec'],
    241313    FLA  => ['FPX',  'Macromedia/Adobe Flash project'],
     314    FLIF => ['FLIF', 'Free Lossless Image Format'],
     315    FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension)
    242316    FLV  => ['FLV',  'Flash Video'],
     317    FPF  => ['FPF',  'FLIR Public image Format'],
    243318    FPX  => ['FPX',  'FlashPix'],
    244319    GIF  => ['GIF',  'Compuserve Graphics Interchange Format'],
     320    GPR  => ['TIFF', 'GoPro RAW'],
    245321    GZ   =>  'GZIP',
    246322    GZIP => ['GZIP', 'GNU ZIP compressed archive'],
    247323    HDP  => ['TIFF', 'Windows HD Photo'],
     324    HDR  => ['HDR',  'Radiance RGBE High Dynamic Range'],
     325    HEIC => ['MOV',  'High Efficiency Image Format still image'],
     326    HEIF => ['MOV',  'High Efficiency Image Format'],
     327    HIF  =>  'HEIF',
    248328    HTM  =>  'HTML',
    249329    HTML => ['HTML', 'HyperText Markup Language'],
     330    ICAL =>  'ICS',
    250331    ICC  => ['ICC',  'International Color Consortium'],
    251332    ICM  =>  'ICC',
     333    ICS  => ['VCard','iCalendar Schedule'],
     334    IDML => ['ZIP',  'Adobe InDesign Markup Language'],
    252335    IIQ  => ['TIFF', 'Phase One Intelligent Image Quality RAW'],
    253336    IND  => ['IND',  'Adobe InDesign'],
    254337    INDD => ['IND',  'Adobe InDesign Document'],
    255338    INDT => ['IND',  'Adobe InDesign Template'],
     339    INSV => ['MOV',  'Insta360 Video'],
     340    INSP => ['JPEG', 'Insta360 Picture'],
     341    INX  => ['XMP',  'Adobe InDesign Interchange'],
     342    ISO  => ['ISO',  'ISO 9660 disk image'],
    256343    ITC  => ['ITC',  'iTunes Cover Flow'],
     344    J2C  => ['JP2',  'JPEG 2000 codestream'],
     345    J2K  =>  'J2C',
    257346    JNG  => ['PNG',  'JPG Network Graphics'],
    258347    JP2  => ['JP2',  'JPEG 2000 file'],
    259348    # JP4? - looks like a JPEG but the image data is different
    260     JPEG =>  'JPG',
    261     JPG  => ['JPEG', 'Joint Photographic Experts Group'],
     349    JPC  =>  'J2C',
     350    JPE  =>  'JPEG',
     351    JPEG => ['JPEG', 'Joint Photographic Experts Group'],
     352    JPF  =>  'JP2',
     353    JPG =>   'JPEG',
    262354    JPM  => ['JP2',  'JPEG 2000 compound image'],
    263355    JPX  => ['JP2',  'JPEG 2000 with extensions'],
     356    JSON => ['JSON', 'JavaScript Object Notation'],
     357    JXR  => ['TIFF', 'JPEG XR'],
    264358    K25  => ['TIFF', 'Kodak DC25 RAW'],
    265359    KDC  => ['TIFF', 'Kodak Digital Camera RAW'],
    266360    KEY  => ['ZIP',  'Apple Keynote presentation'],
    267361    KTH  => ['ZIP',  'Apple Keynote Theme'],
     362    LA   => ['RIFF', 'Lossless Audio'],
     363    LFP  => ['LFP',  'Lytro Light Field Picture'],
     364    LFR  =>  'LFP', # (Light Field RAW)
    268365    LNK  => ['LNK',  'Windows shortcut'],
     366    LRI  => ['LRI',  'Light RAW'],
     367    LRV  => ['MOV',  'Low-Resolution Video'],
    269368    M2T  =>  'M2TS',
    270369    M2TS => ['M2TS', 'MPEG-2 Transport Stream'],
     
    274373    M4P  => ['MOV',  'MPEG-4 Protected'],
    275374    M4V  => ['MOV',  'MPEG-4 Video'],
     375    MAX  => ['FPX',  '3D Studio MAX'],
    276376    MEF  => ['TIFF', 'Mamiya (RAW) Electronic Format'],
    277377    MIE  => ['MIE',  'Meta Information Encapsulation format'],
     
    282382    MKV  => ['MKV',  'Matroska Video'],
    283383    MNG  => ['PNG',  'Multiple-image Network Graphics'],
    284   # MODD => ['PLIST','Sony Picture Motion Metadata'],
     384    MOBI => ['PDB',  'Mobipocket electronic book'],
     385    MODD => ['PLIST','Sony Picture Motion metadata'],
     386    MOI  => ['MOI',  'MOD Information file'],
    285387    MOS  => ['TIFF', 'Creo Leaf Mosaic'],
    286388    MOV  => ['MOV',  'Apple QuickTime movie'],
     
    293395    MQV  => ['MOV',  'Sony Mobile Quicktime Video'],
    294396    MRW  => ['MRW',  'Minolta RAW format'],
    295     MTS  => ['M2TS', 'MPEG-2 Transport Stream'],
     397    MTS  =>  'M2TS',
    296398    MXF  => ['MXF',  'Material Exchange Format'],
    297399  # NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'],
     
    301403    NRW  => ['TIFF', 'Nikon RAW (2)'],
    302404    NUMBERS => ['ZIP','Apple Numbers spreadsheet'],
     405    O    => ['EXE',  'Relocatable Object'],
     406    ODB  => ['ZIP',  'Open Document Database'],
     407    ODC  => ['ZIP',  'Open Document Chart'],
     408    ODF  => ['ZIP',  'Open Document Formula'],
     409    ODG  => ['ZIP',  'Open Document Graphics'],
     410    ODI  => ['ZIP',  'Open Document Image'],
    303411    ODP  => ['ZIP',  'Open Document Presentation'],
    304412    ODS  => ['ZIP',  'Open Document Spreadsheet'],
    305413    ODT  => ['ZIP',  'Open Document Text file'],
     414    OFR  => ['RIFF', 'OptimFROG audio'],
    306415    OGG  => ['OGG',  'Ogg Vorbis audio file'],
     416    OGV  => ['OGG',  'Ogg Video file'],
     417    ONP  => ['JSON', 'ON1 Presets'],
     418    OPUS => ['OGG',  'Ogg Opus audio file'],
    307419    ORF  => ['ORF',  'Olympus RAW format'],
    308420    OTF  => ['Font', 'Open Type Font'],
     421    PAC  => ['RIFF', 'Lossless Predictive Audio Compression'],
    309422    PAGES => ['ZIP', 'Apple Pages document'],
    310423    PBM  => ['PPM',  'Portable BitMap'],
     424    PCD  => ['PCD',  'Kodak Photo CD Image Pac'],
    311425    PCT  =>  'PICT',
     426    PCX  => ['PCX',  'PC Paintbrush'],
     427    PDB  => ['PDB',  'Palm Database'],
    312428    PDF  => ['PDF',  'Adobe Portable Document Format'],
    313429    PEF  => ['TIFF', 'Pentax (RAW) Electronic Format'],
     
    317433    PGF  => ['PGF',  'Progressive Graphics File'],
    318434    PGM  => ['PPM',  'Portable Gray Map'],
     435    PHP  => ['PHP',  'PHP Hypertext Preprocessor'],
     436    PHP3 =>  'PHP',
     437    PHP4 =>  'PHP',
     438    PHP5 =>  'PHP',
     439    PHPS =>  'PHP',
     440    PHTML=>  'PHP',
    319441    PICT => ['PICT', 'Apple PICTure'],
    320   # PLIST=> ['PLIST','Apple Property List'],
     442    PLIST=> ['PLIST','Apple Property List'],
    321443    PMP  => ['PMP',  'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;)
    322444    PNG  => ['PNG',  'Portable Network Graphics'],
     
    324446    POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'],
    325447    POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'],
     448    PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'],
     449    PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'],
    326450    PPM  => ['PPM',  'Portable Pixel Map'],
    327451    PPS  => ['FPX',  'Microsoft PowerPoint Slideshow'],
     
    331455    PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'],
    332456    PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'],
     457    PRC  => ['PDB',  'Palm Database'],
    333458    PS   => ['PS',   'PostScript'],
    334459    PS2  =>  'PS',
    335460    PS3  =>  'PS',
    336461    PSB  => ['PSD',  'Photoshop Large Document'],
    337     PSD  => ['PSD',  'Photoshop Drawing'],
     462    PSD  => ['PSD',  'Photoshop Document'],
     463    PSDT => ['PSD',  'Photoshop Document Template'],
    338464    PSP  => ['PSP',  'Paint Shop Pro'],
    339465    PSPFRAME => 'PSP',
     
    342468    PSPTUBE  => 'PSP',
    343469    QIF  =>  'QTIF',
    344     QT   => ['MOV',  'QuickTime movie'],
     470    QT   =>  'MOV',
    345471    QTI  =>  'QTIF',
    346472    QTIF => ['QTIF', 'QuickTime Image File'],
     473    R3D  => ['R3D',  'Redcode RAW Video'],
    347474    RA   => ['Real', 'Real Audio'],
    348475    RAF  => ['RAF',  'FujiFilm RAW Format'],
     
    361488    RWL  => ['TIFF', 'Leica RAW'],
    362489    RWZ  => ['RWZ',  'Rawzor compressed image'],
     490    SEQ  => ['FLIR', 'FLIR image Sequence'],
     491    SKETCH => ['ZIP', 'Sketch design file'],
    363492    SO   => ['EXE',  'Shared Object file'],
    364493    SR2  => ['TIFF', 'Sony RAW Format 2'],
     
    368497    SWF  => ['SWF',  'Shockwave Flash'],
    369498    TAR  => ['TAR',  'TAR archive'],
    370     THM  => ['JPEG', 'Canon Thumbnail'],
     499    THM  => ['JPEG', 'Thumbnail'],
    371500    THMX => [['ZIP','FPX'], 'Office Open XML Theme'],
    372501    TIF  =>  'TIFF',
    373502    TIFF => ['TIFF', 'Tagged Image File Format'],
     503    TORRENT => ['Torrent', 'BitTorrent description file'],
    374504    TS   =>  'M2TS',
    375505    TTC  => ['Font', 'True Type Font Collection'],
    376506    TTF  => ['Font', 'True Type Font'],
    377507    TUB  => 'PSP',
     508    TXT  => ['TXT',  'Text file'],
     509    VCARD=> ['VCard','Virtual Card'],
     510    VCF  => 'VCARD',
    378511    VOB  => ['MPEG', 'Video Object'],
    379512    VRD  => ['VRD',  'Canon VRD Recipe Data'],
     
    384517    WEBP => ['RIFF', 'Google Web Picture'],
    385518    WMA  => ['ASF',  'Windows Media Audio'],
     519    WMF  => ['WMF',  'Windows Metafile Format'],
    386520    WMV  => ['ASF',  'Windows Media Video'],
     521    WV   => ['RIFF', 'WavePack lossless audio'],
    387522    X3F  => ['X3F',  'Sigma RAW format'],
     523    MACOS=> ['MacOS','MacOS ._ sidecar file'],
    388524    XCF  => ['XCF',  'GIMP native image format'],
    389525    XHTML=> ['HTML', 'Extensible HyperText Markup Language'],
     
    398534    XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'],
    399535    XMP  => ['XMP',  'Extensible Metadata Platform'],
     536    WOFF => ['Font', 'Web Open Font Format'],
     537    WOFF2=> ['Font', 'Web Open Font Format2'],
     538    WTV  => ['WTV',  'Windows recorded TV show'],
    400539    ZIP  => ['ZIP',  'ZIP archive'],
     540);
     541
     542# typical extension for each file type (if different than FileType)
     543# - case is not significant
     544my %fileTypeExt = (
     545    'Canon 1D RAW' => 'tif',
     546    DICOM   => 'dcm',
     547    FLIR    => 'fff',
     548    GZIP    => 'gz',
     549    JPEG    => 'jpg',
     550    M2TS    => 'mts',
     551    MPEG    => 'mpg',
     552    TIFF    => 'tif',
     553    VCard   => 'vcf',
    401554);
    402555
     
    404557my %fileDescription = (
    405558    DICOM => 'Digital Imaging and Communications in Medicine',
    406     PLIST => 'Property List',
    407559    XML   => 'Extensible Markup Language',
    408     'DJVU (multi-page)' => 'DjVu multi-page image',
    409560    'Win32 EXE' => 'Windows 32-bit Executable',
    410561    'Win32 DLL' => 'Windows 32-bit Dynamic Link Library',
     562    'Win64 EXE' => 'Windows 64-bit Executable',
     563    'Win64 DLL' => 'Windows 64-bit Dynamic Link Library',
    411564);
    412565
    413566# MIME types for applicable file types above
    414 # (missing entries default to 'application/unknown', but note that
    415 other mime types may be specified by some modules, ie. QuickTime.pm)
     567# (missing entries default to 'application/unknown', but note that other MIME
     568types may be specified by some modules, eg. QuickTime.pm and RIFF.pm)
    416569%mimeType = (
    417570   '3FR' => 'image/x-hasselblad-3fr',
     571    AA   => 'audio/audible',
     572    AAE  => 'application/vnd.apple.photos',
    418573    AI   => 'application/vnd.adobe.illustrator',
    419574    AIFF => 'audio/x-aiff',
     575    ALIAS=> 'application/x-macos',
    420576    APE  => 'audio/x-monkeys-audio',
     577    APNG => 'image/apng',
    421578    ASF  => 'video/x-ms-asf',
    422579    ARW  => 'image/x-sony-arw',
    423     AVI  => 'video/x-msvideo',
    424580    BMP  => 'image/bmp',
     581    BPG  => 'image/bpg',
    425582    BTF  => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html)
    426583    BZ2  => 'application/bzip2',
    427584   'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension)
     585    CHM  => 'application/x-chm',
     586    COS  => 'application/octet-stream', #PH (NC)
    428587    CR2  => 'image/x-canon-cr2',
     588    CR3  => 'image/x-canon-cr3',
     589    CRM  => 'video/x-canon-crm',
    429590    CRW  => 'image/x-canon-crw',
     591    CSV  => 'text/csv',
     592    CZI  => 'image/x-zeiss-czi', #PH (NC)
     593    DCP  => 'application/octet-stream', #PH (NC)
    430594    DCR  => 'image/x-kodak-dcr',
     595    DCX  => 'image/dcx',
     596    DEX  => 'application/octet-stream',
    431597    DFONT=> 'application/x-dfont',
    432     DICM => 'application/dicom',
     598    DICOM=> 'application/dicom',
    433599    DIVX => 'video/divx',
    434600    DJVU => 'image/vnd.djvu',
     
    440606    DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate',
    441607    DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template',
     608    DPX  => 'image/x-dpx',
     609    DR4  => 'application/octet-stream', #PH (NC)
     610    DS2  => 'audio/x-ds2',
     611    DSS  => 'audio/x-dss',
    442612    DV   => 'video/x-dv',
     613   'DVR-MS' => 'video/x-ms-dvr',
     614    DWF  => 'model/vnd.dwf',
     615    DWG  => 'image/vnd.dwg',
    443616    EIP  => 'application/x-captureone', #(NC)
    444617    EPS  => 'application/postscript',
    445618    ERF  => 'image/x-epson-erf',
    446619    EXE  => 'application/octet-stream',
     620    EXR  => 'image/x-exr',
     621    EXV  => 'image/x-exv',
     622    FFF  => 'image/x-hasselblad-fff',
     623    FITS => 'image/fits',
    447624    FLA  => 'application/vnd.adobe.fla',
    448625    FLAC => 'audio/flac',
     626    FLIF => 'image/flif',
     627    FLIR => 'image/x-flir-fff', #PH (NC)
    449628    FLV  => 'video/x-flv',
    450629    Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM)
     630    FPF  => 'image/x-flir-fpf', #PH (NC)
    451631    FPX  => 'image/vnd.fpx',
    452632    GIF  => 'image/gif',
     633    GPR  => 'image/x-gopro-gpr',
    453634    GZIP => 'application/x-gzip',
    454635    HDP  => 'image/vnd.ms-photo',
     636    HDR  => 'image/vnd.radiance',
    455637    HTML => 'text/html',
    456638    ICC  => 'application/vnd.iccprofile',
     639    ICS  => 'text/calendar',
     640    IDML => 'application/vnd.adobe.indesign-idml-package',
    457641    IIQ  => 'image/x-raw',
    458642    IND  => 'application/x-indesign',
     643    INX  => 'application/x-indesign-interchange', #PH (NC)
     644    ISO  => 'application/x-iso9660-image',
    459645    ITC  => 'application/itunes',
     646    J2C  => 'image/x-j2c', #PH (NC)
    460647    JNG  => 'image/jng',
    461648    JP2  => 'image/jp2',
     
    463650    JPM  => 'image/jpm',
    464651    JPX  => 'image/jpx',
     652    JSON => 'application/json',
     653    JXR  => 'image/jxr',
    465654    K25  => 'image/x-kodak-k25',
    466655    KDC  => 'image/x-kodak-kdc',
     656    KEY  => 'application/x-iwork-keynote-sffkey',
     657    LFP  => 'image/x-lytro-lfp', #PH (NC)
    467658    LNK  => 'application/octet-stream',
     659    LRI  => 'image/x-light-lri',
    468660    M2T  => 'video/mpeg',
    469661    M2TS => 'video/m2ts',
     662    MAX  => 'application/x-3ds',
    470663    MEF  => 'image/x-mamiya-mef',
    471664    MIE  => 'application/x-mie',
     
    475668    MKV  => 'video/x-matroska',
    476669    MNG  => 'video/mng',
     670    MOBI => 'application/x-mobipocket-ebook',
     671    MOI  => 'application/octet-stream', #PH (NC)
    477672    MOS  => 'image/x-raw',
    478673    MOV  => 'video/quicktime',
     
    485680    NEF  => 'image/x-nikon-nef',
    486681    NRW  => 'image/x-nikon-nrw',
     682    NUMBERS => 'application/x-iwork-numbers-sffnumbers',
     683    ODB  => 'application/vnd.oasis.opendocument.database',
     684    ODC  => 'application/vnd.oasis.opendocument.chart',
     685    ODF  => 'application/vnd.oasis.opendocument.formula',
     686    ODG  => 'application/vnd.oasis.opendocument.graphics',
     687    ODI  => 'application/vnd.oasis.opendocument.image',
    487688    ODP  => 'application/vnd.oasis.opendocument.presentation',
    488689    ODS  => 'application/vnd.oasis.opendocument.spreadsheet',
    489690    ODT  => 'application/vnd.oasis.opendocument.text',
    490     OGG  => 'audio/x-ogg',
     691    OGG  => 'audio/ogg',
     692    OGV  => 'video/ogg',
     693    ONP  => 'application/on1',
    491694    ORF  => 'image/x-olympus-orf',
    492695    OTF  => 'application/x-font-otf',
     696    PAGES=> 'application/x-iwork-pages-sffpages',
    493697    PBM  => 'image/x-portable-bitmap',
     698    PCD  => 'image/x-photo-cd',
     699    PCX  => 'image/pcx',
     700    PDB  => 'application/vnd.palm',
    494701    PDF  => 'application/pdf',
    495702    PEF  => 'image/x-pentax-pef',
     703    PFA  => 'application/x-font-type1', # (needed if handled by PostScript module)
    496704    PGF  => 'image/pgf',
    497705    PGM  => 'image/x-portable-graymap',
     706    PHP  => 'application/x-httpd-php',
    498707    PICT => 'image/pict',
    499     PLIST=> 'application/xml',
     708    PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time)
     709    PMP  => 'image/x-sony-pmp', #PH (NC)
    500710    PNG  => 'image/png',
    501711    POT  => 'application/vnd.ms-powerpoint',
    502712    POTM => 'application/vnd.ms-powerpoint.template.macroEnabled',
    503713    POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template',
     714    PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled',
     715    PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented)
    504716    PPM  => 'image/x-portable-pixmap',
    505717    PPS  => 'application/vnd.ms-powerpoint',
     
    513725    PSP  => 'image/x-paintshoppro', #(NC)
    514726    QTIF => 'image/x-quicktime',
     727    R3D  => 'video/x-red-r3d', #PH (invented)
    515728    RA   => 'audio/x-pn-realaudio',
    516729    RAF  => 'image/x-fujifilm-raf',
     
    527740    RWL  => 'image/x-leica-rwl',
    528741    RWZ  => 'image/x-rawzor', #(duplicated in Rawzor.pm)
     742    SEQ  => 'image/x-flir-seq', #PH (NC)
     743    SKETCH => 'application/sketch',
    529744    SR2  => 'image/x-sony-sr2',
    530745    SRF  => 'image/x-sony-srf',
     
    535750    THMX => 'application/vnd.ms-officetheme',
    536751    TIFF => 'image/tiff',
     752    Torrent => 'application/x-bittorrent',
    537753    TTC  => 'application/x-font-ttf',
    538754    TTF  => 'application/x-font-ttf',
     755    TXT  => 'text/plain',
     756    VCard=> 'text/vcard',
     757    VRD  => 'application/octet-stream', #PH (NC)
    539758    VSD  => 'application/x-visio',
    540     WAV  => 'audio/x-wav',
    541759    WDP  => 'image/vnd.ms-photo',
    542760    WEBM => 'video/webm',
    543     WEBP => 'image/webp',
    544761    WMA  => 'audio/x-ms-wma',
     762    WMF  => 'application/x-wmf',
    545763    WMV  => 'video/x-ms-wmv',
     764    WTV  => 'video/x-ms-wtv',
    546765    X3F  => 'image/x-sigma-x3f',
    547766    XCF  => 'image/x-xcf',
     
    565784# - module name '0' indicates a recognized but unsupported file
    566785my %moduleName = (
     786    AA   => 'Audible',
     787    ALIAS=> 0,
     788    AVC  => 0,
    567789    BTF  => 'BigTIFF',
    568790    BZ2  => 0,
    569791    CRW  => 'CanonRaw',
    570     DICM => 'DICOM',
     792    CHM  => 'EXE',
    571793    COS  => 'CaptureOne',
     794    CZI  => 'ZISRAW',
     795    DEX  => 0,
    572796    DOCX => 'OOXML',
     797    DCX  => 0,
     798    DR4  => 'CanonVRD',
     799    DSS  => 'Olympus',
     800    DWF  => 0,
     801    DWG  => 0,
    573802    EPS  => 'PostScript',
    574803    EXIF => '',
     804    EXR  => 'OpenEXR',
     805    EXV  => '',
    575806    ICC  => 'ICC_Profile',
    576807    IND  => 'InDesign',
    577808    FLV  => 'Flash',
     809    FPF  => 'FLIR',
    578810    FPX  => 'FlashPix',
    579811    GZIP => 'ZIP',
     812    HDR  => 'Radiance',
    580813    JP2  => 'Jpeg2000',
    581814    JPEG => '',
    582   # MODD => 'XML',
     815    LFP  => 'Lytro',
     816    LRI  => 0,
    583817    MOV  => 'QuickTime',
    584818    MKV  => 'Matroska',
    585819    MP3  => 'ID3',
    586820    MRW  => 'MinoltaRaw',
    587     OGG  => 'Vorbis',
     821    OGG  => 'Ogg',
    588822    ORF  => 'Olympus',
    589   # PLIST=> 'XML',
     823    PDB  => 'Palm',
     824    PCD  => 'PhotoCD',
     825    PHP  => 0,
    590826    PMP  => 'Sony',
    591827    PS   => 'PostScript',
    592828    PSD  => 'Photoshop',
    593829    QTIF => 'QuickTime',
     830    R3D  => 'Red',
    594831    RAF  => 'FujiFilm',
    595832    RAR  => 'ZIP',
     
    599836    TAR  => 0,
    600837    TIFF => '',
     838    TXT  => 'Text',
    601839    VRD  => 'CanonVRD',
     840    WMF  => 0,
    602841    X3F  => 'SigmaRaw',
    603842    XCF  => 'GIMP',
    604843);
    605844
     845$testLen = 1024;    # number of bytes to read when testing for magic number
     846
    606847# quick "magic number" file test used to avoid loading module unnecessarily:
    607 # - regular expression evaluated on first 1024 bytes of file
     848# - regular expression evaluated on first $testLen bytes of file
    608849# - must match beginning at first byte in file
    609850# - this test must not be more stringent than module logic
    610851%magicNumber = (
     852    AA   => '.{4}\x57\x90\x75\x36',
    611853    AIFF => '(FORM....AIF[FC]|AT&TFORM)',
     854    ALIAS=> "book\0\0\0\0mark\0\0\0\0",
    612855    APE  => '(MAC |APETAGEX|ID3)',
    613856    ASF  => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c',
     857    AVC  => '\+A\+V\+C\+',
     858    Torrent => 'd\d+:\w+',
    614859    BMP  => 'BM',
     860    BPG  => "BPG\xfb",
    615861    BTF  => '(II\x2b\0|MM\0\x2b)',
    616862    BZ2  => 'BZh[1-9]\x31\x41\x59\x26\x53\x59',
     863    CHM  => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec',
    617864    CRW  => '(II|MM).{4}HEAP(CCDR|JPGM)',
    618     DICM => '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)',
     865    CZI  => 'ZISRAWFILE\0{6}',
     866    DCX  => '\xb1\x68\xde\x3a',
     867    DEX  => "dex\n035\0",
     868    DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)',
    619869    DOCX => 'PK\x03\x04',
     870    DPX  => '(SDPX|XPDS)',
     871    DR4  => 'IIII\x04\0\x04\0',
     872    DSS  => '(\x02dss|\x03ds2)',
    620873    DV   => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized)
     874    DWF  => '\(DWF V\d',
     875    DWG  => 'AC10\d{2}\0',
    621876    EPS  => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
    622877    EXE  => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)',
    623878    EXIF => '(II\x2a\0|MM\0\x2a)',
     879    EXR  => '\x76\x2f\x31\x01',
     880    EXV  => '\xff\x01Exiv2',
     881    FITS => 'SIMPLE  = {20}T',
    624882    FLAC => '(fLaC|ID3)',
     883    FLIF => 'FLIF[0-\x6f][0-2]',
     884    FLIR => '[AF]FF\0',
    625885    FLV  => 'FLV\x01',
    626886    Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' .
    627             '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics)',
     887            '(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])',
     888    FPF  => 'FPF Public Image Format\0',
    628889    FPX  => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1',
    629890    GIF  => 'GIF8[79]a',
    630891    GZIP => '\x1f\x8b\x08',
    631     HTML => '(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive)
     892    HDR  => '#\?(RADIANCE|RGBE)\x0a',
     893    HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive)
    632894    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}',
    633895    IND  => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d',
     896  # ISO  =>  signature is at byte 32768
    634897    ITC  => '.{4}itch',
    635     JP2  => '\0\0\0\x0cjP(  |\x1a\x1a)\x0d\x0a\x87\x0a',
     898    JP2  => '(\0\0\0\x0cjP(  |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)',
    636899    JPEG => '\xff\xd8\xff',
     900    JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:',
     901    LFP  => '\x89LFP\x0d\x0a\x1a\x0a',
    637902    LNK  => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46',
     903    LRI  => 'LELR \0',
    638904    M2TS => '(....)?\x47',
    639905    MIE  => '~[\x10\x18]\x04.0MIE',
    640906    MIFF => 'id=ImageMagick',
    641907    MKV  => '\x1a\x45\xdf\xa3',
    642     MOV  => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)',
     908    MOV  => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!)
    643909  # MP3  =>  difficult to rule out
    644910    MPC  => '(MP\+|ID3)',
     911    MOI  => 'V6',
    645912    MPEG => '\0\0\x01[\xb0-\xbf]',
    646913    MRW  => '\0MR[MI]',
     
    648915    OGG  => '(OggS|ID3)',
    649916    ORF  => '(II|MM)',
    650     PDF  => '%PDF-\d+\.\d+',
     917    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)',
     918  # PCD  =>  signature is at byte 2048
     919    PCX  => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]',
     920    PDF  => '\s*%PDF-\d+\.\d+',
    651921    PGF  => 'PGF',
     922    PHP  => '<\?php\s',
    652923    PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)',
     924    PLIST=> '(bplist0|\s*<|\xfe\xff\x00)',
    653925    PMP  => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb',
    654926    PNG  => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n',
     
    658930    PSP  => 'Paint Shop Pro Image File\x0a\x1a\0{5}',
    659931    QTIF => '.{4}(idsc|idat|iicc)',
     932    R3D  => '\0\0..RED(1|2)',
    660933    RAF  => 'FUJIFILM',
    661934    RAR  => 'Rar!\x1a\x07\0',
    662935    RAW  => '(.{25}ARECOYK|II|MM)',
    663936    Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)',
    664     RIFF => 'RIFF',
     937    RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants
    665938    RSRC => '(....)?\0\0\x01\0',
    666939    RTF  => '[\n\r]*\\{[\n\r]*\\\\rtf',
    667     # (don't be too restrictive for RW2/RWL -- how does magic number change for big-endian?)
    668     RW2  => '(II|MM)', #(\x55\0\x18\0\0\0\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a)
    669     RWL  => '(II|MM)', #(ditto)
    670940    RWZ  => 'rawzor',
    671941    SWF  => '[FC]WS[^\0]',
    672942    TAR  => '.{257}ustar(  )?\0', # (this doesn't catch old-style tar files)
     943    TXT  => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)',
    673944    TIFF => '(II|MM)', # don't test magic number (some raw formats are different)
     945    VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n',
    674946    VRD  => 'CANON OPTIONAL DATA\0',
     947    WMF  => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)',
     948    WTV  => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d',
    675949    X3F  => 'FOVb',
     950    MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X        ',
    676951    XCF  => 'gimp xcf ',
    677952    XMP  => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<',
    678953    ZIP  => 'PK\x03\x04',
    679954);
     955
     956# file types with weak magic number recognition
     957my %weakMagic = ( MP3 => 1 );
     958
     959# file types that are determined by the process proc when FastScan == 3
     960# (when done, the process proc must exit after SetFileType if FastScan is 3)
     961my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT);
     962
     963# Compact/XMPShorthand option settings
     964my %compactOpt = (
     965    nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline',
     966    shorthand => 'Shorthand', onedesc => 'OneDesc',
     967    all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'],
     968    allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'],
     969    # aliases to cover anticipated user typos
     970    nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent',
     971    nopad => 'NoPadding', onedescr => 'OneDesc',
     972    # allow numerical settings for backward compatibility
     973    0 => 'None',
     974    1 => 'NoPadding',
     975    2 => ['NoPadding','NoIndent'],
     976    3 => ['NoPadding','NoIndent','OneDesc'],
     977    4 => ['NoPadding','NoIndent','OneDesc','NoNewline'],
     978    5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'],
     979);
     980my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] );
    680981
    681982# lookup for valid character set names (keys are all lower case)
     
    694995    vietnam     => 'Vietnam',     cp1258  => 'Vietnam',
    695996    thai        => 'Thai',        cp874   => 'Thai',
     997    doslatinus  => 'DOSLatinUS',  cp437   => 'DOSLatinUS',
     998    doslatin1   => 'DOSLatin1',   cp850   => 'DOSLatin1',
     999    doscyrillic => 'DOSCyrillic', cp866   => 'DOSCyrillic',
    6961000    macroman    => 'MacRoman',    cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman',
    6971001    maclatin2   => 'MacLatin2',   cp10029 => 'MacLatin2',
     
    7041008);
    7051009
    706 # default group priority for writing
    707 my @defaultWriteGroups = qw(EXIF IPTC XMP MakerNotes Photoshop ICC_Profile CanonVRD);
     1010# default family 0 group priority for writing
     1011# (NOTE: tags in groups not specified here will not be written unless
     1012#  overridden by the module or specified when writing)
     1013my @defaultWriteGroups = qw(
     1014    EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe
     1015);
    7081016
    7091017# group hash for ExifTool-generated tags
     
    7111019
    7121020# special tag names (not used for tag info)
    713 my %specialTags = (
    714     TABLE_NAME=>1, SHORT_NAME=>1, PROCESS_PROC=>1, WRITE_PROC=>1, CHECK_PROC=>1,
    715     GROUPS=>1, FORMAT=>1, FIRST_ENTRY=>1, TAG_PREFIX=>1, PRINT_CONV=>1,
    716     WRITABLE=>1, TABLE_DESC=>1, NOTES=>1, IS_OFFSET=>1, EXTRACT_UNKNOWN=>1,
    717     NAMESPACE=>1, PREFERRED=>1, SRC_TABLE=>1, PRIORITY=>1, WRITE_GROUP=>1,
    718     LANG_INFO=>1, VARS=>1, DATAMEMBER=>1, IS_SUBDIR=>1, SET_GROUP1=>1,
     1021%specialTags = map { $_ => 1 } qw(
     1022    TABLE_NAME       SHORT_NAME  PROCESS_PROC  WRITE_PROC  CHECK_PROC
     1023    GROUPS           FORMAT      FIRST_ENTRY   TAG_PREFIX  PRINT_CONV
     1024    WRITABLE         TABLE_DESC  NOTES         IS_OFFSET   IS_SUBDIR
     1025    EXTRACT_UNKNOWN  NAMESPACE   PREFERRED     SRC_TABLE   PRIORITY
     1026    AVOID            WRITE_GROUP LANG_INFO     VARS        DATAMEMBER
     1027    SET_GROUP1       PERMANENT   INIT_TABLE
    7191028);
    7201029
     
    7341043@Image::ExifTool::pluginTags = ( );
    7351044%Image::ExifTool::pluginTags = ( );
     1045
     1046my %systemTagsNotes = (
     1047    Notes => q{
     1048        extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
     1049        option is set
     1050    },
     1051);
    7361052
    7371053# tag information for preview image -- this should be used for all
     
    7461062    RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
    7471063    # we allow preview image to be set to '', but we don't want a zero-length value
    748     # in the IFD, so set it temorarily to 'none'.  Note that the length is <= 4,
     1064    # in the IFD, so set it temporarily to 'none'.  Note that the length is <= 4,
    7491065    # so this value will fit in the IFD so the preview fixup won't be generated.
    7501066    ValueConvInv => '$val eq "" and $val="none"; $val',
     
    7581074    VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
    7591075    WRITE_PROC => \&DummyWriteProc,
    760     Error   => { Priority => 0, Groups => \%allGroupsExifTool },
    761     Warning => { Priority => 0, Groups => \%allGroupsExifTool },
     1076    Error   => {
     1077        Priority => 0,
     1078        Groups => \%allGroupsExifTool,
     1079        Notes => q{
     1080            returns errors that may have occurred while reading or writing a file.  Any
     1081            Error will prevent the file from being processed.  Minor errors may be
     1082            downgraded to warnings with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors> option
     1083        },
     1084    },
     1085    Warning => {
     1086        Priority => 0,
     1087        Groups => \%allGroupsExifTool,
     1088        Notes => q{
     1089            returns warnings that may have occurred while reading or writing a file.
     1090            Use the -a or L<Duplicates|../ExifTool.html#Duplicates> option to see all warnings if more than one
     1091            occurred. Minor warnings may be ignored with the -m or L<IgnoreMinorErrors|../ExifTool.html#IgnoreMinorErrors>
     1092            option.  Minor warnings with a capital "M" in the "[Minor]" designation
     1093            indicate that the processing is affected by ignoring the warning
     1094        },
     1095    },
    7621096    Comment => {
    7631097        Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image',
     
    7671101    },
    7681102    Directory => {
    769         Groups => { 1 => 'System' },
     1103        Groups => { 1 => 'System', 2 => 'Other' },
     1104        Notes => q{
     1105            the directory of the file as specified in the call to ExifTool, or "." if no
     1106            directory was specified.  May be written to move the file to another
     1107            directory that will be created if doesn't already exist
     1108        },
    7701109        Writable => 1,
     1110        WritePseudo => 1,
     1111        DelCheck => q{"Can't delete"},
    7711112        Protected => 1,
     1113        RawConv => '$self->ConvertFileName($val)',
    7721114        # translate backslashes in directory names and add trailing '/'
    773         ValueConvInv => '$_=$val; tr/\\\\/\//; m{[^/]$} and $_ .= "/"; $_',
     1115        ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_',
    7741116    },
    7751117    FileName => {
    776         Groups => { 1 => 'System' },
     1118        Groups => { 1 => 'System', 2 => 'Other' },
    7771119        Writable => 1,
     1120        WritePseudo => 1,
     1121        DelCheck => q{"Can't delete"},
    7781122        Protected => 1,
    7791123        Notes => q{
    7801124            may be written with a full path name to set FileName and Directory in one
    781             operation.  See L<filename.html|../filename.html> for more information on
    782             writing the FileName and Directory tags
     1125            operation.  This is such a powerful feature that a TestName tag is provided
     1126            to allow dry-run tests before actually writing the file name.  See
     1127            L<filename.html|../filename.html> for more information on writing the
     1128            FileName, Directory and TestName tags
    7831129        },
    784         ValueConvInv => '$val=~tr/\\\\/\//; $val',
     1130        RawConv => '$self->ConvertFileName($val)',
     1131        ValueConvInv => '$self->InverseFileName($val)',
     1132    },
     1133    FilePath => {
     1134        Groups => { 1 => 'System', 2 => 'Other' },
     1135        Notes => q{
     1136            absolute path of source file. Not generated unless specifically requested or
     1137            the L<RequestAll|../ExifTool.html#RequestAll> API option is set.  Does not support Windows Unicode file
     1138            names
     1139        },
     1140    },
     1141    TestName => {
     1142        Writable => 1,
     1143        WritePseudo => 1,
     1144        DelCheck => q{"Can't delete"},
     1145        Protected => 1,
     1146        WriteOnly => 1,
     1147        Notes => q{
     1148            this write-only tag may be used instead of FileName for dry-run tests of the
     1149            file renaming feature.  Writing this tag prints the old and new file names
     1150            to the console, but does not affect the file itself
     1151        },
     1152        ValueConvInv => '$self->InverseFileName($val)',
     1153    },
     1154    FileSequence => {
     1155        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
     1156        Notes => q{
     1157            sequence number for each source file when extracting or copying information,
     1158            including files that fail the -if condition of the command-line application,
     1159            beginning at 0 for the first file.  Not generated unless specifically
     1160            requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set
     1161        },
    7851162    },
    7861163    FileSize => {
    787         Groups => { 1 => 'System' },
     1164        Groups => { 1 => 'System', 2 => 'Other' },
     1165        Notes => q{
     1166            note that the print conversion for this tag uses historic prefixes: 1 kB =
     1167            1024 bytes, etc.
     1168        },
    7881169        PrintConv => \&ConvertFileSize,
    7891170    },
    7901171    ResourceForkSize => {
    791         Groups => { 1 => 'System' },
     1172        Groups => { 1 => 'System', 2 => 'Other' },
    7921173        Notes => q{
    793             [Mac OS only] size of the file's resource fork if it contains data.  If this
    794             tag is generated the ExtractEmbedded option may be used to extract
    795             resource-fork information as a sub-document
     1174            size of the file's resource fork if it contains data.  Mac OS only.  If this
     1175            tag is generated the L<ExtractEmbedded|../ExifTool.html#ExtractEmbedded> option may be used to extract
     1176            resource-fork information as a sub-document.  When writing, the resource
     1177            fork is preserved by default, but it may be deleted with C<-rsrc:all=> on
     1178            the command line
    7961179        },
    7971180        PrintConv => \&ConvertFileSize,
    7981181    },
    799     FileType    => { },
     1182    FileType => {
     1183        Groups => { 2 => 'Other' },
     1184        Notes => q{
     1185            a short description of the file type.  For many file types this is the just
     1186            the uppercase file extension
     1187        },
     1188    },
     1189    FileTypeExtension => {
     1190        Groups => { 2 => 'Other' },
     1191        Notes => q{
     1192            a common lowercase extension for this file type, or uppercase with the -n
     1193            option
     1194        },
     1195        PrintConv => 'lc $val',
     1196    },
    8001197    FileModifyDate => {
    8011198        Description => 'File Modification Date/Time',
    802         Notes => 'the filesystem modification time',
     1199        Notes => q{
     1200            the filesystem modification date/time.  Note that ExifTool may not be able
     1201            to handle filesystem dates before 1970 depending on the limitations of the
     1202            system's standard libraries
     1203        },
    8031204        Groups => { 1 => 'System', 2 => 'Time' },
    8041205        Writable => 1,
    805         # all pseudo-tags must be protected so -tagsfromfile fails with
     1206        WritePseudo => 1,
     1207        DelCheck => q{"Can't delete"},
     1208        # all writable pseudo-tags must be protected so -tagsfromfile fails with
    8061209        # unrecognized files unless a pseudo tag is specified explicitly
    8071210        Protected => 1,
     
    8121215        PrintConvInv => '$self->InverseDateTime($val)',
    8131216    },
     1217    FileAccessDate => {
     1218        Description => 'File Access Date/Time',
     1219        Notes => q{
     1220            the date/time of last access of the file.  Note that this access time is
     1221            updated whenever any software, including ExifTool, reads the file
     1222        },
     1223        Groups => { 1 => 'System', 2 => 'Time' },
     1224        ValueConv => 'ConvertUnixTime($val,1)',
     1225        PrintConv => '$self->ConvertDateTime($val)',
     1226    },
     1227    FileCreateDate => {
     1228        Description => 'File Creation Date/Time',
     1229        Notes => q{
     1230            the filesystem creation date/time.  Windows/Mac only.  In Windows, the file
     1231            creation date/time is preserved by default when writing if Win32API::File
     1232            and Win32::API are available.  On Mac, this tag is extracted only if it or
     1233            the MacOS group is specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is
     1234            set to 2 or higher.  Requires "setfile" for writing on Mac, which may be
     1235            installed by typing C<xcode-select --install> in the Terminal
     1236        },
     1237        Groups => { 1 => 'System', 2 => 'Time' },
     1238        Writable => 1,
     1239        WritePseudo => 1,
     1240        DelCheck => q{"Can't delete"},
     1241        Protected => 1, # all writable pseudo-tags must be protected!
     1242        Shift => 'Time',
     1243        ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)',
     1244        ValueConvInv => q{
     1245            return GetUnixTime($val,1) if $^O eq 'MSWin32';
     1246            return $val if $^O eq 'darwin';
     1247            warn "This tag is Windows/Mac only\n";
     1248            return undef;
     1249        },
     1250        PrintConv => '$self->ConvertDateTime($val)',
     1251        PrintConvInv => '$self->InverseDateTime($val)',
     1252    },
     1253    FileInodeChangeDate => {
     1254        Description => 'File Inode Change Date/Time',
     1255        Notes => q{
     1256            the date/time when the file's directory information was last changed.
     1257            Non-Windows systems only
     1258        },
     1259        Groups => { 1 => 'System', 2 => 'Time' },
     1260        ValueConv => 'ConvertUnixTime($val,1)',
     1261        PrintConv => '$self->ConvertDateTime($val)',
     1262    },
    8141263    FilePermissions => {
    815         Groups => { 1 => 'System' },
     1264        Groups => { 1 => 'System', 2 => 'Other' },
    8161265        Notes => q{
    8171266            r=read, w=write and x=execute permissions for the file owner, group and
    8181267            others.  The ValueConv value is an octal number so bit test operations on
    819             this value should be done in octal, ie. "oct($filePermissions) & 0200"
     1268            this value should be done in octal, eg. 'oct($filePermissions#) & 0200'
    8201269        },
    821         ValueConv => 'sprintf("%.3o", $val & 0777)',
     1270        Writable => 1,
     1271        WritePseudo => 1,
     1272        DelCheck => q{"Can't delete"},
     1273        Protected => 1, # all writable pseudo-tags must be protected!
     1274        ValueConv => 'sprintf("%.3o", $val)',
     1275        ValueConvInv => 'oct($val & 07777)',
    8221276        PrintConv => sub {
    823             my ($mask, $str, $val) = (0400, '', oct(shift));
     1277            my ($mask, $val) = (0400, oct(shift));
     1278            my %types = (
     1279                0010000 => 'p',
     1280                0020000 => 'c',
     1281                0040000 => 'd',
     1282                0060000 => 'b',
     1283                0120000 => 'l',
     1284                0140000 => 's',
     1285            );
     1286            my $str = $types{$val & 0170000} || '-';
    8241287            while ($mask) {
    8251288                foreach (qw(r w x)) {
     
    8301293            return $str;
    8311294        },
     1295        PrintConvInv => sub {
     1296            my ($bit, $val, $str) = (8, 0, shift);
     1297            $str = substr($str, 1) if length($str) == 10;
     1298            return undef if length($str) != 9;
     1299            while ($bit >= 0) {
     1300                foreach (qw(r w x)) {
     1301                    $val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_;
     1302                    --$bit;
     1303                }
     1304            }
     1305            return sprintf('%.3o', $val);
     1306        },
    8321307    },
    833     MIMEType    => { },
    834     ImageWidth  => { },
    835     ImageHeight => { },
    836     XResolution => { },
    837     YResolution => { },
    838     MaxVal      => { }, # max pixel value in PPM or PGM image
     1308    FileAttributes => {
     1309        Groups => { 1 => 'System', 2 => 'Other' },
     1310        Notes => q{
     1311            extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
     1312            option is set.  2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows
     1313            attribute bits if Win32API::File is available
     1314        },
     1315        PrintHex => 1,
     1316        PrintConvColumns => 2,
     1317        PrintConv => [{ # stat device types (bitmask 0xf000)
     1318            0x0000 => 'Unknown',
     1319            0x1000 => 'FIFO',
     1320            0x2000 => 'Character',
     1321            0x3000 => 'Mux Character',
     1322            0x4000 => 'Directory',
     1323            0x5000 => 'XENIX Named',
     1324            0x6000 => 'Block',
     1325            0x7000 => 'Mux Block',
     1326            0x8000 => 'Regular',
     1327            0x9000 => 'VxFS Compressed',
     1328            0xa000 => 'Symbolic Link',
     1329            0xb000 => 'Solaris Shadow Inode',
     1330            0xc000 => 'Socket',
     1331            0xd000 => 'Solaris Door',
     1332            0xe000 => 'BSD Whiteout',
     1333        },{ BITMASK => { # stat attribute bits (bitmask 0x0e00)
     1334            9 => 'Sticky',
     1335            10 => 'Set Group ID',
     1336            11 => 'Set User ID',
     1337        }},{ BITMASK => { # Windows attribute bits
     1338            0 => 'Read Only',
     1339            1 => 'Hidden',
     1340            2 => 'System',
     1341            3 => 'Volume Label',
     1342            4 => 'Directory',
     1343            5 => 'Archive',
     1344            6 => 'Device',
     1345            7 => 'Normal',
     1346            8 => 'Temporary',
     1347            9 => 'Sparse File',
     1348            10 => 'Reparse Point',
     1349            11 => 'Compressed',
     1350            12 => 'Offline',
     1351            13 => 'Not Content Indexed',
     1352            14 => 'Encrypted',
     1353        }}],
     1354    },
     1355    FileDeviceID => {
     1356        Groups => { 1 => 'System', 2 => 'Other' },
     1357        %systemTagsNotes,
     1358        PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor)
     1359    },
     1360    FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
     1361    FileInodeNumber  => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
     1362    FileHardLinks    => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
     1363    FileUserID => {
     1364        Groups => { 1 => 'System', 2 => 'Other' },
     1365        Notes => q{
     1366            extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
     1367            option is set.  Returns user ID number with the -n option, or name
     1368            otherwise.  May be written with either user name or number
     1369        },
     1370        Writable => 1,
     1371        WritePseudo => 1,
     1372        DelCheck => q{"Can't delete"},
     1373        Protected => 1, # all writable pseudo-tags must be protected!
     1374        PrintConv => 'eval { getpwuid($val) } || $val',
     1375        PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)',
     1376    },
     1377    FileGroupID => {
     1378        Groups => { 1 => 'System', 2 => 'Other' },
     1379        Notes => q{
     1380            extracted only if specifically requested or the L<SystemTags|../ExifTool.html#SystemTags> or L<RequestAll|../ExifTool.html#RequestAll> API
     1381            option is set.  Returns group ID number with the -n option, or name
     1382            otherwise.  May be written with either group name or number
     1383        },
     1384        Writable => 1,
     1385        WritePseudo => 1,
     1386        DelCheck => q{"Can't delete"},
     1387        Protected => 1, # all writable pseudo-tags must be protected!
     1388        PrintConv => 'eval { getgrgid($val) } || $val',
     1389        PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)',
     1390    },
     1391    FileBlockSize    => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
     1392    FileBlockCount   => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes },
     1393    HardLink => {
     1394        Writable => 1,
     1395        DelCheck => q{"Can't delete"},
     1396        WriteOnly => 1,
     1397        WritePseudo => 1,
     1398        Protected => 1,
     1399        Notes => q{
     1400            this write-only tag is used to create a hard link with the specified name to
     1401            the source file.  If the source file is edited, copied, renamed or moved in
     1402            the same operation as writing HardLink, then the link is made to the updated
     1403            file.  Note that subsequent editing of either hard-linked file by exiftool
     1404            will break the link unless the -overwrite_original_in_place option is used
     1405        },
     1406        ValueConvInv => '$val=~tr/\\\\/\//; $val',
     1407    },
     1408    SymLink => {
     1409        Writable => 1,
     1410        DelCheck => q{"Can't delete"},
     1411        WriteOnly => 1,
     1412        WritePseudo => 1,
     1413        Protected => 1,
     1414        Notes => q{
     1415            this write-only tag is used to create a symbolic link with the specified
     1416            name to the source file.  If the source file is edited, copied, renamed or
     1417            moved in the same operation as writing SymLink, then the link is made to the
     1418            updated file.  The link uses an absolute path unless it is created in the
     1419            current working directory.  Valid only for file systems that support
     1420            symbolic links.  Note that subsequent editing of the file via the symbolic
     1421            link by exiftool will cause the link to be replaced by the edited file
     1422            without changing the original unless the -overwrite_original_in_place option
     1423            is used
     1424        },
     1425        ValueConvInv => '$val=~tr/\\\\/\//; $val',
     1426    },
     1427    MIMEType    => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } },
     1428    ImageWidth  => { Notes => 'the width of the image in number of pixels' },
     1429    ImageHeight => { Notes => 'the height of the image in number of pixels' },
     1430    XResolution => { Notes => 'the horizontal pixel resolution' },
     1431    YResolution => { Notes => 'the vertical pixel resolution' },
     1432    MaxVal      => { Notes => 'maximum pixel value in PPM or PGM image' },
    8391433    EXIF => {
    840         Notes => 'the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images',
     1434        Notes => q{
     1435            the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag
     1436            is generated only if specifically requested
     1437        },
    8411438        Groups => { 0 => 'EXIF', 1 => 'EXIF' },
    842         Flags => ['Writable' ,'Protected', 'Binary'],
     1439        Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'],
    8431440        WriteCheck => q{
    8441441            return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/;
     
    8461443        },
    8471444    },
    848     ICC_Profile => {
    849         Notes => 'the full ICC_Profile data block',
    850         Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' },
    851         Flags => ['Writable' ,'Protected', 'Binary'],
     1445    IPTC => {
     1446        Notes => q{
     1447            the full IPTC data block.  This tag is generated only if specifically
     1448            requested
     1449        },
     1450        Groups => { 0 => 'IPTC', 1 => 'IPTC' },
     1451        Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'],
     1452        Priority => 0,  # so main IPTC (which hopefully comes first) takes priority
    8521453        WriteCheck => q{
    853             require Image::ExifTool::ICC_Profile;
    854             return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
     1454            return undef if $val =~ /^(\x1c|\0+$)/;
     1455            return 'Invalid IPTC data';
    8551456        },
    8561457    },
    8571458    XMP => {
    858         Notes => 'the full XMP data block',
     1459        Notes => q{
     1460            the XMP data block, but note that extended XMP in JPEG images may be split
     1461            into multiple blocks.  This tag is generated only if specifically requested
     1462        },
    8591463        Groups => { 0 => 'XMP', 1 => 'XMP' },
    860         Flags => ['Writable', 'Protected', 'Binary'],
     1464        Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'],
    8611465        Priority => 0,  # so main xmp (which usually comes first) takes priority
    8621466        WriteCheck => q{
     
    8651469        },
    8661470    },
     1471    XML => {
     1472        Notes => 'the XML data block, extracted for some file types',
     1473        Groups => { 0 => 'XML', 1 => 'XML' },
     1474        Binary => 1,
     1475    },
     1476    ICC_Profile => {
     1477        Notes => q{
     1478            the full ICC_Profile data block.  This tag is generated only if specifically
     1479            requested
     1480        },
     1481        Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' },
     1482        Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'],
     1483        WriteCheck => q{
     1484            require Image::ExifTool::ICC_Profile;
     1485            return Image::ExifTool::ICC_Profile::ValidateICC(\$val);
     1486        },
     1487    },
    8671488    CanonVRD => {
    868         Notes => 'the full Canon DPP VRD trailer block',
     1489        Notes => q{
     1490            the full Canon DPP VRD trailer block.  This tag is generated only if
     1491            specifically requested
     1492        },
    8691493        Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
    870         Flags => ['Writable' ,'Protected', 'Binary'],
     1494        Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'],
    8711495        Permanent => 0, # (this is 1 by default for MakerNotes tags)
    8721496        WriteCheck => q{
     
    8741498            return 'Invalid CanonVRD data';
    8751499        },
     1500    },
     1501    CanonDR4 => {
     1502        Notes => q{
     1503            the full Canon DPP version 4 DR4 block.  This tag is generated only if
     1504            specifically requested
     1505        },
     1506        Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
     1507        Flags => ['Writable' ,'Protected', 'Binary'],
     1508        Permanent => 0, # (this is 1 by default for MakerNotes tags)
     1509        WriteCheck => q{
     1510            return undef if $val =~ /^IIII\x04\0\x04\0/;
     1511            return 'Invalid CanonDR4 data';
     1512        },
     1513    },
     1514    Adobe => {
     1515        Notes => q{
     1516            the JPEG APP14 Adobe segment.  Extracted only if specified. See the
     1517            L<JPEG Adobe Tags|JPEG.html#Adobe> for more information
     1518        },
     1519        Groups => { 0 => 'APP14', 1 => 'Adobe' },
     1520        WriteGroup => 'Adobe',
     1521        Flags => ['Writable' ,'Protected', 'Binary'],
    8761522    },
    8771523    CurrentIPTCDigest => {
     
    8811527            specified by the L<MWG|http://www.metadataworkinggroup.org/>.  ExifTool
    8821528            automates the handling of this tag in the MWG module -- see the
    883             L<MWG Tag Name documentation|MWG.html> for details
     1529            L<MWG Composite Tags|MWG.html> for details
    8841530        },
    8851531        ValueConv => 'unpack("H*", $val)',
    8861532    },
    8871533    PreviewImage => {
     1534        Notes => 'JPEG-format embedded preview image',
     1535        Groups => { 2 => 'Preview' },
    8881536        Writable => 1,
    8891537        WriteCheck => '$self->CheckImage(\$val)',
     1538        WriteGroup => 'All',
    8901539        # can't delete, so set to empty string and return no error
    8911540        DelCheck => '$val = ""; return undef',
     
    8931542        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
    8941543    },
    895     PreviewPNG  => { Binary => 1 },
     1544    ThumbnailImage => {
     1545        Groups => { 2 => 'Preview' },
     1546        Notes => 'JPEG-format embedded thumbnail image',
     1547        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
     1548    },
     1549    OtherImage => {
     1550        Groups => { 2 => 'Preview' },
     1551        Notes => 'other JPEG-format embedded image',
     1552        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
     1553    },
     1554    PreviewPNG => {
     1555        Groups => { 2 => 'Preview' },
     1556        Notes => 'PNG-format embedded preview image',
     1557        Binary => 1,
     1558    },
     1559    PreviewWMF => {
     1560        Groups => { 2 => 'Preview' },
     1561        Notes => 'WMF-format embedded preview image',
     1562        Binary => 1,
     1563    },
     1564    PreviewTIFF => {
     1565        Groups => { 2 => 'Preview' },
     1566        Notes => 'TIFF-format embedded preview image',
     1567        Binary => 1,
     1568    },
     1569    PreviewPDF => {
     1570        Groups => { 2 => 'Preview' },
     1571        Notes => 'PDF-format embedded preview image',
     1572        Binary => 1,
     1573    },
    8961574    ExifByteOrder => {
    8971575        Writable => 1,
    898         Notes => 'only writable for newly created EXIF segments',
     1576        DelCheck => q{"Can't delete"},
     1577        Notes => q{
     1578            represents the byte order of EXIF information.  May be written to set the
     1579            byte order only for newly created EXIF segments
     1580        },
    8991581        PrintConv => {
    9001582            II => 'Little-endian (Intel, II)',
     
    9041586    ExifUnicodeByteOrder => {
    9051587        Writable => 1,
     1588        WriteOnly => 1,
     1589        DelCheck => q{"Can't delete"},
    9061590        Notes => q{
    907             the EXIF specification is particularly vague about the byte ordering for
    908             Unicode text, and different applications use different conventions.  By
    909             default ExifTool writes Unicode text in EXIF byte order, but this write-only
    910             tag may be used to force a specific byte order
     1591            specifies the byte order to use when writing EXIF Unicode text.  The EXIF
     1592            specification is particularly vague about this byte ordering, and different
     1593            applications use different conventions.  By default ExifTool writes Unicode
     1594            text in EXIF byte order, but this write-only tag may be used to force a
     1595            specific order.  Applies to the EXIF UserComment tag when writing special
     1596            characters
    9111597        },
    9121598        PrintConv => {
     
    9181604        Description => 'ExifTool Version Number',
    9191605        Groups => \%allGroupsExifTool,
     1606        Notes => 'the version of ExifTool currently running',
    9201607    },
    921     RAFVersion => { },
     1608    ProcessingTime => {
     1609        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
     1610        Notes => q{
     1611            the clock time in seconds taken by ExifTool to extract information from this
     1612            file.  Not generated unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API
     1613            option is set.  Requires Time::HiRes
     1614        },
     1615        PrintConv => 'sprintf("%.3g s", $val)',
     1616    },
     1617    RAFVersion => { Notes => 'RAF file version number' },
    9221618    JPEGDigest => {
    9231619        Notes => q{
     
    9261622            compared to known values in an attempt to deduce the originating software
    9271623            based only on the JPEG image data.  For performance reasons, this tag is
    928             generated only if specifically requested
     1624            generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set
     1625            to 3 or higher
    9291626        },
    9301627    },
     1628    JPEGQualityEstimate => {
     1629        Notes => q{
     1630            an estimate of the IJG JPEG quality setting for the image, calculated from
     1631            the quantization tables.  For performance reasons, this tag is generated
     1632            only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set to 3 or
     1633            higher
     1634        },
     1635    },
     1636    JPEGImageLength => {
     1637        Notes => q{
     1638            byte length of JPEG image without metadata.  For performance reasons, this
     1639            tag is generated only if specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option
     1640            is set to 3 or higher
     1641        },
     1642    },
     1643    # Validate (added from Validate.pm)
    9311644    Now => {
    9321645        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' },
    9331646        Notes => q{
    934             the current date/time.  Useful when setting the tag values, ie.
    935             C<"-modifydate<now">.  Not generated unless specifically requested
    936         },
    937         ValueConv => sub {
    938             my $time = shift;
    939             my @tm = localtime $time;
    940             my $tz = Image::ExifTool::TimeZoneString(\@tm, $time);
    941             sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d%s", $tm[5]+1900, $tm[4]+1, $tm[3],
    942                     $tm[2], $tm[1], $tm[0], $tz);
     1647            the current date/time.  Useful when setting the tag values, eg.
     1648            C<"-modifydate<now">.  Not generated unless specifically requested or the
     1649            L<RequestAll|../ExifTool.html#RequestAll> API option is set
    9431650        },
    9441651        PrintConv => '$self->ConvertDateTime($val)',
    9451652    },
    946     ID3Size     => { },
     1653    NewGUID => {
     1654        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' },
     1655        Notes => q{
     1656            generates a new, random GUID with format
     1657            YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour,
     1658            M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and
     1659            R=random hex number; without dashes with the -n option.  Not generated
     1660            unless specifically requested or the L<RequestAll|../ExifTool.html#RequestAll> API option is set
     1661        },
     1662        PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val',
     1663    },
     1664    ID3Size     => { Notes => 'size of the ID3 data block' },
    9471665    Geotag => {
    9481666        Writable => 1,
     1667        WriteOnly => 1,
     1668        WriteNothing => 1,
    9491669        AllowGroup => '(exif|gps|xmp|xmp-exif)',
    9501670        Notes => q{
    9511671            this write-only tag is used to define the GPS track log data or track log
    9521672            file name.  Currently supported track log formats are GPX, NMEA RMC/GGA/GLL,
    953             KML, IGC, Garmin XML and TCX, and Magellan PMGNTRK.  See
    954             L<geotag.html|../geotag.html> for details
     1673            KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus
     1674            Beacon text, and Bramor gEO log files.  May be set to the special value of
     1675            "DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points
     1676            are available.  See L<geotag.html|../geotag.html> for details
    9551677        },
    9561678        DelCheck => q{
     
    9701692    Geotime => {
    9711693        Writable => 1,
     1694        WriteOnly => 1,
    9721695        AllowGroup => '(exif|gps|xmp|xmp-exif)',
    9731696        Notes => q{
    9741697            this write-only tag is used to define a date/time for interpolating a
    9751698            position in the GPS track specified by the Geotag tag.  Writing this tag
    976             causes the following 8 tags to be written:  GPSLatitude, GPSLatitudeRef,
    977             GPSLongitude, GPSLongitudeRef, GPSAltitude, GPSAltitudeRef, GPSDateStamp and
    978             GPSTimeStamp.  The local system timezone is assumed if the date/time value
    979             does not contain a timezone.  May be deleted to delete associated GPS tags.
    980             A group name of 'EXIF' or 'XMP' may be specified to write or delete only
    981             EXIF or XMP GPS tags.  The value of Geotag must be assigned before this tag
     1699            causes GPS information to be written into the EXIF or XMP of the target
     1700            files.  The local system timezone is assumed if the date/time value does not
     1701            contain a timezone.  May be deleted to delete associated GPS tags.  A group
     1702            name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP
     1703            GPS tags
    9821704        },
    9831705        DelCheck => q{
     
    9941716    Geosync => {
    9951717        Writable => 1,
     1718        WriteOnly => 1,
     1719        WriteNothing => 1,
    9961720        AllowGroup => '(exif|gps|xmp|xmp-exif)',
    9971721        Shift => 'Time', # enables "+=" syntax as well as "=+"
     
    10001724            synchronization with the GPS clock.  For example, set this to "-12" if the
    10011725            camera clock is 12 seconds faster than GPS time.  Input format is
    1002             "[+-][[[DD ]HH:]MM:]SS[.ss]".  Must be set before Geotime to be effective.
    1003             Additional features allow calculation of time differences and time drifts,
    1004             and extraction of synchronization times from image files. See the
    1005             L<geotagging documentation|../geotag.html> for details
     1726            "[+-][[[DD ]HH:]MM:]SS[.ss]".  Additional features allow calculation of time
     1727            differences and time drifts, and extraction of synchronization times from
     1728            image files.  See the L<geotagging documentation|../geotag.html> for details
    10061729        },
    10071730        ValueConvInv => q{
     
    10101733        },
    10111734    },
     1735    ForceWrite => {
     1736        Groups => { 0 => '*', 1 => '*', 2 => '*' },
     1737        Writable => 1,
     1738        WriteOnly => 1,
     1739        Notes => q{
     1740            write-only tag used to force metadata in a file to be rewritten even if no
     1741            tag values are changed.  May be set to "EXIF", "IPTC", "XMP" or "PNG" to
     1742            force the corresponding metadata type to be rewritten, "FixBase" to cause
     1743            EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All"
     1744            to rewrite all of these metadata types.  Values are case insensitive, and
     1745            multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp>
     1746        },
     1747    },
     1748    EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } },
     1749    Trailer => {
     1750        Groups => { 0 => 'Trailer' },
     1751        Notes => 'the full JPEG trailer data block.  Extracted only if specifically requested',
     1752        Writable => 1,
     1753        Protected => 1,
     1754    },
     1755);
     1756
     1757# tags defined by UserParam option (added at runtime)
     1758%Image::ExifTool::UserParam = (
     1759    GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' },
     1760    PRIORITY => 0,
    10121761);
    10131762
     
    10711820        Format => 'int8u[2]',
    10721821        PrintConv => 'sprintf("%d.%.2d", split(" ",$val))',
     1822        Mandatory => 1,
    10731823    },
    10741824    2 => {
     
    10821832        },
    10831833        Priority => -1,
     1834        Mandatory => 1,
    10841835    },
    10851836    3 => {
     
    10891840        Priority => -1,
    10901841        RawConv => '$$self{JFIFXResolution} = $val',
     1842        Mandatory => 1,
    10911843    },
    10921844    5 => {
     
    10961848        Priority => -1,
    10971849        RawConv => '$$self{JFIFYResolution} = $val',
     1850        Mandatory => 1,
     1851    },
     1852    7 => {
     1853        Name => 'ThumbnailWidth',
     1854        RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef',
     1855    },
     1856    8 => {
     1857        Name => 'ThumbnailHeight',
     1858        RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef',
     1859    },
     1860    9 => {
     1861        Name => 'ThumbnailTIFF',
     1862        Groups => { 2 => 'Preview' },
     1863        Format => 'undef[3*($val{7}||0)*($val{8}||0)]',
     1864        Notes => 'raw RGB thumbnail data, extracted as a TIFF image',
     1865        RawConv => 'length($val) ? $val : undef',
     1866        ValueConv => sub {
     1867            my ($val, $et) = @_;
     1868            my $len = length $val;
     1869            return \ "Binary data $len bytes" unless $et->Options('Binary');
     1870            my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val;
     1871            return \$img;
     1872        },
    10981873    },
    10991874);
    11001875%Image::ExifTool::JFIF::Extension = (
    1101     GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' },
     1876    GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' },
     1877    NOTES => 'Thumbnail images extracted from the JFXX segment.',
    11021878    0x10 => {
    11031879        Name => 'ThumbnailImage',
     1880        Groups => { 2 => 'Preview' },
     1881        Notes => 'JPEG-format thumbnail image',
    11041882        RawConv => '$self->ValidateImage(\$val,$tag)',
     1883    },
     1884    0x11 => { # (untested)
     1885        Name => 'ThumbnailTIFF',
     1886        Groups => { 2 => 'Preview' },
     1887        Notes => 'raw palette-color thumbnail data, extracted as a TIFF image',
     1888        RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef',
     1889        ValueConv => sub {
     1890            my ($val, $et) = @_;
     1891            my $len = length $val;
     1892            return \ "Binary data $len bytes" unless $et->Options('Binary');
     1893            my ($w, $h) = unpack('CC', $val);
     1894            my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770);
     1895            return \$img;
     1896        },
     1897    },
     1898    0x13 => {
     1899        Name => 'ThumbnailTIFF',
     1900        Groups => { 2 => 'Preview' },
     1901        Notes => 'raw RGB thumbnail data, extracted as a TIFF image',
     1902        RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef',
     1903        ValueConv => sub {
     1904            my ($val, $et) = @_;
     1905            my $len = length $val;
     1906            return \ "Binary data $len bytes" unless $et->Options('Binary');
     1907            my ($w, $h) = unpack('CC', $val);
     1908            my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2);
     1909            return \$img;
     1910        },
    11051911    },
    11061912);
     
    11151921);
    11161922
     1923my %compositeID;    # lookup for new ID's of Composite tags based on original ID
     1924
    11171925# static private ExifTool variables
    11181926
     
    11311939
    11321940# Clean unnecessary information (line number, LF) from warning
    1133 # Inputs: 0) warning string or undef to use current warning
     1941# Inputs: 0) warning string or undef to use $evalWarning
    11341942# Returns: cleaned warning
    11351943sub CleanWarning(;$)
     
    11601968
    11611969    $self->ClearOptions();      # create default options hash
    1162     $self->{VALUE} = { };       # must initialize this for warning messages
    1163     $self->{DEL_GROUP} = { };   # lookup for groups to delete when writing
     1970    $$self{VALUE} = { };        # must initialize this for warning messages
     1971    $$self{PATH} = [ ];         # (this too)
     1972    $$self{DEL_GROUP} = { };    # lookup for groups to delete when writing
     1973    $$self{SAVE_COUNT} = 0;     # count calls to SaveNewValues()
     1974    $$self{FILE_SEQUENCE} = 0;  # sequence number for files when reading
    11641975
    11651976    # initialize our new groups for writing
     
    11871998#   my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize');
    11881999#    - or -
    1189 #   my $exifTool = new Image::ExifTool;
    1190 #   my $info = $exifTool->ImageInfo($file, \@tagList, {Sort=>'Group0'} );
     2000#   my $et = new Image::ExifTool;
     2001#   my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} );
    11912002sub ImageInfo($;@)
    11922003{
     
    11992010        $self = new Image::ExifTool;
    12002011    }
    1201     my %saveOptions = %{$self->{OPTIONS}};  # save original options
     2012    my %saveOptions = %{$$self{OPTIONS}};   # save original options
    12022013
    12032014    # initialize file information
    1204     $self->{FILENAME} = $self->{RAF} = undef;
     2015    $$self{FILENAME} = $$self{RAF} = undef;
    12052016
    12062017    $self->ParseArguments(@_);              # parse our function arguments
     
    12082019    my $info = $self->GetInfo(undef);       # get requested information
    12092020
    1210     $self->{OPTIONS} = \%saveOptions;       # restore original options
     2021    $$self{OPTIONS} = \%saveOptions;        # restore original options
    12112022
    12122023    return $info;   # return requested information
     
    12162027# Get/set ExifTool options
    12172028# Inputs: 0) ExifTool object reference,
    1218 #         1) Parameter name, 2) Value to set the option
     2029#         1) Parameter name (case insensitive), 2) Value to set the option
    12192030#         3-N) More parameter/value pairs
    12202031# Returns: original value of last option specified
     
    12282039    while (@_) {
    12292040        my $param = shift;
     2041        # fix parameter case if necessary
     2042        unless (exists $$options{$param}) {
     2043            my ($fixed) = grep /^$param$/i, keys %$options;
     2044            if ($fixed) {
     2045                $param = $fixed;
     2046            } else {
     2047                $param =~ s/^Group(\d*)$/Group$1/i;
     2048            }
     2049        }
    12302050        $oldVal = $$options{$param};
     2051        if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) {
     2052            # get previous Compact/XMPShorthand setting
     2053            $oldVal = $$oldVal{$param};
     2054        }
    12312055        last unless @_;
    12322056        my $newVal = shift;
     
    12672091                    warn "Invalid Charset $newVal\n";
    12682092                }
    1269             }
     2093            } elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') {
     2094                $$options{$param} = $newVal;    # only these may be set to a false value
     2095            } elsif ($param eq 'CharsetQuickTime') {
     2096                $$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman
     2097            } else {
     2098                $$options{$param} = 'Latin';    # all others default to Latin
     2099            }
     2100        } elsif ($param eq 'UserParam') {
     2101            # clear options if $newVal is undef
     2102            defined $newVal or $$options{$param} = {}, next;
     2103            my $table = GetTagTable('Image::ExifTool::UserParam');
     2104            # allow initialization of entire UserParam hash
     2105            if (ref $newVal eq 'HASH') {
     2106                my %newParams;
     2107                foreach (sort keys %$newVal) {
     2108                    my $lcTag = lc $_;
     2109                    $newParams{$lcTag} = $$newVal{$_};
     2110                    delete $$table{$lcTag};
     2111                    AddTagToTable($table, $lcTag, $_);
     2112                }
     2113                $$options{$param} = \%newParams;
     2114                next;
     2115            }
     2116            my ($force, $paramName);
     2117            # set/reset single UserParam parameter
     2118            if ($newVal =~ /(.*?)=(.*)/s) {
     2119                $paramName = $1;
     2120                $newVal = $2;
     2121                $force = 1 if $paramName =~ s/\^$//;
     2122                $paramName =~ tr/-_a-zA-Z0-9#//dc;
     2123                $param = lc $paramName;
     2124            } else {
     2125                ($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc;
     2126                undef $newVal;
     2127            }
     2128            delete $$table{$param};
     2129            $oldVal = $$options{UserParam}{$param};
     2130            if (defined $newVal) {
     2131                if (length $newVal or $force) {
     2132                    $$options{UserParam}{$param} = $newVal;
     2133                    AddTagToTable($table, $param, $paramName);
     2134                } else {
     2135                    delete $$options{UserParam}{$param};
     2136                }
     2137            }
     2138            # remove alternate version of tag
     2139            $param .= '#' unless $param =~ s/#$//;
     2140            delete $$table{$param};
     2141            delete $$options{UserParam}{$param};
     2142        } elsif ($param eq 'RequestTags') {
     2143            if (defined $newVal) {
     2144                # parse list from delimited string if necessary
     2145                my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g);
     2146                ExpandShortcuts(\@reqList);
     2147                # add to existing list
     2148                $$options{$param} or $$options{$param} = [ ];
     2149                foreach (@reqList) {
     2150                    /^(.*:)?([-\w?*]*)#?$/ or next;
     2151                    push @{$$options{$param}}, lc($2) if $2;
     2152                    next unless $1;
     2153                    # add requested groups with trailing colon
     2154                    push @{$$options{$param}}, lc($_).':' foreach split /:/, $1;
     2155                }
     2156            } else {
     2157                $$options{$param} = undef;  # clear the list
     2158            }
     2159        } elsif ($param eq 'ListJoin') {
     2160            $$options{$param} = $newVal;
     2161            # set the old List and ListSep options for backward compatibility
     2162            if (defined $newVal) {
     2163                $$options{List} = 0;
     2164                $$options{ListSep} = $newVal;
     2165            } else {
     2166                $$options{List} = 1;
     2167                # (ListSep must be defined)
     2168            }
     2169        } elsif ($param eq 'List') {
     2170            $$options{$param} = $newVal;
     2171            # set the new ListJoin option for forward compatibility
     2172            $$options{ListJoin} = $newVal ? undef : $$options{ListSep};
     2173        } elsif ($param eq 'Compact' or $param eq 'XMPShorthand') {
     2174            # set Compact and XMPShorthand options, preserving backward compatibility
     2175            my ($p, %compact);
     2176            foreach $p ('Compact','XMPShorthand') {
     2177                my $val = $param eq $p ? $newVal : $$options{Compact}{$p};
     2178                if (defined $val) {
     2179                    my @v = ($val =~ /\w+/g);
     2180                    my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt;
     2181                    foreach (@v) {
     2182                        my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal;
     2183                        ref $set or $compact{$set} = 1, next;
     2184                        $compact{$_} = 1 foreach @$set;
     2185                    }
     2186                }
     2187                $compact{$p} = $val; # preserve most recent setting
     2188            }
     2189            $$options{Compact} = $$options{XMPShorthand} = \%compact;
    12702190        } else {
    12712191            if ($param eq 'Escape') {
     
    12812201                }
    12822202                # must forget saved values since they depend on Escape method
    1283                 $self->{BOTH} = { };
     2203                $$self{BOTH} = { };
     2204            } elsif ($param eq 'GlobalTimeShift') {
     2205                delete $$self{GLOBAL_TIME_OFFSET};  # reset our calculated offset
     2206            } elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) {
     2207                $ENV{TZ} = $newVal;
     2208                eval { require POSIX; POSIX::tzset() };
     2209            } elsif ($param eq 'Validate') {
     2210                # load Validate module if Validate option enabled
     2211                $newVal and require Image::ExifTool::Validate;
    12842212            }
    12852213            $$options{$param} = $newVal;
     
    12982226
    12992227    # create options hash with default values
    1300     # (commented out options don't need initializing)
    13012228    # +-----------------------------------------------------+
    13022229    # ! DON'T FORGET!!  When adding any new option, must    !
    13032230    # ! decide how it is handled in SetNewValuesFromFile()  !
    13042231    # +-----------------------------------------------------+
    1305     $self->{OPTIONS} = {
    1306     #   Binary      => undef,   # flag to extract binary values even if tag not specified
    1307     #   ByteOrder   => undef,   # default byte order when creating EXIF information
     2232    # (Note: All options must exist in this lookup, even if undefined,
     2233    # to facilitate case-insensitive options. 'Group#' is handled specially)
     2234    $$self{OPTIONS} = {
     2235        Binary      => undef,   # flag to extract binary values even if tag not specified
     2236        ByteOrder   => undef,   # default byte order when creating EXIF information
    13082237        Charset     => 'UTF8',  # character set for converting Unicode characters
     2238        CharsetEXIF => undef,   # internal EXIF "ASCII" string encoding
     2239        CharsetFileName => undef,   # external encoding for file names
    13092240        CharsetID3  => 'Latin', # internal ID3v1 character set
    13102241        CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet
    1311     #   Compact     => undef,   # compact XMP and IPTC data
     2242        CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names
     2243        CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding
     2244        CharsetRIFF => 0,       # internal RIFF string encoding (0=default to Latin)
     2245        Compact     => { },     # write compact XMP
    13122246        Composite   => 1,       # flag to calculate Composite tags
    1313     #   Compress    => undef,   # flag to write new values as compressed if possible
    1314     #   CoordFormat => undef,   # GPS lat/long coordinate format
    1315     #   DateFormat  => undef,   # format for date/time
     2247        Compress    => undef,   # flag to write new values as compressed if possible
     2248        CoordFormat => undef,   # GPS lat/long coordinate format
     2249        DateFormat  => undef,   # format for date/time
    13162250        Duplicates  => 1,       # flag to save duplicate tag values
    1317     #   Escape      => undef,   # escape special characters
    1318     #   Exclude     => undef,   # tags to exclude
    1319     #   ExtractEmbedded =>undef,# flag to extract information from embedded documents
    1320     #   FastScan    => undef,   # flag to avoid scanning for trailer
    1321     #   FixBase     => undef,   # fix maker notes base offsets
    1322     #   GeoMaxIntSecs => undef, # geotag maximum interpolation time (secs)
    1323     #   GeoMaxExtSecs => undef, # geotag maximum extrapolation time (secs)
    1324     #   GeoMaxHDOP  => undef,   # geotag maximum HDOP
    1325     #   GeoMaxPDOP  => undef,   # geotag maximum PDOP
    1326     #   GeoMinSats  => undef,   # geotag minimum satellites
     2251        Escape      => undef,   # escape special characters
     2252        Exclude     => undef,   # tags to exclude
     2253        ExtendedXMP => 1,       # strategy for reading extended XMP
     2254        ExtractEmbedded =>undef,# flag to extract information from embedded documents
     2255        FastScan    => undef,   # flag to avoid scanning for trailer
     2256        Filter      => undef,   # output filter for all tag values
     2257        FilterW     => undef,   # input filter when writing tag values
     2258        FixBase     => undef,   # fix maker notes base offsets
     2259        GeoMaxIntSecs => 1800,  # geotag maximum interpolation time (secs)
     2260        GeoMaxExtSecs => 1800,  # geotag maximum extrapolation time (secs)
     2261        GeoMaxHDOP  => undef,   # geotag maximum HDOP
     2262        GeoMaxPDOP  => undef,   # geotag maximum PDOP
     2263        GeoMinSats  => undef,   # geotag minimum satellites
     2264        GeoSpeedRef => undef,   # geotag GPSSpeedRef
     2265        GlobalTimeShift => undef,   # apply time shift to all extracted date/time values
    13272266    #   Group#      => undef,   # return tags for specified groups in family #
     2267        HexTagIDs   => 0,       # use hex tag ID's in family 7 group names
    13282268        HtmlDump    => 0,       # HTML dump (0-3, higher # = bigger limit)
    1329     #   HtmlDumpBase => undef,  # base address for HTML dump
    1330     #   IgnoreMinorErrors => undef, # ignore minor errors when reading/writing
     2269        HtmlDumpBase => undef,  # base address for HTML dump
     2270        IgnoreMinorErrors => undef, # ignore minor errors when reading/writing
    13312271        Lang        => $defaultLang,# localized language for descriptions etc
    1332     #   LargeFileSupport => undef,  # flag indicating support of 64-bit file offsets
    1333     #   List        => undef,   # extract lists of PrintConv values into arrays
    1334         ListSep     => ', ',    # list item separator
    1335     #   ListSplit   => undef,   # regex for splitting list-type tag values when writing
    1336     #   MakerNotes  => undef,   # extract maker notes as a block
    1337     #   MissingTagValue =>undef,# value for missing tags when expanded in expressions
    1338     #   Password    => undef,   # password for password-protected PDF documents
     2272        LargeFileSupport => undef,  # flag indicating support of 64-bit file offsets
     2273        List        => undef,   # extract lists of PrintConv values into arrays [no longer documented]
     2274        ListItem    => undef,   # used to return a specific item from lists
     2275        ListJoin    => ', ',    # join lists together with this separator
     2276        ListSep     => ', ',    # list item separator [no longer documented]
     2277        ListSplit   => undef,   # regex for splitting list-type tag values when writing
     2278        MakerNotes  => undef,   # extract maker notes as a block
     2279        MDItemTags  => undef,   # extract MacOS metadata item tags
     2280        MissingTagValue =>undef,# value for missing tags when expanded in expressions
     2281        NoMultiExif => undef,   # raise error when writing multi-segment EXIF
     2282        NoPDFList   => undef,   # flag to avoid splitting PDF List-type tag values
     2283        Password    => undef,   # password for password-protected PDF documents
    13392284        PrintConv   => 1,       # flag to enable print conversion
    1340     #   SavePath    => undef,   # (undocumented) save family 5 location path
    1341     #   ScanForXMP  => undef,   # flag to scan for XMP information in all files
    1342         Sort        => 'Input', # order to sort found tags (Input, File, Alpha, Group#)
    1343     #   StrictDate  => undef,   # flag to return undef for invalid date conversions
    1344     #   Struct      => undef,   # return structures as hash references
     2285        QuickTimeHandler => 1,  # flag to add mdir Handler to newly created Meta box
     2286        QuickTimeUTC=> undef,   # assume that QuickTime date/time tags are stored as UTC
     2287        RequestAll  => undef,   # extract all tags that must be specifically requested
     2288        RequestTags => undef,   # extra tags to request (on top of those in the tag list)
     2289        SaveFormat  => undef,   # save family 6 tag TIFF format
     2290        SavePath    => undef,   # save family 5 location path
     2291        ScanForXMP  => undef,   # flag to scan for XMP information in all files
     2292        Sort        => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#)
     2293        Sort2       => 'File',  # secondary sort order for tags in a group (File, Tag, Descr)
     2294        StrictDate  => undef,   # flag to return undef for invalid date conversions
     2295        Struct      => undef,   # return structures as hash references
     2296        SystemTags  => undef,   # extract additional File System tags
    13452297        TextOut     => \*STDOUT,# file for Verbose/HtmlDump output
     2298        TimeZone    => undef,   # local time zone
    13462299        Unknown     => 0,       # flag to get values of unknown tags (0-2)
     2300        UserParam   => { },     # user parameters for additional user-defined tag values
     2301        Validate    => undef,   # perform additional validation
    13472302        Verbose     => 0,       # print verbose messages (0-5, higher # = more verbose)
     2303        WriteMode   => 'wcg',   # enable all write modes by default
     2304        XAttrTags   => undef,   # extract MacOS extended attribute tags
     2305        XMPAutoConv => 1,       # automatic conversion of unknown XMP tag values
     2306        XMPShorthand=> 0,       # (unused, but needed for backward compatibility)
    13482307    };
    13492308    # keep necessary member variables in sync with options
     
    13702329    local $_;
    13712330    my $self = shift;
    1372     my $options = $self->{OPTIONS};     # pointer to current options
    1373     my (%saveOptions, $reEntry, $rsize);
     2331    my $options = $$self{OPTIONS};      # pointer to current options
     2332    my $fast = $$options{FastScan} || 0;
     2333    my $req = $$self{REQ_TAG_LOOKUP};
     2334    my $reqAll = $$options{RequestAll} || 0;
     2335    my (%saveOptions, $reEntry, $rsize, $type, @startTime, $saveOrder, $isDir);
    13742336
    13752337    # check for internal ReEntry option to allow recursive calls to ExtractInfo
     
    13852347            FILE_TYPE => $$self{FILE_TYPE},
    13862348        };
    1387         $self->{RAF} = new File::RandomAccess($_[0]);
     2349        $saveOrder = GetByteOrder(),
     2350        $$self{RAF} = new File::RandomAccess($_[0]);
    13882351        $$self{PROCESSED} = { };
    13892352        delete $$self{EXIF_DATA};
    13902353        delete $$self{EXIF_POS};
    13912354    } else {
    1392         if (defined $_[0] or $options->{HtmlDump}) {
     2355        if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) {
    13932356            %saveOptions = %$options;       # save original options
    1394    
     2357
    13952358            # require duplicates for html dump
    1396             $self->Options(Duplicates => 1) if $options->{HtmlDump};
    1397    
     2359            $self->Options(Duplicates => 1) if $$options{HtmlDump};
     2360            # enable Validate option if Validate tag is requested
     2361            $self->Options(Validate => 1) if $$req{validate};
     2362
    13982363            if (defined $_[0]) {
    13992364                # only initialize filename if called with arguments
    1400                 $self->{FILENAME} = undef;  # name of file (or '' if we didn't open it)
    1401                 $self->{RAF} = undef;       # RandomAccess object reference
    1402    
     2365                $$self{FILENAME} = undef;   # name of file (or '' if we didn't open it)
     2366                $$self{RAF} = undef;        # RandomAccess object reference
     2367
    14032368                $self->ParseArguments(@_);  # initialize from our arguments
    14042369            }
     
    14072372        $self->Init();
    14082373
    1409         delete $self->{MAKER_NOTE_FIXUP};   # fixup information for extracted maker notes
    1410         delete $self->{MAKER_NOTE_BYTE_ORDER};
     2374        delete $$self{MAKER_NOTE_FIXUP};    # fixup information for extracted maker notes
     2375        delete $$self{MAKER_NOTE_BYTE_ORDER};
    14112376
    14122377        # return our version number
    14132378        $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
    1414         $self->FoundTag('Now', time()) if $self->{REQ_TAG_LOOKUP}{now} or $self->{TAGS_FROM_FILE};
    1415     }
    1416     my $filename = $self->{FILENAME};   # image file name ('' if already open)
    1417     my $raf = $self->{RAF};             # RandomAccess object
     2379        $self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll;
     2380        $self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll;
     2381        # generate sequence number if necessary
     2382        $self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll;
     2383
     2384        if ($$req{processingtime} or $reqAll) {
     2385            eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() };
     2386            if (not @startTime and $$req{processingtime}) {
     2387                $self->WarnOnce('Install Time::HiRes to generate ProcessingTime');
     2388            }
     2389        }
     2390
     2391        ++$$self{FILE_SEQUENCE};        # count files read
     2392    }
     2393
     2394    my $filename = $$self{FILENAME};    # image file name ('' if already open)
     2395    my $raf = $$self{RAF};              # RandomAccess object
    14182396
    14192397    local *EXIFTOOL_FILE;   # avoid clashes with global namespace
     
    14252403            unless ($filename eq '-') {
    14262404                # extract file name from pipe if necessary
    1427                 $realname =~ /\|$/ and $realname =~ s/.*?"(.*?)".*/$1/;
    1428                 my ($dir, $name);
    1429                 if (eval 'require File::Basename') {
    1430                     $dir = File::Basename::dirname($realname);
    1431                     $name = File::Basename::basename($realname);
    1432                 } else {
    1433                     ($name = $realname) =~ tr/\\/\//;
    1434                     # remove path
    1435                     $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///;
    1436                 }
     2405                $realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s;
     2406                my ($dir, $name) = SplitFileName($realname);
    14372407                $self->FoundTag('FileName', $name);
    14382408                $self->FoundTag('Directory', $dir) if defined $dir and length $dir;
     2409                if ($$req{filepath} or
     2410                   ($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath}))
     2411                {
     2412                    local $SIG{'__WARN__'} = \&SetWarning;
     2413                    if (eval { require Cwd }) {
     2414                        my $path = eval { Cwd::abs_path($filename) };
     2415                        $self->FoundTag('FilePath', $path) if defined $path;
     2416                    } elsif ($$req{filepath}) {
     2417                        $self->WarnOnce('The Perl Cwd module must be installed to use FilePath');
     2418                    }
     2419                }
    14392420                # get size of resource fork on Mac OS
    1440                 $rsize = -s "$filename/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE};
     2421                $rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE};
    14412422            }
    14422423            # open the file
    1443             if (open(EXIFTOOL_FILE, $filename)) {
     2424            if ($self->Open(\*EXIFTOOL_FILE, $filename)) {
    14442425                # create random access file object
    14452426                $raf = new File::RandomAccess(\*EXIFTOOL_FILE);
    14462427                # patch to force pipe to be buffered because seek returns success
    14472428                # in Windows cmd shell pipe even though it really failed
    1448                 $raf->{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/;
    1449                 $self->{RAF} = $raf;
     2429                $$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/;
     2430                $$self{RAF} = $raf;
     2431            } elsif ($self->IsDirectory($filename)) {
     2432                $isDir = 1;
    14502433            } else {
    14512434                $self->Error('Error opening file');
     
    14562439    }
    14572440
    1458     if ($raf) {
     2441    while ($raf or $isDir) {
     2442        my (@stat, $plainFile);
    14592443        if ($reEntry) {
    14602444            # we already set these tags
    1461         } elsif (not $raf->{FILE_PT}) {
     2445        } elsif (not $raf) {
     2446            @stat = stat $filename;
     2447        } elsif (not $$raf{FILE_PT}) {
    14622448            # get file size from image in memory
    1463             $self->FoundTag('FileSize', length ${$raf->{BUFF_PT}});
    1464         } elsif (-f $raf->{FILE_PT}) {
    1465             # get file size and last modified time if this is a plain file
    1466             my $fileSize = -s _;
    1467             my $fileTime = -M _;
    1468             my @stat = stat _;
    1469             $self->FoundTag('FileSize', $fileSize) if defined $fileSize;
    1470             $self->FoundTag('ResourceForkSize', $rsize) if $rsize;
    1471             $self->FoundTag('FileModifyDate', $^T - $fileTime*(24*3600)) if defined $fileTime;
    1472             $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2];
    1473         }
    1474 
     2449            $self->FoundTag('FileSize', length ${$$raf{BUFF_PT}});
     2450        } elsif (-f $$raf{FILE_PT}) {
     2451            # get file tags if this is a plain file
     2452            @stat = stat _;
     2453            $plainFile = 1;
     2454        } else {
     2455            @stat = stat $$raf{FILE_PT};
     2456        }
     2457        my $fileSize = $stat[7];
     2458        $self->FoundTag('FileSize', $stat[7]) if defined $stat[7];
     2459        $self->FoundTag('ResourceForkSize', $rsize) if $rsize;
     2460        $self->FoundTag('FileModifyDate', $stat[9]) if defined $stat[9];
     2461        $self->FoundTag('FileAccessDate', $stat[8]) if defined $stat[8];
     2462        my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate';
     2463        $self->FoundTag($cTag, $stat[10]) if defined $stat[10];
     2464        $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2];
     2465        # extract more system info if SystemTags option is set
     2466        if (@stat) {
     2467            my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags});
     2468            if ($sys or $$req{fileattributes}) {
     2469                my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00);
     2470                # add Windows file attributes if available
     2471                if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') {
     2472                    local $SIG{'__WARN__'} = \&SetWarning;
     2473                    if (eval { require Win32API::File }) {
     2474                        my $wattr;
     2475                        my $file = $filename;
     2476                        if ($self->EncodeFileName($file)) {
     2477                            $wattr = eval { Win32API::File::GetFileAttributesW($file) };
     2478                        } else {
     2479                            $wattr = eval { Win32API::File::GetFileAttributes($file) };
     2480                        }
     2481                        push @attr, $wattr if defined $wattr and $wattr != 0xffffffff;
     2482                    }
     2483                }
     2484                $self->FoundTag('FileAttributes', "@attr");
     2485            }
     2486            $self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber};
     2487            $self->FoundTag('FileInodeNumber', $stat[1])  if $sys or $$req{fileinodenumber};
     2488            $self->FoundTag('FileHardLinks', $stat[3])    if $sys or $$req{filehardlinks};
     2489            $self->FoundTag('FileUserID', $stat[4])       if $sys or $$req{fileuserid};
     2490            $self->FoundTag('FileGroupID', $stat[5])      if $sys or $$req{filegroupid};
     2491            $self->FoundTag('FileDeviceID', $stat[6])     if $sys or $$req{filedeviceid};
     2492            $self->FoundTag('FileBlockSize', $stat[11])   if $sys or $$req{fileblocksize};
     2493            $self->FoundTag('FileBlockCount', $stat[12])  if $sys or $$req{fileblockcount};
     2494        }
     2495        # extract MDItem tags if requested (only on plain files)
     2496        if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) {
     2497            my $reqMacOS = ($reqAll > 1 or $$req{'macos:'});
     2498            my $crDate = ($reqMacOS || $$req{filecreatedate});
     2499            my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req);
     2500            my $xattr  = ($reqMacOS || $$options{XAttrTags}  || grep /^xattr/,  keys %$req);
     2501            if ($crDate or $mdItem or $xattr) {
     2502                require Image::ExifTool::MacOS;
     2503                Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate;
     2504                Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem and $plainFile;
     2505                Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr;
     2506            }
     2507        }
     2508        # do whatever else we can with directories, then return
     2509        if ($isDir or (defined $stat[2] and ($stat[2] & 0170000) == 0040000)) {
     2510            $self->FoundTag('FileType', 'DIR');
     2511            $self->FoundTag('FileTypeExtension', '');
     2512            $self->BuildCompositeTags() if $$options{Composite};
     2513            $raf->Close() if $raf;
     2514            return 1;
     2515        }
    14752516        # get list of file types to check
    1476         my ($tiffType, %noMagic);
    1477         $self->{FILE_EXT} = GetFileExtension($realname);
     2517        my ($tiffType, %noMagic, $recognizedExt);
     2518        my $ext = $$self{FILE_EXT} = GetFileExtension($realname);
     2519        # set $recognizedExt if this file type is recognized by extension only
     2520        $recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and
     2521                                 defined $moduleName{$ext} and not $moduleName{$ext};
    14782522        my @fileTypeList = GetFileType($realname);
     2523        if ($fast >= 4) {
     2524            if (@fileTypeList) {
     2525                $type = shift @fileTypeList;
     2526                $self->SetFileType($$self{FILE_TYPE} = $type);
     2527            } else {
     2528                $self->Error('Unknown file type');
     2529            }
     2530            $self->BuildCompositeTags() if $fast == 4 and $$options{Composite};
     2531            last;   # don't read the file
     2532        }
    14792533        if (@fileTypeList) {
    14802534            # add remaining types to end of list so we test them all
    14812535            my $pat = join '|', @fileTypeList;
    14822536            push @fileTypeList, grep(!/^($pat)$/, @fileTypes);
    1483             $tiffType = $self->{FILE_EXT};
    1484             $noMagic{MXF} = 1;  # don't do magic number test on MXF or DV files
    1485             $noMagic{DV} = 1;
     2537            $tiffType = $$self{FILE_EXT};
     2538            unless ($fast == 3) {
     2539                $noMagic{MXF} = 1;  # don't do magic number test on MXF or DV files
     2540                $noMagic{DV} = 1;
     2541            }
    14862542        } else {
    14872543            # scan through all recognized file types
     
    14932549        $raf->BinMode();    # set binary mode before we start reading
    14942550        my $pos = $raf->Tell(); # get file position so we can rewind
    1495         my %dirInfo = ( RAF => $raf, Base => $pos );
    14962551        # loop through list of file types to test
    1497         my ($type, $buff, $seekErr);
    1498         # read first 1024 bytes of file for testing
    1499         $raf->Read($buff, 1024) or $buff = '';
     2552        my ($buff, $seekErr);
     2553        my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff );
     2554        # read start of file for testing
     2555        $raf->Read($buff, $testLen) or $buff = '';
    15002556        $raf->Seek($pos, 0) or $seekErr = 1;
    15012557        until ($seekErr) {
     2558            my $unkHeader;
    15022559            $type = shift @fileTypeList;
    15032560            if ($type) {
    1504                 # do quick test for this file type to avoid loading module unnecessarily
    1505                 next if $magicNumber{$type} and $buff !~ /^$magicNumber{$type}/s and
    1506                         not $noMagic{$type};
     2561                if ($magicNumber{$type}) {
     2562                    # do quick test for this file type to avoid loading module unnecessarily
     2563                    next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type};
     2564                } else {
     2565                    # keep checking for other types if we recognize this file only by extension
     2566                    next if defined $moduleName{$type} and not $moduleName{$type};
     2567                    next if $fast > 2;  # keep checking if we aren't processing the file
     2568                }
     2569                next if $weakMagic{$type} and defined $recognizedExt;
     2570            } elsif (not defined $type) {
     2571                last;
     2572            } elsif ($recognizedExt) {
     2573                $type = $recognizedExt; # set type from recognized file extension only
    15072574            } else {
    1508                 last unless defined $type;
    15092575                # last ditch effort to scan past unknown header for JPEG/TIFF
    15102576                next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g;
     
    15132579                $dirInfo{Base} = $pos + $skip;
    15142580                $raf->Seek($pos + $skip, 0) or $seekErr = 1, last;
    1515                 $self->Warn("Skipped unknown $skip byte header");
     2581                $self->Warn("Processing $type-like data after unknown $skip-byte header");
     2582                $unkHeader = 1 unless $$self{DOC_NUM};
    15162583            }
    15172584            # save file type in member variable
    1518             $self->{FILE_TYPE} = $self->{PATH}[0] = $type;
     2585            $$self{FILE_TYPE} = $type;
    15192586            $dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type;
     2587            # don't process the file when FastScan == 3
     2588            if ($fast == 3 and not $processType{$type}) {
     2589                unless ($weakMagic{$type} and (not $ext or $ext ne $type)) {
     2590                    $self->SetFileType($dirInfo{Parent});
     2591                }
     2592                last;
     2593            }
    15202594            my $module = $moduleName{$type};
    15212595            $module = $type unless defined $module;
     
    15312605                last;
    15322606            }
     2607            push @{$$self{PATH}}, $type;    # save file type in metadata PATH
     2608
    15332609            # process the file
    15342610            no strict 'refs';
    1535             &$func($self, \%dirInfo) and last;
     2611            my $result = &$func($self, \%dirInfo);
    15362612            use strict 'refs';
    15372613
     2614            pop @{$$self{PATH}};
     2615
     2616            if ($result) {  # all done if successful
     2617                if ($unkHeader) {
     2618                    $self->DeleteTag('FileType');
     2619                    $self->DeleteTag('FileTypeExtension');
     2620                    $self->DeleteTag('MIMEType');
     2621                    $self->VPrint(0,"Reset file type due to unknown header\n");
     2622                }
     2623                last;
     2624            }
    15382625            # seek back to try again from the same position in the file
    15392626            $raf->Seek($pos, 0) or $seekErr = 1, last;
     2627        }
     2628        if (not defined $type and not $$self{DOC_NUM}) {
     2629            # if we were given a single image with a known type there
     2630            # must be a format error since we couldn't read it, otherwise
     2631            # it is likely we don't support images of this type
     2632            my $fileType = GetFileType($realname) || '';
     2633            my $err;
     2634            if (not length $buff) {
     2635                $err = 'File is empty';
     2636            } else {
     2637                my $ch = substr($buff, 0, 1);
     2638                if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) {
     2639                    if ($fileType eq 'RAW') {
     2640                        $err = 'Unsupported RAW file type';
     2641                    } elsif ($fileType) {
     2642                        $err = 'File format error';
     2643                    } else {
     2644                        $err = 'Unknown file type';
     2645                    }
     2646                } else {
     2647                    # provide some insight into the content of some corrupted files
     2648                    if ($$self{OPTIONS}{FastScan}) {
     2649                        $err = 'File header is all';
     2650                    } else {
     2651                        my $num = 0;
     2652                        for (;;) {
     2653                            $raf->Read($buff, 65536) or undef($num), last;
     2654                            $buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last;
     2655                            $num += length($buff);
     2656                        }
     2657                        if ($num) {
     2658                            $err = 'First ' . ConvertFileSize($num) . ' of file is';
     2659                        } else {
     2660                            $err = 'Entire file is';
     2661                        }
     2662                    }
     2663                    if ($ch eq "\0") {
     2664                        $err .= ' binary zeros';
     2665                    } elsif ($ch eq ' ') {
     2666                        $err .= ' ASCII spaces';
     2667                    } elsif ($ch =~ /[a-zA-Z0-9]/) {
     2668                        $err .= " ASCII '${ch}' characters";
     2669                    } else {
     2670                        $err .= sprintf(" binary 0x%.2x's", ord $ch);
     2671                    }
     2672                }
     2673            }
     2674            $self->Error($err);
    15402675        }
    15412676        if ($seekErr) {
    15422677            $self->Error('Error seeking in file');
    15432678        } elsif ($self->Options('ScanForXMP') and (not defined $type or
    1544             (not $self->Options('FastScan') and not $$self{FoundXMP})))
     2679            (not $fast and not $$self{FoundXMP})))
    15452680        {
    15462681            # scan for XMP
     
    15492684            Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = '';
    15502685        }
    1551         unless (defined $type) {
    1552             # if we were given a single image with a known type there
    1553             # must be a format error since we couldn't read it, otherwise
    1554             # it is likely we don't support images of this type
    1555             my $fileType = GetFileType($realname);
    1556             my $err;
    1557             if (not $fileType) {
    1558                 $err = 'Unknown file type';
    1559             } elsif ($fileType eq 'RAW') {
    1560                 $err = 'Unsupported RAW file type';
    1561             } else {
    1562                 $err = 'File format error';
    1563             }
    1564             $self->Error($err);
    1565         }
    15662686        # extract binary EXIF data block only if requested
    1567         if (defined $self->{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and
    1568             ($self->{REQ_TAG_LOOKUP}{exif} or $self->{OPTIONS}{Binary}))
     2687        if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and
     2688            ($$req{exif} or
     2689            # (not extracted normally, so check TAGS_FROM_FILE)
     2690            ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif})))
    15692691        {
    1570             $self->FoundTag('EXIF', $self->{EXIF_DATA});
     2692            $self->FoundTag('EXIF', $$self{EXIF_DATA});
    15712693        }
    15722694        unless ($reEntry) {
    1573             $self->{PATH} = [ ];    # reset PATH
     2695            $$self{PATH} = [ ];     # reset PATH
    15742696            # calculate Composite tags
    1575             $self->BuildCompositeTags() if $options->{Composite};
     2697            $self->BuildCompositeTags() if $$options{Composite};
    15762698            # do our HTML dump if requested
    1577             if ($self->{HTML_DUMP}) {
     2699            if ($$self{HTML_DUMP}) {
    15782700                $raf->Seek(0, 2);   # seek to end of file
    1579                 $self->{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
    1580                 my $pos = $options->{HtmlDumpBase};
    1581                 $pos = ($self->{FIRST_EXIF_POS} || 0) unless defined $pos;
    1582                 my $dataPt = defined $self->{EXIF_DATA} ? \$self->{EXIF_DATA} : undef;
    1583                 undef $dataPt if defined $self->{EXIF_POS} and $pos != $self->{EXIF_POS};
    1584                 my $success = $self->{HTML_DUMP}->Print($raf, $dataPt, $pos,
    1585                     $options->{TextOut}, $options->{HtmlDump},
    1586                     $self->{FILENAME} ? "HTML Dump ($self->{FILENAME})" : 'HTML Dump');
    1587                 $self->Warn("Error reading $self->{HTML_DUMP}{ERROR}") if $success < 0;
     2701                $$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
     2702                my $pos = $$options{HtmlDumpBase};
     2703                $pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos;
     2704                my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef;
     2705                undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS};
     2706                undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous
     2707                my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos,
     2708                    $$options{TextOut}, $$options{HtmlDump},
     2709                    $$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump');
     2710                $self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0;
    15882711            }
    15892712        }
     
    15912714            $raf->Close();  # close the file if we opened it
    15922715            # process the resource fork as an embedded file on Mac filesystems
    1593             if ($rsize and $options->{ExtractEmbedded}) {
     2716            if ($rsize and $$options{ExtractEmbedded}) {
    15942717                local *RESOURCE_FILE;
    1595                 if (open(RESOURCE_FILE, "$filename/rsrc")) {
     2718                if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) {
    15962719                    $$self{DOC_NUM} = $$self{DOC_COUNT} + 1;
    15972720                    $$self{IN_RESOURCE} = 1;
     
    16042727            }
    16052728        }
     2729        last;   # (loop was a cheap "goto")
     2730    }
     2731
     2732    # generate Validate tag if requested
     2733    if ($$options{Validate} and not $reEntry) {
     2734        Image::ExifTool::Validate::FinishValidate($self, $$req{validate});
     2735    }
     2736
     2737    @startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime));
     2738
     2739    # add user-defined parameters that ended with '!'
     2740    if (%{$$options{UserParam}}) {
     2741        my $doMsg = $$options{Verbose};
     2742        my $table = GetTagTable('Image::ExifTool::UserParam');
     2743        foreach (sort keys %{$$options{UserParam}}) {
     2744            next unless /#$/;
     2745            if ($doMsg) {
     2746                $self->VPrint(0, "UserParam tags:\n");
     2747                undef $doMsg;
     2748            }
     2749            $self->HandleTag($table, $_, $$options{UserParam}{$_});
     2750        }
    16062751    }
    16072752
    16082753    # restore original options
    1609     %saveOptions and $self->{OPTIONS} = \%saveOptions;
     2754    %saveOptions and $$self{OPTIONS} = \%saveOptions;
    16102755
    16112756    if ($reEntry) {
    16122757        # restore necessary members when exiting re-entrant code
    16132758        $$self{$_} = $$reEntry{$_} foreach keys %$reEntry;
    1614     }
    1615 
    1616     return exists $self->{VALUE}{Error} ? 0 : 1;
     2759        SetByteOrder($saveOrder);
     2760    }
     2761
     2762    # ($type may be undef without an Error when processing sub-documents)
     2763    return 0 if not defined $type or exists $$self{VALUE}{Error};
     2764    return 1;
    16172765}
    16182766
     
    16332781
    16342782    unless (@_ and not defined $_[0]) {
    1635         %saveOptions = %{$self->{OPTIONS}}; # save original options
     2783        %saveOptions = %{$$self{OPTIONS}}; # save original options
    16362784        # must set FILENAME so it isn't parsed from the arguments
    1637         $self->{FILENAME} = '' unless defined $self->{FILENAME};
     2785        $$self{FILENAME} = '' unless defined $$self{FILENAME};
    16382786        $self->ParseArguments(@_);
    16392787    }
    16402788
    16412789    # get reference to list of tags for which we will return info
    1642     my ($rtnTags, $byValue) = $self->SetFoundTags();
     2790    my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags();
    16432791
    16442792    # build hash of tag information
    16452793    my (%info, %ignored);
    1646     my $conv = $self->{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
     2794    my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
    16472795    foreach (@$rtnTags) {
    16482796        my $val = $self->GetValue($_, $conv);
     
    16522800
    16532801    # override specified tags with ValueConv value if necessary
    1654     if (@$byValue and $conv ne 'ValueConv') {
     2802    if (@$byValue) {
    16552803        # first determine the number of times each non-ValueConv value is used
    16562804        my %nonVal;
     
    16652813            # generate a new tag key like "Tag #" or "Tag #(1)"
    16662814            $vtag =~ s/( |$)/ #/;
    1667             unless (defined $self->{VALUE}->{$vtag}) {
    1668                 $self->{VALUE}{$vtag} = $self->{VALUE}{$tag};
    1669                 $self->{TAG_INFO}{$vtag} = $self->{TAG_INFO}{$tag};
    1670                 $self->{TAG_EXTRA}{$vtag} = $self->{TAG_EXTRA}{$tag};
    1671                 $self->{FILE_ORDER}{$vtag} = $self->{FILE_ORDER}{$tag};
     2815            unless (defined $$self{VALUE}{$vtag}) {
     2816                $$self{VALUE}{$vtag} = $$self{VALUE}{$tag};
     2817                $$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag};
     2818                $$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag};
     2819                $$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag};
    16722820                # remove existing PrintConv entry unless we are using it too
    16732821                delete $info{$tag} unless $nonVal{$tag};
     
    16792827
    16802828    # remove ignored tags from the list
    1681     my $reqTags = $self->{REQUESTED_TAGS} || [ ];
    1682     if (%ignored and not @$reqTags) {
    1683         my @goodTags;
    1684         foreach (@$rtnTags) {
    1685             push @goodTags, $_ unless $ignored{$_};
    1686         }
    1687         $rtnTags = $self->{FOUND_TAGS} = \@goodTags;
     2829    my $reqTags = $$self{REQUESTED_TAGS} || [ ];
     2830    if (%ignored) {
     2831        if (not @$reqTags) {
     2832            my @goodTags;
     2833            foreach (@$rtnTags) {
     2834                push @goodTags, $_ unless $ignored{$_};
     2835            }
     2836            $rtnTags = $$self{FOUND_TAGS} = \@goodTags;
     2837        } elsif (@$wildTags) {
     2838            # only remove tags specified by wildcard
     2839            my @goodTags;
     2840            my $i = 0;
     2841            foreach (@$rtnTags) {
     2842                if (@$wildTags and $i == $$wildTags[0]) {
     2843                    shift @$wildTags;
     2844                    push @goodTags, $_ unless $ignored{$_};
     2845                } else {
     2846                    push @goodTags, $_;
     2847                }
     2848                ++$i;
     2849            }
     2850            $rtnTags = $$self{FOUND_TAGS} = \@goodTags;
     2851        }
    16882852    }
    16892853
    16902854    # return sorted tag list if provided with a list reference
    1691     if ($self->{IO_TAG_LIST}) {
     2855    if ($$self{IO_TAG_LIST}) {
    16922856        # use file order by default if no tags specified
    16932857        # (no such thing as 'Input' order in this case)
    1694         my $sortOrder = $self->{OPTIONS}{Sort};
    1695         unless (@$reqTags or ($sortOrder and $sortOrder ne 'Input')) {
    1696             $sortOrder = 'File';
    1697         }
     2858        my $sort = $$self{OPTIONS}{Sort};
     2859        $sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input');
    16982860        # return tags in specified sort order
    1699         @{$self->{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sortOrder);
     2861        @{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2});
    17002862    }
    17012863
    17022864    # restore original options
    1703     %saveOptions and $self->{OPTIONS} = \%saveOptions;
     2865    %saveOptions and $$self{OPTIONS} = \%saveOptions;
    17042866
    17052867    return \%info;
    1706 }
    1707 
    1708 #------------------------------------------------------------------------------
    1709 # Combine information from a list of info hashes
    1710 # Unless Duplicates is enabled, first entry found takes priority
    1711 # Inputs: 0) ExifTool object reference, 1-N) list of info hash references
    1712 # Returns: Combined information hash reference
    1713 sub CombineInfo($;@)
    1714 {
    1715     local $_;
    1716     my $self = shift;
    1717     my (%combinedInfo, $info, $tag, %haveInfo);
    1718 
    1719     if ($self->{OPTIONS}{Duplicates}) {
    1720         while ($info = shift) {
    1721             foreach $tag (keys %$info) {
    1722                 $combinedInfo{$tag} = $$info{$tag};
    1723             }
    1724         }
    1725     } else {
    1726         while ($info = shift) {
    1727             foreach $tag (keys %$info) {
    1728                 my $tagName = GetTagName($tag);
    1729                 next if $haveInfo{$tagName};
    1730                 $haveInfo{$tagName} = 1;
    1731                 $combinedInfo{$tag} = $$info{$tag};
    1732             }
    1733         }
    1734     }
    1735     return \%combinedInfo;
    17362868}
    17372869
     
    17402872#         1) [optional] reference to info hash or tag list ref (default is found tags)
    17412873#         2) [optional] sort order ('File', 'Input', ...)
     2874#         3) [optional] secondary sort order
    17422875# Returns: List of tags in specified order
    1743 sub GetTagList($;$$)
     2876sub GetTagList($;$$$)
    17442877{
    17452878    local $_;
    1746     my ($self, $info, $sortOrder) = @_;
     2879    my ($self, $info, $sort, $sort2) = @_;
    17472880
    17482881    my $foundTags;
     
    17532886        $foundTags = $info;
    17542887    }
    1755     my $fileOrder = $self->{FILE_ORDER};
     2888    my $fileOrder = $$self{FILE_ORDER};
    17562889
    17572890    if ($foundTags) {
     
    17632896        }
    17642897    } else {
    1765         $sortOrder = $info if $info and not $sortOrder;
    1766         $foundTags = $self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;
    1767     }
    1768     $sortOrder or $sortOrder = $self->{OPTIONS}{Sort};
     2898        $sort = $info if $info and not $sort;
     2899        $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef;
     2900    }
     2901    $sort or $sort = $$self{OPTIONS}{Sort};
    17692902
    17702903    # return original list if no sort order specified
    1771     return @$foundTags unless $sortOrder and $sortOrder ne 'Input';
    1772 
    1773     if ($sortOrder eq 'Alpha') {
     2904    return @$foundTags unless $sort and $sort ne 'Input';
     2905
     2906    if ($sort eq 'Tag' or $sort eq 'Alpha') {
    17742907        return sort @$foundTags;
    1775     } elsif ($sortOrder =~ /^Group(\d*(:\d+)*)/) {
     2908    } elsif ($sort =~ /^Group(\d*(:\d+)*)/) {
    17762909        my $family = $1 || 0;
    17772910        # want to maintain a basic file order with the groups
     
    17862919            $groupOrder{$tag} = $num;
    17872920        }
     2921        $sort2 or $sort2 = $$self{OPTIONS}{Sort2};
     2922        if ($sort2) {
     2923            if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') {
     2924                return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags;
     2925            } elsif ($sort2 eq 'Descr') {
     2926                my $desc = $self->GetDescriptions($foundTags);
     2927                return sort { $groupOrder{$a} <=> $groupOrder{$b} or
     2928                              $$desc{$a} cmp $$desc{$b} } @$foundTags;
     2929            }
     2930        }
    17882931        return sort { $groupOrder{$a} <=> $groupOrder{$b} or
    17892932                      $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
     2933    } elsif ($sort eq 'Descr') {
     2934        my $desc = $self->GetDescriptions($foundTags);
     2935        return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags;
    17902936    } else {
    17912937        return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags;
     
    17962942# Get list of found tags in specified sort order
    17972943# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...)
     2944#         2) secondary sort order
    17982945# Returns: List of tag keys in specified order
    17992946# Notes: If not specified, sort order is taken from OPTIONS
    1800 sub GetFoundTags($;$)
     2947sub GetFoundTags($;$$)
    18012948{
    18022949    local $_;
    1803     my ($self, $sortOrder) = @_;
    1804     my $foundTags = $self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;
    1805     return $self->GetTagList($foundTags, $sortOrder);
     2950    my ($self, $sort, $sort2) = @_;
     2951    my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef;
     2952    return $self->GetTagList($foundTags, $sort, $sort2);
    18062953}
    18072954
     
    18192966# Get tag value
    18202967# Inputs: 0) ExifTool object reference
    1821 #         1) tag key (or flattened tagInfo for getting field values, not part of public API)
    1822 #         2) [optional] Value type: PrintConv, ValueConv, Both or Raw, the default
     2968#         1) tag key or tag name with optional group names (case sensitive)
     2969#            (or flattened tagInfo for getting field values, not part of public API)
     2970#         2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default
    18232971#            is PrintConv or ValueConv, depending on the PrintConv option setting
    18242972#         3) raw field value (not part of public API)
     
    18302978    my ($self, $tag, $type) = @_; # plus: ($fieldValue)
    18312979    my (@convTypes, $tagInfo, $valueConv, $both);
    1832 
     2980    my $rawValue = $$self{VALUE};
     2981
     2982    # get specific tag key if tag has a group name
     2983    if ($tag =~ /^(.*):(.+)/) {
     2984        my ($gp, $tg) = ($1, $2);
     2985        my ($i, $key, @keys);
     2986        # build list of tag keys in the order of priority (no index
     2987        # is top priority, otherwise higher index is higher priority)
     2988        for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) {
     2989            push @keys, $key if defined $$rawValue{$key};
     2990            last if $i <= 0;
     2991            $key = "$tg ($i)";
     2992        }
     2993        if (@keys) {
     2994            $key = $self->GroupMatches($gp, \@keys);
     2995            $tag = $key if $key;
     2996        }
     2997    }
    18332998    # figure out what conversions to do
    1834     $type or $type = $self->{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
     2999    if ($type) {
     3000        return $$self{RATIONAL}{$tag} if $type eq 'Rational';
     3001    } else {
     3002        $type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
     3003    }
    18353004
    18363005    # start with the raw value
    1837     my $value = $self->{VALUE}{$tag};
     3006    my $value = $$rawValue{$tag};
    18383007    if (not defined $value) {
    1839         return wantarray ? () : undef unless ref $tag;
     3008        return () unless ref $tag;
    18403009        # get the value of a structure field
    18413010        $tagInfo = $tag;
     
    18483017        }
    18493018    } else {
    1850         $tagInfo = $self->{TAG_INFO}{$tag};
     3019        $tagInfo = $$self{TAG_INFO}{$tag};
    18513020        if ($$tagInfo{Struct} and ref $value) {
    18523021            # must load XMPStruct.pl just in case (should already be loaded if
     
    18563025            # convert strucure field values
    18573026            unless ($type eq 'Both') {
    1858                 # (note: ConvertStruct handles the escape too if necessary)
     3027                # (note: ConvertStruct handles the filtering and escaping too if necessary)
    18593028                return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type);
    18603029            }
     
    18663035        if ($type ne 'Raw') {
    18673036            # use values we calculated already if we stored them
    1868             $both = $self->{BOTH}{$tag};
     3037            $both = $$self{BOTH}{$tag};
    18693038            if ($both) {
    18703039                if ($type eq 'PrintConv') {
     
    18873056    foreach $convType (@convTypes) {
    18883057        # don't convert a scalar reference or structure
    1889         last if ref $value eq 'SCALAR';
     3058        last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary};
    18903059        my $conv = $$tagInfo{$convType};
    18913060        unless (defined $conv) {
     
    18953064            } else {
    18963065                # use PRINT_CONV from tag table if PrintConv doesn't exist
    1897                 next unless defined($conv = $tagInfo->{Table}{PRINT_CONV});
     3066                next unless defined($conv = $$tagInfo{Table}{PRINT_CONV});
    18983067                next if exists $$tagInfo{$convType};
    18993068            }
     
    19063075            $convList = $conv;
    19073076            $conv = $$convList[0];
    1908             my @valList = split ' ', $value;
     3077            my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value;
    19093078            # reorganize list if specified (Note: The writer currently doesn't
    19103079            # relist values, so they may be grouped but the order must not change)
     
    19283097                $value = \@valList;
    19293098            }
     3099            return () unless @$value;
    19303100        }
    19313101        # initialize array so we can iterate over values in list
    19323102        if (ref $value eq 'ARRAY') {
    1933             $i = 0;
    1934             $vals = $value;
    1935             $val = $$vals[0];
     3103            if (defined $$tagInfo{RawJoin}) {
     3104                $val = join ' ', @$value;
     3105            } else {
     3106                $i = 0;
     3107                $vals = $value;
     3108                $val = $$vals[0];
     3109            }
    19363110        } else {
    19373111            $val = $value;
     
    19453119                    my $oldEscape = $$self{ESCAPE_PROC};
    19463120                    delete $$self{ESCAPE_PROC};
     3121                    # temporarily delete filter so it isn't applied to the Require'd values
     3122                    my $oldFilter = $$self{OPTIONS}{Filter};
     3123                    delete $$self{OPTIONS}{Filter};
    19473124                    foreach (keys %$val) {
    1948                         $raw[$_] = $self->{VALUE}{$$val{$_}};
     3125                        next unless defined $$val{$_};
     3126                        $raw[$_] = $$rawValue{$$val{$_}};
    19493127                        ($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both');
    1950                         next if defined $val[$_] or not $tagInfo->{Require}{$_};
     3128                        next if defined $val[$_] or not $$tagInfo{Require}{$_};
     3129                        $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter;
    19513130                        $$self{ESCAPE_PROC} = $oldEscape;
    1952                         return wantarray ? () : undef;
     3131                        return ();
    19533132                    }
     3133                    $$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter;
    19543134                    $$self{ESCAPE_PROC} = $oldEscape;
    19553135                    # set $val to $val[0], or \@val for a CODE ref conversion
     
    19583138                if (ref $conv eq 'HASH') {
    19593139                    # look up converted value in hash
    1960                     my $lc;
    1961                     if (defined($value = $$conv{$val})) {
    1962                         # override with our localized language PrintConv if available
    1963                         if ($$self{CUR_LANG} and $convType eq 'PrintConv' and
    1964                             # (no need to check for lang-alt tag names -- they won't have a PrintConv)
    1965                             ref($lc = $self->{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and
    1966                             ($lc = $$lc{PrintConv}) and ($lc = $$lc{$value}))
    1967                         {
    1968                             $value = $self->Decode($lc, 'UTF8');
     3140                    if (not defined($value = $$conv{$val})) {
     3141                        if ($$conv{BITMASK}) {
     3142                            $value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord});
     3143                        } else {
     3144                             # use alternate conversion routine if available
     3145                            if ($$conv{OTHER}) {
     3146                                local $SIG{'__WARN__'} = \&SetWarning;
     3147                                undef $evalWarning;
     3148                                $value = &{$$conv{OTHER}}($val, undef, $conv);
     3149                                $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning;
     3150                            }
     3151                            if (not defined $value) {
     3152                                if ($$tagInfo{PrintHex} and $val and IsInt($val) and
     3153                                    $convType eq 'PrintConv')
     3154                                {
     3155                                    $value = sprintf('Unknown (0x%x)',$val);
     3156                                } else {
     3157                                    $value = "Unknown ($val)";
     3158                                }
     3159                            }
    19693160                        }
    1970                     } else {
    1971                         if ($$conv{BITMASK}) {
    1972                             $value = DecodeBits($val, $$conv{BITMASK});
    1973                             # override with localized language strings
    1974                             if (defined $value and $$self{CUR_LANG} and $convType eq 'PrintConv' and
    1975                                 ref($lc = $self->{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and
    1976                                 ($lc = $$lc{PrintConv}))
    1977                             {
    1978                                 my @vals = split ', ', $value;
    1979                                 foreach (@vals) {
    1980                                     $_ = $$lc{$_} if defined $$lc{$_};
    1981                                 }
    1982                                 $value = join ', ', @vals;
     3161                    }
     3162                    # override with our localized language PrintConv if available
     3163                    my $tmp;
     3164                    if ($$self{CUR_LANG} and $convType eq 'PrintConv' and
     3165                        # (no need to check for lang-alt tag names -- they won't have a PrintConv)
     3166                        ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and
     3167                        ($tmp = $$tmp{PrintConv}))
     3168                    {
     3169                        if ($$conv{BITMASK} and not defined $$conv{$val}) {
     3170                            my @vals = split ', ', $value;
     3171                            foreach (@vals) {
     3172                                $_ = $$tmp{$_} if defined $$tmp{$_};
    19833173                            }
    1984                         } elsif (not $$conv{OTHER} or
    1985                                  # use alternate conversion routine if available
    1986                                  not defined($value = &{$$conv{OTHER}}($val, undef, $conv)))
    1987                         {
    1988                             if (($$tagInfo{PrintHex} or
    1989                                 ($$tagInfo{Mask} and not defined $$tagInfo{PrintHex}))
    1990                                 and $val and IsInt($val) and $convType eq 'PrintConv')
    1991                             {
    1992                                 $val = sprintf('0x%x',$val);
    1993                             }
    1994                             $value = "Unknown ($val)";
     3174                            $value = join ', ', @vals;
     3175                        } elsif (defined($tmp = $$tmp{$value})) {
     3176                            $value = $self->Decode($tmp, 'UTF8');
    19953177                        }
    19963178                    }
     
    20123194            }
    20133195            last unless $vals;
     3196            # must store a separate copy of each binary data value in the list
     3197            if (ref $value eq 'SCALAR') {
     3198                my $tval = $$value;
     3199                $value = \$tval;
     3200            }
    20143201            # save this converted value and step to next value in list
    20153202            push @values, $value if defined $value;
     
    20193206            }
    20203207            $val = $$vals[$i];
    2021             $conv = $$convList[$i] if $convList;
     3208            if ($convList) {
     3209                my $nextConv = $$convList[$i];
     3210                if ($nextConv and $nextConv eq 'REPEAT') {
     3211                    undef $convList;
     3212                } else {
     3213                    $conv = $nextConv;
     3214                }
     3215            }
    20223216        }
    20233217        # return undefined now if no value
    2024         return wantarray ? () : undef unless defined $value;
     3218        return () unless defined $value;
    20253219        # join back into single value if split for conversion list
    20263220        if ($convList and ref $value eq 'ARRAY') {
     
    20313225        # save both (unescaped) values because we often need them again
    20323226        # (Composite tags need "Both" and often Require one tag for various Composite tags)
    2033         $self->{BOTH}{$tag} = [ $valueConv, $value ] unless $both;
     3227        $$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both;
    20343228        # escape values if necessary
    20353229        if ($$self{ESCAPE_PROC}) {
     
    20443238            $valueConv = $value;
    20453239        }
     3240        $self->Filter($$self{OPTIONS}{Filter}, \$value);
    20463241        # return Both values as a list (ValueConv, PrintConv)
    20473242        return ($valueConv, $value);
     
    20503245    DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
    20513246
     3247    # filter if necessary
     3248    $self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv';
     3249
    20523250    if (ref $value eq 'ARRAY') {
    2053         # return array if requested
    2054         return @$value if wantarray;
    2055         # return list reference for Raw, ValueConv or if List or not a list of scalars
    2056         return $value if $type ne 'PrintConv' or $self->{OPTIONS}{List} or ref $$value[0];
    2057         # otherwise join in comma-separated string
    2058         $value = join $self->{OPTIONS}{ListSep}, @$value;
     3251        if (defined $$self{OPTIONS}{ListItem}) {
     3252            $value = $$value[$$self{OPTIONS}{ListItem}];
     3253        } elsif (wantarray) {
     3254            # return array if requested
     3255            return @$value;
     3256        } elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) {
     3257            # join PrintConv values in comma-separated string if List option not used
     3258            # and list contains simple scalars (otherwise return ARRAY ref)
     3259            $value = join $$self{OPTIONS}{ListSep}, @$value;
     3260        }
    20593261    }
    20603262    return $value;
     
    20643266# Get tag identification number
    20653267# Inputs: 0) ExifTool object reference, 1) tag key
    2066 # Returns: Scalar context: Tag ID if available, otherwise ''
    2067 #          List context: 0) Tag ID (or ''), 1) language code (or undef)
     3268# Returns: Scalar context: tag ID if available, otherwise ''
     3269#          List context: 0) tag ID (or ''), 1) language code (or undef)
    20683270sub GetTagID($$)
    20693271{
    20703272    my ($self, $tag) = @_;
    2071     my $tagInfo = $self->{TAG_INFO}{$tag};
     3273    my $tagInfo = $$self{TAG_INFO}{$tag};
    20723274    return '' unless $tagInfo and defined $$tagInfo{TagID};
    20733275    return ($$tagInfo{TagID}, $$tagInfo{LangCode}) if wantarray;
    20743276    return $$tagInfo{TagID};
    2075 }
    2076 
    2077 #------------------------------------------------------------------------------
    2078 # Get tag table name
    2079 # Inputs: 0) ExifTool object reference, 1) tag key
    2080 # Returns: Table name if available, otherwise ''
    2081 sub GetTableName($$)
    2082 {
    2083     my ($self, $tag) = @_;
    2084     my $tagInfo = $self->{TAG_INFO}{$tag} or return '';
    2085     return $tagInfo->{Table}{SHORT_NAME};
    2086 }
    2087 
    2088 #------------------------------------------------------------------------------
    2089 # Get tag index number
    2090 # Inputs: 0) ExifTool object reference, 1) tag key
    2091 # Returns: Table index number, or undefined if this tag isn't indexed
    2092 sub GetTagIndex($$)
    2093 {
    2094     my ($self, $tag) = @_;
    2095     my $tagInfo = $self->{TAG_INFO}{$tag} or return undef;
    2096     return $$tagInfo{Index};
    20973277}
    20983278
     
    21073287    my ($self, $tag) = @_;
    21083288    my ($desc, $name);
    2109     my $tagInfo = $self->{TAG_INFO}{$tag};
     3289    my $tagInfo = $$self{TAG_INFO}{$tag};
    21103290    # ($tagInfo won't be defined for missing tags extracted with -f)
    21113291    if ($tagInfo) {
    21123292        # use alternate language description if available
    21133293        while ($$self{CUR_LANG}) {
    2114             $desc = $self->{CUR_LANG}{$$tagInfo{Name}};
     3294            $desc = $$self{CUR_LANG}{$$tagInfo{Name}};
    21153295            if ($desc) {
    21163296                # must look up Description if this tag also has a PrintConv
     
    21203300                last unless $$tagInfo{LangCode} and
    21213301                    ($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and
    2122                     $desc = $self->{CUR_LANG}{$name};
     3302                    $desc = $$self{CUR_LANG}{$name};
    21233303                $desc = $$desc{Description} or last if ref $desc;
    21243304                $desc .= " ($$tagInfo{LangCode})";
     
    21443324# Inputs: 0) ExifTool object reference
    21453325#         1) tag key (or reference to tagInfo hash, not part of the public API)
    2146 #         2) [optional] group family (-1 to get extended group list)
    2147 # Returns: Scalar context: Group name (for family 0 if not otherwise specified)
    2148 #          Array context: Group name if family specified, otherwise list of
     3326#         2) [optional] group family (-1 to get extended group list, or multiple
     3327#            families separated by colons to return multiple groups as a string)
     3328# Returns: Scalar context: group name (for family 0 if not otherwise specified)
     3329#          List context: group name if family specified, otherwise list of
    21493330#          group names for each family.  Returns '' for undefined tag.
    2150 # Notes: Mutiple families may be specified with ':' in family argument (ie. '1:2')
     3331# Notes: Multiple families may be specified with ':' in family argument (eg. '1:2')
    21513332sub GetGroup($$;$)
    21523333{
    21533334    local $_;
    21543335    my ($self, $tag, $family) = @_;
    2155     my ($tagInfo, @groups, @families, $simplify, $byTagInfo);
     3336    my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID);
    21563337    if (ref $tag eq 'HASH') {
    21573338        $tagInfo = $tag;
     
    21603341        $byTagInfo = 1;
    21613342    } else {
    2162         $tagInfo = $self->{TAG_INFO}{$tag} or return '';
     3343        $tagInfo = $$self{TAG_INFO}{$tag} || { };
     3344        $ex = $$self{TAG_EXTRA}{$tag};
    21633345    }
    21643346    my $groups = $$tagInfo{Groups};
     
    21663348    # (after this, Groups 0-2 in tagInfo are guaranteed to be defined)
    21673349    unless ($$tagInfo{GotGroups}) {
    2168         my $tagTablePtr = $$tagInfo{Table};
    2169         if ($tagTablePtr) {
    2170             # construct our group list
    2171             $groups or $groups = $$tagInfo{Groups} = { };
    2172             # fill in default groups
    2173             foreach (keys %{$$tagTablePtr{GROUPS}}) {
    2174                 $$groups{$_} or $$groups{$_} = $tagTablePtr->{GROUPS}{$_};
    2175             }
     3350        my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } };
     3351        # construct our group list
     3352        $groups or $groups = $$tagInfo{Groups} = { };
     3353        # fill in default groups
     3354        foreach (0..2) {
     3355            $$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_};
    21763356        }
    21773357        # set flag indicating group list was built
     
    21813361        if ($family =~ /[^\d]/) {
    21823362            @families = ($family =~ /\d+/g);
    2183             return $$groups{0} unless @families;
     3363            return(($ex && $$ex{G0}) || $$groups{0}) unless @families;
    21843364            $simplify = 1 unless $family =~ /^:/;
    21853365            undef $family;
    21863366            foreach (0..2) { $groups[$_] = $$groups{$_}; }
     3367            $noID = 1 if @families == 1 and $families[0] != 7;
    21873368        } else {
    2188             return $$groups{$family} if $family == 0 or $family == 2;
     3369            return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2;
    21893370            $groups[1] = $$groups{1};
    21903371        }
    21913372    } else {
    2192         return $$groups{0} unless wantarray;
     3373        return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray;
    21933374        foreach (0..2) { $groups[$_] = $$groups{$_}; }
    21943375    }
     
    21963377    $groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : '';
    21973378    # handle dynamic group names if necessary
    2198     my $ex = $self->{TAG_EXTRA}{$tag};
    2199     if ($ex and not $byTagInfo) {
    2200         $groups[0] = $$ex{G0} if $$ex{G0};
    2201         $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1};
    2202         $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3};
    2203         $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5};
     3379    unless ($byTagInfo) {
     3380        if ($ex) {
     3381            $groups[0] = $$ex{G0} if $$ex{G0};
     3382            $groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1};
     3383            $groups[3] = 'Doc' . $$ex{G3} if $$ex{G3};
     3384            $groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5};
     3385            if (defined $$ex{G6}) {
     3386                $groups[5] = '' unless defined $groups[5];  # (can't leave a hole in the array)
     3387                $groups[6] = $$ex{G6};
     3388            }
     3389        }
     3390        # generate tag ID group names unless obviously not needed
     3391        unless ($noID) {
     3392            my $id = $$tagInfo{TagID};
     3393            if (not defined $id) {
     3394                $id = '';   # (just to be safe)
     3395            } elsif ($id =~ /^\d+$/) {
     3396                $id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs};
     3397            } else {
     3398                $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge;
     3399            }
     3400            $groups[7] = 'ID-' . $id;
     3401            defined $groups[$_] or $groups[$_] = '' foreach (5,6);
     3402        }
    22043403    }
    22053404    if ($family) {
    22063405        return $groups[$family] || '' if $family > 0;
    22073406        # add additional matching group names to list
    2208         # ie) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1
     3407        # eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1
    22093408        # and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc
    22103409        if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) {
     
    22193418        # create list of group names (without identical adjacent groups if simplifying)
    22203419        foreach (@families) {
    2221             my $grp = $groups[$_] or next;
     3420            my $grp = $groups[$_];
     3421            unless ($grp) {
     3422                next if $simplify;
     3423                $grp = '';
     3424            }
    22223425            push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1];
    22233426        }
     
    22463449    if (ref $info ne 'HASH') {
    22473450        $family = $info;
    2248         $info = $self->{VALUE};
     3451        $info = $$self{VALUE};
    22493452    } else {
    22503453        $family = shift;
     
    22643467# Inputs: 0) ExifTool object reference,
    22653468#         1-N) group names (reset to default if no groups specified)
     3469# - used when new tag values are set (ie. before files are written)
    22663470sub SetNewGroups($;@)
    22673471{
     
    22693473    my ($self, @groups) = @_;
    22703474    @groups or @groups = @defaultWriteGroups;
    2271     my $count = @groups;
     3475    my $count = @groups * 10;
    22723476    my %priority;
    22733477    foreach (@groups) {
    2274         $priority{lc($_)} = $count--;
    2275     }
    2276     $priority{file} = 10;       # 'File' group is always written (Comment)
    2277     $priority{composite} = 10;  # 'Composite' group is always written
     3478        $priority{lc($_)} = $count;
     3479        $count -= 10;
     3480    }
     3481    $priority{file} = 500;      # 'File' group is always written (Comment)
     3482    $priority{composite} = 500; # 'Composite' group is always written
    22783483    # set write priority (higher # is higher priority)
    2279     $self->{WRITE_PRIORITY} = \%priority;
    2280     $self->{WRITE_GROUPS} = \@groups;
     3484    $$self{WRITE_PRIORITY} = \%priority;
     3485    $$self{WRITE_GROUPS} = \@groups;
    22813486}
    22823487
     
    22933498
    22943499    $$self{BuildingComposite} = 1;
    2295     # first, add user-defined Composite tags if necessary
    2296     if (%UserDefined and $UserDefined{'Image::ExifTool::Composite'}) {
    2297         AddCompositeTags($UserDefined{'Image::ExifTool::Composite'}, 1);
    2298         delete $UserDefined{'Image::ExifTool::Composite'};
    2299     }
    2300     my @tagList = sort keys %Image::ExifTool::Composite;
    2301     my %tagsUsed;
    2302 
    2303     my $rawValue = $self->{VALUE};
     3500
     3501    my $compTable = GetTagTable('Image::ExifTool::Composite');
     3502    my @tagList = sort keys %$compTable;
     3503    my $rawValue = $$self{VALUE};
     3504    my $compKeys = $$self{COMP_KEYS};
     3505    my (%cache, $allBuilt);
     3506
    23043507    for (;;) {
    2305         my %notBuilt;
    2306         $notBuilt{$_} = 1 foreach @tagList;
    2307         my @deferredTags;
    2308         my $tag;
     3508        my (%notBuilt, $tag, @deferredTags);
     3509        foreach (@tagList) {
     3510            $notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_};
     3511        }
    23093512COMPOSITE_TAG:
    23103513        foreach $tag (@tagList) {
    23113514            next if $specialTags{$tag};
    2312             my $tagInfo = $self->GetTagInfo(\%Image::ExifTool::Composite, $tag);
     3515            my $tagInfo = $self->GetTagInfo($compTable, $tag);
    23133516            next unless $tagInfo;
     3517            my $tagName = $$compTable{$tag}{Name};
    23143518            # put required tags into array and make sure they all exist
    23153519            my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT});
    23163520            my $require = $$tagInfo{Require} || { };
    2317             my $desire = $$tagInfo{Desire} || { };
     3521            my $desire  = $$tagInfo{Desire}  || { };
     3522            my $inhibit = $$tagInfo{Inhibit} || { };
    23183523            # loop through sub-documents if necessary
    2319             my $doc;
     3524            my $docNum = 0;
    23203525            for (;;) {
    23213526                my (%tagKey, $found, $index);
    23223527                # save Require'd and Desire'd tag values in list
    23233528                for ($index=0; ; ++$index) {
    2324                     my $reqTag = $$require{$index} || $$desire{$index} or last;
    2325                     # add family 3 group if generating Composite tags for sub-documents
    2326                     # (unless tag already begins with family 3 group name)
    2327                     if ($subDoc and $reqTag !~ /^(Main|Doc\d+):/) {
    2328                         $reqTag = ($doc ? "Doc$doc:" : 'Main:') . $reqTag;
     3529                    my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index};
     3530                    unless ($reqTag) {
     3531                        # allow Composite with no Require'd or Desire'd tags
     3532                        $found = 1 if $index == 0;
     3533                        last;
    23293534                    }
    2330                     # allow tag group to be specified
    2331                     if ($reqTag =~ /^(.*):(.+)/) {
     3535                    if ($subDoc) {
     3536                        # handle SubDoc tags specially to cache tag keys for faster
     3537                        # processing when there are a large number of sub-documents
     3538                        # - get document number from the tag groups if specified,
     3539                        #   otherwise we are looping through all documents for this tag
     3540                        my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum;
     3541                        # make fast lookup for keys of this tag with specified groups other than doc group
     3542                        # (similar to code in InsertTagValues(), but this is case-sensitive)
     3543                        my $cacheTag = $cache{$reqTag};
     3544                        unless ($cacheTag) {
     3545                            $cacheTag = $cache{$reqTag} = [ ];
     3546                            my $reqGroup;
     3547                            $reqTag =~ s/^(.*):// and $reqGroup = $1;
     3548                            my ($i, $key, @keys);
     3549                            # build list of tag keys in order of precedence
     3550                            for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) {
     3551                                push @keys, $key if defined $$rawValue{$key};
     3552                                last if $i <= 0;
     3553                                $key = "$reqTag ($i)";
     3554                            }
     3555                            @keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup;
     3556                            if (@keys) {
     3557                                my $ex = $$self{TAG_EXTRA};
     3558                                # loop through tags in reverse order of precedence so the higher
     3559                                # priority tag will win in the case of duplicates within a doc
     3560                                $$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys;
     3561                            }
     3562                        }
     3563                        # (set $reqTag to a bogus key if not found)
     3564                        $reqTag = $$cacheTag[$doc] || "$reqTag (0)";
     3565                    } elsif ($reqTag =~ /^(.*):(.+)/) {
    23323566                        my ($reqGroup, $name) = ($1, $2);
    23333567                        if ($reqGroup eq 'Composite' and $notBuilt{$name}) {
    2334                             push @deferredTags, $tag;
    2335                             next COMPOSITE_TAG;
     3568                            # defer only until all other tags are built if
     3569                            # we are inhibiting based on another Composite tag
     3570                            unless ($$inhibit{$index} and $allBuilt) {
     3571                                push @deferredTags, $tag;
     3572                                next COMPOSITE_TAG;
     3573                            }
    23363574                        }
     3575                        # (CAREFUL! keys may not be sequential if one was deleted)
    23373576                        my ($i, $key, @keys);
    2338                         for ($i=0; ; ++$i) {
    2339                             $key = $name;
    2340                             $key .= " ($i)" if $i;
    2341                             last unless defined $$rawValue{$key};
    2342                             push @keys, $key;
     3577                        for ($key=$name, $i=$$self{DUPL_TAG}{$name} || 0; ; --$i) {
     3578                            push @keys, $key if defined $$rawValue{$key};
     3579                            last if $i <= 0;
     3580                            $key = "$name ($i)";
    23433581                        }
    23443582                        # find first matching tag
    23453583                        $key = $self->GroupMatches($reqGroup, \@keys);
    2346                         $reqTag = $key if $key;
    2347                     } elsif ($notBuilt{$reqTag}) {
     3584                        $reqTag = $key || "$name (0)";
     3585                    } elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) {
    23483586                        # calculate this tag later if it relies on another
    23493587                        # Composite tag which hasn't been calculated yet
     
    23523590                    }
    23533591                    if (defined $$rawValue{$reqTag}) {
    2354                         $found = 1;
     3592                        if ($$inhibit{$index}) {
     3593                            $found = 0;
     3594                            last;
     3595                        } else {
     3596                            $found = 1;
     3597                        }
    23553598                    } elsif ($$require{$index}) {
    23563599                        $found = 0;
     
    23593602                    $tagKey{$index} = $reqTag;
    23603603                }
    2361                 if ($doc) {
     3604                if ($docNum) {
    23623605                    if ($found) {
    2363                         $self->{DOC_NUM} = $doc;
     3606                        $$self{DOC_NUM} = $docNum;
     3607                        # save pointers to all used tag keys
     3608                        foreach (keys %tagKey) {
     3609                            $$compKeys{$_} or $$compKeys{$_} = [ ];
     3610                            push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ];
     3611                        }
    23643612                        $self->FoundTag($tagInfo, \%tagKey);
    2365                         delete $self->{DOC_NUM};
     3613                        delete $$self{DOC_NUM};
    23663614                    }
    2367                     next if ++$doc <= $self->{DOC_COUNT};
     3615                    next if ++$docNum <= $$self{DOC_COUNT};
    23683616                    last;
    23693617                } elsif ($found) {
    2370                     delete $notBuilt{$tag}; # this tag is OK to build now
     3618                    delete $notBuilt{$tagName}; # this tag is OK to build now
    23713619                    # keep track of all Require'd tag keys
    23723620                    foreach (keys %tagKey) {
     
    23743622                        # can be replaced (also eliminates keys with
    23753623                        # instance numbers which can't be replaced either)
    2376                         next unless $Image::ExifTool::Composite{$tagKey{$_}};
    2377                         my $keyRef = \$tagKey{$_};
    2378                         $tagsUsed{$$keyRef} or $tagsUsed{$$keyRef} = [ ];
    2379                         push @{$tagsUsed{$$keyRef}}, $keyRef;
     3624                        next unless $compositeID{$tagKey{$_}};
     3625                    }
     3626                    # save pointers to all used tag keys
     3627                    foreach (keys %tagKey) {
     3628                        $$compKeys{$_} or $$compKeys{$_} = [ ];
     3629                        push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ];
    23803630                    }
    23813631                    # save reference to tag key lookup as value for Composite tag
    23823632                    my $key = $self->FoundTag($tagInfo, \%tagKey);
    2383                     # check to see if we just replaced one of the tag keys we Require'd
    2384                     if (defined $key and $tagsUsed{$key}) {
    2385                         foreach (@{$tagsUsed{$key}}) {
    2386                             $$_ = $self->{MOVED_KEY};   # replace with new tag key
    2387                         }
    2388                         delete $tagsUsed{$key};         # can't be replaced again
     3633                } elsif (not defined $found) {
     3634                    delete $notBuilt{$tagName}; # tag can't be built anyway
     3635                }
     3636                last unless $subDoc;
     3637                # don't process sub-documents if there is no chance to build this tag
     3638                # (can be very time-consuming if there are many docs)
     3639                if (%$require) {
     3640                    foreach (keys %$require) {
     3641                        my $reqTag = $$require{$_};
     3642                        $reqTag =~ s/.*://;
     3643                        next COMPOSITE_TAG unless defined $$rawValue{$reqTag};
    23893644                    }
    2390                 } elsif (not defined $found) {
    2391                     delete $notBuilt{$tag}; # tag can't be built anyway
    2392                 }
    2393                 last unless $subDoc;
    2394                 $doc = 1;   # continue to process the 1st sub-document
     3645                    $docNum = 1;   # go ahead and process the 1st sub-document
     3646                } else {
     3647                    my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire;
     3648                    # at least one of the specified desire tags must exist
     3649                    foreach (@try) {
     3650                        my $desTag = $$desire{$_} or next;
     3651                        $desTag =~ s/.*://;
     3652                        defined $$rawValue{$desTag} and $docNum = 1, last;
     3653                    }
     3654                    last unless $docNum;
     3655                }
    23953656            }
    23963657        }
    23973658        last unless @deferredTags;
    23983659        if (@deferredTags == @tagList) {
    2399             # everything was deferred in the last pass,
    2400             # must be a circular dependency
    2401             warn "Circular dependency in Composite tags\n";
    2402             last;
     3660            if ($allBuilt) {
     3661                # everything was deferred in the last pass,
     3662                # must be a circular dependency
     3663                warn "Circular dependency in Composite tags\n";
     3664                last;
     3665            }
     3666            $allBuilt = 1;  # try once more, ignoring Composite Inhibit tags
    24033667        }
    24043668        @tagList = @deferredTags; # calculate deferred tags now
    24053669    }
    24063670    delete $$self{BuildingComposite};
     3671}
     3672
     3673#------------------------------------------------------------------------------
     3674# Get reference to Composite tag info hash
     3675# Inputs: 0) case-sensitive Composite tag name
     3676# Returns: tagInfo hash or undef
     3677sub GetCompositeTagInfo($)
     3678{
     3679    my $tag = shift;
     3680    return undef unless $compositeID{$tag};
     3681    return $Image::ExifTool::Composite{$compositeID{$tag}[0]};
    24073682}
    24083683
     
    24343709#         1) flag to return long description instead of type ('0' to return any recognized type)
    24353710# Returns: File type (or desc) or undef if extension not supported or if
    2436 #          description is the same as the input FileType.  In array
    2437 #          context, may return more than one file type if the file may be
    2438 #          different formats.  Returns list of all supported extensions if no
    2439 #          file specified
     3711#          description is the same as the input FileType.  In list context,
     3712#          may return more than one file type if the file may be different formats.
     3713#          Returns list of all supported extensions if no file specified
    24403714sub GetFileType(;$$)
    24413715{
     
    24503724            # return all supported types
    24513725            foreach (sort keys %fileTypeLookup) {
    2452                 push @types, $_ unless defined $moduleName{$_} and $moduleName{$_} eq '0';
     3726                my $module = $moduleName{$_};
     3727                $module = $moduleName{$fileTypeLookup{$_}} unless defined $module;
     3728                push @types, $_ unless defined $module and $module eq '0';
    24533729            }
    24543730        }
    24553731        return @types;
    24563732    }
    2457     my $fileType;
     3733    my ($fileType, $subType);
    24583734    my $fileExt = GetFileExtension($file);
    2459     $fileExt = uc($file) unless $fileExt;
     3735    unless ($fileExt) {
     3736        if ($file =~ s/ \((.*)\)$//) {
     3737            $subType = $1;
     3738            $fileExt = GetFileExtension($file);
     3739        }
     3740        $fileExt = uc($file) unless $fileExt;
     3741    }
    24603742    $fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type
    2461     $fileType = $fileTypeLookup{$fileType} unless ref $fileType or not $fileType;
     3743    $fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType;
    24623744    # return description if specified
    24633745    # (allow input $file to be a FileType for this purpose)
    24643746    if ($desc) {
    2465         return $fileType ? $$fileType[1] : $fileDescription{$file};
     3747        $desc = $fileType ? $$fileType[1] : $fileDescription{$file};
     3748        $desc .= ", $subType" if $subType;
     3749        return $desc;
    24663750    } elsif ($fileType and (not defined $desc or $desc ne '0')) {
    24673751        # return only supported file types
     
    24693753        undef $fileType if defined $mod and $mod eq '0';
    24703754    }
    2471     $fileType or return wantarray ? () : undef;
     3755    $fileType or return ();
    24723756    $fileType = $$fileType[0];      # get file type (or list of types)
    24733757    if (wantarray) {
     
    24873771    local $_;
    24883772    my $file = shift or return undef;
    2489     my $type = GetFileType($file) or return undef;
     3773    my ($type) = GetFileType($file) or return undef;
    24903774    if ($noWriteFile{$type}) {
    24913775        # can't write TIFF files with certain extensions (various RAW formats)
     
    24933777        return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext;
    24943778    }
    2495     return scalar(grep /^$type$/, @writeTypes);
     3779    unless (%writeTypes) {
     3780        $writeTypes{$_} = 1 foreach @writeTypes;
     3781    }
     3782    return $writeTypes{$type};
    24963783}
    24973784
     
    25133800# Functions below this are not part of the public API
    25143801
    2515 # Initialize member variables
     3802# Initialize member variables for reading or writing a new file
    25163803# Inputs: 0) ExifTool object reference
    25173804sub Init($)
     
    25213808    # delete all DataMember variables (lower-case names)
    25223809    foreach (keys %$self) {
    2523         /[a-z]/ and delete $self->{$_};
    2524     }
    2525     delete $self->{FOUND_TAGS};     # list of found tags
    2526     delete $self->{EXIF_DATA};      # the EXIF data block
    2527     delete $self->{EXIF_POS};       # EXIF position in file
    2528     delete $self->{FIRST_EXIF_POS}; # position of first EXIF in file
    2529     delete $self->{HTML_DUMP};      # html dump information
    2530     delete $self->{SET_GROUP1};     # group1 name override
    2531     delete $self->{DOC_NUM};        # current embedded document number
    2532     $self->{DOC_COUNT}  = 0;        # count of embedded documents processed
    2533     $self->{BASE}       = 0;        # base for offsets from start of file
    2534     $self->{FILE_ORDER} = { };      # * hash of tag order in file
    2535     $self->{VALUE}      = { };      # * hash of raw tag values
    2536     $self->{BOTH}       = { };      # * hash for Value/PrintConv values of Require'd tags
    2537     $self->{TAG_INFO}   = { };      # * hash of tag information
    2538     $self->{TAG_EXTRA}  = { };      # * hash of extra tag information (dynamic group names)
    2539     $self->{PRIORITY}   = { };      # * priority of current tags
    2540     $self->{LIST_TAGS}  = { };      # hash of tagInfo refs for active List-type tags
    2541     $self->{PROCESSED}  = { };      # hash of processed directory start positions
    2542     $self->{DIR_COUNT}  = { };      # count various types of directories
    2543     $self->{DUPL_TAG}   = { };      # last-used index for duplicate-tag keys
    2544     $self->{WARNED_ONCE}= { };      # WarnOnce() warnings already issued
    2545     $self->{PATH}       = [ ];      # current subdirectory path in file when reading
    2546     $self->{NUM_FOUND}  = 0;        # total number of tags found (incl. duplicates)
    2547     $self->{CHANGED}    = 0;        # number of tags changed (writer only)
    2548     $self->{INDENT}     = '  ';     # initial indent for verbose messages
    2549     $self->{PRIORITY_DIR} = '';     # the priority directory name
    2550     $self->{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories
    2551     $self->{TIFF_TYPE}  = '';       # type of TIFF data (APP1, TIFF, NEF, etc...)
    2552     $self->{Make}       = '';       # camera make
    2553     $self->{Model}      = '';       # camera model
    2554     $self->{CameraType} = '';       # Olympus camera type
     3810        /[a-z]/ and delete $$self{$_};
     3811    }
     3812    delete $$self{FOUND_TAGS};      # list of found tags
     3813    delete $$self{EXIF_DATA};       # the EXIF data block
     3814    delete $$self{EXIF_POS};        # EXIF position in file
     3815    delete $$self{FIRST_EXIF_POS};  # position of first EXIF in file
     3816    delete $$self{HTML_DUMP};       # html dump information
     3817    delete $$self{SET_GROUP0};      # group0 name override
     3818    delete $$self{SET_GROUP1};      # group1 name override
     3819    delete $$self{DOC_NUM};         # current embedded document number
     3820    $$self{DOC_COUNT}  = 0;         # count of embedded documents processed
     3821    $$self{BASE}       = 0;         # base for offsets from start of file
     3822    $$self{FILE_ORDER} = { };       # * hash of tag order in file ('*' = based on tag key)
     3823    $$self{VALUE}      = { };       # * hash of raw tag values
     3824    $$self{BOTH}       = { };       # * hash for Value/PrintConv values of Require'd tags
     3825    $$self{RATIONAL}   = { };       # * hash of original rational components
     3826    $$self{TAG_INFO}   = { };       # * hash of tag information
     3827    $$self{TAG_EXTRA}  = { };       # * hash of extra tag information (dynamic group names)
     3828    $$self{PRIORITY}   = { };       # * priority of current tags
     3829    $$self{LIST_TAGS}  = { };       # hash of tagInfo refs for active List-type tags
     3830    $$self{PROCESSED}  = { };       # hash of processed directory start positions
     3831    $$self{DIR_COUNT}  = { };       # count various types of directories
     3832    $$self{DUPL_TAG}   = { };       # last-used index for duplicate-tag keys
     3833    $$self{WARNED_ONCE}= { };       # WarnOnce() warnings already issued
     3834    $$self{WRITTEN}    = { };       # list of tags written (selected tags only)
     3835    $$self{FORCE_WRITE}= { };       # ForceWrite lookup (set from ForceWrite tag)
     3836    $$self{FOUND_DIR}  = { };       # hash of directory names found in file
     3837    $$self{COMP_KEYS}  = { };       # lookup for tag keys used in Composite tags
     3838    $$self{PATH}       = [ ];       # current subdirectory path in file when reading
     3839    $$self{NUM_FOUND}  = 0;         # total number of tags found (incl. duplicates)
     3840    $$self{CHANGED}    = 0;         # number of tags changed (writer only)
     3841    $$self{INDENT}     = '  ';      # initial indent for verbose messages
     3842    $$self{PRIORITY_DIR} = '';      # the priority directory name
     3843    $$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories
     3844    $$self{TIFF_TYPE}  = '';        # type of TIFF data (APP1, TIFF, NEF, etc...)
     3845    $$self{FMT_EXPR}   = undef;     # current advanced formatting expression
     3846    $$self{Make}       = '';        # camera make
     3847    $$self{Model}      = '';        # camera model
     3848    $$self{CameraType} = '';        # Olympus camera type
     3849    $$self{FileType}   = '';        # identified file type
    25553850    if ($self->Options('HtmlDump')) {
    25563851        require Image::ExifTool::HtmlDump;
    2557         $self->{HTML_DUMP} = new Image::ExifTool::HtmlDump;
     3852        $$self{HTML_DUMP} = new Image::ExifTool::HtmlDump;
    25583853    }
    25593854    # make sure our TextOut is a file reference
    2560     $self->{OPTIONS}{TextOut} = \*STDOUT unless ref $self->{OPTIONS}{TextOut};
     3855    $$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut};
     3856}
     3857
     3858#------------------------------------------------------------------------------
     3859# Combine information from a list of info hashes
     3860# Unless Duplicates is enabled, first entry found takes priority
     3861# Inputs: 0) ExifTool object reference, 1-N) list of info hash references
     3862# Returns: Combined information hash reference
     3863sub CombineInfo($;@)
     3864{
     3865    local $_;
     3866    my $self = shift;
     3867    my (%combinedInfo, $info, $tag, %haveInfo);
     3868
     3869    if ($$self{OPTIONS}{Duplicates}) {
     3870        while ($info = shift) {
     3871            foreach $tag (keys %$info) {
     3872                $combinedInfo{$tag} = $$info{$tag};
     3873            }
     3874        }
     3875    } else {
     3876        while ($info = shift) {
     3877            foreach $tag (keys %$info) {
     3878                my $tagName = GetTagName($tag);
     3879                next if $haveInfo{$tagName};
     3880                $haveInfo{$tagName} = 1;
     3881                $combinedInfo{$tag} = $$info{$tag};
     3882            }
     3883        }
     3884    }
     3885    return \%combinedInfo;
     3886}
     3887
     3888#------------------------------------------------------------------------------
     3889# Get tag table name
     3890# Inputs: 0) ExifTool object reference, 1) tag key
     3891# Returns: Table name if available, otherwise ''
     3892sub GetTableName($$)
     3893{
     3894    my ($self, $tag) = @_;
     3895    my $tagInfo = $$self{TAG_INFO}{$tag} or return '';
     3896    return $$tagInfo{Table}{SHORT_NAME};
     3897}
     3898
     3899#------------------------------------------------------------------------------
     3900# Get tag index number
     3901# Inputs: 0) ExifTool object reference, 1) tag key
     3902# Returns: Table index number, or undefined if this tag isn't indexed
     3903sub GetTagIndex($$)
     3904{
     3905    my ($self, $tag) = @_;
     3906    my $tagInfo = $$self{TAG_INFO}{$tag} or return undef;
     3907    return $$tagInfo{Index};
     3908}
     3909
     3910#------------------------------------------------------------------------------
     3911# Find value for specified tag
     3912# Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1)
     3913# Returns: value or undef
     3914sub FindValue($$$)
     3915{
     3916    my ($et, $tag, $grp) = @_;
     3917    my ($i, $val);
     3918    my $value = $$et{VALUE};
     3919    for ($i=0; ; ++$i) {
     3920        my $key = $tag . ($i ? " ($i)" : '');
     3921        last unless defined $$value{$key};
     3922        if ($et->GetGroup($key, 1) eq $grp) {
     3923            $val = $$value{$key};
     3924            last;
     3925        }
     3926    }
     3927    return $val;
     3928}
     3929
     3930#------------------------------------------------------------------------------
     3931# Get tag key for next existing tag
     3932# Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name
     3933# Returns: Key of next existing tag, or undef if no more
     3934# Notes: This routine is provided for iterating through duplicate tags in the
     3935#        ValueConv of Composite tags.
     3936sub NextTagKey($$)
     3937{
     3938    my ($self, $tag) = @_;
     3939    my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1;
     3940    $tag = "$tag ($i)";
     3941    return $tag if defined $$self{VALUE}{$tag};
     3942    return undef;
     3943}
     3944
     3945#------------------------------------------------------------------------------
     3946# Split file name into directory and name parts
     3947# Inptus: 0) file name
     3948# Returns: 0) directory, 1) filename
     3949sub SplitFileName($)
     3950{
     3951    my $file = shift;
     3952    my ($dir, $name);
     3953    if (eval { require File::Basename }) {
     3954        $dir = File::Basename::dirname($file);
     3955        $name = File::Basename::basename($file);
     3956    } else {
     3957        ($name = $file) =~ tr/\\/\//;
     3958        # remove path
     3959        $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///;
     3960    }
     3961    return ($dir, $name);
     3962}
     3963
     3964#------------------------------------------------------------------------------
     3965# Encode file name for calls to system i/o routines
     3966# Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion
     3967# Returns: true if Windows Unicode routines should be used (in which case
     3968#          the file name will be encoded as a null-terminated UTF-16LE string)
     3969sub EncodeFileName($$;$)
     3970{
     3971    my ($self, $file, $force) = @_;
     3972    my $enc = $$self{OPTIONS}{CharsetFileName};
     3973    if ($enc) {
     3974        if ($file =~ /[\x80-\xff]/ or $force) {
     3975            # encode for use in Windows Unicode functions if necessary
     3976            if ($^O eq 'MSWin32') {
     3977                local $SIG{'__WARN__'} = \&SetWarning;
     3978                if (eval { require Win32API::File }) {
     3979                    # recode as UTF-16LE and add null terminator
     3980                    $_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0";
     3981                    return 1;
     3982                }
     3983                $self->WarnOnce('Install Win32API::File for Windows Unicode file support');
     3984            } else {
     3985                # recode as UTF-8 for other platforms if necessary
     3986                $_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8';
     3987            }
     3988        }
     3989    } elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) {
     3990        require Image::ExifTool::XMP;
     3991        if (Image::ExifTool::XMP::IsUTF8(\$file) < 0) {
     3992            $self->WarnOnce('FileName encoding not specified');
     3993        }
     3994    }
     3995    return 0;
     3996}
     3997
     3998#------------------------------------------------------------------------------
     3999# Modified perl open() routine to properly handle special characters in file names
     4000# Inputs: 0) ExifTool ref, 1) filehandle, 2) filename,
     4001#         3) mode: '<' or undef = read, '>' = write, '+<' = update
     4002# Returns: true on success
     4003# Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid
     4004#       "unopened filehandle" errors due to a change in scope of the filehandle
     4005sub Open($*$;$)
     4006{
     4007    my ($self, $fh, $file, $mode) = @_;
     4008
     4009    $file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand
     4010    # default to read mode ('<') unless input is a pipe
     4011    $mode = ($file =~ /\|$/ ? '' : '<') unless $mode;
     4012    if ($mode) {
     4013        if ($self->EncodeFileName($file)) {
     4014            # handle Windows Unicode file name
     4015            local $SIG{'__WARN__'} = \&SetWarning;
     4016            my ($access, $create);
     4017            if ($mode eq '>') {
     4018                eval {
     4019                    $access  = Win32API::File::GENERIC_WRITE();
     4020                    $create  = Win32API::File::CREATE_ALWAYS();
     4021                }
     4022            } else {
     4023                eval {
     4024                    $access  = Win32API::File::GENERIC_READ();
     4025                    $access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update
     4026                    $create  = Win32API::File::OPEN_EXISTING();
     4027                }
     4028            }
     4029            my $share = 0;
     4030            eval {
     4031                unless ($access & Win32API::File::GENERIC_WRITE()) {
     4032                    $share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE();
     4033                }
     4034            };
     4035            my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) };
     4036            return undef unless $wh;
     4037            my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) };
     4038            if (not defined $fd or $fd < 0) {
     4039                eval { Win32API::File::CloseHandle($wh) };
     4040                return undef;
     4041            }
     4042            $file = "&=$fd";    # specify file by descriptor
     4043        } else {
     4044            # add leading space to protect against leading characters like '>'
     4045            # in file name, and trailing "\0" to protect trailing spaces
     4046            $file = " $file\0";
     4047        }
     4048    }
     4049    return open $fh, "$mode$file";
     4050}
     4051
     4052#------------------------------------------------------------------------------
     4053# Check to see if a file exists (with Windows Unicode support)
     4054# Inputs: 0) ExifTool ref, 1) file name
     4055# Returns: true if file exists
     4056sub Exists($$)
     4057{
     4058    my ($self, $file) = @_;
     4059
     4060    if ($self->EncodeFileName($file)) {
     4061        local $SIG{'__WARN__'} = \&SetWarning;
     4062        my $wh = eval { Win32API::File::CreateFileW($file,
     4063                        Win32API::File::GENERIC_READ(),
     4064                        Win32API::File::FILE_SHARE_READ(), [],
     4065                        Win32API::File::OPEN_EXISTING(), 0, []) };
     4066        return 0 unless $wh;
     4067        eval { Win32API::File::CloseHandle($wh) };
     4068    } else {
     4069        return -e $file;
     4070    }
     4071    return 1;
     4072}
     4073
     4074#------------------------------------------------------------------------------
     4075# Return true if file is a directory (with Windows Unicode support)
     4076# Inputs: 0) ExifTool ref, 1) file name
     4077# Returns: true if file is a directory (false if file isn't, or doesn't exist)
     4078sub IsDirectory($$)
     4079{
     4080    my ($et, $file) = @_;
     4081    if ($et->EncodeFileName($file)) {
     4082        local $SIG{'__WARN__'} = \&SetWarning;
     4083        my $attrs = eval { Win32API::File::GetFileAttributesW($file) };
     4084        my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0;
     4085        return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit;
     4086    } else {
     4087        return -d $file;
     4088    }
     4089    return 0;
     4090}
     4091
     4092#------------------------------------------------------------------------------
     4093# Get file times (Unix seconds since the epoch)
     4094# Inputs: 0) ExifTool ref, 1) file name or ref
     4095# Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error)
     4096my $k32GetFileTime;
     4097sub GetFileTime($$)
     4098{
     4099    my ($self, $file) = @_;
     4100
     4101    # open file by name if necessary
     4102    unless (ref $file) {
     4103        local *FH;
     4104        unless ($self->Open(\*FH, $file)) {
     4105            if ($self->IsDirectory($file)) {
     4106                my @rtn = (stat $file)[8, 9, 10];
     4107                return @rtn if defined $rtn[0];
     4108            }
     4109            $self->Warn("GetFileTime error for '${file}'");
     4110            return ();
     4111        }
     4112        $file = *FH;  # (not \*FH, so *FH will be kept open until $file goes out of scope)
     4113    }
     4114    # on Windows, try to work around incorrect file times when daylight saving time is in effect
     4115    if ($^O eq 'MSWin32') {
     4116        if (not eval { require Win32::API }) {
     4117            $self->WarnOnce('Install Win32::API for proper handling of Windows file times');
     4118        } elsif (not eval { require Win32API::File }) {
     4119            $self->WarnOnce('Install Win32API::File for proper handling of Windows file times');
     4120        } else {
     4121            # get Win32 handle, needed for GetFileTime
     4122            my $win32Handle = eval { Win32API::File::GetOsFHandle($file) };
     4123            unless ($win32Handle) {
     4124                $self->Warn("Win32API::File::GetOsFHandle returned invalid handle");
     4125                return ();
     4126            }
     4127            # get FILETIME structs
     4128            my ($atime, $mtime, $ctime, $time);
     4129            $atime = $mtime = $ctime = pack 'LL', 0, 0;
     4130            unless ($k32GetFileTime) {
     4131                return () if defined $k32GetFileTime;
     4132                $k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I');
     4133                unless ($k32GetFileTime) {
     4134                    $self->Warn('Error calling Win32::API::GetFileTime');
     4135                    $k32GetFileTime = 0;
     4136                    return ();
     4137                }
     4138            }
     4139            unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) {
     4140                $self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError());
     4141                return ();
     4142            }
     4143            # convert FILETIME structs to Unix seconds
     4144            foreach $time ($atime, $mtime, $ctime) {
     4145                my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct
     4146                # FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601
     4147                # (89 leap years between 1601 and 1970)
     4148                $time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600);
     4149            }
     4150            return ($atime, $mtime, $ctime);
     4151        }
     4152    }
     4153    # other os (or Windows fallback)
     4154    return (stat $file)[8, 9, 10];
    25614155}
    25624156
     
    25684162{
    25694163    my $self = shift;
    2570     my $options = $self->{OPTIONS};
    2571     my @exclude;
    2572     my @oldGroupOpts = grep /^Group/, keys %{$self->{OPTIONS}};
    2573     my $wasExcludeOpt;
    2574 
    2575     $self->{REQUESTED_TAGS} = [ ];
    2576     $self->{REQ_TAG_LOOKUP} = { };
    2577     $self->{IO_TAG_LIST} = undef;
     4164    my $options = $$self{OPTIONS};
     4165    my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}};
     4166    my (@exclude, $wasExcludeOpt);
     4167
     4168    $$self{REQUESTED_TAGS}  = [ ];
     4169    $$self{REQ_TAG_LOOKUP}  = { };
     4170    $$self{EXCL_TAG_LOOKUP} = { };
     4171    $$self{IO_TAG_LIST} = undef;
    25784172
    25794173    # handle our input arguments
    25804174    while (@_) {
    25814175        my $arg = shift;
    2582         if (ref $arg) {
     4176        if (ref $arg and not overload::Method($arg, q[""])) {
    25834177            if (ref $arg eq 'ARRAY') {
    2584                 $self->{IO_TAG_LIST} = $arg;
     4178                $$self{IO_TAG_LIST} = $arg;
    25854179                foreach (@$arg) {
    25864180                    if (/^-(.*)/) {
    25874181                        push @exclude, $1;
    25884182                    } else {
    2589                         push @{$self->{REQUESTED_TAGS}}, $_;
     4183                        push @{$$self{REQUESTED_TAGS}}, $_;
    25904184                    }
    25914185                }
     
    25964190                    if (@oldGroupOpts and $opt =~ /^Group/) {
    25974191                        foreach (@oldGroupOpts) {
    2598                             delete $options->{$_};
     4192                            delete $$options{$_};
    25994193                        }
    26004194                        undef @oldGroupOpts;
     
    26044198                }
    26054199            } elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) {
    2606                 next if defined $self->{RAF};
     4200                next if defined $$self{RAF};
    26074201                # convert image data from UTF-8 to character stream if necessary
    26084202                # (patches RHEL 3 UTF8 LANG problem)
    26094203                if (ref $arg eq 'SCALAR' and $] >= 5.006 and
    2610                     (eval 'require Encode; Encode::is_utf8($$arg)' or $@))
     4204                    (eval { require Encode; Encode::is_utf8($$arg) } or $@))
    26114205                {
    26124206                    # repack by hand if Encode isn't available
    2613                     my $buff = $@ ? pack('C*',unpack('U0C*',$$arg)) : Encode::encode('utf8',$$arg);
     4207                    my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg);
    26144208                    $arg = \$buff;
    26154209                }
    2616                 $self->{RAF} = new File::RandomAccess($arg);
     4210                $$self{RAF} = new File::RandomAccess($arg);
    26174211                # set filename to empty string to indicate that
    26184212                # we have a file but we didn't open it
    2619                 $self->{FILENAME} = '';
     4213                $$self{FILENAME} = '';
    26204214            } elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) {
    2621                 $self->{RAF} = $arg;
    2622                 $self->{FILENAME} = '';
     4215                $$self{RAF} = $arg;
     4216                $$self{FILENAME} = '';
    26234217            } else {
    26244218                warn "Don't understand ImageInfo argument $arg\n";
    26254219            }
    2626         } elsif (defined $self->{FILENAME}) {
     4220        } elsif (defined $$self{FILENAME}) {
    26274221            if ($arg =~ /^-(.*)/) {
    26284222                push @exclude, $1;
    26294223            } else {
    2630                 push @{$self->{REQUESTED_TAGS}}, $arg;
     4224                push @{$$self{REQUESTED_TAGS}}, $arg;
    26314225            }
    26324226        } else {
    2633             $self->{FILENAME} = $arg;
    2634         }
     4227            $$self{FILENAME} = $arg;
     4228        }
     4229    }
     4230    # add additional requested tags to lookup
     4231    if ($$options{RequestTags}) {
     4232        $$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}};
    26354233    }
    26364234    # expand shortcuts in tag arguments if provided
    2637     if (@{$self->{REQUESTED_TAGS}}) {
    2638         ExpandShortcuts($self->{REQUESTED_TAGS});
     4235    if (@{$$self{REQUESTED_TAGS}}) {
     4236        ExpandShortcuts($$self{REQUESTED_TAGS});
    26394237        # initialize lookup for requested tags
    2640         foreach (@{$self->{REQUESTED_TAGS}}) {
    2641             $self->{REQ_TAG_LOOKUP}{lc(/.+:(.+)/ ? $1 : $_)} = 1;
    2642         }
    2643     }
    2644 
     4238        foreach (@{$$self{REQUESTED_TAGS}}) {
     4239            /^(.*:)?([-\w?*]*)#?$/ or next;
     4240            $$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2;
     4241            next unless $1;
     4242            $$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1;
     4243        }
     4244    }
    26454245    if (@exclude or $wasExcludeOpt) {
    26464246        # must add existing excluded tags
    2647         if ($options->{Exclude}) {
    2648             if (ref $options->{Exclude} eq 'ARRAY') {
    2649                 push @exclude, @{$options->{Exclude}};
    2650             } else {
    2651                 push @exclude, $options->{Exclude};
    2652             }
    2653         }
    2654         $options->{Exclude} = \@exclude;
     4247        push @exclude, @{$$options{Exclude}} if $$options{Exclude};
     4248        $$options{Exclude} = \@exclude;
    26554249        # expand shortcuts in new exclude list
    2656         ExpandShortcuts($options->{Exclude}, 1); # (also remove '#' suffix)
    2657     }
     4250        ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix)
     4251    }
     4252    # generate lookup for excluded tags
     4253    if ($$options{Exclude}) {
     4254        foreach (@{$$options{Exclude}}) {
     4255            /([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc($1)} = 1;
     4256        }
     4257        # exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set
     4258        undef $$options{Exclude} if $$self{TAGS_FROM_FILE};
     4259    }
     4260}
     4261
     4262#------------------------------------------------------------------------------
     4263# Does group name match the tag ID?
     4264# Inputs: 0) tag ID, 1) group name (with "ID-" removed)
     4265# Returns: true on success
     4266sub IsSameID($$)
     4267{
     4268    my ($id, $grp) = @_;
     4269    return 1 if $grp eq $id;    # decimal ID's or raw ID's
     4270    if ($id =~ /^\d+$/) {       # numerical numerical ID's may be in hex
     4271        return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id);
     4272    } else {                    # other ID's may conform to ExifTool group name conventions
     4273        return 1 if $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $id;
     4274    }
     4275    return 0;
    26584276}
    26594277
     
    26694287    $tagList = [ $tagList ] unless ref $tagList;
    26704288    my ($tag, @matches);
    2671     if ($group =~ /:/) {
    2672         # check each group name individually (ie. "Author:1IPTC")
    2673         my @grps = split ':', lc $group;
    2674         my (@fmys, $g);
     4289    # check each group name individually (eg. "Author:1IPTC")
     4290    my @grps = split ':', $group;
     4291    my (@fmys, $g);
     4292    for ($g=0; $g<@grps; ++$g) {
     4293        if ($grps[$g] =~ s/^(\d*)(id-)?//i) {
     4294            $fmys[$g] = $1 if length $1;
     4295            if ($2) {
     4296                $fmys[$g] = 7;
     4297                next;   # (don't convert tag ID's to lower case)
     4298            }
     4299        }
     4300        $grps[$g] = lc $grps[$g];
     4301        $grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag
     4302    }
     4303    foreach $tag (@$tagList) {
     4304        my @groups = $self->GetGroup($tag, -1);
    26754305        for ($g=0; $g<@grps; ++$g) {
    2676             $fmys[$g] = $1 if $grps[$g] =~ s/^(\d+)//;
    2677         }
    2678         foreach $tag (@$tagList) {
    2679             my @groups = $self->GetGroup($tag, -1);
    2680             for ($g=0; $g<@grps; ++$g) {
    2681                 my $grp = $grps[$g];
    2682                 next if $grp eq '*' or $grp eq 'all';
    2683                 if (defined $fmys[$g]) {
    2684                     my $f = $fmys[$g];
    2685                     last unless $groups[$f] and $grps[$g] eq lc $groups[$f];
     4306            my $grp = $grps[$g];
     4307            next if $grp eq '*' or $grp eq 'all';
     4308            my $f;
     4309            if (defined($f = $fmys[$g])) {
     4310                last unless defined $groups[$f];
     4311                if ($f == 7) {
     4312                    next if IsSameID($self->GetTagID($tag), $grp);
    26864313                } else {
    2687                     last unless grep /^$grps[$g]$/i, @groups;
    2688                 }
    2689             }
    2690             push @matches, $tag if $g == @grps;
     4314                    next if $grp eq lc $groups[$f];
     4315                }
     4316                last;
     4317            } else {
     4318                last unless grep /^$grp$/i, @groups;
     4319            }
     4320        }
     4321        if ($g == @grps) {
     4322            return $tag unless wantarray;
     4323            push @matches, $tag;
     4324        }
     4325    }
     4326    return wantarray ? @matches : $matches[0];
     4327}
     4328
     4329#------------------------------------------------------------------------------
     4330# Remove specified tags from returned tag list, updating indices in other lists
     4331# Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref,
     4332#         4) true to include tags from hash instead of excluding
     4333# Returns: nothing, but updates input lists
     4334sub RemoveTagsFromList($$$$;$)
     4335{
     4336    local $_;
     4337    my ($tags, $list1, $list2, $exclude, $inv) = @_;
     4338    my @filteredTags;
     4339
     4340    if (@$list1 or @$list2) {
     4341        while (@$tags) {
     4342            my $tag = pop @$tags;
     4343            my $i = @$tags;
     4344            if ($$exclude{$tag} xor $inv) {
     4345                # remove index of excluded tag from each list
     4346                @$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1;
     4347                @$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2;
     4348            } else {
     4349                unshift @filteredTags, $tag;
     4350            }
    26914351        }
    26924352    } else {
    2693         my $family = ($group =~ s/^(\d+)//) ? $1 : -1;
    2694         foreach $tag (@$tagList) {
    2695             my @groups = $self->GetGroup($tag, $family);
    2696             push @matches, $tag if grep(/^$group$/i, @groups);
    2697         }
    2698     }
    2699     return wantarray ? @matches : $matches[0];
     4353        foreach (@$tags) {
     4354            push @filteredTags, $_ unless $$exclude{$_} xor $inv;
     4355        }
     4356    }
     4357    $_[0] = \@filteredTags;     # update tag list
    27004358}
    27014359
     
    27054363# Returns: 0) Reference to list of found tag keys (in order of requested tags)
    27064364#          1) Reference to list of indices for tags requested by value
     4365#          2) Reference to list of indices for tags specified by wildcard or "all"
     4366# Notes: index lists are returned in increasing order
    27074367sub SetFoundTags($)
    27084368{
    27094369    my $self = shift;
    2710     my $options = $self->{OPTIONS};
    2711     my $reqTags = $self->{REQUESTED_TAGS} || [ ];
    2712     my $duplicates = $options->{Duplicates};
    2713     my $exclude = $options->{Exclude};
    2714     my $fileOrder = $self->{FILE_ORDER};
     4370    my $options = $$self{OPTIONS};
     4371    my $reqTags = $$self{REQUESTED_TAGS} || [ ];
     4372    my $duplicates = $$options{Duplicates};
     4373    my $exclude = $$options{Exclude};
     4374    my $fileOrder = $$self{FILE_ORDER};
    27154375    my @groupOptions = sort grep /^Group/, keys %$options;
    27164376    my $doDups = $duplicates || $exclude || @groupOptions;
    2717     my ($tag, $rtnTags, @byValue);
     4377    my ($tag, $rtnTags, @byValue, @wildTags);
    27184378
    27194379    # only return requested tags if specified
     
    27214381        $rtnTags or $rtnTags = [ ];
    27224382        # scan through the requested tags and generate a list of tags we found
    2723         my $tagHash = $self->{VALUE};
     4383        my $tagHash = $$self{VALUE};
    27244384        my $reqTag;
    27254385        foreach $reqTag (@$reqTags) {
     
    27304390                    $allGrp = 1;
    27314391                } elsif ($group !~ /^[-\w:]*$/) {
    2732                     $self->Warn("Invalid group name '$group'");
     4392                    $self->Warn("Invalid group name '${group}'");
    27334393                    $group = 'invalid';
    27344394                }
     
    27364396                $tag = $reqTag;
    27374397            }
    2738             $byValue = 1 if $tag =~ s/#$//;
    2739             if (defined $tagHash->{$reqTag} and not $doDups) {
     4398            $byValue = 1 if $tag =~ s/#$// and $$options{PrintConv};
     4399            if (defined $$tagHash{$reqTag} and not $doDups) {
    27404400                $matches[0] = $tag;
    27414401            } elsif ($tag =~ /^(\*|all)$/i) {
    27424402                # tag name of '*' or 'all' matches all tags
    27434403                if ($doDups or $allGrp) {
    2744                     @matches = keys %$tagHash;
     4404                    @matches = grep(!/#/, keys %$tagHash);
    27454405                } else {
    27464406                    @matches = grep(!/ /, keys %$tagHash);
     
    27524412                $tag =~ s/\*/[-\\w]*/g;
    27534413                $tag =~ s/\?/[-\\w]/g;
    2754                 $tag .= '( .*)?' if $doDups or $allGrp;
     4414                $tag .= '( \\(.*)?' if $doDups or $allGrp;
    27554415                @matches = grep(/^$tag$/i, keys %$tagHash);
    27564416                next unless @matches;   # don't want entry in list for wildcard tags
     
    27584418            } elsif ($doDups or defined $group) {
    27594419                # must also look for tags like "Tag (1)"
    2760                 @matches = grep(/^$tag( |$)/i, keys %$tagHash);
     4420                # (but be sure not to match temporary ValueConv entries like "Tag #")
     4421                @matches = grep(/^$tag( \(|$)/i, keys %$tagHash);
    27614422            } elsif ($tag =~ /^[-\w]+$/) {
    27624423                # find first matching value
     
    27654426                defined $matches[0] or undef @matches;
    27664427            } else {
    2767                 $self->Warn("Invalid tag name '$tag'");
     4428                $self->Warn("Invalid tag name '${tag}'");
    27684429            }
    27694430            if (defined $group and not $allGrp) {
     
    27784439                unless ($doDups or $allTag or $allGrp) {
    27794440                    $tag = shift @matches;
    2780                     my $oldPriority = $self->{PRIORITY}{$tag} || 1;
     4441                    my $oldPriority = $$self{PRIORITY}{$tag} || 1;
    27814442                    foreach (@matches) {
    2782                         my $priority = $self->{PRIORITY}{$_};
     4443                        my $priority = $$self{PRIORITY}{$_};
    27834444                        $priority = 1 unless defined $priority;
    27844445                        next unless $priority >= $oldPriority;
     
    27904451            } elsif (not @matches) {
    27914452                # put entry in return list even without value (value is undef)
    2792                 $matches[0] = "$tag (0)";
     4453                $matches[0] = $byValue ? "$tag #(0)" : "$tag (0)";
    27934454                # bogus file order entry to avoid warning if sorting in file order
    2794                 $self->{FILE_ORDER}{$matches[0]} = 999;
     4455                $$self{FILE_ORDER}{$matches[0]} = 9999;
    27954456            }
    27964457            # save indices of tags extracted by value
    27974458            push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue;
     4459            # save indices of wildcard tags
     4460            push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag;
    27984461            push @$rtnTags, @matches;
    27994462        }
     
    28024465        my @allTags;
    28034466        if ($doDups) {
    2804             @allTags = keys %{$self->{VALUE}};
     4467            @allTags = keys %{$$self{VALUE}};
    28054468        } else {
    2806             foreach (keys %{$self->{VALUE}}) {
    2807                 # only include tag if it doesn't end in a copy number
    2808                 push @allTags, $_ unless / /;
    2809             }
     4469            # only include tag if it doesn't end in a copy number
     4470            @allTags = grep(!/ /, keys %{$$self{VALUE}});
    28104471        }
    28114472        $rtnTags = \@allTags;
     
    28234484                        undef $group;
    28244485                    } elsif ($group !~ /^[-\w:]*$/) {
    2825                         $self->Warn("Invalid group name '$group'");
     4486                        $self->Warn("Invalid group name '${group}'");
    28264487                        $group = 'invalid';
    28274488                    }
     
    28424503            }
    28434504            if (%exclude) {
    2844                 my @filteredTags;
    2845                 $exclude{$_} or push @filteredTags, $_ foreach @$rtnTags;
    2846                 $rtnTags = \@filteredTags;      # use new filtered tag list
    2847                 last unless @filteredTags;      # all done if nothing left
     4505                # remove excluded tags from return list(s)
     4506                RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude);
     4507                last unless @$rtnTags;      # all done if nothing left
    28484508            }
    28494509            last if $duplicates and not @groupOptions;
     
    28594519            $wantGroup{$family} or $wantGroup{$family} = { };
    28604520            my $groupList;
    2861             if (ref $options->{$groupOpt} eq 'ARRAY') {
    2862                 $groupList = $options->{$groupOpt};
     4521            if (ref $$options{$groupOpt} eq 'ARRAY') {
     4522                $groupList = $$options{$groupOpt};
    28634523            } else {
    2864                 $groupList = [ $options->{$groupOpt} ];
     4524                $groupList = [ $$options{$groupOpt} ];
    28654525            }
    28664526            foreach (@$groupList) {
     
    28944554            }
    28954555            next unless $wantTag;
    2896             if ($duplicates) {
    2897                 push @tags, $tag;
    2898             } else {
    2899                 my $tagName = GetTagName($tag);
    2900                 my $bestTag = $bestTag{$tagName};
    2901                 if (defined $bestTag) {
    2902                     next if $wantTag > $keepTags{$bestTag};
    2903                     if ($wantTag == $keepTags{$bestTag}) {
    2904                         # want two tags with the same name -- keep the latest one
    2905                         if ($tag =~ / \((\d+)\)$/) {
    2906                             my $tagNum = $1;
    2907                             next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum;
    2908                         }
     4556            $duplicates and $keepTags{$tag} = 1, next;
     4557            # determine which tag we want to keep
     4558            my $tagName = GetTagName($tag);
     4559            my $bestTag = $bestTag{$tagName};
     4560            if (defined $bestTag) {
     4561                next if $wantTag > $keepTags{$bestTag};
     4562                if ($wantTag == $keepTags{$bestTag}) {
     4563                    # want two tags with the same name -- keep the latest one
     4564                    if ($tag =~ / \((\d+)\)$/) {
     4565                        my $tagNum = $1;
     4566                        next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum;
    29094567                    }
    2910                     # this tag is better, so delete old best tag
    2911                     delete $keepTags{$bestTag};
    2912                 }
    2913                 $keepTags{$tag} = $wantTag;    # keep this tag (for now...)
    2914                 $bestTag{$tagName} = $tag;      # this is our current best tag
    2915             }
    2916         }
    2917         unless ($duplicates) {
    2918             # construct new tag list with no duplicates, preserving order
    2919             foreach $tag (@$rtnTags) {
    2920                 push @tags, $tag if $keepTags{$tag};
    2921             }
    2922         }
    2923         $rtnTags = \@tags;
     4568                }
     4569                # this tag is better, so delete old best tag
     4570                delete $keepTags{$bestTag};
     4571            }
     4572            $keepTags{$tag} = $wantTag;     # keep this tag (for now...)
     4573            $bestTag{$tagName} = $tag;      # this is our current best tag
     4574        }
     4575        # include only tags we want to keep in return lists
     4576        RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1);
    29244577        last;
    29254578    }
    2926     $self->{FOUND_TAGS} = $rtnTags;     # save found tags
     4579    $$self{FOUND_TAGS} = $rtnTags;      # save found tags
    29274580
    29284581    # return reference to found tag keys (and list of indices of tags to extract by value)
    2929     return wantarray ? ($rtnTags, \@byValue) : $rtnTags;
     4582    return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags;
    29304583}
    29314584
     
    29344587# Inputs: 0) autoload function, 1-N) function arguments
    29354588# Returns: result of function or dies if function not available
    2936 # To Do: Generalize this routine so it works on systems that don't use '/'
    2937 #        as a path name separator.
    29384589sub DoAutoLoad(@)
    29394590{
     
    29464597        # load Image/ExifTool/WriteMODULE.pl
    29474598        $file .= "$callInfo[2].pl";
     4599    } elsif ($callInfo[-1] eq 'ShiftTime') {
     4600        $file = 'Image/ExifTool/Shift.pl';  # load Shift.pl
    29484601    } else {
    29494602        # load Image/ExifTool/Writer.pl
     
    29514604    }
    29524605    # attempt to load the package
    2953     eval "require '$file'" or die "Error while attempting to call $autoload\n$@\n";
     4606    eval { require $file } or die "Error while attempting to call $autoload\n$@\n";
    29544607    unless (defined &$autoload) {
    29554608        my @caller = caller(0);
     
    29714624#------------------------------------------------------------------------------
    29724625# Add warning tag
    2973 # Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor
     4626# Inputs: 0) ExifTool object reference, 1) warning message
     4627#         2) true if minor (2 if behaviour changes when warning is ignored,
     4628#            or 3 if warning shouldn't be issued when Validate option is used)
    29744629# Returns: true if warning tag was added
    29754630sub Warn($$;$)
     
    29774632    my ($self, $str, $ignorable) = @_;
    29784633    if ($ignorable) {
    2979         return 0 if $self->{OPTIONS}{IgnoreMinorErrors};
    2980         $str = "[minor] $str";
     4634        return 0 if $$self{OPTIONS}{IgnoreMinorErrors};
     4635        return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate};
     4636        $str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str";
    29814637    }
    29824638    $self->FoundTag('Warning', $str);
     
    29914647{
    29924648    my ($self, $str, $ignorable) = @_;
    2993     return 0 if $ignorable and $self->{OPTIONS}{IgnoreMinorErrors};
     4649    return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors};
    29944650    unless ($$self{WARNED_ONCE}{$str}) {
    29954651        $self->Warn($str, $ignorable);
     
    30064662{
    30074663    my ($self, $str, $ignorable) = @_;
    3008     if ($ignorable) {
    3009         if ($self->{OPTIONS}{IgnoreMinorErrors}) {
    3010             $self->Warn($str);
    3011             return 0;
    3012         }
     4664    if ($$self{DemoteErrors}) {
     4665        $self->Warn($str) and ++$$self{DemoteErrors};
     4666        return 1;
     4667    } elsif ($ignorable) {
     4668        $$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0;
    30134669        $str = "[minor] $str";
    30144670    }
     
    31164772# Add hash of Composite tags to our composites
    31174773# Inputs: 0) hash reference to table of Composite tags to add or module name,
    3118 #         1) overwrite existing tag
     4774#         1) override existing tag definition
    31194775sub AddCompositeTags($;$)
    31204776{
    31214777    local $_;
    3122     my ($add, $overwrite) = @_;
    3123     my $module;
     4778    my ($add, $override) = @_;
     4779    my ($module, $prefix, $tagID);
    31244780    unless (ref $add) {
     4781        ($prefix = $add) =~ s/.*:://;
    31254782        $module = $add;
    31264783        $add .= '::Composite';
    31274784        no strict 'refs';
    31284785        $add = \%$add;
     4786        $prefix .= '-';
     4787    } else {
     4788        $prefix = 'UserDefined-';
    31294789    }
    31304790    my $defaultGroups = $$add{GROUPS};
     4791    my $compTable = GetTagTable('Image::ExifTool::Composite');
    31314792
    31324793    # make sure default groups are defined in families 0 and 1
    31334794    if ($defaultGroups) {
    3134         $defaultGroups->{0} or $defaultGroups->{0} = 'Composite';
    3135         $defaultGroups->{1} or $defaultGroups->{1} = 'Composite';
    3136         $defaultGroups->{2} or $defaultGroups->{2} = 'Other';
     4795        $$defaultGroups{0} or $$defaultGroups{0} = 'Composite';
     4796        $$defaultGroups{1} or $$defaultGroups{1} = 'Composite';
     4797        $$defaultGroups{2} or $$defaultGroups{2} = 'Other';
    31374798    } else {
    31384799        $defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' };
    31394800    }
    3140     SetupTagTable($add);    # generate tag Name, etc
    3141     my $tagID;
     4801    SetupTagTable($add);    # generate Name, TagID, etc
    31424802    foreach $tagID (sort keys %$add) {
    31434803        next if $specialTags{$tagID};   # must skip special tags
    31444804        my $tagInfo = $$add{$tagID};
    3145         # tagID's MUST be the exact tag name for logic in BuildCompositeTags()
    3146         my $tag = $$tagInfo{Name};
     4805        my $new = $prefix . $tagID;     # new tag ID for Composite table
    31474806        $$tagInfo{Module} = $module if $$tagInfo{Writable};
    3148         # allow Composite tags with the same name
    3149         my ($t, $n, $type);
    3150         while ($Image::ExifTool::Composite{$tag} and not $overwrite) {
    3151             $n ? $n += 1 : ($n = 2, $t = $tag);
    3152             $tag = "${t}_$n";
    3153             $$tagInfo{NewTagID} = $tag; # save new ID so we can use it in TagLookup
    3154         }
    3155         # convert scalar Require/Desire entries
    3156         foreach $type ('Require','Desire') {
     4807        $$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override};
     4808        $$tagInfo{IsComposite} = 1;
     4809        # handle Composite tags with the same name
     4810        if ($compositeID{$tagID}) {
     4811            # determine if we want to override this tag
     4812            # (=0 keep both, >0 override, <0 keep existing)
     4813            my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0);
     4814            next if $over < 0;
     4815            if ($over) {
     4816                # remove existing tags with this ID
     4817                delete $$compTable{$_} foreach @{$compositeID{$tagID}};
     4818                delete $compositeID{$tagID};
     4819            }
     4820        }
     4821        # make sure new TagID is unique by adding index if necessary
     4822        # (could only happen for UserDefined tags now that module name is added to tag ID)
     4823        my $n = 0;
     4824        while ($$compTable{$new}) {
     4825            $new =~ s/-\d+$// if $n++;
     4826            $new .= "-$n";
     4827        }
     4828        # use new ID and save it so we can use it in TagLookup
     4829        $$tagInfo{NewTagID} = $new unless $tagID eq $new;
     4830
     4831        # add new ID to lookup of Composite tag ID's
     4832        $compositeID{$tagID} = [ ] unless $compositeID{$tagID};
     4833        unshift @{$compositeID{$tagID}}, $new;  # (most recent one first)
     4834
     4835        # convert scalar Require/Desire/Inhibit entries
     4836        my ($type, @hashes, @scalars, %used);
     4837        foreach $type ('Require','Desire','Inhibit') {
    31574838            my $req = $$tagInfo{$type} or next;
    3158             $$tagInfo{$type} = { 0 => $req } if ref($req) ne 'HASH';
     4839            push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type;
     4840        }
     4841        if (@scalars) {
     4842            # make lookup for indices that are used
     4843            foreach $type (@hashes) {
     4844                $used{$_} = 1 foreach keys %{$$tagInfo{$type}};
     4845            }
     4846            my $next = 0;
     4847            foreach $type (@scalars) {
     4848                ++$next while $used{$next};
     4849                $$tagInfo{$type} = { $next++ => $$tagInfo{$type} };
     4850            }
    31594851        }
    31604852        # add this Composite tag to our main Composite table
    3161         $$tagInfo{Table} = \%Image::ExifTool::Composite;
    3162         # (use the original TagID, even if we changed it)
    3163         # $$tagInfo{TagID} = $tag;
    3164         # save new tag ID so we can find entry in Composite table
    3165         $Image::ExifTool::Composite{$tag} = $tagInfo;
     4853        $$tagInfo{Table} = $compTable;
     4854        # (use the original TagID, even if we changed it, so don't do this:)
     4855        $$tagInfo{TagID} = $new;
     4856        # save tag under new ID in Composite table
     4857        $$compTable{$new} = $tagInfo;
    31664858        # set all default groups in tag
    31674859        my $groups = $$tagInfo{Groups};
     
    32234915{
    32244916    my $tagTablePtr = shift;
     4917    my $avoid = $$tagTablePtr{AVOID};
    32254918    my ($tagID, $tagInfo);
    32264919    foreach $tagID (TagTableKeys($tagTablePtr)) {
     
    32304923            $$tagInfo{Table} = $tagTablePtr;
    32314924            $$tagInfo{TagID} = $tagID;
    3232             my $tag = $$tagInfo{Name};
    3233             unless (defined $tag) {
    3234                 # generate name equal to tag ID if 'Name' doesn't exist
    3235                 $tag = $tagID;
    3236                 $$tagInfo{Name} = ucfirst($tag); # make first char uppercase
    3237             }
     4925            $$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID);
    32384926            $$tagInfo{Flags} and ExpandFlags($tagInfo);
     4927            $$tagInfo{Avoid} = $avoid if defined $avoid;
     4928            # calculate BitShift from Mask if necessary
     4929            if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) {
     4930                my ($mask, $bitShift) = ($$tagInfo{Mask}, 0);
     4931                ++$bitShift until $mask & (1 << $bitShift);
     4932                $$tagInfo{BitShift} = $bitShift;
     4933            }
    32394934        }
    32404935        next unless @infoArray > 1;
     
    32674962{
    32684963    my ($val, $sig) = @_;
    3269     $val == 0 and return 0;
    3270     my $sign = $val < 0 ? ($val=-$val, -1) : 1;
    3271     my $log = log($val) / log(10);
    3272     my $exp = int($log) - $sig + ($log > 0 ? 1 : 0);
    3273     return $sign * int(10 ** ($log - $exp) + 0.5) * 10 ** $exp;
     4964    return sprintf("%.${sig}g", $val);
    32744965}
    32754966
     
    33965087sub GetDouble($$) { return DoUnpackDbl('d', @_); }
    33975088sub Get16uRev($$) { return DoUnpackRev('S', @_); }
     5089sub Get32uRev($$) { return DoUnpackRev('L', @_); }
    33985090
    33995091# rationals may be a floating point number, 'inf' or 'undef'
     5092my ($ratNumer, $ratDenom);
    34005093sub GetRational32s($$)
    34015094{
    34025095    my ($dataPt, $pos) = @_;
    3403     my $numer = Get16s($dataPt,$pos);
    3404     my $denom = Get16s($dataPt, $pos + 2) or return $numer ? 'inf' : 'undef';
     5096    $ratNumer = Get16s($dataPt,$pos);
     5097    $ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef';
    34055098    # round off to a reasonable number of significant figures
    3406     return RoundFloat($numer / $denom, 7);
     5099    return RoundFloat($ratNumer / $ratDenom, 7);
    34075100}
    34085101sub GetRational32u($$)
    34095102{
    34105103    my ($dataPt, $pos) = @_;
    3411     my $numer = Get16u($dataPt,$pos);
    3412     my $denom = Get16u($dataPt, $pos + 2) or return $numer ? 'inf' : 'undef';
    3413     return RoundFloat($numer / $denom, 7);
     5104    $ratNumer = Get16u($dataPt,$pos);
     5105    $ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef';
     5106    return RoundFloat($ratNumer / $ratDenom, 7);
    34145107}
    34155108sub GetRational64s($$)
    34165109{
    34175110    my ($dataPt, $pos) = @_;
    3418     my $numer = Get32s($dataPt,$pos);
    3419     my $denom = Get32s($dataPt, $pos + 4) or return $numer ? 'inf' : 'undef';
    3420     return RoundFloat($numer / $denom, 10);
     5111    $ratNumer = Get32s($dataPt,$pos);
     5112    $ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef';
     5113    return RoundFloat($ratNumer / $ratDenom, 10);
    34215114}
    34225115sub GetRational64u($$)
    34235116{
    34245117    my ($dataPt, $pos) = @_;
    3425     my $numer = Get32u($dataPt,$pos);
    3426     my $denom = Get32u($dataPt, $pos + 4) or return $numer ? 'inf' : 'undef';
    3427     return RoundFloat($numer / $denom, 10);
     5118    $ratNumer = Get32u($dataPt,$pos);
     5119    $ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef';
     5120    return RoundFloat($ratNumer / $ratDenom, 10);
    34285121}
    34295122sub GetFixed16s($$)
     
    35245217    int32s => 4,
    35255218    int32u => 4,
     5219    int32uRev => 4,
    35265220    int64s => 8,
    35275221    int64u => 8,
     
    35345228    fixed32s => 4,
    35355229    fixed32u => 4,
     5230    fixed64s => 8,
    35365231    float => 4,
    35375232    double => 8,
     
    35445239    ifd => 4,
    35455240    ifd64 => 8,
     5241    ue7 => 1,
    35465242);
    35475243my %readValueProc = (
     
    35535249    int32s => \&Get32s,
    35545250    int32u => \&Get32u,
     5251    int32uRev => \&Get32uRev,
    35555252    int64s => \&Get64s,
    35565253    int64u => \&Get64u,
     
    35635260    fixed32s => \&GetFixed32s,
    35645261    fixed32u => \&GetFixed32u,
     5262    fixed64s => \&GetFixed64s,
    35655263    float => \&GetFloat,
    35665264    double => \&GetDouble,
     
    35695267    ifd64 => \&Get64u,
    35705268);
     5269# lookup for all rational types
     5270my %isRational = (
     5271    rational32u => 1,
     5272    rational32s => 1,
     5273    rational64u => 1,
     5274    rational64s => 1,
     5275);
    35715276sub FormatSize($) { return $formatSize{$_[0]}; }
    35725277
     
    35745279# Read value from binary data (with current byte ordering)
    35755280# Inputs: 0) data reference, 1) value offset, 2) format string,
    3576 #         3) number of values (or undef to use all data)
    3577 #         4) valid data length relative to offset
     5281#         3) number of values (or undef to use all data),
     5282#         4) valid data length relative to offset (or undef to use all data),
     5283#         5) optional pointer to returned rational
    35785284# Returns: converted value, or undefined if data isn't there
    35795285#          or list of values in list context
    3580 sub ReadValue($$$$$)
    3581 {
    3582     my ($dataPt, $offset, $format, $count, $size) = @_;
     5286sub ReadValue($$$;$$$)
     5287{
     5288    my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_;
    35835289
    35845290    my $len = $formatSize{$format};
     
    35875293        $len = 1;
    35885294    }
     5295    $size = length($$dataPt) - $offset unless defined $size;
    35895296    unless ($count) {
    35905297        return '' if defined $count or $size < $len;
     
    35985305    my @vals;
    35995306    my $proc = $readValueProc{$format};
    3600     if ($proc) {
     5307    if (not $proc) {
     5308        # handle undef/binary/string (also unsupported unicode/complex)
     5309        $vals[0] = substr($$dataPt, $offset, $count * $len);
     5310        # truncate string at null terminator if necessary
     5311        $vals[0] =~ s/\0.*//s if $format eq 'string';
     5312    } elsif ($isRational{$format} and $ratPt) {
     5313        # store rationals separately as string fractions
     5314        my @rat;
     5315        for (;;) {
     5316            push @vals, &$proc($dataPt, $offset);
     5317            push @rat, "$ratNumer/$ratDenom";
     5318            last if --$count <= 0;
     5319            $offset += $len;
     5320        }
     5321        $$ratPt = join(' ',@rat);
     5322    } else {
    36015323        for (;;) {
    36025324            push @vals, &$proc($dataPt, $offset);
     
    36045326            $offset += $len;
    36055327        }
    3606     } else {
    3607         # handle undef/binary/string (also unsupported unicode/complex)
    3608         $vals[0] = substr($$dataPt, $offset, $count * $len);
    3609         # truncate string at null terminator if necessary
    3610         $vals[0] =~ s/\0.*//s if $format eq 'string';
    36115328    }
    36125329    return @vals if wantarray;
     
    37065423    {
    37075424        # issue warning only if the tag was specifically requested
    3708         if ($self->{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) {
     5425        if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) {
    37095426            $self->Warn("$tag is not a valid JPEG image",1);
    37105427            return undef;
     
    37125429    }
    37135430    return $imagePt;
     5431}
     5432
     5433#------------------------------------------------------------------------------
     5434# Validate a tag name argument (including group name and wildcards, etc)
     5435# Inputs: 0) tag name
     5436# Returns: true if tag name is valid
     5437# - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9]
     5438# - tag names may contain wildcards [?*], and end with a hash [#]
     5439# - may have group name prefixes (which may have family number prefix), separated by colons
     5440# - a group name may be zero or more characters
     5441sub ValidTagName($)
     5442{
     5443    my $tag = shift;
     5444    return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/;
     5445}
     5446
     5447#------------------------------------------------------------------------------
     5448# Generate a valid tag name based on the tag ID or name
     5449# Inputs: 0) tag ID or name
     5450# Returns: valid tag name
     5451sub MakeTagName($)
     5452{
     5453    my $name = shift;
     5454    $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
     5455    $name = ucfirst $name;          # capitalize first letter
     5456    $name = "Tag$name" if length($name) < 2; # must at least 2 characters long
     5457    return $name;
    37145458}
    37155459
     
    37315475    # put a space between acronyms and words
    37325476    $desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g;
    3733     # put spaces after numbers (if more than one character following number)
     5477    # put spaces after numbers (if more than one character follows the number)
    37345478    $desc =~ s/(\d)([A-Z]\S)/$1 $2/g;
    37355479    # add TagID to description
     
    37395483
    37405484#------------------------------------------------------------------------------
     5485# Get descriptions for all tags in an array
     5486# Inputs: 0) ExifTool ref, 1) reference to list of tag keys
     5487# Returns: reference to hash lookup for descriptions
     5488# Note: Returned descriptions are NOT escaped by ESCAPE_PROC
     5489sub GetDescriptions($$)
     5490{
     5491    local $_;
     5492    my ($self, $tags) = @_;
     5493    my %desc;
     5494    my $oldEscape = $$self{ESCAPE_PROC};
     5495    delete $$self{ESCAPE_PROC};
     5496    $desc{$_} = $self->GetDescription($_) foreach @$tags;
     5497    $$self{ESCAPE_PROC} = $oldEscape;
     5498    return \%desc;
     5499}
     5500
     5501#------------------------------------------------------------------------------
     5502# Apply filter to value(s) if necessary
     5503# Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter
     5504# Returns: true unless a filter returned undef; changes value if necessary
     5505sub Filter($$$)
     5506{
     5507    local $_;
     5508    my ($self, $filter, $valPt) = @_;
     5509    return 1 unless defined $filter and defined $$valPt;
     5510    my $rtnVal;
     5511    if (not ref $$valPt) {
     5512        $_ = $$valPt;
     5513        #### eval Filter ($_, $self)
     5514        eval $filter;
     5515        if (defined $_) {
     5516            $$valPt = $_;
     5517            $rtnVal = 1;
     5518        }
     5519    } elsif (ref $$valPt eq 'SCALAR') {
     5520        my $val = $$$valPt; # make a copy to avoid filtering twice
     5521        $rtnVal = $self->Filter($filter, \$val);
     5522        $$valPt = \$val;
     5523    } elsif (ref $$valPt eq 'ARRAY') {
     5524        my @val = @{$$valPt}; # make a copy to avoid filtering twice
     5525        $self->Filter($filter, \$_) and $rtnVal = 1 foreach @val;
     5526        $$valPt = \@val;
     5527    } elsif (ref $$valPt eq 'HASH') {
     5528        my %val = %{$$valPt}; # make a copy to avoid filtering twice
     5529        $self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val;
     5530        $$valPt = \%val;
     5531    } else {
     5532        $rtnVal = 1;
     5533    }
     5534    return $rtnVal;
     5535}
     5536
     5537#------------------------------------------------------------------------------
    37415538# Return printable value
    37425539# Inputs: 0) ExifTool object reference
     
    37485545    $outStr =~ tr/\x01-\x1f\x7f-\xff/./;
    37495546    $outStr =~ s/\x00//g;
    3750     if (defined $maxLen) {
    3751         # minimum length is 20 (0 is unlimited)
    3752         $maxLen = 20 if $maxLen and $maxLen < 20;
     5547    my $verbose = $$self{OPTIONS}{Verbose};
     5548    if ($verbose < 4) {
     5549        if ($maxLen) {
     5550            $maxLen = 20 if $maxLen < 20;   # minimum length is 20
     5551        } elsif (defined $maxLen) {
     5552            $maxLen = length $outStr;       # 0 is unlimited
     5553        } else {
     5554            $maxLen = 60;                   # default maximum is 60
     5555        }
    37535556    } else {
    3754         $maxLen = 60;                   # default length is 60
    3755     }
    3756     # limit length only if verbose < 4
    3757     if ($maxLen and length($outStr) > $maxLen and $self->{OPTIONS}{Verbose} < 4) {
    3758         $outStr = substr($outStr,0,$maxLen-6) . '[snip]';
    3759     }
     5557        $maxLen = length $outStr;
     5558        # limit to 2048 characters if verbose < 5
     5559        $maxLen = 2048 if $maxLen > 2048 and $verbose < 5;
     5560    }
     5561
     5562    # limit length if necessary
     5563    $outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen;
    37605564    return $outStr;
    37615565}
     
    37685572{
    37695573    my ($self, $date) = @_;
    3770     my $dateFormat = $self->{OPTIONS}{DateFormat};
     5574    my $fmt = $$self{OPTIONS}{DateFormat};
     5575    my $shift = $$self{OPTIONS}{GlobalTimeShift};
     5576    if ($shift) {
     5577        my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1;
     5578        my $offset = $$self{GLOBAL_TIME_OFFSET};
     5579        $offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { };
     5580        ShiftTime($date, $shift, $dir, $offset);
     5581    }
    37715582    # only convert date if a format was specified and the date is recognizable
    3772     if ($dateFormat) {
     5583    if ($fmt) {
     5584        # separate time zone if it exists
     5585        my $tz;
     5586        $date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1;
    37735587        # a few cameras use incorrect date/time formatting:
    37745588        # - slashes instead of colons in date (RolleiD330, ImpressCam)
    37755589        # - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar)
    37765590        # - single-digit seconds with leading space (HP scanners)
    3777         $date =~ s/[-+]\d{2}:\d{2}$//;  # remove timezone if it exists
    3778         my @a = ($date =~ /\d+/g);      # be very flexible about date/time format
    3779         if (@a and $a[0] > 1900 and $a[0] < 3000 and eval 'require POSIX') {
    3780             $date = POSIX::strftime($dateFormat, $a[5]||0, $a[4]||0, $a[3]||0,
    3781                                                  $a[2]||1, ($a[1]||1)-1, $a[0]-1900);
    3782         } elsif ($self->{OPTIONS}{StrictDate}) {
     5591        my @a = reverse ($date =~ /\d+/g);  # be very flexible about date/time format
     5592        if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) {
     5593            shift @a while @a > 6;      # remove superfluous entries
     5594            unshift @a, 1 while @a < 3; # add month and day if necessary
     5595            unshift @a, 0 while @a < 6; # add h,m,s if necessary
     5596            $a[4] -= 1;                 # base month is 1
     5597            # parse %z and %s ourself (to handle time zones properly)
     5598            if ($fmt =~ /%[sz]/) {
     5599                # use system time zone unless otherwise specified
     5600                $tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local };
     5601                # remove colon, setting to UTC if time zone is not numeric
     5602                $tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000';
     5603                $fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g;      # convert '%z' format codes
     5604                if ($fmt =~ /%s/ and eval { require Time::Local }) {
     5605                    # calculate seconds since the Epoch, UTC
     5606                    my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40);
     5607                    $fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g;   # convert '%s' format codes
     5608                }
     5609            }
     5610            $a[5] -= 1900;  # strftime year starts from 1900
     5611            $date = POSIX::strftime($fmt, @a);  # generate the formatted date/time
     5612        } elsif ($$self{OPTIONS}{StrictDate}) {
    37835613            undef $date;
    37845614        }
     
    38325662# Inputs: 0) localtime array ref, 1) gmtime array ref
    38335663# Returns: time zone offset in minutes
    3834 sub GetTimeZone(;$$)
     5664sub GetTimeZone($$)
    38355665{
    38365666    my ($tm, $gm) = @_;
     
    38435673        $min += ($$tm[3] - $$gm[3]) * 24 * 60;
    38445674    }
     5675    # MirBSD patch to round to the nearest 30 minutes because
     5676    # it includes leap seconds in localtime but not gmtime
     5677    $min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd';
    38455678    return $min;
    38465679}
     
    38605693    my $sign = '+';
    38615694    $min < 0 and $sign = '-', $min = -$min;
     5695    $min = int($min + 0.5); # round off to nearest minute
    38625696    my $h = int($min / 60);
    38635697    return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60);
     
    38665700#------------------------------------------------------------------------------
    38675701# Convert Unix time to EXIF date/time string
    3868 # Inputs: 0) Unix time value, 1) non-zero to convert to local time
     5702# Inputs: 0) Unix time value, 1) non-zero to convert to local time,
     5703#         2) number of digits after the decimal for fractional seconds
    38695704# Returns: EXIF date/time string (with timezone for local times)
    3870 # Notes: fractional seconds are ignored
    3871 sub ConvertUnixTime($;$)
    3872 {
    3873     my ($time, $toLocal) = @_;
     5705sub ConvertUnixTime($;$$)
     5706{
     5707    my ($time, $toLocal, $dec) = @_;
    38745708    return '0000:00:00 00:00:00' if $time == 0;
    38755709    my (@tm, $tz);
     5710    if ($dec) {
     5711        my $frac = $time - int($time);
     5712        $time = int($time);
     5713        $frac < 0 and $frac += 1, $time -= 1;
     5714        $dec = sprintf('%.*f', $dec, $frac);
     5715        # remove number before decimal and increment integer time if it was rounded up
     5716        $dec =~ s/^(\d)// and $1 eq '1' and $time += 1;
     5717    } else {
     5718        $time = int($time + 1e-6) if $time != int($time);  # avoid round-off errors
     5719        $dec = '';
     5720    }
    38765721    if ($toLocal) {
    38775722        @tm = localtime($time);
     
    38815726        $tz = '';
    38825727    }
    3883     my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d%s",
     5728    my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s",
    38845729                      $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz);
    38855730    return $str;
     
    38885733#------------------------------------------------------------------------------
    38895734# Get Unix time from EXIF-formatted date/time string with optional timezone
    3890 # Inputs: 0) EXIF date/time string, 1) non-zero if time is local
     5735# Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC
    38915736# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error
    38925737sub GetUnixTime($;$)
     
    38945739    my ($timeStr, $isLocal) = @_;
    38955740    return 0 if $timeStr eq '0000:00:00 00:00:00';
    3896     my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
    3897     return undef unless @tm == 6 and eval 'require Time::Local';
    3898     my $tzsec = 0;
     5741    my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(.*)/);
     5742    return undef unless @tm == 7 and eval { require Time::Local };
     5743    my ($tzStr, $tzSec) = (pop(@tm), 0);
    38995744    # use specified timezone offset (if given) instead of local system time
    39005745    # if we are converting a local time value
    3901     if ($isLocal and $timeStr =~ /(?:Z|([-+])(\d+):(\d+))$/i) {
    3902         # use specified timezone if one exists
    3903         $tzsec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1;
    3904         undef $isLocal; # convert using GMT corrected for specified timezone
    3905     }
    3906     $tm[0] -= 1900;     # convert year
     5746    if ($isLocal) {
     5747        if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) {
     5748            # use specified timezone if one exists
     5749            $tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1;
     5750            undef $isLocal; # convert using GMT corrected for specified timezone
     5751        } elsif ($isLocal eq '2') {
     5752            undef $isLocal;
     5753        }
     5754    }
    39075755    $tm[1] -= 1;        # convert month
    39085756    @tm = reverse @tm;  # change to order required by timelocal()
    3909     return $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzsec;
     5757    my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec;
     5758    # handle fractional seconds
     5759    $val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/;
     5760    return $val;
    39105761}
    39115762
     
    39185769    my $val = shift;
    39195770    $val < 2048 and return "$val bytes";
    3920     $val < 10240 and return sprintf('%.1f kB', $val / 1024);
    3921     $val < 2097152 and return sprintf('%.0f kB', $val / 1024);
    3922     $val < 10485760 and return sprintf('%.1f MB', $val / 1048576);
    3923     return sprintf('%.0f MB', $val / 1048576);
     5771    $val < 10240 and return sprintf('%.1f KiB', $val / 1024);
     5772    $val < 2097152 and return sprintf('%.0f KiB', $val / 1024);
     5773    $val < 10485760 and return sprintf('%.1f MiB', $val / 1048576);
     5774    $val < 2147483648 and return sprintf('%.0f MiB', $val / 1048576);
     5775    $val < 10737418240 and return sprintf('%.1f GiB', $val / 1073741824);
     5776    return sprintf('%.0f GiB', $val / 1073741824);
    39245777}
    39255778
     
    39275780# Convert seconds to duration string (handles negative durations)
    39285781# Inputs: 0) floating point seconds
    3929 # Returns: duration string in form "S.SS s", "MM:SS" or "H:MM:SS"
     5782# Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS"
    39305783sub ConvertDuration($)
    39315784{
     
    39355788    my $sign = ($time > 0 ? '' : (($time = -$time), '-'));
    39365789    return sprintf("$sign%.2f s", $time) if $time < 30;
     5790    $time += 0.5;   # to round off to nearest second
    39375791    my $h = int($time / 3600);
    39385792    $time -= $h * 3600;
    39395793    my $m = int($time / 60);
    39405794    $time -= $m * 60;
     5795    if ($h > 24) {
     5796        my $d = int($h / 24);
     5797        $h -= $d * 24;
     5798        $sign = "$sign$d days ";
     5799    }
    39415800    return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time));
    39425801}
     
    39615820
    39625821#------------------------------------------------------------------------------
     5822# Convert file name for printing
     5823# Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set
     5824# Returns: converted file name in external character set
     5825sub ConvertFileName($$)
     5826{
     5827    my ($self, $val) = @_;
     5828    my $enc = $$self{OPTIONS}{CharsetFileName};
     5829    $val = $self->Decode($val, $enc) if $enc;
     5830    return $val;
     5831}
     5832
     5833#------------------------------------------------------------------------------
     5834# Inverse conversion for file name (encode in CharsetFileName)
     5835# Inputs: 0) ExifTool ref, 1) file name in external character set
     5836# Returns: file name in CharsetFileName character set
     5837sub InverseFileName($$)
     5838{
     5839    my ($self, $val) = @_;
     5840    my $enc = $$self{OPTIONS}{CharsetFileName};
     5841    $val = $self->Encode($val, $enc) if $enc;
     5842    $val =~ tr/\\/\//;  # make sure we are using forward slashes
     5843    return $val;
     5844}
     5845
     5846#------------------------------------------------------------------------------
    39635847# Save information for HTML dump
    39645848# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size
    3965 #         3) comment string, 4) tool tip (or SAME), 5) flags
    3966 sub HDump($$$$;$$)
     5849#         3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name
     5850sub HDump($$$$;$$$)
    39675851{
    39685852    my $self = shift;
    3969     my $pos = shift;
     5853    $$self{HTML_DUMP} or return;
     5854    my ($pos, $len, $com, $tip, $flg, $ifd) = @_;
    39705855    $pos += $$self{BASE} if $$self{BASE};
    3971     $$self{HTML_DUMP} and $self->{HTML_DUMP}->Add($pos, @_);
    3972 }
    3973 
    3974 #------------------------------------------------------------------------------
    3975 # JPEG constants
    3976 my %jpegMarker = (
    3977     0x01 => 'TEM',
    3978     0xc0 => 'SOF0', # to SOF15, with a few exceptions below
    3979     0xc4 => 'DHT',
    3980     0xc8 => 'JPGA',
    3981     0xcc => 'DAC',
    3982     0xd0 => 'RST0',
    3983     0xd8 => 'SOI',
    3984     0xd9 => 'EOI',
    3985     0xda => 'SOS',
    3986     0xdb => 'DQT',
    3987     0xdc => 'DNL',
    3988     0xdd => 'DRI',
    3989     0xde => 'DHP',
    3990     0xdf => 'EXP',
    3991     0xe0 => 'APP0', # to APP15
    3992     0xf0 => 'JPG0',
    3993     0xfe => 'COM',
    3994 );
    3995 
    3996 #------------------------------------------------------------------------------
    3997 # Get JPEG marker name
    3998 # Inputs: 0) Jpeg number
    3999 # Returns: marker name
    4000 sub JpegMarkerName($)
    4001 {
    4002     my $marker = shift;
    4003     my $markerName = $jpegMarker{$marker};
    4004     unless ($markerName) {
    4005         $markerName = $jpegMarker{$marker & 0xf0};
    4006         if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) {
    4007             $markerName = $1 . ($marker & 0x0f);
    4008         } else {
    4009             $markerName = sprintf("marker 0x%.2x", $marker);
    4010         }
    4011     }
    4012     return $markerName;
     5856    # skip structural data blocks which have been removed from the middle of this dump
     5857    # (SkipData list contains ordered [start,end+1] offsets to skip)
     5858    if ($$self{SkipData}) {
     5859        my $end = $pos + $len;
     5860        my $skip;
     5861        foreach $skip (@{$$self{SkipData}}) {
     5862            $end <= $$skip[0] and last;
     5863            $pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next;
     5864            if ($pos != $$skip[0]) {
     5865                $$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd);
     5866                $len -= $$skip[0] - $pos;
     5867                $tip = 'SAME';
     5868            }
     5869            $pos = $$skip[1];
     5870        }
     5871    }
     5872    $$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd);
    40135873}
    40145874
     
    40415901        {
    40425902            $type = 'MIE';
     5903        } elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) {
     5904            $type = 'Samsung';
     5905        } elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) {
     5906            $type = 'Insta360';
    40435907        }
    40445908        last;
     
    40725936
    40735937    for (;;) { # loop through all trailers
    4074         require "Image/ExifTool/$dirName.pm";
    4075         my $proc = "Image::ExifTool::${dirName}::Process$dirName";
    4076         my $outBuff;
     5938        my ($proc, $outBuff);
     5939        if ($dirName eq 'Insta360') {
     5940            require "Image/ExifTool/QuickTimeStream.pl";
     5941            $proc = 'Image::ExifTool::QuickTime::ProcessInsta360';
     5942        } else {
     5943            require "Image/ExifTool/$dirName.pm";
     5944            $proc = "Image::ExifTool::${dirName}::Process$dirName";
     5945        }
    40775946        if ($outfile) {
    40785947            # write to local buffer so we can add trailer in proper order later
     
    40895958
    40905959        # read or write this trailer
    4091         # (proc takes Offset as offset from end of trailer to end of file,
    4092         #  and returns DataPos and DirLen, and Fixup if applicable)
     5960        # (proc takes Offset as positive offset from end of trailer to end of file,
     5961        #  and returns DataPos and DirLen, and Fixup if applicable, and updates
     5962        #  OutFile when writing)
    40935963        no strict 'refs';
    40945964        my $result = &$proc($self, $dirInfo);
    40955965        use strict 'refs';
    40965966
    4097         # restore PATH
    4098         pop @$path;
    4099         pop @$path;
     5967        # restore PATH (pop last 2 items)
     5968        splice @$path, -2;
     5969
    41005970        # check result
    41015971        if ($outfile) {
     
    41085978                    $outBuff = '';      # free memory
    41095979                }
    4110                 if ($fixup) {
    4111                     # add new fixup information if any
    4112                     $fixup->AddFixup($$dirInfo{Fixup}) if $$dirInfo{Fixup};
    4113                 } else {
     5980                if ($$dirInfo{Fixup}) {
     5981                    if ($fixup) {
     5982                        # add fixup for subsequent trailers to the fixup for this trailer
     5983                        # (but first we must adjust for the new start position)
     5984                        $$fixup{Shift} += $$dirInfo{Fixup}{Start};
     5985                        $$fixup{Start} -= $$dirInfo{Fixup}{Start};
     5986                        $$dirInfo{Fixup}->AddFixup($fixup);
     5987                    }
    41145988                    $fixup = $$dirInfo{Fixup};  # save fixup
    41155989                }
    41165990            } else {
    4117                 $success = 0 if $self->Error("Error rewriting $dirName trailer", 1);
     5991                $success = 0 if $self->Error("Error rewriting $dirName trailer", 2);
    41185992                last;
    41195993            }
     
    41396013
    41406014#------------------------------------------------------------------------------
    4141 # Extract EXIF information from a jpg image
     6015# JPEG constants
     6016
     6017# JPEG marker names
     6018%jpegMarker = (
     6019    0x00 => 'NULL',
     6020    0x01 => 'TEM',
     6021    0xc0 => 'SOF0', # to SOF15, with a few exceptions below
     6022    0xc4 => 'DHT',
     6023    0xc8 => 'JPGA',
     6024    0xcc => 'DAC',
     6025    0xd0 => 'RST0', # to RST7
     6026    0xd8 => 'SOI',
     6027    0xd9 => 'EOI',
     6028    0xda => 'SOS',
     6029    0xdb => 'DQT',
     6030    0xdc => 'DNL',
     6031    0xdd => 'DRI',
     6032    0xde => 'DHP',
     6033    0xdf => 'EXP',
     6034    0xe0 => 'APP0', # to APP15
     6035    0xf0 => 'JPG0',
     6036    0xfe => 'COM',
     6037);
     6038
     6039# lookup for size of JPEG marker length word
     6040# (2 bytes assumed unless specified here)
     6041my %markerLenBytes = (
     6042    0x00 => 0,  0x01 => 0,
     6043    0xd0 => 0,  0xd1 => 0,  0xd2 => 0,  0xd3 => 0,  0xd4 => 0,  0xd5 => 0,  0xd6 => 0,  0xd7 => 0,
     6044    0xd8 => 0,  0xd9 => 0,  0xda => 0,
     6045    # J2C
     6046    0x30 => 0,  0x31 => 0,  0x32 => 0,  0x33 => 0,  0x34 => 0,  0x35 => 0,  0x36 => 0,  0x37 => 0,
     6047    0x38 => 0,  0x39 => 0,  0x3a => 0,  0x3b => 0,  0x3c => 0,  0x3d => 0,  0x3e => 0,  0x3f => 0,
     6048    0x4f => 0,
     6049    0x92 => 0,  0x93 => 0,
     6050    # J2C extensions
     6051    0x74 => 4, 0x75 => 4, 0x77 => 4,
     6052);
     6053
     6054#------------------------------------------------------------------------------
     6055# Get JPEG marker name
     6056# Inputs: 0) Jpeg number
     6057# Returns: marker name
     6058sub JpegMarkerName($)
     6059{
     6060    my $marker = shift;
     6061    my $markerName = $jpegMarker{$marker};
     6062    unless ($markerName) {
     6063        $markerName = $jpegMarker{$marker & 0xf0};
     6064        if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) {
     6065            $markerName = $1 . ($marker & 0x0f);
     6066        } else {
     6067            $markerName = sprintf("marker 0x%.2x", $marker);
     6068        }
     6069    }
     6070    return $markerName;
     6071}
     6072
     6073#------------------------------------------------------------------------------
     6074# Adjust directory start position
     6075# Inputs: 0) dirInfo ref, 1) start offset
     6076#         2) Base for offsets (relative to DataPos, defaults to absolute Base of 0)
     6077sub DirStart($$;$)
     6078{
     6079    my ($dirInfo, $start, $base) = @_;
     6080    $$dirInfo{DirStart} = $start;
     6081    $$dirInfo{DirLen} -= $start;
     6082    if (defined $base) {
     6083        $$dirInfo{Base} = $$dirInfo{DataPos} + $base;
     6084        $$dirInfo{DataPos} = -$base;    # (relative to Base!)
     6085    }
     6086}
     6087
     6088#------------------------------------------------------------------------------
     6089# Extract metadata from a jpg image
    41426090# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
    41436091# Returns: 1 on success, 0 if this wasn't a valid JPEG file
     
    41476095    my ($self, $dirInfo) = @_;
    41486096    my ($ch, $s, $length);
    4149     my $verbose = $self->{OPTIONS}{Verbose};
    4150     my $out = $self->{OPTIONS}{TextOut};
    4151     my $fast = $self->{OPTIONS}{FastScan};
     6097    my $options = $$self{OPTIONS};
     6098    my $verbose = $$options{Verbose};
     6099    my $out = $$options{TextOut};
     6100    my $fast = $$options{FastScan} || 0;
    41526101    my $raf = $$dirInfo{RAF};
    4153     my $htmlDump = $self->{HTML_DUMP};
     6102    my $htmlDump = $$self{HTML_DUMP};
    41546103    my %dumpParms = ( Out => $out );
    4155     my ($success, $icc_profile, $wantTrailer, $trailInfo, %extendedXMP);
    4156     my ($preview, $scalado, @dqt, $subSampling, $dumpEnd);
    4157 
    4158     # check to be sure this is a valid JPG file
    4159     return 0 unless $raf->Read($s, 2) == 2 and $s eq "\xff\xd8";
     6104    my ($success, $wantTrailer, $trailInfo, $foundSOS);
     6105    my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal);
     6106    my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP);
     6107
     6108    # check to be sure this is a valid JPG (or J2C, or EXV) file
     6109    return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/;
     6110    if ($s eq "\xff\x01") {
     6111        return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2';
     6112        $$self{FILE_TYPE} = 'EXV';
     6113    }
     6114    my $appBytes = 0;
     6115    my $calcImageLen = $$self{REQ_TAG_LOOKUP}{jpegimagelength};
     6116    if ($$options{RequestAll} and $$options{RequestAll} > 2) {
     6117        $calcImageLen = 1;
     6118    }
     6119    if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) {
     6120        $self->SetFileType();               # set FileType tag
     6121        return 1 if $fast == 3;             # don't process file when FastScan == 3
     6122        $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags
     6123    }
     6124    $$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode
     6125
    41606126    $dumpParms{MaxLen} = 128 if $verbose < 4;
    4161     unless ($self->{VALUE}{FileType}) {
    4162         $self->SetFileType();               # set FileType tag
    4163         $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags
    4164     }
    41656127    if ($htmlDump) {
    41666128        $dumpEnd = $raf->Tell();
    4167         my $pos = $dumpEnd - 2;
     6129        my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI');
     6130        my $pos = $dumpEnd - $n;
    41686131        $self->HDump(0, $pos, '[unknown header]') if $pos;
    4169         $self->HDump($pos, 2, 'JPEG header', 'SOI Marker');
     6132        $self->HDump($pos, $n, "$t header", "$m Marker");
    41706133    }
    41716134    my $path = $$self{PATH};
     
    41756138    local $/ = "\xff";
    41766139
    4177     my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData);
     6140    my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData);
    41786141
    41796142    # read file until we reach an end of image (EOI) or start of scan (SOS)
     
    41866149        undef $nextSegDataPt;
    41876150#
    4188 # read ahead to the next segment unless we have reached EOI or SOS
     6151# read ahead to the next segment unless we have reached EOI, SOS or SOD
    41896152#
    4190         unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer))) {
     6153        unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) {
    41916154            # read up to next marker (JPEG markers begin with 0xff)
    41926155            my $buff;
     
    41986161                last unless $nextMarker == 0xff;
    41996162            }
    4200             # read data for all markers except 0xd9 (EOI) and stand-alone
    4201             # markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7)
    4202             if ($nextMarker!=0xd9 and $nextMarker!=0x00 and $nextMarker!=0x01 and
    4203                 ($nextMarker<0xd0 or $nextMarker>0xd7))
    4204             {
     6163            # read segment data if it exists
     6164            if (not defined $markerLenBytes{$nextMarker}) {
    42056165                # read record length word
    42066166                last unless $raf->Read($s, 2) == 2;
     
    42116171                last unless $raf->Read($buff, $len) == $len;
    42126172                $nextSegDataPt = \$buff;    # set pointer to our next data
     6173            } elsif ($markerLenBytes{$nextMarker} == 4) {
     6174                # handle J2C extensions with 4-byte length word
     6175                last unless $raf->Read($s, 4) == 4;
     6176                my $len = unpack('N',$s);   # get data length
     6177                last unless defined($len) and $len >= 4;
     6178                $nextSegPos = $raf->Tell();
     6179                $len -= 4;  # subtract size of length word
     6180                last unless $raf->Seek($len, 1);
    42136181            }
    42146182            # read second segment too if this was the first
     
    42276195                print $out "JPEG $markerName ($length bytes):\n";
    42286196                HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2;
     6197            } elsif ($htmlDump) {
     6198                $self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08);
     6199                $dumpEnd = $segPos + $length;
    42296200            }
    42306201            next unless $length >= 6;
     
    42326203            my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt);
    42336204            my $sof = GetTagTable('Image::ExifTool::JPEG::SOF');
    4234             $self->FoundTag($$sof{ImageWidth}, $w);
    4235             $self->FoundTag($$sof{ImageHeight}, $h);
    4236             $self->FoundTag($$sof{EncodingProcess}, $marker - 0xc0);
    4237             $self->FoundTag($$sof{BitsPerSample}, $p);
    4238             $self->FoundTag($$sof{ColorComponents}, $n);
     6205            $self->HandleTag($sof, 'ImageWidth', $w);
     6206            $self->HandleTag($sof, 'ImageHeight', $h);
     6207            $self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0);
     6208            $self->HandleTag($sof, 'BitsPerSample', $p);
     6209            $self->HandleTag($sof, 'ColorComponents', $n);
    42396210            next unless $n == 3 and $length >= 15;
    42406211            my ($i, $hmin, $hmax, $vmin, $vmax);
     
    42596230            if ($hmin and $vmin) {
    42606231                my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin);
    4261                 $self->FoundTag($$sof{YCbCrSubSampling}, "$hs $vs");
     6232                $self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs");
    42626233            }
    42636234            next;
     
    42716242                $dumpEnd = 0;
    42726243            }
    4273             $success = 1;
     6244            if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') {
     6245                $success = 1;
     6246            } else {
     6247                $self->Warn('Missing JPEG SOS');
     6248            }
     6249            if ($$self{REQ_TAG_LOOKUP}{trailer}) {
     6250                # read entire trailer into memory
     6251                if ($raf->Seek(0,2)) {
     6252                    my $len = $raf->Tell() - $pos;
     6253                    if ($len) {
     6254                        my $buff;
     6255                        $raf->Seek($pos, 0);
     6256                        $self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len;
     6257                        $raf->Seek($pos, 0);
     6258                    }
     6259                } else {
     6260                    $self->Warn('Error seeking in file');
     6261                }
     6262            }
    42746263            # we are here because we are looking for trailer information
    42756264            if ($wantTrailer) {
    42766265                my $start = $$self{PreviewImageStart};
    4277                 if ($start) {
     6266                if ($start or $$options{ExtractEmbedded}) {
    42786267                    my $buff;
    42796268                    # most previews start right after the JPEG EOI, but the Olympus E-20
     
    42826271                    # (and Minolta and Sony previews can have a random first byte...)
    42836272                    my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024;
    4284                     if ($raf->Read($buff, $scanLen) and ($buff =~ /\xff\xd8\xff./g or
    4285                         ($self->{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)))
    4286                     {
    4287                         # adjust PreviewImageStart to this location
    4288                         my $actual = $pos + pos($buff) - 4;
    4289                         if ($start ne $actual and $verbose > 1) {
    4290                             print $out "(Fixed PreviewImage location: $start -> $actual)\n";
    4291                         }
    4292                         # update preview image offsets
    4293                         $self->{VALUE}{PreviewImageStart} = $actual if $self->{VALUE}{PreviewImageStart};
    4294                         $$self{PreviewImageStart} = $actual;
    4295                         # load preview now if we tried and failed earlier
    4296                         if ($$self{PreviewError} and $$self{PreviewImageLength}) {
    4297                             if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) {
    4298                                 $self->FoundTag('PreviewImage', $buff);
    4299                                 delete $$self{PreviewError};
     6273                    if ($raf->Read($buff, $scanLen)) {
     6274                        if ($buff =~ /^.{4}ftyp/s) {
     6275                            my $val;
     6276                            if ($raf->Seek(0,2)) {
     6277                                my $len = $raf->Tell() - $pos;
     6278                                if ($$options{Binary}) {
     6279                                    $val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len;
     6280                                } else {
     6281                                    $val = \ "Binary data $len bytes";
     6282                                }
     6283                                if ($val) {
     6284                                    $self->FoundTag('EmbeddedVideo', $val);
     6285                                } else {
     6286                                    $self->Warn('Error reading trailer');
     6287                                }
     6288                            } else {
     6289                                $self->Warn('Error seeking to end of file');
     6290                            }
     6291                        } elsif ($buff =~ /\xff\xd8\xff./g or
     6292                           ($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g))
     6293                        {
     6294                            # adjust PreviewImageStart to this location
     6295                            my $actual = $pos + pos($buff) - 4;
     6296                            if ($start and $start ne $actual and $verbose > 1) {
     6297                                print $out "(Fixed PreviewImage location: $start -> $actual)\n";
     6298                            }
     6299                            # update preview image offsets
     6300                            if ($start) {
     6301                                $$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart};
     6302                                $$self{PreviewImageStart} = $actual;
     6303                            }
     6304                            # load preview now if we tried and failed earlier
     6305                            if ($$self{PreviewError} and $$self{PreviewImageLength}) {
     6306                                if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) {
     6307                                    $self->FoundTag('PreviewImage', $buff);
     6308                                    delete $$self{PreviewError};
     6309                                }
    43006310                            }
    43016311                        }
     
    43336343                }) if $endPos > $pos;
    43346344            }
     6345            $self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen;
    43356346            last;       # all done parsing file
    43366347        } elsif ($marker == 0xda) {         # SOS
    43376348            pop @$path;
     6349            $foundSOS = 1;
    43386350            # all done with meta information unless we have a trailer
    43396351            $verbose and print $out "JPEG SOS\n";
     
    43466358                    $self->ProcessTrailers($trailInfo) and undef $trailInfo;
    43476359                }
    4348                 if ($wantTrailer) {
     6360                if ($wantTrailer and $$self{PreviewImageStart}) {
    43496361                    # seek ahead and validate preview image
    43506362                    my $buff;
     
    43636375                    Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
    43646376                    $wantTrailer = 1 if $$self{LeicaTrailer};
     6377                } else {
     6378                    $wantTrailer = 1 if $$options{ExtractEmbedded};
    43656379                }
    43666380                next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump;
    43676381            }
     6382            # must scan to EOI if Validate or JpegCompressionFactor used
     6383            next if $$options{Validate} or $calcImageLen or $$self{REQ_TAG_LOOKUP}{trailer};
    43686384            # nothing interesting to parse after start of scan (SOS)
    43696385            $success = 1;
    43706386            last;   # all done parsing file
    4371         } elsif ($marker==0x00 or $marker==0x01 or ($marker>=0xd0 and $marker<=0xd7)) {
    4372             # handle stand-alone markers 0x00, 0x01 and 0xd0-0xd7 (NULL, TEM, RST0-RST7)
    4373             $verbose and $marker and print $out "JPEG $markerName:\n";
     6387        } elsif ($marker == 0x93) {
     6388            pop @$path;
     6389            $verbose and print $out "JPEG SOD\n";
     6390            $success = 1;
     6391            next if $verbose > 2 or $htmlDump;
     6392            last;   # all done parsing file
     6393        } elsif (defined $markerLenBytes{$marker}) {
     6394            # handle other stand-alone markers and segments we skipped over
     6395            $verbose and $marker and print $out "JPEG $markerName\n";
    43746396            next;
    43756397        } elsif ($marker == 0xdb and length($$segDataPt) and    # DQT
    43766398            # save the DQT data only if JPEGDigest has been requested
    4377             $self->{REQ_TAG_LOOKUP}->{jpegdigest})
     6399            # (Note: since we aren't checking the RequestAll API option here, the application
     6400            #  must use the RequestTags option to generate these tags if they have not been
     6401            #  specifically requested.  The reason is that there is too much overhead involved
     6402            #  in the calculation of this tag to make this worth the CPU time.)
     6403            ($$self{REQ_TAG_LOOKUP}{jpegdigest} or $$self{REQ_TAG_LOOKUP}{jpegqualityestimate}
     6404            or ($$options{RequestAll} and $$options{RequestAll} > 2)))
    43786405        {
    43796406            my $num = unpack('C',$$segDataPt) & 0x0f;   # get table index
     
    43826409        # handle all other markers
    43836410        my $dumpType = '';
     6411        my ($desc, $tip, $xtra);
    43846412        $length = length $$segDataPt;
     6413        $appBytes += $length + 4 if ($marker & 0xf0) == 0xe0;  # total size of APP segments
    43856414        if ($verbose) {
    43866415            print $out "JPEG $markerName ($length bytes):\n";
     
    43916420            }
    43926421        }
     6422        # prepare dirInfo hash for processing this information
     6423        my %dirInfo = (
     6424            Parent   => $markerName,
     6425            DataPt   => $segDataPt,
     6426            DataPos  => $segPos,
     6427            DataLen  => $length,
     6428            DirStart => 0,
     6429            DirLen   => $length,
     6430            Base     => 0,
     6431        );
    43936432        if ($marker == 0xe0) {              # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad)
    43946433            if ($$segDataPt =~ /^JFIF\0/) {
    43956434                $dumpType = 'JFIF';
    4396                 my %dirInfo = (
    4397                     DataPt => $segDataPt,
    4398                     DataPos  => $segPos,
    4399                     DirStart => 5,
    4400                     DirLen => $length - 5,
    4401                 );
     6435                DirStart(\%dirInfo, 5); # start at byte 5
    44026436                SetByteOrder('MM');
    44036437                my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main');
    44046438                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    4405             } elsif ($$segDataPt =~ /^JFXX\0\x10/) {
     6439            } elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) {
     6440                my $tag = ord $1;
    44066441                $dumpType = 'JFXX';
    44076442                my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension');
    4408                 my $tagInfo = $self->GetTagInfo($tagTablePtr, 0x10);
     6443                my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag);
    44096444                $self->FoundTag($tagInfo, substr($$segDataPt, 6));
    44106445            } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) {
    4411                 next if $fast and $fast > 1;    # skip processing for very fast
     6446                next if $fast > 1;      # skip processing for very fast
    44126447                $dumpType = 'CIFF';
    4413                 my %dirInfo = (
    4414                     RAF => new File::RandomAccess($segDataPt),
    4415                 );
    4416                 $self->{SET_GROUP1} = 'CIFF';
     6448                my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) );
     6449                $$self{SET_GROUP1} = 'CIFF';
     6450                push @{$$self{PATH}}, 'CIFF';
    44176451                require Image::ExifTool::CanonRaw;
    44186452                Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo);
    4419                 delete $self->{SET_GROUP1};
     6453                pop @{$$self{PATH}};
     6454                delete $$self{SET_GROUP1};
    44206455            } elsif ($$segDataPt =~ /^(AVI1|Ocad)/) {
    44216456                $dumpType = $1;
    44226457                SetByteOrder('MM');
    44236458                my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType");
    4424                 my %dirInfo = (
    4425                     DataPt   => $segDataPt,
    4426                     DataPos  => $segPos,
    4427                     DirStart => 4,
    4428                     DirLen   => $length - 4,
    4429                 );
     6459                DirStart(\%dirInfo, 4);
    44306460                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    44316461            }
    4432         } elsif ($marker == 0xe1) {         # APP1 (EXIF, XMP, QVCI)
    4433             if ($$segDataPt =~ /^Exif\0/) { # (some Kodak cameras don't put a second \0)
     6462        } elsif ($marker == 0xe1) {         # APP1 (EXIF, XMP, QVCI, PARROT)
     6463            # (some Kodak cameras don't put a second "\0", and I have seen an
     6464            #  example where there was a second 4-byte APP1 segment header)
     6465            if ($$segDataPt =~ /^(.{0,4})Exif\0/is) {
    44346466                undef $dumpType;    # (will be dumped here)
    44356467                # this is EXIF data --
    44366468                # get the data block (into a common variable)
    44376469                my $hdrLen = length($exifAPP1hdr);
    4438                 my %dirInfo = (
    4439                     Parent => $markerName,
    4440                     DataPt => $segDataPt,
    4441                     DataPos => $segPos,
    4442                     DirStart => $hdrLen,
    4443                     Base => $segPos + $hdrLen,
    4444                 );
     6470                if (length $1) {
     6471                    $hdrLen += length $1;
     6472                    $self->Warn('Unknown garbage at start of EXIF segment',1);
     6473                } elsif ($$segDataPt !~ /^Exif\0/) {
     6474                    $self->Warn('Incorrect EXIF segment identifier',1);
     6475                }
    44456476                if ($htmlDump) {
    44466477                    $self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes");
     
    44486479                    $dumpEnd = $segPos + $length;
    44496480                }
     6481                my $dataPt = $segDataPt;
     6482                if (defined $combinedSegData) {
     6483                    push @skipData, [ $segPos-4, $segPos+$hdrLen ];
     6484                    $combinedSegData .= substr($$segDataPt,$hdrLen);
     6485                    undef $$segDataPt;
     6486                    $dataPt = \$combinedSegData;
     6487                    $segPos = $firstSegPos;
     6488                }
     6489                # peek ahead to see if the next segment is extended EXIF
     6490                if ($nextMarker == $marker and
     6491                    $$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/)
     6492                {
     6493                    # initialize combined data if necessary
     6494                    unless (defined $combinedSegData) {
     6495                        $combinedSegData = $$segDataPt;
     6496                        undef $$segDataPt;
     6497                        $firstSegPos = $segPos;
     6498                        $self->Warn('File contains multi-segment EXIF',1);
     6499                        $$self{ExtendedEXIF} = 1;
     6500                    }
     6501                    next;
     6502                }
     6503                $dirInfo{DataPt} = $dataPt;
     6504                $dirInfo{DataPos} = $segPos;
     6505                $dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt;
     6506                DirStart(\%dirInfo, $hdrLen, $hdrLen);
     6507                $$self{SkipData} = \@skipData if @skipData;
    44506508                # extract the EXIF information (it is in standard TIFF format)
    4451                 $self->ProcessTIFF(\%dirInfo);
     6509                $self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment');
    44526510                # avoid looking for preview unless necessary because it really slows
    44536511                # us down -- only look for it if we found pointer, and preview is
    44546512                # outside EXIF, and PreviewImage is specifically requested
    4455                 my $start = $self->GetValue('PreviewImageStart');
    4456                 my $length = $self->GetValue('PreviewImageLength');
    4457                 if (not $start or not $length and $$self{PreviewError}) {
     6513                my $start = $self->GetValue('PreviewImageStart', 'ValueConv');
     6514                my $plen = $self->GetValue('PreviewImageLength', 'ValueConv');
     6515                if (not $start or not $plen and $$self{PreviewError}) {
    44586516                    $start = $$self{PreviewImageStart};
    4459                     $length = $$self{PreviewImageLength};
    4460                 }
    4461                 if ($start and $length and
    4462                     $start + $length > $self->{EXIF_POS} + length($self->{EXIF_DATA}) and
    4463                     $self->{REQ_TAG_LOOKUP}{previewimage})
     6517                    $plen = $$self{PreviewImageLength};
     6518                }
     6519                if ($start and $plen and IsInt($start) and IsInt($plen) and
     6520                    $start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and
     6521                    ($$self{REQ_TAG_LOOKUP}{previewimage} or
     6522                    # (extracted normally, so check Binary option)
     6523                    ($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage})))
    44646524                {
    44656525                    $$self{PreviewImageStart} = $start;
    4466                     $$self{PreviewImageLength} = $length;
     6526                    $$self{PreviewImageLength} = $plen;
    44676527                    $wantTrailer = 1;
    44686528                }
     6529                if (@skipData) {
     6530                    undef @skipData;
     6531                    delete $$self{SkipData};
     6532                }
     6533                undef $$dataPt;
     6534                next;
    44696535            } elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) {
    44706536                # off len -- extended XMP header (75 bytes total):
     
    44746540                #  71   4 bytes - offset for this XMP data portion
    44756541                $dumpType = 'Extended XMP';
    4476                 if (length $$segDataPt > 75) {
     6542                if ($length > 75) {
    44776543                    my ($size, $off) = unpack('x67N2', $$segDataPt);
    44786544                    my $guid = substr($$segDataPt, 35, 32);
    4479                     my $extXMP = $extendedXMP{$guid};
    4480                     $extXMP or $extXMP = $extendedXMP{$guid} = { };
    4481                     $$extXMP{Size} = $size;
    4482                     $$extXMP{$off} = substr($$segDataPt, 75);
    4483                     # process extended XMP if complete
    4484                     my @offsets;
    4485                     for ($off=0; $off<$size; ) {
    4486                         last unless defined $$extXMP{$off};
    4487                         push @offsets, $off;
    4488                         $off += length $$extXMP{$off};
    4489                     }
    4490                     if ($off == $size) {
    4491                         my $buff = '';
    4492                         # assemble XMP all together
    4493                         $buff .= $$extXMP{$_} foreach @offsets;
    4494                         $dumpType = 'Extended XMP';
    4495                         my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
    4496                         my %dirInfo = (
    4497                             DataPt   => \$buff,
    4498                             Parent   => $markerName,
    4499                         );
    4500                         $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    4501                         delete $extendedXMP{$guid};
     6545                    if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase)
     6546                        $self->WarnOnce($tip = 'Invalid extended XMP GUID');
     6547                    } else {
     6548                        my $extXMP = $extendedXMP{$guid};
     6549                        if (not $extXMP) {
     6550                            $extXMP = $extendedXMP{$guid} = { };
     6551                        } elsif ($size != $$extXMP{Size}) {
     6552                            $self->WarnOnce('Inconsistent extended XMP size');
     6553                        }
     6554                        $$extXMP{Size} = $size;
     6555                        $$extXMP{$off} = substr($$segDataPt, 75);
     6556                        $tip = "Full length: $size\nChunk offset: $off\nChunk length: " .
     6557                            ($length - 75) . "\nGUID: $guid";
     6558                        # (delay processing extended XMP until after reading all segments)
    45026559                    }
    45036560                } else {
    4504                     $self->Warn('Invalid extended XMP segment');
     6561                    $self->WarnOnce($tip = 'Invalid extended XMP segment');
    45056562                }
    45066563            } elsif ($$segDataPt =~ /^QVCI\0/) {
    45076564                $dumpType = 'QVCI';
    45086565                my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI');
    4509                 my %dirInfo = (
    4510                     Base     => 0,
    4511                     DataPt   => $segDataPt,
    4512                     DataPos  => $segPos,
    4513                     DataLen  => $length,
    4514                     DirStart => 0,
    4515                     DirLen   => $length,
    4516                     Parent   => $markerName,
    4517                 );
    45186566                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6567            } elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) {
     6568                $dumpType = 'FLIR';
     6569                # must concatenate FLIR chunks (note: handle the case where
     6570                # some software erroneously writes zeros for the chunk counts)
     6571                my $chunkNum = Get8u($segDataPt, 6);
     6572                my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!)
     6573                $verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n",
     6574                                    $chunkNum + 1, $chunksTot;
     6575                if (defined $flirTotal) {
     6576                    # abort parsing FLIR if the total chunk count is inconsistent
     6577                    undef $flirCount if $chunksTot != $flirTotal;
     6578                } else {
     6579                    $flirCount = 0;
     6580                    $flirTotal = $chunksTot;
     6581                }
     6582                if (defined $flirCount) {
     6583                    if (defined $flirChunk[$chunkNum]) {
     6584                        $self->WarnOnce('Duplicate FLIR chunk number(s)');
     6585                        $flirChunk[$chunkNum] .= substr($$segDataPt, 8);
     6586                    } else {
     6587                        $flirChunk[$chunkNum] = substr($$segDataPt, 8);
     6588                    }
     6589                    # process the FLIR information if we have all of the chunks
     6590                    if (++$flirCount >= $flirTotal) {
     6591                        my $flir = '';
     6592                        defined $_ and $flir .= $_ foreach @flirChunk;
     6593                        undef @flirChunk;   # free memory
     6594                        my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF');
     6595                        my %dirInfo = (
     6596                            DataPt   => \$flir,
     6597                            Parent   => $markerName,
     6598                            DirName  => 'FLIR',
     6599                        );
     6600                        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6601                        undef $flirCount;   # prevent reprocessing
     6602                    }
     6603                } else {
     6604                    $self->WarnOnce('Invalid or extraneous FLIR chunk(s)');
     6605                }
     6606            } elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) {
     6607                # (don't know if this could span multiple segments)
     6608                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main');
     6609                $self->HandleTag($tagTablePtr, 'APP1', $$segDataPt);
     6610                $dumpType = 'Parrot';
    45196611            } else {
    45206612                # Hmmm.  Could be XMP, let's see
    45216613                my $processed;
    4522                 if ($$segDataPt =~ /^http/ or $$segDataPt =~ /<exif:/) {
     6614                if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) {
    45236615                    $dumpType = 'XMP';
    45246616                    # also try to parse XMP with a non-standard header
     
    45266618                    my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0;
    45276619                    my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
    4528                     my %dirInfo = (
    4529                         Base     => 0,
    4530                         DataPt   => $segDataPt,
    4531                         DataPos  => $segPos,
    4532                         DataLen  => $length,
    4533                         DirStart => $start,
    4534                         DirLen   => $length - $start,
    4535                         Parent   => $markerName,
    4536                     );
     6620                    DirStart(\%dirInfo, $start);
     6621                    $dirInfo{DirName} = $start ? 'XMP' : 'XML',
    45376622                    $processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    45386623                    if ($processed and not $start) {
     
    45416626                }
    45426627                if ($verbose and not $processed) {
    4543                     $self->Warn("Ignored EXIF block length $length (bad header)");
     6628                    $self->Warn("Ignored APP1 segment length $length (unknown header)");
    45446629                }
    45456630            }
    45466631        } elsif ($marker == 0xe2) {         # APP2 (ICC Profile, FPXR, MPF, PreviewImage)
    4547             if ($$segDataPt =~ /^ICC_PROFILE\0/) {
     6632            if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) {
    45486633                $dumpType = 'ICC_Profile';
    4549                 # must concatenate blocks of profile
    4550                 my $block_num = Get8u($segDataPt, 12);
    4551                 my $blocks_tot = Get8u($segDataPt, 13);
    4552                 $icc_profile = '' if $block_num == 1;
    4553                 if (defined $icc_profile) {
    4554                     $icc_profile .= substr($$segDataPt, 14);
    4555                     if ($block_num == $blocks_tot) {
     6634                # must concatenate profile chunks (note: handle the case where
     6635                # some software erroneously writes zeros for the chunk counts)
     6636                my $chunkNum = Get8u($segDataPt, 12);
     6637                my $chunksTot = Get8u($segDataPt, 13);
     6638                $verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n";
     6639                if (defined $iccChunksTotal) {
     6640                    # abort parsing ICC_Profile if the total chunk count is inconsistent
     6641                    undef $iccChunkCount if $chunksTot != $iccChunksTotal;
     6642                } else {
     6643                    $iccChunkCount = 0;
     6644                    $iccChunksTotal = $chunksTot;
     6645                    $self->Warn('ICC_Profile chunk count is zero') if !$chunksTot;
     6646                }
     6647                if (defined $iccChunkCount) {
     6648                    if (defined $iccChunk[$chunkNum]) {
     6649                        $self->WarnOnce('Duplicate ICC_Profile chunk number(s)');
     6650                        $iccChunk[$chunkNum] .= substr($$segDataPt, 14);
     6651                    } else {
     6652                        $iccChunk[$chunkNum] = substr($$segDataPt, 14);
     6653                    }
     6654                    # process profile if we have all of the chunks
     6655                    if (++$iccChunkCount >= $iccChunksTotal) {
     6656                        my $icc_profile = '';
     6657                        defined $_ and $icc_profile .= $_ foreach @iccChunk;
     6658                        undef @iccChunk;   # free memory
    45566659                        my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
    45576660                        my %dirInfo = (
     
    45646667                        );
    45656668                        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    4566                         undef $icc_profile;
     6669                        undef $iccChunkCount;     # prevent reprocessing
    45676670                    }
     6671                } else {
     6672                    $self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)');
    45686673                }
    45696674            } elsif ($$segDataPt =~ /^FPXR\0/) {
    4570                 next if $fast and $fast > 1;    # skip processing for very fast
     6675                next if $fast > 1;      # skip processing for very fast
    45716676                $dumpType = 'FPXR';
    45726677                my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
    4573                 my %dirInfo = (
    4574                     DataPt   => $segDataPt,
    4575                     DataPos  => $segPos,
    4576                     DataLen  => $length,
    4577                     DirStart => 0,
    4578                     DirLen   => $length,
    4579                     Parent   => $markerName,
    4580                     # set flag if this is the last FPXR segment
    4581                     LastFPXR => not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
    4582                 );
     6678                # set flag if this is the last FPXR segment
     6679                $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
    45836680                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    45846681            } elsif ($$segDataPt =~ /^MPF\0/) {
    45856682                undef $dumpType;    # (will be dumped here)
    4586                 my %dirInfo = (
    4587                     Parent => $markerName,
    4588                     DataPt => $segDataPt,
    4589                     DataPos => $segPos,
    4590                     DirStart => 4,
    4591                     Base => $segPos + 4,
    4592                     Multi => 1, # the MP Attribute IFD will be MPF1
    4593                 );
     6683                DirStart(\%dirInfo, 4, 4);
     6684                $dirInfo{Multi} = 1;    # the MP Attribute IFD will be MPF1
    45946685                if ($htmlDump) {
    45956686                    $self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes");
     
    46006691                my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main');
    46016692                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
    4602             } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) {
    4603                 $preview = $$segDataPt;
    4604                 $dumpType = 'Samsung Preview';
     6693            } elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) {
     6694                # Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0",
     6695                # Digilife DDC-690/Rollei="BGTH"
     6696                $dumpType = 'Preview Image';
     6697                $preview = substr($$segDataPt, length($1));
    46056698            } elsif ($preview) {
     6699                $dumpType = 'Preview Image';
    46066700                $preview .= $$segDataPt;
    4607                 $dumpType = 'Samsung Preview';
    46086701            }
    46096702            if ($preview and $nextMarker ne $marker) {
     
    46146707            if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) {
    46156708                undef $dumpType;    # (will be dumped here)
    4616                 my %dirInfo = (
    4617                     Parent => $markerName,
    4618                     DataPt => $segDataPt,
    4619                     DataPos => $segPos,
    4620                     DirStart => 6,
    4621                     Base => $segPos + 6,
    4622                 );
     6709                DirStart(\%dirInfo, 6, 6);
    46236710                if ($htmlDump) {
    46246711                    $self->HDump($segPos-4, 10, 'APP3 Meta header');
     
    46296716            } elsif ($$segDataPt =~ /^Stim\0/) {
    46306717                undef $dumpType;    # (will be dumped here)
    4631                 my %dirInfo = (
    4632                     Parent => $markerName,
    4633                     DataPt => $segDataPt,
    4634                     DataPos => $segPos,
    4635                     DirStart => 6,
    4636                     Base => $segPos + 6,
    4637                 );
     6718                DirStart(\%dirInfo, 6, 6);
    46386719                if ($htmlDump) {
    46396720                    $self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes");
     
    46446725                my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main');
    46456726                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
     6727            } elsif ($$self{Make} eq 'DJI') {
     6728                $dumpType = 'DJI ThermalData';
     6729                # add this data to the combined data if it exists
     6730                my $dataPt = $segDataPt;
     6731                if (defined $combinedSegData) {
     6732                    $combinedSegData .= $$segDataPt;
     6733                    $dataPt = \$combinedSegData;
     6734                }
     6735                if ($nextMarker == $marker) {
     6736                    $combinedSegData = $$segDataPt unless defined $combinedSegData;
     6737                } else {
     6738                    # process DJI FLIR thermal data
     6739                    my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main');
     6740                    $self->HandleTag($tagTablePtr, 'APP3', $$dataPt);
     6741                    undef $combinedSegData;
     6742                }
    46466743            } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) {
     6744                $dumpType = 'PreviewImage'; # (Samsung, HP, BenQ)
    46476745                $preview = $$segDataPt;
    4648                 $dumpType = 'Samsung/HP Preview';
    4649             }
    4650             # Samsung continues the preview in APP4
    4651             if ($preview and $nextMarker ne 0xe4) {
     6746            }
     6747            if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4
    46526748                $self->FoundTag('PreviewImage', $preview);
    46536749                undef $preview;
     
    46686764                        DataPt => \$scalado,
    46696765                    );
    4670                     my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Scalado');
     6766                    my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main');
    46716767                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    46726768                    undef $scalado;
    46736769                }
    46746770            } elsif ($$segDataPt =~ /^FPXR\0/) {
    4675                 next if $fast and $fast > 1;    # skip processing for very fast
     6771                next if $fast > 1;      # skip processing for very fast
    46766772                $dumpType = 'FPXR';
    46776773                my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
    4678                 my %dirInfo = (
    4679                     DataPt   => $segDataPt,
    4680                     DataPos  => $segPos,
    4681                     DataLen  => $length,
    4682                     DirStart => 0,
    4683                     DirLen   => $length,
    4684                     Parent   => $markerName,
    4685                     # set flag if this is the last FPXR segment
    4686                     LastFPXR => not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
    4687                 );
     6774                # set flag if this is the last FPXR segment
     6775                $dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/),
     6776                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6777            } elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^\xaa\x55\x12\x06/) {
     6778                $dumpType = 'DJI ThermalParams';
     6779                DirStart(\%dirInfo, 0, 0);
     6780                my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams');
    46886781                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    46896782            } elsif ($preview) {
    46906783                # continued Samsung S1060 preview from APP3
     6784                $dumpType = 'PreviewImage';
    46916785                $preview .= $$segDataPt;
    4692                 # (not sure if next part would be APP5 or APP4 again, but assume APP4)
    4693                 if ($nextMarker ne $marker) {
    4694                     $self->FoundTag('PreviewImage', $preview);
    4695                     undef $preview;
    4696                 }
     6786            }
     6787            # (also seen "QTI Debug Metadata\0" segment in some newer Samsung images)
     6788            # BenQ DC E1050 continues preview in APP5
     6789            if ($preview and $nextMarker ne 0xe5) {
     6790                $self->FoundTag('PreviewImage', $preview);
     6791                undef $preview;
    46976792            }
    46986793        } elsif ($marker == 0xe5) {         # APP5 (Ricoh "RMETA")
    46996794            if ($$segDataPt =~ /^RMETA\0/) {
     6795                # (NOTE: apparently these may span multiple segments, but I haven't seen
     6796                # a sample like this, so multi-segment support hasn't yet been implemented)
    47006797                $dumpType = 'Ricoh RMETA';
    4701                 my %dirInfo = (
    4702                     Parent => $markerName,
    4703                     DataPt => $segDataPt,
    4704                     DataPos => $segPos,
    4705                     DirStart => 6,
    4706                     Base => $segPos + 6,
    4707                 );
     6798                DirStart(\%dirInfo, 6, 6);
    47086799                my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA');
    47096800                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6801            } elsif ($$segDataPt =~ /^ssuniqueid\0/) {
     6802                my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5');
     6803                $self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11));
     6804            } elsif ($$self{Make} eq 'DJI') {
     6805                $dumpType = 'DJI ThermalCal';
     6806                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main');
     6807                $self->HandleTag($tagTablePtr, 'APP5', $$segDataPt);
     6808            } elsif ($preview) {
     6809                $dumpType = 'PreviewImage';
     6810                $preview .= $$segDataPt;
     6811                $self->FoundTag('PreviewImage', $preview);
     6812                undef $preview;
    47106813            }
    47116814        } elsif ($marker == 0xe6) {         # APP6 (Toshiba EPPIM, NITF, HP_TDHD)
    47126815            if ($$segDataPt =~ /^EPPIM\0/) {
    47136816                undef $dumpType;    # (will be dumped here)
    4714                 my %dirInfo = (
    4715                     Parent => $markerName,
    4716                     DataPt => $segDataPt,
    4717                     DataPos => $segPos,
    4718                     DirStart => 6,
    4719                     Base => $segPos + 6,
    4720                 );
     6817                DirStart(\%dirInfo, 6, 6);
    47216818                if ($htmlDump) {
    47226819                    $self->HDump($segPos-4, 10, 'APP6 EPPIM header');
     
    47296826                SetByteOrder('MM');
    47306827                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF');
    4731                 my %dirInfo = (
    4732                     DataPt   => $segDataPt,
    4733                     DataPos  => $segPos,
    4734                     DirStart => 5,
    4735                     DirLen   => $length - 5,
    4736                 );
     6828                DirStart(\%dirInfo, 5);
    47376829                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    47386830            } elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) {
     
    47406832                $dumpType = 'TDHD';
    47416833                my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD');
    4742                 my %dirInfo = (
    4743                     DataPt   => $segDataPt,
    4744                     DataPos  => $segPos,
    4745                     DirStart => 12, # (ignore first TDHD element because size includes 12-byte tag header)
    4746                     DirLen   => $length - 12,
    4747                 );
     6834                # (ignore first TDHD element because size includes 12-byte tag header)
     6835                DirStart(\%dirInfo, 12);
     6836                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6837            } elsif ($$segDataPt =~ /^GoPro\0/) {
     6838                # GoPro segment
     6839                $dumpType = 'GoPro';
     6840                my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF');
     6841                DirStart(\%dirInfo, 6);
     6842                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6843            } elsif ($$segDataPt =~ /^DTAT\0\0.\{/s) {
     6844                $dumpType = 'DJI_DTAT';
     6845                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main');
     6846                $self->HandleTag($tagTablePtr, 'APP6', $$segDataPt);
     6847            }
     6848        } elsif ($marker == 0xe7) {         # APP7 (Pentax, Huawei, Qualcomm)
     6849            if ($$segDataPt =~ /^PENTAX \0(II|MM)/) {
     6850                # found in K-3 images (is this multi-segment??)
     6851                SetByteOrder($1);
     6852                undef $dumpType; # (dump this ourself)
     6853                my $hdrLen = 10;
     6854                my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main');
     6855                DirStart(\%dirInfo, $hdrLen, 0);
     6856                $dirInfo{DirName} = 'Pentax APP7';
     6857                if ($htmlDump) {
     6858                    $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes");
     6859                    $self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax');
     6860                    $dumpEnd = $segPos + $length;
     6861                }
     6862                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6863            } elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) {
     6864                SetByteOrder($1);
     6865                undef $dumpType; # (dump this ourself)
     6866                my $hdrLen = 16;
     6867                my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main');
     6868                DirStart(\%dirInfo, $hdrLen, 8);
     6869                $dirInfo{DirName} = 'Huawei APP7';
     6870                if ($htmlDump) {
     6871                    $self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes");
     6872                    $self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei');
     6873                    $dumpEnd = $segPos + $length;
     6874                }
     6875                $$self{SET_GROUP0} = 'APP7';
     6876                $$self{SET_GROUP1} = 'Huawei';
     6877                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6878                delete $$self{SET_GROUP0};
     6879                delete $$self{SET_GROUP1};
     6880            } elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) {
     6881                # found in HP iPAQ_VoiceMessenger
     6882                $dumpType = 'Qualcomm';
     6883                my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main');
     6884                DirStart(\%dirInfo, 27);
     6885                $dirInfo{DirName} = 'Qualcomm';
    47486886                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    47496887            }
     
    47526890            if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) {
    47536891                $dumpType = 'SPIFF';
    4754                 my %dirInfo = (
    4755                     DataPt => $segDataPt,
    4756                     DataPos  => $segPos,
    4757                     DirStart => 6,
    4758                     DirLen => $length - 6,
    4759                 );
     6892                DirStart(\%dirInfo, 6);
    47606893                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF');
    47616894                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6895            }
     6896        } elsif ($marker == 0xe9) {         # APP9 (Media Jukebox)
     6897            if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) {
     6898                $dumpType = 'MediaJukebox';
     6899                # (start parsing after the "<MJMD>")
     6900                DirStart(\%dirInfo, 22);
     6901                $dirInfo{DirName} = 'MediaJukebox';
     6902                require Image::ExifTool::XMP;
     6903                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox');
     6904                $self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP);
    47626905            }
    47636906        } elsif ($marker == 0xea) {         # APP10 (PhotoStudio Unicode comments)
     
    47666909                my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM');
    47676910                $self->FoundTag('Comment', $comment);
     6911            } elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) {
     6912                # iPhone "AROT" segment containing integrated intensity per 16 scan lines
     6913                # (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz)
     6914                $xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')';
     6915            }
     6916        } elsif ($marker == 0xeb) {         # APP11 (JPEG-HDR)
     6917            if ($$segDataPt =~ /^HDR_RI /) {
     6918                $dumpType = 'JPEG-HDR';
     6919                my $dataPt = $segDataPt;
     6920                if (defined $combinedSegData) {
     6921                    if ($$segDataPt =~ /~\0/g) {
     6922                        $combinedSegData .= substr($$segDataPt,pos($$segDataPt));
     6923                    } else {
     6924                        $self->Warn('Invalid format for JPEG-HDR extended segment');
     6925                    }
     6926                    $dataPt = \$combinedSegData;
     6927                }
     6928                if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) {
     6929                    $combinedSegData = $$segDataPt unless defined $combinedSegData;
     6930                } else {
     6931                    my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR');
     6932                    my %dirInfo = ( DataPt => $dataPt );
     6933                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     6934                    undef $combinedSegData;
     6935                }
    47686936            }
    47696937        } elsif ($marker == 0xec) {         # APP12 (Ducky, Picture Info)
    47706938            if ($$segDataPt =~ /^Ducky/) {
    47716939                $dumpType = 'Ducky';
    4772                 my %dirInfo = (
    4773                     DataPt => $segDataPt,
    4774                     DataPos => $segPos,
    4775                     DirStart => 5,
    4776                     DirLen => $length - 5,
    4777                 );
     6940                DirStart(\%dirInfo, 5);
    47786941                my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky');
    47796942                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    47806943            } else {
    4781                 my %dirInfo = ( DataPt => $segDataPt );
    47826944                my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo');
    47836945                $self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info';
     
    47996961                    # (will handle the Photoshop data the next time around)
    48006962                } else {
    4801                     my $hdrlen = $isOld ? 27 : 14;
     6963                    my $hdrLen = $isOld ? 27 : 14;
    48026964                    # process APP13 Photoshop record
    48036965                    my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
     
    48066968                        DataPos  => $segPos,
    48076969                        DataLen  => length $$dataPt,
    4808                         DirStart => $hdrlen,    # directory starts after identifier
    4809                         DirLen   => length($$dataPt) - $hdrlen,
     6970                        DirStart => $hdrLen,    # directory starts after identifier
     6971                        DirLen   => length($$dataPt) - $hdrLen,
    48106972                        Parent   => $markerName,
    48116973                    );
     
    48176979                SetByteOrder('MM');
    48186980                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM');
    4819                 my %dirInfo = (
    4820                     DataPt   => $segDataPt,
    4821                     DataPos  => $segPos,
    4822                     DirStart => 8,
    4823                     DirLen   => $length - 8,
    4824                 );
     6981                DirStart(\%dirInfo, 8);
    48256982                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    48266983            }
    48276984        } elsif ($marker == 0xee) {         # APP14 (Adobe)
    48286985            if ($$segDataPt =~ /^Adobe/) {
     6986                # extract as a block if requested, or if copying tags from file
     6987                if ($$self{REQ_TAG_LOOKUP}{adobe} or
     6988                    # (not extracted normally, so check TAGS_FROM_FILE)
     6989                    ($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe}))
     6990                {
     6991                    $self->FoundTag('Adobe', $$segDataPt);
     6992                }
    48296993                $dumpType = 'Adobe';
    48306994                SetByteOrder('MM');
    48316995                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe');
    4832                 my %dirInfo = (
    4833                     DataPt   => $segDataPt,
    4834                     DataPos  => $segPos,
    4835                     DirStart => 5,
    4836                     DirLen   => $length - 5,
    4837                 );
     6996                DirStart(\%dirInfo, 5);
    48386997                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    48396998            }
     
    48487007            $$segDataPt =~ s/\0+$//;    # some dumb softwares add null terminators
    48497008            $self->FoundTag('Comment', $$segDataPt);
     7009        } elsif ($marker == 0x64) {         # CME (J2C comment and extension)
     7010            $dumpType = 'Comment';
     7011            if ($length > 2) {
     7012                my $reg = unpack('n', $$segDataPt); # get registration value
     7013                my $val = substr($$segDataPt, 2);
     7014                $val = $self->Decode($val, 'Latin') if $reg == 1;
     7015                # (actually an extension for $reg==65535, but store as binary comment)
     7016                $self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val);
     7017            }
     7018        } elsif ($marker == 0x51) {         # SIZ (J2C)
     7019            my ($w, $h) = unpack('x2N2', $$segDataPt);
     7020            $self->FoundTag('ImageWidth', $w);
     7021            $self->FoundTag('ImageHeight', $h);
    48507022        } elsif (($marker & 0xf0) != 0xe0) {
    4851             undef $dumpType;    # only dump unknown APP segments
     7023            $dumpType = "$markerName segment";
     7024            $desc = "[JPEG $markerName]";   # (other known JPEG segments)
    48527025        }
    48537026        if (defined $dumpType) {
    4854             if (not $dumpType and $self->{OPTIONS}{Unknown}) {
    4855                 $self->Warn("Unknown $markerName segment", 1);
     7027            if (not $dumpType and ($$options{Unknown} or $$options{Validate})) {
     7028                my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : '';
     7029                $xtra = 'segment' unless $xtra;
     7030                $self->Warn("Unknown $markerName$str $xtra", 1);
    48567031            }
    48577032            if ($htmlDump) {
    4858                 my $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
    4859                 $self->HDump($segPos-4, $length+4, $desc, undef, 0x08);
     7033                $desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
     7034                $self->HDump($segPos-4, $length+4, $desc, $tip, 0x08);
    48607035                $dumpEnd = $segPos + $length;
    48617036            }
     
    48637038        undef $$segDataPt;
    48647039    }
     7040    # process extended XMP now if it existed
     7041    if (%extendedXMP) {
     7042        my $guid;
     7043        # GUID indicated by the last main XMP segment
     7044        my $goodGuid = $$self{VALUE}{HasExtendedXMP} || '';
     7045        # GUID of the extended XMP that we will process ('2' for all)
     7046        my $readGuid = $$options{ExtendedXMP} || 0;
     7047        $readGuid = $goodGuid if $readGuid eq '1';
     7048        foreach $guid (sort keys %extendedXMP) {
     7049            next unless length $guid == 32;     # ignore other (internal) keys
     7050            my $extXMP = $extendedXMP{$guid};
     7051            my ($off, @offsets, $warn);
     7052            # make sure we have all chunks, and create a list of sorted offsets
     7053            for ($off=0; $off<$$extXMP{Size}; ) {
     7054                last unless defined $$extXMP{$off};
     7055                push @offsets, $off;
     7056                $off += length $$extXMP{$off};
     7057            }
     7058            unless ($off == $$extXMP{Size}) {
     7059                $self->Warn("Incomplete extended XMP (GUID $guid)");
     7060                next;
     7061            }
     7062            if ($guid eq $readGuid or $readGuid eq '2') {
     7063                $warn = 'Reading non-' if $guid ne $goodGuid;
     7064                my $buff = '';
     7065                # assemble XMP all together
     7066                $buff .= $$extXMP{$_} foreach @offsets;
     7067                my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
     7068                my %dirInfo = (
     7069                    DataPt      => \$buff,
     7070                    Parent      => 'APP1',
     7071                    IsExtended  => 1,
     7072                );
     7073                $$path[$pn] = 'APP1';
     7074                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     7075                pop @$path;
     7076            } else {
     7077                $warn = 'Ignored ';
     7078                $warn .= 'non-' if $guid ne $goodGuid;
     7079            }
     7080            $self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn;
     7081            delete $extendedXMP{$guid};
     7082        }
     7083    }
    48657084    # calculate JPEGDigest if requested
    4866     if (@dqt and $subSampling) {
     7085    if (@dqt) {
    48677086        require Image::ExifTool::JPEGDigest;
    48687087        Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling);
    48697088    }
     7089    # issue necessary warnings
     7090    $self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount;
     7091    $self->Warn('Incomplete FLIR record', 1) if defined $flirCount;
    48707092    $self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError};
    4871     $self->Warn('Invalid extended XMP') if %extendedXMP;
    48727093    $success or $self->Warn('JPEG format error');
    48737094    pop @$path if @$path > $pn;
    48747095    return 1;
     7096}
     7097
     7098#------------------------------------------------------------------------------
     7099# Extract metadata from an Exiv2 EXV file
     7100# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
     7101# Returns: 1 on success, 0 if this wasn't a valid JPEG file
     7102sub ProcessEXV($$)
     7103{
     7104    my ($self, $dirInfo) = @_;
     7105    return $self->ProcessJPEG($dirInfo);
    48757106}
    48767107
     
    49147145    my $base = $$dirInfo{Base} || 0;
    49157146    my $outfile = $$dirInfo{OutFile};
    4916     my ($err, $canonSig, $otherSig);
     7147    my ($err, $sig, $canonSig, $otherSig);
    49177148
    49187149    # attempt to read TIFF header
    4919     $self->{EXIF_DATA} = '';
     7150    $$self{EXIF_DATA} = '';
    49207151    if ($raf) {
    49217152        if ($outfile) {
     
    49307161        # extract full EXIF block (for block copy) from EXIF file
    49317162        my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8;
    4932         my $n = $raf->Read($self->{EXIF_DATA}, $amount);
     7163        my $n = $raf->Read($$self{EXIF_DATA}, $amount);
    49337164        if ($n < 8) {
    49347165            return 0 if $n or not $outfile or $fileType ne 'EXIF';
    49357166            # create EXIF file from scratch
    4936             delete $self->{EXIF_DATA};
     7167            delete $$self{EXIF_DATA};
    49377168            undef $raf;
    49387169        }
     
    49407171            $raf->Seek(8, 0);
    49417172            if ($n == $amount) {
    4942                 $self->{EXIF_DATA} = substr($self->{EXIF_DATA}, 0, 8);
     7173                $$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8);
    49437174                $self->Warn('EXIF too large to extract as a block'); #(shouldn't happen)
    49447175            }
     
    49487179        my $dirStart = $$dirInfo{DirStart} || 0;
    49497180        my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart);
    4950         $self->{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen);
    4951         $self->VerboseDir('TIFF') if $self->{OPTIONS}{Verbose} and length($$self{INDENT}) > 2;
     7181        $$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen);
     7182        $self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2;
    49527183    } elsif ($outfile) {
    4953         delete $self->{EXIF_DATA};  # create from scratch
     7184        delete $$self{EXIF_DATA};  # create from scratch
    49547185    } else {
    4955         $self->{EXIF_DATA} = '';
    4956     }
    4957     unless (defined $self->{EXIF_DATA}) {
     7186        $$self{EXIF_DATA} = '';
     7187    }
     7188    unless (defined $$self{EXIF_DATA}) {
     7189        # set default byte order for creating new GPS in CR3 images
     7190        my $defaultByteOrder;
     7191        if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') {
     7192            $defaultByteOrder = $$self{SaveExifByteOrder};
     7193        }
    49587194        # create TIFF information from scratch
    4959         if ($self->SetPreferredByteOrder() eq 'MM') {
    4960             $self->{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
     7195        if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') {
     7196            $$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
    49617197        } else {
    4962             $self->{EXIF_DATA} = "II\x2a\0\x08\0\0\0";
    4963         }
    4964     }
    4965     $$self{FIRST_EXIF_POS} = $base + $$self{BASE} unless defined $$self{FIRST_EXIF_POS};
     7198            $$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0";
     7199        }
     7200    }
    49667201    $$self{EXIF_POS} = $base + $$self{BASE};
    4967     $dataPt = \$self->{EXIF_DATA};
     7202    $$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS};
     7203    $dataPt = \$$self{EXIF_DATA};
    49687204
    49697205    # set byte ordering
     
    49777213  # (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????)
    49787214  #  return 0 unless $identifier == 0x2a;
     7215    $self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a;
    49797216
    49807217    # get offset to IFD0
     7218    return 0 if length $$dataPt < 8;
    49817219    my $offset = Get32u($dataPt, 4);
    49827220    $offset >= 8 or return 0;
    49837221
    49847222    if ($raf) {
    4985         # Canon CR2 images usually have an offset of 16, but it may be
    4986         # greater if edited by PhotoMechanic, so check the 4-byte signature
     7223        # check for canon or EXIF signature
     7224        # (Canon CR2 images should have an offset of 16, but it may be
     7225        #  greater if edited by PhotoMechanic)
    49877226        if ($identifier == 0x2a and $offset >= 16) {
    4988             $raf->Read($canonSig, 8) == 8 or return 0;
    4989             $$dataPt .= $canonSig;
    4990             if ($canonSig =~ /^(CR\x02\0|\xba\xb0\xac\xbb)/) {
    4991                 $fileType = $canonSig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW';
    4992                 $self->HDump($base+8, 8, "[$fileType header]") if $self->{HTML_DUMP};
    4993             } else {
    4994                 undef $canonSig;
     7227            $raf->Read($sig, 8) == 8 or return 0;
     7228            $$dataPt .= $sig;
     7229            if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) {
     7230                if ($sig eq 'ExifMeta') {
     7231                    $self->SetFileType($fileType = 'EXIF');
     7232                    $otherSig = $sig;
     7233                } else {
     7234                    $fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW';
     7235                    $canonSig = $sig;
     7236                }
     7237                $self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP};
    49957238            }
    49967239        } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) {
     
    50087251            }
    50097252            $tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main');
    5010         } elsif ($identifier == 0x2b and $fileType eq 'TIFF') {
    5011             # this looks like a BigTIFF image
    5012             $raf->Seek(0);
    5013             require Image::ExifTool::BigTIFF;
    5014             return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
    5015         } elsif (Get8u($dataPt, 2) == 0xbc and $byteOrder eq 'II' and $fileType eq 'TIFF') {
    5016             $fileType = 'HDP';  # Windows HD Photo file
    5017             # check version number
    5018             my $ver = Get8u($dataPt, 3);
    5019             if ($ver > 1) {
    5020                 $self->Error("Windows HD Photo version $ver files not yet supported");
    5021                 return 1;
    5022             }
    5023         } elsif ($identifier == 0x4352 and $fileType eq 'TIFF') {
    5024             $fileType = 'DCP';
     7253        } elsif ($fileType eq 'TIFF') {
     7254            if ($identifier == 0x2b) {
     7255                # this looks like a BigTIFF image
     7256                $raf->Seek(0);
     7257                require Image::ExifTool::BigTIFF;
     7258                return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
     7259            } elsif ($identifier == 0x4f52 or $identifier == 0x5352) {
     7260                # Olympus ORF image (set FileType now because base type is 'ORF')
     7261                $self->SetFileType($fileType = 'ORF');
     7262            } elsif ($identifier == 0x4352) {
     7263                $fileType = 'DCP';
     7264            } elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) {
     7265                $fileType = 'HDP';  # Windows HD Photo file
     7266                # check version number
     7267                my $ver = Get8u($dataPt, 3);
     7268                if ($ver > 1) {
     7269                    $self->Error("Windows HD Photo version $ver files not yet supported");
     7270                    return 1;
     7271                }
     7272            }
    50257273        }
    50267274        # we have a valid TIFF (or whatever) file
    5027         if ($fileType and not $self->{VALUE}{FileType}) {
     7275        if ($fileType and not $$self{VALUE}{FileType}) {
    50287276            my $lookup = $fileTypeLookup{$fileType};
    50297277            $lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup;
    50307278            # use file extension to pre-determine type if extension is TIFF-based or type is RAW
    5031             my $t = (($lookup and $$lookup[0] eq 'TIFF') or $fileType =~ /RAW/) ? $fileType : undef;
     7279            my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : '';
     7280            my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef;
    50327281            $self->SetFileType($t);
    50337282        }
    5034     }
    5035     my $ifdName = 'IFD0';
     7283        # don't process file if FastScan == 3
     7284        return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3;
     7285    }
     7286    # (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level)
     7287    my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0';
    50367288    if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') {
    5037         $self->FoundTag('ExifByteOrder', $byteOrder);
     7289        $self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile;
     7290    } elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes)
     7291        $ifdName = $$tagTablePtr{GROUPS}{0};
    50387292    } else {
    50397293        $ifdName = $$tagTablePtr{GROUPS}{1};
    50407294    }
    5041     if ($self->{HTML_DUMP}) {
     7295    if ($$self{HTML_DUMP}) {
    50427296        my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x",
    50437297                          ($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset);
     
    50457299    }
    50467300    # remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...)
    5047     $self->{TIFF_TYPE} = $fileType;
     7301    $$self{TIFF_TYPE} = $fileType;
    50487302
    50497303    # get reference to the main EXIF table
     
    50707324        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    50717325        # process GeoTiff information if available
    5072         if ($self->{VALUE}{GeoTiffDirectory}) {
     7326        if ($$self{VALUE}{GeoTiffDirectory}) {
    50737327            require Image::ExifTool::GeoTiff;
    50747328            Image::ExifTool::GeoTiff::ProcessGeoTiff($self);
     
    50817335                $self->ProcessTrailers($trailInfo);
    50827336            }
    5083             # dump any other known trailer (ie. A100 RAW Data)
     7337            # dump any other known trailer (eg. A100 RAW Data)
    50847338            if ($$self{HTML_DUMP} and $$self{KnownTrailer}) {
    50857339                my $known = $$self{KnownTrailer};
     
    50917345        }
    50927346        # update FileType if necessary now that we know more about the file
    5093         if ($$self{DNGVersion} and $self->{VALUE}{FileType} ne 'DNG') {
     7347        if ($$self{DNGVersion} and $$self{VALUE}{FileType} !~ /^(DNG|GPR)$/) {
    50947348            # override whatever FileType we set since we now know it is DNG
    5095             $self->OverrideFileType('DNG');
     7349            $self->OverrideFileType($$self{TIFF_TYPE} = 'DNG');
    50967350        }
    50977351        return 1;
     
    51017355#
    51027356    if ($$dirInfo{NoTiffEnd}) {
    5103         delete $self->{TIFF_END};
     7357        delete $$self{TIFF_END};
    51047358    } else {
    51057359        # initialize TIFF_END so it will be updated by WriteExif()
    5106         $self->{TIFF_END} = 0;
     7360        $$self{TIFF_END} = 0;
    51077361    }
    51087362    if ($canonSig) {
     
    51147368    } else {
    51157369        # write TIFF header (8 bytes [plus optional signature] followed by IFD)
    5116         $otherSig = '' unless defined $otherSig;
     7370        if ($fileType eq 'EXIF') {
     7371            $otherSig = 'ExifMeta'; # force this signature for all EXIF files
     7372        } elsif (not defined $otherSig) {
     7373            $otherSig = '';
     7374        }
    51177375        my $offset = 8 + length($otherSig);
    51187376        # construct tiff header
     
    51387396                # write any required ARW trailer and patch other ARW quirks
    51397397                require Image::ExifTool::Sony;
    5140                 my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, 
     7398                my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData,
    51417399                                                              $dirInfo{ImageData});
    51427400                $errStr and $self->Error($errStr);
     
    51547412    }
    51557413    # make local copy of TIFF_END now (it may be reset when processing trailers)
    5156     my $tiffEnd = $self->{TIFF_END};
    5157     delete $self->{TIFF_END};
     7414    my $tiffEnd = $$self{TIFF_END};
     7415    delete $$self{TIFF_END};
    51587416
    51597417    # rewrite trailers if they exist
     
    51897447        if ($extra > 0) {
    51907448            my $known = $$self{KnownTrailer};
    5191             if ($self->{DEL_GROUP}{Trailer} and not $known) {
     7449            if ($$self{DEL_GROUP}{Trailer} and not $known) {
    51927450                $self->VPrint(0, "  Deleting unknown trailer ($extra bytes)\n");
    5193                 ++$self->{CHANGED};
     7451                ++$$self{CHANGED};
    51947452            } elsif ($known) {
    51957453                $self->VPrint(0, "  Copying $$known{Name} ($extra bytes)\n");
     
    52287486    if ($$self{DNGVersion}) {
    52297487        my $ver = $$self{DNGVersion};
    5230         # currently support up to DNG version 1.2
    5231         unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.3) {
     7488        # currently support up to DNG version 1.5
     7489        unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.5) {
    52327490            $ver =~ tr/ /./;
    5233             $self->Error("DNG Version $ver not yet supported", 1);
     7491            $self->Error("DNG Version $ver not yet tested", 1);
    52347492        }
    52357493    }
     
    52767534                my $module = $1;
    52777535                if (eval "require $module") {
    5278                     # load additional XMP modules if required
    5279                     if (not %$tableName and $module eq 'Image::ExifTool::XMP') {
    5280                         require 'Image/ExifTool/XMP2.pl';
     7536                    # load additional modules if required
     7537                    if (not %$tableName) {
     7538                        if ($module eq 'Image::ExifTool::XMP') {
     7539                            require 'Image/ExifTool/XMP2.pl';
     7540                        } elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') {
     7541                            require 'Image/ExifTool/QuickTimeStream.pl';
     7542                        }
    52817543                    }
    52827544                } else {
     
    52927554        $table = \%$tableName;
    52937555        use strict 'refs';
     7556        &{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE};
    52947557        $$table{TABLE_NAME} = $tableName;   # set table name
    52957558        ($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://;
     
    53177580        }
    53187581        # generate a tag prefix for unknown tags if necessary
    5319         unless ($$table{TAG_PREFIX}) {
     7582        unless (defined $$table{TAG_PREFIX}) {
    53207583            my $tagPrefix;
    53217584            if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) {
     
    53287591        # set up the new table
    53297592        SetupTagTable($table);
    5330         # add any user-defined tags
    5331         if (%UserDefined and $UserDefined{$tableName}) {
     7593        # add any user-defined tags (except Composite tags, which are handled specially)
     7594        if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) {
    53327595            my $tagID;
    53337596            foreach $tagID (TagTableKeys($UserDefined{$tableName})) {
    5334                 my $tagInfo = $UserDefined{$tableName}{$tagID};
    5335                 if (ref $tagInfo eq 'HASH') {
    5336                     $$tagInfo{Name} or $$tagInfo{Name} = ucfirst($tagID);
    5337                 } else {
    5338                     $tagInfo = { Name => $tagInfo };
    5339                 }
    5340                 if ($$table{WRITABLE} and not defined $$tagInfo{Writable} and
    5341                     not $$tagInfo{SubDirectory})
    5342                 {
    5343                     $$tagInfo{Writable} = $$table{WRITABLE};
    5344                 }
     7597                next if $specialTags{$tagID};
    53457598                delete $$table{$tagID}; # replace any existing entry
    5346                 AddTagToTable($table, $tagID, $tagInfo);
     7599                AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1);
    53477600            }
    53487601        }
     
    53517604        # insert newly loaded table into list
    53527605        $allTables{$tableName} = $table;
     7606    }
     7607    # must check each time to add UserDefined Composite tags because the Composite table
     7608    # may be loaded before the UserDefined tags are available
     7609    if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and
     7610        %UserDefined and $UserDefined{$tableName})
     7611    {
     7612        my $userComp = $UserDefined{$tableName};
     7613        delete $UserDefined{$tableName};        # (must delete first to avoid infinite recursion)
     7614        AddCompositeTags($userComp, 1);
     7615        $UserDefined{$tableName} = $userComp;   # (add back again for adding writable tags later)
     7616        $$table{VARS}{LOADED_USERDEFINED} = 1;  # set flag to avoid doing this again
    53537617    }
    53547618    return $table;
     
    53687632    $proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif;
    53697633    # set directory name from default group0 name if not done already
    5370     $$dirInfo{DirName} or $$dirInfo{DirName} = $tagTablePtr->{GROUPS}{0};
     7634    my $dirName = $$dirInfo{DirName};
     7635    unless ($dirName) {
     7636        $dirName = $$tagTablePtr{GROUPS}{0};
     7637        $dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name)
     7638        $$dirInfo{DirName} = $dirName;
     7639    }
     7640
    53717641    # guard against cyclical recursion into the same directory
    5372     if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos}) {
    5373         my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0);
    5374         if ($self->{PROCESSED}{$addr}) {
    5375             $self->Warn("$$dirInfo{DirName} pointer references previous $self->{PROCESSED}{$addr} directory");
    5376             return 0;
    5377         }
    5378         $self->{PROCESSED}{$addr} = $$dirInfo{DirName};
     7642    if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and
     7643        # directories don't overlap if the length is zero
     7644        ($$dirInfo{DirLen} or not defined $$dirInfo{DirLen}))
     7645    {
     7646        my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE};
     7647        if ($$self{PROCESSED}{$addr}) {
     7648            $self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory");
     7649            # patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer
     7650            return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD';
     7651        }
     7652        $$self{PROCESSED}{$addr} = $dirName;
    53797653    }
    53807654    my $oldOrder = GetByteOrder();
    5381     my $oldIndent = $self->{INDENT};
    5382     my $oldDir = $self->{DIR_NAME};
    5383     $self->{LIST_TAGS} = { };  # don't build lists across different directories
    5384     $self->{INDENT} .= '| ';
    5385     $self->{DIR_NAME} = $$dirInfo{DirName};
    5386     push @{$self->{PATH}}, $$dirInfo{DirName};
     7655    my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'};
     7656    $$self{LIST_TAGS} = { };    # don't build lists across different directories
     7657    $$self{INDENT} .= '| ';
     7658    $$self{DIR_NAME} = $dirName;
     7659    push @{$$self{PATH}}, $dirName;
     7660    $$self{FOUND_DIR}{$dirName} = 1;
    53877661
    53887662    # process the directory
     7663    no strict 'refs';
    53897664    my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr);
    5390 
    5391     pop @{$self->{PATH}};
    5392     $self->{INDENT} = $oldIndent;
    5393     $self->{DIR_NAME} = $oldDir;
     7665    use strict 'refs';
     7666
     7667    pop @{$$self{PATH}};
     7668    @$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save;
    53947669    SetByteOrder($oldOrder);
    53957670    return $rtnVal;
     
    53987673#------------------------------------------------------------------------------
    53997674# Get Metadata path
    5400 # Inputs: 0) Exiftool object ref
     7675# Inputs: 0) ExifTool object ref
    54017676# Return: Metadata path string
    54027677sub MetadataPath($)
     
    54147689    my $filename = shift;
    54157690    my $fileExt;
    5416     if ($filename and $filename =~ /.*\.(.+)$/) {
     7691    if ($filename and $filename =~ /^.*\.([^.]+)$/s) {
    54177692        $fileExt = uc($1);   # change extension to upper case
    54187693        # convert TIF extension to TIFF because we use the
     
    54337708    my $tagInfo = $$tagTablePtr{$tagID};
    54347709
    5435     if (ref $tagInfo eq 'HASH') {
     7710    if ($specialTags{$tagID}) {
     7711        # (hopefully this won't happen)
     7712        warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n";
     7713    } elsif (ref $tagInfo eq 'HASH') {
    54367714        return ($tagInfo);
    54377715    } elsif (ref $tagInfo eq 'ARRAY') {
     
    54777755            }
    54787756        }
    5479         if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and not $$self{OPTIONS}{Verbose}) {
     7757        if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and
     7758            not $$self{OPTIONS}{Verbose} and not $$self{HTML_DUMP})
     7759        {
    54807760            # don't return Unknown tags unless that option is set
    54817761            return undef;
     
    55157795# Add new tag to table (must use this routine to add new tags to a table)
    55167796# Inputs: 0) reference to tag table, 1) tag ID
    5517 #         2) [optional] reference to tag information hash
    5518 # Notes: - will not overwrite existing entry in table
     7797#         2) [optional] tag name or reference to tag information hash
     7798#         3) [optional] flag to avoid adding prefix when generating tag name
     7799# Returns: tagInfo ref
     7800# Notes: - will not override existing entry in table
    55197801# - info need contain no entries when this routine is called
    5520 sub AddTagToTable($$;$)
    5521 {
    5522     my ($tagTablePtr, $tagID, $tagInfo) = @_;
    5523     $tagInfo or $tagInfo = { };
     7802# - tag name is cleaned if necessary
     7803sub AddTagToTable($$;$$)
     7804{
     7805    my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_;
     7806
     7807    # generate tag info hash if necessary
     7808    $tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH';
    55247809
    55257810    # define necessary entries in information hash
     
    55277812        # fill in default groups from table GROUPS
    55287813        foreach (keys %{$$tagTablePtr{GROUPS}}) {
    5529             next if $tagInfo->{Groups}{$_};
    5530             $tagInfo->{Groups}{$_} = $tagTablePtr->{GROUPS}{$_};
     7814            next if $$tagInfo{Groups}{$_};
     7815            $$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_};
    55317816        }
    55327817    } else {
     
    55377822    $$tagInfo{Table} = $tagTablePtr;
    55387823    $$tagInfo{TagID} = $tagID;
     7824    if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) {
     7825        $$tagInfo{Avoid} = $$tagTablePtr{AVOID};
     7826    }
    55397827
    55407828    my $name = $$tagInfo{Name};
    5541     if (defined $name) {
    5542         $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
    5543     } else {
    5544         # construct a name from the tag ID
    5545         $name = $tagID;
    5546         $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
    5547         $name = ucfirst $name;          # start with uppercase
    5548         # make sure name is a reasonable length
    5549         my $prefix = $$tagTablePtr{TAG_PREFIX};
    5550         if ($prefix) {
    5551             # make description to prevent tagID from getting mangled by MakeDescription()
    5552             $$tagInfo{Description} = MakeDescription($prefix, $name);
    5553             $name = "${prefix}_$name";
    5554         }
    5555     }
    5556     # tag names must be at least 2 characters long and begin with a letter
    5557     $name = "Tag$name" if length($name) <= 1 or $name !~ /^[A-Z]/i;
     7829    $name = $tagID unless defined $name;
     7830    $name =~ tr/-_a-zA-Z0-9//dc;    # remove illegal characters
     7831    $name = ucfirst $name;          # capitalize first letter
     7832    # add tag-name prefix if specified and tag name not provided
     7833    unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) {
     7834        # make description to prevent tagID from getting mangled by MakeDescription()
     7835        $$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name);
     7836        $name = "$$tagTablePtr{TAG_PREFIX}_$name";
     7837    }
     7838    # tag names must be at least 2 characters long and prefer them to start with a letter
     7839    $name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i;
    55587840    $$tagInfo{Name} = $name;
    5559     # add tag to table, but never overwrite existing entries (could potentially happen
     7841    # add tag to table, but never override existing entries (could potentially happen
    55607842    # if someone thinks there isn't any tagInfo because a condition wasn't satisfied)
    5561     $$tagTablePtr{$tagID} = $tagInfo unless defined $$tagTablePtr{$tagID};
     7843    unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) {
     7844        $$tagTablePtr{$tagID} = $tagInfo;
     7845    }
     7846    return $tagInfo;
    55627847}
    55637848
     
    55657850# Handle simple extraction of new tag information
    55667851# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value,
    5567 #         4-N) parameters hash: Index, DataPt, DataPos, Start, Size, Parent,
    5568 #              TagInfo, ProcessProc, RAF
     7852#         4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent,
     7853#              TagInfo, ProcessProc, RAF, Format, Count
    55697854# Returns: tag key or undef if tag not found
    55707855# Notes: if value is not defined, it is extracted from DataPt using TagInfo
     
    55737858{
    55747859    my ($self, $tagTablePtr, $tag, $val, %parms) = @_;
    5575     my $verbose = $self->{OPTIONS}{Verbose};
    5576     my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val);
     7860    my $verbose = $$self{OPTIONS}{Verbose};
     7861    my $pfmt = $parms{Format};
     7862    my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count});
    55777863    my $dataPt = $parms{DataPt};
    5578     my ($subdir, $format, $count, $size, $noTagInfo);
     7864    my ($subdir, $format, $noTagInfo, $rational);
    55797865
    55807866    if ($tagInfo) {
    5581         $subdir = $$tagInfo{SubDirectory}
     7867        $subdir = $$tagInfo{SubDirectory};
    55827868    } else {
    55837869        return undef unless $verbose;
     
    55867872    }
    55877873    # read value if not done already (not necessary for subdir)
    5588     unless (defined $val or ($subdir and not $$tagInfo{Writable})) {
     7874    unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) {
    55897875        my $start = $parms{Start} || 0;
    5590         my $size = $parms{Size} || 0;
     7876        my $dLen = $dataPt ? length($$dataPt) : -1;
     7877        my $size = $parms{Size};
     7878        $size = $dLen unless defined $size;
    55917879        # read from data in memory if possible
    5592         if ($dataPt and $start >= 0 and $start + $size <= length($$dataPt)) {
     7880        if ($start >= 0 and $start + $size <= $dLen) {
    55937881            $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT};
     7882            $format = $pfmt if not $format and $pfmt and $formatSize{$pfmt};
    55947883            if ($format) {
    5595                 $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size);
     7884                $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational);
    55967885            } else {
    55977886                $val = substr($$dataPt, $start, $size);
     
    56067895        undef $tagInfo if $noTagInfo;
    56077896        $parms{Value} = $val;
     7897        $parms{Value} .= " ($rational)" if defined $rational;
    56087898        $parms{Table} = $tagTablePtr;
    56097899        if ($format) {
    5610             $count or $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1));
     7900            my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1));
    56117901            $parms{Format} = $format . "[$count]";
    56127902        }
     
    56177907            my $subdirStart = $parms{Start};
    56187908            my $subdirLen = $parms{Size};
     7909            if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) {
     7910                my $conv = $$tagInfo{RawConv};
     7911                local $SIG{'__WARN__'} = \&SetWarning;
     7912                undef $evalWarning;
     7913                if (ref $conv eq 'CODE') {
     7914                    $val = &$conv($val, $self);
     7915                } else {
     7916                    my ($priority, @grps);
     7917                    # NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm
     7918                    #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps)
     7919                    $val = eval $conv;
     7920                    $@ and $evalWarning = $@;
     7921                }
     7922                $self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning;
     7923                return undef unless defined $val;
     7924                $val = $$val if ref $val eq 'SCALAR';
     7925                $dataPt = \$val;
     7926                $subdirStart = 0;
     7927                $subdirLen = length $val;
     7928            }
    56197929            if ($$subdir{Start}) {
    56207930                my $valuePtr = 0;
    56217931                #### eval Start ($valuePtr)
    5622                 my $off = eval $$subdir{Start};               
     7932                my $off = eval $$subdir{Start};
    56237933                $subdirStart += $off;
    56247934                $subdirLen -= $off;
     
    56407950            );
    56417951            my $oldOrder = GetByteOrder();
    5642             SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
     7952            if ($$subdir{ByteOrder}) {
     7953                if ($$subdir{ByteOrder} eq 'Unknown') {
     7954                    if ($subdirStart + 2 <= $subdirLen) {
     7955                        # attempt to determine the byte ordering of an IFD-style subdirectory
     7956                        my $num = Get16u($dataPt, $subdirStart);
     7957                        ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff);
     7958                    }
     7959                } else {
     7960                    SetByteOrder($$subdir{ByteOrder});
     7961                }
     7962            }
    56437963            my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
    56447964            $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc});
     
    56477967            return undef unless $$tagInfo{Writable};
    56487968        }
    5649         return $self->FoundTag($tagInfo, $val);
     7969        my $key = $self->FoundTag($tagInfo, $val);
     7970        # save original components of rational numbers
     7971        $$self{RATIONAL}{$key} = $rational if defined $rational and defined $key;
     7972        return $key;
    56507973    }
    56517974    return undef;
     
    56577980#         1) reference to tagInfo hash or tag name
    56587981#         2) data value (or reference to require hash if Composite)
     7982#         3) optional family 0 group, 4) optional family 1 group
    56597983# Returns: tag key or undef if no value
    5660 sub FoundTag($$$)
     7984sub FoundTag($$$;@)
    56617985{
    56627986    local $_;
    5663     my ($self, $tagInfo, $value) = @_;
    5664     my $tag;
     7987    my ($self, $tagInfo, $value, @grps) = @_;
     7988    my ($tag, $noListDel);
     7989    my $options = $$self{OPTIONS};
    56657990
    56667991    if (ref $tagInfo eq 'HASH') {
     
    56737998        # (not advised to do this since the tag won't show in list)
    56747999        $tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool };
    5675         $self->{OPTIONS}{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
    5676     }
    5677     my $rawValueHash = $self->{VALUE};
     8000        $$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
     8001    }
     8002    # get tag priority
     8003    my $priority = $$tagInfo{Priority};
     8004    unless (defined $priority) {
     8005        $priority = $$tagInfo{Table}{PRIORITY};
     8006        $priority = 0 if not defined $priority and $$tagInfo{Avoid};
     8007    }
     8008    $grps[0] or $grps[0] = $$self{SET_GROUP0};
     8009    $grps[1] or $grps[1] = $$self{SET_GROUP1};
     8010    my $valueHash = $$self{VALUE};
     8011
    56788012    if ($$tagInfo{RawConv}) {
    56798013        # initialize @val for use in Composite RawConv expressions
    56808014        my @val;
    5681         if (ref $value eq 'HASH') {
    5682             foreach (keys %$value) { $val[$_] = $$rawValueHash{$$value{$_}}; }
     8015        if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) {
     8016            foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; }
    56838017        }
    56848018        my $conv = $$tagInfo{RawConv};
     
    56878021        if (ref $conv eq 'CODE') {
    56888022            $value = &$conv($value, $self);
     8023            $$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps};
    56898024        } else {
    5690             my $val = $value;   # must do this in case eval references $val
     8025            my $val = $value;   # do this so eval can use $val
    56918026            # NOTE: RawConv is also evaluated in Writer.pl
    5692             #### eval RawConv ($self, $val, $tag, $tagInfo)
     8027            #### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps)
    56938028            $value = eval $conv;
    56948029            $@ and $evalWarning = $@;
     
    56978032        return undef unless defined $value;
    56988033    }
    5699     # get tag priority
    5700     my $priority = $$tagInfo{Priority};
    5701     defined $priority or $priority = $tagInfo->{Table}{PRIORITY};
    57028034    # handle duplicate tag names
    5703     if (defined $$rawValueHash{$tag}) {
     8035    if (defined $$valueHash{$tag}) {
    57048036        # add to list if there is an active list for this tag
    5705         if ($self->{LIST_TAGS}{$tagInfo}) {
    5706             $tag = $self->{LIST_TAGS}{$tagInfo};  # use key from previous list tag
    5707             if (ref $$rawValueHash{$tag} ne 'ARRAY') {
    5708                 $$rawValueHash{$tag} = [ $$rawValueHash{$tag} ];
    5709             }
    5710             push @{$$rawValueHash{$tag}}, $value;
    5711             return $tag;    # return without creating a new entry
     8037        if ($$self{LIST_TAGS}{$tagInfo}) {
     8038            $tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag
     8039            if (defined $$self{NO_LIST}) {
     8040                # accumulate list in TAG_EXTRA "NoList" element
     8041                if (defined $$self{TAG_EXTRA}{$tag}{NoList}) {
     8042                    push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value;
     8043                } else {
     8044                    $$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ];
     8045                }
     8046                $noListDel = 1; # set flag to delete this tag if re-listed
     8047            } else {
     8048                if (ref $$valueHash{$tag} ne 'ARRAY') {
     8049                    $$valueHash{$tag} = [ $$valueHash{$tag} ];
     8050                }
     8051                push @{$$valueHash{$tag}}, $value;
     8052                return $tag;    # return without creating a new entry
     8053            }
    57128054        }
    57138055        # get next available tag key
    5714         my $nextInd = $self->{DUPL_TAG}{$tag} = ($self->{DUPL_TAG}{$tag} || 0) + 1;
     8056        my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1;
    57158057        my $nextTag = "$tag ($nextInd)";
    57168058#
     
    57188060#
    57198061        # promote existing 0-priority tag so it takes precedence over a new 0-tag
    5720         # (unless old tag was a sub-document and new tag isn't)
    5721         my $oldPriority = $self->{PRIORITY}{$tag};
     8062        # (unless old tag was a sub-document and new tag isn't.  Also, never override
     8063        #  a Warning tag because they may be added by ValueConv, which could be confusing)
     8064        my $oldPriority = $$self{PRIORITY}{$tag};
    57228065        unless ($oldPriority) {
    5723             if ($self->{DOC_NUM} or not $self->{TAG_EXTRA}{$tag} or
    5724                                     not $self->{TAG_EXTRA}{$tag}{G3})
     8066            if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or
     8067                                   not $$self{TAG_EXTRA}{$tag}{G3})
    57258068            {
    57268069                $oldPriority = 1;
     
    57348077            $priority = 1 if not $priority and $$self{DIR_NAME} and
    57358078                             $$self{DIR_NAME} eq $$self{PRIORITY_DIR};
    5736         } elsif ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}}) {
     8079        } elsif ($$self{LOW_PRIORITY_DIR}{'*'} or
     8080            ($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}}))
     8081        {
    57378082            $priority = 0;  # default is 0 for a LOW_PRIORITY_DIR
    57388083        } else {
    57398084            $priority = 1;  # the normal default
    57408085        }
    5741         if ($priority >= $oldPriority and not $self->{DOC_NUM}) {
     8086        if ($priority >= $oldPriority and (not $$self{DOC_NUM} or
     8087            ($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and
     8088             $$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel)
     8089        {
    57428090            # move existing tag out of the way since this tag is higher priority
    5743             $self->{MOVED_KEY} = $nextTag;  # used in BuildCompositeTags()
    5744             $self->{PRIORITY}{$nextTag} = $self->{PRIORITY}{$tag};
    5745             $$rawValueHash{$nextTag} = $$rawValueHash{$tag};
    5746             $self->{FILE_ORDER}{$nextTag} = $self->{FILE_ORDER}{$tag};
    5747             my $oldInfo = $self->{TAG_INFO}{$nextTag} = $self->{TAG_INFO}{$tag};
    5748             if ($self->{TAG_EXTRA}{$tag}) {
    5749                 $self->{TAG_EXTRA}{$nextTag} = $self->{TAG_EXTRA}{$tag};
    5750                 delete $self->{TAG_EXTRA}{$tag};
    5751             }
     8091            # (NOTE: any new members added here must also be added to DeleteTag())
     8092            $$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag};
     8093            $$valueHash{$nextTag} = $$valueHash{$tag};
     8094            $$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag};
     8095            my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag};
     8096            foreach ('TAG_EXTRA','RATIONAL') {
     8097                if ($$self{$_}{$tag}) {
     8098                    $$self{$_}{$nextTag} = $$self{$_}{$tag};
     8099                    delete $$self{$_}{$tag};
     8100                }
     8101            }
     8102            delete $$self{BOTH}{$tag};
    57528103            # update tag key for list if necessary
    5753             $self->{LIST_TAGS}{$oldInfo} = $nextTag if $self->{LIST_TAGS}{$oldInfo};
     8104            $$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo};
     8105            # update this key if used in a Composite tag
     8106            if ($$self{COMP_KEYS}{$tag}) {
     8107                $$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}};
     8108                $$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag};
     8109                delete $$self{COMP_KEYS}{$tag};
     8110            }
    57548111        } else {
    57558112            $tag = $nextTag;        # don't override the existing tag
    57568113        }
    5757         $self->{PRIORITY}{$tag} = $priority;
     8114        $$self{PRIORITY}{$tag} = $priority;
     8115        $$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel;
    57588116    } elsif ($priority) {
    5759         # set tag priority (only if exists and non-zero)
    5760         $self->{PRIORITY}{$tag} = $priority;
     8117        # set tag priority (only if exists and is non-zero)
     8118        $$self{PRIORITY}{$tag} = $priority;
    57618119    }
    57628120
    57638121    # save the raw value, file order, tagInfo ref, group1 name,
    57648122    # and tag key for lists if necessary
    5765     $$rawValueHash{$tag} = $value;
    5766     $self->{FILE_ORDER}{$tag} = ++$self->{NUM_FOUND};
    5767     $self->{TAG_INFO}{$tag} = $tagInfo;
    5768     # set dynamic groups 1 and 3 if necessary
    5769     $self->{TAG_EXTRA}{$tag}{G1} = $self->{SET_GROUP1} if $self->{SET_GROUP1};
    5770     if ($self->{DOC_NUM}) {
    5771         $self->{TAG_EXTRA}{$tag}{G3} = $self->{DOC_NUM};
    5772         if ($self->{DOC_NUM} =~ /^(\d+)/) {
     8123    $$valueHash{$tag} = $value;
     8124    $$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND};
     8125    $$self{TAG_INFO}{$tag} = $tagInfo;
     8126    # set dynamic groups 0, 1 and 3 if necessary
     8127    $$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0];
     8128    $$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1];
     8129    if ($$self{DOC_NUM}) {
     8130        $$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM};
     8131        if ($$self{DOC_NUM} =~ /^(\d+)/) {
    57738132            # keep track of maximum 1st-level sub-document number
    5774             $self->{DOC_COUNT} = $1 unless $self->{DOC_COUNT} >= $1;
     8133            $$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1;
    57758134        }
    57768135    }
    57778136    # save path if requested
    5778     $self->{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $self->{OPTIONS}{SavePath};
     8137    $$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath};
    57798138
    57808139    # remember this tagInfo if we will be accumulating values in a list
    5781     $self->{LIST_TAGS}{$tagInfo} = $tag if $$tagInfo{List} and not $$self{NO_LIST};
     8140    # (but don't override earlier list if this may be deleted by NoListDel flag)
     8141    if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) {
     8142        $$self{LIST_TAGS}{$tagInfo} = $tag;
     8143    }
     8144
     8145    # validate tag if requested (but only for simple values -- could result
     8146    # in infinite recursion if called for a Composite tag (HASH ref value)
     8147    # because FoundTag is called in the middle of building Composite tags
     8148    if ($$options{Validate} and not ref $value) {
     8149        Image::ExifTool::Validate::ValidateRaw($self, $tag, $value);
     8150    }
    57828151
    57838152    return $tag;
     
    57908159{
    57918160    my $self = shift;
    5792     $self->{PRIORITY_DIR} = $self->{DIR_NAME} unless $self->{PRIORITY_DIR};
     8161    $$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR};
    57938162}
    57948163
     
    57998168{
    58008169    my ($self, $tagKey, $extra, $fam) = @_;
    5801     $self->{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra;
     8170    $$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra;
    58028171}
    58038172
     
    58088177{
    58098178    my ($self, $tag) = @_;
    5810     delete $self->{VALUE}{$tag};
    5811     delete $self->{FILE_ORDER}{$tag};
    5812     delete $self->{TAG_INFO}{$tag};
    5813     delete $self->{TAG_EXTRA}{$tag};
     8179    delete $$self{VALUE}{$tag};
     8180    delete $$self{FILE_ORDER}{$tag};
     8181    delete $$self{TAG_INFO}{$tag};
     8182    delete $$self{TAG_EXTRA}{$tag};
     8183    delete $$self{PRIORITY}{$tag};
     8184    delete $$self{RATIONAL}{$tag};
     8185    delete $$self{BOTH}{$tag};
    58148186}
    58158187
     
    58388210#         1) Optional file type (uses FILE_TYPE if not specified)
    58398211#         2) Optional MIME type (uses our lookup if not specified)
     8212#         3) Optional recommended extension (converted to lower case; uses FileType if undef)
    58408213# Notes:  Will NOT set file type twice (subsequent calls ignored)
    5841 sub SetFileType($;$$)
    5842 {
    5843     my ($self, $fileType, $mimeType) = @_;
    5844     unless ($self->{VALUE}{FileType}) {
    5845         my $baseType = $self->{FILE_TYPE};
     8214sub SetFileType($;$$$)
     8215{
     8216    my ($self, $fileType, $mimeType, $normExt) = @_;
     8217    unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) {
     8218        my $baseType = $$self{FILE_TYPE};
     8219        my $ext = $$self{FILE_EXT};
    58468220        $fileType or $fileType = $baseType;
     8221        # handle sub-types which are identified by extension
     8222        if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) {
     8223            my ($f,$e) = @fileTypeLookup{$fileType,$ext};
     8224            if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) {
     8225                # make sure $fileType was a root type and not another sub-type
     8226                $fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]};
     8227            }
     8228        }
    58478229        $mimeType or $mimeType = $mimeType{$fileType};
    58488230        # use base file type if necessary (except if 'TIFF', which is a special case)
    58498231        $mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF';
     8232        unless (defined $normExt) {
     8233            $normExt = $fileTypeExt{$fileType};
     8234            $normExt = $fileType unless defined $normExt;
     8235        }
     8236        $$self{FileType} = $fileType;
    58508237        $self->FoundTag('FileType', $fileType);
     8238        $self->FoundTag('FileTypeExtension', uc $normExt);
    58518239        $self->FoundTag('MIMEType', $mimeType || 'application/unknown');
    58528240    }
     
    58558243#------------------------------------------------------------------------------
    58568244# Override the FileType and MIMEType tags
    5857 # Inputs: 0) ExifTool object ref, 1) file type
     8245# Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension
    58588246# Notes:  does nothing if FileType was not previously defined (ie. when writing)
    5859 sub OverrideFileType($$)
    5860 {
    5861     my ($self, $fileType) = @_;
     8247sub OverrideFileType($$;$$)
     8248{
     8249    my ($self, $fileType, $mimeType, $normExt) = @_;
    58628250    if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) {
     8251        $$self{FileType} = $fileType;
    58638252        $$self{VALUE}{FileType} = $fileType;
    5864         $$self{VALUE}{MIMEType} = $mimeType{$fileType} || 'application/unknown';
     8253        unless (defined $normExt) {
     8254            $normExt = $fileTypeExt{$fileType};
     8255            $normExt = $fileType unless defined $normExt;
     8256        }
     8257        $$self{VALUE}{FileTypeExtension} = uc $normExt;
     8258        $mimeType or $mimeType = $mimeType{$fileType};
     8259        $$self{VALUE}{MIMEType} = $mimeType if $mimeType;
    58658260        if ($$self{OPTIONS}{Verbose}) {
    58668261            $self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n");
    5867             $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $$self{VALUE}{MIMEType}\n");
     8262            $self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n");
     8263            $self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType;
    58688264        }
    58698265    }
     
    58788274    my ($self, $mime) = @_;
    58798275    $mime =~ m{/} or $mime = $mimeType{$mime} or return;
    5880     my $old = $self->{VALUE}{MIMEType};
     8276    my $old = $$self{VALUE}{MIMEType};
    58818277    if (defined $old) {
    58828278        my ($a, $b) = split '/', $old;
    58838279        my ($c, $d) = split '/', $mime;
    58848280        $d =~ s/^x-//;
    5885         $self->{VALUE}{MIMEType} = "$c/$b-$d";
     8281        $$self{VALUE}{MIMEType} = "$c/$b-$d";
    58868282        $self->VPrint(0, "  Modified MIMEType = $c/$b-$d\n");
    58878283    } else {
     
    58978293    my $self = shift;
    58988294    my $level = shift;
    5899     if ($self->{OPTIONS}{Verbose} and $self->{OPTIONS}{Verbose} > $level) {
    5900         my $out = $self->{OPTIONS}{TextOut};
     8295    if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) {
     8296        my $out = $$self{OPTIONS}{TextOut};
    59018297        print $out @_;
    5902     }
     8298        print $out "\n" unless $_[-1] =~ /\n$/;
     8299    }
     8300}
     8301
     8302#------------------------------------------------------------------------------
     8303# Print verbose directory information
     8304# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref
     8305#         2) number of entries in directory (or 0 if unknown)
     8306#         3) optional size of directory in bytes
     8307sub VerboseDir($$;$$)
     8308{
     8309    my ($self, $name, $entries, $size) = @_;
     8310    return unless $$self{OPTIONS}{Verbose};
     8311    if (ref $name eq 'HASH') {
     8312        $size = $$name{DirLen} unless $size;
     8313        $name = $$name{Name} || $$name{DirName};
     8314    }
     8315    my $indent = substr($$self{INDENT}, 0, -2);
     8316    my $out = $$self{OPTIONS}{TextOut};
     8317    my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : '';
     8318    $str .= ", $size bytes" if $size;
     8319    print $out "$indent+ [$name directory$str]\n";
    59038320}
    59048321
     
    59108327    my $self = shift;
    59118328    my $dataPt = shift;
    5912     if ($self->{OPTIONS}{Verbose} and $self->{OPTIONS}{Verbose} > 2) {
     8329    my $verbose = $$self{OPTIONS}{Verbose};
     8330    if ($verbose and $verbose > 2) {
    59138331        my %parms = (
    5914             Prefix => $self->{INDENT},
    5915             Out    => $self->{OPTIONS}{TextOut},
    5916             MaxLen => $self->{OPTIONS}{Verbose} < 4 ? 96 : undef,
     8332            Prefix => $$self{INDENT},
     8333            Out    => $$self{OPTIONS}{TextOut},
     8334            MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef,
    59178335        );
    59188336        HexDump($dataPt, undef, %parms, @_);
    59198337    }
     8338}
     8339
     8340#------------------------------------------------------------------------------
     8341# Print data in hex
     8342# Inputs: 0) data
     8343# Returns: hex string
     8344# (this is a convenience function for use in debugging PrintConv statements)
     8345sub PrintHex($)
     8346{
     8347    my $val = shift;
     8348    return join(' ', unpack('H2' x length($val), $val));
    59208349}
    59218350
     
    59318360    my ($isPreview, $buff);
    59328361
    5933     if ($tag and $tag eq 'PreviewImage') {
    5934         # save PreviewImage start/length in case we want to dump trailer
    5935         $$self{PreviewImageStart} = $offset;
    5936         $$self{PreviewImageLength} = $length;
    5937         $isPreview = 1;
    5938     }
    5939     if ($tag and not $self->{OPTIONS}{Binary} and not $self->{OPTIONS}{Verbose} and
    5940         not $self->{REQ_TAG_LOOKUP}{lc($tag)})
    5941     {
    5942         return "Binary data $length bytes";
    5943     }
    5944     unless ($self->{RAF}->Seek($offset,0)
    5945         and $self->{RAF}->Read($buff, $length) == $length)
     8362    if ($tag) {
     8363        if ($tag eq 'PreviewImage') {
     8364            # save PreviewImage start/length in case we want to dump trailer
     8365            $$self{PreviewImageStart} = $offset;
     8366            $$self{PreviewImageLength} = $length;
     8367            $isPreview = 1;
     8368        }
     8369        my $lcTag = lc $tag;
     8370        if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and
     8371             not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag})
     8372        {
     8373            return "Binary data $length bytes";
     8374        }
     8375    }
     8376    unless ($$self{RAF}->Seek($offset,0)
     8377        and $$self{RAF}->Read($buff, $length) == $length)
    59468378    {
    59478379        $tag or $tag = 'binary data';
     
    59698401    my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset);
    59708402    my $base = $$dirInfo{Base} || 0;
    5971     my $verbose = $self->{OPTIONS}{Verbose};
    5972     my $unknown = $self->{OPTIONS}{Unknown};
     8403    my $verbose = $$self{OPTIONS}{Verbose};
     8404    my $unknown = $$self{OPTIONS}{Unknown};
    59738405    my $dataPos = $$dirInfo{DataPos} || 0;
    59748406
     
    59828414    }
    59838415    # prepare list of tag numbers to extract
    5984     my @tags;
     8416    my (@tags, $topIndex);
    59858417    if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) {
     8418        # don't create a stupid number of tags if data is huge
     8419        my $sizeLimit = $size < 65536 ? $size : 65536;
    59868420        # scan through entire binary table
    5987         @tags = ($$tagTablePtr{FIRST_ENTRY}..(int($size/$increment) - 1));
     8421        $topIndex = int($sizeLimit/$increment);
     8422        @tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1));
    59888423        # add in floating point tag ID's if they exist
    59898424        my @ftags = grep /\./, TagTableKeys($tagTablePtr);
     
    59928427        @tags = @{$$dirInfo{DataMember}};
    59938428        $verbose = 0;   # no verbose output of extracted values when writing
     8429    } elsif ($$dirInfo{MixedTags}) {
     8430        # process sorted integer-ID tags only
     8431        @tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr);
    59948432    } else {
    59958433        # extract known tags in numerical order
    5996         @tags = sort { $a <=> $b } TagTableKeys($tagTablePtr);
     8434        @tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr);
    59978435    }
    59988436    $self->VerboseDir('BinaryData', undef, $size) if $verbose;
     
    60038441    my $varSize = 0;
    60048442    foreach $index (@tags) {
    6005         my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar);
     8443        my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational);
    60068444        if ($$tagTablePtr{$index}) {
    60078445            $tagInfo = $self->GetTagInfo($tagTablePtr, $index);
     
    60098447                next unless defined $tagInfo;
    60108448                my $entry = int($index) * $increment + $varSize;
     8449                if ($entry < 0) {
     8450                    $entry += $size;
     8451                    next if $entry < 0;
     8452                }
    60118453                next if $entry >= $size;
    60128454                my $more = $size - $entry;
     
    60188460            next if $$tagInfo{Unknown} and
    60198461                   ($$tagInfo{Unknown} > $unknown or $index < $nextIndex);
     8462        } elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) {
     8463            $tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next;
    60208464        } else {
    60218465            # don't generate unknown tags in binary tables unless Unknown > 1
     
    60278471        # get relative offset of this entry
    60288472        my $entry = int($index) * $increment + $varSize;
     8473        # allow negative indices to represent bytes from end
     8474        if ($entry < 0) {
     8475            $entry += $size;
     8476            next if $entry < 0;
     8477        }
    60298478        my $more = $size - $entry;
    60308479        last if $more <= 0;     # all done if we have reached the end of data
     
    60508499                $@ and warn("Format $$tagInfo{Name}: $@"), next;
    60518500                next if $count < 0;
    6052                 # allow a variable-length of any format type (with base $count = 1)
     8501                # allow a variable-length value of any format
     8502                # (note: the next incremental index points to data immediately after
     8503                #  this value, regardless of the size of this value, even if it is zero)
    60538504                if ($format =~ s/^var_//) {
    6054                     $varSize += ($count - 1) * ($formatSize{$format} || 1);
     8505                    $varSize += $count * ($formatSize{$format} || 1) - $increment;
     8506                    $wasVar = 1;
    60558507                    # save variable size data if required for writing
    60568508                    if ($$dirInfo{VarFormatData}) {
    6057                         push @{$$dirInfo{VarFormatData}}, $index, $varSize;
     8509                        push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
    60588510                    }
     8511                    # don't extract value if large and we wanted it just to get
     8512                    # the variable-format information when writing
     8513                    next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData};
    60598514                }
    60608515            } elsif ($format =~ /^var_/) {
     
    60698524                    $count = Get8u($dataPt, ($entry++)+$offset);
    60708525                    --$more;
    6071                 } elsif ($format eq 'pstr32') {
     8526                } elsif ($format eq 'pstr32' or $format eq 'ustr32') {
    60728527                    last if $more < 4;
    60738528                    $count = Get32u($dataPt, $entry + $offset);
     8529                    $count *= 2 if $format eq 'ustr32';
    60748530                    $entry += 4;
    60758531                    $more -= 4;
     8532                    $nextIndex += 4 / $increment;   # (increment next index for int32u)
    60768533                } elsif ($format eq 'int16u') {
    60778534                    # int16u size of binary data to follow
     
    60808537                    $varSize -= 2;  # ($count includes size word)
    60818538                    $format = 'undef';
     8539                } elsif ($format eq 'ue7') {
     8540                    require Image::ExifTool::BPG;
     8541                    ($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $offset);
     8542                    last unless defined $val;
     8543                    --$varSize;     # ($count includes base size of 1 byte)
    60828544                } elsif ($$dataPt =~ /\0/g) {
    60838545                    $count = pos($$dataPt) - ($entry+$offset);
     
    60868548                $count = $more if not defined $count or $count > $more;
    60878549                $varSize += $count; # shift subsequent indices
    6088                 $val = substr($$dataPt, $entry+$offset, $count);
    6089                 $val = $self->Decode($val, 'UCS2') if $format eq 'ustring';
    6090                 $val =~ s/\0.*//s unless $format eq 'undef';  # truncate at null
     8550                unless (defined $val) {
     8551                    $val = substr($$dataPt, $entry+$offset, $count);
     8552                    $val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32';
     8553                    $val =~ s/\0.*//s unless $format eq 'undef';  # truncate at null
     8554                }
    60918555                $wasVar = 1;
    60928556                # save variable size data if required for writing
    60938557                if ($$dirInfo{VarFormatData}) {
    6094                     push @{$$dirInfo{VarFormatData}}, $index, $varSize;
     8558                    push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
    60958559                }
    60968560            }
     
    60988562        # hook to allow format, etc to be set dynamically
    60998563        if (defined $$tagInfo{Hook}) {
    6100             #### eval Hook ($format, $varSize)
     8564            my $oldVarSize = $varSize;
     8565            my $pos = $entry + $offset;
     8566            #### eval Hook ($format, $varSize, $size, $dataPt, $pos)
    61018567            eval $$tagInfo{Hook};
    61028568            # save variable size data if required for writing (in case changed by Hook)
    61038569            if ($$dirInfo{VarFormatData}) {
    6104                 $#{$$dirInfo{VarFormatData}} -= 2 if $wasVar; # remove previous entries for this tag
    6105                 push @{$$dirInfo{VarFormatData}}, $index, $varSize;
     8570                $#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag
     8571                push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ];
     8572            } elsif ($varSize != $oldVarSize and $verbose > 2) {
     8573                my ($tmp, $sign) = ($varSize, '+');
     8574                $tmp < 0 and $tmp = -$tmp, $sign = '-';
     8575                $self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index));
    61068576            }
    61078577        }
     
    61138583            $nextIndex = $ni unless $nextIndex > $ni;
    61148584        }
     8585        # allow large tags to be excluded from extraction
     8586        # (provides a work-around for some tight memory situations)
     8587        next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}};
    61158588        # read value now if necessary
    61168589        unless (defined $val and not $$tagInfo{SubDirectory}) {
    6117             $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more);
     8590            $val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational);
    61188591            $mask = $$tagInfo{Mask};
    6119             $val &= $mask if $mask;
     8592            $val = ($val & $mask) >> $$tagInfo{BitShift} if $mask;
    61208593        }
    61218594        if ($verbose and not $$tagInfo{Hidden}) {
     
    61408613        # parse nested BinaryData directories
    61418614        if ($$tagInfo{SubDirectory}) {
    6142             my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}{TagTable});
     8615            my $subdir = $$tagInfo{SubDirectory};
     8616            my $subTablePtr = GetTagTable($$subdir{TagTable});
    61438617            # use specified subdirectory length if given
    61448618            if ($$tagInfo{Format} and $formatSize{$format}) {
     
    61468620                $len = $more if $len > $more;
    61478621            } else {
    6148                 $len = $more;
     8622                $len = $more;   # directory size is all of remaining data
    61498623                if ($$subTablePtr{PROCESS_PROC} and
    61508624                    $$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData)
     
    61548628                }
    61558629            }
     8630            my $subdirBase = $base;
     8631            if (defined $$subdir{Base}) {
     8632                #### eval Base ($start,$base)
     8633                my $start = $entry + $offset + $dataPos;
     8634                $subdirBase = eval($$subdir{Base}) + $base;
     8635            }
     8636            my $start = $$subdir{Start} || 0;
    61568637            my %subdirInfo = (
    61578638                DataPt   => $dataPt,
    61588639                DataPos  => $dataPos,
    6159                 DirStart => $entry + $offset,
    6160                 DirLen   => $len,
    6161                 Base     => $base,
     8640                DataLen  => length $$dataPt,
     8641                DirStart => $entry + $offset + $start,
     8642                DirLen   => $len - $start,
     8643                Base     => $subdirBase,
    61628644            );
    6163             $self->ProcessDirectory(\%subdirInfo, $subTablePtr);
     8645            delete $$self{NO_UNKNOWN};
     8646            $self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc});
     8647            $$self{NO_UNKNOWN} = 1 if $unknown < 2;
    61648648            next;
    61658649        }
    61668650        if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') {
    6167             my $exifTool = $self;
    6168             #### eval IsOffset ($val, $exifTool)
     8651            my $et = $self;
     8652            #### eval IsOffset ($val, $et)
    61698653            $val += $base + $$self{BASE} if eval $$tagInfo{IsOffset};
    61708654        }
    61718655        $val{$index} = $val;
    6172         unless ($self->FoundTag($tagInfo,$val)) {
     8656        my $oldBase;
     8657        if ($$tagInfo{SetBase}) {
     8658            $oldBase = $$self{BASE};
     8659            $$self{BASE} += $base;
     8660        }
     8661        my $key = $self->FoundTag($tagInfo,$val);
     8662        $$self{BASE} = $oldBase if defined $oldBase;
     8663        if ($key) {
     8664            $$self{RATIONAL}{$key} = $rational if defined $rational;
     8665        } else {
    61738666            # don't increment nextIndex if we didn't extract a tag
    61748667            $nextIndex = $saveNextIndex if defined $saveNextIndex;
     
    61838676# (use of noConfig is now deprecated, use configFile = '' instead)
    61848677until ($Image::ExifTool::noConfig) {
    6185     my $file = $Image::ExifTool::configFile;
    6186     if (not defined $file) {
    6187         my $config = '.ExifTool_config';
     8678    my $config = $Image::ExifTool::configFile;
     8679    my $file;
     8680    if (not defined $config) {
     8681        $config = '.ExifTool_config';
    61888682        # get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell)
    61898683        my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} ||
     
    61918685        # look for the config file in 1) the home directory, 2) the program dir
    61928686        $file = "$home/$config";
    6193         -r $file or $file = ($0 =~ /(.*[\\\/])/ ? $1 : './') . $config;
    6194         -r $file or last;
    61958687    } else {
    6196         length $file or last;   # filename of "" disables configuration
    6197         -r $file or warn("Config file not found\n"), last;
    6198     }
    6199     eval "require '$file'"; # load the config file
     8688        length $config or last; # filename of "" disables configuration
     8689        $file = $config;
     8690    }
     8691    # also check executable directory unless path is absolute
     8692    $exePath = $0 unless defined $exePath; # (undocumented $exePath setting)
     8693    -r $file or $config =~ /^\// or $file = ($exePath =~ /(.*[\\\/])/ ? $1 : './') . $config;
     8694    unless (-r $file) {
     8695        warn("Config file not found\n") if defined $Image::ExifTool::configFile;
     8696        last;
     8697    }
     8698    unshift @INC, '.';      # look in current directory first
     8699    eval { require $file }; # load the config file
     8700    shift @INC;
    62008701    # print warning (minus "Compilation failed" part)
    62018702    $@ and $_=$@, s/Compilation failed.*//s, warn $_;
    6202     if (@Image::ExifTool::UserDefined::Lenses) {
    6203         foreach (@Image::ExifTool::UserDefined::Lenses) {
    6204             $Image::ExifTool::userLens{$_} = 1;
    6205         }
    6206     }
    62078703    last;
    62088704}
     8705# read user-defined lenses (may have been defined by script instead of config file)
     8706if (@Image::ExifTool::UserDefined::Lenses) {
     8707    foreach (@Image::ExifTool::UserDefined::Lenses) {
     8708        $Image::ExifTool::userLens{$_} = 1;
     8709    }
     8710}
     8711# add user-defined file types
     8712if (%Image::ExifTool::UserDefined::FileTypes) {
     8713    foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) {
     8714        my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_};
     8715        my $type = uc $_;
     8716        ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next;
     8717        my $baseType = $$fileInfo{BaseType};
     8718        if ($baseType) {
     8719            if ($$fileInfo{Description}) {
     8720                $fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ];
     8721            } else {
     8722                $fileTypeLookup{$type} = $baseType;
     8723            }
     8724            if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) {
     8725                # first make sure we are using an actual base type and not a derived type
     8726                $baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType};
     8727                # mark this type as not writable
     8728                $noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ];
     8729                push @{$noWriteFile{$baseType}}, $type;
     8730            }
     8731        } else {
     8732            $fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ];
     8733            $moduleName{$type} = 0; # not supported
     8734            if ($$fileInfo{Magic}) {
     8735                $magicNumber{$type} = $$fileInfo{Magic};
     8736                push @fileTypes, $type unless grep /^$type$/, @fileTypes;
     8737            }
     8738        }
     8739        $mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType};
     8740    }
     8741}
    62098742
    62108743#------------------------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.