Changeset 24107


Ignore:
Timestamp:
2011-06-01T12:33:42+12:00 (13 years ago)
Author:
sjm84
Message:

Updating the ExifTool perl modules

Location:
main/trunk/greenstone2/perllib/cpan
Files:
89 added
87 edited

Legend:

Unmodified
Added
Removed

  • main/trunk/greenstone2/perllib/cpan/File/RandomAccess.pm

    r16844 r24107  
    44# Description:  Buffer to support random access reading of sequential file
    55#
    6 # Revisions:    02/11/04 - P. Harvey Created
    7 #               02/20/04 - P. Harvey Added flag to disable SeekTest in new()
    8 #               11/18/04 - P. Harvey Fixed bug with seek relative to end of file
    9 #               01/02/05 - P. Harvey Added DEBUG code
    10 #               01/09/06 - P. Harvey Fixed bug in ReadLine() when using
    11 #                          multi-character EOL sequences
    12 #               02/20/06 - P. Harvey Fixed bug where seek past end of file could
    13 #                          generate "substr outside string" warning
    14 #               06/10/06 - P. Harvey Decreased $CHUNK_SIZE from 64k to 8k
    15 #               11/23/06 - P. Harvey Limit reads to < 0x80000000 bytes
     6# Revisions:    02/11/2004 - P. Harvey Created
     7#               02/20/2004 - P. Harvey Added flag to disable SeekTest in new()
     8#               11/18/2004 - P. Harvey Fixed bug with seek relative to end of file
     9#               01/02/2005 - P. Harvey Added DEBUG code
     10#               01/09/2006 - P. Harvey Fixed bug in ReadLine() when using
     11#                            multi-character EOL sequences
     12#               02/20/2006 - P. Harvey Fixed bug where seek past end of file could
     13#                            generate "substr outside string" warning
     14#               06/10/2006 - P. Harvey Decreased $CHUNK_SIZE from 64k to 8k
     15#               11/23/2006 - P. Harvey Limit reads to < 0x80000000 bytes
     16#               11/26/2008 - P. Harvey Fixed bug in ReadLine when reading from a
     17#                            scalar with a multi-character newline
     18#               01/24/2009 - PH Protect against reading too much at once
    1619#
    1720# Notes:        Calls the normal file i/o routines unless SeekTest() fails, in
    … …  
    2225#               May also be used for string i/o (just pass a scalar reference)
    2326#
    24 # Legal:        Copyright (c) 2004-2006 Phil Harvey (phil at owl.phy.queensu.ca)
     27# Legal:        Copyright (c) 2003-2010 Phil Harvey (phil at owl.phy.queensu.ca)
    2528#               This library is free software; you can redistribute it and/or
    2629#               modify it under the same terms as Perl itself.
    … …  
    3437
    3538use vars qw($VERSION @ISA @EXPORT_OK);
    36 $VERSION = '1.07';
     39$VERSION = '1.10';
    3740@ISA = qw(Exporter);
     41
     42sub Read($$$);
    3843
    3944# constants
    … …  
    6469        # file i/o
    6570        my $buff = '';
    66         $self = { 
     71        $self = {
    6772            FILE_PT => $filePt, # file pointer
    6873            BUFF_PT => \$buff,  # reference to file data
    … …  
    156161#------------------------------------------------------------------------------
    157162# Read from the file
    158 # Inputs: 0) reference to RandomAccess object
    159 #         1) buffer, 2) bytes to read
     163# Inputs: 0) reference to RandomAccess object, 1) buffer, 2) bytes to read
    160164# Returns: Number of bytes read
    161165sub Read($$$)
    … …  
    165169    my $rtnVal;
    166170
    167     # avoid dying with "Negative length" error
    168     return 0 if $len & 0x80000000;
    169 
     171    # protect against reading too much at once
     172    # (also from dying with a "Negative length" error)
     173    if ($len & 0xf8000000) {
     174        return 0 if $len < 0;
     175        # read in smaller blocks because Windows attempts to pre-allocate
     176        # memory for the full size, which can lead to an out-of-memory error
     177        my $maxLen = 0x4000000; # (MUST be less than bitmask in "if" above)
     178        my $num = Read($self, $_[0], $maxLen);
     179        return $num if $num < $maxLen;
     180        for (;;) {
     181            $len -= $maxLen;
     182            last if $len <= 0;
     183            my $l = $len < $maxLen ? $len : $maxLen;
     184            my $buff;
     185            my $n = Read($self, $buff, $l);
     186            last unless $n;
     187            $_[0] .= $buff;
     188            $num += $n;
     189            last if $n < $l;
     190        }
     191        return $num;
     192    }
     193    # read through our buffer if necessary
    170194    if ($self->{TESTED} < 0) {
    171195        my $buff;
    … …  
    196220        $self->{POS} += $rtnVal;
    197221    } else {
     222        # read directly from file
    198223        $_[0] = '' unless defined $_[0];
    199224        $rtnVal = read($self->{FILE_PT}, $_[0], $len) || 0;
    … …  
    204229            $self->{DEBUG}->{$pos} = $rtnVal;
    205230        }
    206     } 
     231    }
    207232    return $rtnVal;
    208233}
    … …  
    217242    my $rtnVal;
    218243    my $fp = $self->{FILE_PT};
    219    
     244
    220245    if ($self->{TESTED} < 0) {
    221246        my ($num, $buff);
    … …  
    231256            # scan and read until we find the EOL (or hit EOF)
    232257            for (;;) {
    233                 $pos = index(${$self->{BUFF_PT}}, $/, $pos) + length($/);
    234                 last if $pos > 0;
     258                $pos = index(${$self->{BUFF_PT}}, $/, $pos);
     259                if ($pos >= 0) {
     260                    $pos += length($/);
     261                    last;
     262                }
    235263                $pos = $self->{LEN};    # have scanned to end of buffer
    236264                $num = read($fp, $buff, $CHUNK_SIZE) or last;
    … …  
    240268        } else {
    241269            # string i/o
    242             $pos = index(${$self->{BUFF_PT}}, $/, $pos) + length($/);
    243             $pos <= 0 and $pos = $self->{LEN};
     270            $pos = index(${$self->{BUFF_PT}}, $/, $pos);
     271            if ($pos < 0) {
     272                $pos = $self->{LEN};
     273                $self->{POS} = $pos if $self->{POS} > $pos;
     274            } else {
     275                $pos += length($/);
     276            }
    244277        }
    245278        # read the line from our buffer
    … …  
    260293            $self->{DEBUG}->{$pos} = $rtnVal;
    261294        }
    262     } 
    263     return $rtnVal; 
     295    }
     296    return $rtnVal;
    264297}
    265298
    … …  
    295328{
    296329    my $self = shift;
    297    
     330
    298331    if ($self->{DEBUG}) {
    299332        local $_;

  • main/trunk/greenstone2/perllib/cpan/File/RandomAccess.pod

    r16844 r24107  
    44# Description:  Buffer to support random access reading of sequential file
    55#
    6 # Legal:        Copyright (c) 2004-2006 Phil Harvey (phil at owl.phy.queensu.ca)
     6# Legal:        Copyright (c) 2003-2010 Phil Harvey (phil at owl.phy.queensu.ca)
    77#               This library is free software; you can redistribute it and/or
    88#               modify it under the same terms as Perl itself.
    … …  
    218218=head1 AUTHOR
    219219
    220 Copyright 2004-2006 Phil Harvey (phil at owl.phy.queensu.ca)
     220Copyright 2003-2011 Phil Harvey (phil at owl.phy.queensu.ca)
    221221
    222222This library is free software; you can redistribute it and/or modify it

  • main/trunk/greenstone2/perllib/cpan/Image/ExifTool.pm

    r23771 r24107  
    66# URL:          http://owl.phy.queensu.ca/~phil/exiftool/
    77#
    8 # Revisions:    Nov. 12/03 - P. Harvey Created
     8# Revisions:    Nov. 12/2003 - P. Harvey Created
    99#               (See html/history.html for revision history)
    1010#
    11 # Legal:        Copyright (c) 2003-2007, Phil Harvey (phil at owl.phy.queensu.ca)
     11# Legal:        Copyright (c) 2003-2010, Phil Harvey (phil at owl.phy.queensu.ca)
    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    
     22
    2323use vars qw($VERSION $RELEASE @ISA %EXPORT_TAGS $AUTOLOAD @fileTypes %allTables
    24             @tableOrder $exifAPP1hdr $xmpAPP1hdr $psAPP13hdr $psAPP13old
    25             @loadAllTables %UserDefined $evalWarning);
    26 
    27 $VERSION = '7.00';
     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';
    2830$RELEASE = '';
    2931@ISA = qw(Exporter);
    3032%EXPORT_TAGS = (
    31     # all public non-object-oriented functions
     33    # all public non-object-oriented functions:
    3234    Public => [qw(
    3335        ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags
    3436        GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate
    3537    )],
     38    # exports not part of the public API, but used by ExifTool modules:
    3639    DataAccess => [qw(
    3740        ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u
    38         Get16s Get32u Get32s GetFloat GetDouble GetFixed32s Write WriteValue
    39         Tell Set8u Set8s Set16u Set32u
     41        Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write
     42        WriteValue Tell Set8u Set8s Set16u Set32u
    4043    )],
    41     Utils => [qw(
    42         GetTagTable TagTableKeys GetTagInfoList GenerateTagIDs SetFileType
    43         HtmlDump
    44     )],
    45     Vars => [qw(
    46         %allTables @tableOrder @fileTypes
    47     )],
     44    Utils => [qw(GetTagTable TagTableKeys GetTagInfoList)],
     45    Vars  => [qw(%allTables @tableOrder @fileTypes)],
    4846);
    4947# set all of our EXPORT_TAGS in EXPORT_OK
    … …  
    5452
    5553# The following functions defined in Image::ExifTool::Writer are declared
    56 # here so their prototypes will be available.  The Writer routines will be
    57 # autoloaded when any of these are called.
     54# here so their prototypes will be available.  These Writer routines will be
     55# autoloaded when any of them is called.
    5856sub SetNewValue($;$$%);
    5957sub SetNewValuesFromFile($$;@);
    … …  
    7472sub IsWritable($);
    7573sub GetNewFileName($$);
     74sub NextTagKey($$);
    7675sub LoadAllTables();
    7776sub GetNewTagInfoList($;$);
    … …  
    8887sub VerboseInfo($$$%);
    8988sub VerboseDir($$;$$);
     89sub VerboseValue($$$;$);
    9090sub VPrint($$@);
    9191sub Rationalize($;$);
    9292sub Write($@);
    93 sub ProcessTrailers($$);
    9493sub WriteTrailerBuffer($$$);
    9594sub AddNewTrailers($;@);
    … …  
    10099sub CheckBinaryData($$$);
    101100sub WriteTIFF($$$);
    102 sub Charset2Unicode($$;$);
    103 sub Latin2Unicode($$);
    104 sub UTF82Unicode($$;$);
    105 sub Unicode2Charset($$;$);
    106 sub Unicode2Latin($$;$);
    107 sub Unicode2UTF8($$);
    108101sub PackUTF8(@);
    109102sub UnpackUTF8($);
     103sub SetPreferredByteOrder($);
     104sub CopyBlock($$$);
     105sub CopyFileAttrs($$);
     106
     107# other subroutine definitions
     108sub DoEscape($$);
     109sub ConvertFileSize($);
     110sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem)
    110111
    111112# list of main tag tables to load in LoadAllTables() (sub-tables are recursed
    112113# automatically).  Note: They will appear in this order in the documentation
    113 # (unless tweaked in BuildTagLookup::GetTableOrder()), so put Exif first.
     114# unless tweaked in BuildTagLookup::GetTableOrder().
    114115@loadAllTables = qw(
    115     PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw MinoltaRaw SigmaRaw JPEG
    116     Jpeg2000 BMP BMP PICT PNG MNG MIFF PDF PostScript Photoshop::Header
    117     FujiFilm::RAF Panasonic::Raw Sony::SR2SubIFD ID3 Vorbis FLAC APE
    118     APE::NewHeader APE::OldHeader MPC MPEG::Audio MPEG::Video QuickTime
    119     QuickTime::ImageFile Flash Flash::FLV Real::Media Real::Audio
    120     Real::Metafile RIFF AIFF ASF DICOM MIE HTML
     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
     125);
     126
     127# 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);
     129
     130$defaultLang = 'en';    # default language
     131
     132# language names
     133%langName = (
     134    cs => 'Czech (ČeÅ¡tina)',
     135    de => 'German (Deutsch)',
     136    en => 'English',
     137    en_ca => 'Canadian English',
     138    en_gb => 'British English',
     139    es => 'Spanish (Español)',
     140    fr => 'French (Français)',
     141    it => 'Italian (Italiano)',
     142    ja => 'Japanese (日本語)',
     143    ko => 'Korean (한국얎)',
     144    nl => 'Dutch (Nederlands)',
     145    pl => 'Polish (Polski)',
     146    ru => 'Russian (РусскОй)',
     147    sv => 'Swedish (Svenska)',
     148   'tr'=> 'Turkish (TÃŒrkçe)',
     149    zh_cn => 'Simplified Chinese (简䜓䞭文)',
     150    zh_tw => 'Traditional Chinese (繁體䞭文)',
    121151);
    122152
    123153# recognized file types, in the order we test unknown files
    124154# Notes: 1) There is no need to test for like types separately here
    125 # 2) Put types with no file signature at end of list to avoid false matches
     155# 2) Put types with weak file signatures at end of list to avoid false matches
    126156@fileTypes = qw(JPEG CRW TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF PSD XMP
    127                 BMP PPM RIFF AIFF ASF MOV MPEG Real SWF FLV OGG FLAC APE MPC
    128                 ICC HTML VRD QTIF FPX PICT MP3 DICM RAW);
     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);
    129160
    130161# file types that we can write (edit)
    131 my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF PNG MIE PSD XMP PPM EPS PS ICC
    132                     VRD JP2);
     162my @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);
     164
     165# file extensions that we can't write for various base types
     166%noWriteFile = (
     167    TIFF => [ qw(3FR DCR K25 KDC SRF) ],
     168    XMP  => [ 'SVG' ],
     169);
    133170
    134171# file types that we can create from scratch
    135 my @createTypes = qw(XMP ICC MIE VRD);
     172# - must update CanCreate() documentation if this list is changed!
     173my %createTypes = (XMP=>1, ICC=>1, MIE=>1, VRD=>1, EXIF=>1);
    136174
    137175# file type lookup for all recognized file extensions
    138176my %fileTypeLookup = (
     177   '3FR' => ['TIFF', 'Hasselblad RAW format'],
     178   '3G2' => ['MOV',  '3rd Gen. Partnership Project 2 audio/video'],
     179   '3GP' => ['MOV',  '3rd Gen. Partnership Project audio/video'],
     180   '3GP2'=>  '3G2',
     181   '3GPP'=>  '3GP',
    139182    ACR  => ['DICM', 'American College of Radiology ACR-NEMA'],
    140     AI   => [['PDF','PS'], 'Adobe Illustrator (PDF-like or PS-like)'],
    141     AIF  => ['AIFF', 'Audio Interchange File Format'],
     183    ACFM => ['Font', 'Adobe Composite Font Metrics'],
     184    AFM  => ['Font', 'Adobe Font Metrics'],
     185    AMFM => ['Font', 'Adobe Multiple Master Font Metrics'],
     186    AI   => [['PDF','PS'], 'Adobe Illustrator'],
     187    AIF  =>  'AIFF',
    142188    AIFC => ['AIFF', 'Audio Interchange File Format Compressed'],
    143189    AIFF => ['AIFF', 'Audio Interchange File Format'],
     190    AIT  =>  'AI',
    144191    APE  => ['APE',  "Monkey's Audio format"],
    145     ARW  => ['TIFF', 'Sony Alpha RAW format (TIFF-like)'],
     192    ARW  => ['TIFF', 'Sony Alpha RAW format'],
    146193    ASF  => ['ASF',  'Microsoft Advanced Systems Format'],
    147     AVI  => ['RIFF', 'Audio Video Interleaved (RIFF-based)'],
    148     BMP  => ['BMP',  'Windows BitMaP'],
    149     BTF  => ['BTF',  'Big Tagged Image File Format'],
    150     CIFF => ['CRW',  'Camera Image File Format (same as CRW)'],
    151     CR2  => ['TIFF', 'Canon RAW 2 format (TIFF-like)'],
     194    AVI  => ['RIFF', 'Audio Video Interleaved'],
     195    BMP  => ['BMP',  'Windows Bitmap'],
     196    BTF  => ['BTF',  'Big Tagged Image File Format'], #(unofficial)
     197    BZ2  => ['BZ2',  'BZIP2 archive'],
     198    CIFF => ['CRW',  'Camera Image File Format'],
     199    COS  => ['COS',  'Capture One Settings'],
     200    CR2  => ['TIFF', 'Canon RAW 2 format'],
    152201    CRW  => ['CRW',  'Canon RAW format'],
    153     CS1  => ['PSD',  'Sinar CaptureShop 1-Shot RAW (PSD-like)'],
    154     DC3  => ['DICM', 'DICOM image file'],
    155     DCM  => ['DICM', 'DICOM image file'],
    156     DIB  => ['BMP',  'Device Independent Bitmap (aka. BMP)'],
    157     DIC  => ['DICM', 'DICOM image file'],
    158     DICM => ['DICM', 'DICOM image file'],
    159     DNG  => ['TIFF', 'Digital Negative (TIFF-like)'],
    160     DCR  => ['TIFF', 'Kodak Digital Camera RAW (TIFF-like)'],
    161     DOC  => ['FPX',  'Microsoft Word Document (FPX-like)'],
     202    CS1  => ['PSD',  'Sinar CaptureShop 1-Shot RAW'],
     203    DC3  =>  'DICM',
     204    DCM  =>  'DICM',
     205    DCP  => ['TIFF', 'DNG Camera Profile'],
     206    DCR  => ['TIFF', 'Kodak Digital Camera RAW'],
     207    DFONT=> ['Font', 'Macintosh Data fork Font'],
     208    DIB  => ['BMP',  'Device Independent Bitmap'],
     209    DIC  =>  'DICM',
     210    DICM => ['DICM', 'Digital Imaging and Communications in Medicine'],
     211    DIVX => ['ASF',  'DivX media format'],
     212    DJV  =>  'DJVU',
     213    DJVU => ['AIFF', 'DjVu image'],
     214    DLL  => ['EXE',  'Windows Dynamic Link Library'],
     215    DNG  => ['TIFF', 'Digital Negative'],
     216    DOC  => ['FPX',  'Microsoft Word Document'],
     217    DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'],
     218    # Note: I have seen a password-protected DOCX file which was FPX-like, so I assume
     219    # that any other MS Office file could be like this too.  The only difference is
     220    # that the ZIP and FPX formats are checked first, so if this is wrong, no biggie.
     221    DOCX => [['ZIP','FPX'], 'Office Open XML Document'],
     222    DOT  => ['FPX',  'Microsoft Word Template'],
     223    DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'],
     224    DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'],
     225    DV   => ['DV',   'Digital Video'],
     226    DVB  => ['MOV',  'Digital Video Broadcasting'],
     227    DYLIB=> ['EXE',  'Mach-O Dynamic Link Library'],
     228    EIP  => ['ZIP',  'Capture One Enhanced Image Package'],
    162229    EPS  => ['EPS',  'Encapsulated PostScript Format'],
    163     EPSF => ['EPS',  'Encapsulated PostScript Format'],
    164     ERF  => ['TIFF', 'Epson Raw Format (TIFF-like)'],
     230    EPS2 =>  'EPS',
     231    EPS3 =>  'EPS',
     232    EPSF =>  'EPS',
     233    ERF  => ['TIFF', 'Epson Raw Format'],
     234    EXE  => ['EXE',  'Windows executable file'],
     235    EXIF => ['EXIF', 'Exchangable Image File Metadata'],
     236    F4A  => ['MOV',  'Adobe Flash Player 9+ Audio'],
     237    F4B  => ['MOV',  'Adobe Flash Player 9+ audio Book'],
     238    F4P  => ['MOV',  'Adobe Flash Player 9+ Protected'],
     239    F4V  => ['MOV',  'Adobe Flash Player 9+ Video'],
    165240    FLAC => ['FLAC', 'Free Lossless Audio Codec'],
     241    FLA  => ['FPX',  'Macromedia/Adobe Flash project'],
    166242    FLV  => ['FLV',  'Flash Video'],
    167243    FPX  => ['FPX',  'FlashPix'],
    168244    GIF  => ['GIF',  'Compuserve Graphics Interchange Format'],
    169     HTM  => ['HTML', 'HyperText Markup Language'],
     245    GZ   =>  'GZIP',
     246    GZIP => ['GZIP', 'GNU ZIP compressed archive'],
     247    HDP  => ['TIFF', 'Windows HD Photo'],
     248    HTM  =>  'HTML',
    170249    HTML => ['HTML', 'HyperText Markup Language'],
    171250    ICC  => ['ICC',  'International Color Consortium'],
    172     ICM  => ['ICC',  'International Color Consortium'],
    173     JNG  => ['PNG',  'JPG Network Graphics (PNG-like)'],
     251    ICM  =>  'ICC',
     252    IIQ  => ['TIFF', 'Phase One Intelligent Image Quality RAW'],
     253    IND  => ['IND',  'Adobe InDesign'],
     254    INDD => ['IND',  'Adobe InDesign Document'],
     255    INDT => ['IND',  'Adobe InDesign Template'],
     256    ITC  => ['ITC',  'iTunes Cover Flow'],
     257    JNG  => ['PNG',  'JPG Network Graphics'],
    174258    JP2  => ['JP2',  'JPEG 2000 file'],
    175     JPEG => ['JPEG', 'Joint Photographic Experts Group'],
     259    # JP4? - looks like a JPEG but the image data is different
     260    JPEG =>  'JPG',
    176261    JPG  => ['JPEG', 'Joint Photographic Experts Group'],
    177     JPX  => ['JP2',  'JPEG 2000 file'],
    178     K25  => ['TIFF', 'Kodak DC25 RAW (TIFF-like)'],
    179     M4A  => ['MOV',  'MPG4 Audio (QuickTime-based)'],
    180     MEF  => ['TIFF', 'Mamiya (RAW) Electronic Format (TIFF-like)'],
     262    JPM  => ['JP2',  'JPEG 2000 compound image'],
     263    JPX  => ['JP2',  'JPEG 2000 with extensions'],
     264    K25  => ['TIFF', 'Kodak DC25 RAW'],
     265    KDC  => ['TIFF', 'Kodak Digital Camera RAW'],
     266    KEY  => ['ZIP',  'Apple Keynote presentation'],
     267    KTH  => ['ZIP',  'Apple Keynote Theme'],
     268    LNK  => ['LNK',  'Windows shortcut'],
     269    M2T  =>  'M2TS',
     270    M2TS => ['M2TS', 'MPEG-2 Transport Stream'],
     271    M2V  => ['MPEG', 'MPEG-2 Video'],
     272    M4A  => ['MOV',  'MPEG-4 Audio'],
     273    M4B  => ['MOV',  'MPEG-4 audio Book'],
     274    M4P  => ['MOV',  'MPEG-4 Protected'],
     275    M4V  => ['MOV',  'MPEG-4 Video'],
     276    MEF  => ['TIFF', 'Mamiya (RAW) Electronic Format'],
    181277    MIE  => ['MIE',  'Meta Information Encapsulation format'],
    182     MIF  => ['MIFF', 'Magick Image File Format'],
     278    MIF  =>  'MIFF',
    183279    MIFF => ['MIFF', 'Magick Image File Format'],
    184     MNG  => ['PNG',  'Multiple-image Network Graphics (PNG-like)'],
    185     MOS  => ['TIFF', 'Creo Leaf Mosaic (TIFF-like)'],
     280    MKA  => ['MKV',  'Matroska Audio'],
     281    MKS  => ['MKV',  'Matroska Subtitle'],
     282    MKV  => ['MKV',  'Matroska Video'],
     283    MNG  => ['PNG',  'Multiple-image Network Graphics'],
     284  # MODD => ['PLIST','Sony Picture Motion Metadata'],
     285    MOS  => ['TIFF', 'Creo Leaf Mosaic'],
    186286    MOV  => ['MOV',  'Apple QuickTime movie'],
    187     MP3  => ['MP3',  'MPEG Layer 3 audio (uses ID3 information)'],
    188     MP4  => ['MOV',  'MPEG Layer 4 video (QuickTime-based)'],
     287    MP3  => ['MP3',  'MPEG-1 Layer 3 audio'],
     288    MP4  => ['MOV',  'MPEG-4 video'],
    189289    MPC  => ['MPC',  'Musepack Audio'],
    190     MPEG => ['MPEG', 'MPEG audio/video format 1'],
    191     MPG  => ['MPEG', 'MPEG audio/video format 1'],
     290    MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'],
     291    MPG  =>  'MPEG',
     292    MPO  => ['JPEG', 'Extended Multi-Picture format'],
     293    MQV  => ['MOV',  'Sony Mobile Quicktime Video'],
    192294    MRW  => ['MRW',  'Minolta RAW format'],
    193     NEF  => ['TIFF', 'Nikon (RAW) Electronic Format (TIFF-like)'],
     295    MTS  => ['M2TS', 'MPEG-2 Transport Stream'],
     296    MXF  => ['MXF',  'Material Exchange Format'],
     297  # NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'],
     298    NEF  => ['TIFF', 'Nikon (RAW) Electronic Format'],
     299    NEWER => 'COS',
     300    NMBTEMPLATE => ['ZIP','Apple Numbers Template'],
     301    NRW  => ['TIFF', 'Nikon RAW (2)'],
     302    NUMBERS => ['ZIP','Apple Numbers spreadsheet'],
     303    ODP  => ['ZIP',  'Open Document Presentation'],
     304    ODS  => ['ZIP',  'Open Document Spreadsheet'],
     305    ODT  => ['ZIP',  'Open Document Text file'],
    194306    OGG  => ['OGG',  'Ogg Vorbis audio file'],
    195307    ORF  => ['ORF',  'Olympus RAW format'],
    196     PBM  => ['PPM',  'Portable BitMap (PPM-like)'],
    197     PCT  => ['PICT', 'Apple PICTure'],
     308    OTF  => ['Font', 'Open Type Font'],
     309    PAGES => ['ZIP', 'Apple Pages document'],
     310    PBM  => ['PPM',  'Portable BitMap'],
     311    PCT  =>  'PICT',
    198312    PDF  => ['PDF',  'Adobe Portable Document Format'],
    199     PEF  => ['TIFF', 'Pentax (RAW) Electronic Format (TIFF-like)'],
    200     PGM  => ['PPM',  'Portable Gray Map (PPM-like)'],
     313    PEF  => ['TIFF', 'Pentax (RAW) Electronic Format'],
     314    PFA  => ['Font', 'PostScript Font ASCII'],
     315    PFB  => ['Font', 'PostScript Font Binary'],
     316    PFM  => ['Font', 'Printer Font Metrics'],
     317    PGF  => ['PGF',  'Progressive Graphics File'],
     318    PGM  => ['PPM',  'Portable Gray Map'],
    201319    PICT => ['PICT', 'Apple PICTure'],
     320  # PLIST=> ['PLIST','Apple Property List'],
     321    PMP  => ['PMP',  'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;)
    202322    PNG  => ['PNG',  'Portable Network Graphics'],
     323    POT  => ['FPX',  'Microsoft PowerPoint Template'],
     324    POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'],
     325    POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'],
    203326    PPM  => ['PPM',  'Portable Pixel Map'],
    204     PPT  => ['FPX',  'Microsoft PowerPoint presentation (FPX-like)'],
     327    PPS  => ['FPX',  'Microsoft PowerPoint Slideshow'],
     328    PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'],
     329    PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'],
     330    PPT  => ['FPX',  'Microsoft PowerPoint Presentation'],
     331    PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'],
     332    PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'],
    205333    PS   => ['PS',   'PostScript'],
    206     PSD  => ['PSD',  'PhotoShop Drawing'],
    207     QIF  => ['QTIF', 'QuickTime Image File'],
     334    PS2  =>  'PS',
     335    PS3  =>  'PS',
     336    PSB  => ['PSD',  'Photoshop Large Document'],
     337    PSD  => ['PSD',  'Photoshop Drawing'],
     338    PSP  => ['PSP',  'Paint Shop Pro'],
     339    PSPFRAME => 'PSP',
     340    PSPIMAGE => 'PSP',
     341    PSPSHAPE => 'PSP',
     342    PSPTUBE  => 'PSP',
     343    QIF  =>  'QTIF',
    208344    QT   => ['MOV',  'QuickTime movie'],
    209     QTI  => ['QTIF', 'QuickTime Image File'],
     345    QTI  =>  'QTIF',
    210346    QTIF => ['QTIF', 'QuickTime Image File'],
    211347    RA   => ['Real', 'Real Audio'],
    212348    RAF  => ['RAF',  'FujiFilm RAW Format'],
    213349    RAM  => ['Real', 'Real Audio Metafile'],
    214     RAW  => ['RAW',  'Kyocera Contax N Digital RAW or Panasonic RAW'],
    215     RIF  => ['RIFF', 'Resource Interchange File Format'],
     350    RAR  => ['RAR',  'RAR Archive'],
     351    RAW  => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'],
     352    RIF  =>  'RIFF',
    216353    RIFF => ['RIFF', 'Resource Interchange File Format'],
    217354    RM   => ['Real', 'Real Media'],
    218355    RMVB => ['Real', 'Real Media Variable Bitrate'],
    219356    RPM  => ['Real', 'Real Media Plug-in Metafile'],
     357    RSRC => ['RSRC', 'Mac OS Resource'],
     358    RTF  => ['RTF',  'Rich Text Format'],
    220359    RV   => ['Real', 'Real Video'],
    221     SR2  => ['TIFF', 'Sony RAW Format 2 (TIFF-like)'],
    222     SRF  => ['TIFF', 'Sony RAW Format (TIFF-like)'],
     360    RW2  => ['TIFF', 'Panasonic RAW 2'],
     361    RWL  => ['TIFF', 'Leica RAW'],
     362    RWZ  => ['RWZ',  'Rawzor compressed image'],
     363    SO   => ['EXE',  'Shared Object file'],
     364    SR2  => ['TIFF', 'Sony RAW Format 2'],
     365    SRF  => ['TIFF', 'Sony RAW Format'],
     366    SRW  => ['TIFF', 'Samsung RAW format'],
     367    SVG  => ['XMP',  'Scalable Vector Graphics'],
    223368    SWF  => ['SWF',  'Shockwave Flash'],
    224     THM  => ['JPEG', 'Canon Thumbnail (aka. JPG)'],
    225     TIF  => ['TIFF', 'Tagged Image File Format'],
     369    TAR  => ['TAR',  'TAR archive'],
     370    THM  => ['JPEG', 'Canon Thumbnail'],
     371    THMX => [['ZIP','FPX'], 'Office Open XML Theme'],
     372    TIF  =>  'TIFF',
    226373    TIFF => ['TIFF', 'Tagged Image File Format'],
    227     VRD  => ['VRD',  'Canon VRD Recipe Data (written by DPP)'],
    228     WAV  => ['RIFF', 'WAVeform (Windows digital audio format)'],
    229     WDP  => ['TIFF', 'Windows Media Photo (TIFF-based)'],
    230     WMA  => ['ASF',  'Windows Media Audio (ASF-based)'],
    231     WMV  => ['ASF',  'Windows Media Video (ASF-based)'],
     374    TS   =>  'M2TS',
     375    TTC  => ['Font', 'True Type Font Collection'],
     376    TTF  => ['Font', 'True Type Font'],
     377    TUB  => 'PSP',
     378    VOB  => ['MPEG', 'Video Object'],
     379    VRD  => ['VRD',  'Canon VRD Recipe Data'],
     380    VSD  => ['FPX',  'Microsoft Visio Drawing'],
     381    WAV  => ['RIFF', 'WAVeform (Windows digital audio)'],
     382    WDP  => ['TIFF', 'Windows Media Photo'],
     383    WEBM => ['MKV',  'Google Web Movie'],
     384    WEBP => ['RIFF', 'Google Web Picture'],
     385    WMA  => ['ASF',  'Windows Media Audio'],
     386    WMV  => ['ASF',  'Windows Media Video'],
    232387    X3F  => ['X3F',  'Sigma RAW format'],
     388    XCF  => ['XCF',  'GIMP native image format'],
    233389    XHTML=> ['HTML', 'Extensible HyperText Markup Language'],
    234     XLS  => ['FPX',  'Microsoft Excel worksheet (FPX-like)'],
    235     XMP  => ['XMP',  'Extensible Metadata Platform data file'],
     390    XLA  => ['FPX',  'Microsoft Excel Add-in'],
     391    XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'],
     392    XLS  => ['FPX',  'Microsoft Excel Spreadsheet'],
     393    XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'],
     394    XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'],
     395    XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'],
     396    XLT  => ['FPX',  'Microsoft Excel Template'],
     397    XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'],
     398    XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'],
     399    XMP  => ['XMP',  'Extensible Metadata Platform'],
     400    ZIP  => ['ZIP',  'ZIP archive'],
    236401);
    237402
     403# descriptions for file types not found in above file extension lookup
     404my %fileDescription = (
     405    DICOM => 'Digital Imaging and Communications in Medicine',
     406    PLIST => 'Property List',
     407    XML   => 'Extensible Markup Language',
     408    'DJVU (multi-page)' => 'DjVu multi-page image',
     409    'Win32 EXE' => 'Windows 32-bit Executable',
     410    'Win32 DLL' => 'Windows 32-bit Dynamic Link Library',
     411);
     412
    238413# MIME types for applicable file types above
    239 # (missing entries default to 'application/unknown')
    240 my %mimeType = (
    241     AIFF => 'audio/aiff',
     414# (missing entries default to 'application/unknown', but note that
     415#  other mime types may be specified by some modules, ie. QuickTime.pm)
     416%mimeType = (
     417   '3FR' => 'image/x-hasselblad-3fr',
     418    AI   => 'application/vnd.adobe.illustrator',
     419    AIFF => 'audio/x-aiff',
    242420    APE  => 'audio/x-monkeys-audio',
    243421    ASF  => 'video/x-ms-asf',
    244     ARW  => 'image/x-raw',
    245     AVI  => 'video/avi',
     422    ARW  => 'image/x-sony-arw',
     423    AVI  => 'video/x-msvideo',
    246424    BMP  => 'image/bmp',
    247     BTF  => 'application/unknown', #TEMPORARY!
    248     CR2  => 'image/x-raw',
    249     CRW  => 'image/x-raw',
     425    BTF  => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html)
     426    BZ2  => 'application/bzip2',
     427   'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension)
     428    CR2  => 'image/x-canon-cr2',
     429    CRW  => 'image/x-canon-crw',
     430    DCR  => 'image/x-kodak-dcr',
     431    DFONT=> 'application/x-dfont',
     432    DICM => 'application/dicom',
     433    DIVX => 'video/divx',
     434    DJVU => 'image/vnd.djvu',
     435    DNG  => 'image/x-adobe-dng',
     436    DOC  => 'application/msword',
     437    DOCM => 'application/vnd.ms-word.document.macroEnabled',
     438    DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document',
     439    DOT  => 'application/msword',
     440    DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate',
     441    DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template',
     442    DV   => 'video/x-dv',
     443    EIP  => 'application/x-captureone', #(NC)
    250444    EPS  => 'application/postscript',
    251     ERF  => 'image/x-raw',
    252     DCR  => 'image/x-raw',
    253     DICM => 'application/dicom',
    254     DNG  => 'image/x-raw',
    255     DOC  => 'application/msword',
     445    ERF  => 'image/x-epson-erf',
     446    EXE  => 'application/octet-stream',
     447    FLA  => 'application/vnd.adobe.fla',
    256448    FLAC => 'audio/flac',
    257449    FLV  => 'video/x-flv',
     450    Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM)
    258451    FPX  => 'image/vnd.fpx',
    259452    GIF  => 'image/gif',
     453    GZIP => 'application/x-gzip',
     454    HDP  => 'image/vnd.ms-photo',
    260455    HTML => 'text/html',
     456    ICC  => 'application/vnd.iccprofile',
     457    IIQ  => 'image/x-raw',
     458    IND  => 'application/x-indesign',
     459    ITC  => 'application/itunes',
    261460    JNG  => 'image/jng',
    262     JP2  => 'image/jpeg2000',
     461    JP2  => 'image/jp2',
    263462    JPEG => 'image/jpeg',
    264     K25  => 'image/x-raw',
    265     M4A  => 'audio/mp4',
    266     MEF  => 'image/x-raw',
     463    JPM  => 'image/jpm',
     464    JPX  => 'image/jpx',
     465    K25  => 'image/x-kodak-k25',
     466    KDC  => 'image/x-kodak-kdc',
     467    LNK  => 'application/octet-stream',
     468    M2T  => 'video/mpeg',
     469    M2TS => 'video/m2ts',
     470    MEF  => 'image/x-mamiya-mef',
    267471    MIE  => 'application/x-mie',
    268472    MIFF => 'application/x-magick-image',
     473    MKA  => 'audio/x-matroska',
     474    MKS  => 'application/x-matroska',
     475    MKV  => 'video/x-matroska',
    269476    MNG  => 'video/mng',
    270477    MOS  => 'image/x-raw',
    … …  
    274481    MPC  => 'audio/x-musepack',
    275482    MPEG => 'video/mpeg',
    276     MRW  => 'image/x-raw',
    277     NEF  => 'image/x-raw',
     483    MRW  => 'image/x-minolta-mrw',
     484    MXF  => 'application/mxf',
     485    NEF  => 'image/x-nikon-nef',
     486    NRW  => 'image/x-nikon-nrw',
     487    ODP  => 'application/vnd.oasis.opendocument.presentation',
     488    ODS  => 'application/vnd.oasis.opendocument.spreadsheet',
     489    ODT  => 'application/vnd.oasis.opendocument.text',
    278490    OGG  => 'audio/x-ogg',
    279     ORF  => 'image/x-raw',
     491    ORF  => 'image/x-olympus-orf',
     492    OTF  => 'application/x-font-otf',
    280493    PBM  => 'image/x-portable-bitmap',
    281494    PDF  => 'application/pdf',
    282     PEF  => 'image/x-raw',
     495    PEF  => 'image/x-pentax-pef',
     496    PGF  => 'image/pgf',
    283497    PGM  => 'image/x-portable-graymap',
    284498    PICT => 'image/pict',
     499    PLIST=> 'application/xml',
    285500    PNG  => 'image/png',
     501    POT  => 'application/vnd.ms-powerpoint',
     502    POTM => 'application/vnd.ms-powerpoint.template.macroEnabled',
     503    POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template',
    286504    PPM  => 'image/x-portable-pixmap',
     505    PPS  => 'application/vnd.ms-powerpoint',
     506    PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled',
     507    PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow',
    287508    PPT  => 'application/vnd.ms-powerpoint',
     509    PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled',
     510    PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation',
    288511    PS   => 'application/postscript',
    289     PSD  => 'application/photoshop',
     512    PSD  => 'application/vnd.adobe.photoshop',
     513    PSP  => 'image/x-paintshoppro', #(NC)
    290514    QTIF => 'image/x-quicktime',
    291515    RA   => 'audio/x-pn-realaudio',
    292     RAF  => 'image/x-raw',
     516    RAF  => 'image/x-fujifilm-raf',
    293517    RAM  => 'audio/x-pn-realaudio',
     518    RAR  => 'application/x-rar-compressed',
    294519    RAW  => 'image/x-raw',
    295520    RM   => 'application/vnd.rn-realmedia',
    296521    RMVB => 'application/vnd.rn-realmedia-vbr',
    297522    RPM  => 'audio/x-pn-realaudio-plugin',
     523    RSRC => 'application/ResEdit',
     524    RTF  => 'text/rtf',
    298525    RV   => 'video/vnd.rn-realvideo',
    299     SR2  => 'image/x-raw',
    300     SRF  => 'image/x-raw',
     526    RW2  => 'image/x-panasonic-rw2',
     527    RWL  => 'image/x-leica-rwl',
     528    RWZ  => 'image/x-rawzor', #(duplicated in Rawzor.pm)
     529    SR2  => 'image/x-sony-sr2',
     530    SRF  => 'image/x-sony-srf',
     531    SRW  => 'image/x-samsung-srw',
     532    SVG  => 'image/svg+xml',
    301533    SWF  => 'application/x-shockwave-flash',
     534    TAR  => 'application/x-tar',
     535    THMX => 'application/vnd.ms-officetheme',
    302536    TIFF => 'image/tiff',
     537    TTC  => 'application/x-font-ttf',
     538    TTF  => 'application/x-font-ttf',
     539    VSD  => 'application/x-visio',
    303540    WAV  => 'audio/x-wav',
    304541    WDP  => 'image/vnd.ms-photo',
     542    WEBM => 'video/webm',
     543    WEBP => 'image/webp',
    305544    WMA  => 'audio/x-ms-wma',
    306545    WMV  => 'video/x-ms-wmv',
    307     X3F  => 'image/x-raw',
     546    X3F  => 'image/x-sigma-x3f',
     547    XCF  => 'image/x-xcf',
     548    XLA  => 'application/vnd.ms-excel',
     549    XLAM => 'application/vnd.ms-excel.addin.macroEnabled',
    308550    XLS  => 'application/vnd.ms-excel',
     551    XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled',
     552    XLSM => 'application/vnd.ms-excel.sheet.macroEnabled',
     553    XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
     554    XLT  => 'application/vnd.ms-excel',
     555    XLTM => 'application/vnd.ms-excel.template.macroEnabled',
     556    XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template',
     557    XML  => 'application/xml',
    309558    XMP  => 'application/rdf+xml',
     559    ZIP  => 'application/zip',
    310560);
    311561
    312 # module names for each file type
    313 # (missing entries have same module name as file type)
     562# module names for processing routines of each file type
     563# - undefined entries default to same module name as file type
     564# - module name '' defaults to Image::ExifTool
     565# - module name '0' indicates a recognized but unsupported file
    314566my %moduleName = (
    315567    BTF  => 'BigTIFF',
     568    BZ2  => 0,
    316569    CRW  => 'CanonRaw',
    317570    DICM => 'DICOM',
     571    COS  => 'CaptureOne',
     572    DOCX => 'OOXML',
    318573    EPS  => 'PostScript',
     574    EXIF => '',
    319575    ICC  => 'ICC_Profile',
     576    IND  => 'InDesign',
    320577    FLV  => 'Flash',
    321578    FPX  => 'FlashPix',
     579    GZIP => 'ZIP',
    322580    JP2  => 'Jpeg2000',
    323     JPEG => '',     # (in the current module)
     581    JPEG => '',
     582  # MODD => 'XML',
    324583    MOV  => 'QuickTime',
     584    MKV  => 'Matroska',
    325585    MP3  => 'ID3',
    326586    MRW  => 'MinoltaRaw',
    327587    OGG  => 'Vorbis',
    328588    ORF  => 'Olympus',
     589  # PLIST=> 'XML',
     590    PMP  => 'Sony',
    329591    PS   => 'PostScript',
    330592    PSD  => 'Photoshop',
    331593    QTIF => 'QuickTime',
    332594    RAF  => 'FujiFilm',
     595    RAR  => 'ZIP',
    333596    RAW  => 'KyoceraRaw',
     597    RWZ  => 'Rawzor',
    334598    SWF  => 'Flash',
     599    TAR  => 0,
    335600    TIFF => '',
    336601    VRD  => 'CanonVRD',
    337602    X3F  => 'SigmaRaw',
     603    XCF  => 'GIMP',
     604);
     605
     606# quick "magic number" file test used to avoid loading module unnecessarily:
     607# - regular expression evaluated on first 1024 bytes of file
     608# - must match beginning at first byte in file
     609# - this test must not be more stringent than module logic
     610%magicNumber = (
     611    AIFF => '(FORM....AIF[FC]|AT&TFORM)',
     612    APE  => '(MAC |APETAGEX|ID3)',
     613    ASF  => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c',
     614    BMP  => 'BM',
     615    BTF  => '(II\x2b\0|MM\0\x2b)',
     616    BZ2  => 'BZh[1-9]\x31\x41\x59\x26\x53\x59',
     617    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)',
     619    DOCX => 'PK\x03\x04',
     620    DV   => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized)
     621    EPS  => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
     622    EXE  => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!<arch>\x0a)',
     623    EXIF => '(II\x2a\0|MM\0\x2a)',
     624    FLAC => '(fLaC|ID3)',
     625    FLV  => 'FLV\x01',
     626    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)',
     628    FPX  => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1',
     629    GIF  => 'GIF8[79]a',
     630    GZIP => '\x1f\x8b\x08',
     631    HTML => '(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive)
     632    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}',
     633    IND  => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d',
     634    ITC  => '.{4}itch',
     635    JP2  => '\0\0\0\x0cjP(  |\x1a\x1a)\x0d\x0a\x87\x0a',
     636    JPEG => '\xff\xd8\xff',
     637    LNK  => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46',
     638    M2TS => '(....)?\x47',
     639    MIE  => '~[\x10\x18]\x04.0MIE',
     640    MIFF => 'id=ImageMagick',
     641    MKV  => '\x1a\x45\xdf\xa3',
     642    MOV  => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)',
     643  # MP3  =>  difficult to rule out
     644    MPC  => '(MP\+|ID3)',
     645    MPEG => '\0\0\x01[\xb0-\xbf]',
     646    MRW  => '\0MR[MI]',
     647    MXF  => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized)
     648    OGG  => '(OggS|ID3)',
     649    ORF  => '(II|MM)',
     650    PDF  => '%PDF-\d+\.\d+',
     651    PGF  => 'PGF',
     652    PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)',
     653    PMP  => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb',
     654    PNG  => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n',
     655    PPM  => 'P[1-6]\s+',
     656    PS   => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)',
     657    PSD  => '8BPS\0[\x01\x02]',
     658    PSP  => 'Paint Shop Pro Image File\x0a\x1a\0{5}',
     659    QTIF => '.{4}(idsc|idat|iicc)',
     660    RAF  => 'FUJIFILM',
     661    RAR  => 'Rar!\x1a\x07\0',
     662    RAW  => '(.{25}ARECOYK|II|MM)',
     663    Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)',
     664    RIFF => 'RIFF',
     665    RSRC => '(....)?\0\0\x01\0',
     666    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)
     670    RWZ  => 'rawzor',
     671    SWF  => '[FC]WS[^\0]',
     672    TAR  => '.{257}ustar(  )?\0', # (this doesn't catch old-style tar files)
     673    TIFF => '(II|MM)', # don't test magic number (some raw formats are different)
     674    VRD  => 'CANON OPTIONAL DATA\0',
     675    X3F  => 'FOVb',
     676    XCF  => 'gimp xcf ',
     677    XMP  => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<',
     678    ZIP  => 'PK\x03\x04',
     679);
     680
     681# lookup for valid character set names (keys are all lower case)
     682%charsetName = (
     683    #   Charset setting                       alias(es)
     684    # -------------------------   --------------------------------------------
     685    utf8        => 'UTF8',        cp65001 => 'UTF8', 'utf-8' => 'UTF8',
     686    latin       => 'Latin',       cp1252  => 'Latin', latin1 => 'Latin',
     687    latin2      => 'Latin2',      cp1250  => 'Latin2',
     688    cyrillic    => 'Cyrillic',    cp1251  => 'Cyrillic', russian => 'Cyrillic',
     689    greek       => 'Greek',       cp1253  => 'Greek',
     690    turkish     => 'Turkish',     cp1254  => 'Turkish',
     691    hebrew      => 'Hebrew',      cp1255  => 'Hebrew',
     692    arabic      => 'Arabic',      cp1256  => 'Arabic',
     693    baltic      => 'Baltic',      cp1257  => 'Baltic',
     694    vietnam     => 'Vietnam',     cp1258  => 'Vietnam',
     695    thai        => 'Thai',        cp874   => 'Thai',
     696    macroman    => 'MacRoman',    cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman',
     697    maclatin2   => 'MacLatin2',   cp10029 => 'MacLatin2',
     698    maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic',
     699    macgreek    => 'MacGreek',    cp10006 => 'MacGreek',
     700    macturkish  => 'MacTurkish',  cp10081 => 'MacTurkish',
     701    macromanian => 'MacRomanian', cp10010 => 'MacRomanian',
     702    maciceland  => 'MacIceland',  cp10079 => 'MacIceland',
     703    maccroatian => 'MacCroatian', cp10082 => 'MacCroatian',
    338704);
    339705
    … …  
    343709# group hash for ExifTool-generated tags
    344710my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' );
     711
     712# special tag names (not used for tag info)
     713my %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,
     719);
    345720
    346721# headers for various segment types
    347722$exifAPP1hdr = "Exif\0\0";
    348723$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0";
     724$xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0";
    349725$psAPP13hdr = "Photoshop 3.0\0";
    350726$psAPP13old = 'Adobe_Photoshop2.5:';
    351727
    352728sub DummyWriteProc { return 1; }
     729
     730# lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses
     731%Image::ExifTool::userLens = ( );
     732
     733# queued plug-in tags to add to lookup
     734@Image::ExifTool::pluginTags = ( );
     735%Image::ExifTool::pluginTags = ( );
    353736
    354737# tag information for preview image -- this should be used for all
    … …  
    360743    WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)',
    361744    DataTag => 'PreviewImage',
     745    # accept either scalar or scalar reference
     746    RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
    362747    # we allow preview image to be set to '', but we don't want a zero-length value
    363748    # in the IFD, so set it temorarily to 'none'.  Note that the length is <= 4,
    364749    # so this value will fit in the IFD so the preview fixup won't be generated.
    365     ValueConv => '$self->ValidateImage(\$val,$tag)',
    366750    ValueConvInv => '$val eq "" and $val="none"; $val',
    367751);
    … …  
    372756%Image::ExifTool::Extra = (
    373757    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
    374     DID_TAG_ID => 1,  # tag ID's aren't meaningful for these tags
     758    VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
    375759    WRITE_PROC => \&DummyWriteProc,
     760    Error   => { Priority => 0, Groups => \%allGroupsExifTool },
     761    Warning => { Priority => 0, Groups => \%allGroupsExifTool },
    376762    Comment => {
    377763        Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image',
    … …  
    381767    },
    382768    Directory => {
     769        Groups => { 1 => 'System' },
    383770        Writable => 1,
    384771        Protected => 1,
    … …  
    387774    },
    388775    FileName => {
     776        Groups => { 1 => 'System' },
    389777        Writable => 1,
    390778        Protected => 1,
     779        Notes => q{
     780            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
     783        },
    391784        ValueConvInv => '$val=~tr/\\\\/\//; $val',
    392785    },
    393786    FileSize => {
    394         PrintConv => sub {
    395             my $val = shift;
    396             $val < 2048 and return "$val bytes";
    397             $val < 2097152 and return sprintf('%.0f kB', $val / 1024);
    398             return sprintf('%.0f MB', $val / 1048576);
     787        Groups => { 1 => 'System' },
     788        PrintConv => \&ConvertFileSize,
     789    },
     790    ResourceForkSize => {
     791        Groups => { 1 => 'System' },
     792        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
    399796        },
     797        PrintConv => \&ConvertFileSize,
    400798    },
    401799    FileType    => { },
    … …  
    403801        Description => 'File Modification Date/Time',
    404802        Notes => 'the filesystem modification time',
    405         Groups => { 2 => 'Time' },
     803        Groups => { 1 => 'System', 2 => 'Time' },
    406804        Writable => 1,
     805        # all pseudo-tags must be protected so -tagsfromfile fails with
     806        # unrecognized files unless a pseudo tag is specified explicitly
     807        Protected => 1,
    407808        Shift => 'Time',
    408         ValueConv => 'ConvertUnixTime($val,"local")',
    409         ValueConvInv => 'GetUnixTime($val,"local")',
     809        ValueConv => 'ConvertUnixTime($val,1)',
     810        ValueConvInv => 'GetUnixTime($val,1)',
    410811        PrintConv => '$self->ConvertDateTime($val)',
    411         PrintConvInv => '$val',
     812        PrintConvInv => '$self->InverseDateTime($val)',
     813    },
     814    FilePermissions => {
     815        Groups => { 1 => 'System' },
     816        Notes => q{
     817            r=read, w=write and x=execute permissions for the file owner, group and
     818            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"
     820        },
     821        ValueConv => 'sprintf("%.3o", $val & 0777)',
     822        PrintConv => sub {
     823            my ($mask, $str, $val) = (0400, '', oct(shift));
     824            while ($mask) {
     825                foreach (qw(r w x)) {
     826                    $str .= $val & $mask ? $_ : '-';
     827                    $mask >>= 1;
     828                }
     829            }
     830            return $str;
     831        },
    412832    },
    413833    MIMEType    => { },
    … …  
    418838    MaxVal      => { }, # max pixel value in PPM or PGM image
    419839    EXIF => {
    420         Notes => 'the full EXIF data block',
    421         Groups => { 0 => 'EXIF' },
    422         Binary => 1,
     840        Notes => 'the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images',
     841        Groups => { 0 => 'EXIF', 1 => 'EXIF' },
     842        Flags => ['Writable' ,'Protected', 'Binary'],
     843        WriteCheck => q{
     844            return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/;
     845            return 'Invalid EXIF data';
     846        },
    423847    },
    424848    ICC_Profile => {
    425849        Notes => 'the full ICC_Profile data block',
    426         Groups => { 0 => 'ICC_Profile' },
     850        Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' },
    427851        Flags => ['Writable' ,'Protected', 'Binary'],
    428852        WriteCheck => q{
    … …  
    433857    XMP => {
    434858        Notes => 'the full XMP data block',
    435         Groups => { 0 => 'XMP' },
    436         Flags => [ 'Writable', 'Binary' ],
     859        Groups => { 0 => 'XMP', 1 => 'XMP' },
     860        Flags => ['Writable', 'Protected', 'Binary'],
     861        Priority => 0,  # so main xmp (which usually comes first) takes priority
    437862        WriteCheck => q{
    438863            require Image::ExifTool::XMP;
    … …  
    442867    CanonVRD => {
    443868        Notes => 'the full Canon DPP VRD trailer block',
    444         Groups => { 0 => 'CanonVRD' },
     869        Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' },
    445870        Flags => ['Writable' ,'Protected', 'Binary'],
     871        Permanent => 0, # (this is 1 by default for MakerNotes tags)
    446872        WriteCheck => q{
    447873            return undef if $val =~ /^CANON OPTIONAL DATA\0/;
    … …  
    449875        },
    450876    },
    451     Encryption  => { }, # PDF encryption filter
     877    CurrentIPTCDigest => {
     878        Notes => q{
     879            MD5 digest of existing IPTC data.  All zeros if IPTC exists but Digest::MD5
     880            is not installed.  Only calculated for IPTC in the standard location as
     881            specified by the L<MWG|http://www.metadataworkinggroup.org/>.  ExifTool
     882            automates the handling of this tag in the MWG module -- see the
     883            L<MWG Tag Name documentation|MWG.html> for details
     884        },
     885        ValueConv => 'unpack("H*", $val)',
     886    },
     887    PreviewImage => {
     888        Writable => 1,
     889        WriteCheck => '$self->CheckImage(\$val)',
     890        # can't delete, so set to empty string and return no error
     891        DelCheck => '$val = ""; return undef',
     892        # accept either scalar or scalar reference
     893        RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)',
     894    },
     895    PreviewPNG  => { Binary => 1 },
    452896    ExifByteOrder => {
    453897        Writable => 1,
    454898        Notes => 'only writable for newly created EXIF segments',
    455899        PrintConv => {
    456             II => 'Little-endian (Intel)',
    457             MM => 'Big-endian (Motorola)',
     900            II => 'Little-endian (Intel, II)',
     901            MM => 'Big-endian (Motorola, MM)',
     902        },
     903    },
     904    ExifUnicodeByteOrder => {
     905        Writable => 1,
     906        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
     911        },
     912        PrintConv => {
     913            II => 'Little-endian (Intel, II)',
     914            MM => 'Big-endian (Motorola, MM)',
    458915        },
    459916    },
    460917    ExifToolVersion => {
    461918        Description => 'ExifTool Version Number',
    462         Groups      => \%allGroupsExifTool
     919        Groups => \%allGroupsExifTool,
    463920    },
    464     Error       => { Priority => 0, Groups => \%allGroupsExifTool },
    465     Warning     => { Priority => 0, Groups => \%allGroupsExifTool },
     921    RAFVersion => { },
     922    JPEGDigest => {
     923        Notes => q{
     924            an MD5 digest of the JPEG quantization tables is combined with the component
     925            sub-sampling values to generate the value of this tag.  The result is
     926            compared to known values in an attempt to deduce the originating software
     927            based only on the JPEG image data.  For performance reasons, this tag is
     928            generated only if specifically requested
     929        },
     930    },
     931    Now => {
     932        Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' },
     933        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);
     943        },
     944        PrintConv => '$self->ConvertDateTime($val)',
     945    },
     946    ID3Size     => { },
     947    Geotag => {
     948        Writable => 1,
     949        AllowGroup => '(exif|gps|xmp|xmp-exif)',
     950        Notes => q{
     951            this write-only tag is used to define the GPS track log data or track log
     952            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
     955        },
     956        DelCheck => q{
     957            require Image::ExifTool::Geotag;
     958            # delete associated tags
     959            Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup);
     960        },
     961        ValueConvInv => q{
     962            require Image::ExifTool::Geotag;
     963            # always warn because this tag is never set (warning is "\n" on success)
     964            my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val);
     965            return '' if not defined $result;   # deleting geo tags
     966            return $result if ref $result;      # geotag data hash reference
     967            warn "$result\n";                   # error string
     968        },
     969    },
     970    Geotime => {
     971        Writable => 1,
     972        AllowGroup => '(exif|gps|xmp|xmp-exif)',
     973        Notes => q{
     974            this write-only tag is used to define a date/time for interpolating a
     975            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
     982        },
     983        DelCheck => q{
     984            require Image::ExifTool::Geotag;
     985            # delete associated tags
     986            Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup);
     987        },
     988        ValueConvInv => q{
     989            require Image::ExifTool::Geotag;
     990            warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n";
     991            return undef;
     992        },
     993    },
     994    Geosync => {
     995        Writable => 1,
     996        AllowGroup => '(exif|gps|xmp|xmp-exif)',
     997        Shift => 'Time', # enables "+=" syntax as well as "=+"
     998        Notes => q{
     999            this write-only tag specifies a time difference to add to Geotime for
     1000            synchronization with the GPS clock.  For example, set this to "-12" if the
     1001            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
     1006        },
     1007        ValueConvInv => q{
     1008            require Image::ExifTool::Geotag;
     1009            return Image::ExifTool::Geotag::ConvertGeosync($self, $val);
     1010        },
     1011    },
    4661012);
    4671013
    468 # information decoded from JPEG SOF frame
    469 # (define this here to avoid loading JPEG.pm)
     1014# YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP)
     1015%Image::ExifTool::JPEG::yCbCrSubSampling = (
     1016    '1 1' => 'YCbCr4:4:4 (1 1)', #PH
     1017    '2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm
     1018    '2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm
     1019    '4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm
     1020    '4 2' => 'YCbCr4:1:0 (4 2)', #PH
     1021    '1 2' => 'YCbCr4:4:0 (1 2)', #PH
     1022    '1 4' => 'YCbCr4:4:1 (1 4)', #JD
     1023    '2 4' => 'YCbCr4:2:1 (2 4)', #JD
     1024);
     1025
     1026# define common JPEG segments here to avoid overhead of loading JPEG module
     1027
     1028# JPEG SOF (start of frame) tags
    4701029# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf)
    4711030%Image::ExifTool::JPEG::SOF = (
    4721031    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
    4731032    NOTES => 'This information is extracted from the JPEG Start Of Frame segment.',
    474     VARS => { NO_ID => 1 },
    475     EncodingProcess => {
    476         PrintHex => 1,
    477         PrintConv => {
    478             0x0 => 'Baseline DCT, Huffman coding',
     1033    VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags
     1034    EncodingProcess => {
     1035        PrintHex => 1,
     1036        PrintConv => {
     1037            0x0 => 'Baseline DCT, Huffman coding',
    4791038            0x1 => 'Extended sequential DCT, Huffman coding',
    4801039            0x2 => 'Progressive DCT, Huffman coding',
    … …  
    4971056    YCbCrSubSampling => {
    4981057        Notes => 'calculated from components table',
    499         PrintConv => {
    500             '1 1' => 'YCbCr4:4:4 (1 1)',
    501             '2 1' => 'YCbCr4:2:2 (2 1)',
    502             '2 2' => 'YCbCr4:2:0 (2 2)',
    503             '4 1' => 'YCbCr4:1:1 (4 1)',
    504             '4 2' => 'YCbCr4:1:0 (4 2)',
    505             '1 2' => 'YCbCr4:4:0 (1 2)',
    506         },
     1058        PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling,
    5071059    },
    5081060);
    5091061
    510 # static private ExifTool variables
    511 
    512 %allTables = ( );   # list of all tables loaded (except composite tags)
    513 @tableOrder = ( );  # order the tables were loaded
    514 
    515 my $didTagID;       # flag indicating we are accessing tag ID's
    516 
    517 # composite tags (accumulation of all Composite tag tables)
    518 %Image::ExifTool::Composite = (
    519     GROUPS => { 0 => 'Composite', 1 => 'Composite' },
    520     DID_TAG_ID => 1,    # want empty tagID's for composite tags
    521     WRITE_PROC => \&DummyWriteProc,
    522 );
    523 
    524 # JFIF APP0 definitions
     1062# JPEG JFIF APP0 definitions
    5251063%Image::ExifTool::JFIF::Main = (
    5261064    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
    … …  
    5321070        Name => 'JFIFVersion',
    5331071        Format => 'int8u[2]',
    534         PrintConv => '$val=~tr/ /./;$val',
     1072        PrintConv => 'sprintf("%d.%.2d", split(" ",$val))',
    5351073    },
    5361074    2 => {
    … …  
    5641102    0x10 => {
    5651103        Name => 'ThumbnailImage',
    566         ValueConv => '$self->ValidateImage(\$val,$tag)',
     1104        RawConv => '$self->ValidateImage(\$val,$tag)',
    5671105    },
    5681106);
    5691107
    570 # special tag names (not used for tag info)
    571 my %specialTags = (
    572     PROCESS_PROC=>1, WRITE_PROC=>1, CHECK_PROC=>1, GROUPS=>1, FORMAT=>1,
    573     FIRST_ENTRY=>1, TAG_PREFIX=>1, PRINT_CONV=>1, DID_TAG_ID=>1, WRITABLE=>1,
    574     NOTES=>1, IS_OFFSET=>1, EXTRACT_UNKNOWN=>1, NAMESPACE=>1, PREFERRED=>1,
    575     PARENT=>1, PRIORITY=>1, WRITE_GROUP=>1, LANG_INFO=>1, VARS=>1,
    576     DATAMEMBER=>1,
     1108# Composite tags (accumulation of all Composite tag tables)
     1109%Image::ExifTool::Composite = (
     1110    GROUPS => { 0 => 'Composite', 1 => 'Composite' },
     1111    TABLE_NAME => 'Image::ExifTool::Composite',
     1112    SHORT_NAME => 'Composite',
     1113    VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags
     1114    WRITE_PROC => \&DummyWriteProc,
    5771115);
     1116
     1117# static private ExifTool variables
     1118
     1119%allTables = ( );   # list of all tables loaded (except Composite tags)
     1120@tableOrder = ( );  # order the tables were loaded
    5781121
    5791122#------------------------------------------------------------------------------
    … …  
    6051148# New - create new ExifTool object
    6061149# Inputs: 0) reference to exiftool object or ExifTool class name
     1150# Returns: blessed ExifTool object ref
    6071151sub new
    6081152{
    … …  
    6171161    $self->ClearOptions();      # create default options hash
    6181162    $self->{VALUE} = { };       # must initialize this for warning messages
    619     $self->{DEL_GROUP} = { };   # list of groups to delete when writing
     1163    $self->{DEL_GROUP} = { };   # lookup for groups to delete when writing
    6201164
    6211165    # initialize our new groups for writing
    … …  
    6331177# Notes:
    6341178#   - if no tags names are specified, the values of all tags are returned
    635 #   - tags may be specified with leading '-' to exclude
     1179#   - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv
    6361180#   - can pass a reference to list of tags to find, in which case the list will
    6371181#     be updated with the tags found in the proper case and in the specified order.
    … …  
    6841228    while (@_) {
    6851229        my $param = shift;
    686         $oldVal = $options->{$param};
     1230        $oldVal = $$options{$param};
    6871231        last unless @_;
    688         $options->{$param} = shift;
    689         # clone Exclude list and expand shortcuts
    690         if ($param eq 'Exclude' and defined $options->{$param}) {
     1232        my $newVal = shift;
     1233        if ($param eq 'Lang') {
     1234            # allow this to be set to undef to select the default language
     1235            $newVal = $defaultLang unless defined $newVal;
     1236            if ($newVal eq $defaultLang) {
     1237                $$options{$param} = $newVal;
     1238                delete $$self{CUR_LANG};
     1239            # make sure the language is available
     1240            } elsif (eval "require Image::ExifTool::Lang::$newVal") {
     1241                my $xlat = "Image::ExifTool::Lang::${newVal}::Translate";
     1242                no strict 'refs';
     1243                if (%$xlat) {
     1244                    $$self{CUR_LANG} = \%$xlat;
     1245                    $$options{$param} = $newVal;
     1246                }
     1247            } # else don't change Lang
     1248        } elsif ($param eq 'Exclude' and defined $newVal) {
     1249            # clone Exclude list and expand shortcuts
    6911250            my @exclude;
    692             my $val = $options->{$param};
    693             if (ref $val eq 'ARRAY') {
    694                 @exclude = @$val;
     1251            if (ref $newVal eq 'ARRAY') {
     1252                @exclude = @$newVal;
    6951253            } else {
    696                 @exclude = ($val);
    697             }
    698             ExpandShortcuts(\@exclude);
    699             $options->{$param} = \@exclude;
     1254                @exclude = ($newVal);
     1255            }
     1256            ExpandShortcuts(\@exclude, 1);  # (also remove '#' suffix)
     1257            $$options{$param} = \@exclude;
     1258        } elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') {
     1259            # only allow valid character sets to be set
     1260            if ($newVal) {
     1261                my $charset = $charsetName{lc $newVal};
     1262                if ($charset) {
     1263                    $$options{$param} = $charset;
     1264                    # maintain backward-compatibility with old IPTCCharset option
     1265                    $$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset';
     1266                } else {
     1267                    warn "Invalid Charset $newVal\n";
     1268                }
     1269            }
     1270        } else {
     1271            if ($param eq 'Escape') {
     1272                # set ESCAPE_PROC
     1273                if (defined $newVal and $newVal eq 'XML') {
     1274                    require Image::ExifTool::XMP;
     1275                    $$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML;
     1276                } elsif (defined $newVal and $newVal eq 'HTML') {
     1277                    require Image::ExifTool::HTML;
     1278                    $$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML;
     1279                } else {
     1280                    delete $$self{ESCAPE_PROC};
     1281                }
     1282                # must forget saved values since they depend on Escape method
     1283                $self->{BOTH} = { };
     1284            }
     1285            $$options{$param} = $newVal;
    7001286        }
    7011287    }
    … …  
    7131299    # create options hash with default values
    7141300    # (commented out options don't need initializing)
     1301    # +-----------------------------------------------------+
     1302    # ! DON'T FORGET!!  When adding any new option, must    !
     1303    # ! decide how it is handled in SetNewValuesFromFile()  !
     1304    # +-----------------------------------------------------+
    7151305    $self->{OPTIONS} = {
    7161306    #   Binary      => undef,   # flag to extract binary values even if tag not specified
    7171307    #   ByteOrder   => undef,   # default byte order when creating EXIF information
    7181308        Charset     => 'UTF8',  # character set for converting Unicode characters
     1309        CharsetID3  => 'Latin', # internal ID3v1 character set
     1310        CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet
    7191311    #   Compact     => undef,   # compact XMP and IPTC data
    7201312        Composite   => 1,       # flag to calculate Composite tags
    … …  
    7231315    #   DateFormat  => undef,   # format for date/time
    7241316        Duplicates  => 1,       # flag to save duplicate tag values
     1317    #   Escape      => undef,   # escape special characters
    7251318    #   Exclude     => undef,   # tags to exclude
     1319    #   ExtractEmbedded =>undef,# flag to extract information from embedded documents
    7261320    #   FastScan    => undef,   # flag to avoid scanning for trailer
    7271321    #   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
    7281327    #   Group#      => undef,   # return tags for specified groups in family #
    7291328        HtmlDump    => 0,       # HTML dump (0-3, higher # = bigger limit)
    7301329    #   HtmlDumpBase => undef,  # base address for HTML dump
    7311330    #   IgnoreMinorErrors => undef, # ignore minor errors when reading/writing
     1331        Lang        => $defaultLang,# localized language for descriptions etc
     1332    #   LargeFileSupport => undef,  # flag indicating support of 64-bit file offsets
    7321333    #   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
    7331336    #   MakerNotes  => undef,   # extract maker notes as a block
    7341337    #   MissingTagValue =>undef,# value for missing tags when expanded in expressions
     1338    #   Password    => undef,   # password for password-protected PDF documents
    7351339        PrintConv   => 1,       # flag to enable print conversion
     1340    #   SavePath    => undef,   # (undocumented) save family 5 location path
    7361341    #   ScanForXMP  => undef,   # flag to scan for XMP information in all files
    7371342        Sort        => 'Input', # order to sort found tags (Input, File, Alpha, Group#)
    7381343    #   StrictDate  => undef,   # flag to return undef for invalid date conversions
     1344    #   Struct      => undef,   # return structures as hash references
    7391345        TextOut     => \*STDOUT,# file for Verbose/HtmlDump output
    7401346        Unknown     => 0,       # flag to get values of unknown tags (0-2)
    741         Verbose     => 0,       # print verbose messages (0-4, higher # = more verbose)
     1347        Verbose     => 0,       # print verbose messages (0-5, higher # = more verbose)
    7421348    };
     1349    # keep necessary member variables in sync with options
     1350    delete $$self{CUR_LANG};
     1351    delete $$self{ESCAPE_PROC};
     1352
     1353    # load user-defined default options
     1354    if (%Image::ExifTool::UserDefined::Options) {
     1355        foreach (keys %Image::ExifTool::UserDefined::Options) {
     1356            $self->Options($_, $Image::ExifTool::UserDefined::Options{$_});
     1357        }
     1358    }
    7431359}
    7441360
    … …  
    7491365# Returns: 1 if this was a valid image, 0 otherwise
    7501366# Notes: pass an undefined value to avoid parsing arguments
     1367# Internal 'ReEntry' option allows this routine to be called recursively
    7511368sub ExtractInfo($;@)
    7521369{
    … …  
    7541371    my $self = shift;
    7551372    my $options = $self->{OPTIONS};     # pointer to current options
    756     my %saveOptions;
    757 
    758     if (defined $_[0] or $options->{HtmlDump}) {
    759         %saveOptions = %$options;       # save original options
    760        
    761         # require duplicates for html dump
    762         $self->Options(Duplicates => 1) if $options->{HtmlDump};
    763 
    764         if (defined $_[0]) {
    765             # only initialize filename if called with arguments
    766             $self->{FILENAME} = undef;  # name of file (or '' if we didn't open it)
    767             $self->{RAF} = undef;       # RandomAccess object reference
     1373    my (%saveOptions, $reEntry, $rsize);
     1374
     1375    # check for internal ReEntry option to allow recursive calls to ExtractInfo
     1376    if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and
     1377       (ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB'))
     1378    {
     1379        # save necessary members for restoring later
     1380        $reEntry = {
     1381            RAF       => $$self{RAF},
     1382            PROCESSED => $$self{PROCESSED},
     1383            EXIF_DATA => $$self{EXIF_DATA},
     1384            EXIF_POS  => $$self{EXIF_POS},
     1385            FILE_TYPE => $$self{FILE_TYPE},
     1386        };
     1387        $self->{RAF} = new File::RandomAccess($_[0]);
     1388        $$self{PROCESSED} = { };
     1389        delete $$self{EXIF_DATA};
     1390        delete $$self{EXIF_POS};
     1391    } else {
     1392        if (defined $_[0] or $options->{HtmlDump}) {
     1393            %saveOptions = %$options;       # save original options
    7681394   
    769             $self->ParseArguments(@_);  # initialize from our arguments
    770         }
    771     }
    772     # initialize ExifTool object members
    773     $self->Init();
    774 
    775     delete $self->{MAKER_NOTE_FIXUP};   # fixup information for extracted maker notes
    776     delete $self->{MAKER_NOTE_BYTE_ORDER};
    777     delete $self->{DONE_ID3};
    778 
     1395            # require duplicates for html dump
     1396            $self->Options(Duplicates => 1) if $options->{HtmlDump};
     1397   
     1398            if (defined $_[0]) {
     1399                # 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   
     1403                $self->ParseArguments(@_);  # initialize from our arguments
     1404            }
     1405        }
     1406        # initialize ExifTool object members
     1407        $self->Init();
     1408
     1409        delete $self->{MAKER_NOTE_FIXUP};   # fixup information for extracted maker notes
     1410        delete $self->{MAKER_NOTE_BYTE_ORDER};
     1411
     1412        # return our version number
     1413        $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
     1414        $self->FoundTag('Now', time()) if $self->{REQ_TAG_LOOKUP}{now} or $self->{TAGS_FROM_FILE};
     1415    }
    7791416    my $filename = $self->{FILENAME};   # image file name ('' if already open)
    7801417    my $raf = $self->{RAF};             # RandomAccess object
    7811418
    782     # return our version number
    783     $self->FoundTag('ExifToolVersion', "$VERSION$RELEASE");
    784 
    7851419    local *EXIFTOOL_FILE;   # avoid clashes with global namespace
    7861420
     1421    my $realname = $filename;
    7871422    unless ($raf) {
    7881423        # save file name
    7891424        if (defined $filename and $filename ne '') {
    7901425            unless ($filename eq '-') {
    791                 my $name = $filename;
    7921426                # extract file name from pipe if necessary
    793                 $name =~ /\|$/ and $name =~ s/.*?"(.*)".*/$1/;
    794                 my $dir;
     1427                $realname =~ /\|$/ and $realname =~ s/.*?"(.*?)".*/$1/;
     1428                my ($dir, $name);
    7951429                if (eval 'require File::Basename') {
    796                     $dir = File::Basename::dirname($name);
    797                     $name = File::Basename::basename($name);
     1430                    $dir = File::Basename::dirname($realname);
     1431                    $name = File::Basename::basename($realname);
    7981432                } else {
    799                     $name =~ tr/\\/\//;
    800                     if ($name =~ s/(.*)\///) {  # remove path
    801                         $dir = length($1) ? $1 : '/';
    802                     }
     1433                    ($name = $realname) =~ tr/\\/\//;
     1434                    # remove path
     1435                    $dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///;
    8031436                }
    8041437                $self->FoundTag('FileName', $name);
    8051438                $self->FoundTag('Directory', $dir) if defined $dir and length $dir;
     1439                # get size of resource fork on Mac OS
     1440                $rsize = -s "$filename/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE};
    8061441            }
    8071442            # open the file
    808             if (open(EXIFTOOL_FILE,$filename)) {
    809                 my $filePt = \*EXIFTOOL_FILE;
     1443            if (open(EXIFTOOL_FILE, $filename)) {
    8101444                # create random access file object
    811                 $raf = new File::RandomAccess($filePt);
     1445                $raf = new File::RandomAccess(\*EXIFTOOL_FILE);
    8121446                # patch to force pipe to be buffered because seek returns success
    8131447                # in Windows cmd shell pipe even though it really failed
    … …  
    8231457
    8241458    if ($raf) {
    825         # get file size and last modified time if this is a plain file
    826         if ($raf->{FILE_PT} and -f $raf->{FILE_PT}) {
     1459        if ($reEntry) {
     1460            # we already set these tags
     1461        } elsif (not $raf->{FILE_PT}) {
     1462            # 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
    8271466            my $fileSize = -s _;
    8281467            my $fileTime = -M _;
     1468            my @stat = stat _;
    8291469            $self->FoundTag('FileSize', $fileSize) if defined $fileSize;
     1470            $self->FoundTag('ResourceForkSize', $rsize) if $rsize;
    8301471            $self->FoundTag('FileModifyDate', $^T - $fileTime*(24*3600)) if defined $fileTime;
     1472            $self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2];
    8311473        }
    8321474
    8331475        # get list of file types to check
    834         my $tiffType;
    835         $self->{FILE_EXT} = GetFileExtension($filename);
    836         my @fileTypeList = GetFileType($filename);
     1476        my ($tiffType, %noMagic);
     1477        $self->{FILE_EXT} = GetFileExtension($realname);
     1478        my @fileTypeList = GetFileType($realname);
    8371479        if (@fileTypeList) {
    8381480            # add remaining types to end of list so we test them all
    … …  
    8401482            push @fileTypeList, grep(!/^($pat)$/, @fileTypes);
    8411483            $tiffType = $self->{FILE_EXT};
     1484            $noMagic{MXF} = 1;  # don't do magic number test on MXF or DV files
     1485            $noMagic{DV} = 1;
    8421486        } else {
    8431487            # scan through all recognized file types
    … …  
    8511495        my %dirInfo = ( RAF => $raf, Base => $pos );
    8521496        # loop through list of file types to test
    853         my $type;
    854         for (;;) {
     1497        my ($type, $buff, $seekErr);
     1498        # read first 1024 bytes of file for testing
     1499        $raf->Read($buff, 1024) or $buff = '';
     1500        $raf->Seek($pos, 0) or $seekErr = 1;
     1501        until ($seekErr) {
    8551502            $type = shift @fileTypeList;
    856             unless ($type) {
     1503            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};
     1507            } else {
    8571508                last unless defined $type;
    8581509                # last ditch effort to scan past unknown header for JPEG/TIFF
    859                 my $buff;
    860                 $raf->Read($buff, 1024);
    8611510                next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g;
    8621511                $type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF';
    8631512                my $skip = pos($buff) - length($1);
    8641513                $dirInfo{Base} = $pos + $skip;
    865                 $raf->Seek($pos + $skip, 0);
     1514                $raf->Seek($pos + $skip, 0) or $seekErr = 1, last;
    8661515                $self->Warn("Skipped unknown $skip byte header");
    8671516            }
    8681517            # save file type in member variable
    869             $self->{FILE_TYPE} = $type;
     1518            $self->{FILE_TYPE} = $self->{PATH}[0] = $type;
    8701519            $dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type;
    8711520            my $module = $moduleName{$type};
    … …  
    8771526                require "Image/ExifTool/$module.pm";
    8781527                $func = "Image::ExifTool::${module}::$func";
     1528            } elsif ($module eq '0') {
     1529                $self->SetFileType();
     1530                $self->Warn('Unsupported file type');
     1531                last;
    8791532            }
    8801533            # process the file
    … …  
    8841537
    8851538            # seek back to try again from the same position in the file
    886             unless ($raf->Seek($pos, 0)) {
    887                 $self->Error('Error seeking in file');
    888                 last;
    889             }
    890         }
    891         # scan for XMP if specified
    892         if ($self->Options('ScanForXMP') and (not defined $type or
     1539            $raf->Seek($pos, 0) or $seekErr = 1, last;
     1540        }
     1541        if ($seekErr) {
     1542            $self->Error('Error seeking in file');
     1543        } elsif ($self->Options('ScanForXMP') and (not defined $type or
    8931544            (not $self->Options('FastScan') and not $$self{FoundXMP})))
    8941545        {
     1546            # scan for XMP
    8951547            $raf->Seek($pos, 0);
    8961548            require Image::ExifTool::XMP;
    … …  
    9011553            # must be a format error since we couldn't read it, otherwise
    9021554            # it is likely we don't support images of this type
    903             $self->Error(GetFileType($filename) ?
    904                 'File format error' : 'Unknown file 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);
    9051565        }
    9061566        # extract binary EXIF data block only if requested
    907         if (defined $self->{EXIF_DATA} and $self->{REQ_TAG_LOOKUP}->{exif}) {
     1567        if (defined $self->{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and
     1568            ($self->{REQ_TAG_LOOKUP}{exif} or $self->{OPTIONS}{Binary}))
     1569        {
    9081570            $self->FoundTag('EXIF', $self->{EXIF_DATA});
    9091571        }
    910         # calculate composite tags
    911         $self->BuildCompositeTags() if $options->{Composite};
    912 
    913         # do our HTML dump if requested
    914         if ($self->{HTML_DUMP}) {
    915             $raf->Seek(0, 2);   # seek to end of file
    916             $self->{HTML_DUMP}->FinishTiffDump($self, $raf->Tell());
    917             my $pos = $options->{HtmlDumpBase};
    918             $pos = ($self->{FIRST_EXIF_POS} || 0) unless defined $pos;
    919             my $dataPt = defined $self->{EXIF_DATA} ? \$self->{EXIF_DATA} : undef;
    920             undef $dataPt if defined $self->{EXIF_POS} and $pos != $self->{EXIF_POS};
    921             $self->{HTML_DUMP}->Print($raf, $dataPt, $pos,
    922                 $options->{TextOut}, $options->{HtmlDump},
    923                 $self->{FILENAME} ? "HTML Dump ($self->{FILENAME})" : 'HTML Dump');
    924         }
    925 
    926         $raf->Close() if $filename;     # close the file if we opened it
     1572        unless ($reEntry) {
     1573            $self->{PATH} = [ ];    # reset PATH
     1574            # calculate Composite tags
     1575            $self->BuildCompositeTags() if $options->{Composite};
     1576            # do our HTML dump if requested
     1577            if ($self->{HTML_DUMP}) {
     1578                $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;
     1588            }
     1589        }
     1590        if ($filename) {
     1591            $raf->Close();  # close the file if we opened it
     1592            # process the resource fork as an embedded file on Mac filesystems
     1593            if ($rsize and $options->{ExtractEmbedded}) {
     1594                local *RESOURCE_FILE;
     1595                if (open(RESOURCE_FILE, "$filename/rsrc")) {
     1596                    $$self{DOC_NUM} = $$self{DOC_COUNT} + 1;
     1597                    $$self{IN_RESOURCE} = 1;
     1598                    $self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 });
     1599                    close RESOURCE_FILE;
     1600                    delete $$self{IN_RESOURCE};
     1601                } else {
     1602                    $self->Warn('Error opening resource fork');
     1603                }
     1604            }
     1605        }
    9271606    }
    9281607
    … …  
    9301609    %saveOptions and $self->{OPTIONS} = \%saveOptions;
    9311610
    932     return exists $self->{VALUE}->{Error} ? 0 : 1;
     1611    if ($reEntry) {
     1612        # restore necessary members when exiting re-entrant code
     1613        $$self{$_} = $$reEntry{$_} foreach keys %$reEntry;
     1614    }
     1615
     1616    return exists $self->{VALUE}{Error} ? 0 : 1;
    9331617}
    9341618
    … …  
    9411625#        - If groups are specified, first groups take precedence if duplicate
    9421626#          tags found but Duplicates option not set.
     1627#        - tag names may end in '#' to extract ValueConv value
    9431628sub GetInfo($;@)
    9441629{
    … …  
    9551640
    9561641    # get reference to list of tags for which we will return info
    957     my $rtnTags = $self->SetFoundTags();
     1642    my ($rtnTags, $byValue) = $self->SetFoundTags();
    9581643
    9591644    # build hash of tag information
    9601645    my (%info, %ignored);
    961     my $conv = $self->{OPTIONS}->{PrintConv} ? 'PrintConv' : 'ValueConv';
     1646    my $conv = $self->{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
    9621647    foreach (@$rtnTags) {
    9631648        my $val = $self->GetValue($_, $conv);
    9641649        defined $val or $ignored{$_} = 1, next;
    9651650        $info{$_} = $val;
     1651    }
     1652
     1653    # override specified tags with ValueConv value if necessary
     1654    if (@$byValue and $conv ne 'ValueConv') {
     1655        # first determine the number of times each non-ValueConv value is used
     1656        my %nonVal;
     1657        $nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags;
     1658        --$nonVal{$$rtnTags[$_]} foreach @$byValue;
     1659        # loop through ValueConv tags, updating tag keys and returned values
     1660        foreach (@$byValue) {
     1661            my $tag = $$rtnTags[$_];
     1662            my $val = $self->GetValue($tag, 'ValueConv');
     1663            next unless defined $val;
     1664            my $vtag = $tag;
     1665            # generate a new tag key like "Tag #" or "Tag #(1)"
     1666            $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};
     1672                # remove existing PrintConv entry unless we are using it too
     1673                delete $info{$tag} unless $nonVal{$tag};
     1674            }
     1675            $$rtnTags[$_] = $vtag;  # store ValueConv value with new tag key
     1676            $info{$vtag} = $val;    # return ValueConv value
     1677        }
    9661678    }
    9671679
    … …  
    9801692        # use file order by default if no tags specified
    9811693        # (no such thing as 'Input' order in this case)
    982         my $sortOrder = $self->{OPTIONS}->{Sort};
     1694        my $sortOrder = $self->{OPTIONS}{Sort};
    9831695        unless (@$reqTags or ($sortOrder and $sortOrder ne 'Input')) {
    9841696            $sortOrder = 'File';
    … …  
    10031715    local $_;
    10041716    my $self = shift;
    1005     my (%combinedInfo, $info);
    1006 
    1007     if ($self->{OPTIONS}->{Duplicates}) {
     1717    my (%combinedInfo, $info, $tag, %haveInfo);
     1718
     1719    if ($self->{OPTIONS}{Duplicates}) {
    10081720        while ($info = shift) {
    1009             my $key;
    1010             foreach $key (keys %$info) {
    1011                 $combinedInfo{$key} = $$info{$key};
     1721            foreach $tag (keys %$info) {
     1722                $combinedInfo{$tag} = $$info{$tag};
    10121723            }
    10131724        }
    10141725    } else {
    1015         my (%haveInfo, $tag);
    10161726        while ($info = shift) {
    10171727            foreach $tag (keys %$info) {
    … …  
    10561766        $foundTags = $self->{FOUND_TAGS} || $self->SetFoundTags() or return undef;
    10571767    }
    1058     $sortOrder or $sortOrder = $self->{OPTIONS}->{Sort};
     1768    $sortOrder or $sortOrder = $self->{OPTIONS}{Sort};
    10591769
    10601770    # return original list if no sort order specified
    … …  
    10631773    if ($sortOrder eq 'Alpha') {
    10641774        return sort @$foundTags;
    1065     } elsif ($sortOrder =~ /^Group(\d*)/) {
     1775    } elsif ($sortOrder =~ /^Group(\d*(:\d+)*)/) {
    10661776        my $family = $1 || 0;
    10671777        # want to maintain a basic file order with the groups
    … …  
    10861796# Get list of found tags in specified sort order
    10871797# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...)
    1088 # Returns: List of tags in specified order
     1798# Returns: List of tag keys in specified order
    10891799# Notes: If not specified, sort order is taken from OPTIONS
    10901800sub GetFoundTags($;$)
    … …  
    10991809# Get list of requested tags
    11001810# Inputs: 0) ExifTool object reference
    1101 # Returns: List of requested tags
     1811# Returns: List of requested tag keys
    11021812sub GetRequestedTags($)
    11031813{
    11041814    local $_;
    1105     return @{$_[0]->{REQUESTED_TAGS}};
     1815    return @{$_[0]{REQUESTED_TAGS}};
    11061816}
    11071817
    11081818#------------------------------------------------------------------------------
    11091819# Get tag value
    1110 # Inputs: 0) ExifTool object reference, 1) tag key
     1820# Inputs: 0) ExifTool object reference
     1821#         1) tag key (or flattened tagInfo for getting field values, not part of public API)
    11111822#         2) [optional] Value type: PrintConv, ValueConv, Both or Raw, the default
    11121823#            is PrintConv or ValueConv, depending on the PrintConv option setting
     1824#         3) raw field value (not part of public API)
    11131825# Returns: Scalar context: tag value or undefined
    11141826#          List context: list of values or empty list
    … …  
    11161828{
    11171829    local $_;
    1118     my ($self, $tag, $type) = @_;
     1830    my ($self, $tag, $type) = @_; # plus: ($fieldValue)
     1831    my (@convTypes, $tagInfo, $valueConv, $both);
     1832
     1833    # figure out what conversions to do
     1834    $type or $type = $self->{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv';
    11191835
    11201836    # start with the raw value
    1121     my $value = $self->{VALUE}->{$tag};
    1122     return wantarray ? () : undef unless defined $value;
    1123 
    1124     # figure out what conversions to do
    1125     my (@convTypes, $tagInfo);
    1126     $type or $type = $self->{OPTIONS}->{PrintConv} ? 'PrintConv' : 'ValueConv';
    1127     unless ($type eq 'Raw') {
    1128         $tagInfo = $self->{TAG_INFO}->{$tag};
    1129         push @convTypes, 'ValueConv';
    1130         push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
     1837    my $value = $self->{VALUE}{$tag};
     1838    if (not defined $value) {
     1839        return wantarray ? () : undef unless ref $tag;
     1840        # get the value of a structure field
     1841        $tagInfo = $tag;
     1842        $tag = $$tagInfo{Name};
     1843        $value = $_[3];
     1844        # (note: type "Both" is not allowed for structure fields)
     1845        if ($type ne 'Raw') {
     1846            push @convTypes, 'ValueConv';
     1847            push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
     1848        }
     1849    } else {
     1850        $tagInfo = $self->{TAG_INFO}{$tag};
     1851        if ($$tagInfo{Struct} and ref $value) {
     1852            # must load XMPStruct.pl just in case (should already be loaded if
     1853            # a structure was extracted, but we could also arrive here if a simple
     1854            # list of values was stored incorrectly in a Struct tag)
     1855            require 'Image/ExifTool/XMPStruct.pl';
     1856            # convert strucure field values
     1857            unless ($type eq 'Both') {
     1858                # (note: ConvertStruct handles the escape too if necessary)
     1859                return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type);
     1860            }
     1861            $valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv');
     1862            $value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv');
     1863            # (must not save these in $$self{BOTH} because the values may have been escaped)
     1864            return ($valueConv, $value);
     1865        }
     1866        if ($type ne 'Raw') {
     1867            # use values we calculated already if we stored them
     1868            $both = $self->{BOTH}{$tag};
     1869            if ($both) {
     1870                if ($type eq 'PrintConv') {
     1871                    $value = $$both[1];
     1872                } elsif ($type eq 'ValueConv') {
     1873                    $value = $$both[0];
     1874                    $value = $$both[1] unless defined $value;
     1875                } else {
     1876                    ($valueConv, $value) = @$both;
     1877                }
     1878            } else {
     1879                push @convTypes, 'ValueConv';
     1880                push @convTypes, 'PrintConv' unless $type eq 'ValueConv';
     1881            }
     1882        }
    11311883    }
    11321884
    11331885    # do the conversions
    1134     my (@val, @prt, @raw, $convType, $valueConv);
     1886    my (@val, @prt, @raw, $convType);
    11351887    foreach $convType (@convTypes) {
    1136         last if ref $value eq 'SCALAR'; # don't convert a scalar reference
     1888        # don't convert a scalar reference or structure
     1889        last if ref $value eq 'SCALAR';
    11371890        my $conv = $$tagInfo{$convType};
    11381891        unless (defined $conv) {
    … …  
    11411894                $conv = '\$val';  # return scalar reference for binary values
    11421895            } else {
    1143                 # use PRINT_CONV from tag table if PrintConv not defined
    1144                 next unless defined($conv = $tagInfo->{Table}->{PRINT_CONV});
     1896                # use PRINT_CONV from tag table if PrintConv doesn't exist
     1897                next unless defined($conv = $tagInfo->{Table}{PRINT_CONV});
     1898                next if exists $$tagInfo{$convType};
    11451899            }
    11461900        }
    … …  
    11531907            $conv = $$convList[0];
    11541908            my @valList = split ' ', $value;
    1155             $value = \@valList;
     1909            # reorganize list if specified (Note: The writer currently doesn't
     1910            # relist values, so they may be grouped but the order must not change)
     1911            my $relist = $$tagInfo{Relist};
     1912            if ($relist) {
     1913                my (@newList, $oldIndex);
     1914                foreach $oldIndex (@$relist) {
     1915                    my ($newVal, @join);
     1916                    if (ref $oldIndex) {
     1917                        foreach (@$oldIndex) {
     1918                            push @join, $valList[$_] if defined $valList[$_];
     1919                        }
     1920                        $newVal = join(' ', @join) if @join;
     1921                    } else {
     1922                        $newVal = $valList[$oldIndex];
     1923                    }
     1924                    push @newList, $newVal if defined $newVal;
     1925                }
     1926                $value = \@newList;
     1927            } else {
     1928                $value = \@valList;
     1929            }
    11561930        }
    11571931        # initialize array so we can iterate over values in list
    … …  
    11661940        for (;;) {
    11671941            if (defined $conv) {
    1168                 # get values of required tags if this is a composite tag
     1942                # get values of required tags if this is a Composite tag
    11691943                if (ref $val eq 'HASH' and not @val) {
     1944                    # disable escape of source values so we don't double escape them
     1945                    my $oldEscape = $$self{ESCAPE_PROC};
     1946                    delete $$self{ESCAPE_PROC};
    11701947                    foreach (keys %$val) {
    1171                         $raw[$_] = $self->{VALUE}->{$$val{$_}};
     1948                        $raw[$_] = $self->{VALUE}{$$val{$_}};
    11721949                        ($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both');
    1173                         next if defined $val[$_] or not $tagInfo->{Require}->{$_};
     1950                        next if defined $val[$_] or not $tagInfo->{Require}{$_};
     1951                        $$self{ESCAPE_PROC} = $oldEscape;
    11741952                        return wantarray ? () : undef;
    11751953                    }
     1954                    $$self{ESCAPE_PROC} = $oldEscape;
    11761955                    # set $val to $val[0], or \@val for a CODE ref conversion
    11771956                    $val = ref $conv eq 'CODE' ? \@val : $val[0];
    … …  
    11791958                if (ref $conv eq 'HASH') {
    11801959                    # look up converted value in hash
    1181                     unless (defined($value = $$conv{$val})) {
     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');
     1969                        }
     1970                    } else {
    11821971                        if ($$conv{BITMASK}) {
    11831972                            $value = DecodeBits($val, $$conv{BITMASK});
    1184                         } else {
    1185                             if ($$tagInfo{PrintHex} and $val and IsInt($val) and
    1186                                 $convType eq 'PrintConv')
     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;
     1983                            }
     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')
    11871991                            {
    11881992                                $val = sprintf('0x%x',$val);
    … …  
    12022006                        $@ and $evalWarning = $@;
    12032007                    }
    1204                     if ($evalWarning) {
    1205                         delete $SIG{'__WARN__'};
    1206                         warn "$convType $tag: " . CleanWarning() . "\n";
    1207                     }
     2008                    $self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning;
    12082009                }
    12092010            } else {
    … …  
    12282029    }
    12292030    if ($type eq 'Both') {
    1230         # $valueConv is undefined if there was no print conversion done
    1231         $valueConv = $value unless defined $valueConv;
     2031        # save both (unescaped) values because we often need them again
     2032        # (Composite tags need "Both" and often Require one tag for various Composite tags)
     2033        $self->{BOTH}{$tag} = [ $valueConv, $value ] unless $both;
     2034        # escape values if necessary
     2035        if ($$self{ESCAPE_PROC}) {
     2036            DoEscape($value, $$self{ESCAPE_PROC});
     2037            if (defined $valueConv) {
     2038                DoEscape($valueConv, $$self{ESCAPE_PROC});
     2039            } else {
     2040                $valueConv = $value;
     2041            }
     2042        } elsif (not defined $valueConv) {
     2043            # $valueConv is undefined if there was no print conversion done
     2044            $valueConv = $value;
     2045        }
    12322046        # return Both values as a list (ValueConv, PrintConv)
    12332047        return ($valueConv, $value);
    12342048    }
     2049    # escape value if necessary
     2050    DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
     2051
    12352052    if (ref $value eq 'ARRAY') {
    12362053        # return array if requested
    12372054        return @$value if wantarray;
    1238         # return list reference for Raw, ValueConv or if List option set
    1239         return $value if @convTypes < 2 or $self->{OPTIONS}->{List};
     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];
    12402057        # otherwise join in comma-separated string
    1241         $value = join ', ', @$value;
     2058        $value = join $self->{OPTIONS}{ListSep}, @$value;
    12422059    }
    12432060    return $value;
    … …  
    12472064# Get tag identification number
    12482065# Inputs: 0) ExifTool object reference, 1) tag key
    1249 # Returns: Tag ID if available, otherwise ''
     2066# Returns: Scalar context: Tag ID if available, otherwise ''
     2067#          List context: 0) Tag ID (or ''), 1) language code (or undef)
    12502068sub GetTagID($$)
    12512069{
    1252     local $_;
    12532070    my ($self, $tag) = @_;
    1254     my $tagInfo = $self->{TAG_INFO}->{$tag};
    1255 
    1256     if ($tagInfo) {
    1257         GenerateAllTagIDs();    # make sure tag ID's are generated
    1258         defined $$tagInfo{TagID} and return $$tagInfo{TagID};
    1259     }
    1260     # no ID for this tag (shouldn't happen)
    1261     return '';
     2071    my $tagInfo = $self->{TAG_INFO}{$tag};
     2072    return '' unless $tagInfo and defined $$tagInfo{TagID};
     2073    return ($$tagInfo{TagID}, $$tagInfo{LangCode}) if wantarray;
     2074    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 ''
     2081sub 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
     2092sub GetTagIndex($$)
     2093{
     2094    my ($self, $tag) = @_;
     2095    my $tagInfo = $self->{TAG_INFO}{$tag} or return undef;
     2096    return $$tagInfo{Index};
    12622097}
    12632098
    … …  
    12712106    local $_;
    12722107    my ($self, $tag) = @_;
    1273     my $tagInfo = $self->{TAG_INFO}->{$tag};
    1274     # ($tagInfo should be defined for any extracted tag,
    1275     # but we might as well handle the case where it isn't)
    1276     my $desc;
    1277     $desc = $$tagInfo{Description} if $tagInfo;
     2108    my ($desc, $name);
     2109    my $tagInfo = $self->{TAG_INFO}{$tag};
     2110    # ($tagInfo won't be defined for missing tags extracted with -f)
     2111    if ($tagInfo) {
     2112        # use alternate language description if available
     2113        while ($$self{CUR_LANG}) {
     2114            $desc = $self->{CUR_LANG}{$$tagInfo{Name}};
     2115            if ($desc) {
     2116                # must look up Description if this tag also has a PrintConv
     2117                $desc = $$desc{Description} or last if ref $desc;
     2118            } else {
     2119                # look up default language of lang-alt tag
     2120                last unless $$tagInfo{LangCode} and
     2121                    ($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and
     2122                    $desc = $self->{CUR_LANG}{$name};
     2123                $desc = $$desc{Description} or last if ref $desc;
     2124                $desc .= " ($$tagInfo{LangCode})";
     2125            }
     2126            # escape description if necessary
     2127            DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC};
     2128            # return description in proper Charset
     2129            return $self->Decode($desc, 'UTF8');
     2130        }
     2131        $desc = $$tagInfo{Description};
     2132    }
    12782133    # just make the tag more readable if description doesn't exist
    12792134    unless ($desc) {
    … …  
    12892144# Inputs: 0) ExifTool object reference
    12902145#         1) tag key (or reference to tagInfo hash, not part of the public API)
    1291 #         2) [optional] group family number (-1 to get extended group list)
     2146#         2) [optional] group family (-1 to get extended group list)
    12922147# Returns: Scalar context: Group name (for family 0 if not otherwise specified)
    12932148#          Array context: Group name if family specified, otherwise list of
    1294 #          group names for each family.
     2149#          group names for each family.  Returns '' for undefined tag.
     2150# Notes: Mutiple families may be specified with ':' in family argument (ie. '1:2')
    12952151sub GetGroup($$;$)
    12962152{
    12972153    local $_;
    12982154    my ($self, $tag, $family) = @_;
    1299     my ($tagInfo, @groups, $extra);
     2155    my ($tagInfo, @groups, @families, $simplify, $byTagInfo);
    13002156    if (ref $tag eq 'HASH') {
    13012157        $tagInfo = $tag;
    1302         $tag = $tagInfo->{Name};
     2158        $tag = $$tagInfo{Name};
     2159        # set flag so we don't get extra information for an extracted tag
     2160        $byTagInfo = 1;
    13032161    } else {
    1304         $tagInfo = $self->{TAG_INFO}->{$tag} or return '';
     2162        $tagInfo = $self->{TAG_INFO}{$tag} or return '';
    13052163    }
    13062164    my $groups = $$tagInfo{Groups};
    13072165    # fill in default groups unless already done
     2166    # (after this, Groups 0-2 in tagInfo are guaranteed to be defined)
    13082167    unless ($$tagInfo{GotGroups}) {
    13092168        my $tagTablePtr = $$tagInfo{Table};
    … …  
    13132172            # fill in default groups
    13142173            foreach (keys %{$$tagTablePtr{GROUPS}}) {
    1315                 $$groups{$_} or $$groups{$_} = $tagTablePtr->{GROUPS}->{$_};
     2174                $$groups{$_} or $$groups{$_} = $tagTablePtr->{GROUPS}{$_};
    13162175            }
    13172176        }
    … …  
    13192178        $$tagInfo{GotGroups} = 1;
    13202179    }
    1321     if (defined $family and $family >= 0) {
    1322         return $$groups{$family} || 'Other' unless $family == 1;
    1323         $groups[$family] = $$groups{$family};
     2180    if (defined $family and $family ne '-1') {
     2181        if ($family =~ /[^\d]/) {
     2182            @families = ($family =~ /\d+/g);
     2183            return $$groups{0} unless @families;
     2184            $simplify = 1 unless $family =~ /^:/;
     2185            undef $family;
     2186            foreach (0..2) { $groups[$_] = $$groups{$_}; }
     2187        } else {
     2188            return $$groups{$family} if $family == 0 or $family == 2;
     2189            $groups[1] = $$groups{1};
     2190        }
    13242191    } else {
    13252192        return $$groups{0} unless wantarray;
    13262193        foreach (0..2) { $groups[$_] = $$groups{$_}; }
    13272194    }
    1328     # modify family 1 group name if necessary
    1329     if ($extra = $self->{GROUP1}->{$tag}) {
    1330         if ($extra =~ /^\+(.*)/) {
    1331             $groups[1] .= $1;
    1332         } else {
    1333             $groups[1] = $extra;
    1334         }
     2195    $groups[3] = 'Main';
     2196    $groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : '';
     2197    # 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};
    13352204    }
    13362205    if ($family) {
    1337         return $groups[1] if $family == 1;
     2206        return $groups[$family] || '' if $family > 0;
    13382207        # add additional matching group names to list
    13392208        # ie) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1
    … …  
    13462215        }
    13472216    }
     2217    if (@families) {
     2218        my @grps;
     2219        # create list of group names (without identical adjacent groups if simplifying)
     2220        foreach (@families) {
     2221            my $grp = $groups[$_] or next;
     2222            push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1];
     2223        }
     2224        # remove leading "Main:" if simplifying
     2225        shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main';
     2226        # return colon-separated string of group names
     2227        return join ':', @grps;
     2228    }
    13482229    return @groups;
    13492230}
    … …  
    13532234# Inputs: 0) ExifTool object reference
    13542235#         1) [optional] information hash reference (default all extracted info)
    1355 #         2) [optional] group family number (default 0)
     2236#         2) [optional] group family (default 0)
    13562237# Returns: List of group names in alphabetical order
    13572238sub GetGroups($;$$)
    … …  
    14012282
    14022283#------------------------------------------------------------------------------
    1403 # Build composite tags from required tags
     2284# Build Composite tags from Require'd/Desire'd tags
    14042285# Inputs: 0) ExifTool object reference
    14052286# Note: Tag values are calculated in alphabetical order unless a tag Require's
    1406 #       or Desire's another composite tag, in which case the calculation is
     2287#       or Desire's another Composite tag, in which case the calculation is
    14072288#       deferred until after the other tag is calculated.
    14082289sub BuildCompositeTags($)
    … …  
    14112292    my $self = shift;
    14122293
    1413     # first, add user-defined composite tags if necessary
     2294    $$self{BuildingComposite} = 1;
     2295    # first, add user-defined Composite tags if necessary
    14142296    if (%UserDefined and $UserDefined{'Image::ExifTool::Composite'}) {
    1415         AddCompositeTags($UserDefined{'Image::ExifTool::Composite'},1);
     2297        AddCompositeTags($UserDefined{'Image::ExifTool::Composite'}, 1);
    14162298        delete $UserDefined{'Image::ExifTool::Composite'};
    14172299    }
    … …  
    14222304    for (;;) {
    14232305        my %notBuilt;
    1424         foreach (@tagList) {
    1425             $notBuilt{$_} = 1;
    1426         }
     2306        $notBuilt{$_} = 1 foreach @tagList;
    14272307        my @deferredTags;
    14282308        my $tag;
    … …  
    14332313            next unless $tagInfo;
    14342314            # put required tags into array and make sure they all exist
    1435             my (%tagKey, $type, $found);
    1436             foreach $type ('Require','Desire') {
    1437                 my $req = $$tagInfo{$type} or next;
     2315            my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT});
     2316            my $require = $$tagInfo{Require} || { };
     2317            my $desire = $$tagInfo{Desire} || { };
     2318            # loop through sub-documents if necessary
     2319            my $doc;
     2320            for (;;) {
     2321                my (%tagKey, $found, $index);
    14382322                # save Require'd and Desire'd tag values in list
    1439                 my $index;
    1440                 foreach $index (keys %$req) {
    1441                     my $reqTag = $$req{$index};
     2323                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;
     2329                    }
    14422330                    # allow tag group to be specified
    1443                     if ($reqTag =~ /(.+?):(.+)/) {
     2331                    if ($reqTag =~ /^(.*):(.+)/) {
    14442332                        my ($reqGroup, $name) = ($1, $2);
    1445                         my $family;
    1446                         $family = $1 if $reqGroup =~ s/^(\d+)//;
    1447                         my $i = 0;
    1448                         for (;;++$i) {
    1449                             $reqTag = $name;
    1450                             $reqTag .= " ($i)" if $i;
    1451                             last unless defined $$rawValue{$reqTag};
    1452                             my @groups = $self->GetGroup($reqTag, $family);
    1453                             last if grep { $reqGroup eq $_ } @groups;
     2333                        if ($reqGroup eq 'Composite' and $notBuilt{$name}) {
     2334                            push @deferredTags, $tag;
     2335                            next COMPOSITE_TAG;
    14542336                        }
     2337                        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;
     2343                        }
     2344                        # find first matching tag
     2345                        $key = $self->GroupMatches($reqGroup, \@keys);
     2346                        $reqTag = $key if $key;
    14552347                    } elsif ($notBuilt{$reqTag}) {
    14562348                        # calculate this tag later if it relies on another
    … …  
    14612353                    if (defined $$rawValue{$reqTag}) {
    14622354                        $found = 1;
    1463                     } else {
    1464                         # don't continue if we require this tag
    1465                         $type eq 'Require' and next COMPOSITE_TAG;
     2355                    } elsif ($$require{$index}) {
     2356                        $found = 0;
     2357                        last;   # don't continue since we require this tag
    14662358                    }
    14672359                    $tagKey{$index} = $reqTag;
    14682360                }
    1469             }
    1470             delete $notBuilt{$tag}; # this tag is OK to build now
    1471             next unless $found;     # can't build tag if no values found
    1472             # keep track of all require'd tag keys
    1473             foreach (keys %tagKey) {
    1474                 # only tag keys with same name as a composite tag can be replaced
    1475                 # (also eliminates keys with instance numbers which can't be replaced either)
    1476                 next unless $Image::ExifTool::Composite{$tagKey{$_}};
    1477                 my $keyRef = \$tagKey{$_};
    1478                 $tagsUsed{$$keyRef} or $tagsUsed{$$keyRef} = [ ];
    1479                 push @{$tagsUsed{$$keyRef}}, $keyRef;
    1480             }
    1481             # save reference to tag key lookup as value for composite tag
    1482             my $key = $self->FoundTag($tagInfo, \%tagKey);
    1483             # check to see if we just replaced one of the tag keys we require'd
    1484             next unless defined $key and $tagsUsed{$key};
    1485             foreach (@{$tagsUsed{$key}}) {
    1486                 $$_ = $self->{MOVED_KEY};   # replace with new tag key
    1487             }
    1488             delete $tagsUsed{$key};         # can't be replaced again
     2361                if ($doc) {
     2362                    if ($found) {
     2363                        $self->{DOC_NUM} = $doc;
     2364                        $self->FoundTag($tagInfo, \%tagKey);
     2365                        delete $self->{DOC_NUM};
     2366                    }
     2367                    next if ++$doc <= $self->{DOC_COUNT};
     2368                    last;
     2369                } elsif ($found) {
     2370                    delete $notBuilt{$tag}; # this tag is OK to build now
     2371                    # keep track of all Require'd tag keys
     2372                    foreach (keys %tagKey) {
     2373                        # only tag keys with same name as a Composite tag
     2374                        # can be replaced (also eliminates keys with
     2375                        # 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;
     2380                    }
     2381                    # save reference to tag key lookup as value for Composite tag
     2382                    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
     2389                    }
     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
     2395            }
    14892396        }
    14902397        last unless @deferredTags;
    … …  
    14972404        @tagList = @deferredTags; # calculate deferred tags now
    14982405    }
     2406    delete $$self{BuildingComposite};
    14992407}
    15002408
    … …  
    15222430#------------------------------------------------------------------------------
    15232431# Get file type for specified extension
    1524 # Inputs: 0) file name or extension (case is not significant)
    1525 #         1) flag to return long description instead of type
    1526 # Returns: File type (or desc) or undef if extension not supported.  In array
     2432# Inputs: 0) file name or extension (case is not significant),
     2433#            or FileType value if a description is requested
     2434#         1) flag to return long description instead of type ('0' to return any recognized type)
     2435# Returns: File type (or desc) or undef if extension not supported or if
     2436#          description is the same as the input FileType.  In array
    15272437#          context, may return more than one file type if the file may be
    1528 #          different formats.  Returns list of all recognized extensions if no
     2438#          different formats.  Returns list of all supported extensions if no
    15292439#          file specified
    15302440sub GetFileType(;$$)
    … …  
    15322442    local $_;
    15332443    my ($file, $desc) = @_;
    1534     return sort keys %fileTypeLookup unless defined $file;
     2444    unless (defined $file) {
     2445        my @types;
     2446        if (defined $desc and $desc eq '0') {
     2447            # return all recognized types
     2448            @types = sort keys %fileTypeLookup;
     2449        } else {
     2450            # return all supported types
     2451            foreach (sort keys %fileTypeLookup) {
     2452                push @types, $_ unless defined $moduleName{$_} and $moduleName{$_} eq '0';
     2453            }
     2454        }
     2455        return @types;
     2456    }
    15352457    my $fileType;
    15362458    my $fileExt = GetFileExtension($file);
    15372459    $fileExt = uc($file) unless $fileExt;
    15382460    $fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type
    1539     return $$fileType[1] if $desc;  # return description if specified
     2461    $fileType = $fileTypeLookup{$fileType} unless ref $fileType or not $fileType;
     2462    # return description if specified
     2463    # (allow input $file to be a FileType for this purpose)
     2464    if ($desc) {
     2465        return $fileType ? $$fileType[1] : $fileDescription{$file};
     2466    } elsif ($fileType and (not defined $desc or $desc ne '0')) {
     2467        # return only supported file types
     2468        my $mod = $moduleName{$$fileType[0]};
     2469        undef $fileType if defined $mod and $mod eq '0';
     2470    }
     2471    $fileType or return wantarray ? () : undef;
    15402472    $fileType = $$fileType[0];      # get file type (or list of types)
    15412473    if (wantarray) {
    1542         return () unless $fileType;
    15432474        return @$fileType if ref $fileType eq 'ARRAY';
    15442475    } elsif ($fileType) {
    … …  
    15502481#------------------------------------------------------------------------------
    15512482# Return true if we can write the specified file type
    1552 # Inputs: 0) file name or ext,
     2483# Inputs: 0) file name or ext
    15532484# Returns: true if writable, 0 if not writable, undef if unrecognized
    1554 # Note: This will return true for some TIFF-based RAW images which we shouldn't really write
    15552485sub CanWrite($)
    15562486{
    … …  
    15582488    my $file = shift or return undef;
    15592489    my $type = GetFileType($file) or return undef;
     2490    if ($noWriteFile{$type}) {
     2491        # can't write TIFF files with certain extensions (various RAW formats)
     2492        my $ext = GetFileExtension($file) || uc($file);
     2493        return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext;
     2494    }
    15602495    return scalar(grep /^$type$/, @writeTypes);
    15612496}
    … …  
    15632498#------------------------------------------------------------------------------
    15642499# Return true if we can create the specified file type
    1565 # Inputs: 0) file name or ext,
     2500# Inputs: 0) file name or ext
    15662501# Returns: true if creatable, 0 if not writable, undef if unrecognized
    15672502sub CanCreate($)
    … …  
    15692504    local $_;
    15702505    my $file = shift or return undef;
     2506    my $ext = GetFileExtension($file) || uc($file);
    15712507    my $type = GetFileType($file) or return undef;
    1572     return scalar(grep /^$type$/, @createTypes);
     2508    return 1 if $createTypes{$ext} or $createTypes{$type};
     2509    return 0;
    15732510}
    15742511
    … …  
    15902527    delete $self->{EXIF_POS};       # EXIF position in file
    15912528    delete $self->{FIRST_EXIF_POS}; # position of first EXIF in file
    1592     delete $self->{EXIF_BYTE_ORDER};# the EXIF byte ordering
    15932529    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
    15942533    $self->{BASE}       = 0;        # base for offsets from start of file
    1595     $self->{FILE_ORDER} = { };      # hash of tag order in file
    1596     $self->{VALUE}      = { };      # hash of raw tag values
    1597     $self->{TAG_INFO}   = { };      # hash of tag information
    1598     $self->{GROUP1}     = { };      # hash of family 1 group names
    1599     $self->{PRIORITY}   = { };      # priority of current tags
     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
    16002541    $self->{PROCESSED}  = { };      # hash of processed directory start positions
    16012542    $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
    16022546    $self->{NUM_FOUND}  = 0;        # total number of tags found (incl. duplicates)
    16032547    $self->{CHANGED}    = 0;        # number of tags changed (writer only)
    16042548    $self->{INDENT}     = '  ';     # initial indent for verbose messages
    16052549    $self->{PRIORITY_DIR} = '';     # the priority directory name
     2550    $self->{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories
    16062551    $self->{TIFF_TYPE}  = '';       # type of TIFF data (APP1, TIFF, NEF, etc...)
    1607     $self->{CameraMake} = '';       # camera make
    1608     $self->{CameraModel}= '';       # camera model
     2552    $self->{Make}      = '';       # camera make
     2553    $self->{Model}      = '';       # camera model
    16092554    $self->{CameraType} = '';       # Olympus camera type
    16102555    if ($self->Options('HtmlDump')) {
    … …  
    16132558    }
    16142559    # make sure our TextOut is a file reference
    1615     $self->{OPTIONS}->{TextOut} = \*STDOUT unless ref $self->{OPTIONS}->{TextOut};
     2560    $self->{OPTIONS}{TextOut} = \*STDOUT unless ref $self->{OPTIONS}{TextOut};
    16162561}
    16172562
    … …  
    16552600                        undef @oldGroupOpts;
    16562601                    }
    1657                     $options->{$opt} = $$arg{$opt};
     2602                    $self->Options($opt, $$arg{$opt});
    16582603                    $opt eq 'Exclude' and $wasExcludeOpt = 1;
    16592604                }
    … …  
    16622607                # convert image data from UTF-8 to character stream if necessary
    16632608                # (patches RHEL 3 UTF8 LANG problem)
    1664                 if (ref $arg eq 'SCALAR' and eval 'require Encode; Encode::is_utf8($$arg)') {
    1665                     my $buff = pack('C*', unpack('U0U*', $$arg));
     2609                if (ref $arg eq 'SCALAR' and $] >= 5.006 and
     2610                    (eval 'require Encode; Encode::is_utf8($$arg)' or $@))
     2611                {
     2612                    # repack by hand if Encode isn't available
     2613                    my $buff = $@ ? pack('C*',unpack('U0C*',$$arg)) : Encode::encode('utf8',$$arg);
    16662614                    $arg = \$buff;
    16672615                }
    … …  
    16702618                # we have a file but we didn't open it
    16712619                $self->{FILENAME} = '';
     2620            } elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) {
     2621                $self->{RAF} = $arg;
     2622                $self->{FILENAME} = '';
    16722623            } else {
    16732624                warn "Don't understand ImageInfo argument $arg\n";
    … …  
    16882639        # initialize lookup for requested tags
    16892640        foreach (@{$self->{REQUESTED_TAGS}}) {
    1690             $self->{REQ_TAG_LOOKUP}->{lc(/.+?:(.+)/ ? $1 : $_)} = 1;
     2641            $self->{REQ_TAG_LOOKUP}{lc(/.+:(.+)/ ? $1 : $_)} = 1;
    16912642        }
    16922643    }
    … …  
    17032654        $options->{Exclude} = \@exclude;
    17042655        # expand shortcuts in new exclude list
    1705         ExpandShortcuts($options->{Exclude});
    1706     }
    1707 }
    1708 
    1709 #------------------------------------------------------------------------------
    1710 # Set list of found tags
     2656        ExpandShortcuts($options->{Exclude}, 1); # (also remove '#' suffix)
     2657    }
     2658}
     2659
     2660#------------------------------------------------------------------------------
     2661# Get list of tags in specified group
     2662# Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys
     2663# Returns: list of matching tags in list context, or first match in scalar context
     2664# Notes: Group spec may contain multiple groups separated by colons, each
     2665#        possibly with a leading family number
     2666sub GroupMatches($$$)
     2667{
     2668    my ($self, $group, $tagList) = @_;
     2669    $tagList = [ $tagList ] unless ref $tagList;
     2670    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);
     2675        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];
     2686                } else {
     2687                    last unless grep /^$grps[$g]$/i, @groups;
     2688                }
     2689            }
     2690            push @matches, $tag if $g == @grps;
     2691        }
     2692    } 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];
     2700}
     2701
     2702#------------------------------------------------------------------------------
     2703# Set list of found tags from previously requested tags
    17112704# Inputs: 0) ExifTool object reference
    1712 # Returns: Reference to found tags list (in order of requested tags)
     2705# Returns: 0) Reference to list of found tag keys (in order of requested tags)
     2706#          1) Reference to list of indices for tags requested by value
    17132707sub SetFoundTags($)
    17142708{
    … …  
    17212715    my @groupOptions = sort grep /^Group/, keys %$options;
    17222716    my $doDups = $duplicates || $exclude || @groupOptions;
    1723     my ($tag, $rtnTags);
     2717    my ($tag, $rtnTags, @byValue);
    17242718
    17252719    # only return requested tags if specified
    … …  
    17302724        my $reqTag;
    17312725        foreach $reqTag (@$reqTags) {
    1732             my (@matches, $group, $family, $allGrp, $allTag);
    1733             if ($reqTag =~ /^(\d+)?(.+?):(.+)/) {
    1734                 ($family, $group, $tag) = ($1, $2, $3);
    1735                 $allGrp = 1 if $group =~ /^(\*|all)$/i;
    1736                 $family = -1 unless defined $family;
     2726            my (@matches, $group, $allGrp, $allTag, $byValue);
     2727            if ($reqTag =~ /^(.*):(.+)/) {
     2728                ($group, $tag) = ($1, $2);
     2729                if ($group =~ /^(\*|all)$/i) {
     2730                    $allGrp = 1;
     2731                } elsif ($group !~ /^[-\w:]*$/) {
     2732                    $self->Warn("Invalid group name '$group'");
     2733                    $group = 'invalid';
     2734                }
    17372735            } else {
    17382736                $tag = $reqTag;
    1739                 $family = -1;
    1740             }
     2737            }
     2738            $byValue = 1 if $tag =~ s/#$//;
    17412739            if (defined $tagHash->{$reqTag} and not $doDups) {
    17422740                $matches[0] = $tag;
    … …  
    17502748                next unless @matches;   # don't want entry in list for '*' tag
    17512749                $allTag = 1;
     2750            } elsif ($tag =~ /[*?]/) {
     2751                # allow wildcards in tag names
     2752                $tag =~ s/\*/[-\\w]*/g;
     2753                $tag =~ s/\?/[-\\w]/g;
     2754                $tag .= '( .*)?' if $doDups or $allGrp;
     2755                @matches = grep(/^$tag$/i, keys %$tagHash);
     2756                next unless @matches;   # don't want entry in list for wildcard tags
     2757                $allTag = 1;
    17522758            } elsif ($doDups or defined $group) {
    17532759                # must also look for tags like "Tag (1)"
    1754                 @matches = grep(/^$tag(\s|$)/i, keys %$tagHash);
    1755             } else {
     2760                @matches = grep(/^$tag( |$)/i, keys %$tagHash);
     2761            } elsif ($tag =~ /^[-\w]+$/) {
    17562762                # find first matching value
    17572763                # (use in list context to return value instead of count)
    17582764                ($matches[0]) = grep /^$tag$/i, keys %$tagHash;
    17592765                defined $matches[0] or undef @matches;
     2766            } else {
     2767                $self->Warn("Invalid tag name '$tag'");
    17602768            }
    17612769            if (defined $group and not $allGrp) {
    17622770                # keep only specified group
    1763                 my @grpMatches;
    1764                 foreach (@matches) {
    1765                     my @groups = $self->GetGroup($_, $family);
    1766                     next unless grep /^$group$/i, @groups;
    1767                     push @grpMatches, $_;
    1768                 }
    1769                 @matches = @grpMatches;
     2771                @matches = $self->GroupMatches($group, \@matches);
    17702772                next unless @matches or not $allTag;
    17712773            }
    … …  
    17762778                unless ($doDups or $allTag or $allGrp) {
    17772779                    $tag = shift @matches;
    1778                     my $oldPriority = $self->{PRIORITY}->{$tag} || 1;
     2780                    my $oldPriority = $self->{PRIORITY}{$tag} || 1;
    17792781                    foreach (@matches) {
    1780                         my $priority = $self->{PRIORITY}->{$_};
     2782                        my $priority = $self->{PRIORITY}{$_};
    17812783                        $priority = 1 unless defined $priority;
    17822784                        next unless $priority >= $oldPriority;
    … …  
    17902792                $matches[0] = "$tag (0)";
    17912793                # bogus file order entry to avoid warning if sorting in file order
    1792                 $self->{FILE_ORDER}->{$matches[0]} = 999;
    1793             }
     2794                $self->{FILE_ORDER}{$matches[0]} = 999;
     2795            }
     2796            # save indices of tags extracted by value
     2797            push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue;
    17942798            push @$rtnTags, @matches;
    17952799        }
    … …  
    18112815    while (($exclude or @groupOptions) and @$rtnTags) {
    18122816        if ($exclude) {
    1813             my @filteredTags;
    1814 EX_TAG:     foreach $tag (@$rtnTags) {
    1815                 my $tagName = GetTagName($tag);
    1816                 my @matches = grep /(^|:)($tagName|\*|all)$/i, @$exclude;
    1817                 foreach (@matches) {
    1818                     next EX_TAG unless /^(\d+)?(.+?):/;
    1819                     my ($family, $group) = ($1, $2);
    1820                     next EX_TAG if $group =~ /^(\*|all)$/i;
    1821                     $family = -1 unless defined $family;
    1822                     my @groups = $self->GetGroup($tag, $family);
    1823                     next EX_TAG if grep /^$group$/i, @groups;
     2817            my ($pat, %exclude);
     2818            foreach $pat (@$exclude) {
     2819                my $group;
     2820                if ($pat =~ /^(.*):(.+)/) {
     2821                    ($group, $tag) = ($1, $2);
     2822                    if ($group =~ /^(\*|all)$/i) {
     2823                        undef $group;
     2824                    } elsif ($group !~ /^[-\w:]*$/) {
     2825                        $self->Warn("Invalid group name '$group'");
     2826                        $group = 'invalid';
     2827                    }
     2828                } else {
     2829                    $tag = $pat;
    18242830                }
    1825                 push @filteredTags, $tag;
    1826             }
    1827             $rtnTags = \@filteredTags;      # use new filtered tag list
     2831                my @matches;
     2832                if ($tag =~ /^(\*|all)$/i) {
     2833                    @matches = @$rtnTags;
     2834                } else {
     2835                    # allow wildcards in tag names
     2836                    $tag =~ s/\*/[-\\w]*/g;
     2837                    $tag =~ s/\?/[-\\w]/g;
     2838                    @matches = grep(/^$tag( |$)/i, @$rtnTags);
     2839                }
     2840                @matches = $self->GroupMatches($group, \@matches) if $group and @matches;
     2841                $exclude{$_} = 1 foreach @matches;
     2842            }
     2843            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
     2848            }
    18282849            last if $duplicates and not @groupOptions;
    18292850        }
    … …  
    18342855        my $wantOrder = 0;
    18352856        foreach $groupOpt (@groupOptions) {
    1836             $groupOpt =~ /^Group(\d*)/ or next;
     2857            $groupOpt =~ /^Group(\d*(:\d+)*)/ or next;
    18372858            $family = $1 || 0;
    18382859            $wantGroup{$family} or $wantGroup{$family} = { };
    … …  
    18562877                    $allGroups = 0;     # don't want all groups if we requested one
    18572878                }
    1858                 $wantGroup{$family}->{$groupName} = $want;
     2879                $wantGroup{$family}{$groupName} = $want;
    18592880            }
    18602881        }
    … …  
    18652886            foreach $family (keys %wantGroup) {
    18662887                my $group = $self->GetGroup($tag, $family);
    1867                 my $wanted = $wantGroup{$family}->{$group};
     2888                my $wanted = $wantGroup{$family}{$group};
    18682889                next unless defined $wanted;
    18692890                next GR_TAG unless $wanted;     # skip tag if group excluded
    … …  
    19032924        last;
    19042925    }
    1905 
    1906     # save found tags and return reference
    1907     return $self->{FOUND_TAGS} = $rtnTags;
     2926    $self->{FOUND_TAGS} = $rtnTags;     # save found tags
     2927
     2928    # return reference to found tag keys (and list of indices of tags to extract by value)
     2929    return wantarray ? ($rtnTags, \@byValue) : $rtnTags;
    19082930}
    19092931
    … …  
    19552977    my ($self, $str, $ignorable) = @_;
    19562978    if ($ignorable) {
    1957         return 0 if $self->{OPTIONS}->{IgnoreMinorErrors};
     2979        return 0 if $self->{OPTIONS}{IgnoreMinorErrors};
    19582980        $str = "[minor] $str";
    19592981    }
    19602982    $self->FoundTag('Warning', $str);
     2983    return 1;
     2984}
     2985
     2986#------------------------------------------------------------------------------
     2987# Add warning tag only once per processed file
     2988# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor
     2989# Returns: true if warning tag was added
     2990sub WarnOnce($$;$)
     2991{
     2992    my ($self, $str, $ignorable) = @_;
     2993    return 0 if $ignorable and $self->{OPTIONS}{IgnoreMinorErrors};
     2994    unless ($$self{WARNED_ONCE}{$str}) {
     2995        $self->Warn($str, $ignorable);
     2996        $$self{WARNED_ONCE}{$str} = 1;
     2997    }
    19612998    return 1;
    19622999}
    … …  
    19703007    my ($self, $str, $ignorable) = @_;
    19713008    if ($ignorable) {
    1972         if ($self->{OPTIONS}->{IgnoreMinorErrors}) {
     3009        if ($self->{OPTIONS}{IgnoreMinorErrors}) {
    19733010            $self->Warn($str);
    19743011            return 0;
    … …  
    19823019#------------------------------------------------------------------------------
    19833020# Expand shortcuts
    1984 # Inputs: 0) reference to list of tags
    1985 # Notes: Handles leading '-' for excluded tags, group names, and redirected tags
    1986 sub ExpandShortcuts($)
    1987 {
    1988     my $tagList = shift || return;
     3021# Inputs: 0) reference to list of tags, 1) set to remove trailing '#'
     3022# Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv,
     3023#        multiple group names, and redirected tags
     3024sub ExpandShortcuts($;$)
     3025{
     3026    my ($tagList, $removeSuffix) = @_;
     3027    return unless $tagList and @$tagList;
    19893028
    19903029    require Image::ExifTool::Shortcuts;
    19913030
    19923031    # expand shortcuts
     3032    my $suffix = $removeSuffix ? '' : '#';
    19933033    my @expandedTags;
    19943034    my ($entry, $tag, $excl);
    19953035    foreach $entry (@$tagList) {
     3036        # skip things like options hash references in list
     3037        if (ref $entry) {
     3038            push @expandedTags, $entry;
     3039            next;
     3040        }
    19963041        # remove leading '-'
    19973042        ($excl, $tag) = $entry =~ /^(-?)(.*)/s;
    1998         my ($post, @post);
     3043        my ($post, @post, $pre, $v);
    19993044        # handle redirection
    2000         if ($tag =~ /(.+?)([-+]?[<>].+)/s and not $excl) {
     3045        if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) {
    20013046            ($tag, $post) = ($1, $2);
    20023047            if ($post =~ /^[-+]?>/ or $post !~ /\$/) {
    20033048                # expand shortcuts in postfix (rhs of redirection)
    2004                 my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+?:)?(.+)/);
     3049                my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/);
    20053050                $p2 = '' unless defined $p2;
     3051                $v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix
    20063052                my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main;
    20073053                if ($match) {
    20083054                    foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
    20093055                        /^-/ and next;  # ignore excluded tags
    2010                         if ($p2 and /(.+?:)(.+)/) {
    2011                             push @post, "$op$_";
     3056                        if ($p2 and /(.+:)(.+)/) {
     3057                            push @post, "$op$_$v";
    20123058                        } else {
    2013                             push @post, "$op$p2$_";
     3059                            push @post, "$op$p2$_$v";
    20143060                        }
    20153061                    }
    … …  
    20223068        }
    20233069        # handle group names
    2024         my $pre;
    2025         if ($tag =~ /(.+?:)(.+)/) {
     3070        if ($tag =~ /(.+:)(.+)/) {
    20263071            ($pre, $tag) = ($1, $2);
    20273072        } else {
    20283073            $pre = '';
    20293074        }
     3075        $v = ($tag =~ s/#$//) ? $suffix : '';   # ValueConv suffix
    20303076        # loop over all postfixes
    20313077        for (;;) {
    … …  
    20383084                        /^-/ and next;  # ignore excluded exclude tags
    20393085                        # group of expanded tag takes precedence
    2040                         if ($pre and /(.+?:)(.+)/) {
     3086                        if ($pre and /(.+:)(.+)/) {
    20413087                            push @expandedTags, "$excl$_";
    20423088                        } else {
    … …  
    20443090                        }
    20453091                    }
    2046                 } elsif (length $pre or length $post) {
     3092                } elsif (length $pre or length $post or $v) {
    20473093                    foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) {
    2048                         /(-?)(.+?:)?(.+)/;
     3094                        /(-?)(.+:)?(.+)/;
    20493095                        if ($2) {
    20503096                            # group from expanded tag takes precedence
    2051                             push @expandedTags, "$_$post";
     3097                            push @expandedTags, "$_$v$post";
    20523098                        } else {
    2053                             push @expandedTags, "$1$pre$3$post";
     3099                            push @expandedTags, "$1$pre$3$v$post";
    20543100                        }
    20553101                    }
    … …  
    20583104                }
    20593105            } else {
    2060                 push @expandedTags, "$excl$pre$tag$post";
     3106                push @expandedTags, "$excl$pre$tag$v$post";
    20613107            }
    20623108            last unless @post;
    … …  
    20683114
    20693115#------------------------------------------------------------------------------
    2070 # Add hash of composite tags to our composites
    2071 # Inputs: 0) hash reference to table of composite tags to add or module name,
     3116# Add hash of Composite tags to our composites
     3117# Inputs: 0) hash reference to table of Composite tags to add or module name,
    20723118#         1) overwrite existing tag
    20733119sub AddCompositeTags($;$)
    … …  
    20923138        $defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' };
    20933139    }
    2094     SetupTagTable($add);
     3140    SetupTagTable($add);    # generate tag Name, etc
    20953141    my $tagID;
    2096     foreach $tagID (keys %$add) {
     3142    foreach $tagID (sort keys %$add) {
    20973143        next if $specialTags{$tagID};   # must skip special tags
    20983144        my $tagInfo = $$add{$tagID};
    … …  
    21003146        my $tag = $$tagInfo{Name};
    21013147        $$tagInfo{Module} = $module if $$tagInfo{Writable};
    2102         # allow composite tags with the same name
     3148        # allow Composite tags with the same name
    21033149        my ($t, $n, $type);
    21043150        while ($Image::ExifTool::Composite{$tag} and not $overwrite) {
    2105             $n ? $n += 1 : $n = 2, $t = $tag;
     3151            $n ? $n += 1 : ($n = 2, $t = $tag);
    21063152            $tag = "${t}_$n";
     3153            $$tagInfo{NewTagID} = $tag; # save new ID so we can use it in TagLookup
    21073154        }
    21083155        # convert scalar Require/Desire entries
    … …  
    21113158            $$tagInfo{$type} = { 0 => $req } if ref($req) ne 'HASH';
    21123159        }
    2113         # add this composite tag to our main composite table
     3160        # add this Composite tag to our main Composite table
    21143161        $$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
    21153165        $Image::ExifTool::Composite{$tag} = $tagInfo;
    21163166        # set all default groups in tag
    … …  
    21273177
    21283178#------------------------------------------------------------------------------
     3179# Add tags to TagLookup (used for writing)
     3180# Inputs: 0) source hash of tag definitions, 1) name of destination tag table
     3181sub AddTagsToLookup($$)
     3182{
     3183    my ($tagHash, $table) = @_;
     3184    if (defined &Image::ExifTool::TagLookup::AddTags) {
     3185        Image::ExifTool::TagLookup::AddTags($tagHash, $table);
     3186    } elsif (not $Image::ExifTool::pluginTags{$tagHash}) {
     3187        # queue these tags until TagLookup is loaded
     3188        push @Image::ExifTool::pluginTags, [ $tagHash, $table ];
     3189        # set flag so we don't load same tags twice
     3190        $Image::ExifTool::pluginTags{$tagHash} = 1;
     3191    }
     3192}
     3193
     3194#------------------------------------------------------------------------------
    21293195# Expand tagInfo Flags
    21303196# Inputs: 0) tagInfo hash ref
    … …  
    21523218# Inputs: 0) Reference to tag table
    21533219# Notes: - generates 'Name' field from key if it doesn't exist
    2154 #        - stores 'Table' pointer
     3220#        - stores 'Table' pointer and 'TagID' value
    21553221#        - expands 'Flags' for quick lookup
    21563222sub SetupTagTable($)
    21573223{
    21583224    my $tagTablePtr = shift;
    2159     my $tagID;
     3225    my ($tagID, $tagInfo);
    21603226    foreach $tagID (TagTableKeys($tagTablePtr)) {
    21613227        my @infoArray = GetTagInfoList($tagTablePtr,$tagID);
    21623228        # process conditional tagInfo arrays
    2163         my $tagInfo;
    21643229        foreach $tagInfo (@infoArray) {
    21653230            $$tagInfo{Table} = $tagTablePtr;
     3231            $$tagInfo{TagID} = $tagID;
    21663232            my $tag = $$tagInfo{Name};
    21673233            unless (defined $tag) {
    … …  
    21723238            $$tagInfo{Flags} and ExpandFlags($tagInfo);
    21733239        }
     3240        next unless @infoArray > 1;
     3241        # add an "Index" member to each tagInfo in a list
     3242        my $index = 0;
     3243        foreach $tagInfo (@infoArray) {
     3244            $$tagInfo{Index} = $index++;
     3245        }
    21743246    }
    21753247}
    … …  
    21803252# Notes: May change commas to decimals in floats for use in other locales
    21813253sub IsFloat($) {
    2182     return 1 if $_[0] =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
     3254    return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
    21833255    # allow comma separators (for other locales)
    2184     return 0 unless $_[0] =~ /^([+-]?)(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/;
     3256    return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/;
    21853257    $_[0] =~ tr/,/./;   # but translate ',' to '.'
    21863258    return 1;
    21873259}
    2188 sub IsInt($)   { return scalar($_[0] =~ /^[+-]?\d+$/); }
    2189 sub IsHex($)   { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); }
     3260sub IsInt($)      { return scalar($_[0] =~ /^[+-]?\d+$/); }
     3261sub IsHex($)      { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); }
     3262sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); }
    21903263
    21913264# round floating point value to specified number of significant digits
    … …  
    22013274}
    22023275
     3276# Convert strings to floating point numbers (or undef)
     3277# Inputs: 0-N) list of strings (may be undef)
     3278# Returns: last value converted
     3279sub ToFloat(@)
     3280{
     3281    local $_;
     3282    foreach (@_) {
     3283        next unless defined $_;
     3284        # (add 0 to convert "0.0" to "0" for tests)
     3285        $_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef;
     3286    }
     3287    return $_[-1];
     3288}
     3289
    22033290#------------------------------------------------------------------------------
    22043291# Utility routines to for reading binary data values from file
    22053292
    2206 my $swapBytes;               # set if EXIF header is not native byte ordering
    2207 my $swapWords;               # swap 32-bit words in doubles (ARM quirk)
    2208 my $currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM')
    22093293my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' );
    22103294my %unpackIntel    = ( S => 'v', L => 'V', C => 'C', c => 'c' );
    2211 my %unpackStd = %unpackMotorola;
     3295my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' );
     3296
     3297# the following 4 variables are defined in 'use vars' instead of using 'my'
     3298# because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my'
     3299# variables from within subroutines (ref communication with Pavel Merdin):
     3300# $swapBytes - set if EXIF header is not native byte ordering
     3301# $swapWords - swap 32-bit words in doubles (ARM quirk)
     3302$currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM')
     3303%unpackStd = %unpackMotorola;
    22123304
    22133305# Swap bytes in data if necessary
    … …  
    22403332    return unpack($unpackStd{$_[0]}, ${$_[1]});
    22413333}
     3334# same, but with reversed byte order
     3335sub DoUnpackRev(@)
     3336{
     3337    my $fmt = $unpackRev{$unpackStd{$_[0]}};
     3338    $_[2] and return unpack("x$_[2] $fmt", ${$_[1]});
     3339    return unpack($fmt, ${$_[1]});
     3340}
    22423341# Pack value
    22433342# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref)
    … …  
    22463345{
    22473346    my $val = pack($unpackStd{$_[0]}, $_[1]);
     3347    $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
     3348    return $val;
     3349}
     3350# same, but with reversed byte order
     3351sub DoPackRev(@)
     3352{
     3353    my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]);
    22483354    $_[2] and substr(${$_[2]}, $_[3], length($val)) = $val;
    22493355    return $val;
    … …  
    22893395sub GetFloat($$)  { return DoUnpack(4, 'f', @_); }
    22903396sub GetDouble($$) { return DoUnpackDbl('d', @_); }
    2291 
     3397sub Get16uRev($$) { return DoUnpackRev('S', @_); }
     3398
     3399# rationals may be a floating point number, 'inf' or 'undef'
    22923400sub GetRational32s($$)
    22933401{
    22943402    my ($dataPt, $pos) = @_;
    2295     my $denom = Get16s($dataPt, $pos + 2) or return 'inf';
     3403    my $numer = Get16s($dataPt,$pos);
     3404    my $denom = Get16s($dataPt, $pos + 2) or return $numer ? 'inf' : 'undef';
    22963405    # round off to a reasonable number of significant figures
    2297     return RoundFloat(Get16s($dataPt,$pos) / $denom, 7);
     3406    return RoundFloat($numer / $denom, 7);
    22983407}
    22993408sub GetRational32u($$)
    23003409{
    23013410    my ($dataPt, $pos) = @_;
    2302     my $denom = Get16u($dataPt, $pos + 2) or return 'inf';
    2303     return RoundFloat(Get16u($dataPt,$pos) / $denom, 7);
     3411    my $numer = Get16u($dataPt,$pos);
     3412    my $denom = Get16u($dataPt, $pos + 2) or return $numer ? 'inf' : 'undef';
     3413    return RoundFloat($numer / $denom, 7);
    23043414}
    23053415sub GetRational64s($$)
    23063416{
    23073417    my ($dataPt, $pos) = @_;
    2308     my $denom = Get32s($dataPt, $pos + 4) or return 'inf';
    2309     return RoundFloat(Get32s($dataPt,$pos) / $denom, 10);
     3418    my $numer = Get32s($dataPt,$pos);
     3419    my $denom = Get32s($dataPt, $pos + 4) or return $numer ? 'inf' : 'undef';
     3420    return RoundFloat($numer / $denom, 10);
    23103421}
    23113422sub GetRational64u($$)
    23123423{
    23133424    my ($dataPt, $pos) = @_;
    2314     my $denom = Get32u($dataPt, $pos + 4) or return 'inf';
    2315     return RoundFloat(Get32u($dataPt,$pos) / $denom, 10);
     3425    my $numer = Get32u($dataPt,$pos);
     3426    my $denom = Get32u($dataPt, $pos + 4) or return $numer ? 'inf' : 'undef';
     3427    return RoundFloat($numer / $denom, 10);
    23163428}
    23173429sub GetFixed16s($$)
    … …  
    23443456sub Set16u(@) { return DoPackStd('S', @_); }
    23453457sub Set32u(@) { return DoPackStd('L', @_); }
     3458sub Set16uRev(@) { return DoPackRev('S', @_); }
    23463459
    23473460#------------------------------------------------------------------------------
    … …  
    23513464#------------------------------------------------------------------------------
    23523465# Set byte ordering
    2353 # Inputs: 0) 'II'=intel, 'MM'=motorola
     3466# Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian')
    23543467# Returns: 1 on success
    23553468sub SetByteOrder($)
    … …  
    23603473        %unpackStd = %unpackMotorola;
    23613474    } elsif ($order eq 'II') {  # little endian (Intel)
     3475        %unpackStd = %unpackIntel;
     3476    } elsif ($order =~ /^Big/i) {
     3477        $order = 'MM';
     3478        %unpackStd = %unpackMotorola;
     3479    } elsif ($order =~ /^Little/i) {
     3480        $order = 'II';
    23623481        %unpackStd = %unpackIntel;
    23633482    } else {
    … …  
    24023521    int16s => 2,
    24033522    int16u => 2,
     3523    int16uRev => 2,
    24043524    int32s => 4,
    24053525    int32u => 4,
    … …  
    24173537    double => 8,
    24183538    extended => 10,
     3539    unicode => 2,
     3540    complex => 8,
    24193541    string => 1,
    24203542    binary => 1,
    24213543   'undef' => 1,
    24223544    ifd => 4,
    2423     ifd8 => 8,
     3545    ifd64 => 8,
    24243546);
    24253547my %readValueProc = (
    … …  
    24283550    int16s => \&Get16s,
    24293551    int16u => \&Get16u,
     3552    int16uRev => \&Get16uRev,
    24303553    int32s => \&Get32s,
    24313554    int32u => \&Get32u,
    … …  
    24443567    extended => \&GetExtended,
    24453568    ifd => \&Get32u,
    2446     ifd8 => \&Get64u,
     3569    ifd64 => \&Get64u,
    24473570);
    24483571sub FormatSize($) { return $formatSize{$_[0]}; }
    … …  
    24823605        }
    24833606    } else {
    2484         # handle undef/binary/string
    2485         $vals[0] = substr($$dataPt, $offset, $count);
     3607        # handle undef/binary/string (also unsupported unicode/complex)
     3608        $vals[0] = substr($$dataPt, $offset, $count * $len);
    24863609        # truncate string at null terminator if necessary
    24873610        $vals[0] =~ s/\0.*//s if $format eq 'string';
    24883611    }
    2489     if (wantarray) {
    2490         return @vals;
    2491     } elsif (@vals > 1) {
    2492         return join(' ', @vals);
    2493     } else {
    2494         return $vals[0];
    2495     }
    2496 }
    2497 
    2498 #------------------------------------------------------------------------------
    2499 # Convert UTF-8 to current character set
    2500 # Inputs: 0) ExifTool ref, 1) UTF-8 string
    2501 # Return: Converted string
    2502 sub UTF82Charset($$)
    2503 {
    2504     my ($self, $val) = @_;
    2505     if ($self->{OPTIONS}->{Charset} eq 'Latin' and $val =~ /[\x80-\xff]/) {
    2506         $val = Image::ExifTool::UTF82Unicode($val,'n',$self);
    2507         $val = Image::ExifTool::Unicode2Latin($val,'n',$self);
     3612    return @vals if wantarray;
     3613    return join(' ', @vals) if @vals > 1;
     3614    return $vals[0];
     3615}
     3616
     3617#------------------------------------------------------------------------------
     3618# Decode string with specified encoding
     3619# Inputs: 0) ExifTool object ref, 1) string to decode
     3620#         2) source character set name (undef for current Charset)
     3621#         3) optional source byte order (2-byte and 4-byte fixed-width sets only)
     3622#         4) optional destination character set (defaults to Charset setting)
     3623#         5) optional destination byte order (2-byte and 4-byte fixed-width only)
     3624# Returns: string in destination encoding
     3625# Note: ExifTool ref may be undef if character both character sets are provided
     3626#       (but in this case no warnings will be issued)
     3627sub Decode($$$;$$$)
     3628{
     3629    my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_;
     3630    $from or $from = $$self{OPTIONS}{Charset};
     3631    $to or $to = $$self{OPTIONS}{Charset};
     3632    if ($from ne $to and length $val) {
     3633        require Image::ExifTool::Charset;
     3634        my $cs1 = $Image::ExifTool::Charset::csType{$from};
     3635        my $cs2 = $Image::ExifTool::Charset::csType{$to};
     3636        if ($cs1 and $cs2 and not $cs2 & 0x002) {
     3637            # treat as straight ASCII if no character will need remapping
     3638            if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) {
     3639                my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder);
     3640                $val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder);
     3641            }
     3642        } elsif ($self) {
     3643            my $set = $cs1 ? $to : $from;
     3644            unless ($$self{"DecodeWarn$set"}) {
     3645                $self->Warn("Unsupported character set ($set)");
     3646                $$self{"DecodeWarn$set"} = 1;
     3647            }
     3648        }
    25083649    }
    25093650    return $val;
    … …  
    25113652
    25123653#------------------------------------------------------------------------------
    2513 # Convert Latin to current character set
    2514 # Inputs: 0) ExifTool ref, 1) Latin string
    2515 # Return: Converted string
    2516 sub Latin2Charset($$)
    2517 {
    2518     my ($self, $val) = @_;
    2519     if ($self->{OPTIONS}->{Charset} eq 'UTF8' and $val =~ /[\x80-\xff]/) {
    2520         $val = Image::ExifTool::Latin2Unicode($val,'n');
    2521         $val = Image::ExifTool::Unicode2UTF8($val,'n');
    2522     }
    2523     return $val;
     3654# Encode string with specified encoding
     3655# Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name,
     3656#         3) optional destination byte order (2-byte and 4-byte fixed-width sets only)
     3657# Returns: string in specified encoding
     3658sub Encode($$$;$)
     3659{
     3660    my ($self, $val, $to, $toOrder) = @_;
     3661    return $self->Decode($val, undef, undef, $to, $toOrder);
    25243662}
    25253663
    … …  
    25543692#------------------------------------------------------------------------------
    25553693# Validate an extracted image and repair if necessary
    2556 # Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name
     3694# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key
    25573695# Returns: image reference or undef if it wasn't valid
     3696# Note: should be called from RawConv, not ValueConv
    25583697sub ValidateImage($$$)
    25593698{
    … …  
    25633702            # the first byte of the preview of some Minolta cameras is wrong,
    25643703            # so check for this and set it back to 0xff if necessary
    2565             $$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/ or
     3704            $$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or
    25663705            $self->Options('IgnoreMinorErrors'))
    25673706    {
    25683707        # issue warning only if the tag was specifically requested
    2569         if ($self->{REQ_TAG_LOOKUP}->{lc($tag)}) {
     3708        if ($self->{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) {
    25703709            $self->Warn("$tag is not a valid JPEG image",1);
    25713710            return undef;
    … …  
    25843723    # start with the tag name and force first letter to be upper case
    25853724    my $desc = ucfirst($tag);
    2586     $desc =~ tr/_/ /;       # translate underlines to spaces
     3725    # translate underlines to spaces
     3726    $desc =~ tr/_/ /;
     3727    # remove hex TagID from name (to avoid inserting spaces in the number)
     3728    $desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID;
    25873729    # put a space between lower/UPPER case and lower/number combinations
    25883730    $desc =~ s/([a-z])([A-Z\d])/$1 $2/g;
    … …  
    25913733    # put spaces after numbers (if more than one character following number)
    25923734    $desc =~ s/(\d)([A-Z]\S)/$1 $2/g;
    2593     # remove space in hex number
    2594     $desc =~ s/ 0x ([\dA-Fa-f])/ 0x$1/g;
     3735    # add TagID to description
    25953736    $desc .= ' ' . $tagID if defined $tagID;
    25963737    return $desc;
    … …  
    26003741# Return printable value
    26013742# Inputs: 0) ExifTool object reference
    2602 #         1) value to print, 2) true for unlimited line length
     3743#         1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited)
    26033744sub Printable($;$)
    26043745{
    2605     my ($self, $outStr, $unlimited) = @_;
     3746    my ($self, $outStr, $maxLen) = @_;
    26063747    return '(undef)' unless defined $outStr;
    26073748    $outStr =~ tr/\x01-\x1f\x7f-\xff/./;
    26083749    $outStr =~ s/\x00//g;
    2609     # limit length if verbose < 4
    2610     if (length($outStr) > 60 and not $unlimited and $self->{OPTIONS}->{Verbose} < 4) {
    2611         $outStr = substr($outStr,0,54) . '[snip]';
     3750    if (defined $maxLen) {
     3751        # minimum length is 20 (0 is unlimited)
     3752        $maxLen = 20 if $maxLen and $maxLen < 20;
     3753    } 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]';
    26123759    }
    26133760    return $outStr;
    … …  
    26213768{
    26223769    my ($self, $date) = @_;
    2623     my $dateFormat = $self->{OPTIONS}->{DateFormat};
     3770    my $dateFormat = $self->{OPTIONS}{DateFormat};
    26243771    # only convert date if a format was specified and the date is recognizable
    26253772    if ($dateFormat) {
    2626         if ($date =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/ and eval 'require POSIX') {
    2627             $date = POSIX::strftime($dateFormat, $6, $5, $4, $3, $2-1, $1-1900);
    2628         } elsif ($self->{OPTIONS}->{StrictDate}) {
     3773        # a few cameras use incorrect date/time formatting:
     3774        # - slashes instead of colons in date (RolleiD330, ImpressCam)
     3775        # - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar)
     3776        # - 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}) {
    26293783            undef $date;
    26303784        }
    … …  
    26343788
    26353789#------------------------------------------------------------------------------
     3790# Print conversion for time span value
     3791# Inputs: 0) time ticks, 1) number of seconds per tick (default 1)
     3792# Returns: readable time
     3793sub ConvertTimeSpan($;$)
     3794{
     3795    my ($val, $mult) = @_;
     3796    if (Image::ExifTool::IsFloat($val) and $val != 0) {
     3797        $val *= $mult if $mult;
     3798        if ($val < 60) {
     3799            $val = "$val seconds";
     3800        } elsif ($val < 3600) {
     3801            my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f';
     3802            my $s = ($val == 60 and $mult) ? '' : 's';
     3803            $val = sprintf("$fmt minute$s", $val / 60);
     3804        } elsif ($val < 24 * 3600) {
     3805            $val = sprintf("%.1f hours", $val / 3600);
     3806        } else {
     3807            $val = sprintf("%.1f days", $val / (24 * 3600));
     3808        }
     3809    }
     3810    return $val;
     3811}
     3812
     3813#------------------------------------------------------------------------------
     3814# Patched timelocal() that fixes ActivePerl timezone bug
     3815# Inputs/Returns: same as timelocal()
     3816# Notes: must 'require Time::Local' before calling this routine
     3817sub TimeLocal(@)
     3818{
     3819    my $tm = Time::Local::timelocal(@_);
     3820    if ($^O eq 'MSWin32') {
     3821        # patch for ActivePerl timezone bug
     3822        my @t2 = localtime($tm);
     3823        my $t2 = Time::Local::timelocal(@t2);
     3824        # adjust timelocal() return value to be consistent with localtime()
     3825        $tm += $tm - $t2;
     3826    }
     3827    return $tm;
     3828}
     3829
     3830#------------------------------------------------------------------------------
     3831# Get time zone in minutes
     3832# Inputs: 0) localtime array ref, 1) gmtime array ref
     3833# Returns: time zone offset in minutes
     3834sub GetTimeZone(;$$)
     3835{
     3836    my ($tm, $gm) = @_;
     3837    # compute the number of minutes between localtime and gmtime
     3838    my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]);
     3839    if ($$tm[3] != $$gm[3]) {
     3840        # account for case where one date wraps to the first of the next month
     3841        $$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1;
     3842        # adjust for the +/- one day difference
     3843        $min += ($$tm[3] - $$gm[3]) * 24 * 60;
     3844    }
     3845    return $min;
     3846}
     3847
     3848#------------------------------------------------------------------------------
     3849# Get time zone string
     3850# Inputs: 0) time zone offset in minutes
     3851#     or  0) localtime array ref, 1) corresponding time value
     3852# Returns: time zone string ("+/-HH:MM")
     3853sub TimeZoneString($;$)
     3854{
     3855    my $min = shift;
     3856    if (ref $min) {
     3857        my @gm = gmtime(shift);
     3858        $min = GetTimeZone($min, \@gm);
     3859    }
     3860    my $sign = '+';
     3861    $min < 0 and $sign = '-', $min = -$min;
     3862    my $h = int($min / 60);
     3863    return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60);
     3864}
     3865
     3866#------------------------------------------------------------------------------
    26363867# Convert Unix time to EXIF date/time string
    2637 # Inputs: 0) Unix time value, 1) non-zero to use local instead of GMT time
    2638 # Returns: EXIF date/time string
     3868# Inputs: 0) Unix time value, 1) non-zero to convert to local time
     3869# Returns: EXIF date/time string (with timezone for local times)
     3870# Notes: fractional seconds are ignored
    26393871sub ConvertUnixTime($;$)
    26403872{
    2641     my $time = shift;
     3873    my ($time, $toLocal) = @_;
    26423874    return '0000:00:00 00:00:00' if $time == 0;
    2643     my @tm = shift() ? localtime($time) : gmtime($time);
    2644     return sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d", $tm[5]+1900, $tm[4]+1,
    2645                    $tm[3], $tm[2], $tm[1], $tm[0]);
    2646 }
    2647 
    2648 #------------------------------------------------------------------------------
    2649 # Get Unix time from EXIF-formatted date/time string
    2650 # Inputs: 0) EXIF date/time string, 1) non-zero to use local instead of GMT time
    2651 # Returns: Unix time or undefined on error
     3875    my (@tm, $tz);
     3876    if ($toLocal) {
     3877        @tm = localtime($time);
     3878        $tz = TimeZoneString(\@tm, $time);
     3879    } else {
     3880        @tm = gmtime($time);
     3881        $tz = '';
     3882    }
     3883    my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d%s",
     3884                      $tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz);
     3885    return $str;
     3886}
     3887
     3888#------------------------------------------------------------------------------
     3889# 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
     3891# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error
    26523892sub GetUnixTime($;$)
    26533893{
    2654     my $timeStr = shift;
     3894    my ($timeStr, $isLocal) = @_;
    26553895    return 0 if $timeStr eq '0000:00:00 00:00:00';
    26563896    my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)/);
    2657     return undef unless @tm == 6;
    2658     return undef unless eval 'require Time::Local';
     3897    return undef unless @tm == 6 and eval 'require Time::Local';
     3898    my $tzsec = 0;
     3899    # use specified timezone offset (if given) instead of local system time
     3900    # 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    }
    26593906    $tm[0] -= 1900;     # convert year
    26603907    $tm[1] -= 1;        # convert month
    26613908    @tm = reverse @tm;  # change to order required by timelocal()
    2662     return shift() ? Time::Local::timelocal(@tm) : Time::Local::timegm(@tm);
     3909    return $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzsec;
     3910}
     3911
     3912#------------------------------------------------------------------------------
     3913# Print conversion for file size
     3914# Inputs: 0) file size in bytes
     3915# Returns: converted file size
     3916sub ConvertFileSize($)
     3917{
     3918    my $val = shift;
     3919    $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);
     3924}
     3925
     3926#------------------------------------------------------------------------------
     3927# Convert seconds to duration string (handles negative durations)
     3928# Inputs: 0) floating point seconds
     3929# Returns: duration string in form "S.SS s", "MM:SS" or "H:MM:SS"
     3930sub ConvertDuration($)
     3931{
     3932    my $time = shift;
     3933    return $time unless IsFloat($time);
     3934    return '0 s' if $time == 0;
     3935    my $sign = ($time > 0 ? '' : (($time = -$time), '-'));
     3936    return sprintf("$sign%.2f s", $time) if $time < 30;
     3937    my $h = int($time / 3600);
     3938    $time -= $h * 3600;
     3939    my $m = int($time / 60);
     3940    $time -= $m * 60;
     3941    return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time));
     3942}
     3943
     3944#------------------------------------------------------------------------------
     3945# Print conversion for bitrate values
     3946# Inputs: 0) bitrate in bits per second
     3947# Returns: human-readable bitrate string
     3948# Notes: returns input value without formatting if it isn't numerical
     3949sub ConvertBitrate($)
     3950{
     3951    my $bitrate = shift;
     3952    IsFloat($bitrate) or return $bitrate;
     3953    my @units = ('bps', 'kbps', 'Mbps', 'Gbps');
     3954    for (;;) {
     3955        my $units = shift @units;
     3956        $bitrate >= 1000 and @units and $bitrate /= 1000, next;
     3957        my $fmt = $bitrate < 100 ? '%.3g' : '%.0f';
     3958        return sprintf("$fmt $units", $bitrate);
     3959    }
    26633960}
    26643961
    … …  
    26673964# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size
    26683965#         3) comment string, 4) tool tip (or SAME), 5) flags
    2669 sub HtmlDump($$$$;$$)
     3966sub HDump($$$$;$$)
    26703967{
    26713968    my $self = shift;
    … …  
    27524049
    27534050#------------------------------------------------------------------------------
     4051# Read/rewrite trailer information (including multiple trailers)
     4052# Inputs: 0) ExifTool object ref, 1) DirInfo ref:
     4053# - requires RAF and DirName
     4054# - OutFile is a scalar reference for writing
     4055# - scans from current file position if ScanForAFCP is set
     4056# Returns: 1 if trailer was processed or couldn't be processed (or written OK)
     4057#          0 if trailer was recognized but offsets need fixing (or write error)
     4058# - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated
     4059# - preserves current file position and byte order
     4060sub ProcessTrailers($$)
     4061{
     4062    my ($self, $dirInfo) = @_;
     4063    my $dirName = $$dirInfo{DirName};
     4064    my $outfile = $$dirInfo{OutFile};
     4065    my $offset = $$dirInfo{Offset} || 0;
     4066    my $fixup = $$dirInfo{Fixup};
     4067    my $raf = $$dirInfo{RAF};
     4068    my $pos = $raf->Tell();
     4069    my $byteOrder = GetByteOrder();
     4070    my $success = 1;
     4071    my $path = $$self{PATH};
     4072
     4073    for (;;) { # loop through all trailers
     4074        require "Image/ExifTool/$dirName.pm";
     4075        my $proc = "Image::ExifTool::${dirName}::Process$dirName";
     4076        my $outBuff;
     4077        if ($outfile) {
     4078            # write to local buffer so we can add trailer in proper order later
     4079            $$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = '';
     4080            # must generate new fixup if necessary so we can shift
     4081            # the old fixup separately after we prepend this trailer
     4082            delete $$dirInfo{Fixup};
     4083        }
     4084        delete $$dirInfo{DirLen};       # reset trailer length
     4085        $$dirInfo{Offset} = $offset;    # set offset from end of file
     4086        $$dirInfo{Trailer} = 1;         # set Trailer flag in case proc cares
     4087        # add trailer and DirName to SubDirectory PATH
     4088        push @$path, 'Trailer', $dirName;
     4089
     4090        # 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)
     4093        no strict 'refs';
     4094        my $result = &$proc($self, $dirInfo);
     4095        use strict 'refs';
     4096
     4097        # restore PATH
     4098        pop @$path;
     4099        pop @$path;
     4100        # check result
     4101        if ($outfile) {
     4102            if ($result > 0) {
     4103                if ($outBuff) {
     4104                    # write trailers to OutFile in original order
     4105                    $$outfile = $outBuff . $$outfile;
     4106                    # must adjust old fixup start if it exists
     4107                    $$fixup{Start} += length($outBuff) if $fixup;
     4108                    $outBuff = '';      # free memory
     4109                }
     4110                if ($fixup) {
     4111                    # add new fixup information if any
     4112                    $fixup->AddFixup($$dirInfo{Fixup}) if $$dirInfo{Fixup};
     4113                } else {
     4114                    $fixup = $$dirInfo{Fixup};  # save fixup
     4115                }
     4116            } else {
     4117                $success = 0 if $self->Error("Error rewriting $dirName trailer", 1);
     4118                last;
     4119            }
     4120        } elsif ($result < 0) {
     4121            # can't continue if we must scan for this trailer
     4122            $success = 0;
     4123            last;
     4124        }
     4125        last unless $result > 0 and $$dirInfo{DirLen};
     4126        # look for next trailer
     4127        $offset += $$dirInfo{DirLen};
     4128        my $nextTrail = IdentifyTrailer($raf, $offset) or last;
     4129        $dirName = $$dirInfo{DirName} = $$nextTrail{DirName};
     4130        $raf->Seek($pos, 0);
     4131    }
     4132    SetByteOrder($byteOrder);       # restore original byte order
     4133    $raf->Seek($pos, 0);            # restore original file position
     4134    $$dirInfo{OutFile} = $outfile;  # restore original outfile
     4135    $$dirInfo{Offset} = $offset;    # return offset from EOF to start of first trailer
     4136    $$dirInfo{Fixup} = $fixup;      # return fixup information
     4137    return $success;
     4138}
     4139
     4140#------------------------------------------------------------------------------
    27544141# Extract EXIF information from a jpg image
    27554142# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set
    … …  
    27574144sub ProcessJPEG($$)
    27584145{
     4146    local $_;
    27594147    my ($self, $dirInfo) = @_;
    2760     my ($ch,$s,$length);
    2761     my $verbose = $self->{OPTIONS}->{Verbose};
    2762     my $out = $self->{OPTIONS}->{TextOut};
     4148    my ($ch, $s, $length);
     4149    my $verbose = $self->{OPTIONS}{Verbose};
     4150    my $out = $self->{OPTIONS}{TextOut};
     4151    my $fast = $self->{OPTIONS}{FastScan};
    27634152    my $raf = $$dirInfo{RAF};
    27644153    my $htmlDump = $self->{HTML_DUMP};
    27654154    my %dumpParms = ( Out => $out );
    2766     my ($success, $icc_profile, $wantPreview, $trailInfo);
     4155    my ($success, $icc_profile, $wantTrailer, $trailInfo, %extendedXMP);
     4156    my ($preview, $scalado, @dqt, $subSampling, $dumpEnd);
    27674157
    27684158    # check to be sure this is a valid JPG file
    27694159    return 0 unless $raf->Read($s, 2) == 2 and $s eq "\xff\xd8";
    27704160    $dumpParms{MaxLen} = 128 if $verbose < 4;
    2771     $self->SetFileType();   # set FileType tag
     4161    unless ($self->{VALUE}{FileType}) {
     4162        $self->SetFileType();               # set FileType tag
     4163        $$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags
     4164    }
    27724165    if ($htmlDump) {
    2773         my $pos = $raf->Tell() - 2;
    2774         $self->HtmlDump(0, $pos, '[unknown header]') if $pos;
    2775         $self->HtmlDump($pos, 2, 'JPEG header', 'SOI Marker');
    2776     }
     4166        $dumpEnd = $raf->Tell();
     4167        my $pos = $dumpEnd - 2;
     4168        $self->HDump(0, $pos, '[unknown header]') if $pos;
     4169        $self->HDump($pos, 2, 'JPEG header', 'SOI Marker');
     4170    }
     4171    my $path = $$self{PATH};
     4172    my $pn = scalar @$path;
    27774173
    27784174    # set input record separator to 0xff (the JPEG marker) to make reading quicker
    2779     my $oldsep = $/;
    2780     $/ = "\xff";
    2781 
    2782     my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $dumpEnd);
     4175    local $/ = "\xff";
     4176
     4177    my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData);
    27834178
    27844179    # read file until we reach an end of image (EOI) or start of scan (SOS)
    … …  
    27934188# read ahead to the next segment unless we have reached EOI or SOS
    27944189#
    2795         unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantPreview))) {
     4190        unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer))) {
    27964191            # read up to next marker (JPEG markers begin with 0xff)
    27974192            my $buff;
    … …  
    28214216        }
    28224217        # set some useful variables for the current segment
    2823         my $hdr = "\xff" . chr($marker);    # header for this segment
    28244218        my $markerName = JpegMarkerName($marker);
     4219        $$path[$pn] = $markerName;
    28254220#
    28264221# parse the current segment
    … …  
    28454240            my ($i, $hmin, $hmax, $vmin, $vmax);
    28464241            # loop through all components to determine sampling frequency
     4242            $subSampling = '';
    28474243            for ($i=0; $i<$n; ++$i) {
    28484244                my $sf = Get8u($segDataPt, 7 + 3 * $i);
     4245                $subSampling .= sprintf('%.2x', $sf);
    28494246                # isolate horizontal and vertical components
    28504247                my ($hf, $vf) = ($sf >> 4, $sf & 0x0f);
    … …  
    28664263            next;
    28674264        } elsif ($marker == 0xd9) {         # EOI
     4265            pop @$path;
    28684266            $verbose and print $out "JPEG EOI\n";
    28694267            my $pos = $raf->Tell();
    28704268            if ($htmlDump and $dumpEnd) {
    2871                 $self->HtmlDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08);
    2872                 $self->HtmlDump($pos-2, 2, 'JPEG EOI', undef);
     4269                $self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08);
     4270                $self->HDump($pos-2, 2, 'JPEG EOI', undef);
    28734271                $dumpEnd = 0;
    28744272            }
    28754273            $success = 1;
    28764274            # we are here because we are looking for trailer information
    2877             if ($wantPreview and $self->{VALUE}->{PreviewImageStart}) {
    2878                 my $buff;
    2879                 # most previews start right after the JPEG EOI, but the Olympus E-20
    2880                 # preview is 508 bytes into the trailer, and the K-M Maxxum 7D preview
    2881                 # is 979 bytes in, but Minolta previews can have a random first byte...
    2882                 if ($raf->Read($buff, 1024) and ($buff =~ /\xff\xd8\xff./g or
    2883                     ($self->{CameraMake} =~ /Minolta/i and $buff =~ /.\xd8\xff\xdb/g)))
    2884                 {
    2885                     # adjust PreviewImageStart to this location
    2886                     my $start = $self->{VALUE}->{PreviewImageStart};
    2887                     my $actual = $pos + pos($buff) - 4;
    2888                     if ($start ne $actual and $verbose > 1) {
    2889                         print $out "(Fixed PreviewImage location: $start -> $actual)\n";
     4275            if ($wantTrailer) {
     4276                my $start = $$self{PreviewImageStart};
     4277                if ($start) {
     4278                    my $buff;
     4279                    # most previews start right after the JPEG EOI, but the Olympus E-20
     4280                    # preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is
     4281                    # 979 bytes in, and Sony previews can start up to 32 kB into the trailer.
     4282                    # (and Minolta and Sony previews can have a random first byte...)
     4283                    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};
     4300                            }
     4301                        }
    28904302                    }
    2891                     $self->{VALUE}->{PreviewImageStart} = $actual;
     4303                    $raf->Seek($pos, 0);
    28924304                }
    2893                 $raf->Seek($pos, 0);
    28944305            }
    28954306            # process trailer now or finish processing trailers
    … …  
    29034314                undef $trailInfo;
    29044315            }
     4316            if ($$self{LeicaTrailer}) {
     4317                $raf->Seek(0, 2);
     4318                $$self{LeicaTrailer}{TrailPos} = $pos;
     4319                $$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd;
     4320                Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
     4321            }
    29054322            # finally, dump remaining information in JPEG trailer
    29064323            if ($verbose or $htmlDump) {
    2907                 $raf->Seek(0, 2);
    2908                 my $endPos = $raf->Tell() - $fromEnd;
     4324                my $endPos = $$self{LeicaTrailerPos};
     4325                unless ($endPos) {
     4326                    $raf->Seek(0, 2);
     4327                    $endPos = $raf->Tell() - $fromEnd;
     4328                }
    29094329                $self->DumpUnknownTrailer({
    29104330                    RAF => $raf,
    … …  
    29154335            last;       # all done parsing file
    29164336        } elsif ($marker == 0xda) {         # SOS
     4337            pop @$path;
    29174338            # all done with meta information unless we have a trailer
    29184339            $verbose and print $out "JPEG SOS\n";
    2919             unless ($self->Options('FastScan')) {
     4340            unless ($fast) {
    29204341                $trailInfo = IdentifyTrailer($raf);
    29214342                # process trailer now unless we are doing verbose dump
    … …  
    29254346                    $self->ProcessTrailers($trailInfo) and undef $trailInfo;
    29264347                }
    2927                 if ($wantPreview) {
     4348                if ($wantTrailer) {
    29284349                    # seek ahead and validate preview image
    29294350                    my $buff;
    29304351                    my $curPos = $raf->Tell();
    2931                     if ($raf->Seek($self->GetValue('PreviewImageStart'), 0) and
     4352                    if ($raf->Seek($$self{PreviewImageStart}, 0) and
    29324353                        $raf->Read($buff, 4) == 4 and
    29334354                        $buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/)
    29344355                    {
    2935                         undef $wantPreview;
     4356                        undef $wantTrailer;
    29364357                    }
    29374358                    $raf->Seek($curPos, 0) or last;
    29384359                }
    2939                 next if $trailInfo or $wantPreview or $verbose > 2 or $htmlDump;
     4360                # seek ahead and process Leica trailer
     4361                if ($$self{LeicaTrailer}) {
     4362                    require Image::ExifTool::Panasonic;
     4363                    Image::ExifTool::Panasonic::ProcessLeicaTrailer($self);
     4364                    $wantTrailer = 1 if $$self{LeicaTrailer};
     4365                }
     4366                next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump;
    29404367            }
    29414368            # nothing interesting to parse after start of scan (SOS)
    … …  
    29464373            $verbose and $marker and print $out "JPEG $markerName:\n";
    29474374            next;
     4375        } elsif ($marker == 0xdb and length($$segDataPt) and    # DQT
     4376            # save the DQT data only if JPEGDigest has been requested
     4377            $self->{REQ_TAG_LOOKUP}->{jpegdigest})
     4378        {
     4379            my $num = unpack('C',$$segDataPt) & 0x0f;   # get table index
     4380            $dqt[$num] = $$segDataPt if $num < 4;       # save for MD5 calculation
    29484381        }
    29494382        # handle all other markers
    … …  
    29584391            }
    29594392        }
    2960         if ($marker == 0xe0) {              # APP0 (JFIF, CIFF)
     4393        if ($marker == 0xe0) {              # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad)
    29614394            if ($$segDataPt =~ /^JFIF\0/) {
    29624395                $dumpType = 'JFIF';
    … …  
    29764409                $self->FoundTag($tagInfo, substr($$segDataPt, 6));
    29774410            } elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) {
     4411                next if $fast and $fast > 1;    # skip processing for very fast
    29784412                $dumpType = 'CIFF';
    29794413                my %dirInfo = (
    … …  
    29844418                Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo);
    29854419                delete $self->{SET_GROUP1};
    2986             }
    2987         } elsif ($marker == 0xe1) {         # APP1 (EXIF, XMP)
     4420            } elsif ($$segDataPt =~ /^(AVI1|Ocad)/) {
     4421                $dumpType = $1;
     4422                SetByteOrder('MM');
     4423                my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType");
     4424                my %dirInfo = (
     4425                    DataPt   => $segDataPt,
     4426                    DataPos  => $segPos,
     4427                    DirStart => 4,
     4428                    DirLen   => $length - 4,
     4429                );
     4430                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     4431            }
     4432        } elsif ($marker == 0xe1) {         # APP1 (EXIF, XMP, QVCI)
    29884433            if ($$segDataPt =~ /^Exif\0/) { # (some Kodak cameras don't put a second \0)
    29894434                undef $dumpType;    # (will be dumped here)
    … …  
    29994444                );
    30004445                if ($htmlDump) {
    3001                     $self->HtmlDump($segPos-4, 4, 'APP1 header',
    3002                              "Data size: $length bytes");
    3003                     $self->HtmlDump($segPos, $hdrLen, 'Exif header',
    3004                              'APP1 data type: Exif');
     4446                    $self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes");
     4447                    $self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif');
    30054448                    $dumpEnd = $segPos + $length;
    30064449                }
    … …  
    30124455                my $start = $self->GetValue('PreviewImageStart');
    30134456                my $length = $self->GetValue('PreviewImageLength');
     4457                if (not $start or not $length and $$self{PreviewError}) {
     4458                    $start = $$self{PreviewImageStart};
     4459                    $length = $$self{PreviewImageLength};
     4460                }
    30144461                if ($start and $length and
    30154462                    $start + $length > $self->{EXIF_POS} + length($self->{EXIF_DATA}) and
    3016                     $self->{REQ_TAG_LOOKUP}->{previewimage})
     4463                    $self->{REQ_TAG_LOOKUP}{previewimage})
    30174464                {
    3018                     $wantPreview = 1;
     4465                    $$self{PreviewImageStart} = $start;
     4466                    $$self{PreviewImageLength} = $length;
     4467                    $wantTrailer = 1;
    30194468                }
     4469            } elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) {
     4470                # off len -- extended XMP header (75 bytes total):
     4471                #   0  35 bytes - signature
     4472                #  35  32 bytes - GUID (MD5 hash of full extended XMP data in ASCII)
     4473                #  67   4 bytes - total size of extended XMP data
     4474                #  71   4 bytes - offset for this XMP data portion
     4475                $dumpType = 'Extended XMP';
     4476                if (length $$segDataPt > 75) {
     4477                    my ($size, $off) = unpack('x67N2', $$segDataPt);
     4478                    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};
     4502                    }
     4503                } else {
     4504                    $self->Warn('Invalid extended XMP segment');
     4505                }
     4506            } elsif ($$segDataPt =~ /^QVCI\0/) {
     4507                $dumpType = 'QVCI';
     4508                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                );
     4518                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    30204519            } else {
    30214520                # Hmmm.  Could be XMP, let's see
    … …  
    30234522                if ($$segDataPt =~ /^http/ or $$segDataPt =~ /<exif:/) {
    30244523                    $dumpType = 'XMP';
     4524                    # also try to parse XMP with a non-standard header
     4525                    # (note: this non-standard XMP is ignored when writing)
    30254526                    my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0;
    30264527                    my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main');
    … …  
    30354536                    );
    30364537                    $processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     4538                    if ($processed and not $start) {
     4539                        $self->Warn('Non-standard header for APP1 XMP segment');
     4540                    }
    30374541                }
    30384542                if ($verbose and not $processed) {
    … …  
    30404544                }
    30414545            }
    3042         } elsif ($marker == 0xe2) {         # APP2 (ICC Profile, FPXR)
     4546        } elsif ($marker == 0xe2) {         # APP2 (ICC Profile, FPXR, MPF, PreviewImage)
    30434547            if ($$segDataPt =~ /^ICC_PROFILE\0/) {
    30444548                $dumpType = 'ICC_Profile';
    … …  
    30644568                }
    30654569            } elsif ($$segDataPt =~ /^FPXR\0/) {
     4570                next if $fast and $fast > 1;    # skip processing for very fast
    30664571                $dumpType = 'FPXR';
    30674572                my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main');
    … …  
    30774582                );
    30784583                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    3079             }
    3080         } elsif ($marker == 0xe3) {         # APP3 (Kodak "Meta")
     4584            } elsif ($$segDataPt =~ /^MPF\0/) {
     4585                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                );
     4594                if ($htmlDump) {
     4595                    $self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes");
     4596                    $self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF');
     4597                    $dumpEnd = $segPos + $length;
     4598                }
     4599                # extract the MPF information (it is in standard TIFF format)
     4600                my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main');
     4601                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
     4602            } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) {
     4603                $preview = $$segDataPt;
     4604                $dumpType = 'Samsung Preview';
     4605            } elsif ($preview) {
     4606                $preview .= $$segDataPt;
     4607                $dumpType = 'Samsung Preview';
     4608            }
     4609            if ($preview and $nextMarker ne $marker) {
     4610                $self->FoundTag('PreviewImage', $preview);
     4611                undef $preview;
     4612            }
     4613        } elsif ($marker == 0xe3) {         # APP3 (Kodak "Meta", Stim)
    30814614            if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) {
    30824615                undef $dumpType;    # (will be dumped here)
    … …  
    30894622                );
    30904623                if ($htmlDump) {
    3091                     $self->HtmlDump($segPos-4, 10, 'APP3 Meta header');
     4624                    $self->HDump($segPos-4, 10, 'APP3 Meta header');
    30924625                    $dumpEnd = $segPos + $length;
    30934626                }
    30944627                my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta');
    30954628                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
     4629            } elsif ($$segDataPt =~ /^Stim\0/) {
     4630                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                );
     4638                if ($htmlDump) {
     4639                    $self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes");
     4640                    $self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim');
     4641                    $dumpEnd = $segPos + $length;
     4642                }
     4643                # extract the Stim information (it is in standard TIFF format)
     4644                my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main');
     4645                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
     4646            } elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) {
     4647                $preview = $$segDataPt;
     4648                $dumpType = 'Samsung/HP Preview';
     4649            }
     4650            # Samsung continues the preview in APP4
     4651            if ($preview and $nextMarker ne 0xe4) {
     4652                $self->FoundTag('PreviewImage', $preview);
     4653                undef $preview;
     4654            }
     4655        } elsif ($marker == 0xe4) {         # APP4 ("SCALADO", FPXR, PreviewImage)
     4656            if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) {
     4657                $dumpType = 'SCALADO';
     4658                my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt);
     4659                # assume that the segments are in order and just concatinate them
     4660                $scalado = '' unless defined $scalado;
     4661                $scalado .= substr($$segDataPt, 16);
     4662                if ($idx == $num - 1) {
     4663                    if ($len != length $scalado) {
     4664                        $self->Warn('Possibly corrupted APP4 SCALADO data', 1);
     4665                    }
     4666                    my %dirInfo = (
     4667                        Parent => $markerName,
     4668                        DataPt => \$scalado,
     4669                    );
     4670                    my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Scalado');
     4671                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     4672                    undef $scalado;
     4673                }
     4674            } elsif ($$segDataPt =~ /^FPXR\0/) {
     4675                next if $fast and $fast > 1;    # skip processing for very fast
     4676                $dumpType = 'FPXR';
     4677                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                );
     4688                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     4689            } elsif ($preview) {
     4690                # continued Samsung S1060 preview from APP3
     4691                $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                }
    30964697            }
    30974698        } elsif ($marker == 0xe5) {         # APP5 (Ricoh "RMETA")
    … …  
    31084709                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    31094710            }
    3110         } elsif ($marker == 0xe6) {         # APP6 (Toshiba EPPIM)
     4711        } elsif ($marker == 0xe6) {         # APP6 (Toshiba EPPIM, NITF, HP_TDHD)
    31114712            if ($$segDataPt =~ /^EPPIM\0/) {
    31124713                undef $dumpType;    # (will be dumped here)
    … …  
    31194720                );
    31204721                if ($htmlDump) {
    3121                     $self->HtmlDump($segPos-4, 10, 'APP6 EPPIM header');
     4722                    $self->HDump($segPos-4, 10, 'APP6 EPPIM header');
    31224723                    $dumpEnd = $segPos + $length;
    31234724                }
    31244725                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM');
    31254726                $self->ProcessTIFF(\%dirInfo, $tagTablePtr);
     4727            } elsif ($$segDataPt =~ /^NITF\0/) {
     4728                $dumpType = 'NITF';
     4729                SetByteOrder('MM');
     4730                my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF');
     4731                my %dirInfo = (
     4732                    DataPt   => $segDataPt,
     4733                    DataPos  => $segPos,
     4734                    DirStart => 5,
     4735                    DirLen   => $length - 5,
     4736                );
     4737                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     4738            } elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) {
     4739                # HP Photosmart R837 APP6 "TDHD" segment
     4740                $dumpType = 'TDHD';
     4741                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                );
     4748                $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    31264749            }
    31274750        } elsif ($marker == 0xe8) {         # APP8 (SPIFF)
    … …  
    31414764            if ($$segDataPt =~ /^UNICODE\0/) {
    31424765                $dumpType = 'PhotoStudio';
    3143                 my $comment = $self->Unicode2Charset(substr($$segDataPt,8), 'MM');
     4766                my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM');
    31444767                $self->FoundTag('Comment', $comment);
    31454768            }
    … …  
    31654788                $dumpType = 'Photoshop';
    31664789                # add this data to the combined data if it exists
     4790                my $dataPt = $segDataPt;
    31674791                if (defined $combinedSegData) {
    31684792                    $combinedSegData .= substr($$segDataPt,length($psAPP13hdr));
    3169                     $segDataPt = \$combinedSegData;
    3170                     $length = length $combinedSegData;  # update length
     4793                    $dataPt = \$combinedSegData;
    31714794                }
    31724795                # peek ahead to see if the next segment is photoshop data too
    … …  
    31744797                    # initialize combined data if necessary
    31754798                    $combinedSegData = $$segDataPt unless defined $combinedSegData;
    3176                     next;   # will handle the combined data the next time around
     4799                    # (will handle the Photoshop data the next time around)
     4800                } else {
     4801                    my $hdrlen = $isOld ? 27 : 14;
     4802                    # process APP13 Photoshop record
     4803                    my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
     4804                    my %dirInfo = (
     4805                        DataPt   => $dataPt,
     4806                        DataPos  => $segPos,
     4807                        DataLen  => length $$dataPt,
     4808                        DirStart => $hdrlen,    # directory starts after identifier
     4809                        DirLen   => length($$dataPt) - $hdrlen,
     4810                        Parent   => $markerName,
     4811                    );
     4812                    $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
     4813                    undef $combinedSegData;
    31774814                }
    3178                 my $hdrlen = $isOld ? 27 : 14;
    3179                 # process APP13 Photoshop record
    3180                 my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main');
    3181                 my %dirInfo = (
    3182                     DataPt   => $segDataPt,
    3183                     DataPos  => $segPos,
    3184                     DataLen  => $length,
    3185                     DirStart => $hdrlen,    # directory starts after identifier
    3186                     DirLen   => $length - $hdrlen,
    3187                     Parent   => $markerName,
    3188                 );
    3189                 $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    3190                 undef $combinedSegData;
    31914815            } elsif ($$segDataPt =~ /^Adobe_CM/) {
    31924816                $dumpType = 'Adobe_CM';
    … …  
    32224846        } elsif ($marker == 0xfe) {         # COM (JPEG comment)
    32234847            $dumpType = 'Comment';
     4848            $$segDataPt =~ s/\0+$//;    # some dumb softwares add null terminators
    32244849            $self->FoundTag('Comment', $$segDataPt);
    32254850        } elsif (($marker & 0xf0) != 0xe0) {
    … …  
    32274852        }
    32284853        if (defined $dumpType) {
    3229             if (not $dumpType and $self->{OPTIONS}->{Unknown}) {
     4854            if (not $dumpType and $self->{OPTIONS}{Unknown}) {
    32304855                $self->Warn("Unknown $markerName segment", 1);
    32314856            }
    32324857            if ($htmlDump) {
    32334858                my $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment';
    3234                 $self->HtmlDump($segPos-4, $length+4, $desc, undef, 0x08);
     4859                $self->HDump($segPos-4, $length+4, $desc, undef, 0x08);
    32354860                $dumpEnd = $segPos + $length;
    32364861            }
    … …  
    32384863        undef $$segDataPt;
    32394864    }
    3240     $/ = $oldsep;     # restore separator to original value
     4865    # calculate JPEGDigest if requested
     4866    if (@dqt and $subSampling) {
     4867        require Image::ExifTool::JPEGDigest;
     4868        Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling);
     4869    }
     4870    $self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError};
     4871    $self->Warn('Invalid extended XMP') if %extendedXMP;
    32414872    $success or $self->Warn('JPEG format error');
     4873    pop @$path if @$path > $pn;
    32424874    return 1;
    32434875}
    32444876
    32454877#------------------------------------------------------------------------------
    3246 # Process TIFF data
    3247 # Inputs: 0) ExifTool object reference, 1) directory information reference
    3248 #         2) optional tag table reference
     4878# Process EXIF file
     4879# Inputs/Returns: same as ProcessTIFF
     4880sub ProcessEXIF($$;$)
     4881{
     4882    my ($self, $dirInfo, $tagTablePtr) = @_;
     4883    return $self->ProcessTIFF($dirInfo, $tagTablePtr);
     4884}
     4885
     4886#------------------------------------------------------------------------------
     4887# Process TIFF data (wrapper for DoProcessTIFF to allow re-entry)
     4888# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
    32494889# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
    32504890sub ProcessTIFF($$;$)
     4891{
     4892    my ($self, $dirInfo, $tagTablePtr) = @_;
     4893    my $exifData = $$self{EXIF_DATA};
     4894    my $exifPos = $$self{EXIF_POS};
     4895    my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr);
     4896    # restore original EXIF information (in case ProcessTIFF is nested)
     4897    if (defined $exifData) {
     4898        $$self{EXIF_DATA} = $exifData;
     4899        $$self{EXIF_POS} = $exifPos;
     4900    }
     4901    return $rtnVal;
     4902}
     4903
     4904#------------------------------------------------------------------------------
     4905# Process TIFF data
     4906# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
     4907# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error
     4908sub DoProcessTIFF($$;$)
    32514909{
    32524910    my ($self, $dirInfo, $tagTablePtr) = @_;
    … …  
    32564914    my $base = $$dirInfo{Base} || 0;
    32574915    my $outfile = $$dirInfo{OutFile};
    3258     my ($length, $err, $canonSig);
    3259 
    3260     # read the image file header and offset to 0th IFD if necessary
     4916    my ($err, $canonSig, $otherSig);
     4917
     4918    # attempt to read TIFF header
     4919    $self->{EXIF_DATA} = '';
    32614920    if ($raf) {
    32624921        if ($outfile) {
    … …  
    32694928            $raf->Seek($base, 0) or return 0;
    32704929        }
    3271         $raf->Read($self->{EXIF_DATA}, 8) == 8 or return 0;
    3272     } elsif ($dataPt) {
     4930        # extract full EXIF block (for block copy) from EXIF file
     4931        my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8;
     4932        my $n = $raf->Read($self->{EXIF_DATA}, $amount);
     4933        if ($n < 8) {
     4934            return 0 if $n or not $outfile or $fileType ne 'EXIF';
     4935            # create EXIF file from scratch
     4936            delete $self->{EXIF_DATA};
     4937            undef $raf;
     4938        }
     4939        if ($n > 8) {
     4940            $raf->Seek(8, 0);
     4941            if ($n == $amount) {
     4942                $self->{EXIF_DATA} = substr($self->{EXIF_DATA}, 0, 8);
     4943                $self->Warn('EXIF too large to extract as a block'); #(shouldn't happen)
     4944            }
     4945        }
     4946    } elsif ($dataPt and length $$dataPt) {
    32734947        # save a copy of the EXIF data
    32744948        my $dirStart = $$dirInfo{DirStart} || 0;
    3275         $self->{EXIF_DATA} = substr(${$$dirInfo{DataPt}}, $dirStart);
     4949        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;
    32764952    } elsif ($outfile) {
    3277         # create TIFF information from scratch
    3278         $self->{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
     4953        delete $self->{EXIF_DATA};  # create from scratch
    32794954    } else {
    32804955        $self->{EXIF_DATA} = '';
    32814956    }
     4957    unless (defined $self->{EXIF_DATA}) {
     4958        # create TIFF information from scratch
     4959        if ($self->SetPreferredByteOrder() eq 'MM') {
     4960            $self->{EXIF_DATA} = "MM\0\x2a\0\0\0\x08";
     4961        } else {
     4962            $self->{EXIF_DATA} = "II\x2a\0\x08\0\0\0";
     4963        }
     4964    }
    32824965    $$self{FIRST_EXIF_POS} = $base + $$self{BASE} unless defined $$self{FIRST_EXIF_POS};
    3283     $$self{EXIF_POS} = $base;
     4966    $$self{EXIF_POS} = $base + $$self{BASE};
    32844967    $dataPt = \$self->{EXIF_DATA};
    32854968
    32864969    # set byte ordering
    3287     SetByteOrder(substr($$dataPt,0,2)) or return 0;
    3288     # save EXIF byte ordering
    3289     $self->{EXIF_BYTE_ORDER} = GetByteOrder();
     4970    my $byteOrder = substr($$dataPt,0,2);
     4971    SetByteOrder($byteOrder) or return 0;
    32904972
    32914973    # verify the byte ordering
    32924974    my $identifier = Get16u($dataPt, 2);
    32934975    # identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF)
    3294   # no longer do this because ORF files use different values
     4976  # no longer do this because various files use different values
     4977  # (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????)
    32954978  #  return 0 unless $identifier == 0x2a;
    32964979
    … …  
    33054988            $raf->Read($canonSig, 8) == 8 or return 0;
    33064989            $$dataPt .= $canonSig;
    3307             if ($canonSig =~ /^CR\x02\0/) {
    3308                 $fileType = 'CR2';
    3309                 $self->HtmlDump($base+8, 8, '[CR2 header]') if $self->{HTML_DUMP};
     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};
    33104993            } else {
    33114994                undef $canonSig;
    33124995            }
    3313         } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|TIFF)$/) {
    3314             $fileType = 'RAW';  # Panasonic RAW file
    3315             $tagTablePtr = GetTagTable('Image::ExifTool::Panasonic::Raw');
     4996        } elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) {
     4997            # panasonic RAW, RW2 or RWL file
     4998            my $magic;
     4999            # test for RW2/RWL magic number
     5000            if ($offset >= 0x18 and $raf->Read($magic, 16) and
     5001                $magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a")
     5002            {
     5003                $fileType = 'RW2' unless $fileType eq 'RWL';
     5004                $self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP};
     5005                $otherSig = $magic; # save signature for writing
     5006            } else {
     5007                $fileType = 'RAW';
     5008            }
     5009            $tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main');
    33165010        } elsif ($identifier == 0x2b and $fileType eq 'TIFF') {
    33175011            # this looks like a BigTIFF image
    … …  
    33195013            require Image::ExifTool::BigTIFF;
    33205014            return 1 if Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo);
    3321         } elsif (Get8u($dataPt, 2) == 0xbc and $fileType eq 'TIFF') {
    3322             $fileType = 'WDP';  # Windows Media Photo file
     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';
    33235025        }
    33245026        # we have a valid TIFF (or whatever) file
    3325         if ($fileType and not $self->{VALUE}->{FileType}) {
    3326             $self->SetFileType($fileType);
    3327         }
    3328     }
    3329     $self->FoundTag('ExifByteOrder', GetByteOrder());
     5027        if ($fileType and not $self->{VALUE}{FileType}) {
     5028            my $lookup = $fileTypeLookup{$fileType};
     5029            $lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup;
     5030            # 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;
     5032            $self->SetFileType($t);
     5033        }
     5034    }
     5035    my $ifdName = 'IFD0';
     5036    if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') {
     5037        $self->FoundTag('ExifByteOrder', $byteOrder);
     5038    } else {
     5039        $ifdName = $$tagTablePtr{GROUPS}{1};
     5040    }
    33305041    if ($self->{HTML_DUMP}) {
    3331         my $o = (GetByteOrder() eq 'II') ? 'Little' : 'Big';
    3332         $self->HtmlDump($base, 4, "TIFF header", "Byte order: $o endian", 0);
    3333         $self->HtmlDump($base+4, 4, "IFD0 pointer", sprintf("Offset: 0x%.4x",$offset), 0);
     5042        my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x",
     5043                          ($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset);
     5044        $self->HDump($base, 8, 'TIFF header', $tip, 0);
    33345045    }
    33355046    # remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...)
    … …  
    33465057        DataPos  => 0,
    33475058        DirStart => $offset,
    3348         DirLen   => length $$dataPt,
     5059        DirLen   => length($$dataPt) - $offset,
    33495060        RAF      => $raf,
    3350         DirName  => 'IFD0',
     5061        DirName  => $ifdName,
    33515062        Parent   => $fileType,
    3352         ImageData=> 1, # set flag to get information to copy image data later
     5063        ImageData=> 'Main', # set flag to get information to copy main image data later
     5064        Multi    => $$dirInfo{Multi},
    33535065    );
    33545066
    … …  
    33585070        $self->ProcessDirectory(\%dirInfo, $tagTablePtr);
    33595071        # process GeoTiff information if available
    3360         if ($self->{VALUE}->{GeoTiffDirectory}) {
     5072        if ($self->{VALUE}{GeoTiffDirectory}) {
    33615073            require Image::ExifTool::GeoTiff;
    33625074            Image::ExifTool::GeoTiff::ProcessGeoTiff($self);
    … …  
    33695081                $self->ProcessTrailers($trailInfo);
    33705082            }
     5083            # dump any other known trailer (ie. A100 RAW Data)
     5084            if ($$self{HTML_DUMP} and $$self{KnownTrailer}) {
     5085                my $known = $$self{KnownTrailer};
     5086                $raf->Seek(0, 2);
     5087                my $len = $raf->Tell() - $$known{Start};
     5088                $len -= $$trailInfo{Offset} if $trailInfo;  # account for other trailers
     5089                $self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0;
     5090           }
     5091        }
     5092        # update FileType if necessary now that we know more about the file
     5093        if ($$self{DNGVersion} and $self->{VALUE}{FileType} ne 'DNG') {
     5094            # override whatever FileType we set since we now know it is DNG
     5095            $self->OverrideFileType('DNG');
    33715096        }
    33725097        return 1;
    … …  
    33885113        Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1;
    33895114    } else {
    3390         # write TIFF header (8 bytes to be immediately followed by IFD)
    3391         $dirInfo{NewDataPos} = 8;
     5115        # write TIFF header (8 bytes [plus optional signature] followed by IFD)
     5116        $otherSig = '' unless defined $otherSig;
     5117        my $offset = 8 + length($otherSig);
     5118        # construct tiff header
     5119        my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig;
     5120        $dirInfo{NewDataPos} = $offset;
     5121        $dirInfo{HeaderPtr} = \$header;
    33925122        # preserve padding between image data blocks in ORF images
    33935123        # (otherwise dcraw has problems because it assumes fixed block spacing)
    … …  
    33975127            $err = 1;
    33985128        } elsif (length($newData)) {
    3399             my $offset = 8;
    3400             my $header = substr($$dataPt, 0, 4) . Set32u($offset);
    3401             Write($outfile, $header, $newData) or $err = 1;
     5129            # update header length in case more was added
     5130            my $hdrLen = length $header;
     5131            if ($hdrLen != 8) {
     5132                Set32u($hdrLen, \$header, 4);
     5133                # also update preview fixup if necessary
     5134                my $pi = $$self{PREVIEW_INFO};
     5135                $$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup};
     5136            }
     5137            if ($$self{TIFF_TYPE} eq 'ARW' and not $err) {
     5138                # write any required ARW trailer and patch other ARW quirks
     5139                require Image::ExifTool::Sony;
     5140                my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData,
     5141                                                              $dirInfo{ImageData});
     5142                $errStr and $self->Error($errStr);
     5143                delete $dirInfo{ImageData}; # (was copied by FinishARW)
     5144            } else {
     5145                Write($outfile, $header, $newData) or $err = 1;
     5146            }
    34025147            undef $newData; # free memory
    34035148        }
    … …  
    34085153        }
    34095154    }
     5155    # 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};
     5158
    34105159    # rewrite trailers if they exist
    3411     if ($raf and $self->{TIFF_END} and not $err) {
     5160    if ($raf and $tiffEnd and not $err) {
    34125161        my ($buf, $trailInfo);
    34135162        $raf->Seek(0, 2) or $err = 1;
    3414         my $extra = $raf->Tell() - $self->{TIFF_END};
     5163        my $extra = $raf->Tell() - $tiffEnd;
    34155164        # check for trailer and process if possible
    34165165        for (;;) {
    34175166            last unless $extra > 12;
    3418             $raf->Seek($self->{TIFF_END});  # seek back to end of image
     5167            $raf->Seek($tiffEnd);  # seek back to end of image
    34195168            $trailInfo = IdentifyTrailer($raf);
    34205169            last unless $trailInfo;
    … …  
    34295178            }
    34305179            # calculate unused bytes before trailer
    3431             $extra = $$trailInfo{DataPos} - $self->{TIFF_END};
     5180            $extra = $$trailInfo{DataPos} - $tiffEnd;
    34325181            last; # yes, the 'for' loop was just a cheap 'goto'
    34335182        }
    34345183        # ignore a single zero byte if used for padding
    3435         # (note that Photoshop CS adds a trailer with 2 zero bytes
    3436         #  for some reason, and these will be preserved)
    3437         if ($extra > 0 and $self->{TIFF_END} & 0x01) {
    3438             $raf->Seek($self->{TIFF_END}, 0) or $err = 1;
     5184        if ($extra > 0 and $tiffEnd & 0x01) {
     5185            $raf->Seek($tiffEnd, 0) or $err = 1;
    34395186            $raf->Read($buf, 1) or $err = 1;
    3440             $buf eq "\0" and --$extra, ++$self->{TIFF_END};
     5187            defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd;
    34415188        }
    34425189        if ($extra > 0) {
    3443             if ($self->{DEL_GROUP}->{Trailer}) {
     5190            my $known = $$self{KnownTrailer};
     5191            if ($self->{DEL_GROUP}{Trailer} and not $known) {
    34445192                $self->VPrint(0, "  Deleting unknown trailer ($extra bytes)\n");
    34455193                ++$self->{CHANGED};
     5194            } elsif ($known) {
     5195                $self->VPrint(0, "  Copying $$known{Name} ($extra bytes)\n");
     5196                $raf->Seek($tiffEnd, 0) or $err = 1;
     5197                CopyBlock($raf, $outfile, $extra) or $err = 1;
    34465198            } else {
    3447                 $self->VPrint(0, "  Preserving unknown trailer ($extra bytes)\n");
    3448                 $raf->Seek($self->{TIFF_END}, 0) or $err = 1;
    3449                 while ($extra) {
    3450                     my $n = $extra < 65536 ? $extra : 65536;
     5199                $raf->Seek($tiffEnd, 0) or $err = 1;
     5200                # preserve unknown trailer only if it contains non-null data
     5201                # (Photoshop CS adds a trailer with 2 null bytes)
     5202                my $size = $extra;
     5203                for (;;) {
     5204                    my $n = $size > 65536 ? 65536 : $size;
    34515205                    $raf->Read($buf, $n) == $n or $err = 1, last;
    3452                     Write($outfile, $buf) or $err = 1, last;
    3453                     $extra -= $n;
     5206                    if ($buf =~ /[^\0]/) {
     5207                        $self->VPrint(0, "  Preserving unknown trailer ($extra bytes)\n");
     5208                        # copy the trailer since it contains non-null data
     5209                        Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra;
     5210                        Write($outfile, $buf) or $err = 1, last;
     5211                        CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n;
     5212                        last;
     5213                    }
     5214                    $size -= $n;
     5215                    next if $size > 0;
     5216                    $self->VPrint(0, "  Deleting blank trailer ($extra bytes)\n");
     5217                    last;
    34545218                }
    34555219            }
    … …  
    34615225        Write($outfile, $$trailPt) or $err = 1 if $trailPt;
    34625226    }
    3463     delete $self->{TIFF_END};
     5227    # check DNG version
     5228    if ($$self{DNGVersion}) {
     5229        my $ver = $$self{DNGVersion};
     5230        # currently support up to DNG version 1.2
     5231        unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.3) {
     5232            $ver =~ tr/ /./;
     5233            $self->Error("DNG Version $ver not yet supported", 1);
     5234        }
     5235    }
    34645236    return $err ? -1 : 1;
    34655237}
    … …  
    34955267{
    34965268    my $tableName = shift or return undef;
    3497 
    34985269    my $table = $allTables{$tableName};
    34995270
    … …  
    35045275            if ($tableName =~ /(.*)::/) {
    35055276                my $module = $1;
    3506                 unless (eval "require $module") {
     5277                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';
     5281                    }
     5282                } else {
    35075283                    $@ and warn $@;
    35085284                }
    … …  
    35165292        $table = \%$tableName;
    35175293        use strict 'refs';
     5294        $$table{TABLE_NAME} = $tableName;   # set table name
     5295        ($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://;
    35185296        # set default group 0 and 1 from module name unless already specified
    35195297        my $defaultGroups = $$table{GROUPS};
    … …  
    35295307        }
    35305308        $$defaultGroups{2} = 'Other' unless $$defaultGroups{2};
     5309        if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) {
     5310            # initialize some XMP table defaults
     5311            require Image::ExifTool::XMP;
     5312            Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces
     5313            # set default write/check procs
     5314            $$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC};
     5315            $$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC};
     5316            $$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO};
     5317        }
    35315318        # generate a tag prefix for unknown tags if necessary
    35325319        unless ($$table{TAG_PREFIX}) {
    … …  
    35455332            my $tagID;
    35465333            foreach $tagID (TagTableKeys($UserDefined{$tableName})) {
    3547                 my $tagInfo = $UserDefined{$tableName}->{$tagID};
     5334                my $tagInfo = $UserDefined{$tableName}{$tagID};
    35485335                if (ref $tagInfo eq 'HASH') {
    35495336                    $$tagInfo{Name} or $$tagInfo{Name} = ucfirst($tagID);
    … …  
    35605347            }
    35615348        }
    3562         # generate tag ID's if necessary
    3563         GenerateTagIDs($table) if $didTagID;
    35645349        # remember order we loaded the tables in
    35655350        push @tableOrder, $tableName;
    … …  
    35775362sub ProcessDirectory($$$;$)
    35785363{
    3579     my ($self, $dirInfo, $tagTablePtr, $processProc) = @_;
     5364    my ($self, $dirInfo, $tagTablePtr, $proc) = @_;
    35805365
    35815366    return 0 unless $tagTablePtr and $dirInfo;
    3582     # use default proc from tag table if no proc specified
    3583     $processProc or $processProc = $$tagTablePtr{PROCESS_PROC};
     5367    # use default proc from tag table or EXIF proc as fallback if no proc specified
     5368    $proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif;
    35845369    # set directory name from default group0 name if not done already
    3585     $$dirInfo{DirName} or $$dirInfo{DirName} = $tagTablePtr->{GROUPS}->{0};
     5370    $$dirInfo{DirName} or $$dirInfo{DirName} = $tagTablePtr->{GROUPS}{0};
    35865371    # guard against cyclical recursion into the same directory
    35875372    if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos}) {
    35885373        my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0);
    3589         if ($self->{PROCESSED}->{$addr}) {
    3590             $self->Warn("$$dirInfo{DirName} pointer references previous $self->{PROCESSED}->{$addr} directory");
     5374        if ($self->{PROCESSED}{$addr}) {
     5375            $self->Warn("$$dirInfo{DirName} pointer references previous $self->{PROCESSED}{$addr} directory");
    35915376            return 0;
    35925377        }
    3593         $self->{PROCESSED}->{$addr} = $$dirInfo{DirName};
    3594     }
    3595     # otherwise process as an EXIF directory
    3596     $processProc or $processProc = \&Image::ExifTool::Exif::ProcessExif;
     5378        $self->{PROCESSED}{$addr} = $$dirInfo{DirName};
     5379    }
    35975380    my $oldOrder = GetByteOrder();
    35985381    my $oldIndent = $self->{INDENT};
    35995382    my $oldDir = $self->{DIR_NAME};
     5383    $self->{LIST_TAGS} = { };  # don't build lists across different directories
    36005384    $self->{INDENT} .= '| ';
    36015385    $self->{DIR_NAME} = $$dirInfo{DirName};
    3602     my $rtnVal = &$processProc($self, $dirInfo, $tagTablePtr);
     5386    push @{$self->{PATH}}, $$dirInfo{DirName};
     5387
     5388    # process the directory
     5389    my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr);
     5390
     5391    pop @{$self->{PATH}};
    36035392    $self->{INDENT} = $oldIndent;
    36045393    $self->{DIR_NAME} = $oldDir;
    … …  
    36085397
    36095398#------------------------------------------------------------------------------
     5399# Get Metadata path
     5400# Inputs: 0) Exiftool object ref
     5401# Return: Metadata path string
     5402sub MetadataPath($)
     5403{
     5404    my $self = shift;
     5405    return join '-', @{$$self{PATH}}
     5406}
     5407
     5408#------------------------------------------------------------------------------
    36105409# Get standardized file extension
    36115410# Inputs: 0) file name
    3612 # Returns: standardized extension (all uppercase)
     5411# Returns: standardized extension (all uppercase), or undefined if no extension
    36135412sub GetFileExtension($)
    36145413{
    … …  
    36695468            return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt;
    36705469            # set old value for use in condition if needed
    3671             my $oldVal = $self->{VALUE}->{$$tagInfo{Name}};
    3672             #### eval Condition ($self, $oldVal, [$valPt, $format, $count])
     5470            local $SIG{'__WARN__'} = \&SetWarning;
     5471            undef $evalWarning;
     5472            #### eval Condition ($self, [$valPt, $format, $count])
    36735473            unless (eval $condition) {
    3674                 $@ and warn "Condition $$tagInfo{Name}: $@";
     5474                $@ and $evalWarning = $@;
     5475                $self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning;
    36755476                next;
    36765477            }
    36775478        }
    3678         if ($$tagInfo{Unknown} and not $self->{OPTIONS}->{Unknown}) {
     5479        if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and not $$self{OPTIONS}{Verbose}) {
    36795480            # don't return Unknown tags unless that option is set
    36805481            return undef;
    … …  
    36845485    }
    36855486    # generate information for unknown tags (numerical only) if required
    3686     if (not $tagInfo and $self->{OPTIONS}->{Unknown} and $tagID =~ /^\d+$/ and
    3687         not $$self{NO_UNKNOWN})
     5487    if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and
     5488        $tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN})
    36885489    {
    36895490        my $printConv;
    … …  
    37145515# Add new tag to table (must use this routine to add new tags to a table)
    37155516# Inputs: 0) reference to tag table, 1) tag ID
    3716 #         2) reference to tag information hash
     5517#         2) [optional] reference to tag information hash
    37175518# Notes: - will not overwrite existing entry in table
    37185519# - info need contain no entries when this routine is called
    3719 sub AddTagToTable($$$)
     5520sub AddTagToTable($$;$)
    37205521{
    37215522    my ($tagTablePtr, $tagID, $tagInfo) = @_;
     5523    $tagInfo or $tagInfo = { };
    37225524
    37235525    # define necessary entries in information hash
    … …  
    37255527        # fill in default groups from table GROUPS
    37265528        foreach (keys %{$$tagTablePtr{GROUPS}}) {
    3727             next if $tagInfo->{Groups}->{$_};
    3728             $tagInfo->{Groups}->{$_} = $tagTablePtr->{GROUPS}->{$_};
     5529            next if $tagInfo->{Groups}{$_};
     5530            $tagInfo->{Groups}{$_} = $tagTablePtr->{GROUPS}{$_};
    37295531        }
    37305532    } else {
    3731         $$tagInfo{Groups} = $$tagTablePtr{GROUPS};
     5533        $$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} };
    37325534    }
    37335535    $$tagInfo{Flags} and ExpandFlags($tagInfo);
    … …  
    37365538    $$tagInfo{TagID} = $tagID;
    37375539
    3738     unless ($$tagInfo{Name}) {
     5540    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
    37395549        my $prefix = $$tagTablePtr{TAG_PREFIX};
    3740         $$tagInfo{Name} = "${prefix}_$tagID";
    3741         # make description to prevent tagID from getting mangled by MakeDescription()
    3742         $$tagInfo{Description} = MakeDescription($prefix, $tagID);
    3743     }
     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;
     5558    $$tagInfo{Name} = $name;
    37445559    # add tag to table, but never overwrite existing entries (could potentially happen
    37455560    # if someone thinks there isn't any tagInfo because a condition wasn't satisfied)
    … …  
    37515566# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value,
    37525567#         4-N) parameters hash: Index, DataPt, DataPos, Start, Size, Parent,
    3753 #              TagInfo, ProcessProc
     5568#              TagInfo, ProcessProc, RAF
    37545569# Returns: tag key or undef if tag not found
     5570# Notes: if value is not defined, it is extracted from DataPt using TagInfo
     5571#        Format and Count if provided
    37555572sub HandleTag($$$$;%)
    37565573{
    37575574    my ($self, $tagTablePtr, $tag, $val, %parms) = @_;
    3758     my $verbose = $self->{OPTIONS}->{Verbose};
    3759     my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag);
     5575    my $verbose = $self->{OPTIONS}{Verbose};
     5576    my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val);
    37605577    my $dataPt = $parms{DataPt};
    3761     my $subdir;
     5578    my ($subdir, $format, $count, $size, $noTagInfo);
    37625579
    37635580    if ($tagInfo) {
    … …  
    37655582    } else {
    37665583        return undef unless $verbose;
     5584        $tagInfo = { Name => "tag $tag" };  # create temporary tagInfo hash
     5585        $noTagInfo = 1;
    37675586    }
    37685587    # read value if not done already (not necessary for subdir)
    3769     unless (defined $val or $subdir) {
     5588    unless (defined $val or ($subdir and not $$tagInfo{Writable})) {
    37705589        my $start = $parms{Start} || 0;
    37715590        my $size = $parms{Size} || 0;
    37725591        # read from data in memory if possible
    37735592        if ($dataPt and $start >= 0 and $start + $size <= length($$dataPt)) {
    3774             $val = substr($$dataPt, $start, $size);
     5593            $format = $$tagInfo{Format} || $$tagTablePtr{FORMAT};
     5594            if ($format) {
     5595                $val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size);
     5596            } else {
     5597                $val = substr($$dataPt, $start, $size);
     5598            }
    37755599        } else {
    3776             my $name = $tagInfo ? $$tagInfo{Name} : "tag $tag";
    3777             $self->Warn("Error extracting value for $name");
     5600            $self->Warn("Error extracting value for $$tagInfo{Name}");
    37785601            return undef;
    37795602        }
    … …  
    37815604    # do verbose print if necessary
    37825605    if ($verbose) {
     5606        undef $tagInfo if $noTagInfo;
    37835607        $parms{Value} = $val;
    37845608        $parms{Table} = $tagTablePtr;
     5609        if ($format) {
     5610            $count or $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1));
     5611            $parms{Format} = $format . "[$count]";
     5612        }
    37855613        $self->VerboseInfo($tag, $tagInfo, %parms);
    37865614    }
    37875615    if ($tagInfo) {
    37885616        if ($subdir) {
     5617            my $subdirStart = $parms{Start};
     5618            my $subdirLen = $parms{Size};
     5619            if ($$subdir{Start}) {
     5620                my $valuePtr = 0;
     5621                #### eval Start ($valuePtr)
     5622                my $off = eval $$subdir{Start};               
     5623                $subdirStart += $off;
     5624                $subdirLen -= $off;
     5625            }
    37895626            $dataPt or $dataPt = \$val;
    37905627            # process subdirectory information
    37915628            my %dirInfo = (
    3792                 DirName  => $$tagInfo{Name},
     5629                DirName  => $$subdir{DirName} || $$tagInfo{Name},
    37935630                DataPt   => $dataPt,
    37945631                DataLen  => length $$dataPt,
    37955632                DataPos  => $parms{DataPos},
    3796                 DirStart => $parms{Start},
    3797                 DirLen   => $parms{Size},
     5633                DirStart => $subdirStart,
     5634                DirLen   => $subdirLen,
    37985635                Parent   => $parms{Parent},
     5636                Base     => $parms{Base},
     5637                Multi    => $$subdir{Multi},
     5638                TagInfo  => $tagInfo,
     5639                RAF      => $parms{RAF},
    37995640            );
     5641            my $oldOrder = GetByteOrder();
     5642            SetByteOrder($$subdir{ByteOrder}) if $$subdir{ByteOrder};
    38005643            my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr;
    3801             $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc});
    3802         } else {
    3803             return $self->FoundTag($tagInfo, $val);
    3804         }
     5644            $self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc});
     5645            SetByteOrder($oldOrder);
     5646            # return now unless directory is writable as a block
     5647            return undef unless $$tagInfo{Writable};
     5648        }
     5649        return $self->FoundTag($tagInfo, $val);
    38055650    }
    38065651    return undef;
    … …  
    38095654#------------------------------------------------------------------------------
    38105655# Add tag to hash of extracted information
    3811 # Inputs: 0) reference to ExifTool object
     5656# Inputs: 0) ExifTool object reference
    38125657#         1) reference to tagInfo hash or tag name
    3813 #         2) data value (or reference to require hash if composite)
     5658#         2) data value (or reference to require hash if Composite)
    38145659# Returns: tag key or undef if no value
    38155660sub FoundTag($$$)
    … …  
    38285673        # (not advised to do this since the tag won't show in list)
    38295674        $tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool };
    3830         $self->{OPTIONS}->{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
     5675        $self->{OPTIONS}{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value);
    38315676    }
    38325677    my $rawValueHash = $self->{VALUE};
    38335678    if ($$tagInfo{RawConv}) {
    3834         my $conv = $$tagInfo{RawConv};
    3835         my $val = $value;   # must do this in case eval references $val
    38365679        # initialize @val for use in Composite RawConv expressions
    38375680        my @val;
    3838         if (ref $val eq 'HASH') {
    3839             foreach (keys %$val) { $val[$_] = $$rawValueHash{$$val{$_}}; }
    3840         }
     5681        if (ref $value eq 'HASH') {
     5682            foreach (keys %$value) { $val[$_] = $$rawValueHash{$$value{$_}}; }
     5683        }
     5684      &