line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# File: ExifTool.pm |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Description: Read and write meta information |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# URL: https://exiftool.org/ |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# Revisions: Nov. 12/2003 - P. Harvey Created |
9
|
|
|
|
|
|
|
# (See html/history.html for revision history) |
10
|
|
|
|
|
|
|
# |
11
|
|
|
|
|
|
|
# Legal: Copyright (c) 2003-2022, Phil Harvey (philharvey66 at gmail.com) |
12
|
|
|
|
|
|
|
# This library is free software; you can redistribute it and/or |
13
|
|
|
|
|
|
|
# modify it under the same terms as Perl itself. |
14
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
package Image::ExifTool; |
17
|
|
|
|
|
|
|
|
18
|
105
|
|
|
105
|
|
256629
|
use strict; |
|
105
|
|
|
|
|
828
|
|
|
105
|
|
|
|
|
4346
|
|
19
|
|
|
|
|
|
|
require 5.004; # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do) |
20
|
|
|
|
|
|
|
require Exporter; |
21
|
105
|
|
|
105
|
|
50334
|
use File::RandomAccess; |
|
105
|
|
|
|
|
296
|
|
|
105
|
|
|
|
|
6011
|
|
22
|
105
|
|
|
105
|
|
128764
|
use overload; |
|
105
|
|
|
|
|
179817
|
|
|
105
|
|
|
|
|
2184
|
|
23
|
|
|
|
|
|
|
|
24
|
105
|
|
|
|
|
719660
|
use vars qw($VERSION $RELEASE @ISA @EXPORT_OK %EXPORT_TAGS $AUTOLOAD @fileTypes |
25
|
|
|
|
|
|
|
%allTables @tableOrder $exifAPP1hdr $xmpAPP1hdr $xmpExtAPP1hdr |
26
|
|
|
|
|
|
|
$psAPP13hdr $psAPP13old @loadAllTables %UserDefined $evalWarning |
27
|
|
|
|
|
|
|
%noWriteFile %magicNumber @langs $defaultLang %langName %charsetName |
28
|
|
|
|
|
|
|
%mimeType $swapBytes $swapWords $currentByteOrder %unpackStd |
29
|
|
|
|
|
|
|
%jpegMarker %specialTags %fileTypeLookup $testLen $exeDir |
30
|
105
|
|
|
105
|
|
9561
|
%static_vars); |
|
105
|
|
|
|
|
1796
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$VERSION = '12.50'; |
33
|
|
|
|
|
|
|
$RELEASE = ''; |
34
|
|
|
|
|
|
|
@ISA = qw(Exporter); |
35
|
|
|
|
|
|
|
%EXPORT_TAGS = ( |
36
|
|
|
|
|
|
|
# all public non-object-oriented functions: |
37
|
|
|
|
|
|
|
Public => [qw( |
38
|
|
|
|
|
|
|
ImageInfo GetTagName GetShortcuts GetAllTags GetWritableTags |
39
|
|
|
|
|
|
|
GetAllGroups GetDeleteGroups GetFileType CanWrite CanCreate |
40
|
|
|
|
|
|
|
AddUserDefinedTags |
41
|
|
|
|
|
|
|
)], |
42
|
|
|
|
|
|
|
# exports not part of the public API, but used by ExifTool modules: |
43
|
|
|
|
|
|
|
DataAccess => [qw( |
44
|
|
|
|
|
|
|
ReadValue GetByteOrder SetByteOrder ToggleByteOrder Get8u Get8s Get16u |
45
|
|
|
|
|
|
|
Get16s Get32u Get32s Get64u GetFloat GetDouble GetFixed32s Write |
46
|
|
|
|
|
|
|
WriteValue Tell Set8u Set8s Set16u Set32u Set64u Set64s |
47
|
|
|
|
|
|
|
)], |
48
|
|
|
|
|
|
|
Utils => [qw(GetTagTable TagTableKeys GetTagInfoList AddTagToTable HexDump)], |
49
|
|
|
|
|
|
|
Vars => [qw(%allTables @tableOrder @fileTypes)], |
50
|
|
|
|
|
|
|
); |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
# set all of our EXPORT_TAGS in EXPORT_OK |
53
|
|
|
|
|
|
|
Exporter::export_ok_tags(keys %EXPORT_TAGS); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# test for problems that can arise if encoding.pm is used |
56
|
|
|
|
|
|
|
{ my $t = "\xff"; die "Incompatible encoding!\n" if ord($t) != 0xff; } |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
# The following functions defined in Image::ExifTool::Writer.pl are declared |
59
|
|
|
|
|
|
|
# here so their prototypes will be available. These Writer routines will be |
60
|
|
|
|
|
|
|
# autoloaded when any of them is called. |
61
|
|
|
|
|
|
|
sub SetNewValue($;$$%); |
62
|
|
|
|
|
|
|
sub SetNewValuesFromFile($$;@); |
63
|
|
|
|
|
|
|
sub GetNewValue($$;$); |
64
|
|
|
|
|
|
|
sub GetNewValues($$;$); |
65
|
|
|
|
|
|
|
sub CountNewValues($); |
66
|
|
|
|
|
|
|
sub SaveNewValues($); |
67
|
|
|
|
|
|
|
sub RestoreNewValues($); |
68
|
|
|
|
|
|
|
sub WriteInfo($$;$$); |
69
|
|
|
|
|
|
|
sub SetFileModifyDate($$;$$$); |
70
|
|
|
|
|
|
|
sub SetFileName($$;$$$); |
71
|
|
|
|
|
|
|
sub SetSystemTags($$); |
72
|
|
|
|
|
|
|
sub GetAllTags(;$); |
73
|
|
|
|
|
|
|
sub GetWritableTags(;$); |
74
|
|
|
|
|
|
|
sub GetAllGroups($;$); |
75
|
|
|
|
|
|
|
sub GetNewGroups($); |
76
|
|
|
|
|
|
|
sub GetDeleteGroups(); |
77
|
|
|
|
|
|
|
sub AddUserDefinedTags($%); |
78
|
|
|
|
|
|
|
# non-public routines below |
79
|
|
|
|
|
|
|
sub InsertTagValues($$$;$$$); |
80
|
|
|
|
|
|
|
sub IsWritable($); |
81
|
|
|
|
|
|
|
sub IsSameFile($$$); |
82
|
|
|
|
|
|
|
sub IsRawType($); |
83
|
|
|
|
|
|
|
sub GetNewFileName($$); |
84
|
|
|
|
|
|
|
sub LoadAllTables(); |
85
|
|
|
|
|
|
|
sub GetNewTagInfoList($;$); |
86
|
|
|
|
|
|
|
sub GetNewTagInfoHash($@); |
87
|
|
|
|
|
|
|
sub GetLangInfo($$); |
88
|
|
|
|
|
|
|
sub Get64s($$); |
89
|
|
|
|
|
|
|
sub Get64u($$); |
90
|
|
|
|
|
|
|
sub GetFixed64s($$); |
91
|
|
|
|
|
|
|
sub GetExtended($$); |
92
|
|
|
|
|
|
|
sub Set64u(@); |
93
|
|
|
|
|
|
|
sub Set64s(@); |
94
|
|
|
|
|
|
|
sub DecodeBits($$;$); |
95
|
|
|
|
|
|
|
sub EncodeBits($$;$$); |
96
|
|
|
|
|
|
|
sub Filter($$$); |
97
|
|
|
|
|
|
|
sub HexDump($;$%); |
98
|
|
|
|
|
|
|
sub DumpTrailer($$); |
99
|
|
|
|
|
|
|
sub DumpUnknownTrailer($$); |
100
|
|
|
|
|
|
|
sub VerboseInfo($$$%); |
101
|
|
|
|
|
|
|
sub VerboseValue($$$;$); |
102
|
|
|
|
|
|
|
sub VPrint($$@); |
103
|
|
|
|
|
|
|
sub Rationalize($;$); |
104
|
|
|
|
|
|
|
sub Write($@); |
105
|
|
|
|
|
|
|
sub WriteTrailerBuffer($$$); |
106
|
|
|
|
|
|
|
sub AddNewTrailers($;@); |
107
|
|
|
|
|
|
|
sub Tell($); |
108
|
|
|
|
|
|
|
sub WriteValue($$;$$$$); |
109
|
|
|
|
|
|
|
sub WriteDirectory($$$;$); |
110
|
|
|
|
|
|
|
sub WriteBinaryData($$$); |
111
|
|
|
|
|
|
|
sub CheckBinaryData($$$); |
112
|
|
|
|
|
|
|
sub WriteTIFF($$$); |
113
|
|
|
|
|
|
|
sub PackUTF8(@); |
114
|
|
|
|
|
|
|
sub UnpackUTF8($); |
115
|
|
|
|
|
|
|
sub SetPreferredByteOrder($;$); |
116
|
|
|
|
|
|
|
sub CopyBlock($$$); |
117
|
|
|
|
|
|
|
sub CopyFileAttrs($$$); |
118
|
|
|
|
|
|
|
sub TimeNow(;$$); |
119
|
|
|
|
|
|
|
sub NewGUID(); |
120
|
|
|
|
|
|
|
sub MakeTiffHeader($$$$;$$); |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
# other subroutine definitions |
123
|
|
|
|
|
|
|
sub SplitFileName($); |
124
|
|
|
|
|
|
|
sub EncodeFileName($$;$); |
125
|
|
|
|
|
|
|
sub Open($*$;$); |
126
|
|
|
|
|
|
|
sub Exists($$); |
127
|
|
|
|
|
|
|
sub IsDirectory($$); |
128
|
|
|
|
|
|
|
sub Rename($$$); |
129
|
|
|
|
|
|
|
sub Unlink($@); |
130
|
|
|
|
|
|
|
sub SetFileTime($$;$$$$); |
131
|
|
|
|
|
|
|
sub DoEscape($$); |
132
|
|
|
|
|
|
|
sub ConvertFileSize($); |
133
|
|
|
|
|
|
|
sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem) |
134
|
|
|
|
|
|
|
sub ReadValue($$$;$$$); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# list of main tag tables to load in LoadAllTables() (sub-tables are recursed |
137
|
|
|
|
|
|
|
# automatically). Note: They will appear in this order in the documentation |
138
|
|
|
|
|
|
|
# unless tweaked in BuildTagLookup::GetTableOrder(). |
139
|
|
|
|
|
|
|
@loadAllTables = qw( |
140
|
|
|
|
|
|
|
PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw Lytro MinoltaRaw PanasonicRaw |
141
|
|
|
|
|
|
|
SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 BMP::Extra BPG BPG::Extensions |
142
|
|
|
|
|
|
|
ICO PICT PNG MNG FLIF DjVu DPX OpenEXR ZISRAW MRC LIF MRC::FEI12 MIFF PCX |
143
|
|
|
|
|
|
|
PGF PSP PhotoCD Radiance Other::PFM PDF PostScript Photoshop::Header |
144
|
|
|
|
|
|
|
Photoshop::Layers Photoshop::ImageData FujiFilm::RAF FujiFilm::IFD |
145
|
|
|
|
|
|
|
Samsung::Trailer Sony::SRF2 Sony::SR2SubIFD Sony::PMP ITC ID3 ID3::Lyrics3 |
146
|
|
|
|
|
|
|
FLAC Ogg Vorbis APE APE::NewHeader APE::OldHeader Audible MPC MPEG::Audio |
147
|
|
|
|
|
|
|
MPEG::Video MPEG::Xing M2TS QuickTime QuickTime::ImageFile QuickTime::Stream |
148
|
|
|
|
|
|
|
QuickTime::Tags360Fly Matroska MOI MXF DV Flash Flash::FLV Real::Media |
149
|
|
|
|
|
|
|
Real::Audio Real::Metafile Red RIFF AIFF ASF WTV DICOM FITS MIE JSON HTML |
150
|
|
|
|
|
|
|
XMP::SVG Palm Palm::MOBI Palm::EXTH Torrent EXE EXE::PEVersion EXE::PEString |
151
|
|
|
|
|
|
|
EXE::MachO EXE::PEF EXE::ELF EXE::AR EXE::CHM LNK Font VCard Text |
152
|
|
|
|
|
|
|
VCard::VCalendar RSRC Rawzor ZIP ZIP::GZIP ZIP::RAR RTF OOXML iWork ISO |
153
|
|
|
|
|
|
|
FLIR::AFF FLIR::FPF MacOS MacOS::MDItem FlashPix::DocTable |
154
|
|
|
|
|
|
|
); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# alphabetical list of current Lang modules |
157
|
|
|
|
|
|
|
@langs = qw(cs de en en_ca en_gb es fi fr it ja ko nl pl ru sv tr zh_cn zh_tw); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
$defaultLang = 'en'; # default language |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# language names |
162
|
|
|
|
|
|
|
%langName = ( |
163
|
|
|
|
|
|
|
cs => 'Czech (Čeština)', |
164
|
|
|
|
|
|
|
de => 'German (Deutsch)', |
165
|
|
|
|
|
|
|
en => 'English', |
166
|
|
|
|
|
|
|
en_ca => 'Canadian English', |
167
|
|
|
|
|
|
|
en_gb => 'British English', |
168
|
|
|
|
|
|
|
es => 'Spanish (Español)', |
169
|
|
|
|
|
|
|
fi => 'Finnish (Suomi)', |
170
|
|
|
|
|
|
|
fr => 'French (Français)', |
171
|
|
|
|
|
|
|
it => 'Italian (Italiano)', |
172
|
|
|
|
|
|
|
ja => 'Japanese (日本語)', |
173
|
|
|
|
|
|
|
ko => 'Korean (한국어)', |
174
|
|
|
|
|
|
|
nl => 'Dutch (Nederlands)', |
175
|
|
|
|
|
|
|
pl => 'Polish (Polski)', |
176
|
|
|
|
|
|
|
ru => 'Russian (Русский)', |
177
|
|
|
|
|
|
|
sv => 'Swedish (Svenska)', |
178
|
|
|
|
|
|
|
'tr'=> 'Turkish (Türkçe)', |
179
|
|
|
|
|
|
|
zh_cn => 'Simplified Chinese (简体中文)', |
180
|
|
|
|
|
|
|
zh_tw => 'Traditional Chinese (繁體中文)', |
181
|
|
|
|
|
|
|
); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# recognized file types, in the order we test unknown files |
184
|
|
|
|
|
|
|
# Notes: 1) There is no need to test for like types separately here |
185
|
|
|
|
|
|
|
# 2) Put types with weak file signatures at end of list to avoid false matches |
186
|
|
|
|
|
|
|
# 3) PLIST must be in this list for the binary PLIST format, although it may |
187
|
|
|
|
|
|
|
# cause a file to be checked twice for XML |
188
|
|
|
|
|
|
|
@fileTypes = qw(JPEG EXV CRW DR4 TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF |
189
|
|
|
|
|
|
|
PSD XMP BMP BPG PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG |
190
|
|
|
|
|
|
|
FLAC APE MPC MKV MXF DV PMP IND PGF ICC ITC FLIR FLIF FPF LFP |
191
|
|
|
|
|
|
|
HTML VRD RTF FITS XCF DSS QTIF FPX PICT ZIP GZIP PLIST RAR BZ2 |
192
|
|
|
|
|
|
|
CZI TAR EXE EXR HDR CHM LNK WMF AVC DEX DPX RAW Font RSRC M2TS |
193
|
|
|
|
|
|
|
MacOS PHP PCX DCX DWF DWG DXF WTV Torrent VCard LRI R3D AA PDB |
194
|
|
|
|
|
|
|
PFM2 MRC LIF JXL MOI ISO ALIAS JSON MP3 DICOM PCD ICO TXT); |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# file types that we can write (edit) |
197
|
|
|
|
|
|
|
my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM EPS |
198
|
|
|
|
|
|
|
X3F PS PDF ICC VRD DR4 JP2 JXL EXIF AI AIT IND MOV EXV FLIF |
199
|
|
|
|
|
|
|
RIFF); |
200
|
|
|
|
|
|
|
my %writeTypes; # lookup for writable file types (hash filled if required) |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# file extensions that we can't write for various base types |
203
|
|
|
|
|
|
|
%noWriteFile = ( |
204
|
|
|
|
|
|
|
TIFF => [ qw(3FR DCR K25 KDC SRF) ], |
205
|
|
|
|
|
|
|
XMP => [ qw(SVG INX) ], |
206
|
|
|
|
|
|
|
JP2 => [ qw(J2C JPC) ], |
207
|
|
|
|
|
|
|
MOV => [ qw(INSV) ], |
208
|
|
|
|
|
|
|
); |
209
|
|
|
|
|
|
|
# file extensions that we can only write for various base types |
210
|
|
|
|
|
|
|
my %onlyWriteFile = ( RIFF => [ qw(WEBP) ] ); |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# file types that we can create from scratch |
213
|
|
|
|
|
|
|
# - must update CanCreate() documentation if this list is changed! |
214
|
|
|
|
|
|
|
my %createTypes = map { $_ => 1 } qw(XMP ICC MIE VRD DR4 EXIF EXV); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# file type lookup for all recognized file extensions (upper case) |
217
|
|
|
|
|
|
|
# (if extension may be more than one type, the type is a list where |
218
|
|
|
|
|
|
|
# the writable type should come first if it exists) |
219
|
|
|
|
|
|
|
%fileTypeLookup = ( |
220
|
|
|
|
|
|
|
'360' => ['MOV', 'GoPro 360 video'], |
221
|
|
|
|
|
|
|
'3FR' => ['TIFF', 'Hasselblad RAW format'], |
222
|
|
|
|
|
|
|
'3G2' => ['MOV', '3rd Gen. Partnership Project 2 audio/video'], |
223
|
|
|
|
|
|
|
'3GP' => ['MOV', '3rd Gen. Partnership Project audio/video'], |
224
|
|
|
|
|
|
|
'3GP2'=> '3G2', |
225
|
|
|
|
|
|
|
'3GPP'=> '3GP', |
226
|
|
|
|
|
|
|
A => ['EXE', 'Static library'], |
227
|
|
|
|
|
|
|
AA => ['AA', 'Audible Audiobook'], |
228
|
|
|
|
|
|
|
AAE => ['PLIST','Apple edit information'], |
229
|
|
|
|
|
|
|
AAX => ['MOV', 'Audible Enhanced Audiobook'], |
230
|
|
|
|
|
|
|
ACR => ['DICOM','American College of Radiology ACR-NEMA'], |
231
|
|
|
|
|
|
|
ACFM => ['Font', 'Adobe Composite Font Metrics'], |
232
|
|
|
|
|
|
|
AFM => ['Font', 'Adobe Font Metrics'], |
233
|
|
|
|
|
|
|
AMFM => ['Font', 'Adobe Multiple Master Font Metrics'], |
234
|
|
|
|
|
|
|
AI => [['PDF','PS'], 'Adobe Illustrator'], |
235
|
|
|
|
|
|
|
AIF => 'AIFF', |
236
|
|
|
|
|
|
|
AIFC => ['AIFF', 'Audio Interchange File Format Compressed'], |
237
|
|
|
|
|
|
|
AIFF => ['AIFF', 'Audio Interchange File Format'], |
238
|
|
|
|
|
|
|
AIT => 'AI', |
239
|
|
|
|
|
|
|
ALIAS=> ['ALIAS','MacOS file alias'], |
240
|
|
|
|
|
|
|
APE => ['APE', "Monkey's Audio format"], |
241
|
|
|
|
|
|
|
APNG => ['PNG', 'Animated Portable Network Graphics'], |
242
|
|
|
|
|
|
|
ARW => ['TIFF', 'Sony Alpha RAW format'], |
243
|
|
|
|
|
|
|
ARQ => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'], |
244
|
|
|
|
|
|
|
ASF => ['ASF', 'Microsoft Advanced Systems Format'], |
245
|
|
|
|
|
|
|
AVC => ['AVC', 'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID) |
246
|
|
|
|
|
|
|
AVI => ['RIFF', 'Audio Video Interleaved'], |
247
|
|
|
|
|
|
|
AVIF => ['MOV', 'AV1 Image File Format'], |
248
|
|
|
|
|
|
|
AZW => 'MOBI', # (see http://wiki.mobileread.com/wiki/AZW) |
249
|
|
|
|
|
|
|
AZW3 => 'MOBI', |
250
|
|
|
|
|
|
|
BMP => ['BMP', 'Windows Bitmap'], |
251
|
|
|
|
|
|
|
BPG => ['BPG', 'Better Portable Graphics'], |
252
|
|
|
|
|
|
|
BTF => ['BTF', 'Big Tagged Image File Format'], #(unofficial) |
253
|
|
|
|
|
|
|
BZ2 => ['BZ2', 'BZIP2 archive'], |
254
|
|
|
|
|
|
|
CHM => ['CHM', 'Microsoft Compiled HTML format'], |
255
|
|
|
|
|
|
|
CIFF => ['CRW', 'Camera Image File Format'], |
256
|
|
|
|
|
|
|
COS => ['COS', 'Capture One Settings'], |
257
|
|
|
|
|
|
|
CR2 => ['TIFF', 'Canon RAW 2 format'], |
258
|
|
|
|
|
|
|
CR3 => ['MOV', 'Canon RAW 3 format'], |
259
|
|
|
|
|
|
|
CRM => ['MOV', 'Canon RAW Movie'], |
260
|
|
|
|
|
|
|
CRW => ['CRW', 'Canon RAW format'], |
261
|
|
|
|
|
|
|
CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW'], |
262
|
|
|
|
|
|
|
CSV => ['TXT', 'Comma-Separated Values'], |
263
|
|
|
|
|
|
|
CUR => ['ICO', 'Windows Cursor'], |
264
|
|
|
|
|
|
|
CZI => ['CZI', 'Zeiss Integrated Software RAW'], |
265
|
|
|
|
|
|
|
DC3 => 'DICM', |
266
|
|
|
|
|
|
|
DCM => 'DICM', |
267
|
|
|
|
|
|
|
DCP => ['TIFF', 'DNG Camera Profile'], |
268
|
|
|
|
|
|
|
DCR => ['TIFF', 'Kodak Digital Camera RAW'], |
269
|
|
|
|
|
|
|
DCX => ['DCX', 'Multi-page PC Paintbrush'], |
270
|
|
|
|
|
|
|
DEX => ['DEX', 'Dalvik Executable format'], |
271
|
|
|
|
|
|
|
DFONT=> ['Font', 'Macintosh Data fork Font'], |
272
|
|
|
|
|
|
|
DIB => ['BMP', 'Device Independent Bitmap'], |
273
|
|
|
|
|
|
|
DIC => 'DICM', |
274
|
|
|
|
|
|
|
DICM => ['DICOM','Digital Imaging and Communications in Medicine'], |
275
|
|
|
|
|
|
|
DIR => ['DIR', 'Directory'], |
276
|
|
|
|
|
|
|
DIVX => ['ASF', 'DivX media format'], |
277
|
|
|
|
|
|
|
DJV => 'DJVU', |
278
|
|
|
|
|
|
|
DJVU => ['AIFF', 'DjVu image'], |
279
|
|
|
|
|
|
|
DLL => ['EXE', 'Windows Dynamic Link Library'], |
280
|
|
|
|
|
|
|
DNG => ['TIFF', 'Digital Negative'], |
281
|
|
|
|
|
|
|
DOC => ['FPX', 'Microsoft Word Document'], |
282
|
|
|
|
|
|
|
DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'], |
283
|
|
|
|
|
|
|
# Note: I have seen a password-protected DOCX file which was FPX-like, so I assume |
284
|
|
|
|
|
|
|
# that any other MS Office file could be like this too. The only difference is |
285
|
|
|
|
|
|
|
# that the ZIP and FPX formats are checked first, so if this is wrong, no biggie. |
286
|
|
|
|
|
|
|
DOCX => [['ZIP','FPX'], 'Office Open XML Document'], |
287
|
|
|
|
|
|
|
DOT => ['FPX', 'Microsoft Word Template'], |
288
|
|
|
|
|
|
|
DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'], |
289
|
|
|
|
|
|
|
DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'], |
290
|
|
|
|
|
|
|
DPX => ['DPX', 'Digital Picture Exchange' ], |
291
|
|
|
|
|
|
|
DR4 => ['DR4', 'Canon VRD version 4 Recipe'], |
292
|
|
|
|
|
|
|
DS2 => ['DSS', 'Digital Speech Standard 2'], |
293
|
|
|
|
|
|
|
DSS => ['DSS', 'Digital Speech Standard'], |
294
|
|
|
|
|
|
|
DV => ['DV', 'Digital Video'], |
295
|
|
|
|
|
|
|
DVB => ['MOV', 'Digital Video Broadcasting'], |
296
|
|
|
|
|
|
|
'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'], |
297
|
|
|
|
|
|
|
DWF => ['DWF', 'Autodesk drawing (Design Web Format)'], |
298
|
|
|
|
|
|
|
DWG => ['DWG', 'AutoCAD Drawing'], |
299
|
|
|
|
|
|
|
DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'], |
300
|
|
|
|
|
|
|
DXF => ['DXF', 'AutoCAD Drawing Exchange Format'], |
301
|
|
|
|
|
|
|
EIP => ['ZIP', 'Capture One Enhanced Image Package'], |
302
|
|
|
|
|
|
|
EPS => ['EPS', 'Encapsulated PostScript Format'], |
303
|
|
|
|
|
|
|
EPS2 => 'EPS', |
304
|
|
|
|
|
|
|
EPS3 => 'EPS', |
305
|
|
|
|
|
|
|
EPSF => 'EPS', |
306
|
|
|
|
|
|
|
EPUB => ['ZIP', 'Electronic Publication'], |
307
|
|
|
|
|
|
|
ERF => ['TIFF', 'Epson Raw Format'], |
308
|
|
|
|
|
|
|
EXE => ['EXE', 'Windows executable file'], |
309
|
|
|
|
|
|
|
EXR => ['EXR', 'Open EXR'], |
310
|
|
|
|
|
|
|
EXIF => ['EXIF', 'Exchangable Image File Metadata'], |
311
|
|
|
|
|
|
|
EXV => ['EXV', 'Exiv2 metadata'], |
312
|
|
|
|
|
|
|
F4A => ['MOV', 'Adobe Flash Player 9+ Audio'], |
313
|
|
|
|
|
|
|
F4B => ['MOV', 'Adobe Flash Player 9+ audio Book'], |
314
|
|
|
|
|
|
|
F4P => ['MOV', 'Adobe Flash Player 9+ Protected'], |
315
|
|
|
|
|
|
|
F4V => ['MOV', 'Adobe Flash Player 9+ Video'], |
316
|
|
|
|
|
|
|
FFF => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'], |
317
|
|
|
|
|
|
|
FIT => 'FITS', |
318
|
|
|
|
|
|
|
FITS => ['FITS', 'Flexible Image Transport System'], |
319
|
|
|
|
|
|
|
FLAC => ['FLAC', 'Free Lossless Audio Codec'], |
320
|
|
|
|
|
|
|
FLA => ['FPX', 'Macromedia/Adobe Flash project'], |
321
|
|
|
|
|
|
|
FLIF => ['FLIF', 'Free Lossless Image Format'], |
322
|
|
|
|
|
|
|
FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension) |
323
|
|
|
|
|
|
|
FLV => ['FLV', 'Flash Video'], |
324
|
|
|
|
|
|
|
FPF => ['FPF', 'FLIR Public image Format'], |
325
|
|
|
|
|
|
|
FPX => ['FPX', 'FlashPix'], |
326
|
|
|
|
|
|
|
GIF => ['GIF', 'Compuserve Graphics Interchange Format'], |
327
|
|
|
|
|
|
|
GPR => ['TIFF', 'General Purpose RAW'], # https://gopro.github.io/gpr/ |
328
|
|
|
|
|
|
|
GZ => 'GZIP', |
329
|
|
|
|
|
|
|
GZIP => ['GZIP', 'GNU ZIP compressed archive'], |
330
|
|
|
|
|
|
|
HDP => ['TIFF', 'Windows HD Photo'], |
331
|
|
|
|
|
|
|
HDR => ['HDR', 'Radiance RGBE High Dynamic Range'], |
332
|
|
|
|
|
|
|
HEIC => ['MOV', 'High Efficiency Image Format still image'], |
333
|
|
|
|
|
|
|
HEIF => ['MOV', 'High Efficiency Image Format'], |
334
|
|
|
|
|
|
|
HIF => 'HEIF', |
335
|
|
|
|
|
|
|
HTM => 'HTML', |
336
|
|
|
|
|
|
|
HTML => ['HTML', 'HyperText Markup Language'], |
337
|
|
|
|
|
|
|
ICAL => 'ICS', |
338
|
|
|
|
|
|
|
ICC => ['ICC', 'International Color Consortium'], |
339
|
|
|
|
|
|
|
ICM => 'ICC', |
340
|
|
|
|
|
|
|
ICO => ['ICO', 'Windows Icon'], |
341
|
|
|
|
|
|
|
ICS => ['VCard','iCalendar Schedule'], |
342
|
|
|
|
|
|
|
IDML => ['ZIP', 'Adobe InDesign Markup Language'], |
343
|
|
|
|
|
|
|
IIQ => ['TIFF', 'Phase One Intelligent Image Quality RAW'], |
344
|
|
|
|
|
|
|
IND => ['IND', 'Adobe InDesign'], |
345
|
|
|
|
|
|
|
INDD => ['IND', 'Adobe InDesign Document'], |
346
|
|
|
|
|
|
|
INDT => ['IND', 'Adobe InDesign Template'], |
347
|
|
|
|
|
|
|
INSV => ['MOV', 'Insta360 Video'], |
348
|
|
|
|
|
|
|
INSP => ['JPEG', 'Insta360 Picture'], |
349
|
|
|
|
|
|
|
INX => ['XMP', 'Adobe InDesign Interchange'], |
350
|
|
|
|
|
|
|
ISO => ['ISO', 'ISO 9660 disk image'], |
351
|
|
|
|
|
|
|
ITC => ['ITC', 'iTunes Cover Flow'], |
352
|
|
|
|
|
|
|
J2C => ['JP2', 'JPEG 2000 codestream'], |
353
|
|
|
|
|
|
|
J2K => 'J2C', |
354
|
|
|
|
|
|
|
JNG => ['PNG', 'JPG Network Graphics'], |
355
|
|
|
|
|
|
|
JP2 => ['JP2', 'JPEG 2000 file'], |
356
|
|
|
|
|
|
|
# JP4? - looks like a JPEG but the image data is different |
357
|
|
|
|
|
|
|
JPC => 'J2C', |
358
|
|
|
|
|
|
|
JPE => 'JPEG', |
359
|
|
|
|
|
|
|
JPEG => ['JPEG', 'Joint Photographic Experts Group'], |
360
|
|
|
|
|
|
|
JPF => 'JP2', |
361
|
|
|
|
|
|
|
JPG => 'JPEG', |
362
|
|
|
|
|
|
|
JPM => ['JP2', 'JPEG 2000 compound image'], |
363
|
|
|
|
|
|
|
JPS => ['JPEG', 'JPEG Stereo image'], |
364
|
|
|
|
|
|
|
JPX => ['JP2', 'JPEG 2000 with extensions'], |
365
|
|
|
|
|
|
|
JSON => ['JSON', 'JavaScript Object Notation'], |
366
|
|
|
|
|
|
|
JXL => ['JXL', 'JPEG XL'], |
367
|
|
|
|
|
|
|
JXR => ['TIFF', 'JPEG XR'], |
368
|
|
|
|
|
|
|
K25 => ['TIFF', 'Kodak DC25 RAW'], |
369
|
|
|
|
|
|
|
KDC => ['TIFF', 'Kodak Digital Camera RAW'], |
370
|
|
|
|
|
|
|
KEY => ['ZIP', 'Apple Keynote presentation'], |
371
|
|
|
|
|
|
|
KTH => ['ZIP', 'Apple Keynote Theme'], |
372
|
|
|
|
|
|
|
LA => ['RIFF', 'Lossless Audio'], |
373
|
|
|
|
|
|
|
LFP => ['LFP', 'Lytro Light Field Picture'], |
374
|
|
|
|
|
|
|
LFR => 'LFP', # (Light Field RAW) |
375
|
|
|
|
|
|
|
LIF => ['LIF', 'Leica Image File'], |
376
|
|
|
|
|
|
|
LNK => ['LNK', 'Windows shortcut'], |
377
|
|
|
|
|
|
|
LRI => ['LRI', 'Light RAW'], |
378
|
|
|
|
|
|
|
LRV => ['MOV', 'Low-Resolution Video'], |
379
|
|
|
|
|
|
|
M2T => 'M2TS', |
380
|
|
|
|
|
|
|
M2TS => ['M2TS', 'MPEG-2 Transport Stream'], |
381
|
|
|
|
|
|
|
M2V => ['MPEG', 'MPEG-2 Video'], |
382
|
|
|
|
|
|
|
M4A => ['MOV', 'MPEG-4 Audio'], |
383
|
|
|
|
|
|
|
M4B => ['MOV', 'MPEG-4 audio Book'], |
384
|
|
|
|
|
|
|
M4P => ['MOV', 'MPEG-4 Protected'], |
385
|
|
|
|
|
|
|
M4V => ['MOV', 'MPEG-4 Video'], |
386
|
|
|
|
|
|
|
MACOS=> ['MacOS','MacOS ._ sidecar file'], |
387
|
|
|
|
|
|
|
MAX => ['FPX', '3D Studio MAX'], |
388
|
|
|
|
|
|
|
MEF => ['TIFF', 'Mamiya (RAW) Electronic Format'], |
389
|
|
|
|
|
|
|
MIE => ['MIE', 'Meta Information Encapsulation format'], |
390
|
|
|
|
|
|
|
MIF => 'MIFF', |
391
|
|
|
|
|
|
|
MIFF => ['MIFF', 'Magick Image File Format'], |
392
|
|
|
|
|
|
|
MKA => ['MKV', 'Matroska Audio'], |
393
|
|
|
|
|
|
|
MKS => ['MKV', 'Matroska Subtitle'], |
394
|
|
|
|
|
|
|
MKV => ['MKV', 'Matroska Video'], |
395
|
|
|
|
|
|
|
MNG => ['PNG', 'Multiple-image Network Graphics'], |
396
|
|
|
|
|
|
|
MOBI => ['PDB', 'Mobipocket electronic book'], |
397
|
|
|
|
|
|
|
MODD => ['PLIST','Sony Picture Motion metadata'], |
398
|
|
|
|
|
|
|
MOI => ['MOI', 'MOD Information file'], |
399
|
|
|
|
|
|
|
MOS => ['TIFF', 'Creo Leaf Mosaic'], |
400
|
|
|
|
|
|
|
MOV => ['MOV', 'Apple QuickTime movie'], |
401
|
|
|
|
|
|
|
MP3 => ['MP3', 'MPEG-1 Layer 3 audio'], |
402
|
|
|
|
|
|
|
MP4 => ['MOV', 'MPEG-4 video'], |
403
|
|
|
|
|
|
|
MPC => ['MPC', 'Musepack Audio'], |
404
|
|
|
|
|
|
|
MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'], |
405
|
|
|
|
|
|
|
MPG => 'MPEG', |
406
|
|
|
|
|
|
|
MPO => ['JPEG', 'Extended Multi-Picture format'], |
407
|
|
|
|
|
|
|
MQV => ['MOV', 'Sony Mobile Quicktime Video'], |
408
|
|
|
|
|
|
|
MRC => ['MRC', 'Medical Research Council image'], |
409
|
|
|
|
|
|
|
MRW => ['MRW', 'Minolta RAW format'], |
410
|
|
|
|
|
|
|
MTS => 'M2TS', |
411
|
|
|
|
|
|
|
MXF => ['MXF', 'Material Exchange Format'], |
412
|
|
|
|
|
|
|
# NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'], |
413
|
|
|
|
|
|
|
NEF => ['TIFF', 'Nikon (RAW) Electronic Format'], |
414
|
|
|
|
|
|
|
NEWER => 'COS', |
415
|
|
|
|
|
|
|
NKSC => ['XMP', 'Nikon Sidecar'], |
416
|
|
|
|
|
|
|
NMBTEMPLATE => ['ZIP','Apple Numbers Template'], |
417
|
|
|
|
|
|
|
NRW => ['TIFF', 'Nikon RAW (2)'], |
418
|
|
|
|
|
|
|
NUMBERS => ['ZIP','Apple Numbers spreadsheet'], |
419
|
|
|
|
|
|
|
O => ['EXE', 'Relocatable Object'], |
420
|
|
|
|
|
|
|
ODB => ['ZIP', 'Open Document Database'], |
421
|
|
|
|
|
|
|
ODC => ['ZIP', 'Open Document Chart'], |
422
|
|
|
|
|
|
|
ODF => ['ZIP', 'Open Document Formula'], |
423
|
|
|
|
|
|
|
ODG => ['ZIP', 'Open Document Graphics'], |
424
|
|
|
|
|
|
|
ODI => ['ZIP', 'Open Document Image'], |
425
|
|
|
|
|
|
|
ODP => ['ZIP', 'Open Document Presentation'], |
426
|
|
|
|
|
|
|
ODS => ['ZIP', 'Open Document Spreadsheet'], |
427
|
|
|
|
|
|
|
ODT => ['ZIP', 'Open Document Text file'], |
428
|
|
|
|
|
|
|
OFR => ['RIFF', 'OptimFROG audio'], |
429
|
|
|
|
|
|
|
OGG => ['OGG', 'Ogg Vorbis audio file'], |
430
|
|
|
|
|
|
|
OGV => ['OGG', 'Ogg Video file'], |
431
|
|
|
|
|
|
|
ONP => ['JSON', 'ON1 Presets'], |
432
|
|
|
|
|
|
|
OPUS => ['OGG', 'Ogg Opus audio file'], |
433
|
|
|
|
|
|
|
ORF => ['ORF', 'Olympus RAW format'], |
434
|
|
|
|
|
|
|
ORI => 'ORF', |
435
|
|
|
|
|
|
|
OTF => ['Font', 'Open Type Font'], |
436
|
|
|
|
|
|
|
PAC => ['RIFF', 'Lossless Predictive Audio Compression'], |
437
|
|
|
|
|
|
|
PAGES => ['ZIP', 'Apple Pages document'], |
438
|
|
|
|
|
|
|
PBM => ['PPM', 'Portable BitMap'], |
439
|
|
|
|
|
|
|
PCD => ['PCD', 'Kodak Photo CD Image Pac'], |
440
|
|
|
|
|
|
|
PCT => 'PICT', |
441
|
|
|
|
|
|
|
PCX => ['PCX', 'PC Paintbrush'], |
442
|
|
|
|
|
|
|
PDB => ['PDB', 'Palm Database'], |
443
|
|
|
|
|
|
|
PDF => ['PDF', 'Adobe Portable Document Format'], |
444
|
|
|
|
|
|
|
PEF => ['TIFF', 'Pentax (RAW) Electronic Format'], |
445
|
|
|
|
|
|
|
PFA => ['Font', 'PostScript Font ASCII'], |
446
|
|
|
|
|
|
|
PFB => ['Font', 'PostScript Font Binary'], |
447
|
|
|
|
|
|
|
PFM => [['Font','PFM2'], 'Printer Font Metrics'], # (description is overridden for Portable FloatMap images) |
448
|
|
|
|
|
|
|
PGF => ['PGF', 'Progressive Graphics File'], |
449
|
|
|
|
|
|
|
PGM => ['PPM', 'Portable Gray Map'], |
450
|
|
|
|
|
|
|
PHP => ['PHP', 'PHP Hypertext Preprocessor'], |
451
|
|
|
|
|
|
|
PHP3 => 'PHP', |
452
|
|
|
|
|
|
|
PHP4 => 'PHP', |
453
|
|
|
|
|
|
|
PHP5 => 'PHP', |
454
|
|
|
|
|
|
|
PHPS => 'PHP', |
455
|
|
|
|
|
|
|
PHTML=> 'PHP', |
456
|
|
|
|
|
|
|
PICT => ['PICT', 'Apple PICTure'], |
457
|
|
|
|
|
|
|
PLIST=> ['PLIST','Apple Property List'], |
458
|
|
|
|
|
|
|
PMP => ['PMP', 'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;) |
459
|
|
|
|
|
|
|
PNG => ['PNG', 'Portable Network Graphics'], |
460
|
|
|
|
|
|
|
POT => ['FPX', 'Microsoft PowerPoint Template'], |
461
|
|
|
|
|
|
|
POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'], |
462
|
|
|
|
|
|
|
POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'], |
463
|
|
|
|
|
|
|
PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'], |
464
|
|
|
|
|
|
|
PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'], |
465
|
|
|
|
|
|
|
PPM => ['PPM', 'Portable Pixel Map'], |
466
|
|
|
|
|
|
|
PPS => ['FPX', 'Microsoft PowerPoint Slideshow'], |
467
|
|
|
|
|
|
|
PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'], |
468
|
|
|
|
|
|
|
PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'], |
469
|
|
|
|
|
|
|
PPT => ['FPX', 'Microsoft PowerPoint Presentation'], |
470
|
|
|
|
|
|
|
PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'], |
471
|
|
|
|
|
|
|
PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'], |
472
|
|
|
|
|
|
|
PRC => ['PDB', 'Palm Database'], |
473
|
|
|
|
|
|
|
PS => ['PS', 'PostScript'], |
474
|
|
|
|
|
|
|
PS2 => 'PS', |
475
|
|
|
|
|
|
|
PS3 => 'PS', |
476
|
|
|
|
|
|
|
PSB => ['PSD', 'Photoshop Large Document'], |
477
|
|
|
|
|
|
|
PSD => ['PSD', 'Photoshop Document'], |
478
|
|
|
|
|
|
|
PSDT => ['PSD', 'Photoshop Document Template'], |
479
|
|
|
|
|
|
|
PSP => ['PSP', 'Paint Shop Pro'], |
480
|
|
|
|
|
|
|
PSPFRAME => 'PSP', |
481
|
|
|
|
|
|
|
PSPIMAGE => 'PSP', |
482
|
|
|
|
|
|
|
PSPSHAPE => 'PSP', |
483
|
|
|
|
|
|
|
PSPTUBE => 'PSP', |
484
|
|
|
|
|
|
|
QIF => 'QTIF', |
485
|
|
|
|
|
|
|
QT => 'MOV', |
486
|
|
|
|
|
|
|
QTI => 'QTIF', |
487
|
|
|
|
|
|
|
QTIF => ['QTIF', 'QuickTime Image File'], |
488
|
|
|
|
|
|
|
R3D => ['R3D', 'Redcode RAW Video'], |
489
|
|
|
|
|
|
|
RA => ['Real', 'Real Audio'], |
490
|
|
|
|
|
|
|
RAF => ['RAF', 'FujiFilm RAW Format'], |
491
|
|
|
|
|
|
|
RAM => ['Real', 'Real Audio Metafile'], |
492
|
|
|
|
|
|
|
RAR => ['RAR', 'RAR Archive'], |
493
|
|
|
|
|
|
|
RAW => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'], |
494
|
|
|
|
|
|
|
RIF => 'RIFF', |
495
|
|
|
|
|
|
|
RIFF => ['RIFF', 'Resource Interchange File Format'], |
496
|
|
|
|
|
|
|
RM => ['Real', 'Real Media'], |
497
|
|
|
|
|
|
|
RMVB => ['Real', 'Real Media Variable Bitrate'], |
498
|
|
|
|
|
|
|
RPM => ['Real', 'Real Media Plug-in Metafile'], |
499
|
|
|
|
|
|
|
RSRC => ['RSRC', 'Mac OS Resource'], |
500
|
|
|
|
|
|
|
RTF => ['RTF', 'Rich Text Format'], |
501
|
|
|
|
|
|
|
RV => ['Real', 'Real Video'], |
502
|
|
|
|
|
|
|
RW2 => ['TIFF', 'Panasonic RAW 2'], |
503
|
|
|
|
|
|
|
RWL => ['TIFF', 'Leica RAW'], |
504
|
|
|
|
|
|
|
RWZ => ['RWZ', 'Rawzor compressed image'], |
505
|
|
|
|
|
|
|
SEQ => ['FLIR', 'FLIR image Sequence'], |
506
|
|
|
|
|
|
|
SKETCH => ['ZIP', 'Sketch design file'], |
507
|
|
|
|
|
|
|
SO => ['EXE', 'Shared Object file'], |
508
|
|
|
|
|
|
|
SR2 => ['TIFF', 'Sony RAW Format 2'], |
509
|
|
|
|
|
|
|
SRF => ['TIFF', 'Sony RAW Format'], |
510
|
|
|
|
|
|
|
SRW => ['TIFF', 'Samsung RAW format'], |
511
|
|
|
|
|
|
|
SVG => ['XMP', 'Scalable Vector Graphics'], |
512
|
|
|
|
|
|
|
SWF => ['SWF', 'Shockwave Flash'], |
513
|
|
|
|
|
|
|
TAR => ['TAR', 'TAR archive'], |
514
|
|
|
|
|
|
|
THM => ['JPEG', 'Thumbnail'], |
515
|
|
|
|
|
|
|
THMX => [['ZIP','FPX'], 'Office Open XML Theme'], |
516
|
|
|
|
|
|
|
TIF => 'TIFF', |
517
|
|
|
|
|
|
|
TIFF => ['TIFF', 'Tagged Image File Format'], |
518
|
|
|
|
|
|
|
TORRENT => ['Torrent', 'BitTorrent description file'], |
519
|
|
|
|
|
|
|
TS => 'M2TS', |
520
|
|
|
|
|
|
|
TTC => ['Font', 'True Type Font Collection'], |
521
|
|
|
|
|
|
|
TTF => ['Font', 'True Type Font'], |
522
|
|
|
|
|
|
|
TUB => 'PSP', |
523
|
|
|
|
|
|
|
TXT => ['TXT', 'Text file'], |
524
|
|
|
|
|
|
|
VCARD=> ['VCard','Virtual Card'], |
525
|
|
|
|
|
|
|
VCF => 'VCARD', |
526
|
|
|
|
|
|
|
VOB => ['MPEG', 'Video Object'], |
527
|
|
|
|
|
|
|
VRD => ['VRD', 'Canon VRD Recipe Data'], |
528
|
|
|
|
|
|
|
VSD => ['FPX', 'Microsoft Visio Drawing'], |
529
|
|
|
|
|
|
|
WAV => ['RIFF', 'WAVeform (Windows digital audio)'], |
530
|
|
|
|
|
|
|
WDP => ['TIFF', 'Windows Media Photo'], |
531
|
|
|
|
|
|
|
WEBM => ['MKV', 'Google Web Movie'], |
532
|
|
|
|
|
|
|
WEBP => ['RIFF', 'Google Web Picture'], |
533
|
|
|
|
|
|
|
WMA => ['ASF', 'Windows Media Audio'], |
534
|
|
|
|
|
|
|
WMF => ['WMF', 'Windows Metafile Format'], |
535
|
|
|
|
|
|
|
WMV => ['ASF', 'Windows Media Video'], |
536
|
|
|
|
|
|
|
WV => ['RIFF', 'WavePack lossless audio'], |
537
|
|
|
|
|
|
|
X3F => ['X3F', 'Sigma RAW format'], |
538
|
|
|
|
|
|
|
XCF => ['XCF', 'GIMP native image format'], |
539
|
|
|
|
|
|
|
XHTML=> ['HTML', 'Extensible HyperText Markup Language'], |
540
|
|
|
|
|
|
|
XLA => ['FPX', 'Microsoft Excel Add-in'], |
541
|
|
|
|
|
|
|
XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'], |
542
|
|
|
|
|
|
|
XLS => ['FPX', 'Microsoft Excel Spreadsheet'], |
543
|
|
|
|
|
|
|
XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'], |
544
|
|
|
|
|
|
|
XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'], |
545
|
|
|
|
|
|
|
XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'], |
546
|
|
|
|
|
|
|
XLT => ['FPX', 'Microsoft Excel Template'], |
547
|
|
|
|
|
|
|
XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'], |
548
|
|
|
|
|
|
|
XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'], |
549
|
|
|
|
|
|
|
XMP => ['XMP', 'Extensible Metadata Platform'], |
550
|
|
|
|
|
|
|
WOFF => ['Font', 'Web Open Font Format'], |
551
|
|
|
|
|
|
|
WOFF2=> ['Font', 'Web Open Font Format2'], |
552
|
|
|
|
|
|
|
WTV => ['WTV', 'Windows recorded TV show'], |
553
|
|
|
|
|
|
|
ZIP => ['ZIP', 'ZIP archive'], |
554
|
|
|
|
|
|
|
); |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
# typical extension for each file type (if different than FileType) |
557
|
|
|
|
|
|
|
# - case is not significant |
558
|
|
|
|
|
|
|
my %fileTypeExt = ( |
559
|
|
|
|
|
|
|
'Canon 1D RAW' => 'tif', |
560
|
|
|
|
|
|
|
DICOM => 'dcm', |
561
|
|
|
|
|
|
|
FLIR => 'fff', |
562
|
|
|
|
|
|
|
GZIP => 'gz', |
563
|
|
|
|
|
|
|
JPEG => 'jpg', |
564
|
|
|
|
|
|
|
M2TS => 'mts', |
565
|
|
|
|
|
|
|
MPEG => 'mpg', |
566
|
|
|
|
|
|
|
TIFF => 'tif', |
567
|
|
|
|
|
|
|
VCard => 'vcf', |
568
|
|
|
|
|
|
|
); |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
# descriptions for file types not found in above file extension lookup |
571
|
|
|
|
|
|
|
my %fileDescription = ( |
572
|
|
|
|
|
|
|
DICOM => 'Digital Imaging and Communications in Medicine', |
573
|
|
|
|
|
|
|
XML => 'Extensible Markup Language', |
574
|
|
|
|
|
|
|
'Win32 EXE' => 'Windows 32-bit Executable', |
575
|
|
|
|
|
|
|
'Win32 DLL' => 'Windows 32-bit Dynamic Link Library', |
576
|
|
|
|
|
|
|
'Win64 EXE' => 'Windows 64-bit Executable', |
577
|
|
|
|
|
|
|
'Win64 DLL' => 'Windows 64-bit Dynamic Link Library', |
578
|
|
|
|
|
|
|
); |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
# MIME types for applicable file types above |
581
|
|
|
|
|
|
|
# (missing entries default to 'application/unknown', but note that other MIME |
582
|
|
|
|
|
|
|
# types may be specified by some modules, eg. QuickTime.pm and RIFF.pm) |
583
|
|
|
|
|
|
|
%mimeType = ( |
584
|
|
|
|
|
|
|
'3FR' => 'image/x-hasselblad-3fr', |
585
|
|
|
|
|
|
|
AA => 'audio/audible', |
586
|
|
|
|
|
|
|
AAE => 'application/vnd.apple.photos', |
587
|
|
|
|
|
|
|
AI => 'application/vnd.adobe.illustrator', |
588
|
|
|
|
|
|
|
AIFF => 'audio/x-aiff', |
589
|
|
|
|
|
|
|
ALIAS=> 'application/x-macos', |
590
|
|
|
|
|
|
|
APE => 'audio/x-monkeys-audio', |
591
|
|
|
|
|
|
|
APNG => 'image/apng', |
592
|
|
|
|
|
|
|
ASF => 'video/x-ms-asf', |
593
|
|
|
|
|
|
|
ARW => 'image/x-sony-arw', |
594
|
|
|
|
|
|
|
BMP => 'image/bmp', |
595
|
|
|
|
|
|
|
BPG => 'image/bpg', |
596
|
|
|
|
|
|
|
BTF => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html) |
597
|
|
|
|
|
|
|
BZ2 => 'application/bzip2', |
598
|
|
|
|
|
|
|
'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension) |
599
|
|
|
|
|
|
|
CHM => 'application/x-chm', |
600
|
|
|
|
|
|
|
COS => 'application/octet-stream', #PH (NC) |
601
|
|
|
|
|
|
|
CR2 => 'image/x-canon-cr2', |
602
|
|
|
|
|
|
|
CR3 => 'image/x-canon-cr3', |
603
|
|
|
|
|
|
|
CRM => 'video/x-canon-crm', |
604
|
|
|
|
|
|
|
CRW => 'image/x-canon-crw', |
605
|
|
|
|
|
|
|
CSV => 'text/csv', |
606
|
|
|
|
|
|
|
CUR => 'image/x-cursor', #PH (NC) |
607
|
|
|
|
|
|
|
CZI => 'image/x-zeiss-czi', #PH (NC) |
608
|
|
|
|
|
|
|
DCP => 'application/octet-stream', #PH (NC) |
609
|
|
|
|
|
|
|
DCR => 'image/x-kodak-dcr', |
610
|
|
|
|
|
|
|
DCX => 'image/dcx', |
611
|
|
|
|
|
|
|
DEX => 'application/octet-stream', |
612
|
|
|
|
|
|
|
DFONT=> 'application/x-dfont', |
613
|
|
|
|
|
|
|
DICOM=> 'application/dicom', |
614
|
|
|
|
|
|
|
DIVX => 'video/divx', |
615
|
|
|
|
|
|
|
DJVU => 'image/vnd.djvu', |
616
|
|
|
|
|
|
|
DNG => 'image/x-adobe-dng', |
617
|
|
|
|
|
|
|
DOC => 'application/msword', |
618
|
|
|
|
|
|
|
DOCM => 'application/vnd.ms-word.document.macroEnabled.12', |
619
|
|
|
|
|
|
|
DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document', |
620
|
|
|
|
|
|
|
DOT => 'application/msword', |
621
|
|
|
|
|
|
|
DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate', |
622
|
|
|
|
|
|
|
DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template', |
623
|
|
|
|
|
|
|
DPX => 'image/x-dpx', |
624
|
|
|
|
|
|
|
DR4 => 'application/octet-stream', #PH (NC) |
625
|
|
|
|
|
|
|
DS2 => 'audio/x-ds2', |
626
|
|
|
|
|
|
|
DSS => 'audio/x-dss', |
627
|
|
|
|
|
|
|
DV => 'video/x-dv', |
628
|
|
|
|
|
|
|
'DVR-MS' => 'video/x-ms-dvr', |
629
|
|
|
|
|
|
|
DWF => 'model/vnd.dwf', |
630
|
|
|
|
|
|
|
DWG => 'image/vnd.dwg', |
631
|
|
|
|
|
|
|
DXF => 'application/dxf', |
632
|
|
|
|
|
|
|
EIP => 'application/x-captureone', #(NC) |
633
|
|
|
|
|
|
|
EPS => 'application/postscript', |
634
|
|
|
|
|
|
|
ERF => 'image/x-epson-erf', |
635
|
|
|
|
|
|
|
EXE => 'application/octet-stream', |
636
|
|
|
|
|
|
|
EXR => 'image/x-exr', |
637
|
|
|
|
|
|
|
EXV => 'image/x-exv', |
638
|
|
|
|
|
|
|
FFF => 'image/x-hasselblad-fff', |
639
|
|
|
|
|
|
|
FITS => 'image/fits', |
640
|
|
|
|
|
|
|
FLA => 'application/vnd.adobe.fla', |
641
|
|
|
|
|
|
|
FLAC => 'audio/flac', |
642
|
|
|
|
|
|
|
FLIF => 'image/flif', |
643
|
|
|
|
|
|
|
FLIR => 'image/x-flir-fff', #PH (NC) |
644
|
|
|
|
|
|
|
FLV => 'video/x-flv', |
645
|
|
|
|
|
|
|
Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM) |
646
|
|
|
|
|
|
|
FPF => 'image/x-flir-fpf', #PH (NC) |
647
|
|
|
|
|
|
|
FPX => 'image/vnd.fpx', |
648
|
|
|
|
|
|
|
GIF => 'image/gif', |
649
|
|
|
|
|
|
|
GPR => 'image/x-gopro-gpr', |
650
|
|
|
|
|
|
|
GZIP => 'application/x-gzip', |
651
|
|
|
|
|
|
|
HDP => 'image/vnd.ms-photo', |
652
|
|
|
|
|
|
|
HDR => 'image/vnd.radiance', |
653
|
|
|
|
|
|
|
HTML => 'text/html', |
654
|
|
|
|
|
|
|
ICC => 'application/vnd.iccprofile', |
655
|
|
|
|
|
|
|
ICO => 'image/x-icon', #PH (NC) |
656
|
|
|
|
|
|
|
ICS => 'text/calendar', |
657
|
|
|
|
|
|
|
IDML => 'application/vnd.adobe.indesign-idml-package', |
658
|
|
|
|
|
|
|
IIQ => 'image/x-raw', |
659
|
|
|
|
|
|
|
IND => 'application/x-indesign', |
660
|
|
|
|
|
|
|
INX => 'application/x-indesign-interchange', #PH (NC) |
661
|
|
|
|
|
|
|
ISO => 'application/x-iso9660-image', |
662
|
|
|
|
|
|
|
ITC => 'application/itunes', |
663
|
|
|
|
|
|
|
J2C => 'image/x-j2c', #PH (NC) |
664
|
|
|
|
|
|
|
JNG => 'image/jng', |
665
|
|
|
|
|
|
|
JP2 => 'image/jp2', |
666
|
|
|
|
|
|
|
JPEG => 'image/jpeg', |
667
|
|
|
|
|
|
|
JPM => 'image/jpm', |
668
|
|
|
|
|
|
|
JPS => 'image/x-jps', |
669
|
|
|
|
|
|
|
JPX => 'image/jpx', |
670
|
|
|
|
|
|
|
JSON => 'application/json', |
671
|
|
|
|
|
|
|
JXL => 'image/jxl', #PH (NC) |
672
|
|
|
|
|
|
|
JXR => 'image/jxr', |
673
|
|
|
|
|
|
|
K25 => 'image/x-kodak-k25', |
674
|
|
|
|
|
|
|
KDC => 'image/x-kodak-kdc', |
675
|
|
|
|
|
|
|
KEY => 'application/x-iwork-keynote-sffkey', |
676
|
|
|
|
|
|
|
LFP => 'image/x-lytro-lfp', #PH (NC) |
677
|
|
|
|
|
|
|
LIF => 'image/x-lif', |
678
|
|
|
|
|
|
|
LNK => 'application/octet-stream', |
679
|
|
|
|
|
|
|
LRI => 'image/x-light-lri', |
680
|
|
|
|
|
|
|
M2T => 'video/mpeg', |
681
|
|
|
|
|
|
|
M2TS => 'video/m2ts', |
682
|
|
|
|
|
|
|
MAX => 'application/x-3ds', |
683
|
|
|
|
|
|
|
MEF => 'image/x-mamiya-mef', |
684
|
|
|
|
|
|
|
MIE => 'application/x-mie', |
685
|
|
|
|
|
|
|
MIFF => 'application/x-magick-image', |
686
|
|
|
|
|
|
|
MKA => 'audio/x-matroska', |
687
|
|
|
|
|
|
|
MKS => 'application/x-matroska', |
688
|
|
|
|
|
|
|
MKV => 'video/x-matroska', |
689
|
|
|
|
|
|
|
MNG => 'video/mng', |
690
|
|
|
|
|
|
|
MOBI => 'application/x-mobipocket-ebook', |
691
|
|
|
|
|
|
|
MOI => 'application/octet-stream', #PH (NC) |
692
|
|
|
|
|
|
|
MOS => 'image/x-raw', |
693
|
|
|
|
|
|
|
MOV => 'video/quicktime', |
694
|
|
|
|
|
|
|
MP3 => 'audio/mpeg', |
695
|
|
|
|
|
|
|
MP4 => 'video/mp4', |
696
|
|
|
|
|
|
|
MPC => 'audio/x-musepack', |
697
|
|
|
|
|
|
|
MPEG => 'video/mpeg', |
698
|
|
|
|
|
|
|
MRC => 'image/x-mrc', |
699
|
|
|
|
|
|
|
MRW => 'image/x-minolta-mrw', |
700
|
|
|
|
|
|
|
MXF => 'application/mxf', |
701
|
|
|
|
|
|
|
NEF => 'image/x-nikon-nef', |
702
|
|
|
|
|
|
|
NKSC => 'application/x-nikon-nxstudio', |
703
|
|
|
|
|
|
|
NRW => 'image/x-nikon-nrw', |
704
|
|
|
|
|
|
|
NUMBERS => 'application/x-iwork-numbers-sffnumbers', |
705
|
|
|
|
|
|
|
ODB => 'application/vnd.oasis.opendocument.database', |
706
|
|
|
|
|
|
|
ODC => 'application/vnd.oasis.opendocument.chart', |
707
|
|
|
|
|
|
|
ODF => 'application/vnd.oasis.opendocument.formula', |
708
|
|
|
|
|
|
|
ODG => 'application/vnd.oasis.opendocument.graphics', |
709
|
|
|
|
|
|
|
ODI => 'application/vnd.oasis.opendocument.image', |
710
|
|
|
|
|
|
|
ODP => 'application/vnd.oasis.opendocument.presentation', |
711
|
|
|
|
|
|
|
ODS => 'application/vnd.oasis.opendocument.spreadsheet', |
712
|
|
|
|
|
|
|
ODT => 'application/vnd.oasis.opendocument.text', |
713
|
|
|
|
|
|
|
OGG => 'audio/ogg', |
714
|
|
|
|
|
|
|
OGV => 'video/ogg', |
715
|
|
|
|
|
|
|
ONP => 'application/on1', |
716
|
|
|
|
|
|
|
ORF => 'image/x-olympus-orf', |
717
|
|
|
|
|
|
|
OTF => 'application/x-font-otf', |
718
|
|
|
|
|
|
|
PAGES=> 'application/x-iwork-pages-sffpages', |
719
|
|
|
|
|
|
|
PBM => 'image/x-portable-bitmap', |
720
|
|
|
|
|
|
|
PCD => 'image/x-photo-cd', |
721
|
|
|
|
|
|
|
PCX => 'image/pcx', |
722
|
|
|
|
|
|
|
PDB => 'application/vnd.palm', |
723
|
|
|
|
|
|
|
PDF => 'application/pdf', |
724
|
|
|
|
|
|
|
PEF => 'image/x-pentax-pef', |
725
|
|
|
|
|
|
|
PFA => 'application/x-font-type1', # (needed if handled by PostScript module) |
726
|
|
|
|
|
|
|
PGF => 'image/pgf', |
727
|
|
|
|
|
|
|
PGM => 'image/x-portable-graymap', |
728
|
|
|
|
|
|
|
PHP => 'application/x-httpd-php', |
729
|
|
|
|
|
|
|
PICT => 'image/pict', |
730
|
|
|
|
|
|
|
PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time) |
731
|
|
|
|
|
|
|
PMP => 'image/x-sony-pmp', #PH (NC) |
732
|
|
|
|
|
|
|
PNG => 'image/png', |
733
|
|
|
|
|
|
|
POT => 'application/vnd.ms-powerpoint', |
734
|
|
|
|
|
|
|
POTM => 'application/vnd.ms-powerpoint.template.macroEnabled.12', |
735
|
|
|
|
|
|
|
POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template', |
736
|
|
|
|
|
|
|
PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled.12', |
737
|
|
|
|
|
|
|
PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented) |
738
|
|
|
|
|
|
|
PPM => 'image/x-portable-pixmap', |
739
|
|
|
|
|
|
|
PPS => 'application/vnd.ms-powerpoint', |
740
|
|
|
|
|
|
|
PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled.12', |
741
|
|
|
|
|
|
|
PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow', |
742
|
|
|
|
|
|
|
PPT => 'application/vnd.ms-powerpoint', |
743
|
|
|
|
|
|
|
PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled.12', |
744
|
|
|
|
|
|
|
PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation', |
745
|
|
|
|
|
|
|
PS => 'application/postscript', |
746
|
|
|
|
|
|
|
PSD => 'application/vnd.adobe.photoshop', |
747
|
|
|
|
|
|
|
PSP => 'image/x-paintshoppro', #(NC) |
748
|
|
|
|
|
|
|
QTIF => 'image/x-quicktime', |
749
|
|
|
|
|
|
|
R3D => 'video/x-red-r3d', #PH (invented) |
750
|
|
|
|
|
|
|
RA => 'audio/x-pn-realaudio', |
751
|
|
|
|
|
|
|
RAF => 'image/x-fujifilm-raf', |
752
|
|
|
|
|
|
|
RAM => 'audio/x-pn-realaudio', |
753
|
|
|
|
|
|
|
RAR => 'application/x-rar-compressed', |
754
|
|
|
|
|
|
|
RAW => 'image/x-raw', |
755
|
|
|
|
|
|
|
RM => 'application/vnd.rn-realmedia', |
756
|
|
|
|
|
|
|
RMVB => 'application/vnd.rn-realmedia-vbr', |
757
|
|
|
|
|
|
|
RPM => 'audio/x-pn-realaudio-plugin', |
758
|
|
|
|
|
|
|
RSRC => 'application/ResEdit', |
759
|
|
|
|
|
|
|
RTF => 'text/rtf', |
760
|
|
|
|
|
|
|
RV => 'video/vnd.rn-realvideo', |
761
|
|
|
|
|
|
|
RW2 => 'image/x-panasonic-rw2', |
762
|
|
|
|
|
|
|
RWL => 'image/x-leica-rwl', |
763
|
|
|
|
|
|
|
RWZ => 'image/x-rawzor', #(duplicated in Rawzor.pm) |
764
|
|
|
|
|
|
|
SEQ => 'image/x-flir-seq', #PH (NC) |
765
|
|
|
|
|
|
|
SKETCH => 'application/sketch', |
766
|
|
|
|
|
|
|
SR2 => 'image/x-sony-sr2', |
767
|
|
|
|
|
|
|
SRF => 'image/x-sony-srf', |
768
|
|
|
|
|
|
|
SRW => 'image/x-samsung-srw', |
769
|
|
|
|
|
|
|
SVG => 'image/svg+xml', |
770
|
|
|
|
|
|
|
SWF => 'application/x-shockwave-flash', |
771
|
|
|
|
|
|
|
TAR => 'application/x-tar', |
772
|
|
|
|
|
|
|
THMX => 'application/vnd.ms-officetheme', |
773
|
|
|
|
|
|
|
TIFF => 'image/tiff', |
774
|
|
|
|
|
|
|
Torrent => 'application/x-bittorrent', |
775
|
|
|
|
|
|
|
TTC => 'application/x-font-ttf', |
776
|
|
|
|
|
|
|
TTF => 'application/x-font-ttf', |
777
|
|
|
|
|
|
|
TXT => 'text/plain', |
778
|
|
|
|
|
|
|
VCard=> 'text/vcard', |
779
|
|
|
|
|
|
|
VRD => 'application/octet-stream', #PH (NC) |
780
|
|
|
|
|
|
|
VSD => 'application/x-visio', |
781
|
|
|
|
|
|
|
WDP => 'image/vnd.ms-photo', |
782
|
|
|
|
|
|
|
WEBM => 'video/webm', |
783
|
|
|
|
|
|
|
WMA => 'audio/x-ms-wma', |
784
|
|
|
|
|
|
|
WMF => 'application/x-wmf', |
785
|
|
|
|
|
|
|
WMV => 'video/x-ms-wmv', |
786
|
|
|
|
|
|
|
WTV => 'video/x-ms-wtv', |
787
|
|
|
|
|
|
|
X3F => 'image/x-sigma-x3f', |
788
|
|
|
|
|
|
|
XCF => 'image/x-xcf', |
789
|
|
|
|
|
|
|
XLA => 'application/vnd.ms-excel', |
790
|
|
|
|
|
|
|
XLAM => 'application/vnd.ms-excel.addin.macroEnabled.12', |
791
|
|
|
|
|
|
|
XLS => 'application/vnd.ms-excel', |
792
|
|
|
|
|
|
|
XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled.12', |
793
|
|
|
|
|
|
|
XLSM => 'application/vnd.ms-excel.sheet.macroEnabled.12', |
794
|
|
|
|
|
|
|
XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', |
795
|
|
|
|
|
|
|
XLT => 'application/vnd.ms-excel', |
796
|
|
|
|
|
|
|
XLTM => 'application/vnd.ms-excel.template.macroEnabled.12', |
797
|
|
|
|
|
|
|
XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template', |
798
|
|
|
|
|
|
|
XML => 'application/xml', |
799
|
|
|
|
|
|
|
XMP => 'application/rdf+xml', |
800
|
|
|
|
|
|
|
ZIP => 'application/zip', |
801
|
|
|
|
|
|
|
); |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
# module names for processing routines of each file type |
804
|
|
|
|
|
|
|
# - undefined entries default to same module name as file type |
805
|
|
|
|
|
|
|
# - module name '' defaults to Image::ExifTool |
806
|
|
|
|
|
|
|
# - module name '0' indicates a recognized but unsupported file |
807
|
|
|
|
|
|
|
my %moduleName = ( |
808
|
|
|
|
|
|
|
AA => 'Audible', |
809
|
|
|
|
|
|
|
ALIAS=> 0, |
810
|
|
|
|
|
|
|
AVC => 0, |
811
|
|
|
|
|
|
|
BTF => 'BigTIFF', |
812
|
|
|
|
|
|
|
BZ2 => 0, |
813
|
|
|
|
|
|
|
CRW => 'CanonRaw', |
814
|
|
|
|
|
|
|
CHM => 'EXE', |
815
|
|
|
|
|
|
|
COS => 'CaptureOne', |
816
|
|
|
|
|
|
|
CZI => 'ZISRAW', |
817
|
|
|
|
|
|
|
DEX => 0, |
818
|
|
|
|
|
|
|
DOCX => 'OOXML', |
819
|
|
|
|
|
|
|
DCX => 0, |
820
|
|
|
|
|
|
|
DIR => 0, |
821
|
|
|
|
|
|
|
DR4 => 'CanonVRD', |
822
|
|
|
|
|
|
|
DSS => 'Olympus', |
823
|
|
|
|
|
|
|
DWF => 0, |
824
|
|
|
|
|
|
|
DWG => 0, |
825
|
|
|
|
|
|
|
DXF => 0, |
826
|
|
|
|
|
|
|
EPS => 'PostScript', |
827
|
|
|
|
|
|
|
EXIF => '', |
828
|
|
|
|
|
|
|
EXR => 'OpenEXR', |
829
|
|
|
|
|
|
|
EXV => '', |
830
|
|
|
|
|
|
|
ICC => 'ICC_Profile', |
831
|
|
|
|
|
|
|
IND => 'InDesign', |
832
|
|
|
|
|
|
|
FLV => 'Flash', |
833
|
|
|
|
|
|
|
FPF => 'FLIR', |
834
|
|
|
|
|
|
|
FPX => 'FlashPix', |
835
|
|
|
|
|
|
|
GZIP => 'ZIP', |
836
|
|
|
|
|
|
|
HDR => 'Radiance', |
837
|
|
|
|
|
|
|
JP2 => 'Jpeg2000', |
838
|
|
|
|
|
|
|
JPEG => '', |
839
|
|
|
|
|
|
|
JXL => 'Jpeg2000', |
840
|
|
|
|
|
|
|
LFP => 'Lytro', |
841
|
|
|
|
|
|
|
LRI => 0, |
842
|
|
|
|
|
|
|
MOV => 'QuickTime', |
843
|
|
|
|
|
|
|
MKV => 'Matroska', |
844
|
|
|
|
|
|
|
MP3 => 'ID3', |
845
|
|
|
|
|
|
|
MRW => 'MinoltaRaw', |
846
|
|
|
|
|
|
|
OGG => 'Ogg', |
847
|
|
|
|
|
|
|
ORF => 'Olympus', |
848
|
|
|
|
|
|
|
PDB => 'Palm', |
849
|
|
|
|
|
|
|
PCD => 'PhotoCD', |
850
|
|
|
|
|
|
|
PFM2 => 'Other', |
851
|
|
|
|
|
|
|
PHP => 0, |
852
|
|
|
|
|
|
|
PMP => 'Sony', |
853
|
|
|
|
|
|
|
PS => 'PostScript', |
854
|
|
|
|
|
|
|
PSD => 'Photoshop', |
855
|
|
|
|
|
|
|
QTIF => 'QuickTime', |
856
|
|
|
|
|
|
|
R3D => 'Red', |
857
|
|
|
|
|
|
|
RAF => 'FujiFilm', |
858
|
|
|
|
|
|
|
RAR => 'ZIP', |
859
|
|
|
|
|
|
|
RAW => 'KyoceraRaw', |
860
|
|
|
|
|
|
|
RWZ => 'Rawzor', |
861
|
|
|
|
|
|
|
SWF => 'Flash', |
862
|
|
|
|
|
|
|
TAR => 0, |
863
|
|
|
|
|
|
|
TIFF => '', |
864
|
|
|
|
|
|
|
TXT => 'Text', |
865
|
|
|
|
|
|
|
VRD => 'CanonVRD', |
866
|
|
|
|
|
|
|
WMF => 0, |
867
|
|
|
|
|
|
|
X3F => 'SigmaRaw', |
868
|
|
|
|
|
|
|
XCF => 'GIMP', |
869
|
|
|
|
|
|
|
); |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
$testLen = 1024; # number of bytes to read when testing for magic number |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
# quick "magic number" file test used to avoid loading module unnecessarily: |
874
|
|
|
|
|
|
|
# - regular expression evaluated on first $testLen bytes of file |
875
|
|
|
|
|
|
|
# - must match beginning at first byte in file |
876
|
|
|
|
|
|
|
# - this test must not be more stringent than module logic |
877
|
|
|
|
|
|
|
%magicNumber = ( |
878
|
|
|
|
|
|
|
AA => '.{4}\x57\x90\x75\x36', |
879
|
|
|
|
|
|
|
AIFF => '(FORM....AIF[FC]|AT&TFORM)', |
880
|
|
|
|
|
|
|
ALIAS=> "book\0\0\0\0mark\0\0\0\0", |
881
|
|
|
|
|
|
|
APE => '(MAC |APETAGEX|ID3)', |
882
|
|
|
|
|
|
|
ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c', |
883
|
|
|
|
|
|
|
AVC => '\+A\+V\+C\+', |
884
|
|
|
|
|
|
|
Torrent => 'd\d+:\w+', |
885
|
|
|
|
|
|
|
BMP => 'BM', |
886
|
|
|
|
|
|
|
BPG => "BPG\xfb", |
887
|
|
|
|
|
|
|
BTF => '(II\x2b\0|MM\0\x2b)', |
888
|
|
|
|
|
|
|
BZ2 => 'BZh[1-9]\x31\x41\x59\x26\x53\x59', |
889
|
|
|
|
|
|
|
CHM => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec', |
890
|
|
|
|
|
|
|
CRW => '(II|MM).{4}HEAP(CCDR|JPGM)', |
891
|
|
|
|
|
|
|
CZI => 'ZISRAWFILE\0{6}', |
892
|
|
|
|
|
|
|
DCX => '\xb1\x68\xde\x3a', |
893
|
|
|
|
|
|
|
DEX => "dex\n035\0", |
894
|
|
|
|
|
|
|
DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)', |
895
|
|
|
|
|
|
|
DOCX => 'PK\x03\x04', |
896
|
|
|
|
|
|
|
DPX => '(SDPX|XPDS)', |
897
|
|
|
|
|
|
|
DR4 => 'IIII\x04\0\x04\0', |
898
|
|
|
|
|
|
|
DSS => '(\x02dss|\x03ds2)', |
899
|
|
|
|
|
|
|
DV => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized) |
900
|
|
|
|
|
|
|
DWF => '\(DWF V\d', |
901
|
|
|
|
|
|
|
DWG => 'AC10\d{2}\0', |
902
|
|
|
|
|
|
|
DXF => '\s*0\s+\0?\s*SECTION\s+2\s+HEADER', |
903
|
|
|
|
|
|
|
EPS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', |
904
|
|
|
|
|
|
|
EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!\x0a)', |
905
|
|
|
|
|
|
|
EXIF => '(II\x2a\0|MM\0\x2a)', |
906
|
|
|
|
|
|
|
EXR => '\x76\x2f\x31\x01', |
907
|
|
|
|
|
|
|
EXV => '\xff\x01Exiv2', |
908
|
|
|
|
|
|
|
FITS => 'SIMPLE = {20}T', |
909
|
|
|
|
|
|
|
FLAC => '(fLaC|ID3)', |
910
|
|
|
|
|
|
|
FLIF => 'FLIF[0-\x6f][0-2]', |
911
|
|
|
|
|
|
|
FLIR => '[AF]FF\0', |
912
|
|
|
|
|
|
|
FLV => 'FLV\x01', |
913
|
|
|
|
|
|
|
Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' . |
914
|
|
|
|
|
|
|
'(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])', |
915
|
|
|
|
|
|
|
FPF => 'FPF Public Image Format\0', |
916
|
|
|
|
|
|
|
FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1', |
917
|
|
|
|
|
|
|
GIF => 'GIF8[79]a', |
918
|
|
|
|
|
|
|
GZIP => '\x1f\x8b\x08', |
919
|
|
|
|
|
|
|
HDR => '#\?(RADIANCE|RGBE)\x0a', |
920
|
|
|
|
|
|
|
HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive) |
921
|
|
|
|
|
|
|
ICC => '.{12}(scnr|mntr|prtr|link|spac|abst|nmcl|nkpf|cenc|mid |mlnk|mvis)(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR|nc..|\0{4}){2}', |
922
|
|
|
|
|
|
|
ICO => '\0\0[\x01\x02]\0[^0]\0', # (reasonably assume that the file contains less than 256 images) |
923
|
|
|
|
|
|
|
IND => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d', |
924
|
|
|
|
|
|
|
# ISO => signature is at byte 32768 |
925
|
|
|
|
|
|
|
ITC => '.{4}itch', |
926
|
|
|
|
|
|
|
JP2 => '(\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)', |
927
|
|
|
|
|
|
|
JPEG => '\xff\xd8\xff', |
928
|
|
|
|
|
|
|
JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:', |
929
|
|
|
|
|
|
|
JXL => '\xff\x0a|\0\0\0\x0cJXL \x0d\x0a......ftypjxl ', |
930
|
|
|
|
|
|
|
LFP => '\x89LFP\x0d\x0a\x1a\x0a', |
931
|
|
|
|
|
|
|
LIF => '\x70\0{3}.{4}\x2a.{4}<\0', |
932
|
|
|
|
|
|
|
LNK => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46', |
933
|
|
|
|
|
|
|
LRI => 'LELR \0', |
934
|
|
|
|
|
|
|
M2TS => '(....)?\x47', |
935
|
|
|
|
|
|
|
MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X ', |
936
|
|
|
|
|
|
|
MIE => '~[\x10\x18]\x04.0MIE', |
937
|
|
|
|
|
|
|
MIFF => 'id=ImageMagick', |
938
|
|
|
|
|
|
|
MKV => '\x1a\x45\xdf\xa3', |
939
|
|
|
|
|
|
|
MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!) |
940
|
|
|
|
|
|
|
# MP3 => difficult to rule out |
941
|
|
|
|
|
|
|
MPC => '(MP\+|ID3)', |
942
|
|
|
|
|
|
|
MOI => 'V6', |
943
|
|
|
|
|
|
|
MPEG => '\0\0\x01[\xb0-\xbf]', |
944
|
|
|
|
|
|
|
MRC => '.{64}[\x01\x02\x03]\0\0\0[\x01\x02\x03]\0\0\0[\x01\x02\x03]\0\0\0.{132}MAP[\0 ](\x44\x44|\x44\x41|\x11\x11)\0\0', |
945
|
|
|
|
|
|
|
MRW => '\0MR[MI]', |
946
|
|
|
|
|
|
|
MXF => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized) |
947
|
|
|
|
|
|
|
OGG => '(OggS|ID3)', |
948
|
|
|
|
|
|
|
ORF => '(II|MM)', |
949
|
|
|
|
|
|
|
# PCD => signature is at byte 2048 |
950
|
|
|
|
|
|
|
PCX => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]', |
951
|
|
|
|
|
|
|
PDB => '.{60}(\.pdfADBE|TEXtREAd|BVokBDIC|DB99DBOS|PNRdPPrs|DataPPrs|vIMGView|PmDBPmDB|InfoINDB|ToGoToGo|SDocSilX|JbDbJBas|JfDbJFil|DATALSdb|Mdb1Mdb1|BOOKMOBI|DataPlkr|DataSprd|SM01SMem|TEXtTlDc|InfoTlIf|DataTlMl|DataTlPt|dataTDBP|TdatTide|ToRaTRPW|zTXTGPlm|BDOCWrdS)', |
952
|
|
|
|
|
|
|
PDF => '\s*%PDF-\d+\.\d+', |
953
|
|
|
|
|
|
|
PFM => 'P[Ff]\x0a\d+ \d+\x0a[-+0-9.]+\x0a', |
954
|
|
|
|
|
|
|
PGF => 'PGF', |
955
|
|
|
|
|
|
|
PHP => '<\?php\s', |
956
|
|
|
|
|
|
|
PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)', |
957
|
|
|
|
|
|
|
PLIST=> '(bplist0|\s*<|\xfe\xff\x00)', |
958
|
|
|
|
|
|
|
PMP => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb', |
959
|
|
|
|
|
|
|
PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n', |
960
|
|
|
|
|
|
|
PPM => 'P[1-6]\s+', |
961
|
|
|
|
|
|
|
PS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', |
962
|
|
|
|
|
|
|
PSD => '8BPS\0[\x01\x02]', |
963
|
|
|
|
|
|
|
PSP => 'Paint Shop Pro Image File\x0a\x1a\0{5}', |
964
|
|
|
|
|
|
|
QTIF => '.{4}(idsc|idat|iicc)', |
965
|
|
|
|
|
|
|
R3D => '\0\0..RED(1|2)', |
966
|
|
|
|
|
|
|
RAF => 'FUJIFILM', |
967
|
|
|
|
|
|
|
RAR => 'Rar!\x1a\x07\0', |
968
|
|
|
|
|
|
|
RAW => '(.{25}ARECOYK|II|MM)', |
969
|
|
|
|
|
|
|
Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)', |
970
|
|
|
|
|
|
|
RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants |
971
|
|
|
|
|
|
|
RSRC => '(....)?\0\0\x01\0', |
972
|
|
|
|
|
|
|
RTF => '[\n\r]*\\{[\n\r]*\\\\rtf', |
973
|
|
|
|
|
|
|
RWZ => 'rawzor', |
974
|
|
|
|
|
|
|
SWF => '[FC]WS[^\0]', |
975
|
|
|
|
|
|
|
TAR => '.{257}ustar( )?\0', # (this doesn't catch old-style tar files) |
976
|
|
|
|
|
|
|
TXT => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)', |
977
|
|
|
|
|
|
|
TIFF => '(II|MM)', # don't test magic number (some raw formats are different) |
978
|
|
|
|
|
|
|
VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n', |
979
|
|
|
|
|
|
|
VRD => 'CANON OPTIONAL DATA\0', |
980
|
|
|
|
|
|
|
WMF => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)', |
981
|
|
|
|
|
|
|
WTV => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d', |
982
|
|
|
|
|
|
|
X3F => 'FOVb', |
983
|
|
|
|
|
|
|
XCF => 'gimp xcf ', |
984
|
|
|
|
|
|
|
XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<', |
985
|
|
|
|
|
|
|
ZIP => 'PK\x03\x04', |
986
|
|
|
|
|
|
|
); |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
# file types with weak magic number recognition |
989
|
|
|
|
|
|
|
my %weakMagic = ( MP3 => 1 ); |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
# file types that are determined by the process proc when FastScan == 3 |
992
|
|
|
|
|
|
|
# (when done, the process proc must exit after SetFileType if FastScan is 3) |
993
|
|
|
|
|
|
|
my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT); |
994
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
# Compact/XMPShorthand option settings |
996
|
|
|
|
|
|
|
my %compactOpt = ( |
997
|
|
|
|
|
|
|
nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline', |
998
|
|
|
|
|
|
|
shorthand => 'Shorthand', onedesc => 'OneDesc', |
999
|
|
|
|
|
|
|
all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'], |
1000
|
|
|
|
|
|
|
allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'], |
1001
|
|
|
|
|
|
|
# aliases to cover anticipated user typos |
1002
|
|
|
|
|
|
|
nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent', |
1003
|
|
|
|
|
|
|
nopad => 'NoPadding', onedescr => 'OneDesc', |
1004
|
|
|
|
|
|
|
# allow numerical settings for backward compatibility |
1005
|
|
|
|
|
|
|
0 => 'None', |
1006
|
|
|
|
|
|
|
1 => 'NoPadding', |
1007
|
|
|
|
|
|
|
2 => ['NoPadding','NoIndent'], |
1008
|
|
|
|
|
|
|
3 => ['NoPadding','NoIndent','OneDesc'], |
1009
|
|
|
|
|
|
|
4 => ['NoPadding','NoIndent','OneDesc','NoNewline'], |
1010
|
|
|
|
|
|
|
5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'], |
1011
|
|
|
|
|
|
|
); |
1012
|
|
|
|
|
|
|
my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] ); |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
# lookup for valid character set names (keys are all lower case) |
1015
|
|
|
|
|
|
|
%charsetName = ( |
1016
|
|
|
|
|
|
|
# Charset setting alias(es) |
1017
|
|
|
|
|
|
|
# ------------------------- -------------------------------------------- |
1018
|
|
|
|
|
|
|
utf8 => 'UTF8', cp65001 => 'UTF8', 'utf-8' => 'UTF8', |
1019
|
|
|
|
|
|
|
latin => 'Latin', cp1252 => 'Latin', latin1 => 'Latin', |
1020
|
|
|
|
|
|
|
latin2 => 'Latin2', cp1250 => 'Latin2', |
1021
|
|
|
|
|
|
|
cyrillic => 'Cyrillic', cp1251 => 'Cyrillic', russian => 'Cyrillic', |
1022
|
|
|
|
|
|
|
greek => 'Greek', cp1253 => 'Greek', |
1023
|
|
|
|
|
|
|
turkish => 'Turkish', cp1254 => 'Turkish', |
1024
|
|
|
|
|
|
|
hebrew => 'Hebrew', cp1255 => 'Hebrew', |
1025
|
|
|
|
|
|
|
arabic => 'Arabic', cp1256 => 'Arabic', |
1026
|
|
|
|
|
|
|
baltic => 'Baltic', cp1257 => 'Baltic', |
1027
|
|
|
|
|
|
|
vietnam => 'Vietnam', cp1258 => 'Vietnam', |
1028
|
|
|
|
|
|
|
thai => 'Thai', cp874 => 'Thai', |
1029
|
|
|
|
|
|
|
doslatinus => 'DOSLatinUS', cp437 => 'DOSLatinUS', |
1030
|
|
|
|
|
|
|
doslatin1 => 'DOSLatin1', cp850 => 'DOSLatin1', |
1031
|
|
|
|
|
|
|
doscyrillic => 'DOSCyrillic', cp866 => 'DOSCyrillic', |
1032
|
|
|
|
|
|
|
macroman => 'MacRoman', cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman', |
1033
|
|
|
|
|
|
|
maclatin2 => 'MacLatin2', cp10029 => 'MacLatin2', |
1034
|
|
|
|
|
|
|
maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic', |
1035
|
|
|
|
|
|
|
macgreek => 'MacGreek', cp10006 => 'MacGreek', |
1036
|
|
|
|
|
|
|
macturkish => 'MacTurkish', cp10081 => 'MacTurkish', |
1037
|
|
|
|
|
|
|
macromanian => 'MacRomanian', cp10010 => 'MacRomanian', |
1038
|
|
|
|
|
|
|
maciceland => 'MacIceland', cp10079 => 'MacIceland', |
1039
|
|
|
|
|
|
|
maccroatian => 'MacCroatian', cp10082 => 'MacCroatian', |
1040
|
|
|
|
|
|
|
); |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
# default family 0 group priority for writing |
1043
|
|
|
|
|
|
|
# (NOTE: tags in groups not specified here will not be written unless |
1044
|
|
|
|
|
|
|
# overridden by the module or specified when writing) |
1045
|
|
|
|
|
|
|
my @defaultWriteGroups = qw( |
1046
|
|
|
|
|
|
|
EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe |
1047
|
|
|
|
|
|
|
); |
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
# group hash for ExifTool-generated tags |
1050
|
|
|
|
|
|
|
my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' ); |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
# special tag names (not used for tag info) |
1053
|
|
|
|
|
|
|
%specialTags = map { $_ => 1 } qw( |
1054
|
|
|
|
|
|
|
TABLE_NAME SHORT_NAME PROCESS_PROC WRITE_PROC CHECK_PROC |
1055
|
|
|
|
|
|
|
GROUPS FORMAT FIRST_ENTRY TAG_PREFIX PRINT_CONV |
1056
|
|
|
|
|
|
|
WRITABLE TABLE_DESC NOTES IS_OFFSET IS_SUBDIR |
1057
|
|
|
|
|
|
|
EXTRACT_UNKNOWN NAMESPACE PREFERRED SRC_TABLE PRIORITY |
1058
|
|
|
|
|
|
|
AVOID WRITE_GROUP LANG_INFO VARS DATAMEMBER |
1059
|
|
|
|
|
|
|
SET_GROUP1 PERMANENT INIT_TABLE |
1060
|
|
|
|
|
|
|
); |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
# headers for various segment types |
1063
|
|
|
|
|
|
|
$exifAPP1hdr = "Exif\0\0"; |
1064
|
|
|
|
|
|
|
$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0"; |
1065
|
|
|
|
|
|
|
$xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0"; |
1066
|
|
|
|
|
|
|
$psAPP13hdr = "Photoshop 3.0\0"; |
1067
|
|
|
|
|
|
|
$psAPP13old = 'Adobe_Photoshop2.5:'; |
1068
|
|
|
|
|
|
|
|
1069
|
752
|
|
|
752
|
0
|
2726
|
sub DummyWriteProc { return 1; } |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
# lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses |
1072
|
|
|
|
|
|
|
%Image::ExifTool::userLens = ( ); |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
# queued plug-in tags to add to lookup |
1075
|
|
|
|
|
|
|
@Image::ExifTool::pluginTags = ( ); |
1076
|
|
|
|
|
|
|
%Image::ExifTool::pluginTags = ( ); |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
my %systemTagsNotes = ( |
1079
|
|
|
|
|
|
|
Notes => q{ |
1080
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1081
|
|
|
|
|
|
|
option is set |
1082
|
|
|
|
|
|
|
}, |
1083
|
|
|
|
|
|
|
); |
1084
|
|
|
|
|
|
|
|
1085
|
|
|
|
|
|
|
# tag information for preview image -- this should be used for all |
1086
|
|
|
|
|
|
|
# PreviewImage tags so they are handled properly when reading/writing |
1087
|
|
|
|
|
|
|
%Image::ExifTool::previewImageTagInfo = ( |
1088
|
|
|
|
|
|
|
Name => 'PreviewImage', |
1089
|
|
|
|
|
|
|
Writable => 'undef', |
1090
|
|
|
|
|
|
|
# a value of 'none' is ok... |
1091
|
|
|
|
|
|
|
WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)', |
1092
|
|
|
|
|
|
|
DataTag => 'PreviewImage', |
1093
|
|
|
|
|
|
|
# accept either scalar or scalar reference |
1094
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1095
|
|
|
|
|
|
|
# we allow preview image to be set to '', but we don't want a zero-length value |
1096
|
|
|
|
|
|
|
# in the IFD, so set it temporarily to 'none'. Note that the length is <= 4, |
1097
|
|
|
|
|
|
|
# so this value will fit in the IFD so the preview fixup won't be generated. |
1098
|
|
|
|
|
|
|
ValueConvInv => '$val eq "" and $val="none"; $val', |
1099
|
|
|
|
|
|
|
); |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
# extra tags that aren't truly EXIF tags, but are generated by the script |
1102
|
|
|
|
|
|
|
# Note: any tag in this list with a name corresponding to a Group0 name is |
1103
|
|
|
|
|
|
|
# used to write the entire corresponding directory as a block. |
1104
|
|
|
|
|
|
|
%Image::ExifTool::Extra = ( |
1105
|
|
|
|
|
|
|
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, |
1106
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags |
1107
|
|
|
|
|
|
|
WRITE_PROC => \&DummyWriteProc, |
1108
|
|
|
|
|
|
|
Error => { |
1109
|
|
|
|
|
|
|
Priority => 0, |
1110
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1111
|
|
|
|
|
|
|
Notes => q{ |
1112
|
|
|
|
|
|
|
returns errors that may have occurred while reading or writing a file. Any |
1113
|
|
|
|
|
|
|
Error will prevent the file from being processed. Minor errors may be |
1114
|
|
|
|
|
|
|
downgraded to warnings with the -m or L option |
1115
|
|
|
|
|
|
|
}, |
1116
|
|
|
|
|
|
|
}, |
1117
|
|
|
|
|
|
|
Warning => { |
1118
|
|
|
|
|
|
|
Priority => 0, |
1119
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1120
|
|
|
|
|
|
|
Notes => q{ |
1121
|
|
|
|
|
|
|
returns warnings that may have occurred while reading or writing a file. |
1122
|
|
|
|
|
|
|
Use the -a or L option to see all warnings if more than one |
1123
|
|
|
|
|
|
|
occurred. Minor warnings may be ignored with the -m or L |
1124
|
|
|
|
|
|
|
option. Minor warnings with a capital "M" in the "[Minor]" designation |
1125
|
|
|
|
|
|
|
indicate that the processing is affected by ignoring the warning |
1126
|
|
|
|
|
|
|
}, |
1127
|
|
|
|
|
|
|
}, |
1128
|
|
|
|
|
|
|
Comment => { |
1129
|
|
|
|
|
|
|
Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image', |
1130
|
|
|
|
|
|
|
Writable => 1, |
1131
|
|
|
|
|
|
|
WriteGroup => 'Comment', |
1132
|
|
|
|
|
|
|
Priority => 0, # to preserve order of JPEG COM segments |
1133
|
|
|
|
|
|
|
}, |
1134
|
|
|
|
|
|
|
Directory => { |
1135
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1136
|
|
|
|
|
|
|
Notes => q{ |
1137
|
|
|
|
|
|
|
the directory of the file as specified in the call to ExifTool, or "." if no |
1138
|
|
|
|
|
|
|
directory was specified. May be written to move the file to another |
1139
|
|
|
|
|
|
|
directory that will be created if doesn't already exist |
1140
|
|
|
|
|
|
|
}, |
1141
|
|
|
|
|
|
|
Writable => 1, |
1142
|
|
|
|
|
|
|
WritePseudo => 1, |
1143
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1144
|
|
|
|
|
|
|
Protected => 1, |
1145
|
|
|
|
|
|
|
RawConv => '$self->ConvertFileName($val)', |
1146
|
|
|
|
|
|
|
# translate backslashes in directory names and add trailing '/' |
1147
|
|
|
|
|
|
|
ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_', |
1148
|
|
|
|
|
|
|
}, |
1149
|
|
|
|
|
|
|
FileName => { |
1150
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1151
|
|
|
|
|
|
|
Writable => 1, |
1152
|
|
|
|
|
|
|
WritePseudo => 1, |
1153
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1154
|
|
|
|
|
|
|
Protected => 1, |
1155
|
|
|
|
|
|
|
Notes => q{ |
1156
|
|
|
|
|
|
|
may be written with a full path name to set FileName and Directory in one |
1157
|
|
|
|
|
|
|
operation. This is such a powerful feature that a TestName tag is provided |
1158
|
|
|
|
|
|
|
to allow dry-run tests before actually writing the file name. See |
1159
|
|
|
|
|
|
|
L for more information on writing the |
1160
|
|
|
|
|
|
|
FileName, Directory and TestName tags |
1161
|
|
|
|
|
|
|
}, |
1162
|
|
|
|
|
|
|
RawConv => '$self->ConvertFileName($val)', |
1163
|
|
|
|
|
|
|
ValueConvInv => '$self->InverseFileName($val)', |
1164
|
|
|
|
|
|
|
}, |
1165
|
|
|
|
|
|
|
BaseName => { |
1166
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1167
|
|
|
|
|
|
|
Notes => q{ |
1168
|
|
|
|
|
|
|
file name without extension. Not generated unless specifically requested or |
1169
|
|
|
|
|
|
|
the API L option is set |
1170
|
|
|
|
|
|
|
}, |
1171
|
|
|
|
|
|
|
}, |
1172
|
|
|
|
|
|
|
FilePath => { |
1173
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1174
|
|
|
|
|
|
|
Notes => q{ |
1175
|
|
|
|
|
|
|
absolute path of source file. Not generated unless specifically requested or |
1176
|
|
|
|
|
|
|
the API L option is set. Does not support Windows Unicode file |
1177
|
|
|
|
|
|
|
names |
1178
|
|
|
|
|
|
|
}, |
1179
|
|
|
|
|
|
|
}, |
1180
|
|
|
|
|
|
|
TestName => { |
1181
|
|
|
|
|
|
|
Writable => 1, |
1182
|
|
|
|
|
|
|
WritePseudo => 1, |
1183
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1184
|
|
|
|
|
|
|
Protected => 1, |
1185
|
|
|
|
|
|
|
WriteOnly => 1, |
1186
|
|
|
|
|
|
|
Notes => q{ |
1187
|
|
|
|
|
|
|
this write-only tag may be used instead of FileName for dry-run tests of the |
1188
|
|
|
|
|
|
|
file renaming feature. Writing this tag prints the old and new file names |
1189
|
|
|
|
|
|
|
to the console, but does not affect the file itself |
1190
|
|
|
|
|
|
|
}, |
1191
|
|
|
|
|
|
|
ValueConvInv => '$self->InverseFileName($val)', |
1192
|
|
|
|
|
|
|
}, |
1193
|
|
|
|
|
|
|
FileSequence => { |
1194
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1195
|
|
|
|
|
|
|
Notes => q{ |
1196
|
|
|
|
|
|
|
sequence number for each source file when extracting or copying information, |
1197
|
|
|
|
|
|
|
including files that fail the -if condition of the command-line application, |
1198
|
|
|
|
|
|
|
beginning at 0 for the first file. Not generated unless specifically |
1199
|
|
|
|
|
|
|
requested or the API L option is set |
1200
|
|
|
|
|
|
|
}, |
1201
|
|
|
|
|
|
|
}, |
1202
|
|
|
|
|
|
|
FileSize => { |
1203
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1204
|
|
|
|
|
|
|
Notes => q{ |
1205
|
|
|
|
|
|
|
note that the print conversion for this tag uses historic prefixes: 1 kB = |
1206
|
|
|
|
|
|
|
1024 bytes, etc. |
1207
|
|
|
|
|
|
|
}, |
1208
|
|
|
|
|
|
|
PrintConv => \&ConvertFileSize, |
1209
|
|
|
|
|
|
|
}, |
1210
|
|
|
|
|
|
|
ResourceForkSize => { |
1211
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1212
|
|
|
|
|
|
|
Notes => q{ |
1213
|
|
|
|
|
|
|
size of the file's resource fork if it contains data. Mac OS only. If this |
1214
|
|
|
|
|
|
|
tag is generated the L option may be used to extract |
1215
|
|
|
|
|
|
|
resource-fork information as a sub-document. When writing, the resource |
1216
|
|
|
|
|
|
|
fork is preserved by default, but it may be deleted with C<-rsrc:all=> on |
1217
|
|
|
|
|
|
|
the command line |
1218
|
|
|
|
|
|
|
}, |
1219
|
|
|
|
|
|
|
PrintConv => \&ConvertFileSize, |
1220
|
|
|
|
|
|
|
}, |
1221
|
|
|
|
|
|
|
ZoneIdentifier => { |
1222
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1223
|
|
|
|
|
|
|
Notes => q{ |
1224
|
|
|
|
|
|
|
Windows only. Existence indicates that the file has a Zone.Identifier |
1225
|
|
|
|
|
|
|
alternate data stream, which is used by some Windows browsers to mark |
1226
|
|
|
|
|
|
|
downloaded files as possibly unsafe to run. May be deleted to remove this |
1227
|
|
|
|
|
|
|
stream. Requires Win32API::File |
1228
|
|
|
|
|
|
|
}, |
1229
|
|
|
|
|
|
|
Writable => 1, |
1230
|
|
|
|
|
|
|
WritePseudo => 1, |
1231
|
|
|
|
|
|
|
Protected => 1, |
1232
|
|
|
|
|
|
|
}, |
1233
|
|
|
|
|
|
|
FileType => { |
1234
|
|
|
|
|
|
|
Groups => { 2 => 'Other' }, |
1235
|
|
|
|
|
|
|
Notes => q{ |
1236
|
|
|
|
|
|
|
a short description of the file type. For many file types this is the just |
1237
|
|
|
|
|
|
|
the uppercase file extension |
1238
|
|
|
|
|
|
|
}, |
1239
|
|
|
|
|
|
|
}, |
1240
|
|
|
|
|
|
|
FileTypeExtension => { |
1241
|
|
|
|
|
|
|
Groups => { 2 => 'Other' }, |
1242
|
|
|
|
|
|
|
Notes => q{ |
1243
|
|
|
|
|
|
|
a common lowercase extension for this file type, or uppercase with the -n |
1244
|
|
|
|
|
|
|
option |
1245
|
|
|
|
|
|
|
}, |
1246
|
|
|
|
|
|
|
PrintConv => 'lc $val', |
1247
|
|
|
|
|
|
|
}, |
1248
|
|
|
|
|
|
|
FileModifyDate => { |
1249
|
|
|
|
|
|
|
Description => 'File Modification Date/Time', |
1250
|
|
|
|
|
|
|
Notes => q{ |
1251
|
|
|
|
|
|
|
the filesystem modification date/time. Note that ExifTool may not be able |
1252
|
|
|
|
|
|
|
to handle filesystem dates before 1970 depending on the limitations of the |
1253
|
|
|
|
|
|
|
system's standard libraries |
1254
|
|
|
|
|
|
|
}, |
1255
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1256
|
|
|
|
|
|
|
Writable => 1, |
1257
|
|
|
|
|
|
|
WritePseudo => 1, |
1258
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1259
|
|
|
|
|
|
|
# all writable pseudo-tags must be protected so -tagsfromfile fails with |
1260
|
|
|
|
|
|
|
# unrecognized files unless a pseudo tag is specified explicitly |
1261
|
|
|
|
|
|
|
Protected => 1, |
1262
|
|
|
|
|
|
|
Shift => 'Time', |
1263
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1264
|
|
|
|
|
|
|
ValueConvInv => 'GetUnixTime($val,1)', |
1265
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1266
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
1267
|
|
|
|
|
|
|
}, |
1268
|
|
|
|
|
|
|
FileAccessDate => { |
1269
|
|
|
|
|
|
|
Description => 'File Access Date/Time', |
1270
|
|
|
|
|
|
|
Notes => q{ |
1271
|
|
|
|
|
|
|
the date/time of last access of the file. Note that this access time is |
1272
|
|
|
|
|
|
|
updated whenever any software, including ExifTool, reads the file |
1273
|
|
|
|
|
|
|
}, |
1274
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1275
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1276
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1277
|
|
|
|
|
|
|
}, |
1278
|
|
|
|
|
|
|
FileCreateDate => { |
1279
|
|
|
|
|
|
|
Description => 'File Creation Date/Time', |
1280
|
|
|
|
|
|
|
Notes => q{ |
1281
|
|
|
|
|
|
|
the filesystem creation date/time. Windows/Mac only. In Windows, the file |
1282
|
|
|
|
|
|
|
creation date/time is preserved by default when writing if Win32API::File |
1283
|
|
|
|
|
|
|
and Win32::API are available. On Mac, this tag is extracted only if it or |
1284
|
|
|
|
|
|
|
the MacOS group is specifically requested or the API L option is |
1285
|
|
|
|
|
|
|
set to 2 or higher. Requires "setfile" for writing on Mac, which may be |
1286
|
|
|
|
|
|
|
installed by typing C in the Terminal |
1287
|
|
|
|
|
|
|
}, |
1288
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1289
|
|
|
|
|
|
|
Writable => 1, |
1290
|
|
|
|
|
|
|
WritePseudo => 1, |
1291
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1292
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1293
|
|
|
|
|
|
|
Shift => 'Time', |
1294
|
|
|
|
|
|
|
ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)', |
1295
|
|
|
|
|
|
|
ValueConvInv => q{ |
1296
|
|
|
|
|
|
|
return GetUnixTime($val,1) if $^O eq 'MSWin32'; |
1297
|
|
|
|
|
|
|
return $val if $^O eq 'darwin'; |
1298
|
|
|
|
|
|
|
warn "This tag is Windows/Mac only\n"; |
1299
|
|
|
|
|
|
|
return undef; |
1300
|
|
|
|
|
|
|
}, |
1301
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1302
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
1303
|
|
|
|
|
|
|
}, |
1304
|
|
|
|
|
|
|
FileInodeChangeDate => { |
1305
|
|
|
|
|
|
|
Description => 'File Inode Change Date/Time', |
1306
|
|
|
|
|
|
|
Notes => q{ |
1307
|
|
|
|
|
|
|
the date/time when the file's directory information was last changed. |
1308
|
|
|
|
|
|
|
Non-Windows systems only |
1309
|
|
|
|
|
|
|
}, |
1310
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1311
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1312
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1313
|
|
|
|
|
|
|
}, |
1314
|
|
|
|
|
|
|
FilePermissions => { |
1315
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1316
|
|
|
|
|
|
|
Notes => q{ |
1317
|
|
|
|
|
|
|
r=read, w=write and x=execute permissions for the file owner, group and |
1318
|
|
|
|
|
|
|
others. The ValueConv value is an octal number so bit test operations on |
1319
|
|
|
|
|
|
|
this value should be done in octal, eg. 'oct($filePermissions#) & 0200' |
1320
|
|
|
|
|
|
|
}, |
1321
|
|
|
|
|
|
|
Writable => 1, |
1322
|
|
|
|
|
|
|
WritePseudo => 1, |
1323
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1324
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1325
|
|
|
|
|
|
|
ValueConv => 'sprintf("%.3o", $val)', |
1326
|
|
|
|
|
|
|
ValueConvInv => 'oct($val & 07777)', |
1327
|
|
|
|
|
|
|
PrintConv => sub { |
1328
|
|
|
|
|
|
|
my ($mask, $val) = (0400, oct(shift)); |
1329
|
|
|
|
|
|
|
my %types = ( |
1330
|
|
|
|
|
|
|
0010000 => 'p', |
1331
|
|
|
|
|
|
|
0020000 => 'c', |
1332
|
|
|
|
|
|
|
0040000 => 'd', |
1333
|
|
|
|
|
|
|
0060000 => 'b', |
1334
|
|
|
|
|
|
|
0120000 => 'l', |
1335
|
|
|
|
|
|
|
0140000 => 's', |
1336
|
|
|
|
|
|
|
); |
1337
|
|
|
|
|
|
|
my $str = $types{$val & 0170000} || '-'; |
1338
|
|
|
|
|
|
|
while ($mask) { |
1339
|
|
|
|
|
|
|
foreach (qw(r w x)) { |
1340
|
|
|
|
|
|
|
$str .= $val & $mask ? $_ : '-'; |
1341
|
|
|
|
|
|
|
$mask >>= 1; |
1342
|
|
|
|
|
|
|
} |
1343
|
|
|
|
|
|
|
} |
1344
|
|
|
|
|
|
|
return $str; |
1345
|
|
|
|
|
|
|
}, |
1346
|
|
|
|
|
|
|
PrintConvInv => sub { |
1347
|
|
|
|
|
|
|
my ($bit, $val, $str) = (8, 0, shift); |
1348
|
|
|
|
|
|
|
$str = substr($str, 1) if length($str) == 10; |
1349
|
|
|
|
|
|
|
return undef if length($str) != 9; |
1350
|
|
|
|
|
|
|
while ($bit >= 0) { |
1351
|
|
|
|
|
|
|
foreach (qw(r w x)) { |
1352
|
|
|
|
|
|
|
$val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_; |
1353
|
|
|
|
|
|
|
--$bit; |
1354
|
|
|
|
|
|
|
} |
1355
|
|
|
|
|
|
|
} |
1356
|
|
|
|
|
|
|
return sprintf('%.3o', $val); |
1357
|
|
|
|
|
|
|
}, |
1358
|
|
|
|
|
|
|
}, |
1359
|
|
|
|
|
|
|
FileAttributes => { |
1360
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1361
|
|
|
|
|
|
|
Notes => q{ |
1362
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1363
|
|
|
|
|
|
|
option is set. 2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows |
1364
|
|
|
|
|
|
|
attribute bits if Win32API::File is available |
1365
|
|
|
|
|
|
|
}, |
1366
|
|
|
|
|
|
|
PrintHex => 1, |
1367
|
|
|
|
|
|
|
PrintConvColumns => 2, |
1368
|
|
|
|
|
|
|
PrintConv => [{ # stat device types (bitmask 0xf000) |
1369
|
|
|
|
|
|
|
0x0000 => 'Unknown', |
1370
|
|
|
|
|
|
|
0x1000 => 'FIFO', |
1371
|
|
|
|
|
|
|
0x2000 => 'Character', |
1372
|
|
|
|
|
|
|
0x3000 => 'Mux Character', |
1373
|
|
|
|
|
|
|
0x4000 => 'Directory', |
1374
|
|
|
|
|
|
|
0x5000 => 'XENIX Named', |
1375
|
|
|
|
|
|
|
0x6000 => 'Block', |
1376
|
|
|
|
|
|
|
0x7000 => 'Mux Block', |
1377
|
|
|
|
|
|
|
0x8000 => 'Regular', |
1378
|
|
|
|
|
|
|
0x9000 => 'VxFS Compressed', |
1379
|
|
|
|
|
|
|
0xa000 => 'Symbolic Link', |
1380
|
|
|
|
|
|
|
0xb000 => 'Solaris Shadow Inode', |
1381
|
|
|
|
|
|
|
0xc000 => 'Socket', |
1382
|
|
|
|
|
|
|
0xd000 => 'Solaris Door', |
1383
|
|
|
|
|
|
|
0xe000 => 'BSD Whiteout', |
1384
|
|
|
|
|
|
|
},{ BITMASK => { # stat attribute bits (bitmask 0x0e00) |
1385
|
|
|
|
|
|
|
9 => 'Sticky', |
1386
|
|
|
|
|
|
|
10 => 'Set Group ID', |
1387
|
|
|
|
|
|
|
11 => 'Set User ID', |
1388
|
|
|
|
|
|
|
}},{ BITMASK => { # Windows attribute bits |
1389
|
|
|
|
|
|
|
0 => 'Read Only', |
1390
|
|
|
|
|
|
|
1 => 'Hidden', |
1391
|
|
|
|
|
|
|
2 => 'System', |
1392
|
|
|
|
|
|
|
3 => 'Volume Label', |
1393
|
|
|
|
|
|
|
4 => 'Directory', |
1394
|
|
|
|
|
|
|
5 => 'Archive', |
1395
|
|
|
|
|
|
|
6 => 'Device', |
1396
|
|
|
|
|
|
|
7 => 'Normal', |
1397
|
|
|
|
|
|
|
8 => 'Temporary', |
1398
|
|
|
|
|
|
|
9 => 'Sparse File', |
1399
|
|
|
|
|
|
|
10 => 'Reparse Point', |
1400
|
|
|
|
|
|
|
11 => 'Compressed', |
1401
|
|
|
|
|
|
|
12 => 'Offline', |
1402
|
|
|
|
|
|
|
13 => 'Not Content Indexed', |
1403
|
|
|
|
|
|
|
14 => 'Encrypted', |
1404
|
|
|
|
|
|
|
}}], |
1405
|
|
|
|
|
|
|
}, |
1406
|
|
|
|
|
|
|
FileDeviceID => { |
1407
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1408
|
|
|
|
|
|
|
%systemTagsNotes, |
1409
|
|
|
|
|
|
|
PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor) |
1410
|
|
|
|
|
|
|
}, |
1411
|
|
|
|
|
|
|
FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1412
|
|
|
|
|
|
|
FileInodeNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1413
|
|
|
|
|
|
|
FileHardLinks => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1414
|
|
|
|
|
|
|
FileUserID => { |
1415
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1416
|
|
|
|
|
|
|
Notes => q{ |
1417
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1418
|
|
|
|
|
|
|
option is set. Returns user ID number with the -n option, or name |
1419
|
|
|
|
|
|
|
otherwise. May be written with either user name or number |
1420
|
|
|
|
|
|
|
}, |
1421
|
|
|
|
|
|
|
Writable => 1, |
1422
|
|
|
|
|
|
|
WritePseudo => 1, |
1423
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1424
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1425
|
|
|
|
|
|
|
PrintConv => 'eval { getpwuid($val) } || $val', |
1426
|
|
|
|
|
|
|
PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', |
1427
|
|
|
|
|
|
|
}, |
1428
|
|
|
|
|
|
|
FileGroupID => { |
1429
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1430
|
|
|
|
|
|
|
Notes => q{ |
1431
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1432
|
|
|
|
|
|
|
option is set. Returns group ID number with the -n option, or name |
1433
|
|
|
|
|
|
|
otherwise. May be written with either group name or number |
1434
|
|
|
|
|
|
|
}, |
1435
|
|
|
|
|
|
|
Writable => 1, |
1436
|
|
|
|
|
|
|
WritePseudo => 1, |
1437
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1438
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1439
|
|
|
|
|
|
|
PrintConv => 'eval { getgrgid($val) } || $val', |
1440
|
|
|
|
|
|
|
PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', |
1441
|
|
|
|
|
|
|
}, |
1442
|
|
|
|
|
|
|
FileBlockSize => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1443
|
|
|
|
|
|
|
FileBlockCount => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1444
|
|
|
|
|
|
|
HardLink => { |
1445
|
|
|
|
|
|
|
Writable => 1, |
1446
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1447
|
|
|
|
|
|
|
WriteOnly => 1, |
1448
|
|
|
|
|
|
|
WritePseudo => 1, |
1449
|
|
|
|
|
|
|
Protected => 1, |
1450
|
|
|
|
|
|
|
Notes => q{ |
1451
|
|
|
|
|
|
|
this write-only tag is used to create a hard link with the specified name to |
1452
|
|
|
|
|
|
|
the source file. If the source file is edited, copied, renamed or moved in |
1453
|
|
|
|
|
|
|
the same operation as writing HardLink, then the link is made to the updated |
1454
|
|
|
|
|
|
|
file. Note that subsequent editing of either hard-linked file by exiftool |
1455
|
|
|
|
|
|
|
will break the link unless the -overwrite_original_in_place option is used |
1456
|
|
|
|
|
|
|
}, |
1457
|
|
|
|
|
|
|
ValueConvInv => '$val=~tr/\\\\/\//; $val', |
1458
|
|
|
|
|
|
|
}, |
1459
|
|
|
|
|
|
|
SymLink => { |
1460
|
|
|
|
|
|
|
Writable => 1, |
1461
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1462
|
|
|
|
|
|
|
WriteOnly => 1, |
1463
|
|
|
|
|
|
|
WritePseudo => 1, |
1464
|
|
|
|
|
|
|
Protected => 1, |
1465
|
|
|
|
|
|
|
Notes => q{ |
1466
|
|
|
|
|
|
|
this write-only tag is used to create a symbolic link with the specified |
1467
|
|
|
|
|
|
|
name to the source file. If the source file is edited, copied, renamed or |
1468
|
|
|
|
|
|
|
moved in the same operation as writing SymLink, then the link is made to the |
1469
|
|
|
|
|
|
|
updated file. The link uses an absolute path unless it is created in the |
1470
|
|
|
|
|
|
|
current working directory. Valid only for file systems that support |
1471
|
|
|
|
|
|
|
symbolic links. Note that subsequent editing of the file via the symbolic |
1472
|
|
|
|
|
|
|
link by exiftool will cause the link to be replaced by the edited file |
1473
|
|
|
|
|
|
|
without changing the original unless the -overwrite_original_in_place option |
1474
|
|
|
|
|
|
|
is used |
1475
|
|
|
|
|
|
|
}, |
1476
|
|
|
|
|
|
|
ValueConvInv => '$val=~tr/\\\\/\//; $val', |
1477
|
|
|
|
|
|
|
}, |
1478
|
|
|
|
|
|
|
MIMEType => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } }, |
1479
|
|
|
|
|
|
|
ImageWidth => { Notes => 'the width of the image in number of pixels' }, |
1480
|
|
|
|
|
|
|
ImageHeight => { Notes => 'the height of the image in number of pixels' }, |
1481
|
|
|
|
|
|
|
XResolution => { Notes => 'the horizontal pixel resolution' }, |
1482
|
|
|
|
|
|
|
YResolution => { Notes => 'the vertical pixel resolution' }, |
1483
|
|
|
|
|
|
|
MaxVal => { Notes => 'maximum pixel value in PPM or PGM image' }, |
1484
|
|
|
|
|
|
|
EXIF => { |
1485
|
|
|
|
|
|
|
Notes => q{ |
1486
|
|
|
|
|
|
|
the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag |
1487
|
|
|
|
|
|
|
is generated only if specifically requested |
1488
|
|
|
|
|
|
|
}, |
1489
|
|
|
|
|
|
|
Groups => { 0 => 'EXIF', 1 => 'EXIF' }, |
1490
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1491
|
|
|
|
|
|
|
WriteCheck => q{ |
1492
|
|
|
|
|
|
|
return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/; |
1493
|
|
|
|
|
|
|
return 'Invalid EXIF data'; |
1494
|
|
|
|
|
|
|
}, |
1495
|
|
|
|
|
|
|
}, |
1496
|
|
|
|
|
|
|
IPTC => { |
1497
|
|
|
|
|
|
|
Notes => q{ |
1498
|
|
|
|
|
|
|
the full IPTC data block. This tag is generated only if specifically |
1499
|
|
|
|
|
|
|
requested |
1500
|
|
|
|
|
|
|
}, |
1501
|
|
|
|
|
|
|
Groups => { 0 => 'IPTC', 1 => 'IPTC' }, |
1502
|
|
|
|
|
|
|
Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], |
1503
|
|
|
|
|
|
|
Priority => 0, # so main IPTC (which hopefully comes first) takes priority |
1504
|
|
|
|
|
|
|
WriteCheck => q{ |
1505
|
|
|
|
|
|
|
return undef if $val =~ /^(\x1c|\0+$)/; |
1506
|
|
|
|
|
|
|
return 'Invalid IPTC data'; |
1507
|
|
|
|
|
|
|
}, |
1508
|
|
|
|
|
|
|
}, |
1509
|
|
|
|
|
|
|
XMP => { |
1510
|
|
|
|
|
|
|
Notes => q{ |
1511
|
|
|
|
|
|
|
the XMP data block, but note that extended XMP in JPEG images may be split |
1512
|
|
|
|
|
|
|
into multiple blocks. This tag is generated only if specifically requested |
1513
|
|
|
|
|
|
|
}, |
1514
|
|
|
|
|
|
|
Groups => { 0 => 'XMP', 1 => 'XMP' }, |
1515
|
|
|
|
|
|
|
Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], |
1516
|
|
|
|
|
|
|
Priority => 0, # so main xmp (which usually comes first) takes priority |
1517
|
|
|
|
|
|
|
WriteCheck => q{ |
1518
|
|
|
|
|
|
|
require Image::ExifTool::XMP; |
1519
|
|
|
|
|
|
|
return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val); |
1520
|
|
|
|
|
|
|
}, |
1521
|
|
|
|
|
|
|
}, |
1522
|
|
|
|
|
|
|
XML => { |
1523
|
|
|
|
|
|
|
Notes => 'the XML data block, extracted for some file types', |
1524
|
|
|
|
|
|
|
Groups => { 0 => 'XML', 1 => 'XML' }, |
1525
|
|
|
|
|
|
|
Binary => 1, |
1526
|
|
|
|
|
|
|
}, |
1527
|
|
|
|
|
|
|
ICC_Profile => { |
1528
|
|
|
|
|
|
|
Notes => q{ |
1529
|
|
|
|
|
|
|
the full ICC_Profile data block. This tag is generated only if specifically |
1530
|
|
|
|
|
|
|
requested |
1531
|
|
|
|
|
|
|
}, |
1532
|
|
|
|
|
|
|
Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' }, |
1533
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1534
|
|
|
|
|
|
|
WriteCheck => q{ |
1535
|
|
|
|
|
|
|
require Image::ExifTool::ICC_Profile; |
1536
|
|
|
|
|
|
|
return Image::ExifTool::ICC_Profile::ValidateICC(\$val); |
1537
|
|
|
|
|
|
|
}, |
1538
|
|
|
|
|
|
|
}, |
1539
|
|
|
|
|
|
|
CanonVRD => { |
1540
|
|
|
|
|
|
|
Notes => q{ |
1541
|
|
|
|
|
|
|
the full Canon DPP VRD trailer block. This tag is generated only if |
1542
|
|
|
|
|
|
|
specifically requested |
1543
|
|
|
|
|
|
|
}, |
1544
|
|
|
|
|
|
|
Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, |
1545
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1546
|
|
|
|
|
|
|
Permanent => 0, # (this is 1 by default for MakerNotes tags) |
1547
|
|
|
|
|
|
|
WriteCheck => q{ |
1548
|
|
|
|
|
|
|
return undef if $val =~ /^CANON OPTIONAL DATA\0/; |
1549
|
|
|
|
|
|
|
return 'Invalid CanonVRD data'; |
1550
|
|
|
|
|
|
|
}, |
1551
|
|
|
|
|
|
|
}, |
1552
|
|
|
|
|
|
|
CanonDR4 => { |
1553
|
|
|
|
|
|
|
Notes => q{ |
1554
|
|
|
|
|
|
|
the full Canon DPP version 4 DR4 block. This tag is generated only if |
1555
|
|
|
|
|
|
|
specifically requested |
1556
|
|
|
|
|
|
|
}, |
1557
|
|
|
|
|
|
|
Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, |
1558
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary'], |
1559
|
|
|
|
|
|
|
Permanent => 0, # (this is 1 by default for MakerNotes tags) |
1560
|
|
|
|
|
|
|
WriteCheck => q{ |
1561
|
|
|
|
|
|
|
return undef if $val =~ /^IIII\x04\0\x04\0/; |
1562
|
|
|
|
|
|
|
return 'Invalid CanonDR4 data'; |
1563
|
|
|
|
|
|
|
}, |
1564
|
|
|
|
|
|
|
}, |
1565
|
|
|
|
|
|
|
Adobe => { |
1566
|
|
|
|
|
|
|
Notes => q{ |
1567
|
|
|
|
|
|
|
the JPEG APP14 Adobe segment. Extracted only if specified. See the |
1568
|
|
|
|
|
|
|
L for more information |
1569
|
|
|
|
|
|
|
}, |
1570
|
|
|
|
|
|
|
Groups => { 0 => 'APP14', 1 => 'Adobe' }, |
1571
|
|
|
|
|
|
|
WriteGroup => 'Adobe', |
1572
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary'], |
1573
|
|
|
|
|
|
|
}, |
1574
|
|
|
|
|
|
|
CurrentIPTCDigest => { |
1575
|
|
|
|
|
|
|
Notes => q{ |
1576
|
|
|
|
|
|
|
MD5 digest of existing IPTC data. All zeros if IPTC exists but Digest::MD5 |
1577
|
|
|
|
|
|
|
is not installed. Only calculated for IPTC in the standard location as |
1578
|
|
|
|
|
|
|
specified by the L. ExifTool |
1579
|
|
|
|
|
|
|
automates the handling of this tag in the MWG module -- see the |
1580
|
|
|
|
|
|
|
L for details |
1581
|
|
|
|
|
|
|
}, |
1582
|
|
|
|
|
|
|
ValueConv => 'unpack("H*", $val)', |
1583
|
|
|
|
|
|
|
}, |
1584
|
|
|
|
|
|
|
PreviewImage => { |
1585
|
|
|
|
|
|
|
Notes => 'JPEG-format embedded preview image', |
1586
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1587
|
|
|
|
|
|
|
Writable => 1, |
1588
|
|
|
|
|
|
|
WriteCheck => '$self->CheckImage(\$val)', |
1589
|
|
|
|
|
|
|
WriteGroup => 'All', |
1590
|
|
|
|
|
|
|
# can't delete, so set to empty string and return no error |
1591
|
|
|
|
|
|
|
DelCheck => '$val = ""; return undef', |
1592
|
|
|
|
|
|
|
# accept either scalar or scalar reference |
1593
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1594
|
|
|
|
|
|
|
}, |
1595
|
|
|
|
|
|
|
ThumbnailImage => { |
1596
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1597
|
|
|
|
|
|
|
Notes => 'JPEG-format embedded thumbnail image', |
1598
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1599
|
|
|
|
|
|
|
}, |
1600
|
|
|
|
|
|
|
OtherImage => { |
1601
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1602
|
|
|
|
|
|
|
Notes => 'other JPEG-format embedded image', |
1603
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1604
|
|
|
|
|
|
|
}, |
1605
|
|
|
|
|
|
|
PreviewPNG => { |
1606
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1607
|
|
|
|
|
|
|
Notes => 'PNG-format embedded preview image', |
1608
|
|
|
|
|
|
|
Binary => 1, |
1609
|
|
|
|
|
|
|
}, |
1610
|
|
|
|
|
|
|
PreviewWMF => { |
1611
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1612
|
|
|
|
|
|
|
Notes => 'WMF-format embedded preview image', |
1613
|
|
|
|
|
|
|
Binary => 1, |
1614
|
|
|
|
|
|
|
}, |
1615
|
|
|
|
|
|
|
PreviewTIFF => { |
1616
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1617
|
|
|
|
|
|
|
Notes => 'TIFF-format embedded preview image', |
1618
|
|
|
|
|
|
|
Binary => 1, |
1619
|
|
|
|
|
|
|
}, |
1620
|
|
|
|
|
|
|
PreviewPDF => { |
1621
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1622
|
|
|
|
|
|
|
Notes => 'PDF-format embedded preview image', |
1623
|
|
|
|
|
|
|
Binary => 1, |
1624
|
|
|
|
|
|
|
}, |
1625
|
|
|
|
|
|
|
ExifByteOrder => { |
1626
|
|
|
|
|
|
|
Writable => 1, |
1627
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1628
|
|
|
|
|
|
|
Notes => q{ |
1629
|
|
|
|
|
|
|
represents the byte order of EXIF information. May be written to set the |
1630
|
|
|
|
|
|
|
byte order only for newly created EXIF segments |
1631
|
|
|
|
|
|
|
}, |
1632
|
|
|
|
|
|
|
PrintConv => { |
1633
|
|
|
|
|
|
|
II => 'Little-endian (Intel, II)', |
1634
|
|
|
|
|
|
|
MM => 'Big-endian (Motorola, MM)', |
1635
|
|
|
|
|
|
|
}, |
1636
|
|
|
|
|
|
|
}, |
1637
|
|
|
|
|
|
|
ExifUnicodeByteOrder => { |
1638
|
|
|
|
|
|
|
Writable => 1, |
1639
|
|
|
|
|
|
|
WriteOnly => 1, |
1640
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1641
|
|
|
|
|
|
|
Notes => q{ |
1642
|
|
|
|
|
|
|
specifies the byte order to use when writing EXIF Unicode text. The EXIF |
1643
|
|
|
|
|
|
|
specification is particularly vague about this byte ordering, and different |
1644
|
|
|
|
|
|
|
applications use different conventions. By default ExifTool writes Unicode |
1645
|
|
|
|
|
|
|
text in EXIF byte order, but this write-only tag may be used to force a |
1646
|
|
|
|
|
|
|
specific order. Applies to the EXIF UserComment tag when writing special |
1647
|
|
|
|
|
|
|
characters |
1648
|
|
|
|
|
|
|
}, |
1649
|
|
|
|
|
|
|
PrintConv => { |
1650
|
|
|
|
|
|
|
II => 'Little-endian (Intel, II)', |
1651
|
|
|
|
|
|
|
MM => 'Big-endian (Motorola, MM)', |
1652
|
|
|
|
|
|
|
}, |
1653
|
|
|
|
|
|
|
}, |
1654
|
|
|
|
|
|
|
ExifToolVersion => { |
1655
|
|
|
|
|
|
|
Description => 'ExifTool Version Number', |
1656
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1657
|
|
|
|
|
|
|
Notes => 'the version of ExifTool currently running', |
1658
|
|
|
|
|
|
|
}, |
1659
|
|
|
|
|
|
|
ProcessingTime => { |
1660
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1661
|
|
|
|
|
|
|
Notes => q{ |
1662
|
|
|
|
|
|
|
the clock time in seconds taken by ExifTool to extract information from this |
1663
|
|
|
|
|
|
|
file. Not generated unless specifically requested or the L API |
1664
|
|
|
|
|
|
|
option is set. Requires Time::HiRes |
1665
|
|
|
|
|
|
|
}, |
1666
|
|
|
|
|
|
|
PrintConv => 'sprintf("%.3g s", $val)', |
1667
|
|
|
|
|
|
|
}, |
1668
|
|
|
|
|
|
|
RAFVersion => { Notes => 'RAF file version number' }, |
1669
|
|
|
|
|
|
|
JPEGDigest => { |
1670
|
|
|
|
|
|
|
Notes => q{ |
1671
|
|
|
|
|
|
|
an MD5 digest of the JPEG quantization tables is combined with the component |
1672
|
|
|
|
|
|
|
sub-sampling values to generate the value of this tag. The result is |
1673
|
|
|
|
|
|
|
compared to known values in an attempt to deduce the originating software |
1674
|
|
|
|
|
|
|
based only on the JPEG image data. For performance reasons, this tag is |
1675
|
|
|
|
|
|
|
generated only if specifically requested or the API L option is set |
1676
|
|
|
|
|
|
|
to 3 or higher |
1677
|
|
|
|
|
|
|
}, |
1678
|
|
|
|
|
|
|
}, |
1679
|
|
|
|
|
|
|
JPEGQualityEstimate => { |
1680
|
|
|
|
|
|
|
Notes => q{ |
1681
|
|
|
|
|
|
|
an estimate of the IJG JPEG quality setting for the image, calculated from |
1682
|
|
|
|
|
|
|
the quantization tables. For performance reasons, this tag is generated |
1683
|
|
|
|
|
|
|
only if specifically requested or the API L option is set to 3 or |
1684
|
|
|
|
|
|
|
higher |
1685
|
|
|
|
|
|
|
}, |
1686
|
|
|
|
|
|
|
}, |
1687
|
|
|
|
|
|
|
JPEGImageLength => { |
1688
|
|
|
|
|
|
|
Notes => q{ |
1689
|
|
|
|
|
|
|
byte length of JPEG image without metadata. For performance reasons, this |
1690
|
|
|
|
|
|
|
tag is generated only if specifically requested or the API L option |
1691
|
|
|
|
|
|
|
is set to 3 or higher |
1692
|
|
|
|
|
|
|
}, |
1693
|
|
|
|
|
|
|
}, |
1694
|
|
|
|
|
|
|
# Validate (added from Validate.pm) |
1695
|
|
|
|
|
|
|
Now => { |
1696
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' }, |
1697
|
|
|
|
|
|
|
Notes => q{ |
1698
|
|
|
|
|
|
|
the current date/time. Useful when setting the tag values, eg. |
1699
|
|
|
|
|
|
|
C<"-modifydate. Not generated unless specifically requested or the |
1700
|
|
|
|
|
|
|
API L option is set |
1701
|
|
|
|
|
|
|
}, |
1702
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1703
|
|
|
|
|
|
|
}, |
1704
|
|
|
|
|
|
|
NewGUID => { |
1705
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1706
|
|
|
|
|
|
|
Notes => q{ |
1707
|
|
|
|
|
|
|
generates a new, random GUID with format |
1708
|
|
|
|
|
|
|
YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour, |
1709
|
|
|
|
|
|
|
M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and |
1710
|
|
|
|
|
|
|
R=random hex number; without dashes with the -n option. Not generated |
1711
|
|
|
|
|
|
|
unless specifically requested or the API L option is set |
1712
|
|
|
|
|
|
|
}, |
1713
|
|
|
|
|
|
|
PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val', |
1714
|
|
|
|
|
|
|
}, |
1715
|
|
|
|
|
|
|
ID3Size => { Notes => 'size of the ID3 data block' }, |
1716
|
|
|
|
|
|
|
Geotag => { |
1717
|
|
|
|
|
|
|
Writable => 1, |
1718
|
|
|
|
|
|
|
WriteOnly => 1, |
1719
|
|
|
|
|
|
|
WriteNothing => 1, |
1720
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1721
|
|
|
|
|
|
|
Notes => q{ |
1722
|
|
|
|
|
|
|
this write-only tag is used to define the GPS track log data or track log |
1723
|
|
|
|
|
|
|
file name. Currently supported track log formats are GPX, NMEA RMC/GGA/GLL, |
1724
|
|
|
|
|
|
|
KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus |
1725
|
|
|
|
|
|
|
Beacon text, and Bramor gEO log files. May be set to the special value of |
1726
|
|
|
|
|
|
|
"DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points |
1727
|
|
|
|
|
|
|
are available. See L for details |
1728
|
|
|
|
|
|
|
}, |
1729
|
|
|
|
|
|
|
DelCheck => q{ |
1730
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1731
|
|
|
|
|
|
|
# delete associated tags |
1732
|
|
|
|
|
|
|
Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); |
1733
|
|
|
|
|
|
|
}, |
1734
|
|
|
|
|
|
|
ValueConvInv => q{ |
1735
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1736
|
|
|
|
|
|
|
# always warn because this tag is never set (warning is "\n" on success) |
1737
|
|
|
|
|
|
|
my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val); |
1738
|
|
|
|
|
|
|
return '' if not defined $result; # deleting geo tags |
1739
|
|
|
|
|
|
|
return $result if ref $result; # geotag data hash reference |
1740
|
|
|
|
|
|
|
warn "$result\n"; # error string |
1741
|
|
|
|
|
|
|
}, |
1742
|
|
|
|
|
|
|
}, |
1743
|
|
|
|
|
|
|
Geotime => { |
1744
|
|
|
|
|
|
|
Writable => 1, |
1745
|
|
|
|
|
|
|
WriteOnly => 1, |
1746
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1747
|
|
|
|
|
|
|
Notes => q{ |
1748
|
|
|
|
|
|
|
this write-only tag is used to define a date/time for interpolating a |
1749
|
|
|
|
|
|
|
position in the GPS track specified by the Geotag tag. Writing this tag |
1750
|
|
|
|
|
|
|
causes GPS information to be written into the EXIF or XMP of the target |
1751
|
|
|
|
|
|
|
files. The local system timezone is assumed if the date/time value does not |
1752
|
|
|
|
|
|
|
contain a timezone. May be deleted to delete associated GPS tags. A group |
1753
|
|
|
|
|
|
|
name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP |
1754
|
|
|
|
|
|
|
GPS tags |
1755
|
|
|
|
|
|
|
}, |
1756
|
|
|
|
|
|
|
DelCheck => q{ |
1757
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1758
|
|
|
|
|
|
|
# delete associated tags |
1759
|
|
|
|
|
|
|
Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); |
1760
|
|
|
|
|
|
|
}, |
1761
|
|
|
|
|
|
|
ValueConvInv => q{ |
1762
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1763
|
|
|
|
|
|
|
warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n"; |
1764
|
|
|
|
|
|
|
return undef; |
1765
|
|
|
|
|
|
|
}, |
1766
|
|
|
|
|
|
|
}, |
1767
|
|
|
|
|
|
|
Geosync => { |
1768
|
|
|
|
|
|
|
Writable => 1, |
1769
|
|
|
|
|
|
|
WriteOnly => 1, |
1770
|
|
|
|
|
|
|
WriteNothing => 1, |
1771
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1772
|
|
|
|
|
|
|
Shift => 'Time', # enables "+=" syntax as well as "=+" |
1773
|
|
|
|
|
|
|
Notes => q{ |
1774
|
|
|
|
|
|
|
this write-only tag specifies a time difference to add to Geotime for |
1775
|
|
|
|
|
|
|
synchronization with the GPS clock. For example, set this to "-12" if the |
1776
|
|
|
|
|
|
|
camera clock is 12 seconds faster than GPS time. Input format is |
1777
|
|
|
|
|
|
|
"[+-][[[DD ]HH:]MM:]SS[.ss]". Additional features allow calculation of time |
1778
|
|
|
|
|
|
|
differences and time drifts, and extraction of synchronization times from |
1779
|
|
|
|
|
|
|
image files. See the L for details |
1780
|
|
|
|
|
|
|
}, |
1781
|
|
|
|
|
|
|
ValueConvInv => q{ |
1782
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1783
|
|
|
|
|
|
|
return Image::ExifTool::Geotag::ConvertGeosync($self, $val); |
1784
|
|
|
|
|
|
|
}, |
1785
|
|
|
|
|
|
|
}, |
1786
|
|
|
|
|
|
|
ForceWrite => { |
1787
|
|
|
|
|
|
|
Groups => { 0 => '*', 1 => '*', 2 => '*' }, |
1788
|
|
|
|
|
|
|
Writable => 1, |
1789
|
|
|
|
|
|
|
WriteOnly => 1, |
1790
|
|
|
|
|
|
|
Notes => q{ |
1791
|
|
|
|
|
|
|
write-only tag used to force metadata in a file to be rewritten even if no |
1792
|
|
|
|
|
|
|
tag values are changed. May be set to "EXIF", "IPTC", "XMP" or "PNG" to |
1793
|
|
|
|
|
|
|
force the corresponding metadata type to be rewritten, "FixBase" to cause |
1794
|
|
|
|
|
|
|
EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All" |
1795
|
|
|
|
|
|
|
to rewrite all of these metadata types. Values are case insensitive, and |
1796
|
|
|
|
|
|
|
multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp> |
1797
|
|
|
|
|
|
|
}, |
1798
|
|
|
|
|
|
|
}, |
1799
|
|
|
|
|
|
|
EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } }, |
1800
|
|
|
|
|
|
|
Trailer => { |
1801
|
|
|
|
|
|
|
Groups => { 0 => 'Trailer' }, |
1802
|
|
|
|
|
|
|
Notes => q{ |
1803
|
|
|
|
|
|
|
the full JPEG trailer data block. Extracted only if specifically requested |
1804
|
|
|
|
|
|
|
or the API RequestAll option is set to 3 or higher |
1805
|
|
|
|
|
|
|
}, |
1806
|
|
|
|
|
|
|
Writable => 1, |
1807
|
|
|
|
|
|
|
Protected => 1, |
1808
|
|
|
|
|
|
|
}, |
1809
|
|
|
|
|
|
|
PageCount => { Notes => 'the number of pages in a multi-page TIFF document' }, |
1810
|
|
|
|
|
|
|
); |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
# tags defined by UserParam option (added at runtime) |
1813
|
|
|
|
|
|
|
%Image::ExifTool::UserParam = ( |
1814
|
|
|
|
|
|
|
GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' }, |
1815
|
|
|
|
|
|
|
PRIORITY => 0, |
1816
|
|
|
|
|
|
|
); |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
# YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP) |
1819
|
|
|
|
|
|
|
%Image::ExifTool::JPEG::yCbCrSubSampling = ( |
1820
|
|
|
|
|
|
|
'1 1' => 'YCbCr4:4:4 (1 1)', #PH |
1821
|
|
|
|
|
|
|
'2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm |
1822
|
|
|
|
|
|
|
'2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm |
1823
|
|
|
|
|
|
|
'4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm |
1824
|
|
|
|
|
|
|
'4 2' => 'YCbCr4:1:0 (4 2)', #PH |
1825
|
|
|
|
|
|
|
'1 2' => 'YCbCr4:4:0 (1 2)', #PH |
1826
|
|
|
|
|
|
|
'1 4' => 'YCbCr4:4:1 (1 4)', #JD |
1827
|
|
|
|
|
|
|
'2 4' => 'YCbCr4:2:1 (2 4)', #JD |
1828
|
|
|
|
|
|
|
); |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
# define common JPEG segments here to avoid overhead of loading JPEG module |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
# JPEG SOF (start of frame) tags |
1833
|
|
|
|
|
|
|
# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf) |
1834
|
|
|
|
|
|
|
%Image::ExifTool::JPEG::SOF = ( |
1835
|
|
|
|
|
|
|
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, |
1836
|
|
|
|
|
|
|
NOTES => 'This information is extracted from the JPEG Start Of Frame segment.', |
1837
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags |
1838
|
|
|
|
|
|
|
EncodingProcess => { |
1839
|
|
|
|
|
|
|
PrintHex => 1, |
1840
|
|
|
|
|
|
|
PrintConv => { |
1841
|
|
|
|
|
|
|
0x0 => 'Baseline DCT, Huffman coding', |
1842
|
|
|
|
|
|
|
0x1 => 'Extended sequential DCT, Huffman coding', |
1843
|
|
|
|
|
|
|
0x2 => 'Progressive DCT, Huffman coding', |
1844
|
|
|
|
|
|
|
0x3 => 'Lossless, Huffman coding', |
1845
|
|
|
|
|
|
|
0x5 => 'Sequential DCT, differential Huffman coding', |
1846
|
|
|
|
|
|
|
0x6 => 'Progressive DCT, differential Huffman coding', |
1847
|
|
|
|
|
|
|
0x7 => 'Lossless, Differential Huffman coding', |
1848
|
|
|
|
|
|
|
0x9 => 'Extended sequential DCT, arithmetic coding', |
1849
|
|
|
|
|
|
|
0xa => 'Progressive DCT, arithmetic coding', |
1850
|
|
|
|
|
|
|
0xb => 'Lossless, arithmetic coding', |
1851
|
|
|
|
|
|
|
0xd => 'Sequential DCT, differential arithmetic coding', |
1852
|
|
|
|
|
|
|
0xe => 'Progressive DCT, differential arithmetic coding', |
1853
|
|
|
|
|
|
|
0xf => 'Lossless, differential arithmetic coding', |
1854
|
|
|
|
|
|
|
} |
1855
|
|
|
|
|
|
|
}, |
1856
|
|
|
|
|
|
|
BitsPerSample => { }, |
1857
|
|
|
|
|
|
|
ImageHeight => { }, |
1858
|
|
|
|
|
|
|
ImageWidth => { }, |
1859
|
|
|
|
|
|
|
ColorComponents => { }, |
1860
|
|
|
|
|
|
|
YCbCrSubSampling => { |
1861
|
|
|
|
|
|
|
Notes => 'calculated from components table', |
1862
|
|
|
|
|
|
|
PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling, |
1863
|
|
|
|
|
|
|
}, |
1864
|
|
|
|
|
|
|
); |
1865
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
# JPEG JFIF APP0 definitions |
1867
|
|
|
|
|
|
|
%Image::ExifTool::JFIF::Main = ( |
1868
|
|
|
|
|
|
|
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, |
1869
|
|
|
|
|
|
|
WRITE_PROC => \&Image::ExifTool::WriteBinaryData, |
1870
|
|
|
|
|
|
|
CHECK_PROC => \&Image::ExifTool::CheckBinaryData, |
1871
|
|
|
|
|
|
|
GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' }, |
1872
|
|
|
|
|
|
|
DATAMEMBER => [ 2, 3, 5 ], |
1873
|
|
|
|
|
|
|
0 => { |
1874
|
|
|
|
|
|
|
Name => 'JFIFVersion', |
1875
|
|
|
|
|
|
|
Format => 'int8u[2]', |
1876
|
|
|
|
|
|
|
PrintConv => 'sprintf("%d.%.2d", split(" ",$val))', |
1877
|
|
|
|
|
|
|
Mandatory => 1, |
1878
|
|
|
|
|
|
|
}, |
1879
|
|
|
|
|
|
|
2 => { |
1880
|
|
|
|
|
|
|
Name => 'ResolutionUnit', |
1881
|
|
|
|
|
|
|
Writable => 1, |
1882
|
|
|
|
|
|
|
RawConv => '$$self{JFIFResolutionUnit} = $val', |
1883
|
|
|
|
|
|
|
PrintConv => { |
1884
|
|
|
|
|
|
|
0 => 'None', |
1885
|
|
|
|
|
|
|
1 => 'inches', |
1886
|
|
|
|
|
|
|
2 => 'cm', |
1887
|
|
|
|
|
|
|
}, |
1888
|
|
|
|
|
|
|
Priority => -1, |
1889
|
|
|
|
|
|
|
Mandatory => 1, |
1890
|
|
|
|
|
|
|
}, |
1891
|
|
|
|
|
|
|
3 => { |
1892
|
|
|
|
|
|
|
Name => 'XResolution', |
1893
|
|
|
|
|
|
|
Format => 'int16u', |
1894
|
|
|
|
|
|
|
Writable => 1, |
1895
|
|
|
|
|
|
|
Priority => -1, |
1896
|
|
|
|
|
|
|
RawConv => '$$self{JFIFXResolution} = $val', |
1897
|
|
|
|
|
|
|
Mandatory => 1, |
1898
|
|
|
|
|
|
|
}, |
1899
|
|
|
|
|
|
|
5 => { |
1900
|
|
|
|
|
|
|
Name => 'YResolution', |
1901
|
|
|
|
|
|
|
Format => 'int16u', |
1902
|
|
|
|
|
|
|
Writable => 1, |
1903
|
|
|
|
|
|
|
Priority => -1, |
1904
|
|
|
|
|
|
|
RawConv => '$$self{JFIFYResolution} = $val', |
1905
|
|
|
|
|
|
|
Mandatory => 1, |
1906
|
|
|
|
|
|
|
}, |
1907
|
|
|
|
|
|
|
7 => { |
1908
|
|
|
|
|
|
|
Name => 'ThumbnailWidth', |
1909
|
|
|
|
|
|
|
RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef', |
1910
|
|
|
|
|
|
|
}, |
1911
|
|
|
|
|
|
|
8 => { |
1912
|
|
|
|
|
|
|
Name => 'ThumbnailHeight', |
1913
|
|
|
|
|
|
|
RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef', |
1914
|
|
|
|
|
|
|
}, |
1915
|
|
|
|
|
|
|
9 => { |
1916
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1917
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1918
|
|
|
|
|
|
|
Format => 'undef[3*($val{7}||0)*($val{8}||0)]', |
1919
|
|
|
|
|
|
|
Notes => 'raw RGB thumbnail data, extracted as a TIFF image', |
1920
|
|
|
|
|
|
|
RawConv => 'length($val) ? $val : undef', |
1921
|
|
|
|
|
|
|
ValueConv => sub { |
1922
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1923
|
|
|
|
|
|
|
my $len = length $val; |
1924
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1925
|
|
|
|
|
|
|
my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val; |
1926
|
|
|
|
|
|
|
return \$img; |
1927
|
|
|
|
|
|
|
}, |
1928
|
|
|
|
|
|
|
}, |
1929
|
|
|
|
|
|
|
); |
1930
|
|
|
|
|
|
|
%Image::ExifTool::JFIF::Extension = ( |
1931
|
|
|
|
|
|
|
GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' }, |
1932
|
|
|
|
|
|
|
NOTES => 'Thumbnail images extracted from the JFXX segment.', |
1933
|
|
|
|
|
|
|
0x10 => { |
1934
|
|
|
|
|
|
|
Name => 'ThumbnailImage', |
1935
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1936
|
|
|
|
|
|
|
Notes => 'JPEG-format thumbnail image', |
1937
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(\$val,$tag)', |
1938
|
|
|
|
|
|
|
}, |
1939
|
|
|
|
|
|
|
0x11 => { # (untested) |
1940
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1941
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1942
|
|
|
|
|
|
|
Notes => 'raw palette-color thumbnail data, extracted as a TIFF image', |
1943
|
|
|
|
|
|
|
RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef', |
1944
|
|
|
|
|
|
|
ValueConv => sub { |
1945
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1946
|
|
|
|
|
|
|
my $len = length $val; |
1947
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1948
|
|
|
|
|
|
|
my ($w, $h) = unpack('CC', $val); |
1949
|
|
|
|
|
|
|
my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770); |
1950
|
|
|
|
|
|
|
return \$img; |
1951
|
|
|
|
|
|
|
}, |
1952
|
|
|
|
|
|
|
}, |
1953
|
|
|
|
|
|
|
0x13 => { |
1954
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1955
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1956
|
|
|
|
|
|
|
Notes => 'raw RGB thumbnail data, extracted as a TIFF image', |
1957
|
|
|
|
|
|
|
RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef', |
1958
|
|
|
|
|
|
|
ValueConv => sub { |
1959
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1960
|
|
|
|
|
|
|
my $len = length $val; |
1961
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1962
|
|
|
|
|
|
|
my ($w, $h) = unpack('CC', $val); |
1963
|
|
|
|
|
|
|
my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2); |
1964
|
|
|
|
|
|
|
return \$img; |
1965
|
|
|
|
|
|
|
}, |
1966
|
|
|
|
|
|
|
}, |
1967
|
|
|
|
|
|
|
# Apple may add "AMPF" to the end of the JFIF record, |
1968
|
|
|
|
|
|
|
# possibly indicating the existence of MPF images (ref forum12677) |
1969
|
|
|
|
|
|
|
); |
1970
|
|
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
# Composite tags (accumulation of all Composite tag tables) |
1972
|
|
|
|
|
|
|
%Image::ExifTool::Composite = ( |
1973
|
|
|
|
|
|
|
GROUPS => { 0 => 'Composite', 1 => 'Composite' }, |
1974
|
|
|
|
|
|
|
TABLE_NAME => 'Image::ExifTool::Composite', |
1975
|
|
|
|
|
|
|
SHORT_NAME => 'Composite', |
1976
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags |
1977
|
|
|
|
|
|
|
WRITE_PROC => \&DummyWriteProc, |
1978
|
|
|
|
|
|
|
); |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
my %compositeID; # lookup for new ID's of Composite tags based on original ID |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
# static private ExifTool variables |
1983
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
%allTables = ( ); # list of all tables loaded (except Composite tags) |
1985
|
|
|
|
|
|
|
@tableOrder = ( ); # order the tables were loaded |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1988
|
|
|
|
|
|
|
# Warning handler routines (warning string stored in $evalWarning) |
1989
|
|
|
|
|
|
|
# |
1990
|
|
|
|
|
|
|
# Set warning message |
1991
|
|
|
|
|
|
|
# Inputs: 0) warning string (undef to reset warning) |
1992
|
38
|
|
|
38
|
0
|
576
|
sub SetWarning($) { $evalWarning = $_[0]; } |
1993
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
# Get warning message |
1995
|
17
|
|
|
17
|
0
|
69
|
sub GetWarning() { return $evalWarning; } |
1996
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
# Clean unnecessary information (line number, LF) from warning |
1998
|
|
|
|
|
|
|
# Inputs: 0) warning string or undef to use $evalWarning |
1999
|
|
|
|
|
|
|
# Returns: cleaned warning |
2000
|
|
|
|
|
|
|
sub CleanWarning(;$) |
2001
|
|
|
|
|
|
|
{ |
2002
|
223
|
|
|
223
|
0
|
457
|
my $str = shift; |
2003
|
223
|
50
|
|
|
|
621
|
unless (defined $str) { |
2004
|
223
|
50
|
|
|
|
539
|
return undef unless defined $evalWarning; |
2005
|
223
|
|
|
|
|
452
|
$str = $evalWarning; |
2006
|
|
|
|
|
|
|
} |
2007
|
223
|
100
|
|
|
|
1499
|
$str = $1 if $str =~ /(.*) at /s; |
2008
|
223
|
|
|
|
|
829
|
$str =~ s/\s+$//s; |
2009
|
223
|
|
|
|
|
1062
|
return $str; |
2010
|
|
|
|
|
|
|
} |
2011
|
|
|
|
|
|
|
|
2012
|
|
|
|
|
|
|
#============================================================================== |
2013
|
|
|
|
|
|
|
# New - create new ExifTool object |
2014
|
|
|
|
|
|
|
# Inputs: 0) reference to exiftool object or ExifTool class name |
2015
|
|
|
|
|
|
|
# Returns: blessed ExifTool object ref |
2016
|
|
|
|
|
|
|
sub new |
2017
|
|
|
|
|
|
|
{ |
2018
|
475
|
|
|
475
|
1
|
132048
|
local $_; |
2019
|
475
|
|
|
|
|
1349
|
my $that = shift; |
2020
|
475
|
|
50
|
|
|
3836
|
my $class = ref($that) || $that || 'Image::ExifTool'; |
2021
|
475
|
|
|
|
|
1723
|
my $self = bless {}, $class; |
2022
|
|
|
|
|
|
|
|
2023
|
|
|
|
|
|
|
# make sure our main Exif tag table has been loaded |
2024
|
475
|
|
|
|
|
2123
|
GetTagTable("Image::ExifTool::Exif::Main"); |
2025
|
|
|
|
|
|
|
|
2026
|
475
|
|
|
|
|
3187
|
$self->ClearOptions(); # create default options hash |
2027
|
475
|
|
|
|
|
1432
|
$$self{VALUE} = { }; # must initialize this for warning messages |
2028
|
475
|
|
|
|
|
1589
|
$$self{PATH} = [ ]; # (this too) |
2029
|
475
|
|
|
|
|
1410
|
$$self{DEL_GROUP} = { }; # lookup for groups to delete when writing |
2030
|
475
|
|
|
|
|
1303
|
$$self{SAVE_COUNT} = 0; # count calls to SaveNewValues() |
2031
|
475
|
|
|
|
|
1258
|
$$self{FILE_SEQUENCE} = 0; # sequence number for files when reading |
2032
|
|
|
|
|
|
|
|
2033
|
|
|
|
|
|
|
# initialize our new groups for writing |
2034
|
475
|
|
|
|
|
2573
|
$self->SetNewGroups(@defaultWriteGroups); |
2035
|
|
|
|
|
|
|
|
2036
|
475
|
|
|
|
|
2309
|
return $self; |
2037
|
|
|
|
|
|
|
} |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2040
|
|
|
|
|
|
|
# ImageInfo - return specified information from image file |
2041
|
|
|
|
|
|
|
# Inputs: 0) [optional] ExifTool object reference |
2042
|
|
|
|
|
|
|
# 1) filename, file reference, or scalar data reference |
2043
|
|
|
|
|
|
|
# 2-N) list of tag names to find (or tag list reference or options reference) |
2044
|
|
|
|
|
|
|
# Returns: reference to hash of tag/value pairs (with "Error" entry on error) |
2045
|
|
|
|
|
|
|
# Notes: |
2046
|
|
|
|
|
|
|
# - if no tags names are specified, the values of all tags are returned |
2047
|
|
|
|
|
|
|
# - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv |
2048
|
|
|
|
|
|
|
# - can pass a reference to list of tags to find, in which case the list will |
2049
|
|
|
|
|
|
|
# be updated with the tags found in the proper case and in the specified order. |
2050
|
|
|
|
|
|
|
# - can pass reference to hash specifying options |
2051
|
|
|
|
|
|
|
# - returned tag values may be scalar references indicating binary data |
2052
|
|
|
|
|
|
|
# - see ClearOptions() below for a list of options and their default values |
2053
|
|
|
|
|
|
|
# Examples: |
2054
|
|
|
|
|
|
|
# use Image::ExifTool 'ImageInfo'; |
2055
|
|
|
|
|
|
|
# my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize'); |
2056
|
|
|
|
|
|
|
# - or - |
2057
|
|
|
|
|
|
|
# my $et = new Image::ExifTool; |
2058
|
|
|
|
|
|
|
# my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} ); |
2059
|
|
|
|
|
|
|
sub ImageInfo($;@) |
2060
|
|
|
|
|
|
|
{ |
2061
|
510
|
|
|
510
|
1
|
30240
|
local $_; |
2062
|
|
|
|
|
|
|
# get our ExifTool object ($self) or create one if necessary |
2063
|
510
|
|
|
|
|
1117
|
my $self; |
2064
|
510
|
100
|
100
|
|
|
5928
|
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) { |
2065
|
501
|
|
|
|
|
1518
|
$self = shift; |
2066
|
|
|
|
|
|
|
} else { |
2067
|
9
|
|
|
|
|
75
|
$self = new Image::ExifTool; |
2068
|
|
|
|
|
|
|
} |
2069
|
510
|
|
|
|
|
1213
|
my %saveOptions = %{$$self{OPTIONS}}; # save original options |
|
510
|
|
|
|
|
22555
|
|
2070
|
|
|
|
|
|
|
|
2071
|
|
|
|
|
|
|
# initialize file information |
2072
|
510
|
|
|
|
|
4111
|
$$self{FILENAME} = $$self{RAF} = undef; |
2073
|
|
|
|
|
|
|
|
2074
|
510
|
|
|
|
|
3067
|
$self->ParseArguments(@_); # parse our function arguments |
2075
|
510
|
|
|
|
|
3000
|
$self->ExtractInfo(undef); # extract meta information from image |
2076
|
510
|
|
|
|
|
2751
|
my $info = $self->GetInfo(undef); # get requested information |
2077
|
|
|
|
|
|
|
|
2078
|
510
|
|
|
|
|
8042
|
$$self{OPTIONS} = \%saveOptions; # restore original options |
2079
|
|
|
|
|
|
|
|
2080
|
510
|
|
|
|
|
3391
|
return $info; # return requested information |
2081
|
|
|
|
|
|
|
} |
2082
|
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2084
|
|
|
|
|
|
|
# Get/set ExifTool options |
2085
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, |
2086
|
|
|
|
|
|
|
# 1) Parameter name (case insensitive), 2) Value to set the option |
2087
|
|
|
|
|
|
|
# 3-N) More parameter/value pairs |
2088
|
|
|
|
|
|
|
# Returns: original value of last option specified |
2089
|
|
|
|
|
|
|
sub Options($$;@) |
2090
|
|
|
|
|
|
|
{ |
2091
|
17518
|
|
|
17518
|
1
|
43136
|
local $_; |
2092
|
17518
|
|
|
|
|
25665
|
my $self = shift; |
2093
|
17518
|
|
|
|
|
28681
|
my $options = $$self{OPTIONS}; |
2094
|
17518
|
|
|
|
|
24373
|
my $oldVal; |
2095
|
|
|
|
|
|
|
|
2096
|
17518
|
|
|
|
|
38260
|
while (@_) { |
2097
|
20224
|
|
|
|
|
32776
|
my $param = shift; |
2098
|
|
|
|
|
|
|
# fix parameter case if necessary |
2099
|
20224
|
100
|
|
|
|
45469
|
unless (exists $$options{$param}) { |
2100
|
376
|
|
|
|
|
23242
|
my ($fixed) = grep /^$param$/i, keys %$options; |
2101
|
376
|
50
|
|
|
|
2746
|
if ($fixed) { |
2102
|
0
|
|
|
|
|
0
|
$param = $fixed; |
2103
|
|
|
|
|
|
|
} else { |
2104
|
376
|
|
|
|
|
1759
|
$param =~ s/^Group(\d*)$/Group$1/i; |
2105
|
|
|
|
|
|
|
} |
2106
|
|
|
|
|
|
|
} |
2107
|
20224
|
|
|
|
|
33624
|
$oldVal = $$options{$param}; |
2108
|
20224
|
50
|
33
|
|
|
42219
|
if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) { |
|
|
|
66
|
|
|
|
|
2109
|
|
|
|
|
|
|
# get previous Compact/XMPShorthand setting |
2110
|
0
|
|
|
|
|
0
|
$oldVal = $$oldVal{$param}; |
2111
|
|
|
|
|
|
|
} |
2112
|
20224
|
100
|
|
|
|
43498
|
last unless @_; |
2113
|
4838
|
|
|
|
|
7476
|
my $newVal = shift; |
2114
|
4838
|
100
|
66
|
|
|
39180
|
if ($param eq 'Lang') { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2115
|
|
|
|
|
|
|
# allow this to be set to undef to select the default language |
2116
|
76
|
50
|
|
|
|
379
|
$newVal = $defaultLang unless defined $newVal; |
2117
|
76
|
100
|
|
|
|
313
|
if ($newVal eq $defaultLang) { |
2118
|
58
|
|
|
|
|
169
|
$$options{$param} = $newVal; |
2119
|
58
|
|
|
|
|
204
|
delete $$self{CUR_LANG}; |
2120
|
|
|
|
|
|
|
# make sure the language is available |
2121
|
|
|
|
|
|
|
} else { |
2122
|
18
|
|
|
|
|
61
|
my %langs = map { $_ => 1 } @langs; |
|
324
|
|
|
|
|
647
|
|
2123
|
18
|
50
|
33
|
|
|
1373
|
if ($langs{$newVal} and eval "require Image::ExifTool::Lang::$newVal") { |
2124
|
18
|
|
|
|
|
116
|
my $xlat = "Image::ExifTool::Lang::${newVal}::Translate"; |
2125
|
105
|
|
|
105
|
|
1046
|
no strict 'refs'; |
|
105
|
|
|
|
|
282
|
|
|
105
|
|
|
|
|
437710
|
|
2126
|
18
|
50
|
|
|
|
135
|
if (%$xlat) { |
2127
|
18
|
|
|
|
|
87
|
$$self{CUR_LANG} = \%$xlat; |
2128
|
18
|
|
|
|
|
172
|
$$options{$param} = $newVal; |
2129
|
|
|
|
|
|
|
} |
2130
|
|
|
|
|
|
|
} |
2131
|
|
|
|
|
|
|
} # else don't change Lang |
2132
|
|
|
|
|
|
|
} elsif ($param eq 'Exclude' and defined $newVal) { |
2133
|
|
|
|
|
|
|
# clone Exclude list and expand shortcuts |
2134
|
7
|
|
|
|
|
21
|
my @exclude; |
2135
|
7
|
100
|
|
|
|
40
|
if (ref $newVal eq 'ARRAY') { |
2136
|
6
|
|
|
|
|
28
|
@exclude = @$newVal; |
2137
|
|
|
|
|
|
|
} else { |
2138
|
1
|
|
|
|
|
4
|
@exclude = ($newVal); |
2139
|
|
|
|
|
|
|
} |
2140
|
7
|
|
|
|
|
35
|
ExpandShortcuts(\@exclude, 1); # (also remove '#' suffix) |
2141
|
7
|
|
|
|
|
37
|
$$options{$param} = \@exclude; |
2142
|
|
|
|
|
|
|
} elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') { |
2143
|
|
|
|
|
|
|
# only allow valid character sets to be set |
2144
|
358
|
100
|
66
|
|
|
1554
|
if ($newVal) { |
|
|
50
|
33
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2145
|
241
|
|
|
|
|
681
|
my $charset = $charsetName{lc $newVal}; |
2146
|
241
|
50
|
|
|
|
527
|
if ($charset) { |
2147
|
241
|
|
|
|
|
458
|
$$options{$param} = $charset; |
2148
|
|
|
|
|
|
|
# maintain backward-compatibility with old IPTCCharset option |
2149
|
241
|
100
|
|
|
|
752
|
$$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset'; |
2150
|
|
|
|
|
|
|
} else { |
2151
|
0
|
|
|
|
|
0
|
warn "Invalid Charset $newVal\n"; |
2152
|
|
|
|
|
|
|
} |
2153
|
|
|
|
|
|
|
} elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') { |
2154
|
117
|
|
|
|
|
388
|
$$options{$param} = $newVal; # only these may be set to a false value |
2155
|
|
|
|
|
|
|
} elsif ($param eq 'CharsetQuickTime') { |
2156
|
0
|
|
|
|
|
0
|
$$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman |
2157
|
|
|
|
|
|
|
} else { |
2158
|
0
|
|
|
|
|
0
|
$$options{$param} = 'Latin'; # all others default to Latin |
2159
|
|
|
|
|
|
|
} |
2160
|
|
|
|
|
|
|
} elsif ($param eq 'UserParam') { |
2161
|
|
|
|
|
|
|
# clear options if $newVal is undef |
2162
|
58
|
50
|
|
|
|
289
|
defined $newVal or $$options{$param} = {}, next; |
2163
|
58
|
|
|
|
|
248
|
my $table = GetTagTable('Image::ExifTool::UserParam'); |
2164
|
|
|
|
|
|
|
# allow initialization of entire UserParam hash |
2165
|
58
|
50
|
|
|
|
352
|
if (ref $newVal eq 'HASH') { |
2166
|
58
|
|
|
|
|
140
|
my %newParams; |
2167
|
58
|
|
|
|
|
344
|
foreach (sort keys %$newVal) { |
2168
|
0
|
|
|
|
|
0
|
my $lcTag = lc $_; |
2169
|
0
|
|
|
|
|
0
|
$newParams{$lcTag} = $$newVal{$_}; |
2170
|
0
|
|
|
|
|
0
|
delete $$table{$lcTag}; |
2171
|
0
|
|
|
|
|
0
|
AddTagToTable($table, $lcTag, $_); |
2172
|
|
|
|
|
|
|
} |
2173
|
58
|
|
|
|
|
205
|
$$options{$param} = \%newParams; |
2174
|
58
|
|
|
|
|
229
|
next; |
2175
|
|
|
|
|
|
|
} |
2176
|
0
|
|
|
|
|
0
|
my ($force, $paramName); |
2177
|
|
|
|
|
|
|
# set/reset single UserParam parameter |
2178
|
0
|
0
|
|
|
|
0
|
if ($newVal =~ /(.*?)=(.*)/s) { |
2179
|
0
|
|
|
|
|
0
|
$paramName = $1; |
2180
|
0
|
|
|
|
|
0
|
$newVal = $2; |
2181
|
0
|
0
|
|
|
|
0
|
$force = 1 if $paramName =~ s/\^$//; |
2182
|
0
|
|
|
|
|
0
|
$paramName =~ tr/-_a-zA-Z0-9#//dc; |
2183
|
0
|
|
|
|
|
0
|
$param = lc $paramName; |
2184
|
|
|
|
|
|
|
} else { |
2185
|
0
|
|
|
|
|
0
|
($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc; |
2186
|
0
|
|
|
|
|
0
|
undef $newVal; |
2187
|
|
|
|
|
|
|
} |
2188
|
0
|
|
|
|
|
0
|
delete $$table{$param}; |
2189
|
0
|
|
|
|
|
0
|
$oldVal = $$options{UserParam}{$param}; |
2190
|
0
|
0
|
|
|
|
0
|
if (defined $newVal) { |
2191
|
0
|
0
|
0
|
|
|
0
|
if (length $newVal or $force) { |
2192
|
0
|
|
|
|
|
0
|
$$options{UserParam}{$param} = $newVal; |
2193
|
0
|
|
|
|
|
0
|
AddTagToTable($table, $param, $paramName); |
2194
|
|
|
|
|
|
|
} else { |
2195
|
0
|
|
|
|
|
0
|
delete $$options{UserParam}{$param}; |
2196
|
|
|
|
|
|
|
} |
2197
|
|
|
|
|
|
|
} |
2198
|
|
|
|
|
|
|
# remove alternate version of tag |
2199
|
0
|
0
|
|
|
|
0
|
$param .= '#' unless $param =~ s/#$//; |
2200
|
0
|
|
|
|
|
0
|
delete $$table{$param}; |
2201
|
0
|
|
|
|
|
0
|
delete $$options{UserParam}{$param}; |
2202
|
|
|
|
|
|
|
} elsif ($param eq 'RequestTags') { |
2203
|
100
|
100
|
|
|
|
511
|
if (defined $newVal) { |
2204
|
|
|
|
|
|
|
# parse list from delimited string if necessary |
2205
|
42
|
50
|
|
|
|
363
|
my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); |
2206
|
42
|
|
|
|
|
198
|
ExpandShortcuts(\@reqList); |
2207
|
|
|
|
|
|
|
# add to existing list |
2208
|
42
|
50
|
|
|
|
346
|
$$options{$param} or $$options{$param} = [ ]; |
2209
|
42
|
|
|
|
|
166
|
foreach (@reqList) { |
2210
|
56
|
50
|
|
|
|
425
|
/^(.*:)?([-\w?*]*)#?$/ or next; |
2211
|
56
|
50
|
|
|
|
256
|
push @{$$options{$param}}, lc($2) if $2; |
|
56
|
|
|
|
|
261
|
|
2212
|
56
|
50
|
|
|
|
319
|
next unless $1; |
2213
|
|
|
|
|
|
|
# add requested groups with trailing colon |
2214
|
0
|
|
|
|
|
0
|
push @{$$options{$param}}, lc($_).':' foreach split /:/, $1; |
|
0
|
|
|
|
|
0
|
|
2215
|
|
|
|
|
|
|
} |
2216
|
|
|
|
|
|
|
} else { |
2217
|
58
|
|
|
|
|
205
|
$$options{$param} = undef; # clear the list |
2218
|
|
|
|
|
|
|
} |
2219
|
|
|
|
|
|
|
} elsif ($param eq 'IgnoreTags') { |
2220
|
58
|
50
|
|
|
|
349
|
if (defined $newVal) { |
2221
|
|
|
|
|
|
|
# parse list from delimited string if necessary |
2222
|
0
|
0
|
|
|
|
0
|
my @ignoreList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); |
2223
|
0
|
|
|
|
|
0
|
ExpandShortcuts(\@ignoreList); |
2224
|
|
|
|
|
|
|
# add to existing tags to ignore |
2225
|
0
|
0
|
|
|
|
0
|
$$options{$param} or $$options{$param} = { }; |
2226
|
0
|
|
|
|
|
0
|
foreach (@ignoreList) { |
2227
|
0
|
0
|
|
|
|
0
|
/^(.*:)?([-\w?*]+)#?$/ or next; |
2228
|
0
|
|
|
|
|
0
|
$$options{$param}{lc $2} = 1; |
2229
|
|
|
|
|
|
|
} |
2230
|
|
|
|
|
|
|
} else { |
2231
|
58
|
|
|
|
|
223
|
$$options{$param} = undef; # clear the option |
2232
|
|
|
|
|
|
|
} |
2233
|
|
|
|
|
|
|
} elsif ($param eq 'ListJoin') { |
2234
|
10
|
|
|
|
|
43
|
$$options{$param} = $newVal; |
2235
|
|
|
|
|
|
|
# set the old List and ListSep options for backward compatibility |
2236
|
10
|
100
|
|
|
|
50
|
if (defined $newVal) { |
2237
|
4
|
|
|
|
|
17
|
$$options{List} = 0; |
2238
|
4
|
|
|
|
|
17
|
$$options{ListSep} = $newVal; |
2239
|
|
|
|
|
|
|
} else { |
2240
|
6
|
|
|
|
|
24
|
$$options{List} = 1; |
2241
|
|
|
|
|
|
|
# (ListSep must be defined) |
2242
|
|
|
|
|
|
|
} |
2243
|
|
|
|
|
|
|
} elsif ($param eq 'List') { |
2244
|
77
|
|
|
|
|
290
|
$$options{$param} = $newVal; |
2245
|
|
|
|
|
|
|
# set the new ListJoin option for forward compatibility |
2246
|
77
|
50
|
|
|
|
391
|
$$options{ListJoin} = $newVal ? undef : $$options{ListSep}; |
2247
|
|
|
|
|
|
|
} elsif ($param eq 'Compact' or $param eq 'XMPShorthand') { |
2248
|
|
|
|
|
|
|
# set Compact and XMPShorthand options, preserving backward compatibility |
2249
|
1
|
|
|
|
|
4
|
my ($p, %compact); |
2250
|
1
|
|
|
|
|
4
|
foreach $p ('Compact','XMPShorthand') { |
2251
|
2
|
100
|
|
|
|
21
|
my $val = $param eq $p ? $newVal : $$options{Compact}{$p}; |
2252
|
2
|
100
|
|
|
|
6
|
if (defined $val) { |
2253
|
1
|
|
|
|
|
9
|
my @v = ($val =~ /\w+/g); |
2254
|
1
|
50
|
|
|
|
5
|
my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt; |
2255
|
1
|
|
|
|
|
3
|
foreach (@v) { |
2256
|
1
|
50
|
|
|
|
7
|
my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal; |
2257
|
1
|
50
|
|
|
|
8
|
ref $set or $compact{$set} = 1, next; |
2258
|
0
|
|
|
|
|
0
|
$compact{$_} = 1 foreach @$set; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
} |
2261
|
2
|
|
|
|
|
7
|
$compact{$p} = $val; # preserve most recent setting |
2262
|
|
|
|
|
|
|
} |
2263
|
1
|
|
|
|
|
6
|
$$options{Compact} = $$options{XMPShorthand} = \%compact; |
2264
|
|
|
|
|
|
|
} else { |
2265
|
4093
|
100
|
66
|
|
|
16721
|
if ($param eq 'Escape') { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2266
|
|
|
|
|
|
|
# set ESCAPE_PROC |
2267
|
64
|
50
|
66
|
|
|
710
|
if (defined $newVal and $newVal eq 'XML') { |
|
|
100
|
66
|
|
|
|
|
2268
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
2269
|
0
|
|
|
|
|
0
|
$$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML; |
2270
|
|
|
|
|
|
|
} elsif (defined $newVal and $newVal eq 'HTML') { |
2271
|
5
|
|
|
|
|
1771
|
require Image::ExifTool::HTML; |
2272
|
5
|
|
|
|
|
26
|
$$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML; |
2273
|
|
|
|
|
|
|
} else { |
2274
|
59
|
|
|
|
|
169
|
delete $$self{ESCAPE_PROC}; |
2275
|
|
|
|
|
|
|
} |
2276
|
|
|
|
|
|
|
# must forget saved values since they depend on Escape method |
2277
|
64
|
|
|
|
|
261
|
$$self{BOTH} = { }; |
2278
|
|
|
|
|
|
|
} elsif ($param eq 'GlobalTimeShift') { |
2279
|
59
|
|
|
|
|
204
|
delete $$self{GLOBAL_TIME_OFFSET}; # reset our calculated offset |
2280
|
|
|
|
|
|
|
} elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) { |
2281
|
0
|
|
|
|
|
0
|
$ENV{TZ} = $newVal; |
2282
|
0
|
|
|
|
|
0
|
eval { require POSIX; POSIX::tzset() }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2283
|
|
|
|
|
|
|
} elsif ($param eq 'Validate') { |
2284
|
|
|
|
|
|
|
# load Validate module if Validate option enabled |
2285
|
59
|
100
|
|
|
|
1087
|
$newVal and require Image::ExifTool::Validate; |
2286
|
|
|
|
|
|
|
} |
2287
|
4093
|
|
|
|
|
10706
|
$$options{$param} = $newVal; |
2288
|
|
|
|
|
|
|
} |
2289
|
|
|
|
|
|
|
} |
2290
|
17518
|
|
|
|
|
54226
|
return $oldVal; |
2291
|
|
|
|
|
|
|
} |
2292
|
|
|
|
|
|
|
|
2293
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2294
|
|
|
|
|
|
|
# ClearOptions - set options to default values |
2295
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2296
|
|
|
|
|
|
|
sub ClearOptions($) |
2297
|
|
|
|
|
|
|
{ |
2298
|
475
|
|
|
475
|
1
|
1099
|
local $_; |
2299
|
475
|
|
|
|
|
1168
|
my $self = shift; |
2300
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
# create options hash with default values |
2302
|
|
|
|
|
|
|
# +-----------------------------------------------------+ |
2303
|
|
|
|
|
|
|
# ! DON'T FORGET!! When adding any new option, must ! |
2304
|
|
|
|
|
|
|
# ! decide how it is handled in SetNewValuesFromFile() ! |
2305
|
|
|
|
|
|
|
# +-----------------------------------------------------+ |
2306
|
|
|
|
|
|
|
# (Note: All options must exist in this lookup, even if undefined, |
2307
|
|
|
|
|
|
|
# to facilitate case-insensitive options. 'Group#' is handled specially) |
2308
|
|
|
|
|
|
|
$$self{OPTIONS} = { |
2309
|
475
|
|
|
|
|
41279
|
Binary => undef, # flag to extract binary values even if tag not specified |
2310
|
|
|
|
|
|
|
ByteOrder => undef, # default byte order when creating EXIF information |
2311
|
|
|
|
|
|
|
Charset => 'UTF8', # character set for converting Unicode characters |
2312
|
|
|
|
|
|
|
CharsetEXIF => undef, # internal EXIF "ASCII" string encoding |
2313
|
|
|
|
|
|
|
CharsetFileName => undef, # external encoding for file names |
2314
|
|
|
|
|
|
|
CharsetID3 => 'Latin', # internal ID3v1 character set |
2315
|
|
|
|
|
|
|
CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet |
2316
|
|
|
|
|
|
|
CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names |
2317
|
|
|
|
|
|
|
CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding |
2318
|
|
|
|
|
|
|
CharsetRIFF => 0, # internal RIFF string encoding (0=default to Latin) |
2319
|
|
|
|
|
|
|
Compact => { }, # write compact XMP |
2320
|
|
|
|
|
|
|
Composite => 1, # flag to calculate Composite tags |
2321
|
|
|
|
|
|
|
Compress => undef, # flag to write new values as compressed if possible |
2322
|
|
|
|
|
|
|
CoordFormat => undef, # GPS lat/long coordinate format |
2323
|
|
|
|
|
|
|
DateFormat => undef, # format for date/time |
2324
|
|
|
|
|
|
|
Duplicates => 1, # flag to save duplicate tag values |
2325
|
|
|
|
|
|
|
Escape => undef, # escape special characters |
2326
|
|
|
|
|
|
|
Exclude => undef, # tags to exclude |
2327
|
|
|
|
|
|
|
ExtendedXMP => 1, # strategy for reading extended XMP |
2328
|
|
|
|
|
|
|
ExtractEmbedded =>undef,# flag to extract information from embedded documents |
2329
|
|
|
|
|
|
|
FastScan => undef, # flag to avoid scanning for trailer |
2330
|
|
|
|
|
|
|
Filter => undef, # output filter for all tag values |
2331
|
|
|
|
|
|
|
FilterW => undef, # input filter when writing tag values |
2332
|
|
|
|
|
|
|
FixBase => undef, # fix maker notes base offsets |
2333
|
|
|
|
|
|
|
GeoMaxIntSecs => 1800, # geotag maximum interpolation time (secs) |
2334
|
|
|
|
|
|
|
GeoMaxExtSecs => 1800, # geotag maximum extrapolation time (secs) |
2335
|
|
|
|
|
|
|
GeoMaxHDOP => undef, # geotag maximum HDOP |
2336
|
|
|
|
|
|
|
GeoMaxPDOP => undef, # geotag maximum PDOP |
2337
|
|
|
|
|
|
|
GeoMinSats => undef, # geotag minimum satellites |
2338
|
|
|
|
|
|
|
GeoSpeedRef => undef, # geotag GPSSpeedRef |
2339
|
|
|
|
|
|
|
GlobalTimeShift => undef, # apply time shift to all extracted date/time values |
2340
|
|
|
|
|
|
|
# Group# => undef, # return tags for specified groups in family # |
2341
|
|
|
|
|
|
|
HexTagIDs => 0, # use hex tag ID's in family 7 group names |
2342
|
|
|
|
|
|
|
HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit) |
2343
|
|
|
|
|
|
|
HtmlDumpBase => undef, # base address for HTML dump |
2344
|
|
|
|
|
|
|
IgnoreMinorErrors => undef, # ignore minor errors when reading/writing |
2345
|
|
|
|
|
|
|
IgnoreTags => undef, # list of tags to ignore when extracting |
2346
|
|
|
|
|
|
|
Lang => $defaultLang,# localized language for descriptions etc |
2347
|
|
|
|
|
|
|
LargeFileSupport => undef, # flag indicating support of 64-bit file offsets |
2348
|
|
|
|
|
|
|
List => undef, # extract lists of PrintConv values into arrays [no longer documented] |
2349
|
|
|
|
|
|
|
ListItem => undef, # used to return a specific item from lists |
2350
|
|
|
|
|
|
|
ListJoin => ', ', # join lists together with this separator |
2351
|
|
|
|
|
|
|
ListSep => ', ', # list item separator [no longer documented] |
2352
|
|
|
|
|
|
|
ListSplit => undef, # regex for splitting list-type tag values when writing |
2353
|
|
|
|
|
|
|
MakerNotes => undef, # extract maker notes as a block |
2354
|
|
|
|
|
|
|
MDItemTags => undef, # extract MacOS metadata item tags |
2355
|
|
|
|
|
|
|
MissingTagValue =>undef,# value for missing tags when expanded in expressions |
2356
|
|
|
|
|
|
|
NoMultiExif => undef, # raise error when writing multi-segment EXIF |
2357
|
|
|
|
|
|
|
NoPDFList => undef, # flag to avoid splitting PDF List-type tag values |
2358
|
|
|
|
|
|
|
Password => undef, # password for password-protected PDF documents |
2359
|
|
|
|
|
|
|
PrintConv => 1, # flag to enable print conversion |
2360
|
|
|
|
|
|
|
QuickTimeHandler => 1, # flag to add mdir Handler to newly created Meta box |
2361
|
|
|
|
|
|
|
QuickTimePad=> undef, # flag to preserve padding of QuickTime CR3 tags |
2362
|
|
|
|
|
|
|
QuickTimeUTC=> undef, # assume that QuickTime date/time tags are stored as UTC |
2363
|
|
|
|
|
|
|
RequestAll => undef, # extract all tags that must be specifically requested |
2364
|
|
|
|
|
|
|
RequestTags => undef, # extra tags to request (on top of those in the tag list) |
2365
|
|
|
|
|
|
|
SaveFormat => undef, # save family 6 tag TIFF format |
2366
|
|
|
|
|
|
|
SavePath => undef, # save family 5 location path |
2367
|
|
|
|
|
|
|
ScanForXMP => undef, # flag to scan for XMP information in all files |
2368
|
|
|
|
|
|
|
Sort => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#) |
2369
|
|
|
|
|
|
|
Sort2 => 'File', # secondary sort order for tags in a group (File, Tag, Descr) |
2370
|
|
|
|
|
|
|
StrictDate => undef, # flag to return undef for invalid date conversions |
2371
|
|
|
|
|
|
|
Struct => undef, # return structures as hash references |
2372
|
|
|
|
|
|
|
SystemTags => undef, # extract additional File System tags |
2373
|
|
|
|
|
|
|
TextOut => \*STDOUT,# file for Verbose/HtmlDump output |
2374
|
|
|
|
|
|
|
TimeZone => undef, # local time zone |
2375
|
|
|
|
|
|
|
Unknown => 0, # flag to get values of unknown tags (0-2) |
2376
|
|
|
|
|
|
|
UserParam => { }, # user parameters for additional user-defined tag values |
2377
|
|
|
|
|
|
|
Validate => undef, # perform additional validation |
2378
|
|
|
|
|
|
|
Verbose => 0, # print verbose messages (0-5, higher # = more verbose) |
2379
|
|
|
|
|
|
|
WriteMode => 'wcg', # enable all write modes by default |
2380
|
|
|
|
|
|
|
XAttrTags => undef, # extract MacOS extended attribute tags |
2381
|
|
|
|
|
|
|
XMPAutoConv => 1, # automatic conversion of unknown XMP tag values |
2382
|
|
|
|
|
|
|
XMPShorthand=> 0, # (unused, but needed for backward compatibility) |
2383
|
|
|
|
|
|
|
}; |
2384
|
|
|
|
|
|
|
# keep necessary member variables in sync with options |
2385
|
475
|
|
|
|
|
1833
|
delete $$self{CUR_LANG}; |
2386
|
475
|
|
|
|
|
1079
|
delete $$self{ESCAPE_PROC}; |
2387
|
|
|
|
|
|
|
|
2388
|
|
|
|
|
|
|
# load user-defined default options |
2389
|
475
|
50
|
|
|
|
2345
|
if (%Image::ExifTool::UserDefined::Options) { |
2390
|
0
|
|
|
|
|
0
|
foreach (keys %Image::ExifTool::UserDefined::Options) { |
2391
|
0
|
|
|
|
|
0
|
$self->Options($_, $Image::ExifTool::UserDefined::Options{$_}); |
2392
|
|
|
|
|
|
|
} |
2393
|
|
|
|
|
|
|
} |
2394
|
|
|
|
|
|
|
} |
2395
|
|
|
|
|
|
|
|
2396
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2397
|
|
|
|
|
|
|
# Extract meta information from image |
2398
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2399
|
|
|
|
|
|
|
# 1-N) Same as ImageInfo() |
2400
|
|
|
|
|
|
|
# Returns: 1 if this was a valid image, 0 otherwise |
2401
|
|
|
|
|
|
|
# Notes: pass an undefined value to avoid parsing arguments |
2402
|
|
|
|
|
|
|
# Internal 'ReEntry' option allows this routine to be called recursively |
2403
|
|
|
|
|
|
|
sub ExtractInfo($;@) |
2404
|
|
|
|
|
|
|
{ |
2405
|
517
|
|
|
517
|
1
|
1600
|
local $_; |
2406
|
517
|
|
|
|
|
1087
|
my $self = shift; |
2407
|
517
|
|
|
|
|
1409
|
my $options = $$self{OPTIONS}; # pointer to current options |
2408
|
517
|
|
100
|
|
|
2754
|
my $fast = $$options{FastScan} || 0; |
2409
|
517
|
|
|
|
|
1354
|
my $req = $$self{REQ_TAG_LOOKUP}; |
2410
|
517
|
|
100
|
|
|
2550
|
my $reqAll = $$options{RequestAll} || 0; |
2411
|
517
|
|
|
|
|
1578
|
my (%saveOptions, $reEntry, $rsize, $zid, $type, @startTime, $saveOrder, $isDir); |
2412
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
# check for internal ReEntry option to allow recursive calls to ExtractInfo |
2414
|
517
|
100
|
100
|
|
|
3082
|
if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2415
|
|
|
|
|
|
|
(ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB')) |
2416
|
|
|
|
|
|
|
{ |
2417
|
|
|
|
|
|
|
# save necessary members for restoring later |
2418
|
|
|
|
|
|
|
$reEntry = { |
2419
|
|
|
|
|
|
|
RAF => $$self{RAF}, |
2420
|
|
|
|
|
|
|
PROCESSED => $$self{PROCESSED}, |
2421
|
|
|
|
|
|
|
EXIF_DATA => $$self{EXIF_DATA}, |
2422
|
|
|
|
|
|
|
EXIF_POS => $$self{EXIF_POS}, |
2423
|
|
|
|
|
|
|
FILE_TYPE => $$self{FILE_TYPE}, |
2424
|
2
|
|
|
|
|
19
|
}; |
2425
|
|
|
|
|
|
|
$saveOrder = GetByteOrder(), |
2426
|
2
|
|
|
|
|
8
|
$$self{RAF} = new File::RandomAccess($_[0]); |
2427
|
2
|
|
|
|
|
7
|
$$self{PROCESSED} = { }; |
2428
|
2
|
|
|
|
|
5
|
delete $$self{EXIF_DATA}; |
2429
|
2
|
|
|
|
|
4
|
delete $$self{EXIF_POS}; |
2430
|
|
|
|
|
|
|
} else { |
2431
|
515
|
100
|
66
|
|
|
4714
|
if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) { |
|
|
|
66
|
|
|
|
|
2432
|
6
|
|
|
|
|
215
|
%saveOptions = %$options; # save original options |
2433
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
# require duplicates for html dump |
2435
|
6
|
50
|
|
|
|
69
|
$self->Options(Duplicates => 1) if $$options{HtmlDump}; |
2436
|
|
|
|
|
|
|
# enable Validate option if Validate tag is requested |
2437
|
6
|
100
|
|
|
|
30
|
$self->Options(Validate => 1) if $$req{validate}; |
2438
|
|
|
|
|
|
|
|
2439
|
6
|
100
|
|
|
|
21
|
if (defined $_[0]) { |
2440
|
|
|
|
|
|
|
# only initialize filename if called with arguments |
2441
|
5
|
|
|
|
|
14
|
$$self{FILENAME} = undef; # name of file (or '' if we didn't open it) |
2442
|
5
|
|
|
|
|
14
|
$$self{RAF} = undef; # RandomAccess object reference |
2443
|
|
|
|
|
|
|
|
2444
|
5
|
|
|
|
|
24
|
$self->ParseArguments(@_); # initialize from our arguments |
2445
|
|
|
|
|
|
|
} |
2446
|
|
|
|
|
|
|
} |
2447
|
|
|
|
|
|
|
# initialize ExifTool object members |
2448
|
515
|
|
|
|
|
2633
|
$self->Init(); |
2449
|
|
|
|
|
|
|
|
2450
|
515
|
|
|
|
|
1495
|
delete $$self{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes |
2451
|
515
|
|
|
|
|
1266
|
delete $$self{MAKER_NOTE_BYTE_ORDER}; |
2452
|
|
|
|
|
|
|
|
2453
|
|
|
|
|
|
|
# return our version number |
2454
|
515
|
|
|
|
|
3627
|
$self->FoundTag('ExifToolVersion', "$VERSION$RELEASE"); |
2455
|
515
|
100
|
66
|
|
|
3807
|
$self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll; |
2456
|
515
|
100
|
66
|
|
|
3585
|
$self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll; |
2457
|
|
|
|
|
|
|
# generate sequence number if necessary |
2458
|
515
|
100
|
66
|
|
|
3163
|
$self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll; |
2459
|
|
|
|
|
|
|
|
2460
|
515
|
100
|
66
|
|
|
3000
|
if ($$req{processingtime} or $reqAll) { |
2461
|
58
|
|
|
|
|
204
|
eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() }; |
|
58
|
|
|
|
|
9912
|
|
|
58
|
|
|
|
|
23854
|
|
2462
|
58
|
0
|
33
|
|
|
301
|
if (not @startTime and $$req{processingtime}) { |
2463
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Time::HiRes to generate ProcessingTime'); |
2464
|
|
|
|
|
|
|
} |
2465
|
|
|
|
|
|
|
} |
2466
|
|
|
|
|
|
|
|
2467
|
515
|
|
|
|
|
1489
|
++$$self{FILE_SEQUENCE}; # count files read |
2468
|
|
|
|
|
|
|
} |
2469
|
|
|
|
|
|
|
|
2470
|
517
|
|
|
|
|
1526
|
my $filename = $$self{FILENAME}; # image file name ('' if already open) |
2471
|
517
|
|
|
|
|
1232
|
my $raf = $$self{RAF}; # RandomAccess object |
2472
|
|
|
|
|
|
|
|
2473
|
517
|
|
|
|
|
1922
|
local *EXIFTOOL_FILE; # avoid clashes with global namespace |
2474
|
|
|
|
|
|
|
|
2475
|
517
|
|
|
|
|
1183
|
my $realname = $filename; |
2476
|
517
|
100
|
|
|
|
1728
|
unless ($raf) { |
2477
|
|
|
|
|
|
|
# save file name |
2478
|
473
|
50
|
33
|
|
|
2857
|
if (defined $filename and $filename ne '') { |
2479
|
473
|
50
|
|
|
|
1872
|
unless ($filename eq '-') { |
2480
|
|
|
|
|
|
|
# extract file name from pipe if necessary |
2481
|
473
|
50
|
|
|
|
2145
|
$realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s; |
2482
|
473
|
|
|
|
|
2345
|
my ($dir, $name) = SplitFileName($realname); |
2483
|
473
|
|
|
|
|
2106
|
$self->FoundTag('FileName', $name); |
2484
|
473
|
100
|
66
|
|
|
4537
|
if ($$req{basename} or |
|
|
|
66
|
|
|
|
|
2485
|
|
|
|
|
|
|
($reqAll and not $$self{EXCL_TAG_LOOKUP}{basename})) |
2486
|
|
|
|
|
|
|
{ |
2487
|
58
|
50
|
|
|
|
509
|
$self->FoundTag('BaseName', $name =~ /(.*)\./ ? $1 : $name); |
2488
|
|
|
|
|
|
|
} |
2489
|
473
|
50
|
33
|
|
|
4084
|
$self->FoundTag('Directory', $dir) if defined $dir and length $dir; |
2490
|
473
|
100
|
66
|
|
|
4959
|
if ($$req{filepath} or |
|
|
|
66
|
|
|
|
|
2491
|
|
|
|
|
|
|
($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath})) |
2492
|
|
|
|
|
|
|
{ |
2493
|
58
|
|
|
|
|
346
|
local $SIG{'__WARN__'} = \&SetWarning; |
2494
|
58
|
50
|
|
|
|
175
|
if (eval { require Cwd }) { |
|
58
|
0
|
|
|
|
517
|
|
2495
|
58
|
|
|
|
|
173
|
my $path = eval { Cwd::abs_path($filename) }; |
|
58
|
|
|
|
|
2856
|
|
2496
|
58
|
50
|
|
|
|
510
|
$self->FoundTag('FilePath', $path) if defined $path; |
2497
|
|
|
|
|
|
|
} elsif ($$req{filepath}) { |
2498
|
0
|
|
|
|
|
0
|
$self->WarnOnce('The Perl Cwd module must be installed to use FilePath'); |
2499
|
|
|
|
|
|
|
} |
2500
|
|
|
|
|
|
|
} |
2501
|
|
|
|
|
|
|
# get size of resource fork on Mac OS |
2502
|
473
|
50
|
33
|
|
|
3211
|
$rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE}; |
2503
|
|
|
|
|
|
|
# check to see if Zone.Identifier file exists in Windows |
2504
|
473
|
50
|
33
|
|
|
2269
|
if ($^O eq 'MSWin32' and eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
2505
|
0
|
|
|
|
|
0
|
my $wattr; |
2506
|
0
|
|
|
|
|
0
|
my $zfile = "${filename}:Zone.Identifier"; |
2507
|
0
|
0
|
|
|
|
0
|
if ($self->EncodeFileName($zfile)) { |
2508
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributesW($zfile) }; |
|
0
|
|
|
|
|
0
|
|
2509
|
|
|
|
|
|
|
} else { |
2510
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributes($zfile) }; |
|
0
|
|
|
|
|
0
|
|
2511
|
|
|
|
|
|
|
} |
2512
|
0
|
0
|
|
|
|
0
|
$zid = 1 unless $wattr == Win32API::File::INVALID_FILE_ATTRIBUTES(); |
2513
|
|
|
|
|
|
|
} |
2514
|
|
|
|
|
|
|
} |
2515
|
|
|
|
|
|
|
# open the file |
2516
|
473
|
50
|
|
|
|
2723
|
if ($self->Open(\*EXIFTOOL_FILE, $filename)) { |
|
|
0
|
|
|
|
|
|
2517
|
|
|
|
|
|
|
# create random access file object |
2518
|
473
|
|
|
|
|
5959
|
$raf = new File::RandomAccess(\*EXIFTOOL_FILE); |
2519
|
|
|
|
|
|
|
# patch to force pipe to be buffered because seek returns success |
2520
|
|
|
|
|
|
|
# in Windows cmd shell pipe even though it really failed |
2521
|
473
|
50
|
33
|
|
|
4159
|
$$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/; |
2522
|
473
|
|
|
|
|
1641
|
$$self{RAF} = $raf; |
2523
|
|
|
|
|
|
|
} elsif ($self->IsDirectory($filename)) { |
2524
|
0
|
|
|
|
|
0
|
$isDir = 1; |
2525
|
|
|
|
|
|
|
} else { |
2526
|
0
|
|
|
|
|
0
|
$self->Error('Error opening file'); |
2527
|
|
|
|
|
|
|
} |
2528
|
|
|
|
|
|
|
} else { |
2529
|
0
|
|
|
|
|
0
|
$self->Error('No file specified'); |
2530
|
|
|
|
|
|
|
} |
2531
|
|
|
|
|
|
|
} |
2532
|
|
|
|
|
|
|
|
2533
|
517
|
|
33
|
|
|
2533
|
while ($raf or $isDir) { |
2534
|
517
|
|
|
|
|
1400
|
my (@stat, $plainFile); |
2535
|
517
|
100
|
|
|
|
8667
|
if ($reEntry) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2536
|
|
|
|
|
|
|
# we already set these tags |
2537
|
|
|
|
|
|
|
} elsif (not $raf) { |
2538
|
0
|
|
|
|
|
0
|
@stat = stat $filename; |
2539
|
|
|
|
|
|
|
} elsif (not $$raf{FILE_PT}) { |
2540
|
|
|
|
|
|
|
# get file size from image in memory |
2541
|
22
|
|
|
|
|
74
|
$self->FoundTag('FileSize', length ${$$raf{BUFF_PT}}); |
|
22
|
|
|
|
|
110
|
|
2542
|
|
|
|
|
|
|
} elsif (-f $$raf{FILE_PT}) { |
2543
|
|
|
|
|
|
|
# get file tags if this is a plain file |
2544
|
493
|
|
|
|
|
2939
|
@stat = stat _; |
2545
|
493
|
|
|
|
|
1372
|
$plainFile = 1; |
2546
|
|
|
|
|
|
|
# hack to patch Windows daylight savings time bug |
2547
|
493
|
50
|
|
|
|
2424
|
@stat[8,9,10] = $self->GetFileTime($$raf{FILE_PT}) if $^O eq 'MSWin32'; |
2548
|
|
|
|
|
|
|
} else { |
2549
|
|
|
|
|
|
|
# (note that Windows directories will still show the |
2550
|
|
|
|
|
|
|
# daylight savings time bug -- should fix this sometime) |
2551
|
0
|
|
|
|
|
0
|
@stat = stat $$raf{FILE_PT}; |
2552
|
|
|
|
|
|
|
} |
2553
|
517
|
|
|
|
|
1348
|
my $fileSize = $stat[7]; |
2554
|
517
|
100
|
|
|
|
3286
|
$self->FoundTag('FileSize', $stat[7]) if defined $stat[7]; |
2555
|
517
|
50
|
|
|
|
2554
|
$self->FoundTag('ResourceForkSize', $rsize) if $rsize; |
2556
|
517
|
50
|
|
|
|
1854
|
$self->FoundTag('ZoneIdentifier', 'Exists') if $zid; |
2557
|
517
|
100
|
|
|
|
2941
|
$self->FoundTag('FileModifyDate', $stat[9]) if defined $stat[9]; |
2558
|
517
|
100
|
|
|
|
3492
|
$self->FoundTag('FileAccessDate', $stat[8]) if defined $stat[8]; |
2559
|
517
|
50
|
|
|
|
3198
|
my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate'; |
2560
|
517
|
100
|
|
|
|
3082
|
$self->FoundTag($cTag, $stat[10]) if defined $stat[10]; |
2561
|
517
|
100
|
|
|
|
3669
|
$self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2]; |
2562
|
|
|
|
|
|
|
# extract more system info if SystemTags option is set |
2563
|
517
|
100
|
|
|
|
2542
|
if (@stat) { |
2564
|
493
|
|
66
|
|
|
3735
|
my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags}); |
2565
|
493
|
100
|
66
|
|
|
3096
|
if ($sys or $$req{fileattributes}) { |
2566
|
58
|
|
|
|
|
299
|
my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00); |
2567
|
|
|
|
|
|
|
# add Windows file attributes if available |
2568
|
58
|
0
|
33
|
|
|
350
|
if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2569
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
2570
|
0
|
0
|
|
|
|
0
|
if (eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
2571
|
0
|
|
|
|
|
0
|
my $wattr; |
2572
|
0
|
|
|
|
|
0
|
my $file = $filename; |
2573
|
0
|
0
|
|
|
|
0
|
if ($self->EncodeFileName($file)) { |
2574
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributesW($file) }; |
|
0
|
|
|
|
|
0
|
|
2575
|
|
|
|
|
|
|
} else { |
2576
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributes($file) }; |
|
0
|
|
|
|
|
0
|
|
2577
|
|
|
|
|
|
|
} |
2578
|
0
|
0
|
0
|
|
|
0
|
push @attr, $wattr if defined $wattr and $wattr != 0xffffffff; |
2579
|
|
|
|
|
|
|
} |
2580
|
|
|
|
|
|
|
} |
2581
|
58
|
|
|
|
|
434
|
$self->FoundTag('FileAttributes', "@attr"); |
2582
|
|
|
|
|
|
|
} |
2583
|
493
|
100
|
66
|
|
|
3206
|
$self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber}; |
2584
|
493
|
100
|
66
|
|
|
3035
|
$self->FoundTag('FileInodeNumber', $stat[1]) if $sys or $$req{fileinodenumber}; |
2585
|
493
|
100
|
66
|
|
|
3157
|
$self->FoundTag('FileHardLinks', $stat[3]) if $sys or $$req{filehardlinks}; |
2586
|
493
|
100
|
66
|
|
|
3167
|
$self->FoundTag('FileUserID', $stat[4]) if $sys or $$req{fileuserid}; |
2587
|
493
|
100
|
66
|
|
|
3610
|
$self->FoundTag('FileGroupID', $stat[5]) if $sys or $$req{filegroupid}; |
2588
|
493
|
100
|
66
|
|
|
2996
|
$self->FoundTag('FileDeviceID', $stat[6]) if $sys or $$req{filedeviceid}; |
2589
|
493
|
100
|
66
|
|
|
2941
|
$self->FoundTag('FileBlockSize', $stat[11]) if $sys or $$req{fileblocksize}; |
2590
|
493
|
100
|
66
|
|
|
3809
|
$self->FoundTag('FileBlockCount', $stat[12]) if $sys or $$req{fileblockcount}; |
2591
|
|
|
|
|
|
|
} |
2592
|
|
|
|
|
|
|
# extract MDItem tags if requested (only on plain files) |
2593
|
517
|
0
|
33
|
|
|
2637
|
if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2594
|
0
|
|
0
|
|
|
0
|
my $reqMacOS = ($reqAll > 1 or $$req{'macos:'}); |
2595
|
0
|
|
0
|
|
|
0
|
my $crDate = ($reqMacOS || $$req{filecreatedate}); |
2596
|
0
|
|
0
|
|
|
0
|
my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req); |
2597
|
0
|
|
0
|
|
|
0
|
my $xattr = ($reqMacOS || $$options{XAttrTags} || grep /^xattr/, keys %$req); |
2598
|
0
|
0
|
0
|
|
|
0
|
if ($crDate or $mdItem or $xattr) { |
|
|
|
0
|
|
|
|
|
2599
|
0
|
|
|
|
|
0
|
require Image::ExifTool::MacOS; |
2600
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate; |
2601
|
0
|
0
|
0
|
|
|
0
|
Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem and $plainFile; |
2602
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr; |
2603
|
|
|
|
|
|
|
} |
2604
|
|
|
|
|
|
|
} |
2605
|
|
|
|
|
|
|
# do whatever else we can with directories, then return |
2606
|
517
|
50
|
66
|
|
|
5135
|
if ($isDir or (defined $stat[2] and ($stat[2] & 0170000) == 0040000)) { |
|
|
|
33
|
|
|
|
|
2607
|
0
|
|
|
|
|
0
|
$self->FoundTag('FileType', 'DIR'); |
2608
|
0
|
|
|
|
|
0
|
$self->FoundTag('FileTypeExtension', ''); |
2609
|
0
|
0
|
|
|
|
0
|
$self->BuildCompositeTags() if $$options{Composite}; |
2610
|
0
|
0
|
|
|
|
0
|
$raf->Close() if $raf; |
2611
|
0
|
|
|
|
|
0
|
return 1; |
2612
|
|
|
|
|
|
|
} |
2613
|
|
|
|
|
|
|
# get list of file types to check |
2614
|
517
|
|
|
|
|
2217
|
my ($tiffType, %noMagic, $recognizedExt); |
2615
|
517
|
|
|
|
|
2087
|
my $ext = $$self{FILE_EXT} = GetFileExtension($realname); |
2616
|
|
|
|
|
|
|
# set $recognizedExt if this file type is recognized by extension only |
2617
|
|
|
|
|
|
|
$recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and |
2618
|
517
|
50
|
100
|
|
|
5067
|
defined $moduleName{$ext} and not $moduleName{$ext}; |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2619
|
517
|
|
|
|
|
2397
|
my @fileTypeList = GetFileType($realname); |
2620
|
517
|
50
|
|
|
|
2071
|
if ($fast >= 4) { |
2621
|
0
|
0
|
|
|
|
0
|
if (@fileTypeList) { |
2622
|
0
|
|
|
|
|
0
|
$type = shift @fileTypeList; |
2623
|
0
|
|
|
|
|
0
|
$self->SetFileType($$self{FILE_TYPE} = $type); |
2624
|
|
|
|
|
|
|
} else { |
2625
|
0
|
|
|
|
|
0
|
$self->Error('Unknown file type'); |
2626
|
|
|
|
|
|
|
} |
2627
|
0
|
0
|
0
|
|
|
0
|
$self->BuildCompositeTags() if $fast == 4 and $$options{Composite}; |
2628
|
0
|
|
|
|
|
0
|
last; # don't read the file |
2629
|
|
|
|
|
|
|
} |
2630
|
517
|
100
|
|
|
|
1861
|
if (@fileTypeList) { |
2631
|
|
|
|
|
|
|
# add remaining types to end of list so we test them all |
2632
|
470
|
|
|
|
|
1820
|
my $pat = join '|', @fileTypeList; |
2633
|
470
|
|
|
|
|
42227
|
push @fileTypeList, grep(!/^($pat)$/, @fileTypes); |
2634
|
470
|
|
|
|
|
2040
|
$tiffType = $$self{FILE_EXT}; |
2635
|
470
|
100
|
|
|
|
2893
|
unless ($fast == 3) { |
2636
|
469
|
|
|
|
|
2474
|
$noMagic{MXF} = 1; # don't do magic number test on MXF or DV files |
2637
|
469
|
|
|
|
|
1536
|
$noMagic{DV} = 1; |
2638
|
|
|
|
|
|
|
} |
2639
|
|
|
|
|
|
|
} else { |
2640
|
|
|
|
|
|
|
# scan through all recognized file types |
2641
|
47
|
|
|
|
|
887
|
@fileTypeList = @fileTypes; |
2642
|
47
|
|
|
|
|
137
|
$tiffType = 'TIFF'; |
2643
|
|
|
|
|
|
|
} |
2644
|
517
|
|
|
|
|
1773
|
push @fileTypeList, ''; # end of list marker |
2645
|
|
|
|
|
|
|
# initialize the input file for seeking in binary data |
2646
|
517
|
|
|
|
|
3124
|
$raf->BinMode(); # set binary mode before we start reading |
2647
|
517
|
|
|
|
|
2095
|
my $pos = $raf->Tell(); # get file position so we can rewind |
2648
|
|
|
|
|
|
|
# loop through list of file types to test |
2649
|
517
|
|
|
|
|
1589
|
my ($buff, $seekErr); |
2650
|
517
|
|
|
|
|
3015
|
my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff ); |
2651
|
|
|
|
|
|
|
# read start of file for testing |
2652
|
517
|
50
|
|
|
|
2492
|
$raf->Read($buff, $testLen) or $buff = ''; |
2653
|
517
|
50
|
|
|
|
3015
|
$raf->Seek($pos, 0) or $seekErr = 1; |
2654
|
517
|
|
|
|
|
2881
|
until ($seekErr) { |
2655
|
1912
|
|
|
|
|
3436
|
my $unkHeader; |
2656
|
1912
|
|
|
|
|
3592
|
$type = shift @fileTypeList; |
2657
|
1912
|
50
|
|
|
|
4131
|
if ($type) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2658
|
1912
|
100
|
|
|
|
5293
|
if ($magicNumber{$type}) { |
2659
|
|
|
|
|
|
|
# do quick test for this file type to avoid loading module unnecessarily |
2660
|
1876
|
100
|
100
|
|
|
38433
|
next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type}; |
2661
|
|
|
|
|
|
|
} else { |
2662
|
|
|
|
|
|
|
# keep checking for other types if we recognize this file only by extension |
2663
|
36
|
50
|
66
|
|
|
218
|
next if defined $moduleName{$type} and not $moduleName{$type}; |
2664
|
36
|
50
|
|
|
|
119
|
next if $fast > 2; # keep checking if we aren't processing the file |
2665
|
|
|
|
|
|
|
} |
2666
|
557
|
50
|
66
|
|
|
3365
|
next if $weakMagic{$type} and defined $recognizedExt; |
2667
|
|
|
|
|
|
|
} elsif (not defined $type) { |
2668
|
0
|
|
|
|
|
0
|
last; |
2669
|
|
|
|
|
|
|
} elsif ($recognizedExt) { |
2670
|
0
|
|
|
|
|
0
|
$type = $recognizedExt; # set type from recognized file extension only |
2671
|
|
|
|
|
|
|
} else { |
2672
|
|
|
|
|
|
|
# last ditch effort to scan past unknown header for JPEG/TIFF |
2673
|
0
|
0
|
|
|
|
0
|
next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g; |
2674
|
0
|
0
|
|
|
|
0
|
$type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF'; |
2675
|
0
|
|
|
|
|
0
|
my $skip = pos($buff) - length($1); |
2676
|
0
|
|
|
|
|
0
|
$dirInfo{Base} = $pos + $skip; |
2677
|
0
|
0
|
|
|
|
0
|
$raf->Seek($pos + $skip, 0) or $seekErr = 1, last; |
2678
|
0
|
|
|
|
|
0
|
$self->Warn("Processing $type-like data after unknown $skip-byte header"); |
2679
|
0
|
0
|
|
|
|
0
|
$unkHeader = 1 unless $$self{DOC_NUM}; |
2680
|
|
|
|
|
|
|
} |
2681
|
|
|
|
|
|
|
# save file type in member variable |
2682
|
557
|
|
|
|
|
1738
|
$$self{FILE_TYPE} = $type; |
2683
|
557
|
100
|
|
|
|
2699
|
$dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type; |
2684
|
|
|
|
|
|
|
# don't process the file when FastScan == 3 |
2685
|
557
|
50
|
66
|
|
|
2525
|
if ($fast == 3 and not $processType{$type}) { |
2686
|
0
|
0
|
0
|
|
|
0
|
unless ($weakMagic{$type} and (not $ext or $ext ne $type)) { |
|
|
|
0
|
|
|
|
|
2687
|
0
|
|
|
|
|
0
|
$self->SetFileType($dirInfo{Parent}); |
2688
|
|
|
|
|
|
|
} |
2689
|
0
|
|
|
|
|
0
|
last; |
2690
|
|
|
|
|
|
|
} |
2691
|
557
|
|
|
|
|
1460
|
my $module = $moduleName{$type}; |
2692
|
557
|
100
|
|
|
|
1890
|
$module = $type unless defined $module; |
2693
|
557
|
|
|
|
|
1878
|
my $func = "Process$type"; |
2694
|
|
|
|
|
|
|
|
2695
|
|
|
|
|
|
|
# load module if necessary |
2696
|
557
|
100
|
|
|
|
2172
|
if ($module) { |
|
|
50
|
|
|
|
|
|
2697
|
305
|
|
|
|
|
23653
|
require "Image/ExifTool/$module.pm"; |
2698
|
305
|
|
|
|
|
1371
|
$func = "Image::ExifTool::${module}::$func"; |
2699
|
|
|
|
|
|
|
} elsif ($module eq '0') { |
2700
|
0
|
|
|
|
|
0
|
$self->SetFileType(); |
2701
|
0
|
|
|
|
|
0
|
$self->Warn('Unsupported file type'); |
2702
|
0
|
|
|
|
|
0
|
last; |
2703
|
|
|
|
|
|
|
} |
2704
|
557
|
|
|
|
|
1204
|
push @{$$self{PATH}}, $type; # save file type in metadata PATH |
|
557
|
|
|
|
|
2146
|
|
2705
|
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
|
# process the file |
2707
|
105
|
|
|
105
|
|
2634
|
no strict 'refs'; |
|
105
|
|
|
|
|
279
|
|
|
105
|
|
|
|
|
5897
|
|
2708
|
557
|
|
|
|
|
4755
|
my $result = &$func($self, \%dirInfo); |
2709
|
105
|
|
|
105
|
|
736
|
use strict 'refs'; |
|
105
|
|
|
|
|
248
|
|
|
105
|
|
|
|
|
1542276
|
|
2710
|
|
|
|
|
|
|
|
2711
|
557
|
|
|
|
|
1387
|
pop @{$$self{PATH}}; |
|
557
|
|
|
|
|
1943
|
|
2712
|
|
|
|
|
|
|
|
2713
|
557
|
100
|
|
|
|
2054
|
if ($result) { # all done if successful |
2714
|
517
|
50
|
|
|
|
1824
|
if ($unkHeader) { |
2715
|
0
|
|
|
|
|
0
|
$self->DeleteTag('FileType'); |
2716
|
0
|
|
|
|
|
0
|
$self->DeleteTag('FileTypeExtension'); |
2717
|
0
|
|
|
|
|
0
|
$self->DeleteTag('MIMEType'); |
2718
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"Reset file type due to unknown header\n"); |
2719
|
|
|
|
|
|
|
} |
2720
|
517
|
|
|
|
|
1472
|
last; |
2721
|
|
|
|
|
|
|
} |
2722
|
|
|
|
|
|
|
# seek back to try again from the same position in the file |
2723
|
40
|
50
|
|
|
|
116
|
$raf->Seek($pos, 0) or $seekErr = 1, last; |
2724
|
|
|
|
|
|
|
} |
2725
|
517
|
0
|
33
|
|
|
2040
|
if (not defined $type and not $$self{DOC_NUM}) { |
2726
|
|
|
|
|
|
|
# if we were given a single image with a known type there |
2727
|
|
|
|
|
|
|
# must be a format error since we couldn't read it, otherwise |
2728
|
|
|
|
|
|
|
# it is likely we don't support images of this type |
2729
|
0
|
|
0
|
|
|
0
|
my $fileType = GetFileType($realname) || ''; |
2730
|
0
|
|
|
|
|
0
|
my $err; |
2731
|
0
|
0
|
|
|
|
0
|
if (not length $buff) { |
2732
|
0
|
|
|
|
|
0
|
$err = 'File is empty'; |
2733
|
|
|
|
|
|
|
} else { |
2734
|
0
|
|
|
|
|
0
|
my $ch = substr($buff, 0, 1); |
2735
|
0
|
0
|
0
|
|
|
0
|
if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) { |
2736
|
0
|
0
|
|
|
|
0
|
if ($fileType eq 'RAW') { |
|
|
0
|
|
|
|
|
|
2737
|
0
|
|
|
|
|
0
|
$err = 'Unsupported RAW file type'; |
2738
|
|
|
|
|
|
|
} elsif ($fileType) { |
2739
|
0
|
|
|
|
|
0
|
$err = 'File format error'; |
2740
|
|
|
|
|
|
|
} else { |
2741
|
0
|
|
|
|
|
0
|
$err = 'Unknown file type'; |
2742
|
|
|
|
|
|
|
} |
2743
|
|
|
|
|
|
|
} else { |
2744
|
|
|
|
|
|
|
# provide some insight into the content of some corrupted files |
2745
|
0
|
0
|
|
|
|
0
|
if ($$self{OPTIONS}{FastScan}) { |
2746
|
0
|
|
|
|
|
0
|
$err = 'File header is all'; |
2747
|
|
|
|
|
|
|
} else { |
2748
|
0
|
|
|
|
|
0
|
my $num = 0; |
2749
|
0
|
|
|
|
|
0
|
for (;;) { |
2750
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, 65536) or undef($num), last; |
2751
|
0
|
0
|
|
|
|
0
|
$buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last; |
2752
|
0
|
|
|
|
|
0
|
$num += length($buff); |
2753
|
|
|
|
|
|
|
} |
2754
|
0
|
0
|
|
|
|
0
|
if ($num) { |
2755
|
0
|
|
|
|
|
0
|
$err = 'First ' . ConvertFileSize($num) . ' of file is'; |
2756
|
|
|
|
|
|
|
} else { |
2757
|
0
|
|
|
|
|
0
|
$err = 'Entire file is'; |
2758
|
|
|
|
|
|
|
} |
2759
|
|
|
|
|
|
|
} |
2760
|
0
|
0
|
|
|
|
0
|
if ($ch eq "\0") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2761
|
0
|
|
|
|
|
0
|
$err .= ' binary zeros'; |
2762
|
|
|
|
|
|
|
} elsif ($ch eq ' ') { |
2763
|
0
|
|
|
|
|
0
|
$err .= ' ASCII spaces'; |
2764
|
|
|
|
|
|
|
} elsif ($ch =~ /[a-zA-Z0-9]/) { |
2765
|
0
|
|
|
|
|
0
|
$err .= " ASCII '${ch}' characters"; |
2766
|
|
|
|
|
|
|
} else { |
2767
|
0
|
|
|
|
|
0
|
$err .= sprintf(" binary 0x%.2x's", ord $ch); |
2768
|
|
|
|
|
|
|
} |
2769
|
|
|
|
|
|
|
} |
2770
|
|
|
|
|
|
|
} |
2771
|
0
|
|
|
|
|
0
|
$self->Error($err); |
2772
|
|
|
|
|
|
|
} |
2773
|
517
|
50
|
0
|
|
|
2706
|
if ($seekErr) { |
|
|
50
|
33
|
|
|
|
|
2774
|
0
|
|
|
|
|
0
|
$self->Error('Error seeking in file'); |
2775
|
|
|
|
|
|
|
} elsif ($self->Options('ScanForXMP') and (not defined $type or |
2776
|
|
|
|
|
|
|
(not $fast and not $$self{FoundXMP}))) |
2777
|
|
|
|
|
|
|
{ |
2778
|
|
|
|
|
|
|
# scan for XMP |
2779
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
2780
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
2781
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = ''; |
2782
|
|
|
|
|
|
|
} |
2783
|
|
|
|
|
|
|
# extract binary EXIF data block only if requested |
2784
|
517
|
100
|
100
|
|
|
5030
|
if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
2785
|
|
|
|
|
|
|
($$req{exif} or |
2786
|
|
|
|
|
|
|
# (not extracted normally, so check TAGS_FROM_FILE) |
2787
|
|
|
|
|
|
|
($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif}))) |
2788
|
|
|
|
|
|
|
{ |
2789
|
36
|
|
|
|
|
168
|
$self->FoundTag('EXIF', $$self{EXIF_DATA}); |
2790
|
|
|
|
|
|
|
} |
2791
|
517
|
100
|
|
|
|
2002
|
unless ($reEntry) { |
2792
|
515
|
|
|
|
|
1898
|
$$self{PATH} = [ ]; # reset PATH |
2793
|
|
|
|
|
|
|
# calculate Composite tags |
2794
|
515
|
100
|
|
|
|
3742
|
$self->BuildCompositeTags() if $$options{Composite}; |
2795
|
|
|
|
|
|
|
# do our HTML dump if requested |
2796
|
515
|
50
|
|
|
|
2540
|
if ($$self{HTML_DUMP}) { |
2797
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); # seek to end of file |
2798
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell()); |
2799
|
0
|
|
|
|
|
0
|
my $pos = $$options{HtmlDumpBase}; |
2800
|
0
|
0
|
0
|
|
|
0
|
$pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos; |
2801
|
0
|
0
|
|
|
|
0
|
my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef; |
2802
|
0
|
0
|
0
|
|
|
0
|
undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS}; |
2803
|
0
|
0
|
|
|
|
0
|
undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous |
2804
|
|
|
|
|
|
|
my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos, |
2805
|
|
|
|
|
|
|
$$options{TextOut}, $$options{HtmlDump}, |
2806
|
0
|
0
|
|
|
|
0
|
$$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump'); |
2807
|
0
|
0
|
|
|
|
0
|
$self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0; |
2808
|
|
|
|
|
|
|
} |
2809
|
|
|
|
|
|
|
} |
2810
|
517
|
100
|
|
|
|
2033
|
if ($filename) { |
2811
|
475
|
|
|
|
|
3288
|
$raf->Close(); # close the file if we opened it |
2812
|
|
|
|
|
|
|
# process the resource fork as an embedded file on Mac filesystems |
2813
|
475
|
0
|
33
|
|
|
1937
|
if ($rsize and $$options{ExtractEmbedded}) { |
2814
|
0
|
|
|
|
|
0
|
local *RESOURCE_FILE; |
2815
|
0
|
0
|
|
|
|
0
|
if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) { |
2816
|
0
|
|
|
|
|
0
|
$$self{DOC_NUM} = $$self{DOC_COUNT} + 1; |
2817
|
0
|
|
|
|
|
0
|
$$self{IN_RESOURCE} = 1; |
2818
|
0
|
|
|
|
|
0
|
$self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 }); |
2819
|
0
|
|
|
|
|
0
|
close RESOURCE_FILE; |
2820
|
0
|
|
|
|
|
0
|
delete $$self{IN_RESOURCE}; |
2821
|
|
|
|
|
|
|
} else { |
2822
|
0
|
|
|
|
|
0
|
$self->Warn('Error opening resource fork'); |
2823
|
|
|
|
|
|
|
} |
2824
|
|
|
|
|
|
|
} |
2825
|
|
|
|
|
|
|
} |
2826
|
517
|
|
|
|
|
9438
|
last; # (loop was a cheap "goto") |
2827
|
|
|
|
|
|
|
} |
2828
|
|
|
|
|
|
|
|
2829
|
|
|
|
|
|
|
# generate Validate tag if requested |
2830
|
517
|
100
|
66
|
|
|
2590
|
if ($$options{Validate} and not $reEntry) { |
2831
|
1
|
|
|
|
|
10
|
Image::ExifTool::Validate::FinishValidate($self, $$req{validate}); |
2832
|
|
|
|
|
|
|
} |
2833
|
|
|
|
|
|
|
|
2834
|
517
|
100
|
|
|
|
2235
|
@startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime)); |
2835
|
|
|
|
|
|
|
|
2836
|
|
|
|
|
|
|
# add user-defined parameters that ended with '!' |
2837
|
517
|
50
|
|
|
|
1328
|
if (%{$$options{UserParam}}) { |
|
517
|
|
|
|
|
2355
|
|
2838
|
0
|
|
|
|
|
0
|
my $doMsg = $$options{Verbose}; |
2839
|
0
|
|
|
|
|
0
|
my $table = GetTagTable('Image::ExifTool::UserParam'); |
2840
|
0
|
|
|
|
|
0
|
foreach (sort keys %{$$options{UserParam}}) { |
|
0
|
|
|
|
|
0
|
|
2841
|
0
|
0
|
|
|
|
0
|
next unless /#$/; |
2842
|
0
|
0
|
|
|
|
0
|
if ($doMsg) { |
2843
|
0
|
|
|
|
|
0
|
$self->VPrint(0, "UserParam tags:\n"); |
2844
|
0
|
|
|
|
|
0
|
undef $doMsg; |
2845
|
|
|
|
|
|
|
} |
2846
|
0
|
|
|
|
|
0
|
$self->HandleTag($table, $_, $$options{UserParam}{$_}); |
2847
|
|
|
|
|
|
|
} |
2848
|
|
|
|
|
|
|
} |
2849
|
|
|
|
|
|
|
|
2850
|
|
|
|
|
|
|
# restore original options |
2851
|
517
|
100
|
|
|
|
2690
|
%saveOptions and $$self{OPTIONS} = \%saveOptions; |
2852
|
|
|
|
|
|
|
|
2853
|
517
|
100
|
|
|
|
1738
|
if ($reEntry) { |
2854
|
|
|
|
|
|
|
# restore necessary members when exiting re-entrant code |
2855
|
2
|
|
|
|
|
20
|
$$self{$_} = $$reEntry{$_} foreach keys %$reEntry; |
2856
|
2
|
|
|
|
|
10
|
SetByteOrder($saveOrder); |
2857
|
|
|
|
|
|
|
} |
2858
|
|
|
|
|
|
|
|
2859
|
|
|
|
|
|
|
# ($type may be undef without an Error when processing sub-documents) |
2860
|
517
|
50
|
33
|
|
|
3833
|
return 0 if not defined $type or exists $$self{VALUE}{Error}; |
2861
|
517
|
|
|
|
|
3034
|
return 1; |
2862
|
|
|
|
|
|
|
} |
2863
|
|
|
|
|
|
|
|
2864
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2865
|
|
|
|
|
|
|
# Get hash of extracted meta information |
2866
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2867
|
|
|
|
|
|
|
# 1-N) options hash reference, tag list reference or tag names |
2868
|
|
|
|
|
|
|
# Returns: Reference to information hash |
2869
|
|
|
|
|
|
|
# Notes: - pass an undefined value to avoid parsing arguments |
2870
|
|
|
|
|
|
|
# - If groups are specified, first groups take precedence if duplicate |
2871
|
|
|
|
|
|
|
# tags found but Duplicates option not set. |
2872
|
|
|
|
|
|
|
# - tag names may end in '#' to extract ValueConv value |
2873
|
|
|
|
|
|
|
sub GetInfo($;@) |
2874
|
|
|
|
|
|
|
{ |
2875
|
690
|
|
|
690
|
1
|
4650
|
local $_; |
2876
|
690
|
|
|
|
|
1587
|
my $self = shift; |
2877
|
690
|
|
|
|
|
1381
|
my %saveOptions; |
2878
|
|
|
|
|
|
|
|
2879
|
690
|
100
|
66
|
|
|
4232
|
unless (@_ and not defined $_[0]) { |
2880
|
180
|
|
|
|
|
447
|
%saveOptions = %{$$self{OPTIONS}}; # save original options |
|
180
|
|
|
|
|
12132
|
|
2881
|
|
|
|
|
|
|
# must set FILENAME so it isn't parsed from the arguments |
2882
|
180
|
100
|
|
|
|
1798
|
$$self{FILENAME} = '' unless defined $$self{FILENAME}; |
2883
|
180
|
|
|
|
|
1097
|
$self->ParseArguments(@_); |
2884
|
|
|
|
|
|
|
} |
2885
|
|
|
|
|
|
|
|
2886
|
|
|
|
|
|
|
# get reference to list of tags for which we will return info |
2887
|
690
|
|
|
|
|
3537
|
my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags(); |
2888
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
# build hash of tag information |
2890
|
690
|
|
|
|
|
1615
|
my (%info, %ignored); |
2891
|
690
|
100
|
|
|
|
2704
|
my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; |
2892
|
690
|
|
|
|
|
2126
|
foreach (@$rtnTags) { |
2893
|
35139
|
|
|
|
|
69196
|
my $val = $self->GetValue($_, $conv); |
2894
|
35139
|
100
|
|
|
|
69450
|
defined $val or $ignored{$_} = 1, next; |
2895
|
34180
|
|
|
|
|
83323
|
$info{$_} = $val; |
2896
|
|
|
|
|
|
|
} |
2897
|
|
|
|
|
|
|
|
2898
|
|
|
|
|
|
|
# override specified tags with ValueConv value if necessary |
2899
|
690
|
100
|
|
|
|
3390
|
if (@$byValue) { |
2900
|
|
|
|
|
|
|
# first determine the number of times each non-ValueConv value is used |
2901
|
4
|
|
|
|
|
9
|
my %nonVal; |
2902
|
4
|
|
100
|
|
|
88
|
$nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags; |
2903
|
4
|
|
|
|
|
27
|
--$nonVal{$$rtnTags[$_]} foreach @$byValue; |
2904
|
|
|
|
|
|
|
# loop through ValueConv tags, updating tag keys and returned values |
2905
|
4
|
|
|
|
|
12
|
foreach (@$byValue) { |
2906
|
25
|
|
|
|
|
39
|
my $tag = $$rtnTags[$_]; |
2907
|
25
|
|
|
|
|
51
|
my $val = $self->GetValue($tag, 'ValueConv'); |
2908
|
25
|
100
|
|
|
|
57
|
next unless defined $val; |
2909
|
16
|
|
|
|
|
30
|
my $vtag = $tag; |
2910
|
|
|
|
|
|
|
# generate a new tag key like "Tag #" or "Tag #(1)" |
2911
|
16
|
|
|
|
|
101
|
$vtag =~ s/( |$)/ #/; |
2912
|
16
|
50
|
|
|
|
46
|
unless (defined $$self{VALUE}{$vtag}) { |
2913
|
16
|
|
|
|
|
70
|
$$self{VALUE}{$vtag} = $$self{VALUE}{$tag}; |
2914
|
16
|
|
|
|
|
35
|
$$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag}; |
2915
|
16
|
|
|
|
|
37
|
$$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag}; |
2916
|
16
|
|
|
|
|
31
|
$$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag}; |
2917
|
|
|
|
|
|
|
# remove existing PrintConv entry unless we are using it too |
2918
|
16
|
100
|
|
|
|
51
|
delete $info{$tag} unless $nonVal{$tag}; |
2919
|
|
|
|
|
|
|
} |
2920
|
16
|
|
|
|
|
31
|
$$rtnTags[$_] = $vtag; # store ValueConv value with new tag key |
2921
|
16
|
|
|
|
|
47
|
$info{$vtag} = $val; # return ValueConv value |
2922
|
|
|
|
|
|
|
} |
2923
|
|
|
|
|
|
|
} |
2924
|
|
|
|
|
|
|
|
2925
|
|
|
|
|
|
|
# remove ignored tags from the list |
2926
|
690
|
|
50
|
|
|
2938
|
my $reqTags = $$self{REQUESTED_TAGS} || [ ]; |
2927
|
690
|
100
|
|
|
|
2230
|
if (%ignored) { |
2928
|
408
|
100
|
|
|
|
1952
|
if (not @$reqTags) { |
|
|
100
|
|
|
|
|
|
2929
|
192
|
|
|
|
|
407
|
my @goodTags; |
2930
|
192
|
|
|
|
|
661
|
foreach (@$rtnTags) { |
2931
|
22555
|
100
|
|
|
|
44935
|
push @goodTags, $_ unless $ignored{$_}; |
2932
|
|
|
|
|
|
|
} |
2933
|
192
|
|
|
|
|
1790
|
$rtnTags = $$self{FOUND_TAGS} = \@goodTags; |
2934
|
|
|
|
|
|
|
} elsif (@$wildTags) { |
2935
|
|
|
|
|
|
|
# only remove tags specified by wildcard |
2936
|
41
|
|
|
|
|
78
|
my @goodTags; |
2937
|
41
|
|
|
|
|
62
|
my $i = 0; |
2938
|
41
|
|
|
|
|
99
|
foreach (@$rtnTags) { |
2939
|
356
|
100
|
100
|
|
|
901
|
if (@$wildTags and $i == $$wildTags[0]) { |
2940
|
197
|
|
|
|
|
270
|
shift @$wildTags; |
2941
|
197
|
50
|
|
|
|
450
|
push @goodTags, $_ unless $ignored{$_}; |
2942
|
|
|
|
|
|
|
} else { |
2943
|
159
|
|
|
|
|
268
|
push @goodTags, $_; |
2944
|
|
|
|
|
|
|
} |
2945
|
356
|
|
|
|
|
568
|
++$i; |
2946
|
|
|
|
|
|
|
} |
2947
|
41
|
|
|
|
|
216
|
$rtnTags = $$self{FOUND_TAGS} = \@goodTags; |
2948
|
|
|
|
|
|
|
} |
2949
|
|
|
|
|
|
|
} |
2950
|
|
|
|
|
|
|
|
2951
|
|
|
|
|
|
|
# return sorted tag list if provided with a list reference |
2952
|
690
|
100
|
|
|
|
2874
|
if ($$self{IO_TAG_LIST}) { |
2953
|
|
|
|
|
|
|
# use file order by default if no tags specified |
2954
|
|
|
|
|
|
|
# (no such thing as 'Input' order in this case) |
2955
|
4
|
|
|
|
|
12
|
my $sort = $$self{OPTIONS}{Sort}; |
2956
|
4
|
50
|
33
|
|
|
30
|
$sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input'); |
|
|
|
66
|
|
|
|
|
2957
|
|
|
|
|
|
|
# return tags in specified sort order |
2958
|
4
|
|
|
|
|
25
|
@{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2}); |
|
4
|
|
|
|
|
26
|
|
2959
|
|
|
|
|
|
|
} |
2960
|
|
|
|
|
|
|
|
2961
|
|
|
|
|
|
|
# restore original options |
2962
|
690
|
100
|
|
|
|
3902
|
%saveOptions and $$self{OPTIONS} = \%saveOptions; |
2963
|
|
|
|
|
|
|
|
2964
|
690
|
|
|
|
|
3589
|
return \%info; |
2965
|
|
|
|
|
|
|
} |
2966
|
|
|
|
|
|
|
|
2967
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2968
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2969
|
|
|
|
|
|
|
# 1) [optional] reference to info hash or tag list ref (default is found tags) |
2970
|
|
|
|
|
|
|
# 2) [optional] sort order ('File', 'Input', ...) |
2971
|
|
|
|
|
|
|
# 3) [optional] secondary sort order |
2972
|
|
|
|
|
|
|
# Returns: List of tags in specified order |
2973
|
|
|
|
|
|
|
sub GetTagList($;$$$) |
2974
|
|
|
|
|
|
|
{ |
2975
|
429
|
|
|
429
|
1
|
79572
|
local $_; |
2976
|
429
|
|
|
|
|
1807
|
my ($self, $info, $sort, $sort2) = @_; |
2977
|
|
|
|
|
|
|
|
2978
|
429
|
|
|
|
|
993
|
my $foundTags; |
2979
|
429
|
100
|
|
|
|
2071
|
if (ref $info eq 'HASH') { |
|
|
50
|
|
|
|
|
|
2980
|
424
|
|
|
|
|
6144
|
my @tags = keys %$info; |
2981
|
424
|
|
|
|
|
1497
|
$foundTags = \@tags; |
2982
|
|
|
|
|
|
|
} elsif (ref $info eq 'ARRAY') { |
2983
|
5
|
|
|
|
|
13
|
$foundTags = $info; |
2984
|
|
|
|
|
|
|
} |
2985
|
429
|
|
|
|
|
1352
|
my $fileOrder = $$self{FILE_ORDER}; |
2986
|
|
|
|
|
|
|
|
2987
|
429
|
50
|
|
|
|
1481
|
if ($foundTags) { |
2988
|
|
|
|
|
|
|
# make sure a FILE_ORDER entry exists for all tags |
2989
|
|
|
|
|
|
|
# (note: already generated bogus entries for FOUND_TAGS case below) |
2990
|
429
|
|
|
|
|
1457
|
foreach (@$foundTags) { |
2991
|
23977
|
50
|
|
|
|
46108
|
next if defined $$fileOrder{$_}; |
2992
|
0
|
|
|
|
|
0
|
$$fileOrder{$_} = 999; |
2993
|
|
|
|
|
|
|
} |
2994
|
|
|
|
|
|
|
} else { |
2995
|
0
|
0
|
0
|
|
|
0
|
$sort = $info if $info and not $sort; |
2996
|
0
|
0
|
0
|
|
|
0
|
$foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; |
2997
|
|
|
|
|
|
|
} |
2998
|
429
|
100
|
|
|
|
1939
|
$sort or $sort = $$self{OPTIONS}{Sort}; |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
# return original list if no sort order specified |
3001
|
429
|
100
|
66
|
|
|
3531
|
return @$foundTags unless $sort and $sort ne 'Input'; |
3002
|
|
|
|
|
|
|
|
3003
|
411
|
50
|
33
|
|
|
5180
|
if ($sort eq 'Tag' or $sort eq 'Alpha') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3004
|
0
|
|
|
|
|
0
|
return sort @$foundTags; |
3005
|
|
|
|
|
|
|
} elsif ($sort =~ /^Group(\d*(:\d+)*)/) { |
3006
|
409
|
|
50
|
|
|
2639
|
my $family = $1 || 0; |
3007
|
|
|
|
|
|
|
# want to maintain a basic file order with the groups |
3008
|
|
|
|
|
|
|
# ordered in the way they appear in the file |
3009
|
409
|
|
|
|
|
1033
|
my (%groupCount, %groupOrder); |
3010
|
409
|
|
|
|
|
866
|
my $numGroups = 0; |
3011
|
409
|
|
|
|
|
806
|
my $tag; |
3012
|
409
|
|
|
|
|
2667
|
foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) { |
|
130261
|
|
|
|
|
175621
|
|
3013
|
23269
|
|
|
|
|
40908
|
my $group = $self->GetGroup($tag, $family); |
3014
|
23269
|
|
|
|
|
38811
|
my $num = $groupCount{$group}; |
3015
|
23269
|
100
|
|
|
|
40069
|
$num or $num = $groupCount{$group} = ++$numGroups; |
3016
|
23269
|
|
|
|
|
44796
|
$groupOrder{$tag} = $num; |
3017
|
|
|
|
|
|
|
} |
3018
|
409
|
50
|
|
|
|
3353
|
$sort2 or $sort2 = $$self{OPTIONS}{Sort2}; |
3019
|
409
|
50
|
|
|
|
1647
|
if ($sort2) { |
3020
|
409
|
50
|
33
|
|
|
3435
|
if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') { |
|
|
50
|
|
|
|
|
|
3021
|
0
|
0
|
|
|
|
0
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags; |
|
0
|
|
|
|
|
0
|
|
3022
|
|
|
|
|
|
|
} elsif ($sort2 eq 'Descr') { |
3023
|
0
|
|
|
|
|
0
|
my $desc = $self->GetDescriptions($foundTags); |
3024
|
0
|
|
|
|
|
0
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or |
3025
|
0
|
0
|
|
|
|
0
|
$$desc{$a} cmp $$desc{$b} } @$foundTags; |
3026
|
|
|
|
|
|
|
} |
3027
|
|
|
|
|
|
|
} |
3028
|
409
|
|
|
|
|
2159
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or |
3029
|
130269
|
50
|
|
|
|
233800
|
$$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; |
3030
|
|
|
|
|
|
|
} elsif ($sort eq 'Descr') { |
3031
|
0
|
|
|
|
|
0
|
my $desc = $self->GetDescriptions($foundTags); |
3032
|
0
|
|
|
|
|
0
|
return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags; |
|
0
|
|
|
|
|
0
|
|
3033
|
|
|
|
|
|
|
} else { |
3034
|
2
|
|
|
|
|
15
|
return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; |
|
3697
|
|
|
|
|
4930
|
|
3035
|
|
|
|
|
|
|
} |
3036
|
|
|
|
|
|
|
} |
3037
|
|
|
|
|
|
|
|
3038
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3039
|
|
|
|
|
|
|
# Get list of found tags in specified sort order |
3040
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...) |
3041
|
|
|
|
|
|
|
# 2) secondary sort order |
3042
|
|
|
|
|
|
|
# Returns: List of tag keys in specified order |
3043
|
|
|
|
|
|
|
# Notes: If not specified, sort order is taken from OPTIONS |
3044
|
|
|
|
|
|
|
sub GetFoundTags($;$$) |
3045
|
|
|
|
|
|
|
{ |
3046
|
1
|
|
|
1
|
1
|
160
|
local $_; |
3047
|
1
|
|
|
|
|
4
|
my ($self, $sort, $sort2) = @_; |
3048
|
1
|
50
|
33
|
|
|
8
|
my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; |
3049
|
1
|
|
|
|
|
5
|
return $self->GetTagList($foundTags, $sort, $sort2); |
3050
|
|
|
|
|
|
|
} |
3051
|
|
|
|
|
|
|
|
3052
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3053
|
|
|
|
|
|
|
# Get list of requested tags |
3054
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3055
|
|
|
|
|
|
|
# Returns: List of requested tag keys |
3056
|
|
|
|
|
|
|
sub GetRequestedTags($) |
3057
|
|
|
|
|
|
|
{ |
3058
|
2
|
|
|
2
|
1
|
5
|
local $_; |
3059
|
2
|
|
|
|
|
6
|
return @{$_[0]{REQUESTED_TAGS}}; |
|
2
|
|
|
|
|
12
|
|
3060
|
|
|
|
|
|
|
} |
3061
|
|
|
|
|
|
|
|
3062
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3063
|
|
|
|
|
|
|
# Get tag value |
3064
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3065
|
|
|
|
|
|
|
# 1) tag key or tag name with optional group names (case sensitive) |
3066
|
|
|
|
|
|
|
# (or flattened tagInfo for getting field values, not part of public API) |
3067
|
|
|
|
|
|
|
# 2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default |
3068
|
|
|
|
|
|
|
# is PrintConv or ValueConv, depending on the PrintConv option setting |
3069
|
|
|
|
|
|
|
# 3) raw field value (not part of public API) |
3070
|
|
|
|
|
|
|
# Returns: Scalar context: tag value or undefined |
3071
|
|
|
|
|
|
|
# List context: list of values or empty list |
3072
|
|
|
|
|
|
|
sub GetValue($$;$) |
3073
|
|
|
|
|
|
|
{ |
3074
|
52905
|
|
|
52905
|
1
|
71977
|
local $_; |
3075
|
52905
|
|
|
|
|
94322
|
my ($self, $tag, $type) = @_; # plus: ($fieldValue) |
3076
|
52905
|
|
|
|
|
72555
|
my (@convTypes, $tagInfo, $valueConv, $both); |
3077
|
52905
|
|
|
|
|
76305
|
my $rawValue = $$self{VALUE}; |
3078
|
|
|
|
|
|
|
|
3079
|
|
|
|
|
|
|
# get specific tag key if tag has a group name |
3080
|
52905
|
50
|
|
|
|
113338
|
if ($tag =~ /^(.*):(.+)/) { |
3081
|
0
|
|
|
|
|
0
|
my ($gp, $tg) = ($1, $2); |
3082
|
0
|
|
|
|
|
0
|
my ($i, $key, @keys); |
3083
|
|
|
|
|
|
|
# build list of tag keys in the order of priority (no index |
3084
|
|
|
|
|
|
|
# is top priority, otherwise higher index is higher priority) |
3085
|
0
|
|
0
|
|
|
0
|
for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) { |
3086
|
0
|
0
|
|
|
|
0
|
push @keys, $key if defined $$rawValue{$key}; |
3087
|
0
|
0
|
|
|
|
0
|
last if $i <= 0; |
3088
|
0
|
|
|
|
|
0
|
$key = "$tg ($i)"; |
3089
|
|
|
|
|
|
|
} |
3090
|
0
|
0
|
|
|
|
0
|
if (@keys) { |
3091
|
0
|
|
|
|
|
0
|
$key = $self->GroupMatches($gp, \@keys); |
3092
|
0
|
0
|
|
|
|
0
|
$tag = $key if $key; |
3093
|
|
|
|
|
|
|
} |
3094
|
|
|
|
|
|
|
} |
3095
|
|
|
|
|
|
|
# figure out what conversions to do |
3096
|
52905
|
100
|
|
|
|
87487
|
if ($type) { |
3097
|
52890
|
50
|
|
|
|
92360
|
return $$self{RATIONAL}{$tag} if $type eq 'Rational'; |
3098
|
|
|
|
|
|
|
} else { |
3099
|
15
|
50
|
|
|
|
83
|
$type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; |
3100
|
|
|
|
|
|
|
} |
3101
|
|
|
|
|
|
|
|
3102
|
|
|
|
|
|
|
# start with the raw value |
3103
|
52905
|
|
|
|
|
99075
|
my $value = $$rawValue{$tag}; |
3104
|
52905
|
100
|
|
|
|
88872
|
if (not defined $value) { |
3105
|
10093
|
100
|
|
|
|
28880
|
return () unless ref $tag; |
3106
|
|
|
|
|
|
|
# get the value of a structure field |
3107
|
194
|
|
|
|
|
279
|
$tagInfo = $tag; |
3108
|
194
|
|
|
|
|
378
|
$tag = $$tagInfo{Name}; |
3109
|
194
|
|
|
|
|
304
|
$value = $_[3]; |
3110
|
|
|
|
|
|
|
# (note: type "Both" is not allowed for structure fields) |
3111
|
194
|
50
|
|
|
|
367
|
if ($type ne 'Raw') { |
3112
|
194
|
|
|
|
|
325
|
push @convTypes, 'ValueConv'; |
3113
|
194
|
100
|
|
|
|
424
|
push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; |
3114
|
|
|
|
|
|
|
} |
3115
|
|
|
|
|
|
|
} else { |
3116
|
42812
|
|
|
|
|
80419
|
$tagInfo = $$self{TAG_INFO}{$tag}; |
3117
|
42812
|
100
|
66
|
|
|
102992
|
if ($$tagInfo{Struct} and ref $value) { |
3118
|
|
|
|
|
|
|
# must load XMPStruct.pl just in case (should already be loaded if |
3119
|
|
|
|
|
|
|
# a structure was extracted, but we could also arrive here if a simple |
3120
|
|
|
|
|
|
|
# list of values was stored incorrectly in a Struct tag) |
3121
|
53
|
|
|
|
|
1025
|
require 'Image/ExifTool/XMPStruct.pl'; |
3122
|
|
|
|
|
|
|
# convert strucure field values |
3123
|
53
|
100
|
|
|
|
187
|
unless ($type eq 'Both') { |
3124
|
|
|
|
|
|
|
# (note: ConvertStruct handles the filtering and escaping too if necessary) |
3125
|
48
|
|
|
|
|
255
|
return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type); |
3126
|
|
|
|
|
|
|
} |
3127
|
5
|
|
|
|
|
30
|
$valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv'); |
3128
|
5
|
|
|
|
|
36
|
$value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv'); |
3129
|
|
|
|
|
|
|
# (must not save these in $$self{BOTH} because the values may have been escaped) |
3130
|
5
|
|
|
|
|
47
|
return ($valueConv, $value); |
3131
|
|
|
|
|
|
|
} |
3132
|
42759
|
50
|
|
|
|
76628
|
if ($type ne 'Raw') { |
3133
|
|
|
|
|
|
|
# use values we calculated already if we stored them |
3134
|
42759
|
|
|
|
|
67707
|
$both = $$self{BOTH}{$tag}; |
3135
|
42759
|
100
|
|
|
|
68984
|
if ($both) { |
3136
|
6438
|
100
|
|
|
|
14012
|
if ($type eq 'PrintConv') { |
|
|
100
|
|
|
|
|
|
3137
|
2135
|
|
|
|
|
4689
|
$value = $$both[1]; |
3138
|
|
|
|
|
|
|
} elsif ($type eq 'ValueConv') { |
3139
|
96
|
|
|
|
|
170
|
$value = $$both[0]; |
3140
|
96
|
100
|
|
|
|
195
|
$value = $$both[1] unless defined $value; |
3141
|
|
|
|
|
|
|
} else { |
3142
|
4207
|
|
|
|
|
8346
|
($valueConv, $value) = @$both; |
3143
|
|
|
|
|
|
|
} |
3144
|
|
|
|
|
|
|
} else { |
3145
|
36321
|
|
|
|
|
57949
|
push @convTypes, 'ValueConv'; |
3146
|
36321
|
100
|
|
|
|
74596
|
push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; |
3147
|
|
|
|
|
|
|
} |
3148
|
|
|
|
|
|
|
} |
3149
|
|
|
|
|
|
|
} |
3150
|
|
|
|
|
|
|
|
3151
|
|
|
|
|
|
|
# do the conversions |
3152
|
42953
|
|
|
|
|
62494
|
my (@val, @prt, @raw, $convType); |
3153
|
42953
|
|
|
|
|
66407
|
foreach $convType (@convTypes) { |
3154
|
|
|
|
|
|
|
# don't convert a scalar reference or structure |
3155
|
70265
|
100
|
66
|
|
|
137349
|
last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary}; |
3156
|
69619
|
|
|
|
|
128218
|
my $conv = $$tagInfo{$convType}; |
3157
|
69619
|
100
|
|
|
|
118695
|
unless (defined $conv) { |
3158
|
45448
|
100
|
|
|
|
73223
|
if ($convType eq 'ValueConv') { |
3159
|
28885
|
100
|
|
|
|
66317
|
next unless $$tagInfo{Binary}; |
3160
|
400
|
|
|
|
|
904
|
$conv = '\$val'; # return scalar reference for binary values |
3161
|
|
|
|
|
|
|
} else { |
3162
|
|
|
|
|
|
|
# use PRINT_CONV from tag table if PrintConv doesn't exist |
3163
|
16563
|
100
|
|
|
|
50331
|
next unless defined($conv = $$tagInfo{Table}{PRINT_CONV}); |
3164
|
201
|
100
|
|
|
|
576
|
next if exists $$tagInfo{$convType}; |
3165
|
|
|
|
|
|
|
} |
3166
|
|
|
|
|
|
|
} |
3167
|
|
|
|
|
|
|
# save old ValueConv value if we want Both |
3168
|
24723
|
100
|
100
|
|
|
56048
|
$valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv'; |
3169
|
24723
|
|
|
|
|
36749
|
my ($i, $val, $vals, @values, $convList); |
3170
|
|
|
|
|
|
|
# split into list if conversion is an array |
3171
|
24723
|
100
|
|
|
|
48216
|
if (ref $conv eq 'ARRAY') { |
3172
|
124
|
|
|
|
|
343
|
$convList = $conv; |
3173
|
124
|
|
|
|
|
417
|
$conv = $$convList[0]; |
3174
|
124
|
50
|
|
|
|
699
|
my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value; |
3175
|
|
|
|
|
|
|
# reorganize list if specified (Note: The writer currently doesn't |
3176
|
|
|
|
|
|
|
# relist values, so they may be grouped but the order must not change) |
3177
|
124
|
|
|
|
|
327
|
my $relist = $$tagInfo{Relist}; |
3178
|
124
|
100
|
|
|
|
359
|
if ($relist) { |
3179
|
7
|
|
|
|
|
21
|
my (@newList, $oldIndex); |
3180
|
7
|
|
|
|
|
39
|
foreach $oldIndex (@$relist) { |
3181
|
14
|
|
|
|
|
30
|
my ($newVal, @join); |
3182
|
14
|
100
|
|
|
|
45
|
if (ref $oldIndex) { |
3183
|
7
|
|
|
|
|
23
|
foreach (@$oldIndex) { |
3184
|
16
|
50
|
|
|
|
59
|
push @join, $valList[$_] if defined $valList[$_]; |
3185
|
|
|
|
|
|
|
} |
3186
|
7
|
50
|
|
|
|
46
|
$newVal = join(' ', @join) if @join; |
3187
|
|
|
|
|
|
|
} else { |
3188
|
7
|
|
|
|
|
19
|
$newVal = $valList[$oldIndex]; |
3189
|
|
|
|
|
|
|
} |
3190
|
14
|
100
|
|
|
|
54
|
push @newList, $newVal if defined $newVal; |
3191
|
|
|
|
|
|
|
} |
3192
|
7
|
|
|
|
|
29
|
$value = \@newList; |
3193
|
|
|
|
|
|
|
} else { |
3194
|
117
|
|
|
|
|
304
|
$value = \@valList; |
3195
|
|
|
|
|
|
|
} |
3196
|
124
|
50
|
|
|
|
468
|
return () unless @$value; |
3197
|
|
|
|
|
|
|
} |
3198
|
|
|
|
|
|
|
# initialize array so we can iterate over values in list |
3199
|
24723
|
100
|
|
|
|
43801
|
if (ref $value eq 'ARRAY') { |
3200
|
155
|
100
|
|
|
|
514
|
if (defined $$tagInfo{RawJoin}) { |
3201
|
7
|
|
|
|
|
1416
|
$val = join ' ', @$value; |
3202
|
|
|
|
|
|
|
} else { |
3203
|
148
|
|
|
|
|
297
|
$i = 0; |
3204
|
148
|
|
|
|
|
278
|
$vals = $value; |
3205
|
148
|
|
|
|
|
327
|
$val = $$vals[0]; |
3206
|
|
|
|
|
|
|
} |
3207
|
|
|
|
|
|
|
} else { |
3208
|
24568
|
|
|
|
|
36816
|
$val = $value; |
3209
|
|
|
|
|
|
|
} |
3210
|
|
|
|
|
|
|
# loop through all values in list |
3211
|
24723
|
|
|
|
|
33079
|
for (;;) { |
3212
|
24936
|
100
|
|
|
|
41378
|
if (defined $conv) { |
3213
|
|
|
|
|
|
|
# get values of required tags if this is a Composite tag |
3214
|
24917
|
100
|
66
|
|
|
56491
|
if (ref $val eq 'HASH' and not @val) { |
3215
|
|
|
|
|
|
|
# disable escape of source values so we don't double escape them |
3216
|
2906
|
|
|
|
|
5171
|
my $oldEscape = $$self{ESCAPE_PROC}; |
3217
|
2906
|
|
|
|
|
4834
|
delete $$self{ESCAPE_PROC}; |
3218
|
|
|
|
|
|
|
# temporarily delete filter so it isn't applied to the Require'd values |
3219
|
2906
|
|
|
|
|
4682
|
my $oldFilter = $$self{OPTIONS}{Filter}; |
3220
|
2906
|
|
|
|
|
4808
|
delete $$self{OPTIONS}{Filter}; |
3221
|
2906
|
|
|
|
|
10175
|
foreach (keys %$val) { |
3222
|
17017
|
50
|
|
|
|
33544
|
next unless defined $$val{$_}; |
3223
|
17017
|
|
|
|
|
40672
|
$raw[$_] = $$rawValue{$$val{$_}}; |
3224
|
17017
|
|
|
|
|
34721
|
($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both'); |
3225
|
17017
|
100
|
100
|
|
|
53689
|
next if defined $val[$_] or not $$tagInfo{Require}{$_}; |
3226
|
382
|
50
|
|
|
|
1135
|
$$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; |
3227
|
382
|
|
|
|
|
746
|
$$self{ESCAPE_PROC} = $oldEscape; |
3228
|
382
|
|
|
|
|
1625
|
return (); |
3229
|
|
|
|
|
|
|
} |
3230
|
2524
|
100
|
|
|
|
7314
|
$$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; |
3231
|
2524
|
|
|
|
|
5117
|
$$self{ESCAPE_PROC} = $oldEscape; |
3232
|
|
|
|
|
|
|
# set $val to $val[0], or \@val for a CODE ref conversion |
3233
|
2524
|
50
|
|
|
|
6935
|
$val = ref $conv eq 'CODE' ? \@val : $val[0]; |
3234
|
|
|
|
|
|
|
} |
3235
|
24535
|
100
|
|
|
|
42939
|
if (ref $conv eq 'HASH') { |
3236
|
|
|
|
|
|
|
# look up converted value in hash |
3237
|
7547
|
100
|
|
|
|
29834
|
if (not defined($value = $$conv{$val})) { |
3238
|
440
|
100
|
|
|
|
1910
|
if ($$conv{BITMASK}) { |
3239
|
124
|
|
|
|
|
829
|
$value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord}); |
3240
|
|
|
|
|
|
|
} else { |
3241
|
|
|
|
|
|
|
# use alternate conversion routine if available |
3242
|
316
|
100
|
|
|
|
1132
|
if ($$conv{OTHER}) { |
3243
|
245
|
|
|
|
|
1327
|
local $SIG{'__WARN__'} = \&SetWarning; |
3244
|
245
|
|
|
|
|
733
|
undef $evalWarning; |
3245
|
245
|
|
|
|
|
575
|
$value = &{$$conv{OTHER}}($val, undef, $conv); |
|
245
|
|
|
|
|
1221
|
|
3246
|
245
|
50
|
|
|
|
1067
|
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; |
3247
|
|
|
|
|
|
|
} |
3248
|
316
|
100
|
|
|
|
1146
|
if (not defined $value) { |
3249
|
71
|
50
|
66
|
|
|
385
|
if ($$tagInfo{PrintHex} and $val and IsInt($val) and |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
3250
|
|
|
|
|
|
|
$convType eq 'PrintConv') |
3251
|
|
|
|
|
|
|
{ |
3252
|
0
|
|
|
|
|
0
|
$value = sprintf('Unknown (0x%x)',$val); |
3253
|
|
|
|
|
|
|
} else { |
3254
|
71
|
|
|
|
|
232
|
$value = "Unknown ($val)"; |
3255
|
|
|
|
|
|
|
} |
3256
|
|
|
|
|
|
|
} |
3257
|
|
|
|
|
|
|
} |
3258
|
|
|
|
|
|
|
} |
3259
|
|
|
|
|
|
|
# override with our localized language PrintConv if available |
3260
|
7547
|
|
|
|
|
11043
|
my $tmp; |
3261
|
7547
|
100
|
66
|
|
|
18669
|
if ($$self{CUR_LANG} and $convType eq 'PrintConv' and |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3262
|
|
|
|
|
|
|
# (no need to check for lang-alt tag names -- they won't have a PrintConv) |
3263
|
|
|
|
|
|
|
ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and |
3264
|
|
|
|
|
|
|
($tmp = $$tmp{PrintConv})) |
3265
|
|
|
|
|
|
|
{ |
3266
|
244
|
50
|
33
|
|
|
920
|
if ($$conv{BITMASK} and not defined $$conv{$val}) { |
|
|
100
|
|
|
|
|
|
3267
|
0
|
|
|
|
|
0
|
my @vals = split ', ', $value; |
3268
|
0
|
|
|
|
|
0
|
foreach (@vals) { |
3269
|
0
|
0
|
|
|
|
0
|
$_ = $$tmp{$_} if defined $$tmp{$_}; |
3270
|
|
|
|
|
|
|
} |
3271
|
0
|
|
|
|
|
0
|
$value = join ', ', @vals; |
3272
|
|
|
|
|
|
|
} elsif (defined($tmp = $$tmp{$value})) { |
3273
|
200
|
|
|
|
|
442
|
$value = $self->Decode($tmp, 'UTF8'); |
3274
|
|
|
|
|
|
|
} |
3275
|
|
|
|
|
|
|
} |
3276
|
|
|
|
|
|
|
} else { |
3277
|
|
|
|
|
|
|
# call subroutine or do eval to convert value |
3278
|
16988
|
|
|
|
|
67696
|
local $SIG{'__WARN__'} = \&SetWarning; |
3279
|
16988
|
|
|
|
|
29807
|
undef $evalWarning; |
3280
|
16988
|
100
|
|
|
|
30325
|
if (ref $conv eq 'CODE') { |
3281
|
835
|
|
|
|
|
4080
|
$value = &$conv($val, $self); |
3282
|
|
|
|
|
|
|
} else { |
3283
|
|
|
|
|
|
|
#### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw) |
3284
|
16153
|
|
|
|
|
1036596
|
$value = eval $conv; |
3285
|
16153
|
50
|
|
|
|
63865
|
$@ and $evalWarning = $@; |
3286
|
|
|
|
|
|
|
} |
3287
|
16988
|
50
|
|
|
|
57785
|
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; |
3288
|
|
|
|
|
|
|
} |
3289
|
|
|
|
|
|
|
} else { |
3290
|
19
|
|
|
|
|
37
|
$value = $val; |
3291
|
|
|
|
|
|
|
} |
3292
|
24554
|
100
|
|
|
|
53022
|
last unless $vals; |
3293
|
|
|
|
|
|
|
# must store a separate copy of each binary data value in the list |
3294
|
361
|
100
|
|
|
|
950
|
if (ref $value eq 'SCALAR') { |
3295
|
3
|
|
|
|
|
7
|
my $tval = $$value; |
3296
|
3
|
|
|
|
|
8
|
$value = \$tval; |
3297
|
|
|
|
|
|
|
} |
3298
|
|
|
|
|
|
|
# save this converted value and step to next value in list |
3299
|
361
|
50
|
|
|
|
1037
|
push @values, $value if defined $value; |
3300
|
361
|
100
|
|
|
|
900
|
if (++$i >= scalar(@$vals)) { |
3301
|
148
|
50
|
|
|
|
581
|
$value = \@values if @values; |
3302
|
148
|
|
|
|
|
302
|
last; |
3303
|
|
|
|
|
|
|
} |
3304
|
213
|
|
|
|
|
432
|
$val = $$vals[$i]; |
3305
|
213
|
100
|
|
|
|
523
|
if ($convList) { |
3306
|
132
|
|
|
|
|
269
|
my $nextConv = $$convList[$i]; |
3307
|
132
|
50
|
66
|
|
|
694
|
if ($nextConv and $nextConv eq 'REPEAT') { |
3308
|
0
|
|
|
|
|
0
|
undef $convList; |
3309
|
|
|
|
|
|
|
} else { |
3310
|
132
|
|
|
|
|
335
|
$conv = $nextConv; |
3311
|
|
|
|
|
|
|
} |
3312
|
|
|
|
|
|
|
} |
3313
|
|
|
|
|
|
|
} |
3314
|
|
|
|
|
|
|
# return undefined now if no value |
3315
|
24341
|
100
|
|
|
|
48935
|
return () unless defined $value; |
3316
|
|
|
|
|
|
|
# join back into single value if split for conversion list |
3317
|
23775
|
100
|
66
|
|
|
63441
|
if ($convList and ref $value eq 'ARRAY') { |
3318
|
124
|
100
|
|
|
|
808
|
$value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value); |
3319
|
|
|
|
|
|
|
} |
3320
|
|
|
|
|
|
|
} |
3321
|
42005
|
100
|
|
|
|
79746
|
if ($type eq 'Both') { |
3322
|
|
|
|
|
|
|
# save both (unescaped) values because we often need them again |
3323
|
|
|
|
|
|
|
# (Composite tags need "Both" and often Require one tag for various Composite tags) |
3324
|
7484
|
100
|
|
|
|
21251
|
$$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both; |
3325
|
|
|
|
|
|
|
# escape values if necessary |
3326
|
7484
|
50
|
|
|
|
19605
|
if ($$self{ESCAPE_PROC}) { |
|
|
100
|
|
|
|
|
|
3327
|
0
|
|
|
|
|
0
|
DoEscape($value, $$self{ESCAPE_PROC}); |
3328
|
0
|
0
|
|
|
|
0
|
if (defined $valueConv) { |
3329
|
0
|
|
|
|
|
0
|
DoEscape($valueConv, $$self{ESCAPE_PROC}); |
3330
|
|
|
|
|
|
|
} else { |
3331
|
0
|
|
|
|
|
0
|
$valueConv = $value; |
3332
|
|
|
|
|
|
|
} |
3333
|
|
|
|
|
|
|
} elsif (not defined $valueConv) { |
3334
|
|
|
|
|
|
|
# $valueConv is undefined if there was no print conversion done |
3335
|
3771
|
|
|
|
|
5783
|
$valueConv = $value; |
3336
|
|
|
|
|
|
|
} |
3337
|
7484
|
|
|
|
|
28666
|
$self->Filter($$self{OPTIONS}{Filter}, \$value); |
3338
|
|
|
|
|
|
|
# return Both values as a list (ValueConv, PrintConv) |
3339
|
7484
|
|
|
|
|
31826
|
return ($valueConv, $value); |
3340
|
|
|
|
|
|
|
} |
3341
|
|
|
|
|
|
|
# escape value if necessary |
3342
|
34521
|
100
|
|
|
|
65326
|
DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; |
3343
|
|
|
|
|
|
|
|
3344
|
|
|
|
|
|
|
# filter if necessary |
3345
|
34521
|
100
|
100
|
|
|
73320
|
$self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv'; |
3346
|
|
|
|
|
|
|
|
3347
|
34521
|
100
|
|
|
|
61996
|
if (ref $value eq 'ARRAY') { |
3348
|
289
|
100
|
100
|
|
|
2992
|
if (defined $$self{OPTIONS}{ListItem}) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3349
|
3
|
|
|
|
|
8
|
$value = $$value[$$self{OPTIONS}{ListItem}]; |
3350
|
|
|
|
|
|
|
} elsif (wantarray) { |
3351
|
|
|
|
|
|
|
# return array if requested |
3352
|
1
|
|
|
|
|
18
|
return @$value; |
3353
|
|
|
|
|
|
|
} elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) { |
3354
|
|
|
|
|
|
|
# join PrintConv values in comma-separated string if List option not used |
3355
|
|
|
|
|
|
|
# and list contains simple scalars (otherwise return ARRAY ref) |
3356
|
162
|
|
|
|
|
804
|
$value = join $$self{OPTIONS}{ListSep}, @$value; |
3357
|
|
|
|
|
|
|
} |
3358
|
|
|
|
|
|
|
} |
3359
|
34520
|
|
|
|
|
87480
|
return $value; |
3360
|
|
|
|
|
|
|
} |
3361
|
|
|
|
|
|
|
|
3362
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3363
|
|
|
|
|
|
|
# Get tag identification number |
3364
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3365
|
|
|
|
|
|
|
# Returns: Scalar context: tag ID if available, otherwise '' |
3366
|
|
|
|
|
|
|
# List context: 0) tag ID (or ''), 1) language code (or undef) |
3367
|
|
|
|
|
|
|
sub GetTagID($$) |
3368
|
|
|
|
|
|
|
{ |
3369
|
23282
|
|
|
23282
|
1
|
138318
|
my ($self, $tag) = @_; |
3370
|
23282
|
|
|
|
|
39625
|
my $tagInfo = $$self{TAG_INFO}{$tag}; |
3371
|
23282
|
100
|
66
|
|
|
76684
|
return '' unless $tagInfo and defined $$tagInfo{TagID}; |
3372
|
23280
|
|
100
|
|
|
61923
|
my $id = $$tagInfo{KeysID} || $$tagInfo{TagID}; |
3373
|
23280
|
50
|
|
|
|
42336
|
return ($id, $$tagInfo{LangCode}) if wantarray; |
3374
|
23280
|
|
|
|
|
48206
|
return $id; |
3375
|
|
|
|
|
|
|
} |
3376
|
|
|
|
|
|
|
|
3377
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3378
|
|
|
|
|
|
|
# Get description for specified tag |
3379
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3380
|
|
|
|
|
|
|
# Returns: Tag description |
3381
|
|
|
|
|
|
|
# Notes: Will always return a defined value, even if description isn't available |
3382
|
|
|
|
|
|
|
sub GetDescription($$) |
3383
|
|
|
|
|
|
|
{ |
3384
|
23282
|
|
|
23282
|
1
|
67361
|
local $_; |
3385
|
23282
|
|
|
|
|
38616
|
my ($self, $tag) = @_; |
3386
|
23282
|
|
|
|
|
32379
|
my ($desc, $name); |
3387
|
23282
|
|
|
|
|
37056
|
my $tagInfo = $$self{TAG_INFO}{$tag}; |
3388
|
|
|
|
|
|
|
# ($tagInfo won't be defined for missing tags extracted with -f) |
3389
|
23282
|
50
|
|
|
|
43492
|
if ($tagInfo) { |
3390
|
|
|
|
|
|
|
# use alternate language description if available |
3391
|
23282
|
|
|
|
|
46049
|
while ($$self{CUR_LANG}) { |
3392
|
800
|
|
|
|
|
1987
|
$desc = $$self{CUR_LANG}{$$tagInfo{Name}}; |
3393
|
800
|
100
|
|
|
|
1464
|
if ($desc) { |
3394
|
|
|
|
|
|
|
# must look up Description if this tag also has a PrintConv |
3395
|
671
|
100
|
100
|
|
|
1726
|
$desc = $$desc{Description} or last if ref $desc; |
3396
|
|
|
|
|
|
|
} else { |
3397
|
|
|
|
|
|
|
# look up default language of lang-alt tag |
3398
|
|
|
|
|
|
|
last unless $$tagInfo{LangCode} and |
3399
|
|
|
|
|
|
|
($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and |
3400
|
129
|
50
|
66
|
|
|
366
|
$desc = $$self{CUR_LANG}{$name}; |
|
|
|
66
|
|
|
|
|
3401
|
1
|
50
|
0
|
|
|
5
|
$desc = $$desc{Description} or last if ref $desc; |
3402
|
1
|
|
|
|
|
4
|
$desc .= " ($$tagInfo{LangCode})"; |
3403
|
|
|
|
|
|
|
} |
3404
|
|
|
|
|
|
|
# escape description if necessary |
3405
|
663
|
50
|
|
|
|
1195
|
DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; |
3406
|
|
|
|
|
|
|
# return description in proper Charset |
3407
|
663
|
|
|
|
|
1402
|
return $self->Decode($desc, 'UTF8'); |
3408
|
|
|
|
|
|
|
} |
3409
|
22619
|
|
|
|
|
42472
|
$desc = $$tagInfo{Description}; |
3410
|
|
|
|
|
|
|
} |
3411
|
|
|
|
|
|
|
# just make the tag more readable if description doesn't exist |
3412
|
22619
|
100
|
|
|
|
40723
|
unless ($desc) { |
3413
|
9412
|
|
|
|
|
17310
|
$desc = MakeDescription(GetTagName($tag)); |
3414
|
|
|
|
|
|
|
# save description in tag information |
3415
|
9412
|
50
|
|
|
|
28033
|
$$tagInfo{Description} = $desc if $tagInfo; |
3416
|
|
|
|
|
|
|
} |
3417
|
22619
|
|
|
|
|
47699
|
return $desc; |
3418
|
|
|
|
|
|
|
} |
3419
|
|
|
|
|
|
|
|
3420
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3421
|
|
|
|
|
|
|
# Get group name for specified tag |
3422
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3423
|
|
|
|
|
|
|
# 1) tag key (or reference to tagInfo hash, not part of the public API) |
3424
|
|
|
|
|
|
|
# 2) [optional] group family (-1 to get extended group list, or multiple |
3425
|
|
|
|
|
|
|
# families separated by colons to return multiple groups as a string) |
3426
|
|
|
|
|
|
|
# Returns: Scalar context: group name (for family 0 if not otherwise specified) |
3427
|
|
|
|
|
|
|
# List context: group name if family specified, otherwise list of |
3428
|
|
|
|
|
|
|
# group names for each family. Returns '' for undefined tag. |
3429
|
|
|
|
|
|
|
# Notes: Multiple families may be specified with ':' in family argument (eg. '1:2') |
3430
|
|
|
|
|
|
|
sub GetGroup($$;$) |
3431
|
|
|
|
|
|
|
{ |
3432
|
190519
|
|
|
190519
|
1
|
688326
|
local $_; |
3433
|
190519
|
|
|
|
|
328424
|
my ($self, $tag, $family) = @_; |
3434
|
190519
|
|
|
|
|
281027
|
my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID); |
3435
|
190519
|
100
|
|
|
|
357363
|
if (ref $tag eq 'HASH') { |
3436
|
120618
|
|
|
|
|
165222
|
$tagInfo = $tag; |
3437
|
120618
|
|
|
|
|
232015
|
$tag = $$tagInfo{Name}; |
3438
|
|
|
|
|
|
|
# set flag so we don't get extra information for an extracted tag |
3439
|
120618
|
|
|
|
|
165569
|
$byTagInfo = 1; |
3440
|
|
|
|
|
|
|
} else { |
3441
|
69901
|
|
50
|
|
|
163337
|
$tagInfo = $$self{TAG_INFO}{$tag} || { }; |
3442
|
69901
|
|
|
|
|
112692
|
$ex = $$self{TAG_EXTRA}{$tag}; |
3443
|
|
|
|
|
|
|
} |
3444
|
190519
|
|
|
|
|
367132
|
my $groups = $$tagInfo{Groups}; |
3445
|
|
|
|
|
|
|
# fill in default groups unless already done |
3446
|
|
|
|
|
|
|
# (after this, Groups 0-2 in tagInfo are guaranteed to be defined) |
3447
|
190519
|
100
|
|
|
|
378771
|
unless ($$tagInfo{GotGroups}) { |
3448
|
35640
|
|
50
|
|
|
72925
|
my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } }; |
3449
|
|
|
|
|
|
|
# construct our group list |
3450
|
35640
|
100
|
|
|
|
87128
|
$groups or $groups = $$tagInfo{Groups} = { }; |
3451
|
|
|
|
|
|
|
# fill in default groups |
3452
|
35640
|
|
|
|
|
66320
|
foreach (0..2) { |
3453
|
106920
|
100
|
50
|
|
|
376632
|
$$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_}; |
3454
|
|
|
|
|
|
|
} |
3455
|
|
|
|
|
|
|
# set flag indicating group list was built |
3456
|
35640
|
|
|
|
|
74833
|
$$tagInfo{GotGroups} = 1; |
3457
|
|
|
|
|
|
|
} |
3458
|
190519
|
100
|
100
|
|
|
509426
|
if (defined $family and $family ne '-1') { |
3459
|
98724
|
100
|
|
|
|
217710
|
if ($family =~ /[^\d]/) { |
3460
|
2736
|
|
|
|
|
8910
|
@families = ($family =~ /\d+/g); |
3461
|
2736
|
50
|
0
|
|
|
5599
|
return(($ex && $$ex{G0}) || $$groups{0}) unless @families; |
3462
|
2736
|
50
|
|
|
|
5713
|
$simplify = 1 unless $family =~ /^:/; |
3463
|
2736
|
|
|
|
|
3855
|
undef $family; |
3464
|
2736
|
|
|
|
|
4688
|
foreach (0..2) { $groups[$_] = $$groups{$_}; } |
|
8208
|
|
|
|
|
15680
|
|
3465
|
2736
|
50
|
33
|
|
|
5834
|
$noID = 1 if @families == 1 and $families[0] != 7; |
3466
|
|
|
|
|
|
|
} else { |
3467
|
95988
|
100
|
66
|
|
|
513152
|
return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2; |
|
|
|
100
|
|
|
|
|
3468
|
28485
|
|
|
|
|
91372
|
$groups[1] = $$groups{1}; |
3469
|
|
|
|
|
|
|
} |
3470
|
|
|
|
|
|
|
} else { |
3471
|
91795
|
100
|
33
|
|
|
169131
|
return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray; |
3472
|
91415
|
|
|
|
|
154020
|
foreach (0..2) { $groups[$_] = $$groups{$_}; } |
|
274245
|
|
|
|
|
614990
|
|
3473
|
|
|
|
|
|
|
} |
3474
|
122636
|
|
|
|
|
200090
|
$groups[3] = 'Main'; |
3475
|
122636
|
100
|
|
|
|
285375
|
$groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : ''; |
3476
|
|
|
|
|
|
|
# handle dynamic group names if necessary |
3477
|
122636
|
100
|
|
|
|
233819
|
unless ($byTagInfo) { |
3478
|
44337
|
100
|
|
|
|
78391
|
if ($ex) { |
3479
|
17255
|
100
|
|
|
|
37017
|
$groups[0] = $$ex{G0} if $$ex{G0}; |
3480
|
17255
|
100
|
|
|
|
50082
|
$groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1}; |
|
|
100
|
|
|
|
|
|
3481
|
17255
|
100
|
|
|
|
33517
|
$groups[3] = 'Doc' . $$ex{G3} if $$ex{G3}; |
3482
|
17255
|
100
|
66
|
|
|
33226
|
$groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5}; |
3483
|
17255
|
50
|
|
|
|
31790
|
if (defined $$ex{G6}) { |
3484
|
0
|
0
|
|
|
|
0
|
$groups[5] = '' unless defined $groups[5]; # (can't leave a hole in the array) |
3485
|
0
|
|
|
|
|
0
|
$groups[6] = $$ex{G6}; |
3486
|
|
|
|
|
|
|
} |
3487
|
|
|
|
|
|
|
} |
3488
|
|
|
|
|
|
|
# generate tag ID group names unless obviously not needed |
3489
|
44337
|
50
|
|
|
|
76013
|
unless ($noID) { |
3490
|
44337
|
|
100
|
|
|
146752
|
my $id = $$tagInfo{KeysID} || $$tagInfo{TagID}; |
3491
|
44337
|
100
|
|
|
|
137231
|
if (not defined $id) { |
|
|
100
|
|
|
|
|
|
3492
|
2
|
|
|
|
|
4
|
$id = ''; # (just to be safe) |
3493
|
|
|
|
|
|
|
} elsif ($id =~ /^\d+$/) { |
3494
|
27915
|
50
|
|
|
|
62381
|
$id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs}; |
3495
|
|
|
|
|
|
|
} else { |
3496
|
16420
|
|
|
|
|
34630
|
$id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge; |
|
1282
|
|
|
|
|
6125
|
|
3497
|
|
|
|
|
|
|
} |
3498
|
44337
|
|
|
|
|
89994
|
$groups[7] = 'ID-' . $id; |
3499
|
44337
|
|
100
|
|
|
154236
|
defined $groups[$_] or $groups[$_] = '' foreach (5,6); |
3500
|
|
|
|
|
|
|
} |
3501
|
|
|
|
|
|
|
} |
3502
|
122636
|
100
|
|
|
|
230816
|
if ($family) { |
3503
|
43626
|
100
|
50
|
|
|
183748
|
return $groups[$family] || '' if $family > 0; |
3504
|
|
|
|
|
|
|
# add additional matching group names to list |
3505
|
|
|
|
|
|
|
# eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1 |
3506
|
|
|
|
|
|
|
# and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc |
3507
|
15141
|
100
|
|
|
|
29406
|
if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) { |
3508
|
31
|
|
50
|
|
|
185
|
push @groups, 'MIE' . ($1 || '1'); |
3509
|
31
|
50
|
|
|
|
151
|
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3"; |
3510
|
31
|
50
|
|
|
|
169
|
push @groups, "MIE$1-$2" . ($3 ? '' : '1'); |
3511
|
31
|
50
|
|
|
|
162
|
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1'); |
|
|
50
|
|
|
|
|
|
3512
|
|
|
|
|
|
|
} |
3513
|
|
|
|
|
|
|
} |
3514
|
94151
|
100
|
|
|
|
182451
|
if (@families) { |
3515
|
2736
|
|
|
|
|
3421
|
my @grps; |
3516
|
|
|
|
|
|
|
# create list of group names (without identical adjacent groups if simplifying) |
3517
|
2736
|
|
|
|
|
4305
|
foreach (@families) { |
3518
|
5472
|
|
|
|
|
8554
|
my $grp = $groups[$_]; |
3519
|
5472
|
50
|
|
|
|
8964
|
unless ($grp) { |
3520
|
0
|
0
|
|
|
|
0
|
next if $simplify; |
3521
|
0
|
|
|
|
|
0
|
$grp = ''; |
3522
|
|
|
|
|
|
|
} |
3523
|
5472
|
100
|
66
|
|
|
21856
|
push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1]; |
|
|
|
100
|
|
|
|
|
3524
|
|
|
|
|
|
|
} |
3525
|
|
|
|
|
|
|
# remove leading "Main:" if simplifying |
3526
|
2736
|
50
|
66
|
|
|
10513
|
shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main'; |
|
|
|
66
|
|
|
|
|
3527
|
|
|
|
|
|
|
# return colon-separated string of group names |
3528
|
2736
|
|
|
|
|
10153
|
return join ':', @grps; |
3529
|
|
|
|
|
|
|
} |
3530
|
91415
|
|
|
|
|
363052
|
return @groups; |
3531
|
|
|
|
|
|
|
} |
3532
|
|
|
|
|
|
|
|
3533
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3534
|
|
|
|
|
|
|
# Get group names for specified tags |
3535
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3536
|
|
|
|
|
|
|
# 1) [optional] information hash reference (default all extracted info) |
3537
|
|
|
|
|
|
|
# 2) [optional] group family (default 0) |
3538
|
|
|
|
|
|
|
# Returns: List of group names in alphabetical order |
3539
|
|
|
|
|
|
|
sub GetGroups($;$$) |
3540
|
|
|
|
|
|
|
{ |
3541
|
3
|
|
|
3
|
1
|
76
|
local $_; |
3542
|
3
|
|
|
|
|
7
|
my $self = shift; |
3543
|
3
|
|
|
|
|
6
|
my $info = shift; |
3544
|
3
|
|
|
|
|
7
|
my $family; |
3545
|
|
|
|
|
|
|
|
3546
|
|
|
|
|
|
|
# figure out our arguments |
3547
|
3
|
100
|
|
|
|
15
|
if (ref $info ne 'HASH') { |
3548
|
2
|
|
|
|
|
4
|
$family = $info; |
3549
|
2
|
|
|
|
|
4
|
$info = $$self{VALUE}; |
3550
|
|
|
|
|
|
|
} else { |
3551
|
1
|
|
|
|
|
4
|
$family = shift; |
3552
|
|
|
|
|
|
|
} |
3553
|
3
|
50
|
|
|
|
10
|
$family = 0 unless defined $family; |
3554
|
|
|
|
|
|
|
|
3555
|
|
|
|
|
|
|
# get a list of all groups in specified information |
3556
|
3
|
|
|
|
|
7
|
my ($tag, %groups); |
3557
|
3
|
|
|
|
|
62
|
foreach $tag (keys %$info) { |
3558
|
383
|
|
|
|
|
770
|
$groups{ $self->GetGroup($tag, $family) } = 1; |
3559
|
|
|
|
|
|
|
} |
3560
|
3
|
|
|
|
|
62
|
return sort keys %groups; |
3561
|
|
|
|
|
|
|
} |
3562
|
|
|
|
|
|
|
|
3563
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3564
|
|
|
|
|
|
|
# Set priority for group where new values are written |
3565
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, |
3566
|
|
|
|
|
|
|
# 1-N) group names (reset to default if no groups specified) |
3567
|
|
|
|
|
|
|
# - used when new tag values are set (ie. before files are written) |
3568
|
|
|
|
|
|
|
sub SetNewGroups($;@) |
3569
|
|
|
|
|
|
|
{ |
3570
|
475
|
|
|
475
|
1
|
1036
|
local $_; |
3571
|
475
|
|
|
|
|
2513
|
my ($self, @groups) = @_; |
3572
|
475
|
50
|
|
|
|
1754
|
@groups or @groups = @defaultWriteGroups; |
3573
|
475
|
|
|
|
|
1412
|
my $count = @groups * 10; |
3574
|
475
|
|
|
|
|
957
|
my %priority; |
3575
|
475
|
|
|
|
|
1471
|
foreach (@groups) { |
3576
|
4275
|
|
|
|
|
9213
|
$priority{lc($_)} = $count; |
3577
|
4275
|
|
|
|
|
6497
|
$count -= 10; |
3578
|
|
|
|
|
|
|
} |
3579
|
475
|
|
|
|
|
1735
|
$priority{file} = 500; # 'File' group is always written (Comment) |
3580
|
475
|
|
|
|
|
1241
|
$priority{composite} = 500; # 'Composite' group is always written |
3581
|
|
|
|
|
|
|
# set write priority (higher # is higher priority) |
3582
|
475
|
|
|
|
|
1403
|
$$self{WRITE_PRIORITY} = \%priority; |
3583
|
475
|
|
|
|
|
1967
|
$$self{WRITE_GROUPS} = \@groups; |
3584
|
|
|
|
|
|
|
} |
3585
|
|
|
|
|
|
|
|
3586
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3587
|
|
|
|
|
|
|
# Build Composite tags from Require'd/Desire'd tags |
3588
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3589
|
|
|
|
|
|
|
# Note: Tag values are calculated in alphabetical order unless a tag Require's |
3590
|
|
|
|
|
|
|
# or Desire's another Composite tag, in which case the calculation is |
3591
|
|
|
|
|
|
|
# deferred until after the other tag is calculated. |
3592
|
|
|
|
|
|
|
sub BuildCompositeTags($) |
3593
|
|
|
|
|
|
|
{ |
3594
|
506
|
|
|
506
|
1
|
1182
|
local $_; |
3595
|
506
|
|
|
|
|
1050
|
my $self = shift; |
3596
|
|
|
|
|
|
|
|
3597
|
506
|
|
|
|
|
6166
|
$$self{BuildingComposite} = 1; |
3598
|
|
|
|
|
|
|
|
3599
|
506
|
|
|
|
|
1686
|
my $compTable = GetTagTable('Image::ExifTool::Composite'); |
3600
|
506
|
|
|
|
|
33297
|
my @tagList = sort keys %$compTable; |
3601
|
506
|
|
|
|
|
3010
|
my $rawValue = $$self{VALUE}; |
3602
|
506
|
|
|
|
|
2579
|
my $compKeys = $$self{COMP_KEYS}; |
3603
|
506
|
|
|
|
|
1345
|
my (%cache, $allBuilt); |
3604
|
|
|
|
|
|
|
|
3605
|
506
|
|
|
|
|
1202
|
for (;;) { |
3606
|
2214
|
|
|
|
|
4132
|
my (%notBuilt, $tag, @deferredTags); |
3607
|
2214
|
|
|
|
|
4770
|
foreach (@tagList) { |
3608
|
42980
|
100
|
|
|
|
136741
|
$notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_}; |
3609
|
|
|
|
|
|
|
} |
3610
|
|
|
|
|
|
|
COMPOSITE_TAG: |
3611
|
2214
|
|
|
|
|
4288
|
foreach $tag (@tagList) { |
3612
|
42980
|
100
|
|
|
|
87791
|
next if $specialTags{$tag}; |
3613
|
39944
|
|
|
|
|
82343
|
my $tagInfo = $self->GetTagInfo($compTable, $tag); |
3614
|
39944
|
100
|
|
|
|
76487
|
next unless $tagInfo; |
3615
|
39695
|
|
|
|
|
65851
|
my $tagName = $$compTable{$tag}{Name}; |
3616
|
|
|
|
|
|
|
# put required tags into array and make sure they all exist |
3617
|
39695
|
|
100
|
|
|
83158
|
my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT}); |
3618
|
39695
|
|
100
|
|
|
98334
|
my $require = $$tagInfo{Require} || { }; |
3619
|
39695
|
|
100
|
|
|
101101
|
my $desire = $$tagInfo{Desire} || { }; |
3620
|
39695
|
|
100
|
|
|
100260
|
my $inhibit = $$tagInfo{Inhibit} || { }; |
3621
|
|
|
|
|
|
|
# loop through sub-documents if necessary |
3622
|
39695
|
|
|
|
|
55676
|
my $docNum = 0; |
3623
|
39695
|
|
|
|
|
52577
|
for (;;) { |
3624
|
39695
|
|
|
|
|
56723
|
my (%tagKey, $found, $index); |
3625
|
|
|
|
|
|
|
# save Require'd and Desire'd tag values in list |
3626
|
39695
|
|
|
|
|
56956
|
for ($index=0; ; ++$index) { |
3627
|
94633
|
|
100
|
|
|
321260
|
my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index}; |
3628
|
94633
|
100
|
|
|
|
159790
|
unless ($reqTag) { |
3629
|
|
|
|
|
|
|
# allow Composite with no Require'd or Desire'd tags |
3630
|
8843
|
50
|
|
|
|
17789
|
$found = 1 if $index == 0; |
3631
|
8843
|
|
|
|
|
14022
|
last; |
3632
|
|
|
|
|
|
|
} |
3633
|
85790
|
100
|
66
|
|
|
300050
|
if ($subDoc) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3634
|
|
|
|
|
|
|
# handle SubDoc tags specially to cache tag keys for faster |
3635
|
|
|
|
|
|
|
# processing when there are a large number of sub-documents |
3636
|
|
|
|
|
|
|
# - get document number from the tag groups if specified, |
3637
|
|
|
|
|
|
|
# otherwise we are looping through all documents for this tag |
3638
|
285
|
50
|
0
|
|
|
900
|
my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum; |
3639
|
|
|
|
|
|
|
# make fast lookup for keys of this tag with specified groups other than doc group |
3640
|
|
|
|
|
|
|
# (similar to code in InsertTagValues(), but this is case-sensitive) |
3641
|
285
|
|
|
|
|
489
|
my $cacheTag = $cache{$reqTag}; |
3642
|
285
|
50
|
|
|
|
538
|
unless ($cacheTag) { |
3643
|
285
|
|
|
|
|
868
|
$cacheTag = $cache{$reqTag} = [ ]; |
3644
|
285
|
|
|
|
|
445
|
my $reqGroup; |
3645
|
285
|
50
|
|
|
|
1505
|
$reqTag =~ s/^(.*):// and $reqGroup = $1; |
3646
|
285
|
|
|
|
|
558
|
my ($i, $key, @keys); |
3647
|
|
|
|
|
|
|
# build list of tag keys in order of precedence |
3648
|
285
|
|
50
|
|
|
1053
|
for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) { |
3649
|
285
|
50
|
|
|
|
684
|
push @keys, $key if defined $$rawValue{$key}; |
3650
|
285
|
50
|
|
|
|
635
|
last if $i <= 0; |
3651
|
0
|
|
|
|
|
0
|
$key = "$reqTag ($i)"; |
3652
|
|
|
|
|
|
|
} |
3653
|
285
|
50
|
|
|
|
880
|
@keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup; |
3654
|
285
|
50
|
|
|
|
684
|
if (@keys) { |
3655
|
0
|
|
|
|
|
0
|
my $ex = $$self{TAG_EXTRA}; |
3656
|
|
|
|
|
|
|
# loop through tags in reverse order of precedence so the higher |
3657
|
|
|
|
|
|
|
# priority tag will win in the case of duplicates within a doc |
3658
|
0
|
0
|
0
|
|
|
0
|
$$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys; |
3659
|
|
|
|
|
|
|
} |
3660
|
|
|
|
|
|
|
} |
3661
|
|
|
|
|
|
|
# (set $reqTag to a bogus key if not found) |
3662
|
285
|
|
33
|
|
|
1100
|
$reqTag = $$cacheTag[$doc] || "$reqTag (0)"; |
3663
|
|
|
|
|
|
|
} elsif ($reqTag =~ /^(.*):(.+)/) { |
3664
|
26553
|
|
|
|
|
74566
|
my ($reqGroup, $name) = ($1, $2); |
3665
|
26553
|
100
|
100
|
|
|
59864
|
if ($reqGroup eq 'Composite' and $notBuilt{$name}) { |
3666
|
|
|
|
|
|
|
# defer only until all other tags are built if |
3667
|
|
|
|
|
|
|
# we are inhibiting based on another Composite tag |
3668
|
2095
|
100
|
100
|
|
|
8628
|
unless ($$inhibit{$index} and $allBuilt) { |
3669
|
1655
|
|
|
|
|
3268
|
push @deferredTags, $tag; |
3670
|
1655
|
|
|
|
|
6211
|
next COMPOSITE_TAG; |
3671
|
|
|
|
|
|
|
} |
3672
|
|
|
|
|
|
|
} |
3673
|
|
|
|
|
|
|
# (CAREFUL! keys may not be sequential if one was deleted) |
3674
|
24898
|
|
|
|
|
36257
|
my ($i, $key, @keys); |
3675
|
24898
|
|
100
|
|
|
80627
|
for ($key=$name, $i=$$self{DUPL_TAG}{$name} || 0; ; --$i) { |
3676
|
25537
|
100
|
|
|
|
55590
|
push @keys, $key if defined $$rawValue{$key}; |
3677
|
25537
|
100
|
|
|
|
50720
|
last if $i <= 0; |
3678
|
639
|
|
|
|
|
1900
|
$key = "$name ($i)"; |
3679
|
|
|
|
|
|
|
} |
3680
|
|
|
|
|
|
|
# find first matching tag |
3681
|
24898
|
|
|
|
|
56515
|
$key = $self->GroupMatches($reqGroup, \@keys); |
3682
|
24898
|
|
66
|
|
|
84903
|
$reqTag = $key || "$name (0)"; |
3683
|
|
|
|
|
|
|
} elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) { |
3684
|
|
|
|
|
|
|
# calculate this tag later if it relies on another |
3685
|
|
|
|
|
|
|
# Composite tag which hasn't been calculated yet |
3686
|
4895
|
|
|
|
|
9142
|
push @deferredTags, $tag; |
3687
|
4895
|
|
|
|
|
13205
|
next COMPOSITE_TAG; |
3688
|
|
|
|
|
|
|
} |
3689
|
79240
|
100
|
|
|
|
182047
|
if (defined $$rawValue{$reqTag}) { |
|
|
100
|
|
|
|
|
|
3690
|
15763
|
100
|
|
|
|
25677
|
if ($$inhibit{$index}) { |
3691
|
66
|
|
|
|
|
244
|
$found = 0; |
3692
|
66
|
|
|
|
|
178
|
last; |
3693
|
|
|
|
|
|
|
} else { |
3694
|
15697
|
|
|
|
|
22674
|
$found = 1; |
3695
|
|
|
|
|
|
|
} |
3696
|
|
|
|
|
|
|
} elsif ($$require{$index}) { |
3697
|
24236
|
|
|
|
|
32246
|
$found = 0; |
3698
|
24236
|
|
|
|
|
36838
|
last; # don't continue since we require this tag |
3699
|
|
|
|
|
|
|
} |
3700
|
54938
|
|
|
|
|
113961
|
$tagKey{$index} = $reqTag; |
3701
|
|
|
|
|
|
|
} |
3702
|
33145
|
50
|
|
|
|
80742
|
if ($docNum) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3703
|
0
|
0
|
|
|
|
0
|
if ($found) { |
3704
|
0
|
|
|
|
|
0
|
$$self{DOC_NUM} = $docNum; |
3705
|
|
|
|
|
|
|
# save pointers to all used tag keys |
3706
|
0
|
|
|
|
|
0
|
foreach (keys %tagKey) { |
3707
|
0
|
0
|
|
|
|
0
|
$$compKeys{$_} or $$compKeys{$_} = [ ]; |
3708
|
0
|
|
|
|
|
0
|
push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; |
|
0
|
|
|
|
|
0
|
|
3709
|
|
|
|
|
|
|
} |
3710
|
0
|
|
|
|
|
0
|
$self->FoundTag($tagInfo, \%tagKey); |
3711
|
0
|
|
|
|
|
0
|
delete $$self{DOC_NUM}; |
3712
|
|
|
|
|
|
|
} |
3713
|
0
|
0
|
|
|
|
0
|
next if ++$docNum <= $$self{DOC_COUNT}; |
3714
|
0
|
|
|
|
|
0
|
last; |
3715
|
|
|
|
|
|
|
} elsif ($found) { |
3716
|
5135
|
|
|
|
|
10507
|
delete $notBuilt{$tagName}; # this tag is OK to build now |
3717
|
|
|
|
|
|
|
# keep track of all Require'd tag keys |
3718
|
5135
|
|
|
|
|
19151
|
foreach (keys %tagKey) { |
3719
|
|
|
|
|
|
|
# only tag keys with same name as a Composite tag |
3720
|
|
|
|
|
|
|
# can be replaced (also eliminates keys with |
3721
|
|
|
|
|
|
|
# instance numbers which can't be replaced either) |
3722
|
22807
|
100
|
|
|
|
51695
|
next unless $compositeID{$tagKey{$_}}; |
3723
|
|
|
|
|
|
|
} |
3724
|
|
|
|
|
|
|
# save pointers to all used tag keys |
3725
|
5135
|
|
|
|
|
12858
|
foreach (keys %tagKey) { |
3726
|
22807
|
100
|
|
|
|
48424
|
$$compKeys{$_} or $$compKeys{$_} = [ ]; |
3727
|
22807
|
|
|
|
|
29466
|
push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; |
|
22807
|
|
|
|
|
84070
|
|
3728
|
|
|
|
|
|
|
} |
3729
|
|
|
|
|
|
|
# save reference to tag key lookup as value for Composite tag |
3730
|
5135
|
|
|
|
|
17514
|
my $key = $self->FoundTag($tagInfo, \%tagKey); |
3731
|
|
|
|
|
|
|
} elsif (not defined $found) { |
3732
|
3708
|
|
|
|
|
8104
|
delete $notBuilt{$tagName}; # tag can't be built anyway |
3733
|
|
|
|
|
|
|
} |
3734
|
33145
|
100
|
|
|
|
95371
|
last unless $subDoc; |
3735
|
|
|
|
|
|
|
# don't process sub-documents if there is no chance to build this tag |
3736
|
|
|
|
|
|
|
# (can be very time-consuming if there are many docs) |
3737
|
195
|
100
|
|
|
|
493
|
if (%$require) { |
3738
|
165
|
|
|
|
|
615
|
foreach (keys %$require) { |
3739
|
165
|
|
|
|
|
383
|
my $reqTag = $$require{$_}; |
3740
|
165
|
|
|
|
|
623
|
$reqTag =~ s/.*://; |
3741
|
165
|
50
|
|
|
|
720
|
next COMPOSITE_TAG unless defined $$rawValue{$reqTag}; |
3742
|
|
|
|
|
|
|
} |
3743
|
0
|
|
|
|
|
0
|
$docNum = 1; # go ahead and process the 1st sub-document |
3744
|
|
|
|
|
|
|
} else { |
3745
|
30
|
50
|
|
|
|
155
|
my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire; |
|
30
|
|
|
|
|
128
|
|
3746
|
|
|
|
|
|
|
# at least one of the specified desire tags must exist |
3747
|
30
|
|
|
|
|
111
|
foreach (@try) { |
3748
|
60
|
50
|
|
|
|
216
|
my $desTag = $$desire{$_} or next; |
3749
|
60
|
|
|
|
|
265
|
$desTag =~ s/.*://; |
3750
|
60
|
50
|
|
|
|
272
|
defined $$rawValue{$desTag} and $docNum = 1, last; |
3751
|
|
|
|
|
|
|
} |
3752
|
30
|
50
|
|
|
|
193
|
last unless $docNum; |
3753
|
|
|
|
|
|
|
} |
3754
|
|
|
|
|
|
|
} |
3755
|
|
|
|
|
|
|
} |
3756
|
2214
|
100
|
|
|
|
6882
|
last unless @deferredTags; |
3757
|
1708
|
100
|
|
|
|
5700
|
if (@deferredTags == @tagList) { |
3758
|
440
|
50
|
|
|
|
1731
|
if ($allBuilt) { |
3759
|
|
|
|
|
|
|
# everything was deferred in the last pass, |
3760
|
|
|
|
|
|
|
# must be a circular dependency |
3761
|
0
|
|
|
|
|
0
|
warn "Circular dependency in Composite tags\n"; |
3762
|
0
|
|
|
|
|
0
|
last; |
3763
|
|
|
|
|
|
|
} |
3764
|
440
|
|
|
|
|
1050
|
$allBuilt = 1; # try once more, ignoring Composite Inhibit tags |
3765
|
|
|
|
|
|
|
} |
3766
|
1708
|
|
|
|
|
10112
|
@tagList = @deferredTags; # calculate deferred tags now |
3767
|
|
|
|
|
|
|
} |
3768
|
506
|
|
|
|
|
2472
|
delete $$self{BuildingComposite}; |
3769
|
|
|
|
|
|
|
} |
3770
|
|
|
|
|
|
|
|
3771
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3772
|
|
|
|
|
|
|
# Get reference to Composite tag info hash |
3773
|
|
|
|
|
|
|
# Inputs: 0) case-sensitive Composite tag name |
3774
|
|
|
|
|
|
|
# Returns: tagInfo hash or undef |
3775
|
|
|
|
|
|
|
sub GetCompositeTagInfo($) |
3776
|
|
|
|
|
|
|
{ |
3777
|
11
|
|
|
11
|
0
|
36
|
my $tag = shift; |
3778
|
11
|
50
|
|
|
|
60
|
return undef unless $compositeID{$tag}; |
3779
|
11
|
|
|
|
|
60
|
return $Image::ExifTool::Composite{$compositeID{$tag}[0]}; |
3780
|
|
|
|
|
|
|
} |
3781
|
|
|
|
|
|
|
|
3782
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3783
|
|
|
|
|
|
|
# Get tag name (removes copy index) |
3784
|
|
|
|
|
|
|
# Inputs: 0) Tag key |
3785
|
|
|
|
|
|
|
# Returns: Tag name |
3786
|
|
|
|
|
|
|
sub GetTagName($) |
3787
|
|
|
|
|
|
|
{ |
3788
|
16738
|
|
|
16738
|
1
|
22898
|
local $_; |
3789
|
16738
|
|
|
|
|
40885
|
$_[0] =~ /^(\S+)/; |
3790
|
16738
|
|
|
|
|
48777
|
return $1; |
3791
|
|
|
|
|
|
|
} |
3792
|
|
|
|
|
|
|
|
3793
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3794
|
|
|
|
|
|
|
# Get list of shortcuts |
3795
|
|
|
|
|
|
|
# Returns: Shortcut list (sorted alphabetically) |
3796
|
|
|
|
|
|
|
sub GetShortcuts() |
3797
|
|
|
|
|
|
|
{ |
3798
|
0
|
|
|
0
|
1
|
0
|
local $_; |
3799
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Shortcuts; |
3800
|
0
|
|
|
|
|
0
|
return sort keys %Image::ExifTool::Shortcuts::Main; |
3801
|
|
|
|
|
|
|
} |
3802
|
|
|
|
|
|
|
|
3803
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3804
|
|
|
|
|
|
|
# Get file type for specified extension |
3805
|
|
|
|
|
|
|
# Inputs: 0) file name or extension (case is not significant), |
3806
|
|
|
|
|
|
|
# or FileType value if a description is requested |
3807
|
|
|
|
|
|
|
# 1) flag to return long description instead of type ('0' to return any recognized type) |
3808
|
|
|
|
|
|
|
# Returns: File type (or desc) or undef if extension not supported or if |
3809
|
|
|
|
|
|
|
# description is the same as the input FileType. In list context, |
3810
|
|
|
|
|
|
|
# may return more than one file type if the file may be different formats. |
3811
|
|
|
|
|
|
|
# Returns list of all supported extensions if no file specified |
3812
|
|
|
|
|
|
|
sub GetFileType(;$$) |
3813
|
|
|
|
|
|
|
{ |
3814
|
953
|
|
|
953
|
1
|
2098
|
local $_; |
3815
|
953
|
|
|
|
|
2636
|
my ($file, $desc) = @_; |
3816
|
953
|
50
|
|
|
|
3795
|
unless (defined $file) { |
3817
|
0
|
|
|
|
|
0
|
my @types; |
3818
|
0
|
0
|
0
|
|
|
0
|
if (defined $desc and $desc eq '0') { |
3819
|
|
|
|
|
|
|
# return all recognized types |
3820
|
0
|
|
|
|
|
0
|
@types = sort keys %fileTypeLookup; |
3821
|
|
|
|
|
|
|
} else { |
3822
|
|
|
|
|
|
|
# return all supported types |
3823
|
0
|
|
|
|
|
0
|
foreach (sort keys %fileTypeLookup) { |
3824
|
0
|
|
|
|
|
0
|
my $module = $moduleName{$_}; |
3825
|
0
|
0
|
|
|
|
0
|
$module = $moduleName{$fileTypeLookup{$_}} unless defined $module; |
3826
|
0
|
0
|
0
|
|
|
0
|
push @types, $_ unless defined $module and $module eq '0'; |
3827
|
|
|
|
|
|
|
} |
3828
|
|
|
|
|
|
|
} |
3829
|
0
|
|
|
|
|
0
|
return @types; |
3830
|
|
|
|
|
|
|
} |
3831
|
953
|
|
|
|
|
2129
|
my ($fileType, $subType); |
3832
|
953
|
|
|
|
|
2357
|
my $fileExt = GetFileExtension($file); |
3833
|
953
|
100
|
|
|
|
3487
|
unless ($fileExt) { |
3834
|
66
|
50
|
|
|
|
294
|
if ($file =~ s/ \((.*)\)$//) { |
3835
|
0
|
|
|
|
|
0
|
$subType = $1; |
3836
|
0
|
|
|
|
|
0
|
$fileExt = GetFileExtension($file); |
3837
|
|
|
|
|
|
|
} |
3838
|
66
|
50
|
|
|
|
308
|
$fileExt = uc($file) unless $fileExt; |
3839
|
|
|
|
|
|
|
} |
3840
|
953
|
100
|
|
|
|
4044
|
$fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type |
3841
|
953
|
|
100
|
|
|
6644
|
$fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType; |
3842
|
|
|
|
|
|
|
# return description if specified |
3843
|
|
|
|
|
|
|
# (allow input $file to be a FileType for this purpose) |
3844
|
953
|
50
|
33
|
|
|
6579
|
if ($desc) { |
|
|
100
|
66
|
|
|
|
|
3845
|
0
|
0
|
|
|
|
0
|
if ($fileType) { |
3846
|
0
|
0
|
0
|
|
|
0
|
if ($static_vars{OverrideFileDescription} and $static_vars{OverrideFileDescription}{$fileExt}) { |
3847
|
0
|
|
|
|
|
0
|
$desc = $static_vars{OverrideFileDescription}{$fileExt}; |
3848
|
|
|
|
|
|
|
} else { |
3849
|
0
|
|
|
|
|
0
|
$desc = $$fileType[1]; |
3850
|
|
|
|
|
|
|
} |
3851
|
|
|
|
|
|
|
} else { |
3852
|
0
|
|
|
|
|
0
|
$desc = $fileDescription{$file}; |
3853
|
|
|
|
|
|
|
} |
3854
|
0
|
0
|
|
|
|
0
|
$desc .= ", $subType" if $subType; |
3855
|
0
|
|
|
|
|
0
|
return $desc; |
3856
|
|
|
|
|
|
|
} elsif ($fileType and (not defined $desc or $desc ne '0')) { |
3857
|
|
|
|
|
|
|
# return only supported file types |
3858
|
904
|
|
|
|
|
3309
|
my $mod = $moduleName{$$fileType[0]}; |
3859
|
904
|
50
|
66
|
|
|
4205
|
undef $fileType if defined $mod and $mod eq '0'; |
3860
|
|
|
|
|
|
|
} |
3861
|
953
|
100
|
|
|
|
2771
|
$fileType or return (); |
3862
|
904
|
|
|
|
|
1921
|
$fileType = $$fileType[0]; # get file type (or list of types) |
3863
|
904
|
100
|
|
|
|
2937
|
if (wantarray) { |
|
|
50
|
|
|
|
|
|
3864
|
675
|
100
|
|
|
|
2289
|
return @$fileType if ref $fileType eq 'ARRAY'; |
3865
|
|
|
|
|
|
|
} elsif ($fileType) { |
3866
|
229
|
50
|
|
|
|
925
|
$fileType = $fileExt if ref $fileType eq 'ARRAY'; |
3867
|
|
|
|
|
|
|
} |
3868
|
900
|
|
|
|
|
3063
|
return $fileType; |
3869
|
|
|
|
|
|
|
} |
3870
|
|
|
|
|
|
|
|
3871
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3872
|
|
|
|
|
|
|
# Return true if we can write the specified file type |
3873
|
|
|
|
|
|
|
# Inputs: 0) file name or ext |
3874
|
|
|
|
|
|
|
# Returns: true if writable, 0 if not writable, undef if unrecognized |
3875
|
|
|
|
|
|
|
sub CanWrite($) |
3876
|
|
|
|
|
|
|
{ |
3877
|
0
|
|
|
0
|
1
|
0
|
local $_; |
3878
|
0
|
0
|
|
|
|
0
|
my $file = shift or return undef; |
3879
|
0
|
0
|
|
|
|
0
|
my ($type) = GetFileType($file) or return undef; |
3880
|
0
|
0
|
|
|
|
0
|
if ($noWriteFile{$type}) { |
3881
|
|
|
|
|
|
|
# can't write TIFF files with certain extensions (various RAW formats) |
3882
|
0
|
|
0
|
|
|
0
|
my $ext = GetFileExtension($file) || uc($file); |
3883
|
0
|
0
|
|
|
|
0
|
return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext; |
|
0
|
0
|
|
|
|
0
|
|
3884
|
|
|
|
|
|
|
} |
3885
|
0
|
0
|
|
|
|
0
|
if ($onlyWriteFile{$type}) { |
3886
|
0
|
|
0
|
|
|
0
|
my $ext = GetFileExtension($file) || uc($file); |
3887
|
0
|
0
|
|
|
|
0
|
return grep(/^$ext$/, @{$onlyWriteFile{$type}}) ? 1 : 0 if $ext; |
|
0
|
0
|
|
|
|
0
|
|
3888
|
|
|
|
|
|
|
} |
3889
|
0
|
0
|
|
|
|
0
|
unless (%writeTypes) { |
3890
|
0
|
|
|
|
|
0
|
$writeTypes{$_} = 1 foreach @writeTypes; |
3891
|
|
|
|
|
|
|
} |
3892
|
0
|
|
|
|
|
0
|
return $writeTypes{$type}; |
3893
|
|
|
|
|
|
|
} |
3894
|
|
|
|
|
|
|
|
3895
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3896
|
|
|
|
|
|
|
# Return true if we can create the specified file type |
3897
|
|
|
|
|
|
|
# Inputs: 0) file name or ext |
3898
|
|
|
|
|
|
|
# Returns: true if creatable, 0 if not writable, undef if unrecognized |
3899
|
|
|
|
|
|
|
sub CanCreate($) |
3900
|
|
|
|
|
|
|
{ |
3901
|
23
|
|
|
23
|
1
|
57
|
local $_; |
3902
|
23
|
50
|
|
|
|
107
|
my $file = shift or return undef; |
3903
|
23
|
|
33
|
|
|
88
|
my $ext = GetFileExtension($file) || uc($file); |
3904
|
23
|
50
|
|
|
|
104
|
my $type = GetFileType($file) or return undef; |
3905
|
23
|
50
|
33
|
|
|
224
|
return 1 if $createTypes{$ext} or $createTypes{$type}; |
3906
|
0
|
|
|
|
|
0
|
return 0; |
3907
|
|
|
|
|
|
|
} |
3908
|
|
|
|
|
|
|
|
3909
|
|
|
|
|
|
|
#============================================================================== |
3910
|
|
|
|
|
|
|
# Functions below this are not part of the public API |
3911
|
|
|
|
|
|
|
|
3912
|
|
|
|
|
|
|
# Initialize member variables for reading or writing a new file |
3913
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3914
|
|
|
|
|
|
|
sub Init($) |
3915
|
|
|
|
|
|
|
{ |
3916
|
770
|
|
|
770
|
0
|
1833
|
local $_; |
3917
|
770
|
|
|
|
|
1900
|
my $self = shift; |
3918
|
|
|
|
|
|
|
# delete all DataMember variables (lower-case names) |
3919
|
770
|
|
|
|
|
7468
|
foreach (keys %$self) { |
3920
|
23182
|
100
|
|
|
|
49923
|
/[a-z]/ and delete $$self{$_}; |
3921
|
|
|
|
|
|
|
} |
3922
|
770
|
|
|
|
|
3837
|
undef %static_vars; # clear all static variables |
3923
|
770
|
|
|
|
|
2378
|
delete $$self{FOUND_TAGS}; # list of found tags |
3924
|
770
|
|
|
|
|
1979
|
delete $$self{EXIF_DATA}; # the EXIF data block |
3925
|
770
|
|
|
|
|
1913
|
delete $$self{EXIF_POS}; # EXIF position in file |
3926
|
770
|
|
|
|
|
1784
|
delete $$self{FIRST_EXIF_POS}; # position of first EXIF in file |
3927
|
770
|
|
|
|
|
1636
|
delete $$self{HTML_DUMP}; # html dump information |
3928
|
770
|
|
|
|
|
1589
|
delete $$self{SET_GROUP0}; # group0 name override |
3929
|
770
|
|
|
|
|
1626
|
delete $$self{SET_GROUP1}; # group1 name override |
3930
|
770
|
|
|
|
|
1754
|
delete $$self{DOC_NUM}; # current embedded document number |
3931
|
770
|
|
|
|
|
2047
|
$$self{DOC_COUNT} = 0; # count of embedded documents processed |
3932
|
770
|
|
|
|
|
2531
|
$$self{BASE} = 0; # base for offsets from start of file |
3933
|
770
|
|
|
|
|
4160
|
$$self{FILE_ORDER} = { }; # * hash of tag order in file ('*' = based on tag key) |
3934
|
770
|
|
|
|
|
4916
|
$$self{VALUE} = { }; # * hash of raw tag values |
3935
|
770
|
|
|
|
|
2543
|
$$self{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags |
3936
|
770
|
|
|
|
|
2522
|
$$self{RATIONAL} = { }; # * hash of original rational components |
3937
|
770
|
|
|
|
|
4796
|
$$self{TAG_INFO} = { }; # * hash of tag information |
3938
|
770
|
|
|
|
|
4041
|
$$self{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names) |
3939
|
770
|
|
|
|
|
2648
|
$$self{PRIORITY} = { }; # * priority of current tags |
3940
|
770
|
|
|
|
|
2325
|
$$self{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags |
3941
|
770
|
|
|
|
|
2596
|
$$self{PROCESSED} = { }; # hash of processed directory start positions |
3942
|
770
|
|
|
|
|
2010
|
$$self{DIR_COUNT} = { }; # count various types of directories |
3943
|
770
|
|
|
|
|
2053
|
$$self{DUPL_TAG} = { }; # last-used index for duplicate-tag keys |
3944
|
770
|
|
|
|
|
1950
|
$$self{WARNED_ONCE}= { }; # WarnOnce() warnings already issued |
3945
|
770
|
|
|
|
|
2008
|
$$self{WRITTEN} = { }; # list of tags written (selected tags only) |
3946
|
770
|
|
|
|
|
1918
|
$$self{FORCE_WRITE}= { }; # ForceWrite lookup (set from ForceWrite tag) |
3947
|
770
|
|
|
|
|
2206
|
$$self{FOUND_DIR} = { }; # hash of directory names found in file |
3948
|
770
|
|
|
|
|
5426
|
$$self{COMP_KEYS} = { }; # lookup for tag keys used in Composite tags |
3949
|
770
|
|
|
|
|
2314
|
$$self{PATH} = [ ]; # current subdirectory path in file when reading |
3950
|
770
|
|
|
|
|
2183
|
$$self{NUM_FOUND} = 0; # total number of tags found (incl. duplicates) |
3951
|
770
|
|
|
|
|
1851
|
$$self{CHANGED} = 0; # number of tags changed (writer only) |
3952
|
770
|
|
|
|
|
2082
|
$$self{INDENT} = ' '; # initial indent for verbose messages |
3953
|
770
|
|
|
|
|
1929
|
$$self{PRIORITY_DIR} = ''; # the priority directory name |
3954
|
770
|
|
|
|
|
2875
|
$$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories |
3955
|
770
|
|
|
|
|
2090
|
$$self{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...) |
3956
|
770
|
|
|
|
|
2138
|
$$self{FMT_EXPR} = undef; # current advanced formatting expression |
3957
|
770
|
|
|
|
|
2011
|
$$self{Make} = ''; # camera make |
3958
|
770
|
|
|
|
|
1899
|
$$self{Model} = ''; # camera model |
3959
|
770
|
|
|
|
|
1894
|
$$self{CameraType} = ''; # Olympus camera type |
3960
|
770
|
|
|
|
|
1993
|
$$self{FileType} = ''; # identified file type |
3961
|
770
|
50
|
|
|
|
2862
|
if ($self->Options('HtmlDump')) { |
3962
|
0
|
|
|
|
|
0
|
require Image::ExifTool::HtmlDump; |
3963
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP} = new Image::ExifTool::HtmlDump; |
3964
|
|
|
|
|
|
|
} |
3965
|
|
|
|
|
|
|
# make sure our TextOut is a file reference |
3966
|
770
|
50
|
|
|
|
3892
|
$$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut}; |
3967
|
|
|
|
|
|
|
} |
3968
|
|
|
|
|
|
|
|
3969
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3970
|
|
|
|
|
|
|
# Combine information from a list of info hashes |
3971
|
|
|
|
|
|
|
# Unless Duplicates is enabled, first entry found takes priority |
3972
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1-N) list of info hash references |
3973
|
|
|
|
|
|
|
# Returns: Combined information hash reference |
3974
|
|
|
|
|
|
|
sub CombineInfo($;@) |
3975
|
|
|
|
|
|
|
{ |
3976
|
2
|
|
|
2
|
0
|
1491
|
local $_; |
3977
|
2
|
|
|
|
|
6
|
my $self = shift; |
3978
|
2
|
|
|
|
|
5
|
my (%combinedInfo, $info, $tag, %haveInfo); |
3979
|
|
|
|
|
|
|
|
3980
|
2
|
50
|
|
|
|
8
|
if ($$self{OPTIONS}{Duplicates}) { |
3981
|
0
|
|
|
|
|
0
|
while ($info = shift) { |
3982
|
0
|
|
|
|
|
0
|
foreach $tag (keys %$info) { |
3983
|
0
|
|
|
|
|
0
|
$combinedInfo{$tag} = $$info{$tag}; |
3984
|
|
|
|
|
|
|
} |
3985
|
|
|
|
|
|
|
} |
3986
|
|
|
|
|
|
|
} else { |
3987
|
2
|
|
|
|
|
7
|
while ($info = shift) { |
3988
|
4
|
|
|
|
|
47
|
foreach $tag (keys %$info) { |
3989
|
266
|
|
|
|
|
413
|
my $tagName = GetTagName($tag); |
3990
|
266
|
100
|
|
|
|
500
|
next if $haveInfo{$tagName}; |
3991
|
252
|
|
|
|
|
373
|
$haveInfo{$tagName} = 1; |
3992
|
252
|
|
|
|
|
463
|
$combinedInfo{$tag} = $$info{$tag}; |
3993
|
|
|
|
|
|
|
} |
3994
|
|
|
|
|
|
|
} |
3995
|
|
|
|
|
|
|
} |
3996
|
2
|
|
|
|
|
36
|
return \%combinedInfo; |
3997
|
|
|
|
|
|
|
} |
3998
|
|
|
|
|
|
|
|
3999
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4000
|
|
|
|
|
|
|
# Get tag table name |
4001
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
4002
|
|
|
|
|
|
|
# Returns: Table name if available, otherwise '' |
4003
|
|
|
|
|
|
|
sub GetTableName($$) |
4004
|
|
|
|
|
|
|
{ |
4005
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag) = @_; |
4006
|
0
|
0
|
|
|
|
0
|
my $tagInfo = $$self{TAG_INFO}{$tag} or return ''; |
4007
|
0
|
|
|
|
|
0
|
return $$tagInfo{Table}{SHORT_NAME}; |
4008
|
|
|
|
|
|
|
} |
4009
|
|
|
|
|
|
|
|
4010
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4011
|
|
|
|
|
|
|
# Get tag index number |
4012
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
4013
|
|
|
|
|
|
|
# Returns: Table index number, or undefined if this tag isn't indexed |
4014
|
|
|
|
|
|
|
sub GetTagIndex($$) |
4015
|
|
|
|
|
|
|
{ |
4016
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag) = @_; |
4017
|
0
|
0
|
|
|
|
0
|
my $tagInfo = $$self{TAG_INFO}{$tag} or return undef; |
4018
|
0
|
|
|
|
|
0
|
return $$tagInfo{Index}; |
4019
|
|
|
|
|
|
|
} |
4020
|
|
|
|
|
|
|
|
4021
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4022
|
|
|
|
|
|
|
# Find value for specified tag |
4023
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1) |
4024
|
|
|
|
|
|
|
# Returns: value or undef |
4025
|
|
|
|
|
|
|
sub FindValue($$$) |
4026
|
|
|
|
|
|
|
{ |
4027
|
72
|
|
|
72
|
0
|
178
|
my ($et, $tag, $grp) = @_; |
4028
|
72
|
|
|
|
|
97
|
my ($i, $val); |
4029
|
72
|
|
|
|
|
122
|
my $value = $$et{VALUE}; |
4030
|
72
|
|
|
|
|
111
|
for ($i=0; ; ++$i) { |
4031
|
144
|
100
|
|
|
|
357
|
my $key = $tag . ($i ? " ($i)" : ''); |
4032
|
144
|
100
|
|
|
|
333
|
last unless defined $$value{$key}; |
4033
|
142
|
100
|
|
|
|
264
|
if ($et->GetGroup($key, 1) eq $grp) { |
4034
|
70
|
|
|
|
|
147
|
$val = $$value{$key}; |
4035
|
70
|
|
|
|
|
107
|
last; |
4036
|
|
|
|
|
|
|
} |
4037
|
|
|
|
|
|
|
} |
4038
|
72
|
|
|
|
|
209
|
return $val; |
4039
|
|
|
|
|
|
|
} |
4040
|
|
|
|
|
|
|
|
4041
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4042
|
|
|
|
|
|
|
# Get tag key for next existing tag |
4043
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name |
4044
|
|
|
|
|
|
|
# Returns: Key of next existing tag, or undef if no more |
4045
|
|
|
|
|
|
|
# Notes: This routine is provided for iterating through duplicate tags in the |
4046
|
|
|
|
|
|
|
# ValueConv of Composite tags. |
4047
|
|
|
|
|
|
|
sub NextTagKey($$) |
4048
|
|
|
|
|
|
|
{ |
4049
|
18
|
|
|
18
|
0
|
95
|
my ($self, $tag) = @_; |
4050
|
18
|
50
|
|
|
|
87
|
my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1; |
4051
|
18
|
|
|
|
|
94
|
$tag = "$tag ($i)"; |
4052
|
18
|
50
|
|
|
|
74
|
return $tag if defined $$self{VALUE}{$tag}; |
4053
|
18
|
|
|
|
|
458
|
return undef; |
4054
|
|
|
|
|
|
|
} |
4055
|
|
|
|
|
|
|
|
4056
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4057
|
|
|
|
|
|
|
# Does a string contain valid UTF-8 characters? |
4058
|
|
|
|
|
|
|
# Inputs: 0) string reference, 1) true to allow last character to be truncated |
4059
|
|
|
|
|
|
|
# Returns: 0=regular ASCII, -1=invalid UTF-8, 1=valid UTF-8 with maximum 16-bit |
4060
|
|
|
|
|
|
|
# wide characters, 2=valid UTF-8 requiring 32-bit wide characters |
4061
|
|
|
|
|
|
|
# Notes: Changes current string position |
4062
|
|
|
|
|
|
|
# (see http://www.fileformat.info/info/unicode/utf8.htm for help understanding this) |
4063
|
|
|
|
|
|
|
sub IsUTF8($;$) |
4064
|
|
|
|
|
|
|
{ |
4065
|
103
|
|
|
103
|
0
|
218
|
my ($strPt, $trunc) = @_; |
4066
|
103
|
|
|
|
|
351
|
pos($$strPt) = 0; # start at beginning of string |
4067
|
103
|
100
|
|
|
|
557
|
return 0 unless $$strPt =~ /([\x80-\xff])/g; |
4068
|
41
|
|
|
|
|
88
|
my $rtnVal = 1; |
4069
|
41
|
|
|
|
|
72
|
for (;;) { |
4070
|
183
|
|
|
|
|
334
|
my $ch = ord($1); |
4071
|
|
|
|
|
|
|
# minimum lead byte for 2-byte sequence is 0xc2 (overlong sequences |
4072
|
|
|
|
|
|
|
# not allowed), 0xf8-0xfd are restricted by RFC 3629 (no 5 or 6 byte |
4073
|
|
|
|
|
|
|
# sequences), and 0xfe and 0xff are not valid in UTF-8 strings |
4074
|
183
|
100
|
100
|
|
|
610
|
return -1 if $ch < 0xc2 or $ch >= 0xf8; |
4075
|
|
|
|
|
|
|
# determine number of bytes remaining in sequence |
4076
|
153
|
|
|
|
|
175
|
my $n; |
4077
|
153
|
100
|
|
|
|
264
|
if ($ch < 0xe0) { |
|
|
50
|
|
|
|
|
|
4078
|
75
|
|
|
|
|
95
|
$n = 1; |
4079
|
|
|
|
|
|
|
} elsif ($ch < 0xf0) { |
4080
|
78
|
|
|
|
|
104
|
$n = 2; |
4081
|
|
|
|
|
|
|
} else { |
4082
|
0
|
|
|
|
|
0
|
$n = 3; |
4083
|
|
|
|
|
|
|
# character code is greater than 0xffff if more than 2 extra bytes |
4084
|
|
|
|
|
|
|
# were required in the UTF-8 character |
4085
|
0
|
|
|
|
|
0
|
$rtnVal = 2; |
4086
|
|
|
|
|
|
|
} |
4087
|
153
|
|
|
|
|
198
|
my $pos = pos $$strPt; |
4088
|
153
|
100
|
|
|
|
688
|
unless ($$strPt =~ /\G([\x80-\xbf]{$n})/g) { |
4089
|
1
|
50
|
33
|
|
|
8
|
return $rtnVal if $trunc and $pos + $n > length $$strPt; |
4090
|
1
|
|
|
|
|
5
|
return -1; |
4091
|
|
|
|
|
|
|
} |
4092
|
|
|
|
|
|
|
# the following is ref https://www.cl.cam.ac.uk/%7Emgk25/ucs/utf8_check.c |
4093
|
152
|
100
|
|
|
|
291
|
if ($n == 2) { |
4094
|
77
|
50
|
66
|
|
|
381
|
return -1 if ($ch == 0xe0 and (ord($1) & 0xe0) == 0x80) or |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4095
|
|
|
|
|
|
|
($ch == 0xed and (ord($1) & 0xe0) == 0xa0) or |
4096
|
|
|
|
|
|
|
($ch == 0xef and ord($1) == 0xbf and |
4097
|
|
|
|
|
|
|
(ord(substr $1, 1) & 0xfe) == 0xbe); |
4098
|
|
|
|
|
|
|
} else { |
4099
|
75
|
50
|
33
|
|
|
358
|
return -1 if ($ch == 0xf0 and (ord($1) & 0xf0) == 0x80) or |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4100
|
|
|
|
|
|
|
($ch == 0xf4 and ord($1) > 0x8f) or $ch > 0xf4; |
4101
|
|
|
|
|
|
|
} |
4102
|
152
|
100
|
|
|
|
392
|
last unless $$strPt =~ /([\x80-\xff])/g; |
4103
|
|
|
|
|
|
|
} |
4104
|
10
|
|
|
|
|
34
|
return $rtnVal; |
4105
|
|
|
|
|
|
|
} |
4106
|
|
|
|
|
|
|
|
4107
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4108
|
|
|
|
|
|
|
# Split file name into directory and name parts |
4109
|
|
|
|
|
|
|
# Inptus: 0) file name |
4110
|
|
|
|
|
|
|
# Returns: 0) directory, 1) filename |
4111
|
|
|
|
|
|
|
sub SplitFileName($) |
4112
|
|
|
|
|
|
|
{ |
4113
|
473
|
|
|
473
|
0
|
1187
|
my $file = shift; |
4114
|
473
|
|
|
|
|
1186
|
my ($dir, $name); |
4115
|
473
|
50
|
|
|
|
1128
|
if (eval { require File::Basename }) { |
|
473
|
|
|
|
|
4818
|
|
4116
|
473
|
|
|
|
|
27394
|
$dir = File::Basename::dirname($file); |
4117
|
473
|
|
|
|
|
12414
|
$name = File::Basename::basename($file); |
4118
|
|
|
|
|
|
|
} else { |
4119
|
0
|
|
|
|
|
0
|
($name = $file) =~ tr/\\/\//; |
4120
|
|
|
|
|
|
|
# remove path |
4121
|
0
|
0
|
|
|
|
0
|
$dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///; |
|
|
0
|
|
|
|
|
|
4122
|
|
|
|
|
|
|
} |
4123
|
473
|
|
|
|
|
2107
|
return ($dir, $name); |
4124
|
|
|
|
|
|
|
} |
4125
|
|
|
|
|
|
|
|
4126
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4127
|
|
|
|
|
|
|
# Encode file name for calls to system i/o routines |
4128
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion |
4129
|
|
|
|
|
|
|
# Returns: true if Windows Unicode routines should be used (in which case |
4130
|
|
|
|
|
|
|
# the file name will be encoded as a null-terminated UTF-16LE string) |
4131
|
|
|
|
|
|
|
sub EncodeFileName($$;$) |
4132
|
|
|
|
|
|
|
{ |
4133
|
1136
|
|
|
1136
|
0
|
2891
|
my ($self, $file, $force) = @_; |
4134
|
1136
|
|
|
|
|
2715
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
4135
|
1136
|
50
|
33
|
|
|
6571
|
if ($enc) { |
|
|
50
|
33
|
|
|
|
|
4136
|
0
|
0
|
0
|
|
|
0
|
if ($file =~ /[\x80-\xff]/ or $force) { |
4137
|
|
|
|
|
|
|
# encode for use in Windows Unicode functions if necessary |
4138
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MSWin32') { |
4139
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4140
|
0
|
0
|
|
|
|
0
|
if (eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
4141
|
|
|
|
|
|
|
# recode as UTF-16LE and add null terminator |
4142
|
0
|
|
|
|
|
0
|
$_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0"; |
4143
|
0
|
|
|
|
|
0
|
return 1; |
4144
|
|
|
|
|
|
|
} |
4145
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32API::File for Windows Unicode file support'); |
4146
|
|
|
|
|
|
|
} else { |
4147
|
|
|
|
|
|
|
# recode as UTF-8 for other platforms if necessary |
4148
|
0
|
0
|
|
|
|
0
|
$_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8'; |
4149
|
|
|
|
|
|
|
} |
4150
|
|
|
|
|
|
|
} |
4151
|
|
|
|
|
|
|
} elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) { |
4152
|
0
|
0
|
|
|
|
0
|
$self->WarnOnce('FileName encoding not specified') if IsUTF8(\$file) < 0; |
4153
|
|
|
|
|
|
|
} |
4154
|
1136
|
|
|
|
|
3532
|
return 0; |
4155
|
|
|
|
|
|
|
} |
4156
|
|
|
|
|
|
|
|
4157
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4158
|
|
|
|
|
|
|
# Modified perl open() routine to properly handle special characters in file names |
4159
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) filehandle, 2) filename, |
4160
|
|
|
|
|
|
|
# 3) mode: '<' or undef = read, '>' = write, '+<' = update |
4161
|
|
|
|
|
|
|
# Returns: true on success |
4162
|
|
|
|
|
|
|
# Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid |
4163
|
|
|
|
|
|
|
# "unopened filehandle" errors due to a change in scope of the filehandle |
4164
|
|
|
|
|
|
|
sub Open($*$;$) |
4165
|
|
|
|
|
|
|
{ |
4166
|
908
|
|
|
908
|
0
|
3654
|
my ($self, $fh, $file, $mode) = @_; |
4167
|
|
|
|
|
|
|
|
4168
|
908
|
|
|
|
|
3446
|
$file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand |
4169
|
|
|
|
|
|
|
# default to read mode ('<') unless input is a trusted pipe |
4170
|
908
|
50
|
33
|
|
|
4971
|
$mode = (($file =~ /\|$/ and $$self{TRUST_PIPE}) ? '' : '<') unless $mode; |
|
|
100
|
|
|
|
|
|
4171
|
908
|
|
|
|
|
2103
|
delete $$self{TRUST_PIPE}; |
4172
|
908
|
50
|
|
|
|
2690
|
if ($mode) { |
4173
|
908
|
50
|
|
|
|
3569
|
if ($self->EncodeFileName($file)) { |
4174
|
|
|
|
|
|
|
# handle Windows Unicode file name |
4175
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4176
|
0
|
|
|
|
|
0
|
my ($access, $create); |
4177
|
0
|
0
|
|
|
|
0
|
if ($mode eq '>') { |
4178
|
0
|
|
|
|
|
0
|
eval { |
4179
|
0
|
|
|
|
|
0
|
$access = Win32API::File::GENERIC_WRITE(); |
4180
|
0
|
|
|
|
|
0
|
$create = Win32API::File::CREATE_ALWAYS(); |
4181
|
|
|
|
|
|
|
} |
4182
|
|
|
|
|
|
|
} else { |
4183
|
0
|
|
|
|
|
0
|
eval { |
4184
|
0
|
|
|
|
|
0
|
$access = Win32API::File::GENERIC_READ(); |
4185
|
0
|
0
|
|
|
|
0
|
$access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update |
4186
|
0
|
|
|
|
|
0
|
$create = Win32API::File::OPEN_EXISTING(); |
4187
|
|
|
|
|
|
|
} |
4188
|
|
|
|
|
|
|
} |
4189
|
0
|
|
|
|
|
0
|
my $share = 0; |
4190
|
0
|
|
|
|
|
0
|
eval { |
4191
|
0
|
0
|
|
|
|
0
|
unless ($access & Win32API::File::GENERIC_WRITE()) { |
4192
|
0
|
|
|
|
|
0
|
$share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE(); |
4193
|
|
|
|
|
|
|
} |
4194
|
|
|
|
|
|
|
}; |
4195
|
0
|
|
|
|
|
0
|
my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) }; |
|
0
|
|
|
|
|
0
|
|
4196
|
0
|
0
|
|
|
|
0
|
return undef unless $wh; |
4197
|
0
|
|
|
|
|
0
|
my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) }; |
|
0
|
|
|
|
|
0
|
|
4198
|
0
|
0
|
0
|
|
|
0
|
if (not defined $fd or $fd < 0) { |
4199
|
0
|
|
|
|
|
0
|
eval { Win32API::File::CloseHandle($wh) }; |
|
0
|
|
|
|
|
0
|
|
4200
|
0
|
|
|
|
|
0
|
return undef; |
4201
|
|
|
|
|
|
|
} |
4202
|
0
|
|
|
|
|
0
|
$file = "&=$fd"; # specify file by descriptor |
4203
|
|
|
|
|
|
|
} else { |
4204
|
|
|
|
|
|
|
# add leading space to protect against leading characters like '>' |
4205
|
|
|
|
|
|
|
# in file name, and trailing "\0" to protect trailing spaces |
4206
|
908
|
|
|
|
|
3071
|
$file = " $file\0"; |
4207
|
|
|
|
|
|
|
} |
4208
|
|
|
|
|
|
|
} |
4209
|
908
|
|
|
|
|
62960
|
return open $fh, "$mode$file"; |
4210
|
|
|
|
|
|
|
} |
4211
|
|
|
|
|
|
|
|
4212
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4213
|
|
|
|
|
|
|
# Check to see if a file exists (with Windows Unicode support) |
4214
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name |
4215
|
|
|
|
|
|
|
# Returns: true if file exists |
4216
|
|
|
|
|
|
|
sub Exists($$) |
4217
|
|
|
|
|
|
|
{ |
4218
|
221
|
|
|
221
|
0
|
868
|
my ($self, $file) = @_; |
4219
|
|
|
|
|
|
|
|
4220
|
221
|
50
|
|
|
|
934
|
if ($self->EncodeFileName($file)) { |
4221
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4222
|
0
|
|
|
|
|
0
|
my $wh = eval { Win32API::File::CreateFileW($file, |
|
0
|
|
|
|
|
0
|
|
4223
|
|
|
|
|
|
|
Win32API::File::GENERIC_READ(), |
4224
|
|
|
|
|
|
|
Win32API::File::FILE_SHARE_READ(), [], |
4225
|
|
|
|
|
|
|
Win32API::File::OPEN_EXISTING(), 0, []) }; |
4226
|
0
|
0
|
|
|
|
0
|
return 0 unless $wh; |
4227
|
0
|
|
|
|
|
0
|
eval { Win32API::File::CloseHandle($wh) }; |
|
0
|
|
|
|
|
0
|
|
4228
|
|
|
|
|
|
|
} else { |
4229
|
|
|
|
|
|
|
# (named pipes already exist, but we pretend that they don't |
4230
|
|
|
|
|
|
|
# so we will be able to write them, so test with for pipe -p) |
4231
|
221
|
|
33
|
|
|
5463
|
return(-e $file and not -p $file); |
4232
|
|
|
|
|
|
|
} |
4233
|
0
|
|
|
|
|
0
|
return 1; |
4234
|
|
|
|
|
|
|
} |
4235
|
|
|
|
|
|
|
|
4236
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4237
|
|
|
|
|
|
|
# Return true if file is a directory (with Windows Unicode support) |
4238
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name |
4239
|
|
|
|
|
|
|
# Returns: true if file is a directory (false if file isn't, or doesn't exist) |
4240
|
|
|
|
|
|
|
sub IsDirectory($$) |
4241
|
|
|
|
|
|
|
{ |
4242
|
1
|
|
|
1
|
0
|
5
|
my ($et, $file) = @_; |
4243
|
1
|
50
|
|
|
|
4
|
if ($et->EncodeFileName($file)) { |
4244
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4245
|
0
|
|
|
|
|
0
|
my $attrs = eval { Win32API::File::GetFileAttributesW($file) }; |
|
0
|
|
|
|
|
0
|
|
4246
|
0
|
|
0
|
|
|
0
|
my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0; |
4247
|
0
|
0
|
0
|
|
|
0
|
return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit; |
|
|
|
0
|
|
|
|
|
4248
|
|
|
|
|
|
|
} else { |
4249
|
1
|
|
|
|
|
31
|
return -d $file; |
4250
|
|
|
|
|
|
|
} |
4251
|
0
|
|
|
|
|
0
|
return 0; |
4252
|
|
|
|
|
|
|
} |
4253
|
|
|
|
|
|
|
|
4254
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4255
|
|
|
|
|
|
|
# Get file times (Unix seconds since the epoch) |
4256
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name or ref |
4257
|
|
|
|
|
|
|
# Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error) |
4258
|
|
|
|
|
|
|
my $k32GetFileTime; |
4259
|
|
|
|
|
|
|
sub GetFileTime($$) |
4260
|
|
|
|
|
|
|
{ |
4261
|
0
|
|
|
0
|
0
|
0
|
my ($self, $file) = @_; |
4262
|
|
|
|
|
|
|
|
4263
|
|
|
|
|
|
|
# open file by name if necessary |
4264
|
0
|
0
|
|
|
|
0
|
unless (ref $file) { |
4265
|
0
|
|
|
|
|
0
|
local *FH; |
4266
|
0
|
0
|
|
|
|
0
|
unless ($self->Open(\*FH, $file)) { |
4267
|
0
|
0
|
|
|
|
0
|
if ($self->IsDirectory($file)) { |
4268
|
0
|
|
|
|
|
0
|
my @rtn = (stat $file)[8, 9, 10]; |
4269
|
0
|
0
|
|
|
|
0
|
return @rtn if defined $rtn[0]; |
4270
|
|
|
|
|
|
|
} |
4271
|
0
|
|
|
|
|
0
|
$self->Warn("GetFileTime error for '${file}'"); |
4272
|
0
|
|
|
|
|
0
|
return (); |
4273
|
|
|
|
|
|
|
} |
4274
|
0
|
|
|
|
|
0
|
$file = *FH; # (not \*FH, so *FH will be kept open until $file goes out of scope) |
4275
|
|
|
|
|
|
|
} |
4276
|
|
|
|
|
|
|
# on Windows, try to work around incorrect file times when daylight saving time is in effect |
4277
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MSWin32') { |
4278
|
0
|
0
|
|
|
|
0
|
if (not eval { require Win32::API }) { |
|
0
|
0
|
|
|
|
0
|
|
4279
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32::API for proper handling of Windows file times'); |
4280
|
0
|
|
|
|
|
0
|
} elsif (not eval { require Win32API::File }) { |
4281
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32API::File for proper handling of Windows file times'); |
4282
|
|
|
|
|
|
|
} else { |
4283
|
|
|
|
|
|
|
# get Win32 handle, needed for GetFileTime |
4284
|
0
|
|
|
|
|
0
|
my $win32Handle = eval { Win32API::File::GetOsFHandle($file) }; |
|
0
|
|
|
|
|
0
|
|
4285
|
0
|
0
|
|
|
|
0
|
unless ($win32Handle) { |
4286
|
0
|
|
|
|
|
0
|
$self->Warn("Win32API::File::GetOsFHandle returned invalid handle"); |
4287
|
0
|
|
|
|
|
0
|
return (); |
4288
|
|
|
|
|
|
|
} |
4289
|
|
|
|
|
|
|
# get FILETIME structs |
4290
|
0
|
|
|
|
|
0
|
my ($atime, $mtime, $ctime, $time); |
4291
|
0
|
|
|
|
|
0
|
$atime = $mtime = $ctime = pack 'LL', 0, 0; |
4292
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime) { |
4293
|
0
|
0
|
|
|
|
0
|
return () if defined $k32GetFileTime; |
4294
|
0
|
|
|
|
|
0
|
$k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I'); |
4295
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime) { |
4296
|
0
|
|
|
|
|
0
|
$self->Warn('Error calling Win32::API::GetFileTime'); |
4297
|
0
|
|
|
|
|
0
|
$k32GetFileTime = 0; |
4298
|
0
|
|
|
|
|
0
|
return (); |
4299
|
|
|
|
|
|
|
} |
4300
|
|
|
|
|
|
|
} |
4301
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) { |
4302
|
0
|
|
|
|
|
0
|
$self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError()); |
4303
|
0
|
|
|
|
|
0
|
return (); |
4304
|
|
|
|
|
|
|
} |
4305
|
|
|
|
|
|
|
# convert FILETIME structs to Unix seconds |
4306
|
0
|
|
|
|
|
0
|
foreach $time ($atime, $mtime, $ctime) { |
4307
|
0
|
|
|
|
|
0
|
my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct |
4308
|
|
|
|
|
|
|
# FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601 |
4309
|
|
|
|
|
|
|
# (89 leap years between 1601 and 1970) |
4310
|
0
|
|
|
|
|
0
|
$time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600); |
4311
|
|
|
|
|
|
|
} |
4312
|
0
|
|
|
|
|
0
|
return ($atime, $mtime, $ctime); |
4313
|
|
|
|
|
|
|
} |
4314
|
|
|
|
|
|
|
} |
4315
|
|
|
|
|
|
|
# other os (or Windows fallback) |
4316
|
0
|
|
|
|
|
0
|
return (stat $file)[8, 9, 10]; |
4317
|
|
|
|
|
|
|
} |
4318
|
|
|
|
|
|
|
|
4319
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4320
|
|
|
|
|
|
|
# Parse function arguments and set member variables accordingly |
4321
|
|
|
|
|
|
|
# Inputs: Same as ImageInfo() |
4322
|
|
|
|
|
|
|
# - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS |
4323
|
|
|
|
|
|
|
sub ParseArguments($;@) |
4324
|
|
|
|
|
|
|
{ |
4325
|
695
|
|
|
695
|
0
|
1758
|
my $self = shift; |
4326
|
695
|
|
|
|
|
1789
|
my $options = $$self{OPTIONS}; |
4327
|
695
|
|
|
|
|
1466
|
my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}}; |
|
695
|
|
|
|
|
13959
|
|
4328
|
695
|
|
|
|
|
3506
|
my (@exclude, $wasExcludeOpt); |
4329
|
|
|
|
|
|
|
|
4330
|
695
|
|
|
|
|
2543
|
$$self{REQUESTED_TAGS} = [ ]; |
4331
|
695
|
|
|
|
|
2398
|
$$self{REQ_TAG_LOOKUP} = { }; |
4332
|
695
|
|
|
|
|
2221
|
$$self{EXCL_TAG_LOOKUP} = { }; |
4333
|
695
|
|
|
|
|
1869
|
$$self{IO_TAG_LIST} = undef; |
4334
|
695
|
|
|
|
|
1663
|
delete $$self{EXCL_XMP_LOOKUP}; |
4335
|
|
|
|
|
|
|
|
4336
|
|
|
|
|
|
|
# handle our input arguments |
4337
|
695
|
|
|
|
|
3072
|
while (@_) { |
4338
|
1496
|
|
|
|
|
2987
|
my $arg = shift; |
4339
|
1496
|
100
|
66
|
|
|
6647
|
if (ref $arg and not overload::Method($arg, q[""])) { |
|
|
100
|
|
|
|
|
|
4340
|
153
|
100
|
100
|
|
|
7451
|
if (ref $arg eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4341
|
4
|
|
|
|
|
20
|
$$self{IO_TAG_LIST} = $arg; |
4342
|
4
|
|
|
|
|
34
|
foreach (@$arg) { |
4343
|
12
|
100
|
|
|
|
66
|
if (/^-(.*)/) { |
4344
|
2
|
|
|
|
|
10
|
push @exclude, $1; |
4345
|
|
|
|
|
|
|
} else { |
4346
|
10
|
|
|
|
|
14
|
push @{$$self{REQUESTED_TAGS}}, $_; |
|
10
|
|
|
|
|
24
|
|
4347
|
|
|
|
|
|
|
} |
4348
|
|
|
|
|
|
|
} |
4349
|
|
|
|
|
|
|
} elsif (ref $arg eq 'HASH') { |
4350
|
107
|
|
|
|
|
259
|
my $opt; |
4351
|
107
|
|
|
|
|
492
|
foreach $opt (keys %$arg) { |
4352
|
|
|
|
|
|
|
# a single new group option overrides all old group options |
4353
|
171
|
50
|
33
|
|
|
669
|
if (@oldGroupOpts and $opt =~ /^Group/) { |
4354
|
0
|
|
|
|
|
0
|
foreach (@oldGroupOpts) { |
4355
|
0
|
|
|
|
|
0
|
delete $$options{$_}; |
4356
|
|
|
|
|
|
|
} |
4357
|
0
|
|
|
|
|
0
|
undef @oldGroupOpts; |
4358
|
|
|
|
|
|
|
} |
4359
|
171
|
|
|
|
|
730
|
$self->Options($opt, $$arg{$opt}); |
4360
|
171
|
50
|
|
|
|
728
|
$opt eq 'Exclude' and $wasExcludeOpt = 1; |
4361
|
|
|
|
|
|
|
} |
4362
|
|
|
|
|
|
|
} elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) { |
4363
|
23
|
50
|
|
|
|
119
|
next if defined $$self{RAF}; |
4364
|
|
|
|
|
|
|
# convert image data from UTF-8 to character stream if necessary |
4365
|
|
|
|
|
|
|
# (patches RHEL 3 UTF8 LANG problem) |
4366
|
23
|
50
|
66
|
|
|
227
|
if (ref $arg eq 'SCALAR' and $] >= 5.006 and |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
4367
|
|
|
|
|
|
|
(eval { require Encode; Encode::is_utf8($$arg) } or $@)) |
4368
|
|
|
|
|
|
|
{ |
4369
|
|
|
|
|
|
|
# repack by hand if Encode isn't available |
4370
|
0
|
0
|
|
|
|
0
|
my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg); |
|
|
0
|
|
|
|
|
|
4371
|
0
|
|
|
|
|
0
|
$arg = \$buff; |
4372
|
|
|
|
|
|
|
} |
4373
|
23
|
|
|
|
|
193
|
$$self{RAF} = new File::RandomAccess($arg); |
4374
|
|
|
|
|
|
|
# set filename to empty string to indicate that |
4375
|
|
|
|
|
|
|
# we have a file but we didn't open it |
4376
|
23
|
|
|
|
|
122
|
$$self{FILENAME} = ''; |
4377
|
|
|
|
|
|
|
} elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) { |
4378
|
19
|
|
|
|
|
50
|
$$self{RAF} = $arg; |
4379
|
19
|
|
|
|
|
66
|
$$self{FILENAME} = ''; |
4380
|
|
|
|
|
|
|
} else { |
4381
|
0
|
|
|
|
|
0
|
warn "Don't understand ImageInfo argument $arg\n"; |
4382
|
|
|
|
|
|
|
} |
4383
|
|
|
|
|
|
|
} elsif (defined $$self{FILENAME}) { |
4384
|
870
|
100
|
|
|
|
2334
|
if ($arg =~ /^-(.*)/) { |
4385
|
54
|
|
|
|
|
270
|
push @exclude, $1; |
4386
|
|
|
|
|
|
|
} else { |
4387
|
816
|
|
|
|
|
1313
|
push @{$$self{REQUESTED_TAGS}}, $arg; |
|
816
|
|
|
|
|
2738
|
|
4388
|
|
|
|
|
|
|
} |
4389
|
|
|
|
|
|
|
} else { |
4390
|
473
|
|
|
|
|
1827
|
$$self{FILENAME} = $arg; |
4391
|
|
|
|
|
|
|
} |
4392
|
|
|
|
|
|
|
} |
4393
|
|
|
|
|
|
|
# add additional requested tags to lookup |
4394
|
695
|
100
|
|
|
|
2732
|
if ($$options{RequestTags}) { |
4395
|
42
|
|
|
|
|
147
|
$$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}}; |
|
42
|
|
|
|
|
303
|
|
4396
|
|
|
|
|
|
|
} |
4397
|
|
|
|
|
|
|
# expand shortcuts in tag arguments if provided |
4398
|
695
|
100
|
|
|
|
1492
|
if (@{$$self{REQUESTED_TAGS}}) { |
|
695
|
|
|
|
|
2763
|
|
4399
|
356
|
|
|
|
|
1805
|
ExpandShortcuts($$self{REQUESTED_TAGS}); |
4400
|
|
|
|
|
|
|
# initialize lookup for requested tags |
4401
|
356
|
|
|
|
|
836
|
foreach (@{$$self{REQUESTED_TAGS}}) { |
|
356
|
|
|
|
|
1318
|
|
4402
|
869
|
50
|
|
|
|
4695
|
/^(.*:)?([-\w?*]*)#?$/ or next; |
4403
|
869
|
50
|
|
|
|
4529
|
$$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2; |
4404
|
869
|
100
|
|
|
|
2596
|
next unless $1; |
4405
|
234
|
|
|
|
|
1480
|
$$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1; |
4406
|
|
|
|
|
|
|
} |
4407
|
|
|
|
|
|
|
} |
4408
|
695
|
100
|
66
|
|
|
4304
|
if (@exclude or $wasExcludeOpt) { |
4409
|
|
|
|
|
|
|
# must add existing excluded tags |
4410
|
41
|
100
|
|
|
|
189
|
push @exclude, @{$$options{Exclude}} if $$options{Exclude}; |
|
1
|
|
|
|
|
4
|
|
4411
|
41
|
|
|
|
|
138
|
$$options{Exclude} = \@exclude; |
4412
|
|
|
|
|
|
|
# expand shortcuts in new exclude list |
4413
|
41
|
|
|
|
|
181
|
ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix) |
4414
|
|
|
|
|
|
|
} |
4415
|
|
|
|
|
|
|
# generate lookup for excluded tags |
4416
|
695
|
100
|
|
|
|
2886
|
if ($$options{Exclude}) { |
4417
|
47
|
|
|
|
|
149
|
foreach (@{$$options{Exclude}}) { |
|
47
|
|
|
|
|
208
|
|
4418
|
64
|
100
|
|
|
|
649
|
/([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc $1} = 1; |
4419
|
64
|
50
|
|
|
|
286
|
if (/(xmp-.*:[-\w]+)#?/i) { |
4420
|
0
|
0
|
|
|
|
0
|
$$self{EXCL_XMP_LOOKUP} or $$self{EXCL_XMP_LOOKUP} = { }; |
4421
|
0
|
|
|
|
|
0
|
$$self{EXCL_XMP_LOOKUP}{lc $1} = 1; |
4422
|
|
|
|
|
|
|
} |
4423
|
|
|
|
|
|
|
} |
4424
|
|
|
|
|
|
|
# exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set |
4425
|
47
|
100
|
|
|
|
233
|
undef $$options{Exclude} if $$self{TAGS_FROM_FILE}; |
4426
|
|
|
|
|
|
|
} |
4427
|
|
|
|
|
|
|
} |
4428
|
|
|
|
|
|
|
|
4429
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4430
|
|
|
|
|
|
|
# Does group name match the tag ID? |
4431
|
|
|
|
|
|
|
# Inputs: 0) tag ID, 1) group name (with "ID-" removed) |
4432
|
|
|
|
|
|
|
# Returns: true on success |
4433
|
|
|
|
|
|
|
sub IsSameID($$) |
4434
|
|
|
|
|
|
|
{ |
4435
|
2
|
|
|
2
|
0
|
16
|
my ($id, $grp) = @_; |
4436
|
2
|
100
|
|
|
|
15
|
return 1 if $grp eq $id; # decimal ID's or raw ID's |
4437
|
1
|
50
|
|
|
|
5
|
if ($id =~ /^\d+$/) { # numerical numerical ID's may be in hex |
4438
|
0
|
0
|
0
|
|
|
0
|
return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id); |
4439
|
|
|
|
|
|
|
} else { # other ID's may conform to ExifTool group name conventions |
4440
|
1
|
50
|
33
|
|
|
8
|
return 1 if $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $id; |
|
1
|
|
|
|
|
17
|
|
4441
|
|
|
|
|
|
|
} |
4442
|
1
|
|
|
|
|
4
|
return 0; |
4443
|
|
|
|
|
|
|
} |
4444
|
|
|
|
|
|
|
|
4445
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4446
|
|
|
|
|
|
|
# Get list of tags in specified group |
4447
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys |
4448
|
|
|
|
|
|
|
# Returns: list of matching tags in list context, or first match in scalar context |
4449
|
|
|
|
|
|
|
# Notes: Group spec may contain multiple groups separated by colons, each |
4450
|
|
|
|
|
|
|
# possibly with a leading family number |
4451
|
|
|
|
|
|
|
sub GroupMatches($$$) |
4452
|
|
|
|
|
|
|
{ |
4453
|
25450
|
|
|
25450
|
0
|
45965
|
my ($self, $group, $tagList) = @_; |
4454
|
25450
|
50
|
|
|
|
50029
|
$tagList = [ $tagList ] unless ref $tagList; |
4455
|
25450
|
|
|
|
|
35966
|
my ($tag, @matches); |
4456
|
|
|
|
|
|
|
# check each group name individually (eg. "Author:1IPTC") |
4457
|
25450
|
|
|
|
|
60483
|
my @grps = split ':', $group; |
4458
|
25450
|
|
|
|
|
37905
|
my (@fmys, $g); |
4459
|
25450
|
|
|
|
|
56613
|
for ($g=0; $g<@grps; ++$g) { |
4460
|
26019
|
50
|
|
|
|
112695
|
if ($grps[$g] =~ s/^(\d*)(id-)?//i) { |
4461
|
26019
|
100
|
|
|
|
61909
|
$fmys[$g] = $1 if length $1; |
4462
|
26019
|
50
|
|
|
|
52502
|
if ($2) { |
4463
|
0
|
|
|
|
|
0
|
$fmys[$g] = 7; |
4464
|
0
|
|
|
|
|
0
|
next; # (don't convert tag ID's to lower case) |
4465
|
|
|
|
|
|
|
} |
4466
|
|
|
|
|
|
|
} |
4467
|
26019
|
|
|
|
|
51242
|
$grps[$g] = lc $grps[$g]; |
4468
|
26019
|
50
|
|
|
|
70870
|
$grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag |
4469
|
|
|
|
|
|
|
} |
4470
|
25450
|
|
|
|
|
47358
|
foreach $tag (@$tagList) { |
4471
|
15141
|
|
|
|
|
33814
|
my @groups = $self->GetGroup($tag, -1); |
4472
|
15141
|
|
|
|
|
35219
|
for ($g=0; $g<@grps; ++$g) { |
4473
|
15605
|
|
|
|
|
24675
|
my $grp = $grps[$g]; |
4474
|
15605
|
50
|
33
|
|
|
46708
|
next if $grp eq '*' or $grp eq 'all'; |
4475
|
15605
|
|
|
|
|
20355
|
my $f; |
4476
|
15605
|
100
|
|
|
|
27950
|
if (defined($f = $fmys[$g])) { |
4477
|
3
|
50
|
|
|
|
9
|
last unless defined $groups[$f]; |
4478
|
3
|
50
|
|
|
|
8
|
if ($f == 7) { |
4479
|
0
|
0
|
|
|
|
0
|
next if IsSameID($self->GetTagID($tag), $grp); |
4480
|
|
|
|
|
|
|
} else { |
4481
|
3
|
100
|
|
|
|
10
|
next if $grp eq lc $groups[$f]; |
4482
|
|
|
|
|
|
|
} |
4483
|
1
|
|
|
|
|
3
|
last; |
4484
|
|
|
|
|
|
|
} else { |
4485
|
15602
|
100
|
|
|
|
151263
|
last unless grep /^$grp$/i, @groups; |
4486
|
|
|
|
|
|
|
} |
4487
|
|
|
|
|
|
|
} |
4488
|
15141
|
100
|
|
|
|
41224
|
if ($g == @grps) { |
4489
|
4368
|
100
|
|
|
|
12419
|
return $tag unless wantarray; |
4490
|
2407
|
|
|
|
|
5843
|
push @matches, $tag; |
4491
|
|
|
|
|
|
|
} |
4492
|
|
|
|
|
|
|
} |
4493
|
23489
|
100
|
|
|
|
61763
|
return wantarray ? @matches : $matches[0]; |
4494
|
|
|
|
|
|
|
} |
4495
|
|
|
|
|
|
|
|
4496
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4497
|
|
|
|
|
|
|
# Remove specified tags from returned tag list, updating indices in other lists |
4498
|
|
|
|
|
|
|
# Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref, |
4499
|
|
|
|
|
|
|
# 4) true to include tags from hash instead of excluding |
4500
|
|
|
|
|
|
|
# Returns: nothing, but updates input lists |
4501
|
|
|
|
|
|
|
sub RemoveTagsFromList($$$$;$) |
4502
|
|
|
|
|
|
|
{ |
4503
|
69
|
|
|
69
|
0
|
140
|
local $_; |
4504
|
69
|
|
|
|
|
211
|
my ($tags, $list1, $list2, $exclude, $inv) = @_; |
4505
|
69
|
|
|
|
|
135
|
my @filteredTags; |
4506
|
|
|
|
|
|
|
|
4507
|
69
|
100
|
100
|
|
|
410
|
if (@$list1 or @$list2) { |
4508
|
6
|
|
|
|
|
34
|
while (@$tags) { |
4509
|
233
|
|
|
|
|
340
|
my $tag = pop @$tags; |
4510
|
233
|
|
|
|
|
314
|
my $i = @$tags; |
4511
|
233
|
100
|
50
|
|
|
617
|
if ($$exclude{$tag} xor $inv) { |
4512
|
|
|
|
|
|
|
# remove index of excluded tag from each list |
4513
|
154
|
100
|
|
|
|
236
|
@$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1; |
|
12
|
100
|
|
|
|
29
|
|
4514
|
154
|
100
|
|
|
|
239
|
@$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2; |
|
8245
|
100
|
|
|
|
12868
|
|
4515
|
|
|
|
|
|
|
} else { |
4516
|
79
|
|
|
|
|
223
|
unshift @filteredTags, $tag; |
4517
|
|
|
|
|
|
|
} |
4518
|
|
|
|
|
|
|
} |
4519
|
|
|
|
|
|
|
} else { |
4520
|
63
|
|
|
|
|
195
|
foreach (@$tags) { |
4521
|
6864
|
100
|
100
|
|
|
19534
|
push @filteredTags, $_ unless $$exclude{$_} xor $inv; |
4522
|
|
|
|
|
|
|
} |
4523
|
|
|
|
|
|
|
} |
4524
|
69
|
|
|
|
|
637
|
$_[0] = \@filteredTags; # update tag list |
4525
|
|
|
|
|
|
|
} |
4526
|
|
|
|
|
|
|
|
4527
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4528
|
|
|
|
|
|
|
# Set list of found tags from previously requested tags |
4529
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
4530
|
|
|
|
|
|
|
# Returns: 0) Reference to list of found tag keys (in order of requested tags) |
4531
|
|
|
|
|
|
|
# 1) Reference to list of indices for tags requested by value |
4532
|
|
|
|
|
|
|
# 2) Reference to list of indices for tags specified by wildcard or "all" |
4533
|
|
|
|
|
|
|
# Notes: index lists are returned in increasing order |
4534
|
|
|
|
|
|
|
sub SetFoundTags($) |
4535
|
|
|
|
|
|
|
{ |
4536
|
690
|
|
|
690
|
0
|
1607
|
my $self = shift; |
4537
|
690
|
|
|
|
|
1900
|
my $options = $$self{OPTIONS}; |
4538
|
690
|
|
50
|
|
|
2470
|
my $reqTags = $$self{REQUESTED_TAGS} || [ ]; |
4539
|
690
|
|
|
|
|
1625
|
my $duplicates = $$options{Duplicates}; |
4540
|
690
|
|
|
|
|
1503
|
my $exclude = $$options{Exclude}; |
4541
|
690
|
|
|
|
|
1693
|
my $fileOrder = $$self{FILE_ORDER}; |
4542
|
690
|
|
|
|
|
18725
|
my @groupOptions = sort grep /^Group/, keys %$options; |
4543
|
690
|
|
100
|
|
|
5111
|
my $doDups = $duplicates || $exclude || @groupOptions; |
4544
|
690
|
|
|
|
|
1809
|
my ($tag, $rtnTags, @byValue, @wildTags); |
4545
|
|
|
|
|
|
|
|
4546
|
|
|
|
|
|
|
# only return requested tags if specified |
4547
|
690
|
100
|
|
|
|
2310
|
if (@$reqTags) { |
4548
|
356
|
50
|
|
|
|
1392
|
$rtnTags or $rtnTags = [ ]; |
4549
|
|
|
|
|
|
|
# scan through the requested tags and generate a list of tags we found |
4550
|
356
|
|
|
|
|
867
|
my $tagHash = $$self{VALUE}; |
4551
|
356
|
|
|
|
|
809
|
my $reqTag; |
4552
|
356
|
|
|
|
|
1171
|
foreach $reqTag (@$reqTags) { |
4553
|
869
|
|
|
|
|
1936
|
my (@matches, $group, $allGrp, $allTag, $byValue); |
4554
|
869
|
100
|
|
|
|
3118
|
if ($reqTag =~ /^(.*):(.+)/) { |
4555
|
234
|
|
|
|
|
1010
|
($group, $tag) = ($1, $2); |
4556
|
234
|
50
|
|
|
|
1758
|
if ($group =~ /^(\*|all)$/i) { |
|
|
50
|
|
|
|
|
|
4557
|
0
|
|
|
|
|
0
|
$allGrp = 1; |
4558
|
|
|
|
|
|
|
} elsif ($group !~ /^[-\w:]*$/) { |
4559
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid group name '${group}'"); |
4560
|
0
|
|
|
|
|
0
|
$group = 'invalid'; |
4561
|
|
|
|
|
|
|
} |
4562
|
|
|
|
|
|
|
} else { |
4563
|
635
|
|
|
|
|
1184
|
$tag = $reqTag; |
4564
|
|
|
|
|
|
|
} |
4565
|
869
|
50
|
66
|
|
|
2675
|
$byValue = 1 if $tag =~ s/#$// and $$options{PrintConv}; |
4566
|
869
|
50
|
66
|
|
|
6887
|
if (defined $$tagHash{$reqTag} and not $doDups) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4567
|
0
|
|
|
|
|
0
|
$matches[0] = $tag; |
4568
|
|
|
|
|
|
|
} elsif ($tag =~ /^(\*|all)$/i) { |
4569
|
|
|
|
|
|
|
# tag name of '*' or 'all' matches all tags |
4570
|
138
|
100
|
66
|
|
|
570
|
if ($doDups or $allGrp) { |
4571
|
137
|
|
|
|
|
4729
|
@matches = grep(!/#/, keys %$tagHash); |
4572
|
|
|
|
|
|
|
} else { |
4573
|
1
|
|
|
|
|
110
|
@matches = grep(!/ /, keys %$tagHash); |
4574
|
|
|
|
|
|
|
} |
4575
|
138
|
50
|
|
|
|
906
|
next unless @matches; # don't want entry in list for '*' tag |
4576
|
138
|
|
|
|
|
322
|
$allTag = 1; |
4577
|
|
|
|
|
|
|
} elsif ($tag =~ /[*?]/) { |
4578
|
|
|
|
|
|
|
# allow wildcards in tag names |
4579
|
3
|
|
|
|
|
15
|
$tag =~ s/\*/[-\\w]*/g; |
4580
|
3
|
|
|
|
|
16
|
$tag =~ s/\?/[-\\w]/g; |
4581
|
3
|
50
|
33
|
|
|
19
|
$tag .= '( \\(.*)?' if $doDups or $allGrp; |
4582
|
3
|
|
|
|
|
737
|
@matches = grep(/^$tag$/i, keys %$tagHash); |
4583
|
3
|
50
|
|
|
|
38
|
next unless @matches; # don't want entry in list for wildcard tags |
4584
|
3
|
|
|
|
|
22
|
$allTag = 1; |
4585
|
|
|
|
|
|
|
} elsif ($doDups or defined $group) { |
4586
|
|
|
|
|
|
|
# must also look for tags like "Tag (1)" |
4587
|
|
|
|
|
|
|
# (but be sure not to match temporary ValueConv entries like "Tag #") |
4588
|
728
|
|
|
|
|
52737
|
@matches = grep(/^$tag( \(|$)/i, keys %$tagHash); |
4589
|
|
|
|
|
|
|
} elsif ($tag =~ /^[-\w]+$/) { |
4590
|
|
|
|
|
|
|
# find first matching value |
4591
|
|
|
|
|
|
|
# (use in list context to return value instead of count) |
4592
|
0
|
|
|
|
|
0
|
($matches[0]) = grep /^$tag$/i, keys %$tagHash; |
4593
|
0
|
0
|
|
|
|
0
|
defined $matches[0] or undef @matches; |
4594
|
|
|
|
|
|
|
} else { |
4595
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid tag name '${tag}'"); |
4596
|
|
|
|
|
|
|
} |
4597
|
869
|
100
|
66
|
|
|
5900
|
if (defined $group and not $allGrp) { |
4598
|
|
|
|
|
|
|
# keep only specified group |
4599
|
234
|
|
|
|
|
861
|
@matches = $self->GroupMatches($group, \@matches); |
4600
|
234
|
100
|
100
|
|
|
1125
|
next unless @matches or not $allTag; |
4601
|
|
|
|
|
|
|
} |
4602
|
854
|
100
|
|
|
|
3273
|
if (@matches > 1) { |
|
|
100
|
|
|
|
|
|
4603
|
|
|
|
|
|
|
# maintain original file order for multiple tags |
4604
|
143
|
|
|
|
|
914
|
@matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches; |
|
7692
|
|
|
|
|
10877
|
|
4605
|
|
|
|
|
|
|
# return only the highest priority tag unless duplicates wanted |
4606
|
143
|
50
|
66
|
|
|
705
|
unless ($doDups or $allTag or $allGrp) { |
|
|
|
33
|
|
|
|
|
4607
|
0
|
|
|
|
|
0
|
$tag = shift @matches; |
4608
|
0
|
|
0
|
|
|
0
|
my $oldPriority = $$self{PRIORITY}{$tag} || 1; |
4609
|
0
|
|
|
|
|
0
|
foreach (@matches) { |
4610
|
0
|
|
|
|
|
0
|
my $priority = $$self{PRIORITY}{$_}; |
4611
|
0
|
0
|
|
|
|
0
|
$priority = 1 unless defined $priority; |
4612
|
0
|
0
|
|
|
|
0
|
next unless $priority >= $oldPriority; |
4613
|
0
|
|
|
|
|
0
|
$tag = $_; |
4614
|
0
|
|
0
|
|
|
0
|
$oldPriority = $priority || 1; |
4615
|
|
|
|
|
|
|
} |
4616
|
0
|
|
|
|
|
0
|
@matches = ( $tag ); |
4617
|
|
|
|
|
|
|
} |
4618
|
|
|
|
|
|
|
} elsif (not @matches) { |
4619
|
|
|
|
|
|
|
# put entry in return list even without value (value is undef) |
4620
|
443
|
100
|
|
|
|
1654
|
$matches[0] = $byValue ? "$tag #(0)" : "$tag (0)"; |
4621
|
|
|
|
|
|
|
# bogus file order entry to avoid warning if sorting in file order |
4622
|
443
|
|
|
|
|
1557
|
$$self{FILE_ORDER}{$matches[0]} = 9999; |
4623
|
|
|
|
|
|
|
} |
4624
|
|
|
|
|
|
|
# save indices of tags extracted by value |
4625
|
854
|
100
|
|
|
|
2331
|
push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue; |
4626
|
|
|
|
|
|
|
# save indices of wildcard tags |
4627
|
854
|
100
|
|
|
|
2580
|
push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag; |
4628
|
854
|
|
|
|
|
3094
|
push @$rtnTags, @matches; |
4629
|
|
|
|
|
|
|
} |
4630
|
|
|
|
|
|
|
} else { |
4631
|
|
|
|
|
|
|
# no requested tags, so we want all tags |
4632
|
334
|
|
|
|
|
717
|
my @allTags; |
4633
|
334
|
50
|
|
|
|
1331
|
if ($doDups) { |
4634
|
334
|
|
|
|
|
811
|
@allTags = keys %{$$self{VALUE}}; |
|
334
|
|
|
|
|
8861
|
|
4635
|
|
|
|
|
|
|
} else { |
4636
|
|
|
|
|
|
|
# only include tag if it doesn't end in a copy number |
4637
|
0
|
|
|
|
|
0
|
@allTags = grep(!/ /, keys %{$$self{VALUE}}); |
|
0
|
|
|
|
|
0
|
|
4638
|
|
|
|
|
|
|
} |
4639
|
334
|
|
|
|
|
1350
|
$rtnTags = \@allTags; |
4640
|
|
|
|
|
|
|
} |
4641
|
|
|
|
|
|
|
|
4642
|
|
|
|
|
|
|
# filter excluded tags and group options |
4643
|
690
|
|
100
|
|
|
5366
|
while (($exclude or @groupOptions) and @$rtnTags) { |
|
|
|
66
|
|
|
|
|
4644
|
68
|
100
|
|
|
|
243
|
if ($exclude) { |
4645
|
41
|
|
|
|
|
93
|
my ($pat, %exclude); |
4646
|
41
|
|
|
|
|
166
|
foreach $pat (@$exclude) { |
4647
|
57
|
|
|
|
|
106
|
my $group; |
4648
|
57
|
100
|
|
|
|
330
|
if ($pat =~ /^(.*):(.+)/) { |
4649
|
30
|
|
|
|
|
158
|
($group, $tag) = ($1, $2); |
4650
|
30
|
50
|
|
|
|
260
|
if ($group =~ /^(\*|all)$/i) { |
|
|
50
|
|
|
|
|
|
4651
|
0
|
|
|
|
|
0
|
undef $group; |
4652
|
|
|
|
|
|
|
} elsif ($group !~ /^[-\w:]*$/) { |
4653
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid group name '${group}'"); |
4654
|
0
|
|
|
|
|
0
|
$group = 'invalid'; |
4655
|
|
|
|
|
|
|
} |
4656
|
|
|
|
|
|
|
} else { |
4657
|
27
|
|
|
|
|
61
|
$tag = $pat; |
4658
|
|
|
|
|
|
|
} |
4659
|
57
|
|
|
|
|
115
|
my @matches; |
4660
|
57
|
100
|
|
|
|
259
|
if ($tag =~ /^(\*|all)$/i) { |
4661
|
30
|
|
|
|
|
226
|
@matches = @$rtnTags; |
4662
|
|
|
|
|
|
|
} else { |
4663
|
|
|
|
|
|
|
# allow wildcards in tag names |
4664
|
27
|
|
|
|
|
70
|
$tag =~ s/\*/[-\\w]*/g; |
4665
|
27
|
|
|
|
|
59
|
$tag =~ s/\?/[-\\w]/g; |
4666
|
27
|
|
|
|
|
2761
|
@matches = grep(/^$tag( |$)/i, @$rtnTags); |
4667
|
|
|
|
|
|
|
} |
4668
|
57
|
100
|
66
|
|
|
417
|
@matches = $self->GroupMatches($group, \@matches) if $group and @matches; |
4669
|
57
|
|
|
|
|
534
|
$exclude{$_} = 1 foreach @matches; |
4670
|
|
|
|
|
|
|
} |
4671
|
41
|
50
|
|
|
|
175
|
if (%exclude) { |
4672
|
|
|
|
|
|
|
# remove excluded tags from return list(s) |
4673
|
41
|
|
|
|
|
258
|
RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude); |
4674
|
41
|
50
|
|
|
|
181
|
last unless @$rtnTags; # all done if nothing left |
4675
|
|
|
|
|
|
|
} |
4676
|
41
|
100
|
66
|
|
|
310
|
last if $duplicates and not @groupOptions; |
4677
|
|
|
|
|
|
|
} |
4678
|
|
|
|
|
|
|
# filter groups if requested, or to remove duplicates |
4679
|
28
|
|
|
|
|
71
|
my (%keepTags, %wantGroup, $family, $groupOpt); |
4680
|
28
|
|
|
|
|
59
|
my $allGroups = 1; |
4681
|
|
|
|
|
|
|
# build hash of requested/excluded group names for each group family |
4682
|
28
|
|
|
|
|
58
|
my $wantOrder = 0; |
4683
|
28
|
|
|
|
|
64
|
foreach $groupOpt (@groupOptions) { |
4684
|
29
|
50
|
|
|
|
191
|
$groupOpt =~ /^Group(\d*(:\d+)*)/ or next; |
4685
|
29
|
|
100
|
|
|
138
|
$family = $1 || 0; |
4686
|
29
|
50
|
|
|
|
127
|
$wantGroup{$family} or $wantGroup{$family} = { }; |
4687
|
29
|
|
|
|
|
53
|
my $groupList; |
4688
|
29
|
100
|
|
|
|
101
|
if (ref $$options{$groupOpt} eq 'ARRAY') { |
4689
|
4
|
|
|
|
|
12
|
$groupList = $$options{$groupOpt}; |
4690
|
|
|
|
|
|
|
} else { |
4691
|
25
|
|
|
|
|
69
|
$groupList = [ $$options{$groupOpt} ]; |
4692
|
|
|
|
|
|
|
} |
4693
|
29
|
|
|
|
|
81
|
foreach (@$groupList) { |
4694
|
|
|
|
|
|
|
# groups have priority in order they were specified |
4695
|
33
|
|
|
|
|
62
|
++$wantOrder; |
4696
|
33
|
|
|
|
|
64
|
my ($groupName, $want); |
4697
|
33
|
100
|
|
|
|
103
|
if (/^-(.*)/) { |
4698
|
|
|
|
|
|
|
# excluded group begins with '-' |
4699
|
2
|
|
|
|
|
6
|
$groupName = $1; |
4700
|
2
|
|
|
|
|
5
|
$want = 0; # we don't want tags in this group |
4701
|
|
|
|
|
|
|
} else { |
4702
|
31
|
|
|
|
|
54
|
$groupName = $_; |
4703
|
31
|
|
|
|
|
46
|
$want = $wantOrder; # we want tags in this group |
4704
|
31
|
|
|
|
|
60
|
$allGroups = 0; # don't want all groups if we requested one |
4705
|
|
|
|
|
|
|
} |
4706
|
33
|
|
|
|
|
126
|
$wantGroup{$family}{$groupName} = $want; |
4707
|
|
|
|
|
|
|
} |
4708
|
|
|
|
|
|
|
} |
4709
|
|
|
|
|
|
|
# loop through all tags and decide which ones we want |
4710
|
28
|
|
|
|
|
54
|
my (@tags, %bestTag); |
4711
|
28
|
|
|
|
|
68
|
GR_TAG: foreach $tag (@$rtnTags) { |
4712
|
4505
|
|
|
|
|
5649
|
my $wantTag = $allGroups; # want tag by default if want all groups |
4713
|
4505
|
|
|
|
|
8580
|
foreach $family (keys %wantGroup) { |
4714
|
4591
|
|
|
|
|
8071
|
my $group = $self->GetGroup($tag, $family); |
4715
|
4591
|
|
|
|
|
7948
|
my $wanted = $wantGroup{$family}{$group}; |
4716
|
4591
|
100
|
|
|
|
9030
|
next unless defined $wanted; |
4717
|
1153
|
100
|
|
|
|
1924
|
next GR_TAG unless $wanted; # skip tag if group excluded |
4718
|
|
|
|
|
|
|
# take lowest non-zero want flag |
4719
|
976
|
50
|
33
|
|
|
1774
|
next if $wantTag and $wantTag < $wanted; |
4720
|
976
|
|
|
|
|
1567
|
$wantTag = $wanted; |
4721
|
|
|
|
|
|
|
} |
4722
|
4328
|
100
|
|
|
|
8102
|
next unless $wantTag; |
4723
|
1047
|
100
|
|
|
|
1966
|
$duplicates and $keepTags{$tag} = 1, next; |
4724
|
|
|
|
|
|
|
# determine which tag we want to keep |
4725
|
665
|
|
|
|
|
1031
|
my $tagName = GetTagName($tag); |
4726
|
665
|
|
|
|
|
1116
|
my $bestTag = $bestTag{$tagName}; |
4727
|
665
|
100
|
|
|
|
1132
|
if (defined $bestTag) { |
4728
|
28
|
100
|
|
|
|
86
|
next if $wantTag > $keepTags{$bestTag}; |
4729
|
16
|
50
|
|
|
|
47
|
if ($wantTag == $keepTags{$bestTag}) { |
4730
|
|
|
|
|
|
|
# want two tags with the same name -- keep the latest one |
4731
|
0
|
0
|
|
|
|
0
|
if ($tag =~ / \((\d+)\)$/) { |
4732
|
0
|
|
|
|
|
0
|
my $tagNum = $1; |
4733
|
0
|
0
|
0
|
|
|
0
|
next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum; |
4734
|
|
|
|
|
|
|
} |
4735
|
|
|
|
|
|
|
} |
4736
|
|
|
|
|
|
|
# this tag is better, so delete old best tag |
4737
|
16
|
|
|
|
|
46
|
delete $keepTags{$bestTag}; |
4738
|
|
|
|
|
|
|
} |
4739
|
653
|
|
|
|
|
1029
|
$keepTags{$tag} = $wantTag; # keep this tag (for now...) |
4740
|
653
|
|
|
|
|
1177
|
$bestTag{$tagName} = $tag; # this is our current best tag |
4741
|
|
|
|
|
|
|
} |
4742
|
|
|
|
|
|
|
# include only tags we want to keep in return lists |
4743
|
28
|
|
|
|
|
155
|
RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1); |
4744
|
28
|
|
|
|
|
222
|
last; |
4745
|
|
|
|
|
|
|
} |
4746
|
690
|
|
|
|
|
2554
|
$$self{FOUND_TAGS} = $rtnTags; # save found tags |
4747
|
|
|
|
|
|
|
|
4748
|
|
|
|
|
|
|
# return reference to found tag keys (and list of indices of tags to extract by value) |
4749
|
690
|
50
|
|
|
|
4509
|
return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags; |
4750
|
|
|
|
|
|
|
} |
4751
|
|
|
|
|
|
|
|
4752
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4753
|
|
|
|
|
|
|
# Utility to load our write routines if required (called via AUTOLOAD) |
4754
|
|
|
|
|
|
|
# Inputs: 0) autoload function, 1-N) function arguments |
4755
|
|
|
|
|
|
|
# Returns: result of function or dies if function not available |
4756
|
|
|
|
|
|
|
sub DoAutoLoad(@) |
4757
|
|
|
|
|
|
|
{ |
4758
|
721
|
|
|
721
|
0
|
2134
|
my $autoload = shift; |
4759
|
721
|
|
|
|
|
4478
|
my @callInfo = split(/::/, $autoload); |
4760
|
721
|
|
|
|
|
2071
|
my $file = 'Image/ExifTool/Write'; |
4761
|
|
|
|
|
|
|
|
4762
|
721
|
100
|
|
|
|
143193
|
return if $callInfo[$#callInfo] eq 'DESTROY'; |
4763
|
246
|
100
|
|
|
|
1183
|
if (@callInfo == 4) { |
|
|
100
|
|
|
|
|
|
4764
|
|
|
|
|
|
|
# load Image/ExifTool/WriteMODULE.pl |
4765
|
187
|
|
|
|
|
661
|
$file .= "$callInfo[2].pl"; |
4766
|
|
|
|
|
|
|
} elsif ($callInfo[-1] eq 'ShiftTime') { |
4767
|
1
|
|
|
|
|
3
|
$file = 'Image/ExifTool/Shift.pl'; # load Shift.pl |
4768
|
|
|
|
|
|
|
} else { |
4769
|
|
|
|
|
|
|
# load Image/ExifTool/Writer.pl |
4770
|
58
|
|
|
|
|
204
|
$file .= 'r.pl'; |
4771
|
|
|
|
|
|
|
} |
4772
|
|
|
|
|
|
|
# attempt to load the package |
4773
|
246
|
50
|
|
|
|
657
|
eval { require $file } or die "Error while attempting to call $autoload\n$@\n"; |
|
246
|
|
|
|
|
249665
|
|
4774
|
246
|
50
|
|
|
|
2074
|
unless (defined &$autoload) { |
4775
|
0
|
|
|
|
|
0
|
my @caller = caller(0); |
4776
|
|
|
|
|
|
|
# reproduce Perl's standard 'undefined subroutine' message: |
4777
|
0
|
|
|
|
|
0
|
die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n"; |
4778
|
|
|
|
|
|
|
} |
4779
|
105
|
|
|
105
|
|
1259
|
no strict 'refs'; |
|
105
|
|
|
|
|
271
|
|
|
105
|
|
|
|
|
134446
|
|
4780
|
246
|
|
|
|
|
1691
|
return &$autoload(@_); # call the function |
4781
|
|
|
|
|
|
|
} |
4782
|
|
|
|
|
|
|
|
4783
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4784
|
|
|
|
|
|
|
# AutoLoad our writer routines when necessary |
4785
|
|
|
|
|
|
|
# |
4786
|
|
|
|
|
|
|
sub AUTOLOAD |
4787
|
|
|
|
|
|
|
{ |
4788
|
534
|
|
|
534
|
|
362727
|
return DoAutoLoad($AUTOLOAD, @_); |
4789
|
|
|
|
|
|
|
} |
4790
|
|
|
|
|
|
|
|
4791
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4792
|
|
|
|
|
|
|
# Add warning tag |
4793
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) warning message |
4794
|
|
|
|
|
|
|
# 2) true if minor (2 if behaviour changes when warning is ignored, |
4795
|
|
|
|
|
|
|
# or 3 if warning shouldn't be issued when Validate option is used) |
4796
|
|
|
|
|
|
|
# Returns: true if warning tag was added |
4797
|
|
|
|
|
|
|
sub Warn($$;$) |
4798
|
|
|
|
|
|
|
{ |
4799
|
87
|
|
|
87
|
0
|
298
|
my ($self, $str, $ignorable) = @_; |
4800
|
87
|
100
|
|
|
|
334
|
if ($ignorable) { |
4801
|
32
|
100
|
|
|
|
145
|
return 0 if $$self{OPTIONS}{IgnoreMinorErrors}; |
4802
|
31
|
50
|
66
|
|
|
165
|
return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate}; |
4803
|
31
|
100
|
|
|
|
180
|
$str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str"; |
4804
|
|
|
|
|
|
|
} |
4805
|
86
|
|
|
|
|
420
|
$self->FoundTag('Warning', $str); |
4806
|
86
|
|
|
|
|
336
|
return 1; |
4807
|
|
|
|
|
|
|
} |
4808
|
|
|
|
|
|
|
|
4809
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4810
|
|
|
|
|
|
|
# Add warning tag only once per processed file |
4811
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor |
4812
|
|
|
|
|
|
|
# Returns: true if warning tag was added |
4813
|
|
|
|
|
|
|
sub WarnOnce($$;$) |
4814
|
|
|
|
|
|
|
{ |
4815
|
48
|
|
|
48
|
0
|
167
|
my ($self, $str, $ignorable) = @_; |
4816
|
48
|
50
|
66
|
|
|
234
|
return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors}; |
4817
|
48
|
100
|
|
|
|
251
|
unless ($$self{WARNED_ONCE}{$str}) { |
4818
|
41
|
|
|
|
|
280
|
$self->Warn($str, $ignorable); |
4819
|
41
|
|
|
|
|
176
|
$$self{WARNED_ONCE}{$str} = 1; |
4820
|
|
|
|
|
|
|
} |
4821
|
48
|
|
|
|
|
174
|
return 1; |
4822
|
|
|
|
|
|
|
} |
4823
|
|
|
|
|
|
|
|
4824
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4825
|
|
|
|
|
|
|
# Add error tag |
4826
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor |
4827
|
|
|
|
|
|
|
# Returns: true if error tag was added, otherwise warning was added |
4828
|
|
|
|
|
|
|
sub Error($$;$) |
4829
|
|
|
|
|
|
|
{ |
4830
|
1
|
|
|
1
|
0
|
4
|
my ($self, $str, $ignorable) = @_; |
4831
|
1
|
50
|
|
|
|
9
|
if ($$self{DemoteErrors}) { |
|
|
50
|
|
|
|
|
|
4832
|
0
|
0
|
|
|
|
0
|
$self->Warn($str) and ++$$self{DemoteErrors}; |
4833
|
0
|
|
|
|
|
0
|
return 1; |
4834
|
|
|
|
|
|
|
} elsif ($ignorable) { |
4835
|
1
|
50
|
|
|
|
8
|
$$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0; |
4836
|
0
|
|
|
|
|
0
|
$str = "[minor] $str"; |
4837
|
|
|
|
|
|
|
} |
4838
|
0
|
|
|
|
|
0
|
$self->FoundTag('Error', $str); |
4839
|
0
|
|
|
|
|
0
|
return 1; |
4840
|
|
|
|
|
|
|
} |
4841
|
|
|
|
|
|
|
|
4842
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4843
|
|
|
|
|
|
|
# Expand shortcuts |
4844
|
|
|
|
|
|
|
# Inputs: 0) reference to list of tags, 1) set to remove trailing '#' |
4845
|
|
|
|
|
|
|
# Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv, |
4846
|
|
|
|
|
|
|
# multiple group names, and redirected tags |
4847
|
|
|
|
|
|
|
sub ExpandShortcuts($;$) |
4848
|
|
|
|
|
|
|
{ |
4849
|
504
|
|
|
504
|
0
|
1471
|
my ($tagList, $removeSuffix) = @_; |
4850
|
504
|
50
|
33
|
|
|
2664
|
return unless $tagList and @$tagList; |
4851
|
|
|
|
|
|
|
|
4852
|
504
|
|
|
|
|
30226
|
require Image::ExifTool::Shortcuts; |
4853
|
|
|
|
|
|
|
|
4854
|
|
|
|
|
|
|
# expand shortcuts |
4855
|
504
|
100
|
|
|
|
1867
|
my $suffix = $removeSuffix ? '' : '#'; |
4856
|
504
|
|
|
|
|
1082
|
my @expandedTags; |
4857
|
504
|
|
|
|
|
1119
|
my ($entry, $tag, $excl); |
4858
|
504
|
|
|
|
|
1357
|
foreach $entry (@$tagList) { |
4859
|
|
|
|
|
|
|
# skip things like options hash references in list |
4860
|
1025
|
100
|
|
|
|
2558
|
if (ref $entry) { |
4861
|
1
|
|
|
|
|
4
|
push @expandedTags, $entry; |
4862
|
1
|
|
|
|
|
3
|
next; |
4863
|
|
|
|
|
|
|
} |
4864
|
|
|
|
|
|
|
# remove leading '-' |
4865
|
1024
|
|
|
|
|
5568
|
($excl, $tag) = $entry =~ /^(-?)(.*)/s; |
4866
|
1024
|
|
|
|
|
2199
|
my ($post, @post, $pre, $v); |
4867
|
|
|
|
|
|
|
# handle redirection |
4868
|
1024
|
100
|
100
|
|
|
10744
|
if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) { |
4869
|
23
|
|
|
|
|
116
|
($tag, $post) = ($1, $2); |
4870
|
23
|
100
|
100
|
|
|
192
|
if ($post =~ /^[-+]?>/ or $post !~ /\$/) { |
4871
|
|
|
|
|
|
|
# expand shortcuts in postfix (rhs of redirection) |
4872
|
18
|
|
|
|
|
124
|
my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/); |
4873
|
18
|
100
|
|
|
|
81
|
$p2 = '' unless defined $p2; |
4874
|
18
|
50
|
|
|
|
81
|
$v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix |
4875
|
18
|
|
|
|
|
371
|
my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main; |
4876
|
18
|
50
|
|
|
|
94
|
if ($match) { |
4877
|
0
|
|
|
|
|
0
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
0
|
|
|
|
|
0
|
|
4878
|
0
|
0
|
|
|
|
0
|
/^-/ and next; # ignore excluded tags |
4879
|
0
|
0
|
0
|
|
|
0
|
if ($p2 and /(.+:)(.+)/) { |
4880
|
0
|
|
|
|
|
0
|
push @post, "$op$_$v"; |
4881
|
|
|
|
|
|
|
} else { |
4882
|
0
|
|
|
|
|
0
|
push @post, "$op$p2$_$v"; |
4883
|
|
|
|
|
|
|
} |
4884
|
|
|
|
|
|
|
} |
4885
|
0
|
0
|
|
|
|
0
|
next unless @post; |
4886
|
0
|
|
|
|
|
0
|
$post = shift @post; |
4887
|
|
|
|
|
|
|
} |
4888
|
|
|
|
|
|
|
} |
4889
|
|
|
|
|
|
|
} else { |
4890
|
1001
|
|
|
|
|
2105
|
$post = ''; |
4891
|
|
|
|
|
|
|
} |
4892
|
|
|
|
|
|
|
# handle group names |
4893
|
1024
|
100
|
|
|
|
3323
|
if ($tag =~ /(.+:)(.+)/) { |
4894
|
298
|
|
|
|
|
1204
|
($pre, $tag) = ($1, $2); |
4895
|
|
|
|
|
|
|
} else { |
4896
|
726
|
|
|
|
|
1322
|
$pre = ''; |
4897
|
|
|
|
|
|
|
} |
4898
|
1024
|
100
|
|
|
|
2862
|
$v = ($tag =~ s/#$//) ? $suffix : ''; # ValueConv suffix |
4899
|
|
|
|
|
|
|
# loop over all postfixes |
4900
|
1024
|
|
|
|
|
1801
|
for (;;) { |
4901
|
|
|
|
|
|
|
# expand the tag name |
4902
|
1024
|
|
|
|
|
20959
|
my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main; |
4903
|
1024
|
100
|
|
|
|
3581
|
if ($match) { |
4904
|
17
|
50
|
66
|
|
|
172
|
if ($excl) { |
|
|
100
|
66
|
|
|
|
|
4905
|
|
|
|
|
|
|
# entry starts with '-', so exclude all tags in this shortcut |
4906
|
0
|
|
|
|
|
0
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
0
|
|
|
|
|
0
|
|
4907
|
0
|
0
|
|
|
|
0
|
/^-/ and next; # ignore excluded exclude tags |
4908
|
|
|
|
|
|
|
# group of expanded tag takes precedence |
4909
|
0
|
0
|
0
|
|
|
0
|
if ($pre and /(.+:)(.+)/) { |
4910
|
0
|
|
|
|
|
0
|
push @expandedTags, "$excl$_"; |
4911
|
|
|
|
|
|
|
} else { |
4912
|
0
|
|
|
|
|
0
|
push @expandedTags, "$excl$pre$_"; |
4913
|
|
|
|
|
|
|
} |
4914
|
|
|
|
|
|
|
} |
4915
|
|
|
|
|
|
|
} elsif (length $pre or length $post or $v) { |
4916
|
1
|
|
|
|
|
3
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
1
|
|
|
|
|
5
|
|
4917
|
12
|
|
|
|
|
35
|
/(-?)(.+:)?(.+)/; |
4918
|
12
|
50
|
|
|
|
25
|
if ($2) { |
4919
|
|
|
|
|
|
|
# group from expanded tag takes precedence |
4920
|
0
|
|
|
|
|
0
|
push @expandedTags, "$_$v$post"; |
4921
|
|
|
|
|
|
|
} else { |
4922
|
12
|
|
|
|
|
38
|
push @expandedTags, "$1$pre$3$v$post"; |
4923
|
|
|
|
|
|
|
} |
4924
|
|
|
|
|
|
|
} |
4925
|
|
|
|
|
|
|
} else { |
4926
|
16
|
|
|
|
|
32
|
push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}}; |
|
16
|
|
|
|
|
60
|
|
4927
|
|
|
|
|
|
|
} |
4928
|
|
|
|
|
|
|
} else { |
4929
|
1007
|
|
|
|
|
3431
|
push @expandedTags, "$excl$pre$tag$v$post"; |
4930
|
|
|
|
|
|
|
} |
4931
|
1024
|
50
|
|
|
|
3750
|
last unless @post; |
4932
|
0
|
|
|
|
|
0
|
$post = shift @post; |
4933
|
|
|
|
|
|
|
} |
4934
|
|
|
|
|
|
|
} |
4935
|
504
|
|
|
|
|
2325
|
@$tagList = @expandedTags; |
4936
|
|
|
|
|
|
|
} |
4937
|
|
|
|
|
|
|
|
4938
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4939
|
|
|
|
|
|
|
# Add hash of Composite tags to our composites |
4940
|
|
|
|
|
|
|
# Inputs: 0) hash reference to table of Composite tags to add or module name, |
4941
|
|
|
|
|
|
|
# 1) override existing tag definition |
4942
|
|
|
|
|
|
|
sub AddCompositeTags($;$) |
4943
|
|
|
|
|
|
|
{ |
4944
|
584
|
|
|
584
|
0
|
1855
|
local $_; |
4945
|
584
|
|
|
|
|
2414
|
my ($add, $override) = @_; |
4946
|
584
|
|
|
|
|
1563
|
my ($module, $prefix, $tagID); |
4947
|
584
|
50
|
|
|
|
2873
|
unless (ref $add) { |
4948
|
584
|
|
|
|
|
7297
|
($prefix = $add) =~ s/.*:://; |
4949
|
584
|
|
|
|
|
1676
|
$module = $add; |
4950
|
584
|
|
|
|
|
2051
|
$add .= '::Composite'; |
4951
|
105
|
|
|
105
|
|
931
|
no strict 'refs'; |
|
105
|
|
|
|
|
315
|
|
|
105
|
|
|
|
|
960675
|
|
4952
|
584
|
|
|
|
|
3221
|
$add = \%$add; |
4953
|
584
|
|
|
|
|
1776
|
$prefix .= '-'; |
4954
|
|
|
|
|
|
|
} else { |
4955
|
0
|
|
|
|
|
0
|
$prefix = 'UserDefined-'; |
4956
|
|
|
|
|
|
|
} |
4957
|
584
|
|
|
|
|
1929
|
my $defaultGroups = $$add{GROUPS}; |
4958
|
584
|
|
|
|
|
2787
|
my $compTable = GetTagTable('Image::ExifTool::Composite'); |
4959
|
|
|
|
|
|
|
|
4960
|
|
|
|
|
|
|
# make sure default groups are defined in families 0 and 1 |
4961
|
584
|
100
|
|
|
|
2043
|
if ($defaultGroups) { |
4962
|
490
|
100
|
|
|
|
2482
|
$$defaultGroups{0} or $$defaultGroups{0} = 'Composite'; |
4963
|
490
|
100
|
|
|
|
2069
|
$$defaultGroups{1} or $$defaultGroups{1} = 'Composite'; |
4964
|
490
|
50
|
|
|
|
1954
|
$$defaultGroups{2} or $$defaultGroups{2} = 'Other'; |
4965
|
|
|
|
|
|
|
} else { |
4966
|
94
|
|
|
|
|
632
|
$defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' }; |
4967
|
|
|
|
|
|
|
} |
4968
|
584
|
|
|
|
|
2370
|
SetupTagTable($add); # generate Name, TagID, etc |
4969
|
584
|
|
|
|
|
6046
|
foreach $tagID (sort keys %$add) { |
4970
|
5678
|
100
|
|
|
|
12156
|
next if $specialTags{$tagID}; # must skip special tags |
4971
|
5091
|
|
|
|
|
7751
|
my $tagInfo = $$add{$tagID}; |
4972
|
5091
|
|
|
|
|
11290
|
my $new = $prefix . $tagID; # new tag ID for Composite table |
4973
|
5091
|
100
|
|
|
|
10373
|
$$tagInfo{Module} = $module if $$tagInfo{Writable}; |
4974
|
5091
|
50
|
33
|
|
|
10046
|
$$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override}; |
4975
|
5091
|
|
|
|
|
9448
|
$$tagInfo{IsComposite} = 1; |
4976
|
|
|
|
|
|
|
# handle Composite tags with the same name |
4977
|
5091
|
100
|
|
|
|
11002
|
if ($compositeID{$tagID}) { |
4978
|
|
|
|
|
|
|
# determine if we want to override this tag |
4979
|
|
|
|
|
|
|
# (=0 keep both, >0 override, <0 keep existing) |
4980
|
337
|
|
50
|
|
|
3767
|
my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0); |
|
|
|
50
|
|
|
|
|
4981
|
337
|
50
|
|
|
|
1153
|
next if $over < 0; |
4982
|
337
|
50
|
|
|
|
1491
|
if ($over) { |
4983
|
|
|
|
|
|
|
# remove existing tags with this ID |
4984
|
0
|
|
|
|
|
0
|
delete $$compTable{$_} foreach @{$compositeID{$tagID}}; |
|
0
|
|
|
|
|
0
|
|
4985
|
0
|
|
|
|
|
0
|
delete $compositeID{$tagID}; |
4986
|
|
|
|
|
|
|
} |
4987
|
|
|
|
|
|
|
} |
4988
|
|
|
|
|
|
|
# make sure new TagID is unique by adding index if necessary |
4989
|
|
|
|
|
|
|
# (could only happen for UserDefined tags now that module name is added to tag ID) |
4990
|
5091
|
|
|
|
|
6926
|
my $n = 0; |
4991
|
5091
|
|
|
|
|
11303
|
while ($$compTable{$new}) { |
4992
|
0
|
0
|
|
|
|
0
|
$new =~ s/-\d+$// if $n++; |
4993
|
0
|
|
|
|
|
0
|
$new .= "-$n"; |
4994
|
|
|
|
|
|
|
} |
4995
|
|
|
|
|
|
|
# use new ID and save it so we can use it in TagLookup |
4996
|
5091
|
50
|
|
|
|
13111
|
$$tagInfo{NewTagID} = $new unless $tagID eq $new; |
4997
|
|
|
|
|
|
|
|
4998
|
|
|
|
|
|
|
# add new ID to lookup of Composite tag ID's |
4999
|
5091
|
100
|
|
|
|
13886
|
$compositeID{$tagID} = [ ] unless $compositeID{$tagID}; |
5000
|
5091
|
|
|
|
|
7284
|
unshift @{$compositeID{$tagID}}, $new; # (most recent one first) |
|
5091
|
|
|
|
|
12692
|
|
5001
|
|
|
|
|
|
|
|
5002
|
|
|
|
|
|
|
# convert scalar Require/Desire/Inhibit entries |
5003
|
5091
|
|
|
|
|
8344
|
my ($type, @hashes, @scalars, %used); |
5004
|
5091
|
|
|
|
|
8083
|
foreach $type ('Require','Desire','Inhibit') { |
5005
|
15273
|
100
|
|
|
|
32146
|
my $req = $$tagInfo{$type} or next; |
5006
|
6568
|
100
|
|
|
|
8482
|
push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type; |
|
6568
|
|
|
|
|
17791
|
|
5007
|
|
|
|
|
|
|
} |
5008
|
5091
|
100
|
|
|
|
10181
|
if (@scalars) { |
5009
|
|
|
|
|
|
|
# make lookup for indices that are used |
5010
|
949
|
|
|
|
|
2068
|
foreach $type (@hashes) { |
5011
|
105
|
|
|
|
|
369
|
$used{$_} = 1 foreach keys %{$$tagInfo{$type}}; |
|
105
|
|
|
|
|
1548
|
|
5012
|
|
|
|
|
|
|
} |
5013
|
949
|
|
|
|
|
1596
|
my $next = 0; |
5014
|
949
|
|
|
|
|
1769
|
foreach $type (@scalars) { |
5015
|
949
|
|
|
|
|
2424
|
++$next while $used{$next}; |
5016
|
949
|
|
|
|
|
3592
|
$$tagInfo{$type} = { $next++ => $$tagInfo{$type} }; |
5017
|
|
|
|
|
|
|
} |
5018
|
|
|
|
|
|
|
} |
5019
|
|
|
|
|
|
|
# add this Composite tag to our main Composite table |
5020
|
5091
|
|
|
|
|
8198
|
$$tagInfo{Table} = $compTable; |
5021
|
|
|
|
|
|
|
# (use the original TagID, even if we changed it, so don't do this:) |
5022
|
5091
|
|
|
|
|
7692
|
$$tagInfo{TagID} = $new; |
5023
|
|
|
|
|
|
|
# save tag under new ID in Composite table |
5024
|
5091
|
|
|
|
|
13275
|
$$compTable{$new} = $tagInfo; |
5025
|
|
|
|
|
|
|
# set all default groups in tag |
5026
|
5091
|
|
|
|
|
7647
|
my $groups = $$tagInfo{Groups}; |
5027
|
5091
|
100
|
|
|
|
11521
|
$groups or $groups = $$tagInfo{Groups} = { }; |
5028
|
|
|
|
|
|
|
# fill in default groups |
5029
|
5091
|
|
|
|
|
12257
|
foreach (keys %$defaultGroups) { |
5030
|
15273
|
100
|
|
|
|
33865
|
$$groups{$_} or $$groups{$_} = $$defaultGroups{$_}; |
5031
|
|
|
|
|
|
|
} |
5032
|
|
|
|
|
|
|
# set flag indicating group list was built |
5033
|
5091
|
|
|
|
|
14307
|
$$tagInfo{GotGroups} = 1; |
5034
|
|
|
|
|
|
|
} |
5035
|
|
|
|
|
|
|
} |
5036
|
|
|
|
|
|
|
|
5037
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5038
|
|
|
|
|
|
|
# Add tags to TagLookup (used for writing) |
5039
|
|
|
|
|
|
|
# Inputs: 0) source hash of tag definitions, 1) name of destination tag table |
5040
|
|
|
|
|
|
|
sub AddTagsToLookup($$) |
5041
|
|
|
|
|
|
|
{ |
5042
|
1
|
|
|
1
|
0
|
4
|
my ($tagHash, $table) = @_; |
5043
|
1
|
50
|
|
|
|
7
|
if (defined &Image::ExifTool::TagLookup::AddTags) { |
|
|
50
|
|
|
|
|
|
5044
|
0
|
|
|
|
|
0
|
Image::ExifTool::TagLookup::AddTags($tagHash, $table); |
5045
|
|
|
|
|
|
|
} elsif (not $Image::ExifTool::pluginTags{$tagHash}) { |
5046
|
|
|
|
|
|
|
# queue these tags until TagLookup is loaded |
5047
|
1
|
|
|
|
|
3
|
push @Image::ExifTool::pluginTags, [ $tagHash, $table ]; |
5048
|
|
|
|
|
|
|
# set flag so we don't load same tags twice |
5049
|
1
|
|
|
|
|
4
|
$Image::ExifTool::pluginTags{$tagHash} = 1; |
5050
|
|
|
|
|
|
|
} |
5051
|
|
|
|
|
|
|
} |
5052
|
|
|
|
|
|
|
|
5053
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5054
|
|
|
|
|
|
|
# Expand tagInfo Flags |
5055
|
|
|
|
|
|
|
# Inputs: 0) tagInfo hash ref |
5056
|
|
|
|
|
|
|
# Notes: $$tagInfo{Flags} must be defined to call this routine |
5057
|
|
|
|
|
|
|
sub ExpandFlags($) |
5058
|
|
|
|
|
|
|
{ |
5059
|
4660
|
|
|
4660
|
0
|
7131
|
my $tagInfo = shift; |
5060
|
4660
|
|
|
|
|
7298
|
my $flags = $$tagInfo{Flags}; |
5061
|
4660
|
100
|
|
|
|
10810
|
if (ref $flags eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
5062
|
2352
|
|
|
|
|
5057
|
foreach (@$flags) { |
5063
|
6247
|
|
|
|
|
13891
|
$$tagInfo{$_} = 1; |
5064
|
|
|
|
|
|
|
} |
5065
|
|
|
|
|
|
|
} elsif (ref $flags eq 'HASH') { |
5066
|
0
|
|
|
|
|
0
|
my $key; |
5067
|
0
|
|
|
|
|
0
|
foreach $key (keys %$flags) { |
5068
|
0
|
|
|
|
|
0
|
$$tagInfo{$key} = $$flags{$key}; |
5069
|
|
|
|
|
|
|
} |
5070
|
|
|
|
|
|
|
} else { |
5071
|
2308
|
|
|
|
|
5693
|
$$tagInfo{$flags} = 1; |
5072
|
|
|
|
|
|
|
} |
5073
|
|
|
|
|
|
|
} |
5074
|
|
|
|
|
|
|
|
5075
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5076
|
|
|
|
|
|
|
# Set up tag table (must be done once for each tag table used) |
5077
|
|
|
|
|
|
|
# Inputs: 0) Reference to tag table |
5078
|
|
|
|
|
|
|
# Notes: - generates 'Name' field from key if it doesn't exist |
5079
|
|
|
|
|
|
|
# - stores 'Table' pointer and 'TagID' value |
5080
|
|
|
|
|
|
|
# - expands 'Flags' for quick lookup |
5081
|
|
|
|
|
|
|
sub SetupTagTable($) |
5082
|
|
|
|
|
|
|
{ |
5083
|
5096
|
|
|
5096
|
0
|
8948
|
my $tagTablePtr = shift; |
5084
|
5096
|
|
|
|
|
9342
|
my $avoid = $$tagTablePtr{AVOID}; |
5085
|
5096
|
|
|
|
|
9204
|
my ($tagID, $tagInfo); |
5086
|
5096
|
|
|
|
|
11646
|
foreach $tagID (TagTableKeys($tagTablePtr)) { |
5087
|
203828
|
|
|
|
|
315545
|
my @infoArray = GetTagInfoList($tagTablePtr,$tagID); |
5088
|
|
|
|
|
|
|
# process conditional tagInfo arrays |
5089
|
203828
|
|
|
|
|
296987
|
foreach $tagInfo (@infoArray) { |
5090
|
224183
|
|
|
|
|
398816
|
$$tagInfo{Table} = $tagTablePtr; |
5091
|
224183
|
|
|
|
|
346334
|
$$tagInfo{TagID} = $tagID; |
5092
|
224183
|
100
|
|
|
|
426359
|
$$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID); |
5093
|
224183
|
100
|
|
|
|
381505
|
$$tagInfo{Flags} and ExpandFlags($tagInfo); |
5094
|
224183
|
100
|
|
|
|
362542
|
$$tagInfo{Avoid} = $avoid if defined $avoid; |
5095
|
|
|
|
|
|
|
# calculate BitShift from Mask if necessary |
5096
|
224183
|
100
|
100
|
|
|
438905
|
if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) { |
5097
|
3027
|
|
|
|
|
5279
|
my ($mask, $bitShift) = ($$tagInfo{Mask}, 0); |
5098
|
3027
|
|
|
|
|
9462
|
++$bitShift until $mask & (1 << $bitShift); |
5099
|
3027
|
|
|
|
|
6170
|
$$tagInfo{BitShift} = $bitShift; |
5100
|
|
|
|
|
|
|
} |
5101
|
|
|
|
|
|
|
} |
5102
|
203828
|
100
|
|
|
|
413062
|
next unless @infoArray > 1; |
5103
|
|
|
|
|
|
|
# add an "Index" member to each tagInfo in a list |
5104
|
3679
|
|
|
|
|
6381
|
my $index = 0; |
5105
|
3679
|
|
|
|
|
5855
|
foreach $tagInfo (@infoArray) { |
5106
|
24034
|
|
|
|
|
39226
|
$$tagInfo{Index} = $index++; |
5107
|
|
|
|
|
|
|
} |
5108
|
|
|
|
|
|
|
} |
5109
|
|
|
|
|
|
|
} |
5110
|
|
|
|
|
|
|
|
5111
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5112
|
|
|
|
|
|
|
# Utilities to check for numerical types |
5113
|
|
|
|
|
|
|
# Inputs: 0) value; Returns: true if value is a numerical type |
5114
|
|
|
|
|
|
|
# Notes: May change commas to decimals in floats for use in other locales |
5115
|
|
|
|
|
|
|
sub IsFloat($) { |
5116
|
7788
|
100
|
|
7788
|
0
|
83170
|
return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; |
5117
|
|
|
|
|
|
|
# allow comma separators (for other locales) |
5118
|
2185
|
50
|
|
|
|
17516
|
return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/; |
5119
|
0
|
|
|
|
|
0
|
$_[0] =~ tr/,/./; # but translate ',' to '.' |
5120
|
0
|
|
|
|
|
0
|
return 1; |
5121
|
|
|
|
|
|
|
} |
5122
|
19683
|
|
|
19683
|
0
|
98561
|
sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); } |
5123
|
3047
|
|
|
3047
|
0
|
12736
|
sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); } |
5124
|
16
|
|
|
16
|
0
|
837
|
sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); } |
5125
|
|
|
|
|
|
|
|
5126
|
|
|
|
|
|
|
# round floating point value to specified number of significant digits |
5127
|
|
|
|
|
|
|
# Inputs: 0) value, 1) number of sig digits; Returns: rounded number |
5128
|
|
|
|
|
|
|
sub RoundFloat($$) |
5129
|
|
|
|
|
|
|
{ |
5130
|
3364
|
|
|
3364
|
0
|
6410
|
my ($val, $sig) = @_; |
5131
|
3364
|
|
|
|
|
23454
|
return sprintf("%.${sig}g", $val); |
5132
|
|
|
|
|
|
|
} |
5133
|
|
|
|
|
|
|
|
5134
|
|
|
|
|
|
|
# Convert strings to floating point numbers (or undef) |
5135
|
|
|
|
|
|
|
# Inputs: 0-N) list of strings (may be undef) |
5136
|
|
|
|
|
|
|
# Returns: last value converted |
5137
|
|
|
|
|
|
|
sub ToFloat(@) |
5138
|
|
|
|
|
|
|
{ |
5139
|
968
|
|
|
968
|
0
|
1973
|
local $_; |
5140
|
968
|
|
|
|
|
2503
|
foreach (@_) { |
5141
|
10463
|
100
|
|
|
|
19488
|
next unless defined $_; |
5142
|
|
|
|
|
|
|
# (add 0 to convert "0.0" to "0" for tests) |
5143
|
3909
|
100
|
|
|
|
22405
|
$_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef; |
5144
|
|
|
|
|
|
|
} |
5145
|
968
|
|
|
|
|
10320
|
return $_[-1]; |
5146
|
|
|
|
|
|
|
} |
5147
|
|
|
|
|
|
|
|
5148
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5149
|
|
|
|
|
|
|
# Utility routines to for reading binary data values from file |
5150
|
|
|
|
|
|
|
|
5151
|
|
|
|
|
|
|
my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' ); |
5152
|
|
|
|
|
|
|
my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' ); |
5153
|
|
|
|
|
|
|
my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' ); |
5154
|
|
|
|
|
|
|
|
5155
|
|
|
|
|
|
|
# the following 4 variables are defined in 'use vars' instead of using 'my' |
5156
|
|
|
|
|
|
|
# because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my' |
5157
|
|
|
|
|
|
|
# variables from within subroutines (ref communication with Pavel Merdin): |
5158
|
|
|
|
|
|
|
# $swapBytes - set if EXIF header is not native byte ordering |
5159
|
|
|
|
|
|
|
# $swapWords - swap 32-bit words in doubles (ARM quirk) |
5160
|
|
|
|
|
|
|
$currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM') |
5161
|
|
|
|
|
|
|
%unpackStd = %unpackMotorola; |
5162
|
|
|
|
|
|
|
|
5163
|
|
|
|
|
|
|
# Swap bytes in data if necessary |
5164
|
|
|
|
|
|
|
# Inputs: 0) data, 1) number of bytes |
5165
|
|
|
|
|
|
|
# Returns: swapped data |
5166
|
|
|
|
|
|
|
sub SwapBytes($$) |
5167
|
|
|
|
|
|
|
{ |
5168
|
1360
|
100
|
|
1360
|
0
|
3749
|
return $_[0] unless $swapBytes; |
5169
|
206
|
|
|
|
|
508
|
my ($val, $bytes) = @_; |
5170
|
206
|
|
|
|
|
385
|
my $newVal = ''; |
5171
|
206
|
|
|
|
|
1478
|
$newVal .= substr($val, $bytes, 1) while $bytes--; |
5172
|
206
|
|
|
|
|
590
|
return $newVal; |
5173
|
|
|
|
|
|
|
} |
5174
|
|
|
|
|
|
|
# Swap words. Inputs: 8 bytes of data, Returns: swapped data |
5175
|
|
|
|
|
|
|
sub SwapWords($) |
5176
|
|
|
|
|
|
|
{ |
5177
|
1299
|
50
|
33
|
1299
|
0
|
4911
|
return $_[0] unless $swapWords and length($_[0]) == 8; |
5178
|
0
|
|
|
|
|
0
|
return substr($_[0],4,4) . substr($_[0],0,4) |
5179
|
|
|
|
|
|
|
} |
5180
|
|
|
|
|
|
|
|
5181
|
|
|
|
|
|
|
# Unpack value, letting unpack() handle byte swapping |
5182
|
|
|
|
|
|
|
# Inputs: 0) unpack template, 1) data reference, 2) offset |
5183
|
|
|
|
|
|
|
# Returns: unpacked number |
5184
|
|
|
|
|
|
|
# - uses value of %unpackStd to determine the unpack template |
5185
|
|
|
|
|
|
|
# - can only be called for 'S' or 'L' templates since these are the only |
5186
|
|
|
|
|
|
|
# templates for which you can specify the byte ordering. |
5187
|
|
|
|
|
|
|
sub DoUnpackStd(@) |
5188
|
|
|
|
|
|
|
{ |
5189
|
156736
|
100
|
|
156736
|
0
|
390856
|
$_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]}); |
|
152348
|
|
|
|
|
395471
|
|
5190
|
4388
|
|
|
|
|
8163
|
return unpack($unpackStd{$_[0]}, ${$_[1]}); |
|
4388
|
|
|
|
|
14327
|
|
5191
|
|
|
|
|
|
|
} |
5192
|
|
|
|
|
|
|
# same, but with reversed byte order |
5193
|
|
|
|
|
|
|
sub DoUnpackRev(@) |
5194
|
|
|
|
|
|
|
{ |
5195
|
12
|
|
|
12
|
0
|
26
|
my $fmt = $unpackRev{$unpackStd{$_[0]}}; |
5196
|
12
|
50
|
|
|
|
38
|
$_[2] and return unpack("x$_[2] $fmt", ${$_[1]}); |
|
12
|
|
|
|
|
35
|
|
5197
|
0
|
|
|
|
|
0
|
return unpack($fmt, ${$_[1]}); |
|
0
|
|
|
|
|
0
|
|
5198
|
|
|
|
|
|
|
} |
5199
|
|
|
|
|
|
|
# Pack value |
5200
|
|
|
|
|
|
|
# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref) |
5201
|
|
|
|
|
|
|
# Returns: packed value |
5202
|
|
|
|
|
|
|
sub DoPackStd(@) |
5203
|
|
|
|
|
|
|
{ |
5204
|
32029
|
|
|
32029
|
0
|
65873
|
my $val = pack($unpackStd{$_[0]}, $_[1]); |
5205
|
32029
|
100
|
|
|
|
56844
|
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; |
|
7739
|
|
|
|
|
13975
|
|
5206
|
32029
|
|
|
|
|
79341
|
return $val; |
5207
|
|
|
|
|
|
|
} |
5208
|
|
|
|
|
|
|
# same, but with reversed byte order |
5209
|
|
|
|
|
|
|
sub DoPackRev(@) |
5210
|
|
|
|
|
|
|
{ |
5211
|
0
|
|
|
0
|
0
|
0
|
my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]); |
5212
|
0
|
0
|
|
|
|
0
|
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; |
|
0
|
|
|
|
|
0
|
|
5213
|
0
|
|
|
|
|
0
|
return $val; |
5214
|
|
|
|
|
|
|
} |
5215
|
|
|
|
|
|
|
|
5216
|
|
|
|
|
|
|
# Unpack value, handling the byte swapping manually |
5217
|
|
|
|
|
|
|
# Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset |
5218
|
|
|
|
|
|
|
# Returns: unpacked number |
5219
|
|
|
|
|
|
|
# - uses value of $swapBytes to determine byte ordering |
5220
|
|
|
|
|
|
|
sub DoUnpack(@) |
5221
|
|
|
|
|
|
|
{ |
5222
|
27150
|
|
|
27150
|
0
|
47056
|
my ($bytes, $template, $dataPt, $pos) = @_; |
5223
|
27150
|
|
|
|
|
34054
|
my $val; |
5224
|
27150
|
100
|
|
|
|
43608
|
if ($swapBytes) { |
5225
|
5384
|
|
|
|
|
7522
|
$val = ''; |
5226
|
5384
|
|
|
|
|
23020
|
$val .= substr($$dataPt,$pos+$bytes,1) while $bytes--; |
5227
|
|
|
|
|
|
|
} else { |
5228
|
21766
|
|
|
|
|
37362
|
$val = substr($$dataPt,$pos,$bytes); |
5229
|
|
|
|
|
|
|
} |
5230
|
27150
|
50
|
|
|
|
48770
|
defined($val) or return undef; |
5231
|
27150
|
|
|
|
|
63844
|
return unpack($template,$val); |
5232
|
|
|
|
|
|
|
} |
5233
|
|
|
|
|
|
|
|
5234
|
|
|
|
|
|
|
# Unpack double value |
5235
|
|
|
|
|
|
|
# Inputs: 0) unpack template, 1) data reference, 2) offset |
5236
|
|
|
|
|
|
|
# Returns: unpacked number |
5237
|
|
|
|
|
|
|
sub DoUnpackDbl(@) |
5238
|
|
|
|
|
|
|
{ |
5239
|
1236
|
|
|
1236
|
0
|
2223
|
my ($template, $dataPt, $pos) = @_; |
5240
|
1236
|
|
|
|
|
2325
|
my $val = substr($$dataPt,$pos,8); |
5241
|
1236
|
50
|
|
|
|
2251
|
defined($val) or return undef; |
5242
|
|
|
|
|
|
|
# swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value |
5243
|
1236
|
|
|
|
|
2309
|
return unpack($template, SwapWords(SwapBytes($val, 8))); |
5244
|
|
|
|
|
|
|
} |
5245
|
|
|
|
|
|
|
|
5246
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) offset into data |
5247
|
129
|
|
|
129
|
0
|
394
|
sub Get8s($$) { return DoUnpackStd('c', @_); } |
5248
|
7706
|
|
|
7706
|
0
|
14829
|
sub Get8u($$) { return DoUnpackStd('C', @_); } |
5249
|
14471
|
|
|
14471
|
0
|
27150
|
sub Get16s($$) { return DoUnpack(2, 's', @_); } |
5250
|
75822
|
|
|
75822
|
0
|
136001
|
sub Get16u($$) { return DoUnpackStd('S', @_); } |
5251
|
12036
|
|
|
12036
|
0
|
21393
|
sub Get32s($$) { return DoUnpack(4, 'l', @_); } |
5252
|
73079
|
|
|
73079
|
0
|
126951
|
sub Get32u($$) { return DoUnpackStd('L', @_); } |
5253
|
643
|
|
|
643
|
0
|
1732
|
sub GetFloat($$) { return DoUnpack(4, 'f', @_); } |
5254
|
1236
|
|
|
1236
|
0
|
2517
|
sub GetDouble($$) { return DoUnpackDbl('d', @_); } |
5255
|
12
|
|
|
12
|
0
|
31
|
sub Get16uRev($$) { return DoUnpackRev('S', @_); } |
5256
|
0
|
|
|
0
|
0
|
0
|
sub Get32uRev($$) { return DoUnpackRev('L', @_); } |
5257
|
|
|
|
|
|
|
|
5258
|
|
|
|
|
|
|
# rationals may be a floating point number, 'inf' or 'undef' |
5259
|
|
|
|
|
|
|
my ($ratNumer, $ratDenom); |
5260
|
|
|
|
|
|
|
sub GetRational32s($$) |
5261
|
|
|
|
|
|
|
{ |
5262
|
12
|
|
|
12
|
0
|
30
|
my ($dataPt, $pos) = @_; |
5263
|
12
|
|
|
|
|
31
|
$ratNumer = Get16s($dataPt,$pos); |
5264
|
12
|
0
|
|
|
|
29
|
$ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5265
|
|
|
|
|
|
|
# round off to a reasonable number of significant figures |
5266
|
12
|
|
|
|
|
35
|
return RoundFloat($ratNumer / $ratDenom, 7); |
5267
|
|
|
|
|
|
|
} |
5268
|
|
|
|
|
|
|
sub GetRational32u($$) |
5269
|
|
|
|
|
|
|
{ |
5270
|
12
|
|
|
12
|
0
|
25
|
my ($dataPt, $pos) = @_; |
5271
|
12
|
|
|
|
|
31
|
$ratNumer = Get16u($dataPt,$pos); |
5272
|
12
|
0
|
|
|
|
34
|
$ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5273
|
12
|
|
|
|
|
45
|
return RoundFloat($ratNumer / $ratDenom, 7); |
5274
|
|
|
|
|
|
|
} |
5275
|
|
|
|
|
|
|
sub GetRational64s($$) |
5276
|
|
|
|
|
|
|
{ |
5277
|
654
|
|
|
654
|
0
|
1713
|
my ($dataPt, $pos) = @_; |
5278
|
654
|
|
|
|
|
1537
|
$ratNumer = Get32s($dataPt,$pos); |
5279
|
654
|
0
|
|
|
|
2195
|
$ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5280
|
654
|
|
|
|
|
2042
|
return RoundFloat($ratNumer / $ratDenom, 10); |
5281
|
|
|
|
|
|
|
} |
5282
|
|
|
|
|
|
|
sub GetRational64u($$) |
5283
|
|
|
|
|
|
|
{ |
5284
|
2703
|
|
|
2703
|
0
|
5180
|
my ($dataPt, $pos) = @_; |
5285
|
2703
|
|
|
|
|
4956
|
$ratNumer = Get32u($dataPt,$pos); |
5286
|
2703
|
50
|
|
|
|
6346
|
$ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; |
|
|
100
|
|
|
|
|
|
5287
|
2686
|
|
|
|
|
8665
|
return RoundFloat($ratNumer / $ratDenom, 10); |
5288
|
|
|
|
|
|
|
} |
5289
|
|
|
|
|
|
|
sub GetFixed16s($$) |
5290
|
|
|
|
|
|
|
{ |
5291
|
13
|
|
|
13
|
0
|
41
|
my ($dataPt, $pos) = @_; |
5292
|
13
|
|
|
|
|
44
|
my $val = Get16s($dataPt, $pos) / 0x100; |
5293
|
13
|
50
|
|
|
|
83
|
return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000; |
5294
|
|
|
|
|
|
|
} |
5295
|
|
|
|
|
|
|
sub GetFixed16u($$) |
5296
|
|
|
|
|
|
|
{ |
5297
|
0
|
|
|
0
|
0
|
0
|
my ($dataPt, $pos) = @_; |
5298
|
0
|
|
|
|
|
0
|
return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000; |
5299
|
|
|
|
|
|
|
} |
5300
|
|
|
|
|
|
|
sub GetFixed32s($$) |
5301
|
|
|
|
|
|
|
{ |
5302
|
1754
|
|
|
1754
|
0
|
3023
|
my ($dataPt, $pos) = @_; |
5303
|
1754
|
|
|
|
|
2965
|
my $val = Get32s($dataPt, $pos) / 0x10000; |
5304
|
|
|
|
|
|
|
# remove insignificant digits |
5305
|
1754
|
100
|
|
|
|
5222
|
return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5; |
5306
|
|
|
|
|
|
|
} |
5307
|
|
|
|
|
|
|
sub GetFixed32u($$) |
5308
|
|
|
|
|
|
|
{ |
5309
|
156
|
|
|
156
|
0
|
426
|
my ($dataPt, $pos) = @_; |
5310
|
|
|
|
|
|
|
# remove insignificant digits |
5311
|
156
|
|
|
|
|
404
|
return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5; |
5312
|
|
|
|
|
|
|
} |
5313
|
|
|
|
|
|
|
# Inputs: 0) value, 1) data ref, 2) offset |
5314
|
5
|
|
|
5
|
0
|
18
|
sub Set8s(@) { return DoPackStd('c', @_); } |
5315
|
291
|
|
|
291
|
0
|
664
|
sub Set8u(@) { return DoPackStd('C', @_); } |
5316
|
12887
|
|
|
12887
|
0
|
22827
|
sub Set16u(@) { return DoPackStd('S', @_); } |
5317
|
18846
|
|
|
18846
|
0
|
33640
|
sub Set32u(@) { return DoPackStd('L', @_); } |
5318
|
0
|
|
|
0
|
0
|
0
|
sub Set16uRev(@) { return DoPackRev('S', @_); } |
5319
|
|
|
|
|
|
|
|
5320
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5321
|
|
|
|
|
|
|
# Get current byte order ('II' or 'MM') |
5322
|
14005
|
|
|
14005
|
0
|
37999
|
sub GetByteOrder() { return $currentByteOrder; } |
5323
|
|
|
|
|
|
|
|
5324
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5325
|
|
|
|
|
|
|
# Set byte ordering |
5326
|
|
|
|
|
|
|
# Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian') |
5327
|
|
|
|
|
|
|
# Returns: 1 on success |
5328
|
|
|
|
|
|
|
sub SetByteOrder($) |
5329
|
|
|
|
|
|
|
{ |
5330
|
15159
|
|
|
15159
|
0
|
28970
|
my $order = shift; |
5331
|
|
|
|
|
|
|
|
5332
|
15159
|
100
|
|
|
|
35629
|
if ($order eq 'MM') { # big endian (Motorola) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
5333
|
7856
|
|
|
|
|
36338
|
%unpackStd = %unpackMotorola; |
5334
|
|
|
|
|
|
|
} elsif ($order eq 'II') { # little endian (Intel) |
5335
|
7112
|
|
|
|
|
33172
|
%unpackStd = %unpackIntel; |
5336
|
|
|
|
|
|
|
} elsif ($order =~ /^Big/i) { |
5337
|
15
|
|
|
|
|
34
|
$order = 'MM'; |
5338
|
15
|
|
|
|
|
100
|
%unpackStd = %unpackMotorola; |
5339
|
|
|
|
|
|
|
} elsif ($order =~ /^Little/i) { |
5340
|
11
|
|
|
|
|
43
|
$order = 'II'; |
5341
|
11
|
|
|
|
|
84
|
%unpackStd = %unpackIntel; |
5342
|
|
|
|
|
|
|
} else { |
5343
|
165
|
|
|
|
|
641
|
return 0; |
5344
|
|
|
|
|
|
|
} |
5345
|
14994
|
|
|
|
|
38824
|
my $val = unpack('S','A '); |
5346
|
14994
|
|
|
|
|
22440
|
my $nativeOrder; |
5347
|
14994
|
50
|
|
|
|
33556
|
if ($val == 0x4120) { # big endian |
|
|
50
|
|
|
|
|
|
5348
|
0
|
|
|
|
|
0
|
$nativeOrder = 'MM'; |
5349
|
|
|
|
|
|
|
} elsif ($val == 0x2041) { # little endian |
5350
|
14994
|
|
|
|
|
23424
|
$nativeOrder = 'II'; |
5351
|
|
|
|
|
|
|
} else { |
5352
|
0
|
|
|
|
|
0
|
warn sprintf("Unknown native byte order! (pattern %x)\n",$val); |
5353
|
0
|
|
|
|
|
0
|
return 0; |
5354
|
|
|
|
|
|
|
} |
5355
|
14994
|
|
|
|
|
22252
|
$currentByteOrder = $order; # save current byte order |
5356
|
|
|
|
|
|
|
|
5357
|
|
|
|
|
|
|
# swap bytes if our native CPU byte ordering is not the same as the EXIF |
5358
|
14994
|
|
|
|
|
24770
|
$swapBytes = ($order ne $nativeOrder); |
5359
|
|
|
|
|
|
|
|
5360
|
|
|
|
|
|
|
# little-endian ARM has big-endian words for doubles (thanks Riku Voipio) |
5361
|
|
|
|
|
|
|
# (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since |
5362
|
|
|
|
|
|
|
# 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?) |
5363
|
14994
|
|
|
|
|
22303
|
my $pack1d = pack('d', 1); |
5364
|
14994
|
|
33
|
|
|
45825
|
$swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or |
5365
|
|
|
|
|
|
|
$pack1d eq "\0\0\xf0\x3f\0\0\0\0"); |
5366
|
14994
|
|
|
|
|
31666
|
return 1; |
5367
|
|
|
|
|
|
|
} |
5368
|
|
|
|
|
|
|
|
5369
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5370
|
|
|
|
|
|
|
# Change byte order |
5371
|
|
|
|
|
|
|
sub ToggleByteOrder() |
5372
|
|
|
|
|
|
|
{ |
5373
|
39
|
100
|
|
39
|
0
|
131
|
SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II'); |
5374
|
|
|
|
|
|
|
} |
5375
|
|
|
|
|
|
|
|
5376
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5377
|
|
|
|
|
|
|
# hash lookups for reading values from data |
5378
|
|
|
|
|
|
|
my %formatSize = ( |
5379
|
|
|
|
|
|
|
int8s => 1, |
5380
|
|
|
|
|
|
|
int8u => 1, |
5381
|
|
|
|
|
|
|
int16s => 2, |
5382
|
|
|
|
|
|
|
int16u => 2, |
5383
|
|
|
|
|
|
|
int16uRev => 2, |
5384
|
|
|
|
|
|
|
int32s => 4, |
5385
|
|
|
|
|
|
|
int32u => 4, |
5386
|
|
|
|
|
|
|
int32uRev => 4, |
5387
|
|
|
|
|
|
|
int64s => 8, |
5388
|
|
|
|
|
|
|
int64u => 8, |
5389
|
|
|
|
|
|
|
rational32s => 4, |
5390
|
|
|
|
|
|
|
rational32u => 4, |
5391
|
|
|
|
|
|
|
rational64s => 8, |
5392
|
|
|
|
|
|
|
rational64u => 8, |
5393
|
|
|
|
|
|
|
fixed16s => 2, |
5394
|
|
|
|
|
|
|
fixed16u => 2, |
5395
|
|
|
|
|
|
|
fixed32s => 4, |
5396
|
|
|
|
|
|
|
fixed32u => 4, |
5397
|
|
|
|
|
|
|
fixed64s => 8, |
5398
|
|
|
|
|
|
|
float => 4, |
5399
|
|
|
|
|
|
|
double => 8, |
5400
|
|
|
|
|
|
|
extended => 10, |
5401
|
|
|
|
|
|
|
unicode => 2, |
5402
|
|
|
|
|
|
|
complex => 8, |
5403
|
|
|
|
|
|
|
string => 1, |
5404
|
|
|
|
|
|
|
binary => 1, |
5405
|
|
|
|
|
|
|
'undef' => 1, |
5406
|
|
|
|
|
|
|
ifd => 4, |
5407
|
|
|
|
|
|
|
ifd64 => 8, |
5408
|
|
|
|
|
|
|
ue7 => 1, |
5409
|
|
|
|
|
|
|
); |
5410
|
|
|
|
|
|
|
my %readValueProc = ( |
5411
|
|
|
|
|
|
|
int8s => \&Get8s, |
5412
|
|
|
|
|
|
|
int8u => \&Get8u, |
5413
|
|
|
|
|
|
|
int16s => \&Get16s, |
5414
|
|
|
|
|
|
|
int16u => \&Get16u, |
5415
|
|
|
|
|
|
|
int16uRev => \&Get16uRev, |
5416
|
|
|
|
|
|
|
int32s => \&Get32s, |
5417
|
|
|
|
|
|
|
int32u => \&Get32u, |
5418
|
|
|
|
|
|
|
int32uRev => \&Get32uRev, |
5419
|
|
|
|
|
|
|
int64s => \&Get64s, |
5420
|
|
|
|
|
|
|
int64u => \&Get64u, |
5421
|
|
|
|
|
|
|
rational32s => \&GetRational32s, |
5422
|
|
|
|
|
|
|
rational32u => \&GetRational32u, |
5423
|
|
|
|
|
|
|
rational64s => \&GetRational64s, |
5424
|
|
|
|
|
|
|
rational64u => \&GetRational64u, |
5425
|
|
|
|
|
|
|
fixed16s => \&GetFixed16s, |
5426
|
|
|
|
|
|
|
fixed16u => \&GetFixed16u, |
5427
|
|
|
|
|
|
|
fixed32s => \&GetFixed32s, |
5428
|
|
|
|
|
|
|
fixed32u => \&GetFixed32u, |
5429
|
|
|
|
|
|
|
fixed64s => \&GetFixed64s, |
5430
|
|
|
|
|
|
|
float => \&GetFloat, |
5431
|
|
|
|
|
|
|
double => \&GetDouble, |
5432
|
|
|
|
|
|
|
extended => \&GetExtended, |
5433
|
|
|
|
|
|
|
ifd => \&Get32u, |
5434
|
|
|
|
|
|
|
ifd64 => \&Get64u, |
5435
|
|
|
|
|
|
|
); |
5436
|
|
|
|
|
|
|
# lookup for all rational types |
5437
|
|
|
|
|
|
|
my %isRational = ( |
5438
|
|
|
|
|
|
|
rational32u => 1, |
5439
|
|
|
|
|
|
|
rational32s => 1, |
5440
|
|
|
|
|
|
|
rational64u => 1, |
5441
|
|
|
|
|
|
|
rational64s => 1, |
5442
|
|
|
|
|
|
|
); |
5443
|
1515
|
|
|
1515
|
0
|
4518
|
sub FormatSize($) { return $formatSize{$_[0]}; } |
5444
|
|
|
|
|
|
|
|
5445
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5446
|
|
|
|
|
|
|
# Read value from binary data (with current byte ordering) |
5447
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) value offset, 2) format string, |
5448
|
|
|
|
|
|
|
# 3) number of values (or undef to use all data), |
5449
|
|
|
|
|
|
|
# 4) valid data length relative to offset (or undef to use all data), |
5450
|
|
|
|
|
|
|
# 5) optional pointer to returned rational |
5451
|
|
|
|
|
|
|
# Returns: converted value, or undefined if data isn't there |
5452
|
|
|
|
|
|
|
# or list of values in list context |
5453
|
|
|
|
|
|
|
sub ReadValue($$$;$$$) |
5454
|
|
|
|
|
|
|
{ |
5455
|
35372
|
|
|
35372
|
0
|
77747
|
my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_; |
5456
|
|
|
|
|
|
|
|
5457
|
35372
|
|
|
|
|
64921
|
my $len = $formatSize{$format}; |
5458
|
35372
|
50
|
|
|
|
65536
|
unless ($len) { |
5459
|
0
|
|
|
|
|
0
|
warn "Unknown format $format"; |
5460
|
0
|
|
|
|
|
0
|
$len = 1; |
5461
|
|
|
|
|
|
|
} |
5462
|
35372
|
50
|
|
|
|
65318
|
$size = length($$dataPt) - $offset unless defined $size; |
5463
|
35372
|
100
|
|
|
|
62237
|
unless ($count) { |
5464
|
1359
|
100
|
100
|
|
|
4933
|
return '' if defined $count or $size < $len; |
5465
|
1330
|
|
|
|
|
2792
|
$count = int($size / $len); |
5466
|
|
|
|
|
|
|
} |
5467
|
|
|
|
|
|
|
# make sure entry is inside data |
5468
|
35343
|
100
|
|
|
|
69192
|
if ($len * $count > $size) { |
5469
|
3
|
|
|
|
|
14
|
$count = int($size / $len); # shorten count if necessary |
5470
|
3
|
50
|
|
|
|
27
|
$count < 1 and return undef; # return undefined if no data |
5471
|
|
|
|
|
|
|
} |
5472
|
35340
|
|
|
|
|
49186
|
my @vals; |
5473
|
35340
|
|
|
|
|
59211
|
my $proc = $readValueProc{$format}; |
5474
|
35340
|
100
|
100
|
|
|
99392
|
if (not $proc) { |
|
|
100
|
|
|
|
|
|
5475
|
|
|
|
|
|
|
# handle undef/binary/string (also unsupported unicode/complex) |
5476
|
6162
|
|
|
|
|
19205
|
$vals[0] = substr($$dataPt, $offset, $count * $len); |
5477
|
|
|
|
|
|
|
# truncate string at null terminator if necessary |
5478
|
6162
|
100
|
|
|
|
30406
|
$vals[0] =~ s/\0.*//s if $format eq 'string'; |
5479
|
|
|
|
|
|
|
} elsif ($isRational{$format} and $ratPt) { |
5480
|
|
|
|
|
|
|
# store rationals separately as string fractions |
5481
|
2994
|
|
|
|
|
4509
|
my @rat; |
5482
|
2994
|
|
|
|
|
4663
|
for (;;) { |
5483
|
3293
|
|
|
|
|
8082
|
push @vals, &$proc($dataPt, $offset); |
5484
|
3293
|
|
|
|
|
9278
|
push @rat, "$ratNumer/$ratDenom"; |
5485
|
3293
|
100
|
|
|
|
8521
|
last if --$count <= 0; |
5486
|
299
|
|
|
|
|
484
|
$offset += $len; |
5487
|
|
|
|
|
|
|
} |
5488
|
2994
|
|
|
|
|
8207
|
$$ratPt = join(' ',@rat); |
5489
|
|
|
|
|
|
|
} else { |
5490
|
26184
|
|
|
|
|
36673
|
for (;;) { |
5491
|
48379
|
|
|
|
|
89140
|
push @vals, &$proc($dataPt, $offset); |
5492
|
48379
|
100
|
|
|
|
101851
|
last if --$count <= 0; |
5493
|
22195
|
|
|
|
|
29304
|
$offset += $len; |
5494
|
|
|
|
|
|
|
} |
5495
|
|
|
|
|
|
|
} |
5496
|
35340
|
100
|
|
|
|
70622
|
return @vals if wantarray; |
5497
|
34928
|
100
|
|
|
|
93885
|
return join(' ', @vals) if @vals > 1; |
5498
|
31370
|
|
|
|
|
75399
|
return $vals[0]; |
5499
|
|
|
|
|
|
|
} |
5500
|
|
|
|
|
|
|
|
5501
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5502
|
|
|
|
|
|
|
# Decode string with specified encoding |
5503
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) string to decode |
5504
|
|
|
|
|
|
|
# 2) source character set name (undef for current Charset) |
5505
|
|
|
|
|
|
|
# 3) optional source byte order (2-byte and 4-byte fixed-width sets only) |
5506
|
|
|
|
|
|
|
# 4) optional destination character set (defaults to Charset setting) |
5507
|
|
|
|
|
|
|
# 5) optional destination byte order (2-byte and 4-byte fixed-width only) |
5508
|
|
|
|
|
|
|
# Returns: string in destination encoding |
5509
|
|
|
|
|
|
|
# Note: ExifTool ref may be undef if character both character sets are provided |
5510
|
|
|
|
|
|
|
# (but in this case no warnings will be issued) |
5511
|
|
|
|
|
|
|
sub Decode($$$;$$$) |
5512
|
|
|
|
|
|
|
{ |
5513
|
6171
|
|
|
6171
|
0
|
14410
|
my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_; |
5514
|
6171
|
100
|
|
|
|
12409
|
$from or $from = $$self{OPTIONS}{Charset}; |
5515
|
6171
|
100
|
|
|
|
15848
|
$to or $to = $$self{OPTIONS}{Charset}; |
5516
|
6171
|
100
|
100
|
|
|
16455
|
if ($from ne $to and length $val) { |
5517
|
1089
|
|
|
|
|
29233
|
require Image::ExifTool::Charset; |
5518
|
1089
|
|
|
|
|
2583
|
my $cs1 = $Image::ExifTool::Charset::csType{$from}; |
5519
|
1089
|
|
|
|
|
1857
|
my $cs2 = $Image::ExifTool::Charset::csType{$to}; |
5520
|
1089
|
50
|
33
|
|
|
5450
|
if ($cs1 and $cs2 and not $cs2 & 0x002) { |
|
|
0
|
33
|
|
|
|
|
5521
|
|
|
|
|
|
|
# treat as straight ASCII if no character will need remapping |
5522
|
1089
|
100
|
100
|
|
|
4060
|
if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) { |
5523
|
776
|
|
|
|
|
2445
|
my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder); |
5524
|
776
|
|
|
|
|
2258
|
$val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder); |
5525
|
|
|
|
|
|
|
} |
5526
|
|
|
|
|
|
|
} elsif ($self) { |
5527
|
0
|
0
|
|
|
|
0
|
my $set = $cs1 ? $to : $from; |
5528
|
0
|
0
|
|
|
|
0
|
unless ($$self{"DecodeWarn$set"}) { |
5529
|
0
|
|
|
|
|
0
|
$self->Warn("Unsupported character set ($set)"); |
5530
|
0
|
|
|
|
|
0
|
$$self{"DecodeWarn$set"} = 1; |
5531
|
|
|
|
|
|
|
} |
5532
|
|
|
|
|
|
|
} |
5533
|
|
|
|
|
|
|
} |
5534
|
6171
|
|
|
|
|
16317
|
return $val; |
5535
|
|
|
|
|
|
|
} |
5536
|
|
|
|
|
|
|
|
5537
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5538
|
|
|
|
|
|
|
# Encode string with specified encoding |
5539
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name, |
5540
|
|
|
|
|
|
|
# 3) optional destination byte order (2-byte and 4-byte fixed-width sets only) |
5541
|
|
|
|
|
|
|
# Returns: string in specified encoding |
5542
|
|
|
|
|
|
|
sub Encode($$$;$) |
5543
|
|
|
|
|
|
|
{ |
5544
|
59
|
|
|
59
|
0
|
206
|
my ($self, $val, $to, $toOrder) = @_; |
5545
|
59
|
|
|
|
|
247
|
return $self->Decode($val, undef, undef, $to, $toOrder); |
5546
|
|
|
|
|
|
|
} |
5547
|
|
|
|
|
|
|
|
5548
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5549
|
|
|
|
|
|
|
# Decode bit mask |
5550
|
|
|
|
|
|
|
# Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef) |
5551
|
|
|
|
|
|
|
# 2) optional bits per word (defaults to 32) |
5552
|
|
|
|
|
|
|
sub DecodeBits($$;$) |
5553
|
|
|
|
|
|
|
{ |
5554
|
171
|
|
|
171
|
0
|
744
|
my ($vals, $lookup, $bits) = @_; |
5555
|
171
|
100
|
|
|
|
614
|
$bits or $bits = 32; |
5556
|
171
|
|
|
|
|
386
|
my ($val, $i, @bitList); |
5557
|
171
|
|
|
|
|
372
|
my $num = 0; |
5558
|
171
|
|
|
|
|
648
|
foreach $val (split ' ', $vals) { |
5559
|
239
|
|
|
|
|
767
|
for ($i=0; $i<$bits; ++$i) { |
5560
|
5952
|
100
|
|
|
|
12712
|
next unless $val & (1 << $i); |
5561
|
139
|
|
|
|
|
313
|
my $n = $i + $num; |
5562
|
139
|
100
|
|
|
|
550
|
if (not $lookup) { |
|
|
100
|
|
|
|
|
|
5563
|
19
|
|
|
|
|
63
|
push @bitList, $n; |
5564
|
|
|
|
|
|
|
} elsif ($$lookup{$n}) { |
5565
|
114
|
|
|
|
|
363
|
push @bitList, $$lookup{$n}; |
5566
|
|
|
|
|
|
|
} else { |
5567
|
6
|
|
|
|
|
20
|
push @bitList, "[$n]"; |
5568
|
|
|
|
|
|
|
} |
5569
|
|
|
|
|
|
|
} |
5570
|
239
|
|
|
|
|
713
|
$num += $bits; |
5571
|
|
|
|
|
|
|
} |
5572
|
171
|
100
|
|
|
|
940
|
return '(none)' unless @bitList; |
5573
|
95
|
100
|
|
|
|
853
|
return join($lookup ? ', ' : ',', @bitList); |
5574
|
|
|
|
|
|
|
} |
5575
|
|
|
|
|
|
|
|
5576
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5577
|
|
|
|
|
|
|
# Validate an extracted image and repair if necessary |
5578
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key |
5579
|
|
|
|
|
|
|
# Returns: image reference or undef if it wasn't valid |
5580
|
|
|
|
|
|
|
# Note: should be called from RawConv, not ValueConv |
5581
|
|
|
|
|
|
|
sub ValidateImage($$$) |
5582
|
|
|
|
|
|
|
{ |
5583
|
199
|
|
|
199
|
0
|
737
|
my ($self, $imagePt, $tag) = @_; |
5584
|
199
|
50
|
|
|
|
778
|
return undef if $$imagePt eq 'none'; |
5585
|
199
|
100
|
66
|
|
|
1856
|
unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or |
|
|
|
100
|
|
|
|
|
5586
|
|
|
|
|
|
|
# the first byte of the preview of some Minolta cameras is wrong, |
5587
|
|
|
|
|
|
|
# so check for this and set it back to 0xff if necessary |
5588
|
|
|
|
|
|
|
$$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or |
5589
|
|
|
|
|
|
|
$self->Options('IgnoreMinorErrors')) |
5590
|
|
|
|
|
|
|
{ |
5591
|
|
|
|
|
|
|
# issue warning only if the tag was specifically requested |
5592
|
113
|
50
|
|
|
|
576
|
if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) { |
5593
|
0
|
|
|
|
|
0
|
$self->Warn("$tag is not a valid JPEG image",1); |
5594
|
0
|
|
|
|
|
0
|
return undef; |
5595
|
|
|
|
|
|
|
} |
5596
|
|
|
|
|
|
|
} |
5597
|
199
|
|
|
|
|
2189
|
return $imagePt; |
5598
|
|
|
|
|
|
|
} |
5599
|
|
|
|
|
|
|
|
5600
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5601
|
|
|
|
|
|
|
# Validate a tag name argument (including group name and wildcards, etc) |
5602
|
|
|
|
|
|
|
# Inputs: 0) tag name |
5603
|
|
|
|
|
|
|
# Returns: true if tag name is valid |
5604
|
|
|
|
|
|
|
# - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9] |
5605
|
|
|
|
|
|
|
# - tag names may contain wildcards [?*], and end with a hash [#] |
5606
|
|
|
|
|
|
|
# - may have group name prefixes (which may have family number prefix), separated by colons |
5607
|
|
|
|
|
|
|
# - a group name may be zero or more characters |
5608
|
|
|
|
|
|
|
sub ValidTagName($) |
5609
|
|
|
|
|
|
|
{ |
5610
|
41
|
|
|
41
|
0
|
96
|
my $tag = shift; |
5611
|
41
|
|
|
|
|
399
|
return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/; |
5612
|
|
|
|
|
|
|
} |
5613
|
|
|
|
|
|
|
|
5614
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5615
|
|
|
|
|
|
|
# Generate a valid tag name based on the tag ID or name |
5616
|
|
|
|
|
|
|
# Inputs: 0) tag ID or name |
5617
|
|
|
|
|
|
|
# Returns: valid tag name |
5618
|
|
|
|
|
|
|
sub MakeTagName($) |
5619
|
|
|
|
|
|
|
{ |
5620
|
34363
|
|
|
34363
|
0
|
47731
|
my $name = shift; |
5621
|
34363
|
|
|
|
|
62173
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
5622
|
34363
|
|
|
|
|
56286
|
$name = ucfirst $name; # capitalize first letter |
5623
|
34363
|
50
|
|
|
|
62835
|
$name = "Tag$name" if length($name) < 2; # must at least 2 characters long |
5624
|
34363
|
|
|
|
|
63924
|
return $name; |
5625
|
|
|
|
|
|
|
} |
5626
|
|
|
|
|
|
|
|
5627
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5628
|
|
|
|
|
|
|
# Make description from a tag name |
5629
|
|
|
|
|
|
|
# Inputs: 0) tag name 1) optional tagID to add at end of description |
5630
|
|
|
|
|
|
|
# Returns: description |
5631
|
|
|
|
|
|
|
sub MakeDescription($;$) |
5632
|
|
|
|
|
|
|
{ |
5633
|
10215
|
|
|
10215
|
0
|
19582
|
my ($tag, $tagID) = @_; |
5634
|
|
|
|
|
|
|
# start with the tag name and force first letter to be upper case |
5635
|
10215
|
|
|
|
|
19301
|
my $desc = ucfirst($tag); |
5636
|
|
|
|
|
|
|
# translate underlines to spaces |
5637
|
10215
|
|
|
|
|
17736
|
$desc =~ tr/_/ /; |
5638
|
|
|
|
|
|
|
# remove hex TagID from name (to avoid inserting spaces in the number) |
5639
|
10215
|
100
|
66
|
|
|
31343
|
$desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID; |
5640
|
|
|
|
|
|
|
# put a space between lower/UPPER case and lower/number combinations |
5641
|
10215
|
|
|
|
|
62835
|
$desc =~ s/([a-z])([A-Z\d])/$1 $2/g; |
5642
|
|
|
|
|
|
|
# put a space between acronyms and words |
5643
|
10215
|
|
|
|
|
27787
|
$desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g; |
5644
|
|
|
|
|
|
|
# put spaces after numbers (if more than one character follows the number) |
5645
|
10215
|
|
|
|
|
17113
|
$desc =~ s/(\d)([A-Z]\S)/$1 $2/g; |
5646
|
|
|
|
|
|
|
# add TagID to description |
5647
|
10215
|
100
|
|
|
|
19959
|
$desc .= ' ' . $tagID if defined $tagID; |
5648
|
10215
|
|
|
|
|
27090
|
return $desc; |
5649
|
|
|
|
|
|
|
} |
5650
|
|
|
|
|
|
|
|
5651
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5652
|
|
|
|
|
|
|
# Get descriptions for all tags in an array |
5653
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) reference to list of tag keys |
5654
|
|
|
|
|
|
|
# Returns: reference to hash lookup for descriptions |
5655
|
|
|
|
|
|
|
# Note: Returned descriptions are NOT escaped by ESCAPE_PROC |
5656
|
|
|
|
|
|
|
sub GetDescriptions($$) |
5657
|
|
|
|
|
|
|
{ |
5658
|
0
|
|
|
0
|
0
|
0
|
local $_; |
5659
|
0
|
|
|
|
|
0
|
my ($self, $tags) = @_; |
5660
|
0
|
|
|
|
|
0
|
my %desc; |
5661
|
0
|
|
|
|
|
0
|
my $oldEscape = $$self{ESCAPE_PROC}; |
5662
|
0
|
|
|
|
|
0
|
delete $$self{ESCAPE_PROC}; |
5663
|
0
|
|
|
|
|
0
|
$desc{$_} = $self->GetDescription($_) foreach @$tags; |
5664
|
0
|
|
|
|
|
0
|
$$self{ESCAPE_PROC} = $oldEscape; |
5665
|
0
|
|
|
|
|
0
|
return \%desc; |
5666
|
|
|
|
|
|
|
} |
5667
|
|
|
|
|
|
|
|
5668
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5669
|
|
|
|
|
|
|
# Apply filter to value(s) if necessary |
5670
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter |
5671
|
|
|
|
|
|
|
# Returns: true unless a filter returned undef; changes value if necessary |
5672
|
|
|
|
|
|
|
sub Filter($$$) |
5673
|
|
|
|
|
|
|
{ |
5674
|
13073
|
|
|
13073
|
1
|
20066
|
local $_; |
5675
|
13073
|
|
|
|
|
29958
|
my ($self, $filter, $valPt) = @_; |
5676
|
13073
|
100
|
66
|
|
|
44011
|
return 1 unless defined $filter and defined $$valPt; |
5677
|
462
|
|
|
|
|
701
|
my $rtnVal; |
5678
|
462
|
100
|
|
|
|
987
|
if (not ref $$valPt) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5679
|
446
|
|
|
|
|
785
|
$_ = $$valPt; |
5680
|
|
|
|
|
|
|
#### eval Filter ($_, $self) |
5681
|
446
|
|
|
|
|
25025
|
eval $filter; |
5682
|
446
|
50
|
|
|
|
1667
|
if (defined $_) { |
5683
|
446
|
|
|
|
|
850
|
$$valPt = $_; |
5684
|
446
|
|
|
|
|
677
|
$rtnVal = 1; |
5685
|
|
|
|
|
|
|
} |
5686
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'SCALAR') { |
5687
|
12
|
|
|
|
|
23
|
my $val = $$$valPt; # make a copy to avoid filtering twice |
5688
|
12
|
|
|
|
|
28
|
$rtnVal = $self->Filter($filter, \$val); |
5689
|
12
|
|
|
|
|
30
|
$$valPt = \$val; |
5690
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'ARRAY') { |
5691
|
4
|
|
|
|
|
5
|
my @val = @{$$valPt}; # make a copy to avoid filtering twice |
|
4
|
|
|
|
|
24
|
|
5692
|
4
|
|
50
|
|
|
13
|
$self->Filter($filter, \$_) and $rtnVal = 1 foreach @val; |
5693
|
4
|
|
|
|
|
9
|
$$valPt = \@val; |
5694
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'HASH') { |
5695
|
0
|
|
|
|
|
0
|
my %val = %{$$valPt}; # make a copy to avoid filtering twice |
|
0
|
|
|
|
|
0
|
|
5696
|
0
|
|
0
|
|
|
0
|
$self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val; |
5697
|
0
|
|
|
|
|
0
|
$$valPt = \%val; |
5698
|
|
|
|
|
|
|
} else { |
5699
|
0
|
|
|
|
|
0
|
$rtnVal = 1; |
5700
|
|
|
|
|
|
|
} |
5701
|
462
|
|
|
|
|
858
|
return $rtnVal; |
5702
|
|
|
|
|
|
|
} |
5703
|
|
|
|
|
|
|
|
5704
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5705
|
|
|
|
|
|
|
# Return printable value |
5706
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
5707
|
|
|
|
|
|
|
# 1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited) |
5708
|
|
|
|
|
|
|
sub Printable($;$) |
5709
|
|
|
|
|
|
|
{ |
5710
|
593
|
|
|
593
|
0
|
1192
|
my ($self, $outStr, $maxLen) = @_; |
5711
|
593
|
50
|
|
|
|
1222
|
return '(undef)' unless defined $outStr; |
5712
|
593
|
|
|
|
|
1233
|
$outStr =~ tr/\x01-\x1f\x7f-\xff/./; |
5713
|
593
|
|
|
|
|
1760
|
$outStr =~ s/\x00//g; |
5714
|
593
|
|
|
|
|
1009
|
my $verbose = $$self{OPTIONS}{Verbose}; |
5715
|
593
|
50
|
|
|
|
1161
|
if ($verbose < 4) { |
5716
|
593
|
100
|
|
|
|
1102
|
if ($maxLen) { |
|
|
50
|
|
|
|
|
|
5717
|
592
|
50
|
|
|
|
1237
|
$maxLen = 20 if $maxLen < 20; # minimum length is 20 |
5718
|
|
|
|
|
|
|
} elsif (defined $maxLen) { |
5719
|
1
|
|
|
|
|
2
|
$maxLen = length $outStr; # 0 is unlimited |
5720
|
|
|
|
|
|
|
} else { |
5721
|
0
|
|
|
|
|
0
|
$maxLen = 60; # default maximum is 60 |
5722
|
|
|
|
|
|
|
} |
5723
|
|
|
|
|
|
|
} else { |
5724
|
0
|
|
|
|
|
0
|
$maxLen = length $outStr; |
5725
|
|
|
|
|
|
|
# limit to 2048 characters if verbose < 5 |
5726
|
0
|
0
|
0
|
|
|
0
|
$maxLen = 2048 if $maxLen > 2048 and $verbose < 5; |
5727
|
|
|
|
|
|
|
} |
5728
|
|
|
|
|
|
|
|
5729
|
|
|
|
|
|
|
# limit length if necessary |
5730
|
593
|
100
|
|
|
|
1228
|
$outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen; |
5731
|
593
|
|
|
|
|
1821
|
return $outStr; |
5732
|
|
|
|
|
|
|
} |
5733
|
|
|
|
|
|
|
|
5734
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5735
|
|
|
|
|
|
|
# Convert date/time from Exif format |
5736
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format |
5737
|
|
|
|
|
|
|
# Returns: Formatted date/time string |
5738
|
|
|
|
|
|
|
sub ConvertDateTime($$) |
5739
|
|
|
|
|
|
|
{ |
5740
|
1779
|
|
|
1779
|
0
|
4939
|
my ($self, $date) = @_; |
5741
|
1779
|
|
|
|
|
4216
|
my $fmt = $$self{OPTIONS}{DateFormat}; |
5742
|
1779
|
|
|
|
|
3225
|
my $shift = $$self{OPTIONS}{GlobalTimeShift}; |
5743
|
1779
|
100
|
|
|
|
4685
|
if ($shift) { |
5744
|
8
|
50
|
33
|
|
|
59
|
my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1; |
5745
|
8
|
|
|
|
|
20
|
my $offset = $$self{GLOBAL_TIME_OFFSET}; |
5746
|
8
|
100
|
|
|
|
21
|
$offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { }; |
5747
|
8
|
|
|
|
|
34
|
ShiftTime($date, $shift, $dir, $offset); |
5748
|
|
|
|
|
|
|
} |
5749
|
|
|
|
|
|
|
# only convert date if a format was specified and the date is recognizable |
5750
|
1779
|
100
|
|
|
|
3966
|
if ($fmt) { |
5751
|
|
|
|
|
|
|
# separate time zone if it exists |
5752
|
5
|
|
|
|
|
9
|
my $tz; |
5753
|
5
|
100
|
|
|
|
36
|
$date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1; |
5754
|
|
|
|
|
|
|
# a few cameras use incorrect date/time formatting: |
5755
|
|
|
|
|
|
|
# - slashes instead of colons in date (RolleiD330, ImpressCam) |
5756
|
|
|
|
|
|
|
# - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar) |
5757
|
|
|
|
|
|
|
# - single-digit seconds with leading space (HP scanners) |
5758
|
5
|
|
|
|
|
38
|
my @a = reverse ($date =~ /\d+/g); # be very flexible about date/time format |
5759
|
5
|
50
|
33
|
|
|
51
|
if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) { |
|
5
|
0
|
33
|
|
|
36
|
|
|
|
|
33
|
|
|
|
|
5760
|
5
|
|
|
|
|
16
|
shift @a while @a > 6; # remove superfluous entries |
5761
|
5
|
|
|
|
|
17
|
unshift @a, 1 while @a < 3; # add month and day if necessary |
5762
|
5
|
|
|
|
|
13
|
unshift @a, 0 while @a < 6; # add h,m,s if necessary |
5763
|
5
|
|
|
|
|
14
|
$a[4] -= 1; # base month is 1 |
5764
|
|
|
|
|
|
|
# parse our %f fractional seconds first (and round up seconds if necessary) |
5765
|
|
|
|
|
|
|
# - if there are multiple %f codes, they all get the same number of digits as the first |
5766
|
5
|
50
|
|
|
|
28
|
if ($fmt =~ /%(-?)\.?(\d*)f/) { |
5767
|
0
|
|
|
|
|
0
|
my ($neg, $dig) = ($1, $2); |
5768
|
0
|
0
|
|
|
|
0
|
my $frac = $date =~ /(\.\d+)/ ? $1 : ''; |
5769
|
0
|
0
|
|
|
|
0
|
if (not $frac) { |
|
|
0
|
|
|
|
|
|
5770
|
0
|
0
|
|
|
|
0
|
$frac = '.' . ('0' x $dig) if $dig; |
5771
|
|
|
|
|
|
|
} elsif (length $dig) { |
5772
|
0
|
0
|
|
|
|
0
|
if ($dig+1 > length($frac)) { |
|
|
0
|
|
|
|
|
|
5773
|
0
|
|
|
|
|
0
|
$frac .= '0' x ($dig+1-length($frac)); |
5774
|
|
|
|
|
|
|
} elsif ($dig+1 < length($frac)) { |
5775
|
0
|
|
|
|
|
0
|
$frac = sprintf("%.${dig}f", $frac); |
5776
|
0
|
|
0
|
|
|
0
|
while ($frac =~ s/^(\d)// and $1 ne '0') { |
5777
|
|
|
|
|
|
|
# this is a pain, but we must round up to the next second |
5778
|
0
|
0
|
|
|
|
0
|
++$a[0] < 60 and last; |
5779
|
0
|
|
|
|
|
0
|
$a[0] = 0; |
5780
|
0
|
0
|
|
|
|
0
|
++$a[1] < 60 and last; |
5781
|
0
|
|
|
|
|
0
|
$a[1] = 0; |
5782
|
0
|
0
|
|
|
|
0
|
++$a[2] < 24 and last; |
5783
|
0
|
|
|
|
|
0
|
$a[2] = 0; |
5784
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/Shift.pl'; |
5785
|
0
|
0
|
|
|
|
0
|
++$a[3] <= DaysInMonth($a[4]+1, $a[5]) and last; |
5786
|
0
|
|
|
|
|
0
|
$a[3] = 1; |
5787
|
0
|
0
|
|
|
|
0
|
++$a[4] < 12 and last; |
5788
|
0
|
|
|
|
|
0
|
$a[4] = 0; |
5789
|
0
|
|
|
|
|
0
|
++$a[5]; |
5790
|
0
|
|
|
|
|
0
|
last; # (this was a goto) |
5791
|
|
|
|
|
|
|
} |
5792
|
|
|
|
|
|
|
} |
5793
|
|
|
|
|
|
|
} |
5794
|
0
|
0
|
|
|
|
0
|
$neg and $frac =~ s/^\.//; |
5795
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%-?\.?\d*f/$1$2$frac/g; |
5796
|
|
|
|
|
|
|
} |
5797
|
|
|
|
|
|
|
# parse %z and %s ourself (to handle time zones properly) |
5798
|
5
|
50
|
|
|
|
24
|
if ($fmt =~ /%[sz]/) { |
5799
|
|
|
|
|
|
|
# use system time zone unless otherwise specified |
5800
|
0
|
0
|
0
|
|
|
0
|
$tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local }; |
|
0
|
|
|
|
|
0
|
|
5801
|
|
|
|
|
|
|
# remove colon, setting to UTC if time zone is not numeric |
5802
|
0
|
0
|
0
|
|
|
0
|
$tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000'; |
5803
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g; # convert '%z' format codes |
5804
|
0
|
0
|
0
|
|
|
0
|
if ($fmt =~ /%s/ and eval { require Time::Local }) { |
|
0
|
|
|
|
|
0
|
|
5805
|
|
|
|
|
|
|
# calculate seconds since the Epoch, UTC |
5806
|
0
|
|
|
|
|
0
|
my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40); |
5807
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g; # convert '%s' format codes |
5808
|
|
|
|
|
|
|
} |
5809
|
|
|
|
|
|
|
} |
5810
|
5
|
|
|
|
|
9
|
$a[5] -= 1900; # strftime year starts from 1900 |
5811
|
5
|
|
|
|
|
234
|
$date = POSIX::strftime($fmt, @a); # generate the formatted date/time |
5812
|
|
|
|
|
|
|
} elsif ($$self{OPTIONS}{StrictDate}) { |
5813
|
0
|
|
|
|
|
0
|
undef $date; |
5814
|
|
|
|
|
|
|
} |
5815
|
|
|
|
|
|
|
} |
5816
|
1779
|
|
|
|
|
11582
|
return $date; |
5817
|
|
|
|
|
|
|
} |
5818
|
|
|
|
|
|
|
|
5819
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5820
|
|
|
|
|
|
|
# Print conversion for time span value |
5821
|
|
|
|
|
|
|
# Inputs: 0) time ticks, 1) number of seconds per tick (default 1) |
5822
|
|
|
|
|
|
|
# Returns: readable time |
5823
|
|
|
|
|
|
|
sub ConvertTimeSpan($;$) |
5824
|
|
|
|
|
|
|
{ |
5825
|
3
|
|
|
3
|
0
|
15
|
my ($val, $mult) = @_; |
5826
|
3
|
50
|
33
|
|
|
13
|
if (Image::ExifTool::IsFloat($val) and $val != 0) { |
5827
|
3
|
100
|
|
|
|
13
|
$val *= $mult if $mult; |
5828
|
3
|
50
|
|
|
|
30
|
if ($val < 60) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5829
|
0
|
|
|
|
|
0
|
$val = "$val seconds"; |
5830
|
|
|
|
|
|
|
} elsif ($val < 3600) { |
5831
|
3
|
100
|
66
|
|
|
28
|
my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f'; |
5832
|
3
|
100
|
66
|
|
|
19
|
my $s = ($val == 60 and $mult) ? '' : 's'; |
5833
|
3
|
|
|
|
|
34
|
$val = sprintf("$fmt minute$s", $val / 60); |
5834
|
|
|
|
|
|
|
} elsif ($val < 24 * 3600) { |
5835
|
0
|
|
|
|
|
0
|
$val = sprintf("%.1f hours", $val / 3600); |
5836
|
|
|
|
|
|
|
} else { |
5837
|
0
|
|
|
|
|
0
|
$val = sprintf("%.1f days", $val / (24 * 3600)); |
5838
|
|
|
|
|
|
|
} |
5839
|
|
|
|
|
|
|
} |
5840
|
3
|
|
|
|
|
25
|
return $val; |
5841
|
|
|
|
|
|
|
} |
5842
|
|
|
|
|
|
|
|
5843
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5844
|
|
|
|
|
|
|
# Patched timelocal() that fixes ActivePerl timezone bug |
5845
|
|
|
|
|
|
|
# Inputs/Returns: same as timelocal() |
5846
|
|
|
|
|
|
|
# Notes: must 'require Time::Local' before calling this routine |
5847
|
|
|
|
|
|
|
sub TimeLocal(@) |
5848
|
|
|
|
|
|
|
{ |
5849
|
36
|
|
|
36
|
0
|
1608
|
my $tm = Time::Local::timelocal(@_); |
5850
|
36
|
50
|
|
|
|
2957
|
if ($^O eq 'MSWin32') { |
5851
|
|
|
|
|
|
|
# patch for ActivePerl timezone bug |
5852
|
0
|
|
|
|
|
0
|
my @t2 = localtime($tm); |
5853
|
0
|
|
|
|
|
0
|
my $t2 = Time::Local::timelocal(@t2); |
5854
|
|
|
|
|
|
|
# adjust timelocal() return value to be consistent with localtime() |
5855
|
0
|
|
|
|
|
0
|
$tm += $tm - $t2; |
5856
|
|
|
|
|
|
|
} |
5857
|
36
|
|
|
|
|
139
|
return $tm; |
5858
|
|
|
|
|
|
|
} |
5859
|
|
|
|
|
|
|
|
5860
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5861
|
|
|
|
|
|
|
# Get time zone in minutes |
5862
|
|
|
|
|
|
|
# Inputs: 0) localtime array ref, 1) gmtime array ref |
5863
|
|
|
|
|
|
|
# Returns: time zone offset in minutes |
5864
|
|
|
|
|
|
|
sub GetTimeZone($$) |
5865
|
|
|
|
|
|
|
{ |
5866
|
930
|
|
|
930
|
0
|
2219
|
my ($tm, $gm) = @_; |
5867
|
|
|
|
|
|
|
# compute the number of minutes between localtime and gmtime |
5868
|
930
|
|
|
|
|
3340
|
my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]); |
5869
|
930
|
50
|
|
|
|
2630
|
if ($$tm[3] != $$gm[3]) { |
5870
|
|
|
|
|
|
|
# account for case where one date wraps to the first of the next month |
5871
|
0
|
0
|
|
|
|
0
|
$$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1; |
|
|
0
|
|
|
|
|
|
5872
|
|
|
|
|
|
|
# adjust for the +/- one day difference |
5873
|
0
|
|
|
|
|
0
|
$min += ($$tm[3] - $$gm[3]) * 24 * 60; |
5874
|
|
|
|
|
|
|
} |
5875
|
|
|
|
|
|
|
# MirBSD patch to round to the nearest 30 minutes because |
5876
|
|
|
|
|
|
|
# it includes leap seconds in localtime but not gmtime |
5877
|
930
|
0
|
|
|
|
3879
|
$min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd'; |
|
|
50
|
|
|
|
|
|
5878
|
930
|
|
|
|
|
2817
|
return $min; |
5879
|
|
|
|
|
|
|
} |
5880
|
|
|
|
|
|
|
|
5881
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5882
|
|
|
|
|
|
|
# Get time zone string |
5883
|
|
|
|
|
|
|
# Inputs: 0) time zone offset in minutes |
5884
|
|
|
|
|
|
|
# or 0) localtime array ref, 1) corresponding time value |
5885
|
|
|
|
|
|
|
# Returns: time zone string ("+/-HH:MM") |
5886
|
|
|
|
|
|
|
sub TimeZoneString($;$) |
5887
|
|
|
|
|
|
|
{ |
5888
|
971
|
|
|
971
|
0
|
2362
|
my $min = shift; |
5889
|
971
|
100
|
|
|
|
3211
|
if (ref $min) { |
5890
|
930
|
|
|
|
|
5248
|
my @gm = gmtime(shift); |
5891
|
930
|
|
|
|
|
3022
|
$min = GetTimeZone($min, \@gm); |
5892
|
|
|
|
|
|
|
} |
5893
|
971
|
|
|
|
|
2786
|
my $sign = '+'; |
5894
|
971
|
100
|
|
|
|
2648
|
$min < 0 and $sign = '-', $min = -$min; |
5895
|
971
|
|
|
|
|
2768
|
$min = int($min + 0.5); # round off to nearest minute |
5896
|
971
|
|
|
|
|
2366
|
my $h = int($min / 60); |
5897
|
971
|
|
|
|
|
6117
|
return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60); |
5898
|
|
|
|
|
|
|
} |
5899
|
|
|
|
|
|
|
|
5900
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5901
|
|
|
|
|
|
|
# Convert Unix time to EXIF date/time string |
5902
|
|
|
|
|
|
|
# Inputs: 0) Unix time value, 1) non-zero to convert to local time, |
5903
|
|
|
|
|
|
|
# 2) number of digits after the decimal for fractional seconds |
5904
|
|
|
|
|
|
|
# Returns: EXIF date/time string (with timezone for local times) |
5905
|
|
|
|
|
|
|
sub ConvertUnixTime($;$$) |
5906
|
|
|
|
|
|
|
{ |
5907
|
1036
|
|
|
1036
|
0
|
3481
|
my ($time, $toLocal, $dec) = @_; |
5908
|
1036
|
100
|
|
|
|
3056
|
return '0000:00:00 00:00:00' if $time == 0; |
5909
|
1035
|
|
|
|
|
2012
|
my (@tm, $tz); |
5910
|
1035
|
50
|
|
|
|
2465
|
if ($dec) { |
5911
|
0
|
|
|
|
|
0
|
my $frac = $time - int($time); |
5912
|
0
|
|
|
|
|
0
|
$time = int($time); |
5913
|
0
|
0
|
|
|
|
0
|
$frac < 0 and $frac += 1, $time -= 1; |
5914
|
0
|
|
|
|
|
0
|
$dec = sprintf('%.*f', $dec, $frac); |
5915
|
|
|
|
|
|
|
# remove number before decimal and increment integer time if it was rounded up |
5916
|
0
|
0
|
0
|
|
|
0
|
$dec =~ s/^(\d)// and $1 eq '1' and $time += 1; |
5917
|
|
|
|
|
|
|
} else { |
5918
|
1035
|
100
|
|
|
|
2863
|
$time = int($time + 1e-6) if $time != int($time); # avoid round-off errors |
5919
|
1035
|
|
|
|
|
1982
|
$dec = ''; |
5920
|
|
|
|
|
|
|
} |
5921
|
1035
|
100
|
|
|
|
2352
|
if ($toLocal) { |
5922
|
871
|
|
|
|
|
31547
|
@tm = localtime($time); |
5923
|
871
|
|
|
|
|
4375
|
$tz = TimeZoneString(\@tm, $time); |
5924
|
|
|
|
|
|
|
} else { |
5925
|
164
|
|
|
|
|
1117
|
@tm = gmtime($time); |
5926
|
164
|
|
|
|
|
365
|
$tz = ''; |
5927
|
|
|
|
|
|
|
} |
5928
|
1035
|
|
|
|
|
7489
|
my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s", |
5929
|
|
|
|
|
|
|
$tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz); |
5930
|
1035
|
|
|
|
|
9572
|
return $str; |
5931
|
|
|
|
|
|
|
} |
5932
|
|
|
|
|
|
|
|
5933
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5934
|
|
|
|
|
|
|
# Get Unix time from EXIF-formatted date/time string with optional timezone |
5935
|
|
|
|
|
|
|
# Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC |
5936
|
|
|
|
|
|
|
# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error |
5937
|
|
|
|
|
|
|
sub GetUnixTime($;$) |
5938
|
|
|
|
|
|
|
{ |
5939
|
162
|
|
|
162
|
0
|
37014
|
my ($timeStr, $isLocal) = @_; |
5940
|
162
|
50
|
|
|
|
502
|
return 0 if $timeStr eq '0000:00:00 00:00:00'; |
5941
|
162
|
|
|
|
|
1132
|
my @tm = ($timeStr =~ /^(\d+)[-:](\d+)[-:](\d+)\s+(\d+):(\d+):(\d+)(.*)/); |
5942
|
162
|
50
|
|
|
|
500
|
return undef unless @tm == 7; |
5943
|
162
|
50
|
|
|
|
287
|
unless (eval { require Time::Local }) { |
|
162
|
|
|
|
|
5856
|
|
5944
|
0
|
|
|
|
|
0
|
warn "Time::Local is not installed\n"; |
5945
|
0
|
|
|
|
|
0
|
return undef; |
5946
|
|
|
|
|
|
|
} |
5947
|
162
|
|
|
|
|
19810
|
my ($tzStr, $tzSec) = (pop(@tm), 0); |
5948
|
|
|
|
|
|
|
# use specified timezone offset (if given) instead of local system time |
5949
|
|
|
|
|
|
|
# if we are converting a local time value |
5950
|
162
|
100
|
|
|
|
446
|
if ($isLocal) { |
5951
|
113
|
50
|
|
|
|
427
|
if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) { |
|
|
0
|
|
|
|
|
|
5952
|
|
|
|
|
|
|
# use specified timezone if one exists |
5953
|
113
|
100
|
|
|
|
550
|
$tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1; |
|
|
100
|
|
|
|
|
|
5954
|
113
|
|
|
|
|
211
|
undef $isLocal; # convert using GMT corrected for specified timezone |
5955
|
|
|
|
|
|
|
} elsif ($isLocal eq '2') { |
5956
|
0
|
|
|
|
|
0
|
undef $isLocal; |
5957
|
|
|
|
|
|
|
} |
5958
|
|
|
|
|
|
|
} |
5959
|
162
|
|
|
|
|
384
|
$tm[1] -= 1; # convert month |
5960
|
162
|
|
|
|
|
325
|
@tm = reverse @tm; # change to order required by timelocal() |
5961
|
162
|
50
|
|
|
|
643
|
my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec; |
5962
|
|
|
|
|
|
|
# handle fractional seconds |
5963
|
160
|
100
|
100
|
|
|
5723
|
$val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/; |
5964
|
160
|
|
|
|
|
1332
|
return $val; |
5965
|
|
|
|
|
|
|
} |
5966
|
|
|
|
|
|
|
|
5967
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5968
|
|
|
|
|
|
|
# Print conversion for file size |
5969
|
|
|
|
|
|
|
# Inputs: 0) file size in bytes |
5970
|
|
|
|
|
|
|
# Returns: converted file size |
5971
|
|
|
|
|
|
|
sub ConvertFileSize($) |
5972
|
|
|
|
|
|
|
{ |
5973
|
300
|
|
|
300
|
0
|
858
|
my $val = shift; |
5974
|
300
|
100
|
|
|
|
1556
|
$val < 2000 and return "$val bytes"; |
5975
|
194
|
100
|
|
|
|
1941
|
$val < 10000 and return sprintf('%.1f kB', $val / 1000); |
5976
|
52
|
100
|
|
|
|
471
|
$val < 2000000 and return sprintf('%.0f kB', $val / 1000); |
5977
|
4
|
100
|
|
|
|
56
|
$val < 10000000 and return sprintf('%.1f MB', $val / 1000000); |
5978
|
1
|
50
|
|
|
|
9
|
$val < 2000000000 and return sprintf('%.0f MB', $val / 1000000); |
5979
|
0
|
0
|
|
|
|
0
|
$val < 10000000000 and return sprintf('%.1f GB', $val / 1000000000); |
5980
|
0
|
|
|
|
|
0
|
return sprintf('%.0f GB', $val / 1000000000); |
5981
|
|
|
|
|
|
|
} |
5982
|
|
|
|
|
|
|
|
5983
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5984
|
|
|
|
|
|
|
# Convert seconds to duration string (handles negative durations) |
5985
|
|
|
|
|
|
|
# Inputs: 0) floating point seconds |
5986
|
|
|
|
|
|
|
# Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS" |
5987
|
|
|
|
|
|
|
sub ConvertDuration($) |
5988
|
|
|
|
|
|
|
{ |
5989
|
130
|
|
|
130
|
0
|
310
|
my $time = shift; |
5990
|
130
|
50
|
|
|
|
327
|
return $time unless IsFloat($time); |
5991
|
130
|
100
|
|
|
|
819
|
return '0 s' if $time == 0; |
5992
|
61
|
50
|
|
|
|
193
|
my $sign = ($time > 0 ? '' : (($time = -$time), '-')); |
5993
|
61
|
100
|
|
|
|
844
|
return sprintf("$sign%.2f s", $time) if $time < 30; |
5994
|
4
|
|
|
|
|
9
|
$time += 0.5; # to round off to nearest second |
5995
|
4
|
|
|
|
|
14
|
my $h = int($time / 3600); |
5996
|
4
|
|
|
|
|
13
|
$time -= $h * 3600; |
5997
|
4
|
|
|
|
|
11
|
my $m = int($time / 60); |
5998
|
4
|
|
|
|
|
7
|
$time -= $m * 60; |
5999
|
4
|
50
|
|
|
|
14
|
if ($h > 24) { |
6000
|
0
|
|
|
|
|
0
|
my $d = int($h / 24); |
6001
|
0
|
|
|
|
|
0
|
$h -= $d * 24; |
6002
|
0
|
|
|
|
|
0
|
$sign = "$sign$d days "; |
6003
|
|
|
|
|
|
|
} |
6004
|
4
|
|
|
|
|
50
|
return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time)); |
6005
|
|
|
|
|
|
|
} |
6006
|
|
|
|
|
|
|
|
6007
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6008
|
|
|
|
|
|
|
# Print conversion for bitrate values |
6009
|
|
|
|
|
|
|
# Inputs: 0) bitrate in bits per second |
6010
|
|
|
|
|
|
|
# Returns: human-readable bitrate string |
6011
|
|
|
|
|
|
|
# Notes: returns input value without formatting if it isn't numerical |
6012
|
|
|
|
|
|
|
sub ConvertBitrate($) |
6013
|
|
|
|
|
|
|
{ |
6014
|
19
|
|
|
19
|
0
|
52
|
my $bitrate = shift; |
6015
|
19
|
50
|
|
|
|
65
|
IsFloat($bitrate) or return $bitrate; |
6016
|
19
|
|
|
|
|
88
|
my @units = ('bps', 'kbps', 'Mbps', 'Gbps'); |
6017
|
19
|
|
|
|
|
70
|
for (;;) { |
6018
|
36
|
|
|
|
|
74
|
my $units = shift @units; |
6019
|
36
|
100
|
66
|
|
|
162
|
$bitrate >= 1000 and @units and $bitrate /= 1000, next; |
6020
|
19
|
100
|
|
|
|
69
|
my $fmt = $bitrate < 100 ? '%.3g' : '%.0f'; |
6021
|
19
|
|
|
|
|
313
|
return sprintf("$fmt $units", $bitrate); |
6022
|
|
|
|
|
|
|
} |
6023
|
|
|
|
|
|
|
} |
6024
|
|
|
|
|
|
|
|
6025
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6026
|
|
|
|
|
|
|
# Convert file name for printing |
6027
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set |
6028
|
|
|
|
|
|
|
# Returns: converted file name in external character set |
6029
|
|
|
|
|
|
|
sub ConvertFileName($$) |
6030
|
|
|
|
|
|
|
{ |
6031
|
946
|
|
|
946
|
0
|
2988
|
my ($self, $val) = @_; |
6032
|
946
|
|
|
|
|
2397
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
6033
|
946
|
50
|
|
|
|
2773
|
$val = $self->Decode($val, $enc) if $enc; |
6034
|
946
|
|
|
|
|
7726
|
return $val; |
6035
|
|
|
|
|
|
|
} |
6036
|
|
|
|
|
|
|
|
6037
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6038
|
|
|
|
|
|
|
# Inverse conversion for file name (encode in CharsetFileName) |
6039
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in external character set |
6040
|
|
|
|
|
|
|
# Returns: file name in CharsetFileName character set |
6041
|
|
|
|
|
|
|
sub InverseFileName($$) |
6042
|
|
|
|
|
|
|
{ |
6043
|
1
|
|
|
1
|
0
|
4
|
my ($self, $val) = @_; |
6044
|
1
|
|
|
|
|
4
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
6045
|
1
|
50
|
|
|
|
6
|
$val = $self->Encode($val, $enc) if $enc; |
6046
|
1
|
|
|
|
|
4
|
$val =~ tr/\\/\//; # make sure we are using forward slashes |
6047
|
1
|
|
|
|
|
11
|
return $val; |
6048
|
|
|
|
|
|
|
} |
6049
|
|
|
|
|
|
|
|
6050
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6051
|
|
|
|
|
|
|
# Save information for HTML dump |
6052
|
|
|
|
|
|
|
# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size |
6053
|
|
|
|
|
|
|
# 3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name |
6054
|
|
|
|
|
|
|
sub HDump($$$$;$$$) |
6055
|
|
|
|
|
|
|
{ |
6056
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
6057
|
0
|
0
|
|
|
|
0
|
$$self{HTML_DUMP} or return; |
6058
|
0
|
|
|
|
|
0
|
my ($pos, $len, $com, $tip, $flg, $ifd) = @_; |
6059
|
0
|
0
|
|
|
|
0
|
$pos += $$self{BASE} if $$self{BASE}; |
6060
|
|
|
|
|
|
|
# skip structural data blocks which have been removed from the middle of this dump |
6061
|
|
|
|
|
|
|
# (SkipData list contains ordered [start,end+1] offsets to skip) |
6062
|
0
|
0
|
|
|
|
0
|
if ($$self{SkipData}) { |
6063
|
0
|
|
|
|
|
0
|
my $end = $pos + $len; |
6064
|
0
|
|
|
|
|
0
|
my $skip; |
6065
|
0
|
|
|
|
|
0
|
foreach $skip (@{$$self{SkipData}}) { |
|
0
|
|
|
|
|
0
|
|
6066
|
0
|
0
|
|
|
|
0
|
$end <= $$skip[0] and last; |
6067
|
0
|
0
|
|
|
|
0
|
$pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next; |
6068
|
0
|
0
|
|
|
|
0
|
if ($pos != $$skip[0]) { |
6069
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd); |
6070
|
0
|
|
|
|
|
0
|
$len -= $$skip[0] - $pos; |
6071
|
0
|
|
|
|
|
0
|
$tip = 'SAME'; |
6072
|
|
|
|
|
|
|
} |
6073
|
0
|
|
|
|
|
0
|
$pos = $$skip[1]; |
6074
|
|
|
|
|
|
|
} |
6075
|
|
|
|
|
|
|
} |
6076
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd); |
6077
|
|
|
|
|
|
|
} |
6078
|
|
|
|
|
|
|
|
6079
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6080
|
|
|
|
|
|
|
# Identify trailer ending at specified offset from end of file |
6081
|
|
|
|
|
|
|
# Inputs: 0) RAF reference, 1) offset from end of file (0 by default) |
6082
|
|
|
|
|
|
|
# Returns: Trailer info hash (with RAF and DirName set), |
6083
|
|
|
|
|
|
|
# or undef if no recognized trailer was found |
6084
|
|
|
|
|
|
|
# Notes: leaves file position unchanged |
6085
|
|
|
|
|
|
|
sub IdentifyTrailer($;$) |
6086
|
|
|
|
|
|
|
{ |
6087
|
566
|
|
|
566
|
0
|
1239
|
my $raf = shift; |
6088
|
566
|
|
100
|
|
|
2210
|
my $offset = shift || 0; |
6089
|
566
|
|
|
|
|
2065
|
my $pos = $raf->Tell(); |
6090
|
566
|
|
|
|
|
1485
|
my ($buff, $type, $len); |
6091
|
566
|
|
33
|
|
|
2439
|
while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) { |
6092
|
|
|
|
|
|
|
# read up to 64 bytes before specified offset from end of file |
6093
|
566
|
50
|
|
|
|
2295
|
$len = 64 if $len > 64; |
6094
|
566
|
50
|
33
|
|
|
2059
|
$raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last; |
6095
|
566
|
100
|
66
|
|
|
11867
|
if ($buff =~ /AXS(!|\*).{8}$/s) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6096
|
29
|
|
|
|
|
104
|
$type = 'AFCP'; |
6097
|
|
|
|
|
|
|
} elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) { |
6098
|
29
|
|
|
|
|
137
|
$type = 'FotoStation'; |
6099
|
|
|
|
|
|
|
} elsif ($buff =~ /cbipcbbl$/) { |
6100
|
34
|
|
|
|
|
142
|
$type = 'PhotoMechanic'; |
6101
|
|
|
|
|
|
|
} elsif ($buff =~ /^CANON OPTIONAL DATA\0/) { |
6102
|
41
|
|
|
|
|
136
|
$type = 'CanonVRD'; |
6103
|
|
|
|
|
|
|
} elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or |
6104
|
|
|
|
|
|
|
$buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s) |
6105
|
|
|
|
|
|
|
{ |
6106
|
26
|
|
|
|
|
107
|
$type = 'MIE'; |
6107
|
|
|
|
|
|
|
} elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) { |
6108
|
26
|
|
|
|
|
89
|
$type = 'Samsung'; |
6109
|
|
|
|
|
|
|
} elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) { |
6110
|
0
|
|
|
|
|
0
|
$type = 'Insta360'; |
6111
|
|
|
|
|
|
|
} elsif ($buff =~ m(\0{6}/NIKON APP$)) { |
6112
|
0
|
|
|
|
|
0
|
$type = 'NikonApp'; |
6113
|
|
|
|
|
|
|
} |
6114
|
566
|
|
|
|
|
1339
|
last; |
6115
|
|
|
|
|
|
|
} |
6116
|
566
|
|
|
|
|
2291
|
$raf->Seek($pos, 0); # restore original file position |
6117
|
566
|
100
|
|
|
|
3409
|
return $type ? { RAF => $raf, DirName => $type } : undef; |
6118
|
|
|
|
|
|
|
} |
6119
|
|
|
|
|
|
|
|
6120
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6121
|
|
|
|
|
|
|
# Read/rewrite trailer information (including multiple trailers) |
6122
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) DirInfo ref: |
6123
|
|
|
|
|
|
|
# - requires RAF and DirName |
6124
|
|
|
|
|
|
|
# - OutFile is a scalar reference for writing |
6125
|
|
|
|
|
|
|
# - scans from current file position if ScanForAFCP is set |
6126
|
|
|
|
|
|
|
# Returns: 1 if trailer was processed or couldn't be processed (or written OK) |
6127
|
|
|
|
|
|
|
# 0 if trailer was recognized but offsets need fixing (or write error) |
6128
|
|
|
|
|
|
|
# - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated |
6129
|
|
|
|
|
|
|
# - preserves current file position and byte order |
6130
|
|
|
|
|
|
|
sub ProcessTrailers($$) |
6131
|
|
|
|
|
|
|
{ |
6132
|
57
|
|
|
57
|
0
|
200
|
my ($self, $dirInfo) = @_; |
6133
|
57
|
|
|
|
|
174
|
my $dirName = $$dirInfo{DirName}; |
6134
|
57
|
|
|
|
|
135
|
my $outfile = $$dirInfo{OutFile}; |
6135
|
57
|
|
50
|
|
|
408
|
my $offset = $$dirInfo{Offset} || 0; |
6136
|
57
|
|
|
|
|
188
|
my $fixup = $$dirInfo{Fixup}; |
6137
|
57
|
|
|
|
|
150
|
my $raf = $$dirInfo{RAF}; |
6138
|
57
|
|
|
|
|
210
|
my $pos = $raf->Tell(); |
6139
|
57
|
|
|
|
|
235
|
my $byteOrder = GetByteOrder(); |
6140
|
57
|
|
|
|
|
136
|
my $success = 1; |
6141
|
57
|
|
|
|
|
150
|
my $path = $$self{PATH}; |
6142
|
|
|
|
|
|
|
|
6143
|
57
|
|
|
|
|
152
|
for (;;) { # loop through all trailers |
6144
|
185
|
|
|
|
|
387
|
my ($proc, $outBuff); |
6145
|
185
|
50
|
|
|
|
671
|
if ($dirName eq 'Insta360') { |
|
|
50
|
|
|
|
|
|
6146
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/QuickTimeStream.pl'; |
6147
|
0
|
|
|
|
|
0
|
$proc = 'Image::ExifTool::QuickTime::ProcessInsta360'; |
6148
|
|
|
|
|
|
|
} elsif ($dirName eq 'NikonApp') { |
6149
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Nikon; |
6150
|
0
|
|
|
|
|
0
|
$proc = 'Image::ExifTool::Nikon::ProcessNikonApp'; |
6151
|
|
|
|
|
|
|
} else { |
6152
|
185
|
|
|
|
|
16933
|
require "Image/ExifTool/$dirName.pm"; |
6153
|
185
|
|
|
|
|
640
|
$proc = "Image::ExifTool::${dirName}::Process$dirName"; |
6154
|
|
|
|
|
|
|
} |
6155
|
185
|
100
|
|
|
|
564
|
if ($outfile) { |
6156
|
|
|
|
|
|
|
# write to local buffer so we can add trailer in proper order later |
6157
|
50
|
100
|
|
|
|
212
|
$$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = ''; |
6158
|
|
|
|
|
|
|
# must generate new fixup if necessary so we can shift |
6159
|
|
|
|
|
|
|
# the old fixup separately after we prepend this trailer |
6160
|
50
|
|
|
|
|
124
|
delete $$dirInfo{Fixup}; |
6161
|
|
|
|
|
|
|
} |
6162
|
185
|
|
|
|
|
416
|
delete $$dirInfo{DirLen}; # reset trailer length |
6163
|
185
|
|
|
|
|
387
|
$$dirInfo{Offset} = $offset; # set offset from end of file |
6164
|
185
|
|
|
|
|
404
|
$$dirInfo{Trailer} = 1; # set Trailer flag in case proc cares |
6165
|
|
|
|
|
|
|
# add trailer and DirName to SubDirectory PATH |
6166
|
185
|
|
|
|
|
476
|
push @$path, 'Trailer', $dirName; |
6167
|
|
|
|
|
|
|
|
6168
|
|
|
|
|
|
|
# read or write this trailer |
6169
|
|
|
|
|
|
|
# (proc takes Offset as positive offset from end of trailer to end of file, |
6170
|
|
|
|
|
|
|
# and returns DataPos and DirLen, and Fixup if applicable, and updates |
6171
|
|
|
|
|
|
|
# OutFile when writing) |
6172
|
105
|
|
|
105
|
|
1117
|
no strict 'refs'; |
|
105
|
|
|
|
|
275
|
|
|
105
|
|
|
|
|
5626
|
|
6173
|
185
|
|
|
|
|
2029
|
my $result = &$proc($self, $dirInfo); |
6174
|
105
|
|
|
105
|
|
764
|
use strict 'refs'; |
|
105
|
|
|
|
|
340
|
|
|
105
|
|
|
|
|
1386462
|
|
6175
|
|
|
|
|
|
|
|
6176
|
|
|
|
|
|
|
# restore PATH (pop last 2 items) |
6177
|
185
|
|
|
|
|
583
|
splice @$path, -2; |
6178
|
|
|
|
|
|
|
|
6179
|
|
|
|
|
|
|
# check result |
6180
|
185
|
100
|
|
|
|
676
|
if ($outfile) { |
|
|
50
|
|
|
|
|
|
6181
|
50
|
50
|
|
|
|
143
|
if ($result > 0) { |
6182
|
50
|
100
|
|
|
|
152
|
if ($outBuff) { |
6183
|
|
|
|
|
|
|
# write trailers to OutFile in original order |
6184
|
33
|
|
|
|
|
328
|
$$outfile = $outBuff . $$outfile; |
6185
|
|
|
|
|
|
|
# must adjust old fixup start if it exists |
6186
|
33
|
50
|
|
|
|
143
|
$$fixup{Start} += length($outBuff) if $fixup; |
6187
|
33
|
|
|
|
|
61
|
$outBuff = ''; # free memory |
6188
|
|
|
|
|
|
|
} |
6189
|
50
|
100
|
|
|
|
174
|
if ($$dirInfo{Fixup}) { |
6190
|
15
|
100
|
|
|
|
51
|
if ($fixup) { |
6191
|
|
|
|
|
|
|
# add fixup for subsequent trailers to the fixup for this trailer |
6192
|
|
|
|
|
|
|
# (but first we must adjust for the new start position) |
6193
|
7
|
|
|
|
|
22
|
$$fixup{Shift} += $$dirInfo{Fixup}{Start}; |
6194
|
7
|
|
|
|
|
31
|
$$fixup{Start} -= $$dirInfo{Fixup}{Start}; |
6195
|
7
|
|
|
|
|
32
|
$$dirInfo{Fixup}->AddFixup($fixup); |
6196
|
|
|
|
|
|
|
} |
6197
|
15
|
|
|
|
|
48
|
$fixup = $$dirInfo{Fixup}; # save fixup |
6198
|
|
|
|
|
|
|
} |
6199
|
|
|
|
|
|
|
} else { |
6200
|
0
|
0
|
|
|
|
0
|
$success = 0 if $self->Error("Error rewriting $dirName trailer", 2); |
6201
|
0
|
|
|
|
|
0
|
last; |
6202
|
|
|
|
|
|
|
} |
6203
|
|
|
|
|
|
|
} elsif ($result < 0) { |
6204
|
|
|
|
|
|
|
# can't continue if we must scan for this trailer |
6205
|
0
|
|
|
|
|
0
|
$success = 0; |
6206
|
0
|
|
|
|
|
0
|
last; |
6207
|
|
|
|
|
|
|
} |
6208
|
185
|
50
|
33
|
|
|
1082
|
last unless $result > 0 and $$dirInfo{DirLen}; |
6209
|
|
|
|
|
|
|
# look for next trailer |
6210
|
185
|
|
|
|
|
412
|
$offset += $$dirInfo{DirLen}; |
6211
|
185
|
100
|
|
|
|
530
|
my $nextTrail = IdentifyTrailer($raf, $offset) or last; |
6212
|
128
|
|
|
|
|
412
|
$dirName = $$dirInfo{DirName} = $$nextTrail{DirName}; |
6213
|
128
|
|
|
|
|
413
|
$raf->Seek($pos, 0); |
6214
|
|
|
|
|
|
|
} |
6215
|
57
|
|
|
|
|
306
|
SetByteOrder($byteOrder); # restore original byte order |
6216
|
57
|
|
|
|
|
393
|
$raf->Seek($pos, 0); # restore original file position |
6217
|
57
|
|
|
|
|
244
|
$$dirInfo{OutFile} = $outfile; # restore original outfile |
6218
|
57
|
|
|
|
|
209
|
$$dirInfo{Offset} = $offset; # return offset from EOF to start of first trailer |
6219
|
57
|
|
|
|
|
294
|
$$dirInfo{Fixup} = $fixup; # return fixup information |
6220
|
57
|
|
|
|
|
370
|
return $success; |
6221
|
|
|
|
|
|
|
} |
6222
|
|
|
|
|
|
|
|
6223
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6224
|
|
|
|
|
|
|
# JPEG constants |
6225
|
|
|
|
|
|
|
|
6226
|
|
|
|
|
|
|
# JPEG marker names |
6227
|
|
|
|
|
|
|
%jpegMarker = ( |
6228
|
|
|
|
|
|
|
0x00 => 'NULL', |
6229
|
|
|
|
|
|
|
0x01 => 'TEM', |
6230
|
|
|
|
|
|
|
0xc0 => 'SOF0', # to SOF15, with a few exceptions below |
6231
|
|
|
|
|
|
|
0xc4 => 'DHT', |
6232
|
|
|
|
|
|
|
0xc8 => 'JPGA', |
6233
|
|
|
|
|
|
|
0xcc => 'DAC', |
6234
|
|
|
|
|
|
|
0xd0 => 'RST0', # to RST7 |
6235
|
|
|
|
|
|
|
0xd8 => 'SOI', |
6236
|
|
|
|
|
|
|
0xd9 => 'EOI', |
6237
|
|
|
|
|
|
|
0xda => 'SOS', |
6238
|
|
|
|
|
|
|
0xdb => 'DQT', |
6239
|
|
|
|
|
|
|
0xdc => 'DNL', |
6240
|
|
|
|
|
|
|
0xdd => 'DRI', |
6241
|
|
|
|
|
|
|
0xde => 'DHP', |
6242
|
|
|
|
|
|
|
0xdf => 'EXP', |
6243
|
|
|
|
|
|
|
0xe0 => 'APP0', # to APP15 |
6244
|
|
|
|
|
|
|
0xf0 => 'JPG0', |
6245
|
|
|
|
|
|
|
0xfe => 'COM', |
6246
|
|
|
|
|
|
|
); |
6247
|
|
|
|
|
|
|
|
6248
|
|
|
|
|
|
|
# lookup for size of JPEG marker length word |
6249
|
|
|
|
|
|
|
# (2 bytes assumed unless specified here) |
6250
|
|
|
|
|
|
|
my %markerLenBytes = ( |
6251
|
|
|
|
|
|
|
0x00 => 0, 0x01 => 0, |
6252
|
|
|
|
|
|
|
0xd0 => 0, 0xd1 => 0, 0xd2 => 0, 0xd3 => 0, 0xd4 => 0, 0xd5 => 0, 0xd6 => 0, 0xd7 => 0, |
6253
|
|
|
|
|
|
|
0xd8 => 0, 0xd9 => 0, 0xda => 0, |
6254
|
|
|
|
|
|
|
# J2C |
6255
|
|
|
|
|
|
|
0x30 => 0, 0x31 => 0, 0x32 => 0, 0x33 => 0, 0x34 => 0, 0x35 => 0, 0x36 => 0, 0x37 => 0, |
6256
|
|
|
|
|
|
|
0x38 => 0, 0x39 => 0, 0x3a => 0, 0x3b => 0, 0x3c => 0, 0x3d => 0, 0x3e => 0, 0x3f => 0, |
6257
|
|
|
|
|
|
|
0x4f => 0, |
6258
|
|
|
|
|
|
|
0x92 => 0, 0x93 => 0, |
6259
|
|
|
|
|
|
|
# J2C extensions |
6260
|
|
|
|
|
|
|
0x74 => 4, 0x75 => 4, 0x77 => 4, |
6261
|
|
|
|
|
|
|
); |
6262
|
|
|
|
|
|
|
|
6263
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6264
|
|
|
|
|
|
|
# Get JPEG marker name |
6265
|
|
|
|
|
|
|
# Inputs: 0) Jpeg number |
6266
|
|
|
|
|
|
|
# Returns: marker name |
6267
|
|
|
|
|
|
|
sub JpegMarkerName($) |
6268
|
|
|
|
|
|
|
{ |
6269
|
3055
|
|
|
3055
|
0
|
5637
|
my $marker = shift; |
6270
|
3055
|
|
|
|
|
7479
|
my $markerName = $jpegMarker{$marker}; |
6271
|
3055
|
100
|
|
|
|
6678
|
unless ($markerName) { |
6272
|
1157
|
|
|
|
|
3569
|
$markerName = $jpegMarker{$marker & 0xf0}; |
6273
|
1157
|
50
|
33
|
|
|
9171
|
if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) { |
6274
|
1157
|
|
|
|
|
4276
|
$markerName = $1 . ($marker & 0x0f); |
6275
|
|
|
|
|
|
|
} else { |
6276
|
0
|
|
|
|
|
0
|
$markerName = sprintf("marker 0x%.2x", $marker); |
6277
|
|
|
|
|
|
|
} |
6278
|
|
|
|
|
|
|
} |
6279
|
3055
|
|
|
|
|
7630
|
return $markerName; |
6280
|
|
|
|
|
|
|
} |
6281
|
|
|
|
|
|
|
|
6282
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6283
|
|
|
|
|
|
|
# Adjust directory start position |
6284
|
|
|
|
|
|
|
# Inputs: 0) dirInfo ref, 1) start offset |
6285
|
|
|
|
|
|
|
# 2) Base for offsets (relative to DataPos, defaults to absolute Base of 0) |
6286
|
|
|
|
|
|
|
sub DirStart($$;$) |
6287
|
|
|
|
|
|
|
{ |
6288
|
560
|
|
|
560
|
0
|
1531
|
my ($dirInfo, $start, $base) = @_; |
6289
|
560
|
|
|
|
|
1163
|
$$dirInfo{DirStart} = $start; |
6290
|
560
|
|
|
|
|
1207
|
$$dirInfo{DirLen} -= $start; |
6291
|
560
|
100
|
|
|
|
1831
|
if (defined $base) { |
6292
|
263
|
|
|
|
|
684
|
$$dirInfo{Base} = $$dirInfo{DataPos} + $base; |
6293
|
263
|
|
|
|
|
686
|
$$dirInfo{DataPos} = -$base; # (relative to Base!) |
6294
|
|
|
|
|
|
|
} |
6295
|
|
|
|
|
|
|
} |
6296
|
|
|
|
|
|
|
|
6297
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6298
|
|
|
|
|
|
|
# Extract metadata from a jpg image |
6299
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set |
6300
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG file |
6301
|
|
|
|
|
|
|
sub ProcessJPEG($$) |
6302
|
|
|
|
|
|
|
{ |
6303
|
233
|
|
|
233
|
0
|
527
|
local $_; |
6304
|
233
|
|
|
|
|
666
|
my ($self, $dirInfo) = @_; |
6305
|
233
|
|
|
|
|
529
|
my ($ch, $s, $length); |
6306
|
233
|
|
|
|
|
693
|
my $options = $$self{OPTIONS}; |
6307
|
233
|
|
|
|
|
588
|
my $verbose = $$options{Verbose}; |
6308
|
233
|
|
|
|
|
587
|
my $out = $$options{TextOut}; |
6309
|
233
|
|
100
|
|
|
1241
|
my $fast = $$options{FastScan} || 0; |
6310
|
233
|
|
|
|
|
568
|
my $raf = $$dirInfo{RAF}; |
6311
|
233
|
|
|
|
|
592
|
my $req = $$self{REQ_TAG_LOOKUP}; |
6312
|
233
|
|
|
|
|
525
|
my $htmlDump = $$self{HTML_DUMP}; |
6313
|
233
|
|
|
|
|
832
|
my %dumpParms = ( Out => $out ); |
6314
|
233
|
|
|
|
|
1422
|
my ($success, $wantTrailer, $trailInfo, $foundSOS, %jumbfChunk); |
6315
|
233
|
|
|
|
|
0
|
my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal); |
6316
|
233
|
|
|
|
|
0
|
my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP); |
6317
|
|
|
|
|
|
|
|
6318
|
|
|
|
|
|
|
# check to be sure this is a valid JPG (or J2C, or EXV) file |
6319
|
233
|
50
|
33
|
|
|
945
|
return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/; |
6320
|
233
|
100
|
|
|
|
1137
|
if ($s eq "\xff\x01") { |
6321
|
2
|
50
|
33
|
|
|
16
|
return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2'; |
6322
|
2
|
|
|
|
|
11
|
$$self{FILE_TYPE} = 'EXV'; |
6323
|
|
|
|
|
|
|
} |
6324
|
233
|
|
|
|
|
535
|
my $appBytes = 0; |
6325
|
233
|
|
|
|
|
574
|
my $calcImageLen = $$req{jpegimagelength}; |
6326
|
233
|
50
|
66
|
|
|
2132
|
if ($$options{RequestAll} and $$options{RequestAll} > 2) { |
6327
|
0
|
|
|
|
|
0
|
$calcImageLen = 1; |
6328
|
|
|
|
|
|
|
} |
6329
|
233
|
100
|
66
|
|
|
1209
|
if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) { |
|
|
|
66
|
|
|
|
|
6330
|
225
|
|
|
|
|
1238
|
$self->SetFileType(); # set FileType tag |
6331
|
225
|
100
|
|
|
|
1969
|
return 1 if $fast == 3; # don't process file when FastScan == 3 |
6332
|
224
|
|
|
|
|
837
|
$$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags |
6333
|
|
|
|
|
|
|
} |
6334
|
232
|
100
|
|
|
|
848
|
$$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode |
6335
|
|
|
|
|
|
|
|
6336
|
232
|
50
|
|
|
|
1554
|
$dumpParms{MaxLen} = 128 if $verbose < 4; |
6337
|
232
|
50
|
|
|
|
861
|
if ($htmlDump) { |
6338
|
0
|
|
|
|
|
0
|
$dumpEnd = $raf->Tell(); |
6339
|
0
|
0
|
|
|
|
0
|
my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI'); |
6340
|
0
|
|
|
|
|
0
|
my $pos = $dumpEnd - $n; |
6341
|
0
|
0
|
|
|
|
0
|
$self->HDump(0, $pos, '[unknown header]') if $pos; |
6342
|
0
|
|
|
|
|
0
|
$self->HDump($pos, $n, "$t header", "$m Marker"); |
6343
|
|
|
|
|
|
|
} |
6344
|
232
|
|
|
|
|
714
|
my $path = $$self{PATH}; |
6345
|
232
|
|
|
|
|
550
|
my $pn = scalar @$path; |
6346
|
|
|
|
|
|
|
|
6347
|
|
|
|
|
|
|
# set input record separator to 0xff (the JPEG marker) to make reading quicker |
6348
|
232
|
|
|
|
|
1383
|
local $/ = "\xff"; |
6349
|
|
|
|
|
|
|
|
6350
|
232
|
|
|
|
|
679
|
my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData); |
6351
|
|
|
|
|
|
|
|
6352
|
|
|
|
|
|
|
# read file until we reach an end of image (EOI) or start of scan (SOS) |
6353
|
232
|
|
|
|
|
792
|
Marker: for (;;) { |
6354
|
|
|
|
|
|
|
# set marker and data pointer for current segment |
6355
|
2053
|
|
|
|
|
3807
|
my $marker = $nextMarker; |
6356
|
2053
|
|
|
|
|
3183
|
my $segDataPt = $nextSegDataPt; |
6357
|
2053
|
|
|
|
|
3117
|
my $segPos = $nextSegPos; |
6358
|
2053
|
|
|
|
|
2936
|
my $skipped; |
6359
|
2053
|
|
|
|
|
3396
|
undef $nextMarker; |
6360
|
2053
|
|
|
|
|
3210
|
undef $nextSegDataPt; |
6361
|
|
|
|
|
|
|
# |
6362
|
|
|
|
|
|
|
# read ahead to the next segment unless we have reached EOI, SOS or SOD |
6363
|
|
|
|
|
|
|
# |
6364
|
2053
|
100
|
100
|
|
|
13715
|
unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) { |
|
|
|
100
|
|
|
|
|
6365
|
|
|
|
|
|
|
# read up to next marker (JPEG markers begin with 0xff) |
6366
|
1820
|
|
|
|
|
2775
|
my $buff; |
6367
|
1820
|
50
|
|
|
|
6684
|
$raf->ReadLine($buff) or last; |
6368
|
1820
|
|
|
|
|
3478
|
$skipped = length($buff) - 1; |
6369
|
|
|
|
|
|
|
# JPEG markers can be padded with unlimited 0xff's |
6370
|
1820
|
|
|
|
|
3627
|
for (;;) { |
6371
|
1820
|
50
|
|
|
|
4771
|
$raf->Read($ch, 1) or last Marker; |
6372
|
1820
|
|
|
|
|
3626
|
$nextMarker = ord($ch); |
6373
|
1820
|
50
|
|
|
|
4660
|
last unless $nextMarker == 0xff; |
6374
|
0
|
|
|
|
|
0
|
++$skipped; |
6375
|
|
|
|
|
|
|
} |
6376
|
|
|
|
|
|
|
# read segment data if it exists |
6377
|
1820
|
100
|
|
|
|
6388
|
if (not defined $markerLenBytes{$nextMarker}) { |
|
|
50
|
|
|
|
|
|
6378
|
|
|
|
|
|
|
# read record length word |
6379
|
1587
|
50
|
|
|
|
4107
|
last unless $raf->Read($s, 2) == 2; |
6380
|
1587
|
|
|
|
|
4961
|
my $len = unpack('n',$s); # get data length |
6381
|
1587
|
50
|
33
|
|
|
6640
|
last unless defined($len) and $len >= 2; |
6382
|
1587
|
|
|
|
|
4278
|
$nextSegPos = $raf->Tell(); |
6383
|
1587
|
|
|
|
|
2727
|
$len -= 2; # subtract size of length word |
6384
|
1587
|
50
|
|
|
|
3799
|
last unless $raf->Read($buff, $len) == $len; |
6385
|
1587
|
|
|
|
|
3443
|
$nextSegDataPt = \$buff; # set pointer to our next data |
6386
|
|
|
|
|
|
|
} elsif ($markerLenBytes{$nextMarker} == 4) { |
6387
|
|
|
|
|
|
|
# handle J2C extensions with 4-byte length word |
6388
|
0
|
0
|
|
|
|
0
|
last unless $raf->Read($s, 4) == 4; |
6389
|
0
|
|
|
|
|
0
|
my $len = unpack('N',$s); # get data length |
6390
|
0
|
0
|
0
|
|
|
0
|
last unless defined($len) and $len >= 4; |
6391
|
0
|
|
|
|
|
0
|
$nextSegPos = $raf->Tell(); |
6392
|
0
|
|
|
|
|
0
|
$len -= 4; # subtract size of length word |
6393
|
0
|
0
|
|
|
|
0
|
last unless $raf->Seek($len, 1); |
6394
|
|
|
|
|
|
|
} |
6395
|
|
|
|
|
|
|
# read second segment too if this was the first |
6396
|
1820
|
100
|
|
|
|
4510
|
next unless defined $marker; |
6397
|
|
|
|
|
|
|
} |
6398
|
|
|
|
|
|
|
# set some useful variables for the current segment |
6399
|
1820
|
|
|
|
|
4702
|
my $markerName = JpegMarkerName($marker); |
6400
|
1820
|
|
|
|
|
3915
|
$$path[$pn] = $markerName; |
6401
|
|
|
|
|
|
|
# issue warning if we skipped some garbage |
6402
|
1820
|
0
|
33
|
|
|
4755
|
if ($skipped and not $foundSOS and $markerName ne 'SOS') { |
|
|
|
33
|
|
|
|
|
6403
|
0
|
|
|
|
|
0
|
$self->Warn("Skipped unknown $skipped bytes after JPEG $markerName segment", 1); |
6404
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
6405
|
0
|
|
|
|
|
0
|
$self->HDump($nextSegPos-4-$skipped, $skipped, "[unknown $skipped bytes]", undef, 0x08); |
6406
|
0
|
|
|
|
|
0
|
$dumpEnd = $nextSegPos - 4; |
6407
|
|
|
|
|
|
|
} |
6408
|
|
|
|
|
|
|
} |
6409
|
|
|
|
|
|
|
# |
6410
|
|
|
|
|
|
|
# parse the current segment |
6411
|
|
|
|
|
|
|
# |
6412
|
|
|
|
|
|
|
# handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc) |
6413
|
1820
|
100
|
66
|
|
|
17670
|
if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
6414
|
229
|
|
|
|
|
599
|
$length = length $$segDataPt; |
6415
|
229
|
100
|
|
|
|
1108
|
if ($verbose) { |
|
|
50
|
|
|
|
|
|
6416
|
2
|
|
|
|
|
11
|
print $out "JPEG $markerName ($length bytes):\n"; |
6417
|
2
|
100
|
|
|
|
14
|
HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2; |
6418
|
|
|
|
|
|
|
} elsif ($htmlDump) { |
6419
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08); |
6420
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6421
|
|
|
|
|
|
|
} |
6422
|
229
|
50
|
|
|
|
878
|
next unless $length >= 6; |
6423
|
|
|
|
|
|
|
# extract some useful information |
6424
|
229
|
|
|
|
|
1071
|
my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt); |
6425
|
229
|
|
|
|
|
847
|
my $sof = GetTagTable('Image::ExifTool::JPEG::SOF'); |
6426
|
229
|
|
|
|
|
1347
|
$self->HandleTag($sof, 'ImageWidth', $w); |
6427
|
229
|
|
|
|
|
1043
|
$self->HandleTag($sof, 'ImageHeight', $h); |
6428
|
229
|
|
|
|
|
1338
|
$self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0); |
6429
|
229
|
|
|
|
|
1244
|
$self->HandleTag($sof, 'BitsPerSample', $p); |
6430
|
229
|
|
|
|
|
1185
|
$self->HandleTag($sof, 'ColorComponents', $n); |
6431
|
229
|
50
|
33
|
|
|
1977
|
next unless $n == 3 and $length >= 15; |
6432
|
229
|
|
|
|
|
603
|
my ($i, $hmin, $hmax, $vmin, $vmax); |
6433
|
|
|
|
|
|
|
# loop through all components to determine sampling frequency |
6434
|
229
|
|
|
|
|
607
|
$subSampling = ''; |
6435
|
229
|
|
|
|
|
1013
|
for ($i=0; $i<$n; ++$i) { |
6436
|
687
|
|
|
|
|
1781
|
my $sf = Get8u($segDataPt, 7 + 3 * $i); |
6437
|
687
|
|
|
|
|
2591
|
$subSampling .= sprintf('%.2x', $sf); |
6438
|
|
|
|
|
|
|
# isolate horizontal and vertical components |
6439
|
687
|
|
|
|
|
1736
|
my ($hf, $vf) = ($sf >> 4, $sf & 0x0f); |
6440
|
687
|
100
|
|
|
|
1682
|
unless ($i) { |
6441
|
229
|
|
|
|
|
577
|
$hmin = $hmax = $hf; |
6442
|
229
|
|
|
|
|
505
|
$vmin = $vmax = $vf; |
6443
|
229
|
|
|
|
|
687
|
next; |
6444
|
|
|
|
|
|
|
} |
6445
|
|
|
|
|
|
|
# determine min/max frequencies |
6446
|
458
|
100
|
|
|
|
1478
|
$hmin = $hf if $hf < $hmin; |
6447
|
458
|
50
|
|
|
|
1246
|
$hmax = $hf if $hf > $hmax; |
6448
|
458
|
100
|
|
|
|
1201
|
$vmin = $vf if $vf < $vmin; |
6449
|
458
|
50
|
|
|
|
1506
|
$vmax = $vf if $vf > $vmax; |
6450
|
|
|
|
|
|
|
} |
6451
|
229
|
50
|
33
|
|
|
1524
|
if ($hmin and $vmin) { |
6452
|
229
|
|
|
|
|
812
|
my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin); |
6453
|
229
|
|
|
|
|
2233
|
$self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs"); |
6454
|
|
|
|
|
|
|
} |
6455
|
229
|
|
|
|
|
908
|
next; |
6456
|
|
|
|
|
|
|
} elsif ($marker == 0xd9) { # EOI |
6457
|
3
|
|
|
|
|
13
|
pop @$path; |
6458
|
3
|
100
|
|
|
|
18
|
$verbose and print $out "JPEG EOI\n"; |
6459
|
3
|
|
|
|
|
19
|
my $pos = $raf->Tell(); |
6460
|
3
|
50
|
33
|
|
|
25
|
if ($htmlDump and $dumpEnd) { |
6461
|
0
|
|
|
|
|
0
|
$self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08); |
6462
|
0
|
|
|
|
|
0
|
$self->HDump($pos-2, 2, 'JPEG EOI', undef); |
6463
|
0
|
|
|
|
|
0
|
$dumpEnd = 0; |
6464
|
|
|
|
|
|
|
} |
6465
|
3
|
50
|
66
|
|
|
26
|
if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') { |
6466
|
3
|
|
|
|
|
12
|
$success = 1; |
6467
|
|
|
|
|
|
|
} else { |
6468
|
0
|
|
|
|
|
0
|
$self->Warn('Missing JPEG SOS'); |
6469
|
|
|
|
|
|
|
} |
6470
|
3
|
50
|
|
|
|
19
|
if ($$req{trailer}) { |
6471
|
|
|
|
|
|
|
# read entire trailer into memory |
6472
|
0
|
0
|
|
|
|
0
|
if ($raf->Seek(0,2)) { |
6473
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $pos; |
6474
|
0
|
0
|
|
|
|
0
|
if ($len) { |
6475
|
0
|
|
|
|
|
0
|
my $buff; |
6476
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6477
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len; |
6478
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6479
|
|
|
|
|
|
|
} |
6480
|
|
|
|
|
|
|
} else { |
6481
|
0
|
|
|
|
|
0
|
$self->Warn('Error seeking in file'); |
6482
|
|
|
|
|
|
|
} |
6483
|
|
|
|
|
|
|
} |
6484
|
|
|
|
|
|
|
# we are here because we are looking for trailer information |
6485
|
3
|
50
|
|
|
|
18
|
if ($wantTrailer) { |
6486
|
0
|
|
|
|
|
0
|
my $start = $$self{PreviewImageStart}; |
6487
|
0
|
0
|
0
|
|
|
0
|
if ($start or $$options{ExtractEmbedded}) { |
6488
|
0
|
|
|
|
|
0
|
my $buff; |
6489
|
|
|
|
|
|
|
# most previews start right after the JPEG EOI, but the Olympus E-20 |
6490
|
|
|
|
|
|
|
# preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is |
6491
|
|
|
|
|
|
|
# 979 bytes in, and Sony previews can start up to 32 kB into the trailer. |
6492
|
|
|
|
|
|
|
# (and Minolta and Sony previews can have a random first byte...) |
6493
|
0
|
0
|
|
|
|
0
|
my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024; |
6494
|
0
|
0
|
|
|
|
0
|
if ($raf->Read($buff, $scanLen)) { |
6495
|
0
|
0
|
0
|
|
|
0
|
if ($buff =~ /^.{4}ftyp/s) { |
|
|
0
|
0
|
|
|
|
|
6496
|
0
|
|
|
|
|
0
|
my $val; |
6497
|
0
|
0
|
|
|
|
0
|
if ($raf->Seek(0,2)) { |
6498
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $pos; |
6499
|
0
|
0
|
|
|
|
0
|
if ($$options{Binary}) { |
6500
|
0
|
0
|
0
|
|
|
0
|
$val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len; |
6501
|
|
|
|
|
|
|
} else { |
6502
|
0
|
|
|
|
|
0
|
$val = \ "Binary data $len bytes"; |
6503
|
|
|
|
|
|
|
} |
6504
|
0
|
0
|
|
|
|
0
|
if ($val) { |
6505
|
0
|
|
|
|
|
0
|
$self->FoundTag('EmbeddedVideo', $val); |
6506
|
|
|
|
|
|
|
} else { |
6507
|
0
|
|
|
|
|
0
|
$self->Warn('Error reading trailer'); |
6508
|
|
|
|
|
|
|
} |
6509
|
|
|
|
|
|
|
} else { |
6510
|
0
|
|
|
|
|
0
|
$self->Warn('Error seeking to end of file'); |
6511
|
|
|
|
|
|
|
} |
6512
|
|
|
|
|
|
|
} elsif ($buff =~ /\xff\xd8\xff./g or |
6513
|
|
|
|
|
|
|
($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)) |
6514
|
|
|
|
|
|
|
{ |
6515
|
|
|
|
|
|
|
# adjust PreviewImageStart to this location |
6516
|
0
|
|
|
|
|
0
|
my $actual = $pos + pos($buff) - 4; |
6517
|
0
|
0
|
0
|
|
|
0
|
if ($start and $start ne $actual and $verbose > 1) { |
|
|
|
0
|
|
|
|
|
6518
|
0
|
|
|
|
|
0
|
print $out "(Fixed PreviewImage location: $start -> $actual)\n"; |
6519
|
|
|
|
|
|
|
} |
6520
|
|
|
|
|
|
|
# update preview image offsets |
6521
|
0
|
0
|
|
|
|
0
|
if ($start) { |
6522
|
0
|
0
|
|
|
|
0
|
$$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart}; |
6523
|
0
|
|
|
|
|
0
|
$$self{PreviewImageStart} = $actual; |
6524
|
|
|
|
|
|
|
} |
6525
|
|
|
|
|
|
|
# load preview now if we tried and failed earlier |
6526
|
0
|
0
|
0
|
|
|
0
|
if ($$self{PreviewError} and $$self{PreviewImageLength}) { |
6527
|
0
|
0
|
0
|
|
|
0
|
if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) { |
6528
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $buff); |
6529
|
0
|
|
|
|
|
0
|
delete $$self{PreviewError}; |
6530
|
|
|
|
|
|
|
} |
6531
|
|
|
|
|
|
|
} |
6532
|
|
|
|
|
|
|
} |
6533
|
|
|
|
|
|
|
} |
6534
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6535
|
|
|
|
|
|
|
} |
6536
|
|
|
|
|
|
|
} |
6537
|
|
|
|
|
|
|
# process trailer now or finish processing trailers |
6538
|
|
|
|
|
|
|
# and scan for AFCP if necessary |
6539
|
3
|
|
|
|
|
10
|
my $fromEnd = 0; |
6540
|
3
|
50
|
|
|
|
15
|
if ($trailInfo) { |
6541
|
0
|
|
|
|
|
0
|
$$trailInfo{ScanForAFCP} = 1; # scan now if necessary |
6542
|
0
|
|
|
|
|
0
|
$self->ProcessTrailers($trailInfo); |
6543
|
|
|
|
|
|
|
# save offset from end of file to start of first trailer |
6544
|
0
|
|
|
|
|
0
|
$fromEnd = $$trailInfo{Offset}; |
6545
|
0
|
|
|
|
|
0
|
undef $trailInfo; |
6546
|
|
|
|
|
|
|
} |
6547
|
3
|
50
|
|
|
|
15
|
if ($$self{LeicaTrailer}) { |
6548
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); |
6549
|
0
|
|
|
|
|
0
|
$$self{LeicaTrailer}{TrailPos} = $pos; |
6550
|
0
|
|
|
|
|
0
|
$$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd; |
6551
|
0
|
|
|
|
|
0
|
Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); |
6552
|
|
|
|
|
|
|
} |
6553
|
|
|
|
|
|
|
# finally, dump remaining information in JPEG trailer |
6554
|
3
|
100
|
66
|
|
|
26
|
if ($verbose or $htmlDump) { |
6555
|
1
|
|
|
|
|
4
|
my $endPos = $$self{LeicaTrailerPos}; |
6556
|
1
|
50
|
|
|
|
3
|
unless ($endPos) { |
6557
|
1
|
|
|
|
|
4
|
$raf->Seek(0, 2); |
6558
|
1
|
|
|
|
|
4
|
$endPos = $raf->Tell() - $fromEnd; |
6559
|
|
|
|
|
|
|
} |
6560
|
|
|
|
|
|
|
$self->DumpUnknownTrailer({ |
6561
|
1
|
50
|
|
|
|
4
|
RAF => $raf, |
6562
|
|
|
|
|
|
|
DataPos => $pos, |
6563
|
|
|
|
|
|
|
DirLen => $endPos - $pos |
6564
|
|
|
|
|
|
|
}) if $endPos > $pos; |
6565
|
|
|
|
|
|
|
} |
6566
|
3
|
50
|
|
|
|
15
|
$self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen; |
6567
|
3
|
|
|
|
|
8
|
last; # all done parsing file |
6568
|
|
|
|
|
|
|
} elsif ($marker == 0xda) { # SOS |
6569
|
229
|
|
|
|
|
1106
|
pop @$path; |
6570
|
229
|
|
|
|
|
619
|
$foundSOS = 1; |
6571
|
|
|
|
|
|
|
# all done with meta information unless we have a trailer |
6572
|
229
|
100
|
|
|
|
858
|
$verbose and print $out "JPEG SOS\n"; |
6573
|
229
|
100
|
|
|
|
986
|
unless ($fast) { |
6574
|
228
|
|
|
|
|
946
|
$trailInfo = IdentifyTrailer($raf); |
6575
|
|
|
|
|
|
|
# process trailer now unless we are doing verbose dump |
6576
|
228
|
50
|
66
|
|
|
1452
|
if ($trailInfo and $verbose < 3 and not $htmlDump) { |
|
|
|
66
|
|
|
|
|
6577
|
|
|
|
|
|
|
# process trailers (keep trailInfo to finish processing later |
6578
|
|
|
|
|
|
|
# only if we can't finish without scanning from end of file) |
6579
|
28
|
50
|
|
|
|
166
|
$self->ProcessTrailers($trailInfo) and undef $trailInfo; |
6580
|
|
|
|
|
|
|
} |
6581
|
228
|
0
|
33
|
|
|
921
|
if ($wantTrailer and $$self{PreviewImageStart}) { |
6582
|
|
|
|
|
|
|
# seek ahead and validate preview image |
6583
|
0
|
|
|
|
|
0
|
my $buff; |
6584
|
0
|
|
|
|
|
0
|
my $curPos = $raf->Tell(); |
6585
|
0
|
0
|
0
|
|
|
0
|
if ($raf->Seek($$self{PreviewImageStart}, 0) and |
|
|
|
0
|
|
|
|
|
6586
|
|
|
|
|
|
|
$raf->Read($buff, 4) == 4 and |
6587
|
|
|
|
|
|
|
$buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/) |
6588
|
|
|
|
|
|
|
{ |
6589
|
0
|
|
|
|
|
0
|
undef $wantTrailer; |
6590
|
|
|
|
|
|
|
} |
6591
|
0
|
0
|
|
|
|
0
|
$raf->Seek($curPos, 0) or last; |
6592
|
|
|
|
|
|
|
} |
6593
|
|
|
|
|
|
|
# seek ahead and process Leica trailer |
6594
|
228
|
50
|
|
|
|
940
|
if ($$self{LeicaTrailer}) { |
6595
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Panasonic; |
6596
|
0
|
|
|
|
|
0
|
Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); |
6597
|
0
|
0
|
|
|
|
0
|
$wantTrailer = 1 if $$self{LeicaTrailer}; |
6598
|
|
|
|
|
|
|
} else { |
6599
|
228
|
50
|
|
|
|
889
|
$wantTrailer = 1 if $$options{ExtractEmbedded}; |
6600
|
|
|
|
|
|
|
} |
6601
|
228
|
100
|
33
|
|
|
2522
|
next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump; |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
6602
|
|
|
|
|
|
|
} |
6603
|
|
|
|
|
|
|
# must scan to EOI if Validate or JpegCompressionFactor used |
6604
|
228
|
50
|
33
|
|
|
1925
|
next if $$options{Validate} or $calcImageLen or $$req{trailer}; |
|
|
|
33
|
|
|
|
|
6605
|
|
|
|
|
|
|
# nothing interesting to parse after start of scan (SOS) |
6606
|
228
|
|
|
|
|
547
|
$success = 1; |
6607
|
228
|
|
|
|
|
607
|
last; # all done parsing file |
6608
|
|
|
|
|
|
|
} elsif ($marker == 0x93) { |
6609
|
1
|
|
|
|
|
2
|
pop @$path; |
6610
|
1
|
50
|
|
|
|
5
|
$verbose and print $out "JPEG SOD\n"; |
6611
|
1
|
|
|
|
|
3
|
$success = 1; |
6612
|
1
|
50
|
33
|
|
|
12
|
next if $verbose > 2 or $htmlDump; |
6613
|
1
|
|
|
|
|
3
|
last; # all done parsing file |
6614
|
|
|
|
|
|
|
} elsif (defined $markerLenBytes{$marker}) { |
6615
|
|
|
|
|
|
|
# handle other stand-alone markers and segments we skipped over |
6616
|
0
|
0
|
0
|
|
|
0
|
$verbose and $marker and print $out "JPEG $markerName\n"; |
6617
|
0
|
|
|
|
|
0
|
next; |
6618
|
|
|
|
|
|
|
} elsif ($marker == 0xdb and length($$segDataPt) and # DQT |
6619
|
|
|
|
|
|
|
# save the DQT data only if JPEGDigest has been requested |
6620
|
|
|
|
|
|
|
# (Note: since we aren't checking the API RequestAll option here, the application |
6621
|
|
|
|
|
|
|
# must use the RequestTags option to generate these tags if they have not been |
6622
|
|
|
|
|
|
|
# specifically requested. The reason is that there is too much overhead involved |
6623
|
|
|
|
|
|
|
# in the calculation of this tag to make this worth the CPU time.) |
6624
|
|
|
|
|
|
|
($$req{jpegdigest} or $$req{jpegqualityestimate} |
6625
|
|
|
|
|
|
|
or ($$options{RequestAll} and $$options{RequestAll} > 2))) |
6626
|
|
|
|
|
|
|
{ |
6627
|
1
|
|
|
|
|
4
|
my $num = unpack('C',$$segDataPt) & 0x0f; # get table index |
6628
|
1
|
50
|
|
|
|
5
|
$dqt[$num] = $$segDataPt if $num < 4; # save for MD5 calculation |
6629
|
|
|
|
|
|
|
} |
6630
|
|
|
|
|
|
|
# handle all other markers |
6631
|
1358
|
|
|
|
|
2633
|
my $dumpType = ''; |
6632
|
1358
|
|
|
|
|
2315
|
my ($desc, $tip, $xtra); |
6633
|
1358
|
|
|
|
|
2384
|
$length = length $$segDataPt; |
6634
|
1358
|
100
|
|
|
|
3784
|
$appBytes += $length + 4 if ($marker & 0xf0) == 0xe0; # total size of APP segments |
6635
|
1358
|
100
|
|
|
|
3142
|
if ($verbose) { |
6636
|
6
|
|
|
|
|
30
|
print $out "JPEG $markerName ($length bytes):\n"; |
6637
|
6
|
100
|
|
|
|
20
|
if ($verbose > 2) { |
6638
|
3
|
|
|
|
|
10
|
my %extraParms = ( Addr => $segPos ); |
6639
|
3
|
50
|
|
|
|
11
|
$extraParms{MaxLen} = 128 if $verbose == 4; |
6640
|
3
|
|
|
|
|
18
|
HexDump($segDataPt, undef, %dumpParms, %extraParms); |
6641
|
|
|
|
|
|
|
} |
6642
|
|
|
|
|
|
|
} |
6643
|
|
|
|
|
|
|
# prepare dirInfo hash for processing this information |
6644
|
1358
|
|
|
|
|
8133
|
my %dirInfo = ( |
6645
|
|
|
|
|
|
|
Parent => $markerName, |
6646
|
|
|
|
|
|
|
DataPt => $segDataPt, |
6647
|
|
|
|
|
|
|
DataPos => $segPos, |
6648
|
|
|
|
|
|
|
DataLen => $length, |
6649
|
|
|
|
|
|
|
DirStart => 0, |
6650
|
|
|
|
|
|
|
DirLen => $length, |
6651
|
|
|
|
|
|
|
Base => 0, |
6652
|
|
|
|
|
|
|
); |
6653
|
1358
|
100
|
|
|
|
16172
|
if ($marker == 0xe0) { # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6654
|
106
|
100
|
|
|
|
1166
|
if ($$segDataPt =~ /^JFIF\0/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6655
|
49
|
|
|
|
|
133
|
$dumpType = 'JFIF'; |
6656
|
49
|
|
|
|
|
234
|
DirStart(\%dirInfo, 5); # start at byte 5 |
6657
|
49
|
|
|
|
|
209
|
SetByteOrder('MM'); |
6658
|
49
|
|
|
|
|
228
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main'); |
6659
|
49
|
|
|
|
|
317
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6660
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) { |
6661
|
19
|
|
|
|
|
85
|
my $tag = ord $1; |
6662
|
19
|
|
|
|
|
63
|
$dumpType = 'JFXX'; |
6663
|
19
|
|
|
|
|
72
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension'); |
6664
|
19
|
|
|
|
|
124
|
my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag); |
6665
|
19
|
|
|
|
|
118
|
$self->FoundTag($tagInfo, substr($$segDataPt, 6)); |
6666
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) { |
6667
|
19
|
50
|
|
|
|
89
|
next if $fast > 1; # skip processing for very fast |
6668
|
19
|
|
|
|
|
49
|
$dumpType = 'CIFF'; |
6669
|
19
|
|
|
|
|
115
|
my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) ); |
6670
|
19
|
|
|
|
|
96
|
$$self{SET_GROUP1} = 'CIFF'; |
6671
|
19
|
|
|
|
|
47
|
push @{$$self{PATH}}, 'CIFF'; |
|
19
|
|
|
|
|
76
|
|
6672
|
19
|
|
|
|
|
1489
|
require Image::ExifTool::CanonRaw; |
6673
|
19
|
|
|
|
|
156
|
Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo); |
6674
|
19
|
|
|
|
|
58
|
pop @{$$self{PATH}}; |
|
19
|
|
|
|
|
71
|
|
6675
|
19
|
|
|
|
|
109
|
delete $$self{SET_GROUP1}; |
6676
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(AVI1|Ocad)/) { |
6677
|
19
|
|
|
|
|
81
|
$dumpType = $1; |
6678
|
19
|
|
|
|
|
88
|
SetByteOrder('MM'); |
6679
|
19
|
|
|
|
|
148
|
my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType"); |
6680
|
19
|
|
|
|
|
102
|
DirStart(\%dirInfo, 4); |
6681
|
19
|
|
|
|
|
90
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6682
|
|
|
|
|
|
|
} |
6683
|
|
|
|
|
|
|
} elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI, PARROT) |
6684
|
|
|
|
|
|
|
# (some Kodak cameras don't put a second "\0", and I have seen an |
6685
|
|
|
|
|
|
|
# example where there was a second 4-byte APP1 segment header) |
6686
|
259
|
100
|
66
|
|
|
3184
|
if ($$segDataPt =~ /^(.{0,4})Exif\0/is) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6687
|
187
|
|
|
|
|
473
|
undef $dumpType; # (will be dumped here) |
6688
|
|
|
|
|
|
|
# this is EXIF data -- |
6689
|
|
|
|
|
|
|
# get the data block (into a common variable) |
6690
|
187
|
|
|
|
|
503
|
my $hdrLen = length($exifAPP1hdr); |
6691
|
187
|
50
|
|
|
|
1443
|
if (length $1) { |
|
|
50
|
|
|
|
|
|
6692
|
0
|
|
|
|
|
0
|
$hdrLen += length $1; |
6693
|
0
|
|
|
|
|
0
|
$self->Warn('Unknown garbage at start of EXIF segment',1); |
6694
|
|
|
|
|
|
|
} elsif ($$segDataPt !~ /^Exif\0/) { |
6695
|
0
|
|
|
|
|
0
|
$self->Warn('Incorrect EXIF segment identifier',1); |
6696
|
|
|
|
|
|
|
} |
6697
|
187
|
50
|
|
|
|
692
|
if ($htmlDump) { |
6698
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes"); |
6699
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif'); |
6700
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6701
|
|
|
|
|
|
|
} |
6702
|
187
|
|
|
|
|
413
|
my $dataPt = $segDataPt; |
6703
|
187
|
50
|
|
|
|
667
|
if (defined $combinedSegData) { |
6704
|
0
|
|
|
|
|
0
|
push @skipData, [ $segPos-4, $segPos+$hdrLen ]; |
6705
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,$hdrLen); |
6706
|
0
|
|
|
|
|
0
|
undef $$segDataPt; |
6707
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
6708
|
0
|
|
|
|
|
0
|
$segPos = $firstSegPos; |
6709
|
|
|
|
|
|
|
} |
6710
|
|
|
|
|
|
|
# peek ahead to see if the next segment is extended EXIF |
6711
|
187
|
50
|
66
|
|
|
1301
|
if ($nextMarker == $marker and |
6712
|
|
|
|
|
|
|
$$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/) |
6713
|
|
|
|
|
|
|
{ |
6714
|
|
|
|
|
|
|
# initialize combined data if necessary |
6715
|
0
|
0
|
|
|
|
0
|
unless (defined $combinedSegData) { |
6716
|
0
|
|
|
|
|
0
|
$combinedSegData = $$segDataPt; |
6717
|
0
|
|
|
|
|
0
|
undef $$segDataPt; |
6718
|
0
|
|
|
|
|
0
|
$firstSegPos = $segPos; |
6719
|
0
|
|
|
|
|
0
|
$self->Warn('File contains multi-segment EXIF',1); |
6720
|
0
|
|
|
|
|
0
|
$$self{ExtendedEXIF} = 1; |
6721
|
|
|
|
|
|
|
} |
6722
|
0
|
|
|
|
|
0
|
next; |
6723
|
|
|
|
|
|
|
} |
6724
|
187
|
|
|
|
|
581
|
$dirInfo{DataPt} = $dataPt; |
6725
|
187
|
|
|
|
|
491
|
$dirInfo{DataPos} = $segPos; |
6726
|
187
|
|
|
|
|
573
|
$dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt; |
6727
|
187
|
|
|
|
|
860
|
DirStart(\%dirInfo, $hdrLen, $hdrLen); |
6728
|
187
|
50
|
|
|
|
671
|
$$self{SkipData} = \@skipData if @skipData; |
6729
|
|
|
|
|
|
|
# extract the EXIF information (it is in standard TIFF format) |
6730
|
187
|
50
|
|
|
|
1815
|
$self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment'); |
6731
|
|
|
|
|
|
|
# avoid looking for preview unless necessary because it really slows |
6732
|
|
|
|
|
|
|
# us down -- only look for it if we found pointer, and preview is |
6733
|
|
|
|
|
|
|
# outside EXIF, and PreviewImage is specifically requested |
6734
|
187
|
|
|
|
|
983
|
my $start = $self->GetValue('PreviewImageStart', 'ValueConv'); |
6735
|
187
|
|
|
|
|
705
|
my $plen = $self->GetValue('PreviewImageLength', 'ValueConv'); |
6736
|
187
|
100
|
66
|
|
|
1280
|
if (not $start or not $plen and $$self{PreviewError}) { |
|
|
|
66
|
|
|
|
|
6737
|
171
|
|
|
|
|
424
|
$start = $$self{PreviewImageStart}; |
6738
|
171
|
|
|
|
|
463
|
$plen = $$self{PreviewImageLength}; |
6739
|
|
|
|
|
|
|
} |
6740
|
187
|
0
|
100
|
|
|
821
|
if ($start and $plen and IsInt($start) and IsInt($plen) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
6741
|
|
|
|
|
|
|
$start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and |
6742
|
|
|
|
|
|
|
($$req{previewimage} or |
6743
|
|
|
|
|
|
|
# (extracted normally, so check Binary option) |
6744
|
|
|
|
|
|
|
($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage}))) |
6745
|
|
|
|
|
|
|
{ |
6746
|
0
|
|
|
|
|
0
|
$$self{PreviewImageStart} = $start; |
6747
|
0
|
|
|
|
|
0
|
$$self{PreviewImageLength} = $plen; |
6748
|
0
|
|
|
|
|
0
|
$wantTrailer = 1; |
6749
|
|
|
|
|
|
|
} |
6750
|
187
|
50
|
|
|
|
747
|
if (@skipData) { |
6751
|
0
|
|
|
|
|
0
|
undef @skipData; |
6752
|
0
|
|
|
|
|
0
|
delete $$self{SkipData}; |
6753
|
|
|
|
|
|
|
} |
6754
|
187
|
|
|
|
|
483
|
undef $$dataPt; |
6755
|
187
|
|
|
|
|
905
|
next; |
6756
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) { |
6757
|
|
|
|
|
|
|
# off len -- extended XMP header (75 bytes total): |
6758
|
|
|
|
|
|
|
# 0 35 bytes - signature |
6759
|
|
|
|
|
|
|
# 35 32 bytes - GUID (MD5 hash of full extended XMP data in ASCII) |
6760
|
|
|
|
|
|
|
# 67 4 bytes - total size of extended XMP data |
6761
|
|
|
|
|
|
|
# 71 4 bytes - offset for this XMP data portion |
6762
|
2
|
|
|
|
|
6
|
$dumpType = 'Extended XMP'; |
6763
|
2
|
50
|
|
|
|
9
|
if ($length > 75) { |
6764
|
2
|
|
|
|
|
13
|
my ($size, $off) = unpack('x67N2', $$segDataPt); |
6765
|
2
|
|
|
|
|
7
|
my $guid = substr($$segDataPt, 35, 32); |
6766
|
2
|
50
|
|
|
|
9
|
if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase) |
6767
|
0
|
|
|
|
|
0
|
$self->WarnOnce($tip = 'Invalid extended XMP GUID'); |
6768
|
|
|
|
|
|
|
} else { |
6769
|
2
|
|
|
|
|
6
|
my $extXMP = $extendedXMP{$guid}; |
6770
|
2
|
100
|
|
|
|
15
|
if (not $extXMP) { |
|
|
50
|
|
|
|
|
|
6771
|
1
|
|
|
|
|
6
|
$extXMP = $extendedXMP{$guid} = { }; |
6772
|
|
|
|
|
|
|
} elsif ($size != $$extXMP{Size}) { |
6773
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Inconsistent extended XMP size'); |
6774
|
|
|
|
|
|
|
} |
6775
|
2
|
|
|
|
|
6
|
$$extXMP{Size} = $size; |
6776
|
2
|
|
|
|
|
8
|
$$extXMP{$off} = substr($$segDataPt, 75); |
6777
|
2
|
|
|
|
|
15
|
$tip = "Full length: $size\nChunk offset: $off\nChunk length: " . |
6778
|
|
|
|
|
|
|
($length - 75) . "\nGUID: $guid"; |
6779
|
|
|
|
|
|
|
# (delay processing extended XMP until after reading all segments) |
6780
|
|
|
|
|
|
|
} |
6781
|
|
|
|
|
|
|
} else { |
6782
|
0
|
|
|
|
|
0
|
$self->WarnOnce($tip = 'Invalid extended XMP segment'); |
6783
|
|
|
|
|
|
|
} |
6784
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^QVCI\0/) { |
6785
|
1
|
|
|
|
|
3
|
$dumpType = 'QVCI'; |
6786
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI'); |
6787
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6788
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) { |
6789
|
1
|
|
|
|
|
4
|
$dumpType = 'FLIR'; |
6790
|
|
|
|
|
|
|
# must concatenate FLIR chunks (note: handle the case where |
6791
|
|
|
|
|
|
|
# some software erroneously writes zeros for the chunk counts) |
6792
|
1
|
|
|
|
|
3
|
my $chunkNum = Get8u($segDataPt, 6); |
6793
|
1
|
|
|
|
|
3
|
my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!) |
6794
|
1
|
50
|
|
|
|
4
|
$verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n", |
6795
|
|
|
|
|
|
|
$chunkNum + 1, $chunksTot; |
6796
|
1
|
50
|
|
|
|
4
|
if (defined $flirTotal) { |
6797
|
|
|
|
|
|
|
# abort parsing FLIR if the total chunk count is inconsistent |
6798
|
0
|
0
|
|
|
|
0
|
undef $flirCount if $chunksTot != $flirTotal; |
6799
|
|
|
|
|
|
|
} else { |
6800
|
1
|
|
|
|
|
2
|
$flirCount = 0; |
6801
|
1
|
|
|
|
|
3
|
$flirTotal = $chunksTot; |
6802
|
|
|
|
|
|
|
} |
6803
|
1
|
50
|
|
|
|
3
|
if (defined $flirCount) { |
6804
|
1
|
50
|
|
|
|
19
|
if (defined $flirChunk[$chunkNum]) { |
6805
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Duplicate FLIR chunk number(s)'); |
6806
|
0
|
|
|
|
|
0
|
$flirChunk[$chunkNum] .= substr($$segDataPt, 8); |
6807
|
|
|
|
|
|
|
} else { |
6808
|
1
|
|
|
|
|
14
|
$flirChunk[$chunkNum] = substr($$segDataPt, 8); |
6809
|
|
|
|
|
|
|
} |
6810
|
|
|
|
|
|
|
# process the FLIR information if we have all of the chunks |
6811
|
1
|
50
|
|
|
|
4
|
if (++$flirCount >= $flirTotal) { |
6812
|
1
|
|
|
|
|
2
|
my $flir = ''; |
6813
|
1
|
|
33
|
|
|
12
|
defined $_ and $flir .= $_ foreach @flirChunk; |
6814
|
1
|
|
|
|
|
4
|
undef @flirChunk; # free memory |
6815
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF'); |
6816
|
1
|
|
|
|
|
8
|
my %dirInfo = ( |
6817
|
|
|
|
|
|
|
DataPt => \$flir, |
6818
|
|
|
|
|
|
|
Parent => $markerName, |
6819
|
|
|
|
|
|
|
DirName => 'FLIR', |
6820
|
|
|
|
|
|
|
); |
6821
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6822
|
1
|
|
|
|
|
6
|
undef $flirCount; # prevent reprocessing |
6823
|
|
|
|
|
|
|
} |
6824
|
|
|
|
|
|
|
} else { |
6825
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Invalid or extraneous FLIR chunk(s)'); |
6826
|
|
|
|
|
|
|
} |
6827
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) { |
6828
|
|
|
|
|
|
|
# (don't know if this could span multiple segments) |
6829
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6830
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP1', $$segDataPt); |
6831
|
0
|
|
|
|
|
0
|
$dumpType = 'Parrot'; |
6832
|
|
|
|
|
|
|
} else { |
6833
|
|
|
|
|
|
|
# Hmmm. Could be XMP, let's see |
6834
|
68
|
|
|
|
|
196
|
my $processed; |
6835
|
68
|
50
|
33
|
|
|
540
|
if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) { |
6836
|
68
|
|
|
|
|
181
|
$dumpType = 'XMP'; |
6837
|
|
|
|
|
|
|
# also try to parse XMP with a non-standard header |
6838
|
|
|
|
|
|
|
# (note: this non-standard XMP is ignored when writing) |
6839
|
68
|
50
|
|
|
|
714
|
my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0; |
6840
|
68
|
|
|
|
|
307
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
6841
|
68
|
|
|
|
|
391
|
DirStart(\%dirInfo, $start); |
6842
|
68
|
50
|
|
|
|
592
|
$dirInfo{DirName} = $start ? 'XMP' : 'XML', |
6843
|
|
|
|
|
|
|
$processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6844
|
68
|
50
|
33
|
|
|
601
|
if ($processed and not $start) { |
6845
|
0
|
|
|
|
|
0
|
$self->Warn('Non-standard header for APP1 XMP segment'); |
6846
|
|
|
|
|
|
|
} |
6847
|
|
|
|
|
|
|
} |
6848
|
68
|
50
|
33
|
|
|
365
|
if ($verbose and not $processed) { |
6849
|
0
|
|
|
|
|
0
|
$self->Warn("Ignored APP1 segment length $length (unknown header)"); |
6850
|
|
|
|
|
|
|
} |
6851
|
|
|
|
|
|
|
} |
6852
|
|
|
|
|
|
|
} elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR, MPF, PreviewImage) |
6853
|
120
|
100
|
66
|
|
|
1085
|
if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6854
|
34
|
|
|
|
|
108
|
$dumpType = 'ICC_Profile'; |
6855
|
|
|
|
|
|
|
# must concatenate profile chunks (note: handle the case where |
6856
|
|
|
|
|
|
|
# some software erroneously writes zeros for the chunk counts) |
6857
|
34
|
|
|
|
|
168
|
my $chunkNum = Get8u($segDataPt, 12); |
6858
|
34
|
|
|
|
|
133
|
my $chunksTot = Get8u($segDataPt, 13); |
6859
|
34
|
50
|
|
|
|
192
|
$verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n"; |
6860
|
34
|
50
|
|
|
|
119
|
if (defined $iccChunksTotal) { |
6861
|
|
|
|
|
|
|
# abort parsing ICC_Profile if the total chunk count is inconsistent |
6862
|
0
|
0
|
|
|
|
0
|
undef $iccChunkCount if $chunksTot != $iccChunksTotal; |
6863
|
|
|
|
|
|
|
} else { |
6864
|
34
|
|
|
|
|
76
|
$iccChunkCount = 0; |
6865
|
34
|
|
|
|
|
73
|
$iccChunksTotal = $chunksTot; |
6866
|
34
|
50
|
|
|
|
119
|
$self->Warn('ICC_Profile chunk count is zero') if !$chunksTot; |
6867
|
|
|
|
|
|
|
} |
6868
|
34
|
50
|
|
|
|
129
|
if (defined $iccChunkCount) { |
6869
|
34
|
50
|
|
|
|
142
|
if (defined $iccChunk[$chunkNum]) { |
6870
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Duplicate ICC_Profile chunk number(s)'); |
6871
|
0
|
|
|
|
|
0
|
$iccChunk[$chunkNum] .= substr($$segDataPt, 14); |
6872
|
|
|
|
|
|
|
} else { |
6873
|
34
|
|
|
|
|
228
|
$iccChunk[$chunkNum] = substr($$segDataPt, 14); |
6874
|
|
|
|
|
|
|
} |
6875
|
|
|
|
|
|
|
# process profile if we have all of the chunks |
6876
|
34
|
50
|
|
|
|
162
|
if (++$iccChunkCount >= $iccChunksTotal) { |
6877
|
34
|
|
|
|
|
80
|
my $icc_profile = ''; |
6878
|
34
|
|
66
|
|
|
298
|
defined $_ and $icc_profile .= $_ foreach @iccChunk; |
6879
|
34
|
|
|
|
|
105
|
undef @iccChunk; # free memory |
6880
|
34
|
|
|
|
|
122
|
my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main'); |
6881
|
34
|
|
|
|
|
310
|
my %dirInfo = ( |
6882
|
|
|
|
|
|
|
DataPt => \$icc_profile, |
6883
|
|
|
|
|
|
|
DataPos => $segPos + 14, |
6884
|
|
|
|
|
|
|
DataLen => length($icc_profile), |
6885
|
|
|
|
|
|
|
DirStart => 0, |
6886
|
|
|
|
|
|
|
DirLen => length($icc_profile), |
6887
|
|
|
|
|
|
|
Parent => $markerName, |
6888
|
|
|
|
|
|
|
); |
6889
|
34
|
|
|
|
|
192
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6890
|
34
|
|
|
|
|
177
|
undef $iccChunkCount; # prevent reprocessing |
6891
|
|
|
|
|
|
|
} |
6892
|
|
|
|
|
|
|
} else { |
6893
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)'); |
6894
|
|
|
|
|
|
|
} |
6895
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FPXR\0/) { |
6896
|
67
|
50
|
|
|
|
213
|
next if $fast > 1; # skip processing for very fast |
6897
|
67
|
|
|
|
|
130
|
$dumpType = 'FPXR'; |
6898
|
67
|
|
|
|
|
207
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); |
6899
|
|
|
|
|
|
|
# set flag if this is the last FPXR segment |
6900
|
67
|
|
100
|
|
|
583
|
$dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), |
6901
|
|
|
|
|
|
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6902
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^MPF\0/) { |
6903
|
19
|
|
|
|
|
59
|
undef $dumpType; # (will be dumped here) |
6904
|
19
|
|
|
|
|
89
|
DirStart(\%dirInfo, 4, 4); |
6905
|
19
|
|
|
|
|
59
|
$dirInfo{Multi} = 1; # the MP Attribute IFD will be MPF1 |
6906
|
19
|
50
|
|
|
|
72
|
if ($htmlDump) { |
6907
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes"); |
6908
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF'); |
6909
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6910
|
|
|
|
|
|
|
} |
6911
|
|
|
|
|
|
|
# extract the MPF information (it is in standard TIFF format) |
6912
|
19
|
|
|
|
|
74
|
my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main'); |
6913
|
19
|
|
|
|
|
128
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6914
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) { |
6915
|
|
|
|
|
|
|
# Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0", |
6916
|
|
|
|
|
|
|
# Digilife DDC-690/Rollei="BGTH" |
6917
|
0
|
|
|
|
|
0
|
$dumpType = 'Preview Image'; |
6918
|
0
|
|
|
|
|
0
|
$preview = substr($$segDataPt, length($1)); |
6919
|
|
|
|
|
|
|
} elsif ($preview) { |
6920
|
0
|
|
|
|
|
0
|
$dumpType = 'Preview Image'; |
6921
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
6922
|
|
|
|
|
|
|
} |
6923
|
120
|
50
|
33
|
|
|
429
|
if ($preview and $nextMarker ne $marker) { |
6924
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
6925
|
0
|
|
|
|
|
0
|
undef $preview; |
6926
|
|
|
|
|
|
|
} |
6927
|
|
|
|
|
|
|
} elsif ($marker == 0xe3) { # APP3 (Kodak "Meta", Stim) |
6928
|
20
|
100
|
|
|
|
218
|
if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6929
|
19
|
|
|
|
|
53
|
undef $dumpType; # (will be dumped here) |
6930
|
19
|
|
|
|
|
91
|
DirStart(\%dirInfo, 6, 6); |
6931
|
19
|
50
|
|
|
|
100
|
if ($htmlDump) { |
6932
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 10, 'APP3 Meta header'); |
6933
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6934
|
|
|
|
|
|
|
} |
6935
|
19
|
|
|
|
|
72
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta'); |
6936
|
19
|
|
|
|
|
111
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6937
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^Stim\0/) { |
6938
|
0
|
|
|
|
|
0
|
undef $dumpType; # (will be dumped here) |
6939
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 6, 6); |
6940
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
6941
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes"); |
6942
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim'); |
6943
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6944
|
|
|
|
|
|
|
} |
6945
|
|
|
|
|
|
|
# extract the Stim information (it is in standard TIFF format) |
6946
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main'); |
6947
|
0
|
|
|
|
|
0
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6948
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^_JPSJPS_/) { |
6949
|
1
|
|
|
|
|
4
|
$dumpType = 'JPS'; |
6950
|
1
|
50
|
|
|
|
11
|
$self->OverrideFileType('JPS') if $$self{FILE_TYPE} eq 'JPEG'; |
6951
|
1
|
|
|
|
|
5
|
SetByteOrder('MM'); |
6952
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::JPS'); |
6953
|
1
|
|
|
|
|
6
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6954
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI') { |
6955
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalData'; |
6956
|
|
|
|
|
|
|
# add this data to the combined data if it exists |
6957
|
0
|
|
|
|
|
0
|
my $dataPt = $segDataPt; |
6958
|
0
|
0
|
|
|
|
0
|
if (defined $combinedSegData) { |
6959
|
0
|
|
|
|
|
0
|
$combinedSegData .= $$segDataPt; |
6960
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
6961
|
|
|
|
|
|
|
} |
6962
|
0
|
0
|
|
|
|
0
|
if ($nextMarker == $marker) { |
6963
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
6964
|
|
|
|
|
|
|
} else { |
6965
|
|
|
|
|
|
|
# process DJI FLIR thermal data |
6966
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6967
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP3', $$dataPt); |
6968
|
0
|
|
|
|
|
0
|
undef $combinedSegData; |
6969
|
|
|
|
|
|
|
} |
6970
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) { |
6971
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; # (Samsung, HP, BenQ) |
6972
|
0
|
|
|
|
|
0
|
$preview = $$segDataPt; |
6973
|
|
|
|
|
|
|
} |
6974
|
20
|
50
|
33
|
|
|
149
|
if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4 |
6975
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
6976
|
0
|
|
|
|
|
0
|
undef $preview; |
6977
|
|
|
|
|
|
|
} |
6978
|
|
|
|
|
|
|
} elsif ($marker == 0xe4) { # APP4 ("SCALADO", FPXR, PreviewImage) |
6979
|
0
|
0
|
0
|
|
|
0
|
if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6980
|
0
|
|
|
|
|
0
|
$dumpType = 'SCALADO'; |
6981
|
0
|
|
|
|
|
0
|
my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt); |
6982
|
|
|
|
|
|
|
# assume that the segments are in order and just concatinate them |
6983
|
0
|
0
|
|
|
|
0
|
$scalado = '' unless defined $scalado; |
6984
|
0
|
|
|
|
|
0
|
$scalado .= substr($$segDataPt, 16); |
6985
|
0
|
0
|
|
|
|
0
|
if ($idx == $num - 1) { |
6986
|
0
|
0
|
|
|
|
0
|
if ($len != length $scalado) { |
6987
|
0
|
|
|
|
|
0
|
$self->Warn('Possibly corrupted APP4 SCALADO data', 1); |
6988
|
|
|
|
|
|
|
} |
6989
|
0
|
|
|
|
|
0
|
my %dirInfo = ( |
6990
|
|
|
|
|
|
|
Parent => $markerName, |
6991
|
|
|
|
|
|
|
DataPt => \$scalado, |
6992
|
|
|
|
|
|
|
); |
6993
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main'); |
6994
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6995
|
0
|
|
|
|
|
0
|
undef $scalado; |
6996
|
|
|
|
|
|
|
} |
6997
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FPXR\0/) { |
6998
|
0
|
0
|
|
|
|
0
|
next if $fast > 1; # skip processing for very fast |
6999
|
0
|
|
|
|
|
0
|
$dumpType = 'FPXR'; |
7000
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); |
7001
|
|
|
|
|
|
|
# set flag if this is the last FPXR segment |
7002
|
0
|
|
0
|
|
|
0
|
$dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), |
7003
|
|
|
|
|
|
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7004
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^\xaa\x55\x12\x06/) { |
7005
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalParams'; |
7006
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 0, 0); |
7007
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams'); |
7008
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7009
|
|
|
|
|
|
|
} elsif ($preview) { |
7010
|
|
|
|
|
|
|
# continued Samsung S1060 preview from APP3 |
7011
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; |
7012
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
7013
|
|
|
|
|
|
|
} |
7014
|
|
|
|
|
|
|
# (also seen "QTI Debug Metadata\0" segment in some newer Samsung images) |
7015
|
|
|
|
|
|
|
# BenQ DC E1050 continues preview in APP5 |
7016
|
0
|
0
|
0
|
|
|
0
|
if ($preview and $nextMarker ne 0xe5) { |
7017
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
7018
|
0
|
|
|
|
|
0
|
undef $preview; |
7019
|
|
|
|
|
|
|
} |
7020
|
|
|
|
|
|
|
} elsif ($marker == 0xe5) { # APP5 (Ricoh "RMETA") |
7021
|
20
|
50
|
|
|
|
138
|
if ($$segDataPt =~ /^RMETA\0/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
7022
|
|
|
|
|
|
|
# (NOTE: apparently these may span multiple segments, but I haven't seen |
7023
|
|
|
|
|
|
|
# a sample like this, so multi-segment support hasn't yet been implemented) |
7024
|
20
|
|
|
|
|
66
|
$dumpType = 'Ricoh RMETA'; |
7025
|
20
|
|
|
|
|
124
|
DirStart(\%dirInfo, 6, 6); |
7026
|
20
|
|
|
|
|
114
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA'); |
7027
|
20
|
|
|
|
|
107
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7028
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^ssuniqueid\0/) { |
7029
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5'); |
7030
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11)); |
7031
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI') { |
7032
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalCal'; |
7033
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
7034
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP5', $$segDataPt); |
7035
|
|
|
|
|
|
|
} elsif ($preview) { |
7036
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; |
7037
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
7038
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
7039
|
0
|
|
|
|
|
0
|
undef $preview; |
7040
|
|
|
|
|
|
|
} |
7041
|
|
|
|
|
|
|
} elsif ($marker == 0xe6) { # APP6 (Toshiba EPPIM, NITF, HP_TDHD) |
7042
|
37
|
100
|
33
|
|
|
342
|
if ($$segDataPt =~ /^EPPIM\0/) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
7043
|
18
|
|
|
|
|
61
|
undef $dumpType; # (will be dumped here) |
7044
|
18
|
|
|
|
|
90
|
DirStart(\%dirInfo, 6, 6); |
7045
|
18
|
50
|
|
|
|
99
|
if ($htmlDump) { |
7046
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 10, 'APP6 EPPIM header'); |
7047
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7048
|
|
|
|
|
|
|
} |
7049
|
18
|
|
|
|
|
65
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM'); |
7050
|
18
|
|
|
|
|
101
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
7051
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^NITF\0/) { |
7052
|
18
|
|
|
|
|
53
|
$dumpType = 'NITF'; |
7053
|
18
|
|
|
|
|
72
|
SetByteOrder('MM'); |
7054
|
18
|
|
|
|
|
123
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF'); |
7055
|
18
|
|
|
|
|
105
|
DirStart(\%dirInfo, 5); |
7056
|
18
|
|
|
|
|
113
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7057
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) { |
7058
|
|
|
|
|
|
|
# HP Photosmart R837 APP6 "TDHD" segment |
7059
|
0
|
|
|
|
|
0
|
$dumpType = 'TDHD'; |
7060
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD'); |
7061
|
|
|
|
|
|
|
# (ignore first TDHD element because size includes 12-byte tag header) |
7062
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 12); |
7063
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7064
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^GoPro\0/) { |
7065
|
|
|
|
|
|
|
# GoPro segment |
7066
|
1
|
|
|
|
|
2
|
$dumpType = 'GoPro'; |
7067
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF'); |
7068
|
1
|
|
|
|
|
4
|
DirStart(\%dirInfo, 6); |
7069
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7070
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^DTAT\0\0.\{/s) { |
7071
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI_DTAT'; |
7072
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
7073
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP6', $$segDataPt); |
7074
|
|
|
|
|
|
|
} |
7075
|
|
|
|
|
|
|
} elsif ($marker == 0xe7) { # APP7 (Pentax, Huawei, Qualcomm) |
7076
|
19
|
50
|
|
|
|
230
|
if ($$segDataPt =~ /^PENTAX \0(II|MM)/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7077
|
|
|
|
|
|
|
# found in K-3 images (is this multi-segment??) |
7078
|
0
|
|
|
|
|
0
|
SetByteOrder($1); |
7079
|
0
|
|
|
|
|
0
|
undef $dumpType; # (dump this ourself) |
7080
|
0
|
|
|
|
|
0
|
my $hdrLen = 10; |
7081
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main'); |
7082
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, $hdrLen, 0); |
7083
|
0
|
|
|
|
|
0
|
$dirInfo{DirName} = 'Pentax APP7'; |
7084
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7085
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); |
7086
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax'); |
7087
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7088
|
|
|
|
|
|
|
} |
7089
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7090
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) { |
7091
|
0
|
|
|
|
|
0
|
SetByteOrder($1); |
7092
|
0
|
|
|
|
|
0
|
undef $dumpType; # (dump this ourself) |
7093
|
0
|
|
|
|
|
0
|
my $hdrLen = 16; |
7094
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main'); |
7095
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, $hdrLen, 8); |
7096
|
0
|
|
|
|
|
0
|
$dirInfo{DirName} = 'Huawei APP7'; |
7097
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7098
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); |
7099
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei'); |
7100
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7101
|
|
|
|
|
|
|
} |
7102
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP0} = 'APP7'; |
7103
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP1} = 'Huawei'; |
7104
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7105
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP0}; |
7106
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP1}; |
7107
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) { |
7108
|
|
|
|
|
|
|
# found in HP iPAQ_VoiceMessenger |
7109
|
19
|
|
|
|
|
58
|
$dumpType = 'Qualcomm'; |
7110
|
19
|
|
|
|
|
78
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main'); |
7111
|
19
|
|
|
|
|
100
|
DirStart(\%dirInfo, 27); |
7112
|
19
|
|
|
|
|
83
|
$dirInfo{DirName} = 'Qualcomm'; |
7113
|
19
|
|
|
|
|
103
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7114
|
|
|
|
|
|
|
} |
7115
|
|
|
|
|
|
|
} elsif ($marker == 0xe8) { # APP8 (SPIFF) |
7116
|
|
|
|
|
|
|
# my sample SPIFF has 32 bytes of data, but spec states 30 |
7117
|
19
|
50
|
33
|
|
|
169
|
if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) { |
7118
|
19
|
|
|
|
|
50
|
$dumpType = 'SPIFF'; |
7119
|
19
|
|
|
|
|
77
|
DirStart(\%dirInfo, 6); |
7120
|
19
|
|
|
|
|
91
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF'); |
7121
|
19
|
|
|
|
|
102
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7122
|
|
|
|
|
|
|
} |
7123
|
|
|
|
|
|
|
} elsif ($marker == 0xe9) { # APP9 (Media Jukebox) |
7124
|
19
|
50
|
33
|
|
|
203
|
if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) { |
7125
|
19
|
|
|
|
|
59
|
$dumpType = 'MediaJukebox'; |
7126
|
|
|
|
|
|
|
# (start parsing after the "") |
7127
|
19
|
|
|
|
|
85
|
DirStart(\%dirInfo, 22); |
7128
|
19
|
|
|
|
|
79
|
$dirInfo{DirName} = 'MediaJukebox'; |
7129
|
19
|
|
|
|
|
175
|
require Image::ExifTool::XMP; |
7130
|
19
|
|
|
|
|
74
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox'); |
7131
|
19
|
|
|
|
|
123
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP); |
7132
|
|
|
|
|
|
|
} |
7133
|
|
|
|
|
|
|
} elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments) |
7134
|
19
|
50
|
0
|
|
|
129
|
if ($$segDataPt =~ /^UNICODE\0/) { |
|
|
0
|
|
|
|
|
|
7135
|
19
|
|
|
|
|
51
|
$dumpType = 'PhotoStudio'; |
7136
|
19
|
|
|
|
|
118
|
my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM'); |
7137
|
19
|
|
|
|
|
111
|
$self->FoundTag('Comment', $comment); |
7138
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) { |
7139
|
|
|
|
|
|
|
# iPhone "AROT" segment containing integrated intensity per 16 scan lines |
7140
|
|
|
|
|
|
|
# (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz) |
7141
|
0
|
|
|
|
|
0
|
$xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')'; |
7142
|
|
|
|
|
|
|
} |
7143
|
|
|
|
|
|
|
} elsif ($marker == 0xeb) { # APP11 (JPEG-HDR, JUMBF) |
7144
|
38
|
100
|
33
|
|
|
390
|
if ($$segDataPt =~ /^HDR_RI /) { |
|
|
50
|
|
|
|
|
|
7145
|
19
|
|
|
|
|
55
|
$dumpType = 'JPEG-HDR'; |
7146
|
19
|
|
|
|
|
56
|
my $dataPt = $segDataPt; |
7147
|
19
|
50
|
|
|
|
73
|
if (defined $combinedSegData) { |
7148
|
0
|
0
|
|
|
|
0
|
if ($$segDataPt =~ /~\0/g) { |
7149
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,pos($$segDataPt)); |
7150
|
|
|
|
|
|
|
} else { |
7151
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid format for JPEG-HDR extended segment'); |
7152
|
|
|
|
|
|
|
} |
7153
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7154
|
|
|
|
|
|
|
} |
7155
|
19
|
50
|
33
|
|
|
147
|
if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) { |
7156
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7157
|
|
|
|
|
|
|
} else { |
7158
|
19
|
|
|
|
|
75
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR'); |
7159
|
19
|
|
|
|
|
86
|
my %dirInfo = ( DataPt => $dataPt ); |
7160
|
19
|
|
|
|
|
95
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7161
|
19
|
|
|
|
|
101
|
undef $combinedSegData; |
7162
|
|
|
|
|
|
|
} |
7163
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(JP..)/s and length($$segDataPt) >= 16) { |
7164
|
|
|
|
|
|
|
# JUMBF extension marker |
7165
|
19
|
|
|
|
|
66
|
my $hdr = $1; |
7166
|
19
|
|
|
|
|
84
|
$dumpType = 'JUMBF'; |
7167
|
19
|
|
|
|
|
100
|
SetByteOrder('MM'); |
7168
|
19
|
|
|
|
|
112
|
my $seq = Get32u($segDataPt, 4) - 1; # (start from 0) |
7169
|
19
|
|
|
|
|
70
|
my $len = Get32u($segDataPt, 8); |
7170
|
19
|
|
|
|
|
85
|
my $type = substr($$segDataPt, 12, 4); |
7171
|
19
|
|
|
|
|
51
|
my $hdrLen; |
7172
|
19
|
50
|
33
|
|
|
92
|
if ($len == 1 and length($$segDataPt) >= 24) { |
7173
|
0
|
|
|
|
|
0
|
$len = Get64u($$segDataPt, 16); |
7174
|
0
|
|
|
|
|
0
|
$hdrLen = 16; |
7175
|
|
|
|
|
|
|
} else { |
7176
|
19
|
|
|
|
|
45
|
$hdrLen = 8; |
7177
|
|
|
|
|
|
|
} |
7178
|
19
|
50
|
|
|
|
106
|
$jumbfChunk{$type} or $jumbfChunk{$type} = [ ]; |
7179
|
19
|
50
|
|
|
|
126
|
if ($len < $hdrLen) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7180
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid JUMBF segment'); |
7181
|
|
|
|
|
|
|
} elsif ($seq < 0) { |
7182
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid JUMBF sequence number'); |
7183
|
|
|
|
|
|
|
} elsif (defined $jumbfChunk{$type}[$seq]) { |
7184
|
0
|
|
|
|
|
0
|
$self->Warn('Duplicate JUMBF sequence number'); |
7185
|
|
|
|
|
|
|
} else { |
7186
|
|
|
|
|
|
|
# add to list of JUMBF chunks |
7187
|
19
|
|
|
|
|
83
|
$jumbfChunk{$type}[$seq] = substr($$segDataPt, 8 + $hdrLen); |
7188
|
|
|
|
|
|
|
# check to see if we have a complete JUMBF box |
7189
|
19
|
|
|
|
|
45
|
my $size = $hdrLen; |
7190
|
19
|
|
|
|
|
45
|
foreach (@{$jumbfChunk{$type}}) { |
|
19
|
|
|
|
|
73
|
|
7191
|
19
|
50
|
|
|
|
71
|
defined $_ or $size = 0, last; |
7192
|
19
|
|
|
|
|
52
|
$size += length $_; |
7193
|
|
|
|
|
|
|
} |
7194
|
19
|
50
|
|
|
|
66
|
if ($size == $len) { |
7195
|
19
|
|
|
|
|
58
|
my $buff = join '', substr($$segDataPt,8,$hdrLen), @{$jumbfChunk{$type}}; |
|
19
|
|
|
|
|
82
|
|
7196
|
19
|
|
|
|
|
60
|
$dirInfo{DataPt} = \$buff; |
7197
|
19
|
|
|
|
|
60
|
$dirInfo{DataPos} = $segPos + 8; # (shows correct offsets for single-segment JUMBF) |
7198
|
19
|
|
|
|
|
61
|
$dirInfo{DataLen} = $dirInfo{DirLen} = $size; |
7199
|
19
|
|
|
|
|
66
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main'); |
7200
|
19
|
|
|
|
|
120
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7201
|
19
|
|
|
|
|
129
|
delete $jumbfChunk{$type}; |
7202
|
|
|
|
|
|
|
} |
7203
|
|
|
|
|
|
|
} |
7204
|
|
|
|
|
|
|
} |
7205
|
|
|
|
|
|
|
} elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info) |
7206
|
40
|
100
|
|
|
|
217
|
if ($$segDataPt =~ /^Ducky/) { |
7207
|
21
|
|
|
|
|
78
|
$dumpType = 'Ducky'; |
7208
|
21
|
|
|
|
|
108
|
DirStart(\%dirInfo, 5); |
7209
|
21
|
|
|
|
|
99
|
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky'); |
7210
|
21
|
|
|
|
|
126
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7211
|
|
|
|
|
|
|
} else { |
7212
|
19
|
|
|
|
|
79
|
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo'); |
7213
|
19
|
50
|
|
|
|
137
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info'; |
7214
|
|
|
|
|
|
|
} |
7215
|
|
|
|
|
|
|
} elsif ($marker == 0xed) { # APP13 (Photoshop, Adobe_CM) |
7216
|
82
|
|
|
|
|
210
|
my $isOld; |
7217
|
82
|
100
|
50
|
|
|
1312
|
if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) { |
|
|
50
|
66
|
|
|
|
|
7218
|
63
|
|
|
|
|
185
|
$dumpType = 'Photoshop'; |
7219
|
|
|
|
|
|
|
# add this data to the combined data if it exists |
7220
|
63
|
|
|
|
|
157
|
my $dataPt = $segDataPt; |
7221
|
63
|
50
|
|
|
|
252
|
if (defined $combinedSegData) { |
7222
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,length($psAPP13hdr)); |
7223
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7224
|
|
|
|
|
|
|
} |
7225
|
|
|
|
|
|
|
# peek ahead to see if the next segment is photoshop data too |
7226
|
63
|
50
|
66
|
|
|
464
|
if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) { |
7227
|
|
|
|
|
|
|
# initialize combined data if necessary |
7228
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7229
|
|
|
|
|
|
|
# (will handle the Photoshop data the next time around) |
7230
|
|
|
|
|
|
|
} else { |
7231
|
63
|
50
|
|
|
|
210
|
my $hdrLen = $isOld ? 27 : 14; |
7232
|
|
|
|
|
|
|
# process APP13 Photoshop record |
7233
|
63
|
|
|
|
|
256
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); |
7234
|
63
|
|
|
|
|
637
|
my %dirInfo = ( |
7235
|
|
|
|
|
|
|
DataPt => $dataPt, |
7236
|
|
|
|
|
|
|
DataPos => $segPos, |
7237
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
7238
|
|
|
|
|
|
|
DirStart => $hdrLen, # directory starts after identifier |
7239
|
|
|
|
|
|
|
DirLen => length($$dataPt) - $hdrLen, |
7240
|
|
|
|
|
|
|
Parent => $markerName, |
7241
|
|
|
|
|
|
|
); |
7242
|
63
|
|
|
|
|
323
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7243
|
63
|
|
|
|
|
423
|
undef $combinedSegData; |
7244
|
|
|
|
|
|
|
} |
7245
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^Adobe_CM/) { |
7246
|
19
|
|
|
|
|
63
|
$dumpType = 'Adobe_CM'; |
7247
|
19
|
|
|
|
|
85
|
SetByteOrder('MM'); |
7248
|
19
|
|
|
|
|
99
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM'); |
7249
|
19
|
|
|
|
|
97
|
DirStart(\%dirInfo, 8); |
7250
|
19
|
|
|
|
|
92
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7251
|
|
|
|
|
|
|
} |
7252
|
|
|
|
|
|
|
} elsif ($marker == 0xee) { # APP14 (Adobe) |
7253
|
45
|
50
|
|
|
|
304
|
if ($$segDataPt =~ /^Adobe/) { |
7254
|
|
|
|
|
|
|
# extract as a block if requested, or if copying tags from file |
7255
|
45
|
100
|
66
|
|
|
419
|
if ($$req{adobe} or |
|
|
|
66
|
|
|
|
|
7256
|
|
|
|
|
|
|
# (not extracted normally, so check TAGS_FROM_FILE) |
7257
|
|
|
|
|
|
|
($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe})) |
7258
|
|
|
|
|
|
|
{ |
7259
|
16
|
|
|
|
|
73
|
$self->FoundTag('Adobe', $$segDataPt); |
7260
|
|
|
|
|
|
|
} |
7261
|
45
|
|
|
|
|
190
|
$dumpType = 'Adobe'; |
7262
|
45
|
|
|
|
|
182
|
SetByteOrder('MM'); |
7263
|
45
|
|
|
|
|
296
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe'); |
7264
|
45
|
|
|
|
|
214
|
DirStart(\%dirInfo, 5); |
7265
|
45
|
|
|
|
|
247
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7266
|
|
|
|
|
|
|
} |
7267
|
|
|
|
|
|
|
} elsif ($marker == 0xef) { # APP15 (GraphicConverter) |
7268
|
19
|
50
|
33
|
|
|
207
|
if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) { |
7269
|
19
|
|
|
|
|
55
|
$dumpType = 'GraphicConverter'; |
7270
|
19
|
|
|
|
|
94
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv'); |
7271
|
19
|
|
|
|
|
97
|
$self->HandleTag($tagTablePtr, 'Q', $1); |
7272
|
|
|
|
|
|
|
} |
7273
|
|
|
|
|
|
|
} elsif ($marker == 0xfe) { # COM (JPEG comment) |
7274
|
27
|
|
|
|
|
80
|
$dumpType = 'Comment'; |
7275
|
27
|
|
|
|
|
102
|
$$segDataPt =~ s/\0+$//; # some dumb softwares add null terminators |
7276
|
27
|
|
|
|
|
98
|
$self->FoundTag('Comment', $$segDataPt); |
7277
|
|
|
|
|
|
|
} elsif ($marker == 0x64) { # CME (J2C comment and extension) |
7278
|
2
|
|
|
|
|
7
|
$dumpType = 'Comment'; |
7279
|
2
|
50
|
|
|
|
11
|
if ($length > 2) { |
7280
|
2
|
|
|
|
|
7
|
my $reg = unpack('n', $$segDataPt); # get registration value |
7281
|
2
|
|
|
|
|
11
|
my $val = substr($$segDataPt, 2); |
7282
|
2
|
50
|
|
|
|
11
|
$val = $self->Decode($val, 'Latin') if $reg == 1; |
7283
|
|
|
|
|
|
|
# (actually an extension for $reg==65535, but store as binary comment) |
7284
|
2
|
50
|
33
|
|
|
15
|
$self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val); |
7285
|
|
|
|
|
|
|
} |
7286
|
|
|
|
|
|
|
} elsif ($marker == 0x51) { # SIZ (J2C) |
7287
|
1
|
|
|
|
|
6
|
my ($w, $h) = unpack('x2N2', $$segDataPt); |
7288
|
1
|
|
|
|
|
5
|
$self->FoundTag('ImageWidth', $w); |
7289
|
1
|
|
|
|
|
3
|
$self->FoundTag('ImageHeight', $h); |
7290
|
|
|
|
|
|
|
} elsif (($marker & 0xf0) != 0xe0) { |
7291
|
466
|
|
|
|
|
1155
|
$dumpType = "$markerName segment"; |
7292
|
466
|
|
|
|
|
1257
|
$desc = "[JPEG $markerName]"; # (other known JPEG segments) |
7293
|
|
|
|
|
|
|
} |
7294
|
1171
|
100
|
|
|
|
3308
|
if (defined $dumpType) { |
7295
|
1115
|
50
|
33
|
|
|
3023
|
if (not $dumpType and ($$options{Unknown} or $$options{Validate})) { |
|
|
|
66
|
|
|
|
|
7296
|
0
|
0
|
|
|
|
0
|
my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : ''; |
7297
|
0
|
0
|
|
|
|
0
|
$xtra = 'segment' unless $xtra; |
7298
|
0
|
|
|
|
|
0
|
$self->Warn("Unknown $markerName$str $xtra", 1); |
7299
|
|
|
|
|
|
|
} |
7300
|
1115
|
50
|
|
|
|
2655
|
if ($htmlDump) { |
7301
|
0
|
0
|
|
|
|
0
|
$desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment'; |
|
|
0
|
|
|
|
|
|
7302
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, $length+4, $desc, $tip, 0x08); |
7303
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7304
|
|
|
|
|
|
|
} |
7305
|
|
|
|
|
|
|
} |
7306
|
1171
|
|
|
|
|
4350
|
undef $$segDataPt; |
7307
|
|
|
|
|
|
|
} |
7308
|
|
|
|
|
|
|
# process extended XMP now if it existed |
7309
|
232
|
100
|
|
|
|
871
|
if (%extendedXMP) { |
7310
|
1
|
|
|
|
|
7
|
my $guid; |
7311
|
|
|
|
|
|
|
# GUID indicated by the last main XMP segment |
7312
|
1
|
|
50
|
|
|
9
|
my $goodGuid = $$self{VALUE}{HasExtendedXMP} || ''; |
7313
|
|
|
|
|
|
|
# GUID of the extended XMP that we will process ('2' for all) |
7314
|
1
|
|
50
|
|
|
11
|
my $readGuid = $$options{ExtendedXMP} || 0; |
7315
|
1
|
50
|
|
|
|
6
|
$readGuid = $goodGuid if $readGuid eq '1'; |
7316
|
1
|
|
|
|
|
7
|
foreach $guid (sort keys %extendedXMP) { |
7317
|
1
|
50
|
|
|
|
6
|
next unless length $guid == 32; # ignore other (internal) keys |
7318
|
1
|
|
|
|
|
4
|
my $extXMP = $extendedXMP{$guid}; |
7319
|
1
|
|
|
|
|
4
|
my ($off, @offsets, $warn); |
7320
|
|
|
|
|
|
|
# make sure we have all chunks, and create a list of sorted offsets |
7321
|
1
|
|
|
|
|
6
|
for ($off=0; $off<$$extXMP{Size}; ) { |
7322
|
2
|
50
|
|
|
|
7
|
last unless defined $$extXMP{$off}; |
7323
|
2
|
|
|
|
|
6
|
push @offsets, $off; |
7324
|
2
|
|
|
|
|
6
|
$off += length $$extXMP{$off}; |
7325
|
|
|
|
|
|
|
} |
7326
|
1
|
50
|
|
|
|
6
|
unless ($off == $$extXMP{Size}) { |
7327
|
0
|
|
|
|
|
0
|
$self->Warn("Incomplete extended XMP (GUID $guid)"); |
7328
|
0
|
|
|
|
|
0
|
next; |
7329
|
|
|
|
|
|
|
} |
7330
|
1
|
50
|
33
|
|
|
8
|
if ($guid eq $readGuid or $readGuid eq '2') { |
7331
|
1
|
50
|
|
|
|
4
|
$warn = 'Reading non-' if $guid ne $goodGuid; |
7332
|
1
|
|
|
|
|
3
|
my $buff = ''; |
7333
|
|
|
|
|
|
|
# assemble XMP all together |
7334
|
1
|
|
|
|
|
7
|
$buff .= $$extXMP{$_} foreach @offsets; |
7335
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
7336
|
1
|
|
|
|
|
6
|
my %dirInfo = ( |
7337
|
|
|
|
|
|
|
DataPt => \$buff, |
7338
|
|
|
|
|
|
|
Parent => 'APP1', |
7339
|
|
|
|
|
|
|
IsExtended => 1, |
7340
|
|
|
|
|
|
|
); |
7341
|
1
|
|
|
|
|
5
|
$$path[$pn] = 'APP1'; |
7342
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7343
|
1
|
|
|
|
|
15
|
pop @$path; |
7344
|
|
|
|
|
|
|
} else { |
7345
|
0
|
|
|
|
|
0
|
$warn = 'Ignored '; |
7346
|
0
|
0
|
|
|
|
0
|
$warn .= 'non-' if $guid ne $goodGuid; |
7347
|
|
|
|
|
|
|
} |
7348
|
1
|
50
|
|
|
|
22
|
$self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn; |
7349
|
1
|
|
|
|
|
8
|
delete $extendedXMP{$guid}; |
7350
|
|
|
|
|
|
|
} |
7351
|
|
|
|
|
|
|
} |
7352
|
|
|
|
|
|
|
# calculate JPEGDigest if requested |
7353
|
232
|
100
|
|
|
|
852
|
if (@dqt) { |
7354
|
1
|
|
|
|
|
1425
|
require Image::ExifTool::JPEGDigest; |
7355
|
1
|
|
|
|
|
23
|
Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling); |
7356
|
|
|
|
|
|
|
} |
7357
|
|
|
|
|
|
|
# issue necessary warnings |
7358
|
232
|
50
|
|
|
|
794
|
$self->Warn('Invalid JUMBF size or missing JUMBF chunk') if %jumbfChunk; |
7359
|
232
|
50
|
|
|
|
859
|
$self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount; |
7360
|
232
|
50
|
|
|
|
697
|
$self->Warn('Incomplete FLIR record', 1) if defined $flirCount; |
7361
|
232
|
50
|
|
|
|
829
|
$self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError}; |
7362
|
232
|
50
|
|
|
|
661
|
$success or $self->Warn('JPEG format error'); |
7363
|
232
|
50
|
|
|
|
889
|
pop @$path if @$path > $pn; |
7364
|
232
|
|
|
|
|
2023
|
return 1; |
7365
|
|
|
|
|
|
|
} |
7366
|
|
|
|
|
|
|
|
7367
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7368
|
|
|
|
|
|
|
# Extract metadata from an Exiv2 EXV file |
7369
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set |
7370
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG file |
7371
|
|
|
|
|
|
|
sub ProcessEXV($$) |
7372
|
|
|
|
|
|
|
{ |
7373
|
2
|
|
|
2
|
0
|
9
|
my ($self, $dirInfo) = @_; |
7374
|
2
|
|
|
|
|
14
|
return $self->ProcessJPEG($dirInfo); |
7375
|
|
|
|
|
|
|
} |
7376
|
|
|
|
|
|
|
|
7377
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7378
|
|
|
|
|
|
|
# Process EXIF file |
7379
|
|
|
|
|
|
|
# Inputs/Returns: same as ProcessTIFF |
7380
|
|
|
|
|
|
|
sub ProcessEXIF($$;$) |
7381
|
|
|
|
|
|
|
{ |
7382
|
2
|
|
|
2
|
0
|
10
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7383
|
2
|
|
|
|
|
9
|
return $self->ProcessTIFF($dirInfo, $tagTablePtr); |
7384
|
|
|
|
|
|
|
} |
7385
|
|
|
|
|
|
|
|
7386
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7387
|
|
|
|
|
|
|
# Process TIFF data (wrapper for DoProcessTIFF to allow re-entry) |
7388
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref |
7389
|
|
|
|
|
|
|
# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error |
7390
|
|
|
|
|
|
|
sub ProcessTIFF($$;$) |
7391
|
|
|
|
|
|
|
{ |
7392
|
483
|
|
|
483
|
0
|
2332
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7393
|
483
|
|
|
|
|
1211
|
my $exifData = $$self{EXIF_DATA}; |
7394
|
483
|
|
|
|
|
1215
|
my $exifPos = $$self{EXIF_POS}; |
7395
|
483
|
|
|
|
|
2216
|
my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr); |
7396
|
|
|
|
|
|
|
# restore original EXIF information (in case ProcessTIFF is nested) |
7397
|
483
|
100
|
|
|
|
1704
|
if (defined $exifData) { |
7398
|
108
|
|
|
|
|
286
|
$$self{EXIF_DATA} = $exifData; |
7399
|
108
|
|
|
|
|
228
|
$$self{EXIF_POS} = $exifPos; |
7400
|
|
|
|
|
|
|
} |
7401
|
483
|
|
|
|
|
2084
|
return $rtnVal; |
7402
|
|
|
|
|
|
|
} |
7403
|
|
|
|
|
|
|
|
7404
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7405
|
|
|
|
|
|
|
# Process TIFF data |
7406
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref |
7407
|
|
|
|
|
|
|
# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error |
7408
|
|
|
|
|
|
|
sub DoProcessTIFF($$;$) |
7409
|
|
|
|
|
|
|
{ |
7410
|
483
|
|
|
483
|
0
|
1417
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7411
|
483
|
|
|
|
|
1223
|
my $dataPt = $$dirInfo{DataPt}; |
7412
|
483
|
|
100
|
|
|
1831
|
my $fileType = $$dirInfo{Parent} || ''; |
7413
|
483
|
|
|
|
|
1117
|
my $raf = $$dirInfo{RAF}; |
7414
|
483
|
|
100
|
|
|
2713
|
my $base = $$dirInfo{Base} || 0; |
7415
|
483
|
|
|
|
|
1206
|
my $outfile = $$dirInfo{OutFile}; |
7416
|
483
|
|
|
|
|
1133
|
my ($err, $sig, $canonSig, $otherSig); |
7417
|
|
|
|
|
|
|
|
7418
|
|
|
|
|
|
|
# attempt to read TIFF header |
7419
|
483
|
|
|
|
|
1486
|
$$self{EXIF_DATA} = ''; |
7420
|
483
|
100
|
100
|
|
|
3249
|
if ($raf) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7421
|
47
|
100
|
|
|
|
166
|
if ($outfile) { |
7422
|
14
|
50
|
|
|
|
3496
|
$raf->Seek(0, 0) or return 0; |
7423
|
14
|
50
|
|
|
|
98
|
if ($base) { |
7424
|
0
|
0
|
|
|
|
0
|
$raf->Read($$dataPt, $base) == $base or return 0; |
7425
|
0
|
0
|
|
|
|
0
|
Write($outfile, $$dataPt) or $err = 1; |
7426
|
|
|
|
|
|
|
} |
7427
|
|
|
|
|
|
|
} else { |
7428
|
33
|
50
|
|
|
|
206
|
$raf->Seek($base, 0) or return 0; |
7429
|
|
|
|
|
|
|
} |
7430
|
|
|
|
|
|
|
# extract full EXIF block (for block copy) from EXIF file |
7431
|
47
|
100
|
|
|
|
253
|
my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8; |
7432
|
47
|
|
|
|
|
246
|
my $n = $raf->Read($$self{EXIF_DATA}, $amount); |
7433
|
47
|
100
|
|
|
|
274
|
if ($n < 8) { |
7434
|
1
|
50
|
33
|
|
|
13
|
return 0 if $n or not $outfile or $fileType ne 'EXIF'; |
|
|
|
33
|
|
|
|
|
7435
|
|
|
|
|
|
|
# create EXIF file from scratch |
7436
|
1
|
|
|
|
|
4
|
delete $$self{EXIF_DATA}; |
7437
|
1
|
|
|
|
|
3
|
undef $raf; |
7438
|
|
|
|
|
|
|
} |
7439
|
47
|
100
|
|
|
|
564
|
if ($n > 8) { |
7440
|
2
|
|
|
|
|
14
|
$raf->Seek(8, 0); |
7441
|
2
|
50
|
|
|
|
18
|
if ($n == $amount) { |
7442
|
0
|
|
|
|
|
0
|
$$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8); |
7443
|
0
|
|
|
|
|
0
|
$self->Warn('EXIF too large to extract as a block'); #(shouldn't happen) |
7444
|
|
|
|
|
|
|
} |
7445
|
|
|
|
|
|
|
} |
7446
|
|
|
|
|
|
|
} elsif ($dataPt and length $$dataPt) { |
7447
|
|
|
|
|
|
|
# save a copy of the EXIF data |
7448
|
394
|
|
100
|
|
|
1880
|
my $dirStart = $$dirInfo{DirStart} || 0; |
7449
|
394
|
|
66
|
|
|
1391
|
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart); |
7450
|
394
|
|
|
|
|
2515
|
$$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen); |
7451
|
394
|
50
|
66
|
|
|
1999
|
$self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2; |
7452
|
|
|
|
|
|
|
} elsif ($outfile) { |
7453
|
42
|
|
|
|
|
145
|
delete $$self{EXIF_DATA}; # create from scratch |
7454
|
|
|
|
|
|
|
} else { |
7455
|
0
|
|
|
|
|
0
|
$$self{EXIF_DATA} = ''; |
7456
|
|
|
|
|
|
|
} |
7457
|
483
|
100
|
|
|
|
1795
|
unless (defined $$self{EXIF_DATA}) { |
7458
|
|
|
|
|
|
|
# set default byte order for creating new GPS in CR3 images |
7459
|
43
|
|
|
|
|
113
|
my $defaultByteOrder; |
7460
|
43
|
50
|
33
|
|
|
337
|
if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') { |
7461
|
0
|
|
|
|
|
0
|
$defaultByteOrder = $$self{SaveExifByteOrder}; |
7462
|
|
|
|
|
|
|
} |
7463
|
|
|
|
|
|
|
# create TIFF information from scratch |
7464
|
43
|
100
|
|
|
|
321
|
if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') { |
7465
|
34
|
|
|
|
|
135
|
$$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08"; |
7466
|
|
|
|
|
|
|
} else { |
7467
|
9
|
|
|
|
|
42
|
$$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0"; |
7468
|
|
|
|
|
|
|
} |
7469
|
|
|
|
|
|
|
} |
7470
|
483
|
|
|
|
|
1674
|
$$self{EXIF_POS} = $base + $$self{BASE}; |
7471
|
483
|
100
|
|
|
|
2035
|
$$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS}; |
7472
|
483
|
|
|
|
|
1236
|
$dataPt = \$$self{EXIF_DATA}; |
7473
|
|
|
|
|
|
|
|
7474
|
|
|
|
|
|
|
# set byte ordering |
7475
|
483
|
|
|
|
|
1565
|
my $byteOrder = substr($$dataPt,0,2); |
7476
|
483
|
100
|
|
|
|
1623
|
SetByteOrder($byteOrder) or return 0; |
7477
|
|
|
|
|
|
|
|
7478
|
|
|
|
|
|
|
# verify the byte ordering |
7479
|
477
|
|
|
|
|
1995
|
my $identifier = Get16u($dataPt, 2); |
7480
|
|
|
|
|
|
|
# identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF) |
7481
|
|
|
|
|
|
|
# no longer do this because various files use different values |
7482
|
|
|
|
|
|
|
# (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????) |
7483
|
|
|
|
|
|
|
# return 0 unless $identifier == 0x2a; |
7484
|
477
|
50
|
66
|
|
|
2690
|
$self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a; |
7485
|
|
|
|
|
|
|
|
7486
|
|
|
|
|
|
|
# get offset to IFD0 |
7487
|
477
|
50
|
|
|
|
1642
|
return 0 if length $$dataPt < 8; |
7488
|
477
|
|
|
|
|
2271
|
my $offset = Get32u($dataPt, 4); |
7489
|
477
|
50
|
|
|
|
1858
|
$offset >= 8 or return 0; |
7490
|
|
|
|
|
|
|
|
7491
|
477
|
100
|
|
|
|
1633
|
if ($raf) { |
7492
|
|
|
|
|
|
|
# check for canon or EXIF signature |
7493
|
|
|
|
|
|
|
# (Canon CR2 images should have an offset of 16, but it may be |
7494
|
|
|
|
|
|
|
# greater if edited by PhotoMechanic) |
7495
|
40
|
100
|
100
|
|
|
393
|
if ($identifier == 0x2a and $offset >= 16) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
7496
|
17
|
50
|
|
|
|
80
|
$raf->Read($sig, 8) == 8 or return 0; |
7497
|
17
|
|
|
|
|
86
|
$$dataPt .= $sig; |
7498
|
17
|
100
|
|
|
|
129
|
if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) { |
7499
|
10
|
100
|
|
|
|
54
|
if ($sig eq 'ExifMeta') { |
7500
|
1
|
|
|
|
|
15
|
$self->SetFileType($fileType = 'EXIF'); |
7501
|
1
|
|
|
|
|
3
|
$otherSig = $sig; |
7502
|
|
|
|
|
|
|
} else { |
7503
|
9
|
50
|
|
|
|
58
|
$fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW'; |
7504
|
9
|
|
|
|
|
25
|
$canonSig = $sig; |
7505
|
|
|
|
|
|
|
} |
7506
|
10
|
50
|
|
|
|
45
|
$self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP}; |
7507
|
|
|
|
|
|
|
} |
7508
|
|
|
|
|
|
|
} elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) { |
7509
|
|
|
|
|
|
|
# panasonic RAW, RW2 or RWL file |
7510
|
3
|
|
|
|
|
7
|
my $magic; |
7511
|
|
|
|
|
|
|
# test for RW2/RWL magic number |
7512
|
3
|
50
|
33
|
|
|
25
|
if ($offset >= 0x18 and $raf->Read($magic, 16) and |
|
|
|
33
|
|
|
|
|
7513
|
|
|
|
|
|
|
$magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a") |
7514
|
|
|
|
|
|
|
{ |
7515
|
3
|
50
|
|
|
|
14
|
$fileType = 'RW2' unless $fileType eq 'RWL'; |
7516
|
3
|
50
|
|
|
|
223
|
$self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP}; |
7517
|
3
|
|
|
|
|
11
|
$otherSig = $magic; # save signature for writing |
7518
|
|
|
|
|
|
|
} else { |
7519
|
0
|
|
|
|
|
0
|
$fileType = 'RAW'; |
7520
|
|
|
|
|
|
|
} |
7521
|
3
|
|
|
|
|
11
|
$tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main'); |
7522
|
|
|
|
|
|
|
} elsif ($fileType eq 'TIFF') { |
7523
|
13
|
50
|
33
|
|
|
145
|
if ($identifier == 0x2b) { |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7524
|
|
|
|
|
|
|
# this looks like a BigTIFF image |
7525
|
0
|
|
|
|
|
0
|
$raf->Seek(0); |
7526
|
0
|
|
|
|
|
0
|
require Image::ExifTool::BigTIFF; |
7527
|
0
|
|
|
|
|
0
|
my $result = Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo); |
7528
|
0
|
0
|
|
|
|
0
|
if ($result) { |
7529
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(PageCount => $$self{PageCount}) if $$self{MultiPage}; |
7530
|
0
|
|
|
|
|
0
|
return 1; |
7531
|
|
|
|
|
|
|
} |
7532
|
|
|
|
|
|
|
} elsif ($identifier == 0x4f52 or $identifier == 0x5352) { |
7533
|
|
|
|
|
|
|
# Olympus ORF image (set FileType now because base type is 'ORF') |
7534
|
0
|
|
|
|
|
0
|
$self->SetFileType($fileType = 'ORF'); |
7535
|
|
|
|
|
|
|
} elsif ($identifier == 0x4352) { |
7536
|
0
|
|
|
|
|
0
|
$fileType = 'DCP'; |
7537
|
|
|
|
|
|
|
} elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) { |
7538
|
0
|
|
|
|
|
0
|
$fileType = 'HDP'; # Windows HD Photo file |
7539
|
|
|
|
|
|
|
# check version number |
7540
|
0
|
|
|
|
|
0
|
my $ver = Get8u($dataPt, 3); |
7541
|
0
|
0
|
|
|
|
0
|
if ($ver > 1) { |
7542
|
0
|
|
|
|
|
0
|
$self->Error("Windows HD Photo version $ver files not yet supported"); |
7543
|
0
|
|
|
|
|
0
|
return 1; |
7544
|
|
|
|
|
|
|
} |
7545
|
|
|
|
|
|
|
} |
7546
|
|
|
|
|
|
|
} |
7547
|
|
|
|
|
|
|
# we have a valid TIFF (or whatever) file |
7548
|
40
|
100
|
66
|
|
|
301
|
if ($fileType and not $$self{VALUE}{FileType}) { |
7549
|
38
|
|
|
|
|
116
|
my $lookup = $fileTypeLookup{$fileType}; |
7550
|
38
|
50
|
33
|
|
|
192
|
$lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup; |
7551
|
|
|
|
|
|
|
# use file extension to pre-determine type if extension is TIFF-based or type is RAW |
7552
|
38
|
50
|
|
|
|
197
|
my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : ''; |
|
|
50
|
|
|
|
|
|
7553
|
38
|
100
|
66
|
|
|
216
|
my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef; |
7554
|
38
|
|
|
|
|
208
|
$self->SetFileType($t); |
7555
|
|
|
|
|
|
|
} |
7556
|
|
|
|
|
|
|
# don't process file if FastScan == 3 |
7557
|
40
|
50
|
66
|
|
|
388
|
return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3; |
|
|
|
33
|
|
|
|
|
7558
|
|
|
|
|
|
|
} |
7559
|
|
|
|
|
|
|
# (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level) |
7560
|
477
|
100
|
100
|
|
|
3580
|
my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0'; |
7561
|
477
|
100
|
100
|
|
|
3074
|
if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
7562
|
401
|
100
|
|
|
|
1824
|
$self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile; |
7563
|
|
|
|
|
|
|
} elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes) |
7564
|
19
|
|
|
|
|
66
|
$ifdName = $$tagTablePtr{GROUPS}{0}; |
7565
|
|
|
|
|
|
|
} else { |
7566
|
57
|
|
|
|
|
145
|
$ifdName = $$tagTablePtr{GROUPS}{1}; |
7567
|
|
|
|
|
|
|
} |
7568
|
477
|
50
|
|
|
|
2421
|
if ($$self{HTML_DUMP}) { |
7569
|
0
|
0
|
|
|
|
0
|
my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x", |
7570
|
|
|
|
|
|
|
($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset); |
7571
|
0
|
|
|
|
|
0
|
$self->HDump($base, 8, 'TIFF header', $tip, 0); |
7572
|
|
|
|
|
|
|
} |
7573
|
|
|
|
|
|
|
# remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...) |
7574
|
477
|
|
|
|
|
1326
|
$$self{TIFF_TYPE} = $fileType; |
7575
|
|
|
|
|
|
|
|
7576
|
|
|
|
|
|
|
# get reference to the main EXIF table |
7577
|
477
|
100
|
|
|
|
1666
|
$tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main'); |
7578
|
|
|
|
|
|
|
|
7579
|
|
|
|
|
|
|
# build directory information hash |
7580
|
|
|
|
|
|
|
my %dirInfo = ( |
7581
|
|
|
|
|
|
|
Base => $base, |
7582
|
|
|
|
|
|
|
DataPt => $dataPt, |
7583
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
7584
|
|
|
|
|
|
|
DataPos => 0, |
7585
|
|
|
|
|
|
|
DirStart => $offset, |
7586
|
|
|
|
|
|
|
DirLen => length($$dataPt) - $offset, |
7587
|
|
|
|
|
|
|
RAF => $raf, |
7588
|
|
|
|
|
|
|
DirName => $ifdName, |
7589
|
|
|
|
|
|
|
Parent => $fileType, |
7590
|
|
|
|
|
|
|
ImageData=> 'Main', # set flag to get information to copy main image data later |
7591
|
|
|
|
|
|
|
Multi => $$dirInfo{Multi}, |
7592
|
477
|
|
|
|
|
5432
|
); |
7593
|
|
|
|
|
|
|
|
7594
|
|
|
|
|
|
|
# extract information from the image |
7595
|
477
|
100
|
|
|
|
1775
|
unless ($outfile) { |
7596
|
|
|
|
|
|
|
# process the directory |
7597
|
353
|
|
|
|
|
5117
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7598
|
|
|
|
|
|
|
# process GeoTiff information if available |
7599
|
353
|
100
|
|
|
|
1925
|
if ($$self{VALUE}{GeoTiffDirectory}) { |
7600
|
7
|
|
|
|
|
1007
|
require Image::ExifTool::GeoTiff; |
7601
|
7
|
|
|
|
|
80
|
Image::ExifTool::GeoTiff::ProcessGeoTiff($self); |
7602
|
|
|
|
|
|
|
} |
7603
|
|
|
|
|
|
|
# process information in recognized trailers |
7604
|
353
|
100
|
|
|
|
1202
|
if ($raf) { |
7605
|
27
|
|
|
|
|
136
|
my $trailInfo = IdentifyTrailer($raf); |
7606
|
27
|
100
|
|
|
|
184
|
if ($trailInfo) { |
7607
|
3
|
|
|
|
|
12
|
$$trailInfo{ScanForAFCP} = 1; # scan to find AFCP if necessary |
7608
|
3
|
|
|
|
|
19
|
$self->ProcessTrailers($trailInfo); |
7609
|
|
|
|
|
|
|
} |
7610
|
|
|
|
|
|
|
# dump any other known trailer (eg. A100 RAW Data) |
7611
|
27
|
0
|
33
|
|
|
159
|
if ($$self{HTML_DUMP} and $$self{KnownTrailer}) { |
7612
|
0
|
|
|
|
|
0
|
my $known = $$self{KnownTrailer}; |
7613
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); |
7614
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $$known{Start}; |
7615
|
0
|
0
|
|
|
|
0
|
$len -= $$trailInfo{Offset} if $trailInfo; # account for other trailers |
7616
|
0
|
0
|
|
|
|
0
|
$self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0; |
7617
|
|
|
|
|
|
|
} |
7618
|
|
|
|
|
|
|
} |
7619
|
|
|
|
|
|
|
# update FileType if necessary now that we know more about the file |
7620
|
353
|
50
|
66
|
|
|
1485
|
if ($$self{DNGVersion} and $$self{VALUE}{FileType} !~ /^(DNG|GPR)$/) { |
7621
|
|
|
|
|
|
|
# override whatever FileType we set since we now know it is DNG |
7622
|
0
|
|
|
|
|
0
|
$self->OverrideFileType($$self{TIFF_TYPE} = 'DNG'); |
7623
|
|
|
|
|
|
|
} |
7624
|
353
|
100
|
|
|
|
1333
|
if ($$self{TIFF_TYPE} eq 'TIFF') { |
7625
|
10
|
50
|
|
|
|
35
|
$self->FoundTag(PageCount => $$self{PageCount}) if $$self{MultiPage}; |
7626
|
|
|
|
|
|
|
} |
7627
|
353
|
|
|
|
|
1985
|
return 1; |
7628
|
|
|
|
|
|
|
} |
7629
|
|
|
|
|
|
|
# |
7630
|
|
|
|
|
|
|
# rewrite the image |
7631
|
|
|
|
|
|
|
# |
7632
|
124
|
100
|
|
|
|
525
|
if ($$dirInfo{NoTiffEnd}) { |
7633
|
1
|
|
|
|
|
4
|
delete $$self{TIFF_END}; |
7634
|
|
|
|
|
|
|
} else { |
7635
|
|
|
|
|
|
|
# initialize TIFF_END so it will be updated by WriteExif() |
7636
|
123
|
|
|
|
|
399
|
$$self{TIFF_END} = 0; |
7637
|
|
|
|
|
|
|
} |
7638
|
124
|
100
|
|
|
|
395
|
if ($canonSig) { |
7639
|
|
|
|
|
|
|
# write Canon CR2 specially because it has a header we want to preserve, |
7640
|
|
|
|
|
|
|
# and possibly trailers added by the Canon utilities and/or PhotoMechanic |
7641
|
3
|
|
|
|
|
10
|
$dirInfo{OutFile} = $outfile; |
7642
|
3
|
|
|
|
|
26
|
require Image::ExifTool::CanonRaw; |
7643
|
3
|
50
|
|
|
|
23
|
Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1; |
7644
|
|
|
|
|
|
|
} else { |
7645
|
|
|
|
|
|
|
# write TIFF header (8 bytes [plus optional signature] followed by IFD) |
7646
|
121
|
100
|
|
|
|
1014
|
if ($fileType eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
7647
|
3
|
|
|
|
|
9
|
$otherSig = 'ExifMeta'; # force this signature for all EXIF files |
7648
|
|
|
|
|
|
|
} elsif (not defined $otherSig) { |
7649
|
117
|
|
|
|
|
491
|
$otherSig = ''; |
7650
|
|
|
|
|
|
|
} |
7651
|
121
|
|
|
|
|
405
|
my $offset = 8 + length($otherSig); |
7652
|
|
|
|
|
|
|
# construct tiff header |
7653
|
121
|
|
|
|
|
618
|
my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig; |
7654
|
121
|
|
|
|
|
421
|
$dirInfo{NewDataPos} = $offset; |
7655
|
121
|
|
|
|
|
419
|
$dirInfo{HeaderPtr} = \$header; |
7656
|
|
|
|
|
|
|
# preserve padding between image data blocks in ORF images |
7657
|
|
|
|
|
|
|
# (otherwise dcraw has problems because it assumes fixed block spacing) |
7658
|
121
|
100
|
66
|
|
|
827
|
$dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a; |
7659
|
121
|
|
|
|
|
1016
|
my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr); |
7660
|
121
|
50
|
|
|
|
855
|
if (not defined $newData) { |
|
|
100
|
|
|
|
|
|
7661
|
0
|
|
|
|
|
0
|
$err = 1; |
7662
|
|
|
|
|
|
|
} elsif (length($newData)) { |
7663
|
|
|
|
|
|
|
# update header length in case more was added |
7664
|
115
|
|
|
|
|
327
|
my $hdrLen = length $header; |
7665
|
115
|
100
|
|
|
|
510
|
if ($hdrLen != 8) { |
7666
|
5
|
|
|
|
|
29
|
Set32u($hdrLen, \$header, 4); |
7667
|
|
|
|
|
|
|
# also update preview fixup if necessary |
7668
|
5
|
|
|
|
|
23
|
my $pi = $$self{PREVIEW_INFO}; |
7669
|
5
|
0
|
33
|
|
|
41
|
$$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup}; |
7670
|
|
|
|
|
|
|
} |
7671
|
115
|
50
|
33
|
|
|
699
|
if ($$self{TIFF_TYPE} eq 'ARW' and not $err) { |
7672
|
|
|
|
|
|
|
# write any required ARW trailer and patch other ARW quirks |
7673
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Sony; |
7674
|
|
|
|
|
|
|
my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, |
7675
|
0
|
|
|
|
|
0
|
$dirInfo{ImageData}); |
7676
|
0
|
0
|
|
|
|
0
|
$errStr and $self->Error($errStr); |
7677
|
0
|
|
|
|
|
0
|
delete $dirInfo{ImageData}; # (was copied by FinishARW) |
7678
|
|
|
|
|
|
|
} else { |
7679
|
115
|
50
|
|
|
|
617
|
Write($outfile, $header, $newData) or $err = 1; |
7680
|
|
|
|
|
|
|
} |
7681
|
115
|
|
|
|
|
399
|
undef $newData; # free memory |
7682
|
|
|
|
|
|
|
} |
7683
|
|
|
|
|
|
|
# copy over image data now if necessary |
7684
|
121
|
100
|
66
|
|
|
820
|
if (ref $dirInfo{ImageData} and not $err) { |
7685
|
10
|
50
|
|
|
|
76
|
$self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1; |
7686
|
10
|
|
|
|
|
51
|
delete $dirInfo{ImageData}; |
7687
|
|
|
|
|
|
|
} |
7688
|
|
|
|
|
|
|
} |
7689
|
|
|
|
|
|
|
# make local copy of TIFF_END now (it may be reset when processing trailers) |
7690
|
124
|
|
|
|
|
374
|
my $tiffEnd = $$self{TIFF_END}; |
7691
|
124
|
|
|
|
|
342
|
delete $$self{TIFF_END}; |
7692
|
|
|
|
|
|
|
|
7693
|
|
|
|
|
|
|
# rewrite trailers if they exist |
7694
|
124
|
100
|
100
|
|
|
638
|
if ($raf and $tiffEnd and not $err) { |
|
|
|
66
|
|
|
|
|
7695
|
12
|
|
|
|
|
34
|
my ($buf, $trailInfo); |
7696
|
12
|
50
|
|
|
|
50
|
$raf->Seek(0, 2) or $err = 1; |
7697
|
12
|
|
|
|
|
73
|
my $extra = $raf->Tell() - $tiffEnd; |
7698
|
|
|
|
|
|
|
# check for trailer and process if possible |
7699
|
12
|
|
|
|
|
29
|
for (;;) { |
7700
|
12
|
100
|
|
|
|
60
|
last unless $extra > 12; |
7701
|
3
|
|
|
|
|
14
|
$raf->Seek($tiffEnd); # seek back to end of image |
7702
|
3
|
|
|
|
|
19
|
$trailInfo = IdentifyTrailer($raf); |
7703
|
3
|
50
|
|
|
|
19
|
last unless $trailInfo; |
7704
|
0
|
|
|
|
|
0
|
my $tbuf = ''; |
7705
|
0
|
|
|
|
|
0
|
$$trailInfo{OutFile} = \$tbuf; # rewrite trailer(s) |
7706
|
0
|
|
|
|
|
0
|
$$trailInfo{ScanForAFCP} = 1; # scan for AFCP if necessary |
7707
|
|
|
|
|
|
|
# rewrite all trailers to buffer |
7708
|
0
|
0
|
|
|
|
0
|
unless ($self->ProcessTrailers($trailInfo)) { |
7709
|
0
|
|
|
|
|
0
|
undef $trailInfo; |
7710
|
0
|
|
|
|
|
0
|
$err = 1; |
7711
|
0
|
|
|
|
|
0
|
last; |
7712
|
|
|
|
|
|
|
} |
7713
|
|
|
|
|
|
|
# calculate unused bytes before trailer |
7714
|
0
|
|
|
|
|
0
|
$extra = $$trailInfo{DataPos} - $tiffEnd; |
7715
|
0
|
|
|
|
|
0
|
last; # yes, the 'for' loop was just a cheap 'goto' |
7716
|
|
|
|
|
|
|
} |
7717
|
|
|
|
|
|
|
# ignore a single zero byte if used for padding |
7718
|
12
|
100
|
100
|
|
|
88
|
if ($extra > 0 and $tiffEnd & 0x01) { |
7719
|
1
|
50
|
|
|
|
6
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7720
|
1
|
50
|
|
|
|
5
|
$raf->Read($buf, 1) or $err = 1; |
7721
|
1
|
50
|
33
|
|
|
14
|
defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd; |
7722
|
|
|
|
|
|
|
} |
7723
|
12
|
100
|
|
|
|
65
|
if ($extra > 0) { |
7724
|
3
|
|
|
|
|
24
|
my $known = $$self{KnownTrailer}; |
7725
|
3
|
50
|
33
|
|
|
24
|
if ($$self{DEL_GROUP}{Trailer} and not $known) { |
|
|
50
|
|
|
|
|
|
7726
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n"); |
7727
|
0
|
|
|
|
|
0
|
++$$self{CHANGED}; |
7728
|
|
|
|
|
|
|
} elsif ($known) { |
7729
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Copying $$known{Name} ($extra bytes)\n"); |
7730
|
0
|
0
|
|
|
|
0
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7731
|
0
|
0
|
|
|
|
0
|
CopyBlock($raf, $outfile, $extra) or $err = 1; |
7732
|
|
|
|
|
|
|
} else { |
7733
|
3
|
50
|
|
|
|
24
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7734
|
|
|
|
|
|
|
# preserve unknown trailer only if it contains non-null data |
7735
|
|
|
|
|
|
|
# (Photoshop CS adds a trailer with 2 null bytes) |
7736
|
3
|
|
|
|
|
10
|
my $size = $extra; |
7737
|
3
|
|
|
|
|
7
|
for (;;) { |
7738
|
3
|
50
|
|
|
|
25
|
my $n = $size > 65536 ? 65536 : $size; |
7739
|
3
|
50
|
|
|
|
14
|
$raf->Read($buf, $n) == $n or $err = 1, last; |
7740
|
3
|
50
|
|
|
|
26
|
if ($buf =~ /[^\0]/) { |
7741
|
3
|
|
|
|
|
26
|
$self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n"); |
7742
|
|
|
|
|
|
|
# copy the trailer since it contains non-null data |
7743
|
3
|
50
|
0
|
|
|
16
|
Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra; |
7744
|
3
|
50
|
|
|
|
17
|
Write($outfile, $buf) or $err = 1, last; |
7745
|
3
|
50
|
0
|
|
|
18
|
CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n; |
7746
|
3
|
|
|
|
|
9
|
last; |
7747
|
|
|
|
|
|
|
} |
7748
|
0
|
|
|
|
|
0
|
$size -= $n; |
7749
|
0
|
0
|
|
|
|
0
|
next if $size > 0; |
7750
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Deleting blank trailer ($extra bytes)\n"); |
7751
|
0
|
|
|
|
|
0
|
last; |
7752
|
|
|
|
|
|
|
} |
7753
|
|
|
|
|
|
|
} |
7754
|
|
|
|
|
|
|
} |
7755
|
|
|
|
|
|
|
# write trailer buffer if necessary |
7756
|
12
|
50
|
0
|
|
|
55
|
$self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo; |
7757
|
|
|
|
|
|
|
# add any new trailers we are creating |
7758
|
12
|
|
|
|
|
75
|
my $trailPt = $self->AddNewTrailers(); |
7759
|
12
|
100
|
50
|
|
|
59
|
Write($outfile, $$trailPt) or $err = 1 if $trailPt; |
7760
|
|
|
|
|
|
|
} |
7761
|
|
|
|
|
|
|
# check DNG version |
7762
|
124
|
100
|
|
|
|
535
|
if ($$self{DNGVersion}) { |
7763
|
1
|
|
|
|
|
3
|
my $ver = $$self{DNGVersion}; |
7764
|
|
|
|
|
|
|
# currently support up to DNG version 1.6 |
7765
|
1
|
50
|
33
|
|
|
22
|
unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.6) { |
7766
|
0
|
|
|
|
|
0
|
$ver =~ tr/ /./; |
7767
|
0
|
|
|
|
|
0
|
$self->Error("DNG Version $ver not yet tested", 1); |
7768
|
|
|
|
|
|
|
} |
7769
|
|
|
|
|
|
|
} |
7770
|
124
|
50
|
|
|
|
1109
|
return $err ? -1 : 1; |
7771
|
|
|
|
|
|
|
} |
7772
|
|
|
|
|
|
|
|
7773
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7774
|
|
|
|
|
|
|
# Return list of tag table keys (ignoring special keys) |
7775
|
|
|
|
|
|
|
# Inputs: 0) reference to tag table |
7776
|
|
|
|
|
|
|
# Returns: List of table keys (unsorted) |
7777
|
|
|
|
|
|
|
sub TagTableKeys($) |
7778
|
|
|
|
|
|
|
{ |
7779
|
7602
|
|
|
7602
|
0
|
12725
|
local $_; |
7780
|
7602
|
|
|
|
|
12157
|
my $tagTablePtr = shift; |
7781
|
7602
|
|
|
|
|
11394
|
my @keyList; |
7782
|
7602
|
|
|
|
|
117129
|
foreach (keys %$tagTablePtr) { |
7783
|
450762
|
100
|
|
|
|
844073
|
push(@keyList, $_) unless $specialTags{$_}; |
7784
|
|
|
|
|
|
|
} |
7785
|
7602
|
|
|
|
|
75421
|
return @keyList; |
7786
|
|
|
|
|
|
|
} |
7787
|
|
|
|
|
|
|
|
7788
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7789
|
|
|
|
|
|
|
# GetTagTable |
7790
|
|
|
|
|
|
|
# Inputs: 0) table name |
7791
|
|
|
|
|
|
|
# Returns: tag table reference, or undefined if not found |
7792
|
|
|
|
|
|
|
# Notes: Always use this function instead of requiring module and using table |
7793
|
|
|
|
|
|
|
# directly since this function also does the following the first time the table |
7794
|
|
|
|
|
|
|
# is loaded: |
7795
|
|
|
|
|
|
|
# - requires new module if necessary |
7796
|
|
|
|
|
|
|
# - generates default GROUPS hash and Group 0 name from module name |
7797
|
|
|
|
|
|
|
# - registers Composite tags if Composite table found |
7798
|
|
|
|
|
|
|
# - saves descriptions for tags in specified table |
7799
|
|
|
|
|
|
|
# - generates default TAG_PREFIX to be used for unknown tags |
7800
|
|
|
|
|
|
|
sub GetTagTable($) |
7801
|
|
|
|
|
|
|
{ |
7802
|
89510
|
100
|
|
89510
|
0
|
197629
|
my $tableName = shift or return undef; |
7803
|
89506
|
|
|
|
|
205673
|
my $table = $allTables{$tableName}; |
7804
|
|
|
|
|
|
|
|
7805
|
89506
|
100
|
|
|
|
164892
|
unless ($table) { |
7806
|
105
|
|
|
105
|
|
1279
|
no strict 'refs'; |
|
105
|
|
|
|
|
327
|
|
|
105
|
|
|
|
|
22189
|
|
7807
|
4512
|
100
|
|
|
|
32870
|
unless (%$tableName) { |
7808
|
|
|
|
|
|
|
# try to load module for this table |
7809
|
872
|
50
|
|
|
|
6943
|
if ($tableName =~ /(.*)::/) { |
7810
|
872
|
|
|
|
|
3255
|
my $module = $1; |
7811
|
872
|
50
|
|
|
|
71424
|
if (eval "require $module") { |
7812
|
|
|
|
|
|
|
# load additional modules if required |
7813
|
872
|
100
|
|
|
|
7444
|
if (not %$tableName) { |
7814
|
28
|
50
|
|
|
|
182
|
if ($module eq 'Image::ExifTool::XMP') { |
|
|
0
|
|
|
|
|
|
7815
|
28
|
|
|
|
|
24301
|
require 'Image/ExifTool/XMP2.pl'; |
7816
|
|
|
|
|
|
|
} elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') { |
7817
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/QuickTimeStream.pl'; |
7818
|
|
|
|
|
|
|
} |
7819
|
|
|
|
|
|
|
} |
7820
|
|
|
|
|
|
|
} else { |
7821
|
0
|
0
|
|
|
|
0
|
$@ and warn $@; |
7822
|
|
|
|
|
|
|
} |
7823
|
|
|
|
|
|
|
} |
7824
|
872
|
50
|
|
|
|
5695
|
unless (%$tableName) { |
7825
|
0
|
|
|
|
|
0
|
warn "Can't find table $tableName\n"; |
7826
|
0
|
|
|
|
|
0
|
return undef; |
7827
|
|
|
|
|
|
|
} |
7828
|
|
|
|
|
|
|
} |
7829
|
105
|
|
|
105
|
|
924
|
no strict 'refs'; |
|
105
|
|
|
|
|
291
|
|
|
105
|
|
|
|
|
5466
|
|
7830
|
4512
|
|
|
|
|
11892
|
$table = \%$tableName; |
7831
|
105
|
|
|
105
|
|
748
|
use strict 'refs'; |
|
105
|
|
|
|
|
303
|
|
|
105
|
|
|
|
|
94270
|
|
7832
|
4512
|
100
|
|
|
|
14276
|
&{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE}; |
|
13
|
|
|
|
|
266
|
|
7833
|
4512
|
|
|
|
|
11887
|
$$table{TABLE_NAME} = $tableName; # set table name |
7834
|
4512
|
|
|
|
|
27478
|
($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://; |
7835
|
|
|
|
|
|
|
# set default group 0 and 1 from module name unless already specified |
7836
|
4512
|
|
|
|
|
11810
|
my $defaultGroups = $$table{GROUPS}; |
7837
|
4512
|
100
|
|
|
|
10771
|
$defaultGroups or $defaultGroups = $$table{GROUPS} = { }; |
7838
|
4512
|
100
|
100
|
|
|
21130
|
unless ($$defaultGroups{0} and $$defaultGroups{1}) { |
7839
|
3599
|
50
|
|
|
|
21420
|
if ($tableName =~ /Image::.*?::([^:]*)/) { |
7840
|
3599
|
100
|
|
|
|
12564
|
$$defaultGroups{0} = $1 unless $$defaultGroups{0}; |
7841
|
3599
|
100
|
|
|
|
14147
|
$$defaultGroups{1} = $1 unless $$defaultGroups{1}; |
7842
|
|
|
|
|
|
|
} else { |
7843
|
0
|
0
|
|
|
|
0
|
$$defaultGroups{0} = $tableName unless $$defaultGroups{0}; |
7844
|
0
|
0
|
|
|
|
0
|
$$defaultGroups{1} = $tableName unless $$defaultGroups{1}; |
7845
|
|
|
|
|
|
|
} |
7846
|
|
|
|
|
|
|
} |
7847
|
4512
|
100
|
|
|
|
12710
|
$$defaultGroups{2} = 'Other' unless $$defaultGroups{2}; |
7848
|
4512
|
100
|
100
|
|
|
19133
|
if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) { |
7849
|
|
|
|
|
|
|
# initialize some XMP table defaults |
7850
|
510
|
|
|
|
|
3547
|
require Image::ExifTool::XMP; |
7851
|
510
|
|
|
|
|
2625
|
Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces |
7852
|
|
|
|
|
|
|
# set default write/check procs |
7853
|
510
|
100
|
|
|
|
1786
|
$$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC}; |
7854
|
510
|
100
|
|
|
|
1724
|
$$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC}; |
7855
|
510
|
100
|
|
|
|
1554
|
$$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO}; |
7856
|
|
|
|
|
|
|
} |
7857
|
|
|
|
|
|
|
# generate a tag prefix for unknown tags if necessary |
7858
|
4512
|
100
|
|
|
|
11028
|
unless (defined $$table{TAG_PREFIX}) { |
7859
|
4412
|
|
|
|
|
6977
|
my $tagPrefix; |
7860
|
4412
|
50
|
66
|
|
|
28053
|
if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) { |
7861
|
4412
|
|
|
|
|
20564
|
($tagPrefix = $1) =~ s/::/_/g; |
7862
|
|
|
|
|
|
|
} else { |
7863
|
0
|
|
|
|
|
0
|
$tagPrefix = $tableName; |
7864
|
|
|
|
|
|
|
} |
7865
|
4412
|
|
|
|
|
13518
|
$$table{TAG_PREFIX} = $tagPrefix; |
7866
|
|
|
|
|
|
|
} |
7867
|
|
|
|
|
|
|
# set up the new table |
7868
|
4512
|
|
|
|
|
14044
|
SetupTagTable($table); |
7869
|
|
|
|
|
|
|
# add any user-defined tags (except Composite tags, which are handled specially) |
7870
|
4512
|
100
|
100
|
|
|
21690
|
if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) { |
|
|
|
66
|
|
|
|
|
7871
|
2
|
|
|
|
|
5
|
my $tagID; |
7872
|
2
|
|
|
|
|
7
|
foreach $tagID (TagTableKeys($UserDefined{$tableName})) { |
7873
|
3
|
50
|
|
|
|
12
|
next if $specialTags{$tagID}; |
7874
|
3
|
|
|
|
|
5
|
delete $$table{$tagID}; # replace any existing entry |
7875
|
3
|
|
|
|
|
14
|
AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1); |
7876
|
|
|
|
|
|
|
} |
7877
|
|
|
|
|
|
|
} |
7878
|
|
|
|
|
|
|
# remember order we loaded the tables in |
7879
|
4512
|
|
|
|
|
10910
|
push @tableOrder, $tableName; |
7880
|
|
|
|
|
|
|
# insert newly loaded table into list |
7881
|
4512
|
|
|
|
|
16030
|
$allTables{$tableName} = $table; |
7882
|
|
|
|
|
|
|
} |
7883
|
|
|
|
|
|
|
# must check each time to add UserDefined Composite tags because the Composite table |
7884
|
|
|
|
|
|
|
# may be loaded before the UserDefined tags are available |
7885
|
89506
|
50
|
66
|
|
|
255250
|
if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
7886
|
|
|
|
|
|
|
%UserDefined and $UserDefined{$tableName}) |
7887
|
|
|
|
|
|
|
{ |
7888
|
0
|
|
|
|
|
0
|
my $userComp = $UserDefined{$tableName}; |
7889
|
0
|
|
|
|
|
0
|
delete $UserDefined{$tableName}; # (must delete first to avoid infinite recursion) |
7890
|
0
|
|
|
|
|
0
|
AddCompositeTags($userComp, 1); |
7891
|
0
|
|
|
|
|
0
|
$UserDefined{$tableName} = $userComp; # (add back again for adding writable tags later) |
7892
|
0
|
|
|
|
|
0
|
$$table{VARS}{LOADED_USERDEFINED} = 1; # set flag to avoid doing this again |
7893
|
|
|
|
|
|
|
} |
7894
|
89506
|
|
|
|
|
208649
|
return $table; |
7895
|
|
|
|
|
|
|
} |
7896
|
|
|
|
|
|
|
|
7897
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7898
|
|
|
|
|
|
|
# Process an image directory |
7899
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) directory information reference |
7900
|
|
|
|
|
|
|
# 2) tag table reference, 3) optional reference to processing procedure |
7901
|
|
|
|
|
|
|
# Returns: Result from processing (1=success) |
7902
|
|
|
|
|
|
|
sub ProcessDirectory($$$;$) |
7903
|
|
|
|
|
|
|
{ |
7904
|
4885
|
|
|
4885
|
0
|
13565
|
my ($self, $dirInfo, $tagTablePtr, $proc) = @_; |
7905
|
|
|
|
|
|
|
|
7906
|
4885
|
50
|
33
|
|
|
19078
|
return 0 unless $tagTablePtr and $dirInfo; |
7907
|
|
|
|
|
|
|
# use default proc from tag table or EXIF proc as fallback if no proc specified |
7908
|
4885
|
100
|
100
|
|
|
19573
|
$proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif; |
7909
|
|
|
|
|
|
|
# set directory name from default group0 name if not done already |
7910
|
4885
|
|
|
|
|
9062
|
my $dirName = $$dirInfo{DirName}; |
7911
|
4885
|
100
|
|
|
|
11444
|
unless ($dirName) { |
7912
|
701
|
|
|
|
|
2640
|
$dirName = $$tagTablePtr{GROUPS}{0}; |
7913
|
701
|
100
|
|
|
|
2766
|
$dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name) |
7914
|
701
|
|
|
|
|
1738
|
$$dirInfo{DirName} = $dirName; |
7915
|
|
|
|
|
|
|
} |
7916
|
|
|
|
|
|
|
|
7917
|
|
|
|
|
|
|
# guard against cyclical recursion into the same directory |
7918
|
4885
|
100
|
100
|
|
|
25622
|
if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
7919
|
|
|
|
|
|
|
# directories don't overlap if the length is zero |
7920
|
|
|
|
|
|
|
($$dirInfo{DirLen} or not defined $$dirInfo{DirLen})) |
7921
|
|
|
|
|
|
|
{ |
7922
|
4083
|
|
100
|
|
|
14568
|
my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE}; |
7923
|
4083
|
50
|
|
|
|
11416
|
if ($$self{PROCESSED}{$addr}) { |
7924
|
0
|
|
|
|
|
0
|
$self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory"); |
7925
|
|
|
|
|
|
|
# patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer |
7926
|
0
|
0
|
0
|
|
|
0
|
return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD'; |
7927
|
|
|
|
|
|
|
} |
7928
|
4083
|
|
|
|
|
12739
|
$$self{PROCESSED}{$addr} = $dirName; |
7929
|
|
|
|
|
|
|
} |
7930
|
4885
|
|
|
|
|
10755
|
my $oldOrder = GetByteOrder(); |
7931
|
4885
|
|
|
|
|
18390
|
my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'}; |
7932
|
4885
|
|
|
|
|
13135
|
$$self{LIST_TAGS} = { }; # don't build lists across different directories |
7933
|
4885
|
|
|
|
|
10854
|
$$self{INDENT} .= '| '; |
7934
|
4885
|
|
|
|
|
8466
|
$$self{DIR_NAME} = $dirName; |
7935
|
4885
|
|
|
|
|
7372
|
push @{$$self{PATH}}, $dirName; |
|
4885
|
|
|
|
|
11939
|
|
7936
|
4885
|
|
|
|
|
14143
|
$$self{FOUND_DIR}{$dirName} = 1; |
7937
|
|
|
|
|
|
|
|
7938
|
|
|
|
|
|
|
# process the directory |
7939
|
105
|
|
|
105
|
|
928
|
no strict 'refs'; |
|
105
|
|
|
|
|
319
|
|
|
105
|
|
|
|
|
5455
|
|
7940
|
4885
|
|
|
|
|
23309
|
my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr); |
7941
|
105
|
|
|
105
|
|
711
|
use strict 'refs'; |
|
105
|
|
|
|
|
320
|
|
|
105
|
|
|
|
|
842754
|
|
7942
|
|
|
|
|
|
|
|
7943
|
4885
|
|
|
|
|
8146
|
pop @{$$self{PATH}}; |
|
4885
|
|
|
|
|
11271
|
|
7944
|
4885
|
|
|
|
|
17623
|
@$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save; |
7945
|
4885
|
|
|
|
|
13657
|
SetByteOrder($oldOrder); |
7946
|
4885
|
|
|
|
|
19087
|
return $rtnVal; |
7947
|
|
|
|
|
|
|
} |
7948
|
|
|
|
|
|
|
|
7949
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7950
|
|
|
|
|
|
|
# Get Metadata path |
7951
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref |
7952
|
|
|
|
|
|
|
# Return: Metadata path string |
7953
|
|
|
|
|
|
|
sub MetadataPath($) |
7954
|
|
|
|
|
|
|
{ |
7955
|
724
|
|
|
724
|
0
|
1503
|
my $self = shift; |
7956
|
724
|
|
|
|
|
1304
|
return join '-', @{$$self{PATH}} |
|
724
|
|
|
|
|
3730
|
|
7957
|
|
|
|
|
|
|
} |
7958
|
|
|
|
|
|
|
|
7959
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7960
|
|
|
|
|
|
|
# Get standardized file extension |
7961
|
|
|
|
|
|
|
# Inputs: 0) file name |
7962
|
|
|
|
|
|
|
# Returns: standardized extension (all uppercase), or undefined if no extension |
7963
|
|
|
|
|
|
|
sub GetFileExtension($) |
7964
|
|
|
|
|
|
|
{ |
7965
|
1927
|
|
|
1927
|
0
|
3682
|
my $filename = shift; |
7966
|
1927
|
|
|
|
|
3152
|
my $fileExt; |
7967
|
1927
|
100
|
100
|
|
|
12557
|
if ($filename and $filename =~ /^.*\.([^.]+)$/s) { |
7968
|
1796
|
|
|
|
|
5379
|
$fileExt = uc($1); # change extension to upper case |
7969
|
|
|
|
|
|
|
# convert TIF extension to TIFF because we use the |
7970
|
|
|
|
|
|
|
# extension for the file type tag of TIFF images |
7971
|
1796
|
100
|
|
|
|
4589
|
$fileExt eq 'TIF' and $fileExt = 'TIFF'; |
7972
|
|
|
|
|
|
|
} |
7973
|
1927
|
|
|
|
|
6768
|
return $fileExt; |
7974
|
|
|
|
|
|
|
} |
7975
|
|
|
|
|
|
|
|
7976
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7977
|
|
|
|
|
|
|
# Get list of tag information hashes for given tag ID |
7978
|
|
|
|
|
|
|
# Inputs: 0) Tag table reference, 1) tag ID |
7979
|
|
|
|
|
|
|
# Returns: Array of tag information references |
7980
|
|
|
|
|
|
|
# Notes: Generates tagInfo hash if necessary |
7981
|
|
|
|
|
|
|
sub GetTagInfoList($$) |
7982
|
|
|
|
|
|
|
{ |
7983
|
531764
|
|
|
531764
|
0
|
854898
|
my ($tagTablePtr, $tagID) = @_; |
7984
|
531764
|
|
|
|
|
981820
|
my $tagInfo = $$tagTablePtr{$tagID}; |
7985
|
|
|
|
|
|
|
|
7986
|
531764
|
50
|
|
|
|
1145127
|
if ($specialTags{$tagID}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
7987
|
|
|
|
|
|
|
# (hopefully this won't happen) |
7988
|
0
|
|
|
|
|
0
|
warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n"; |
7989
|
|
|
|
|
|
|
} elsif (ref $tagInfo eq 'HASH') { |
7990
|
487561
|
|
|
|
|
999347
|
return ($tagInfo); |
7991
|
|
|
|
|
|
|
} elsif (ref $tagInfo eq 'ARRAY') { |
7992
|
10984
|
|
|
|
|
44843
|
return @$tagInfo; |
7993
|
|
|
|
|
|
|
} elsif ($tagInfo) { |
7994
|
|
|
|
|
|
|
# create hash with name |
7995
|
28780
|
|
|
|
|
64952
|
$tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo }; |
7996
|
28780
|
|
|
|
|
57316
|
return ($tagInfo); |
7997
|
|
|
|
|
|
|
} |
7998
|
4439
|
|
|
|
|
8303
|
return (); |
7999
|
|
|
|
|
|
|
} |
8000
|
|
|
|
|
|
|
|
8001
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8002
|
|
|
|
|
|
|
# Find tag information, processing conditional tags |
8003
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID |
8004
|
|
|
|
|
|
|
# 3) optional value reference, 4) optional format type, 5) optional value count |
8005
|
|
|
|
|
|
|
# Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed |
8006
|
|
|
|
|
|
|
# Notes: You should always call this routine to find a tag in a table because |
8007
|
|
|
|
|
|
|
# this routine will evaluate conditional tags. |
8008
|
|
|
|
|
|
|
# Arguments 3-5 are only required if the information type allows $valPt, $format and/or |
8009
|
|
|
|
|
|
|
# $count in a Condition, and if not given when needed this routine returns ''. |
8010
|
|
|
|
|
|
|
sub GetTagInfo($$$;$$$) |
8011
|
|
|
|
|
|
|
{ |
8012
|
106490
|
|
|
106490
|
0
|
203482
|
my ($self, $tagTablePtr, $tagID) = @_; |
8013
|
106490
|
|
|
|
|
153077
|
my ($valPt, $format, $count); |
8014
|
|
|
|
|
|
|
|
8015
|
106490
|
|
|
|
|
197064
|
my @infoArray = GetTagInfoList($tagTablePtr, $tagID); |
8016
|
|
|
|
|
|
|
# evaluate condition |
8017
|
106490
|
|
|
|
|
149016
|
my $tagInfo; |
8018
|
106490
|
|
|
|
|
180208
|
foreach $tagInfo (@infoArray) { |
8019
|
110846
|
|
|
|
|
229130
|
my $condition = $$tagInfo{Condition}; |
8020
|
110846
|
100
|
|
|
|
208809
|
if ($condition) { |
8021
|
12637
|
100
|
|
|
|
29747
|
($valPt, $format, $count) = splice(@_, 3) if @_ > 3; |
8022
|
12637
|
100
|
100
|
|
|
68785
|
return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt; |
8023
|
|
|
|
|
|
|
# set old value for use in condition if needed |
8024
|
11975
|
|
|
|
|
50608
|
local $SIG{'__WARN__'} = \&SetWarning; |
8025
|
11975
|
|
|
|
|
22149
|
undef $evalWarning; |
8026
|
|
|
|
|
|
|
#### eval Condition ($self, [$valPt, $format, $count]) |
8027
|
11975
|
100
|
|
|
|
879887
|
unless (eval $condition) { |
8028
|
9552
|
50
|
|
|
|
25723
|
$@ and $evalWarning = $@; |
8029
|
9552
|
50
|
|
|
|
18308
|
$self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning; |
8030
|
9552
|
|
|
|
|
43089
|
next; |
8031
|
|
|
|
|
|
|
} |
8032
|
|
|
|
|
|
|
} |
8033
|
|
|
|
|
|
|
# don't return Unknown tags unless that option is set (also see forum13716) |
8034
|
100632
|
100
|
100
|
|
|
253951
|
if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and not |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8035
|
|
|
|
|
|
|
($$self{OPTIONS}{Verbose} or $$self{HTML_DUMP} or |
8036
|
|
|
|
|
|
|
($$self{OPTIONS}{Validate} and not $$tagInfo{AddedUnknown}))) |
8037
|
|
|
|
|
|
|
{ |
8038
|
2061
|
|
|
|
|
5359
|
return undef; |
8039
|
|
|
|
|
|
|
} |
8040
|
|
|
|
|
|
|
# return the tag information we found |
8041
|
98571
|
|
|
|
|
233028
|
return $tagInfo; |
8042
|
|
|
|
|
|
|
} |
8043
|
|
|
|
|
|
|
# generate information for unknown tags (numerical only) if required |
8044
|
5196
|
100
|
100
|
|
|
34850
|
if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8045
|
|
|
|
|
|
|
$tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN}) |
8046
|
|
|
|
|
|
|
{ |
8047
|
599
|
|
|
|
|
1164
|
my $printConv; |
8048
|
599
|
100
|
|
|
|
1308
|
if (defined $$tagTablePtr{PRINT_CONV}) { |
8049
|
155
|
|
|
|
|
271
|
$printConv = $$tagTablePtr{PRINT_CONV}; |
8050
|
|
|
|
|
|
|
} else { |
8051
|
|
|
|
|
|
|
# limit length of printout (can be very long) |
8052
|
444
|
|
|
|
|
720
|
$printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val'; |
8053
|
|
|
|
|
|
|
} |
8054
|
599
|
|
|
|
|
2156
|
my $hex = sprintf("0x%.4x", $tagID); |
8055
|
599
|
|
|
|
|
1159
|
my $prefix = $$tagTablePtr{TAG_PREFIX}; |
8056
|
599
|
|
|
|
|
1873
|
$tagInfo = { |
8057
|
|
|
|
|
|
|
Name => "${prefix}_$hex", |
8058
|
|
|
|
|
|
|
Description => MakeDescription($prefix, $hex), |
8059
|
|
|
|
|
|
|
Unknown => 1, |
8060
|
|
|
|
|
|
|
Writable => 0, # can't write unknown tags |
8061
|
|
|
|
|
|
|
PrintConv => $printConv, |
8062
|
|
|
|
|
|
|
AddedUnknown => 1, |
8063
|
|
|
|
|
|
|
}; |
8064
|
|
|
|
|
|
|
# add tag information to table |
8065
|
599
|
|
|
|
|
1664
|
AddTagToTable($tagTablePtr, $tagID, $tagInfo); |
8066
|
|
|
|
|
|
|
} else { |
8067
|
4597
|
|
|
|
|
7218
|
undef $tagInfo; |
8068
|
|
|
|
|
|
|
} |
8069
|
5196
|
|
|
|
|
12583
|
return $tagInfo; |
8070
|
|
|
|
|
|
|
} |
8071
|
|
|
|
|
|
|
|
8072
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8073
|
|
|
|
|
|
|
# Add new tag to table (must use this routine to add new tags to a table) |
8074
|
|
|
|
|
|
|
# Inputs: 0) reference to tag table, 1) tag ID |
8075
|
|
|
|
|
|
|
# 2) [optional] tag name or reference to tag information hash |
8076
|
|
|
|
|
|
|
# 3) [optional] flag to avoid adding prefix when generating tag name |
8077
|
|
|
|
|
|
|
# Returns: tagInfo ref |
8078
|
|
|
|
|
|
|
# Notes: - will not override existing entry in table |
8079
|
|
|
|
|
|
|
# - info need contain no entries when this routine is called |
8080
|
|
|
|
|
|
|
# - tag name is cleaned if necessary |
8081
|
|
|
|
|
|
|
sub AddTagToTable($$;$$) |
8082
|
|
|
|
|
|
|
{ |
8083
|
6104
|
|
|
6104
|
0
|
12762
|
my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_; |
8084
|
|
|
|
|
|
|
|
8085
|
|
|
|
|
|
|
# generate tag info hash if necessary |
8086
|
6104
|
0
|
|
|
|
13597
|
$tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH'; |
|
|
50
|
|
|
|
|
|
8087
|
|
|
|
|
|
|
|
8088
|
|
|
|
|
|
|
# define necessary entries in information hash |
8089
|
6104
|
100
|
|
|
|
11911
|
if ($$tagInfo{Groups}) { |
8090
|
|
|
|
|
|
|
# fill in default groups from table GROUPS |
8091
|
432
|
|
|
|
|
781
|
foreach (keys %{$$tagTablePtr{GROUPS}}) { |
|
432
|
|
|
|
|
1484
|
|
8092
|
1296
|
100
|
|
|
|
2887
|
next if $$tagInfo{Groups}{$_}; |
8093
|
558
|
|
|
|
|
1250
|
$$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_}; |
8094
|
|
|
|
|
|
|
} |
8095
|
|
|
|
|
|
|
} else { |
8096
|
5672
|
|
|
|
|
7949
|
$$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} }; |
|
5672
|
|
|
|
|
27633
|
|
8097
|
|
|
|
|
|
|
} |
8098
|
6104
|
100
|
|
|
|
14695
|
$$tagInfo{Flags} and ExpandFlags($tagInfo); |
8099
|
|
|
|
|
|
|
$$tagInfo{GotGroups} = 1, |
8100
|
6104
|
|
|
|
|
13593
|
$$tagInfo{Table} = $tagTablePtr; |
8101
|
6104
|
|
|
|
|
13417
|
$$tagInfo{TagID} = $tagID; |
8102
|
6104
|
100
|
100
|
|
|
16057
|
if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) { |
8103
|
1442
|
|
|
|
|
2715
|
$$tagInfo{Avoid} = $$tagTablePtr{AVOID}; |
8104
|
|
|
|
|
|
|
} |
8105
|
|
|
|
|
|
|
|
8106
|
6104
|
|
|
|
|
10067
|
my $name = $$tagInfo{Name}; |
8107
|
6104
|
100
|
|
|
|
12509
|
$name = $tagID unless defined $name; |
8108
|
6104
|
|
|
|
|
12527
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
8109
|
6104
|
|
|
|
|
11720
|
$name = ucfirst $name; # capitalize first letter |
8110
|
|
|
|
|
|
|
# add tag-name prefix if specified and tag name not provided |
8111
|
6104
|
100
|
100
|
|
|
13622
|
unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) { |
|
|
|
66
|
|
|
|
|
8112
|
|
|
|
|
|
|
# make description to prevent tagID from getting mangled by MakeDescription() |
8113
|
22
|
|
|
|
|
73
|
$$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name); |
8114
|
22
|
|
|
|
|
60
|
$name = "$$tagTablePtr{TAG_PREFIX}_$name"; |
8115
|
|
|
|
|
|
|
} |
8116
|
|
|
|
|
|
|
# tag names must be at least 2 characters long and prefer them to start with a letter |
8117
|
6104
|
100
|
100
|
|
|
28970
|
$name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i; |
8118
|
6104
|
|
|
|
|
11411
|
$$tagInfo{Name} = $name; |
8119
|
|
|
|
|
|
|
# add tag to table, but never override existing entries (could potentially happen |
8120
|
|
|
|
|
|
|
# if someone thinks there isn't any tagInfo because a condition wasn't satisfied) |
8121
|
6104
|
50
|
66
|
|
|
21432
|
unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) { |
8122
|
6021
|
|
|
|
|
17489
|
$$tagTablePtr{$tagID} = $tagInfo; |
8123
|
|
|
|
|
|
|
} |
8124
|
6104
|
100
|
|
|
|
11991
|
$$tagInfo{AddedUnknown} = 1 if $$tagInfo{Unknown}; |
8125
|
6104
|
|
|
|
|
13531
|
return $tagInfo; |
8126
|
|
|
|
|
|
|
} |
8127
|
|
|
|
|
|
|
|
8128
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8129
|
|
|
|
|
|
|
# Handle simple extraction of new tag information |
8130
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value, |
8131
|
|
|
|
|
|
|
# 4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent, |
8132
|
|
|
|
|
|
|
# TagInfo, ProcessProc, RAF, Format, Count |
8133
|
|
|
|
|
|
|
# Returns: tag key or undef if tag not found |
8134
|
|
|
|
|
|
|
# Notes: if value is not defined, it is extracted from DataPt using TagInfo |
8135
|
|
|
|
|
|
|
# Format and Count if provided |
8136
|
|
|
|
|
|
|
sub HandleTag($$$$;%) |
8137
|
|
|
|
|
|
|
{ |
8138
|
9366
|
|
|
9366
|
0
|
36234
|
my ($self, $tagTablePtr, $tag, $val, %parms) = @_; |
8139
|
9366
|
|
|
|
|
17551
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8140
|
9366
|
|
|
|
|
14048
|
my $pfmt = $parms{Format}; |
8141
|
9366
|
|
100
|
|
|
35408
|
my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count}); |
8142
|
9366
|
|
|
|
|
19269
|
my $dataPt = $parms{DataPt}; |
8143
|
9366
|
|
|
|
|
14404
|
my ($subdir, $format, $noTagInfo, $rational); |
8144
|
|
|
|
|
|
|
|
8145
|
9366
|
100
|
|
|
|
16899
|
if ($tagInfo) { |
8146
|
7259
|
|
|
|
|
12739
|
$subdir = $$tagInfo{SubDirectory}; |
8147
|
|
|
|
|
|
|
} else { |
8148
|
2107
|
50
|
|
|
|
7466
|
return undef unless $verbose; |
8149
|
0
|
|
|
|
|
0
|
$tagInfo = { Name => "tag $tag" }; # create temporary tagInfo hash |
8150
|
0
|
|
|
|
|
0
|
$noTagInfo = 1; |
8151
|
|
|
|
|
|
|
} |
8152
|
|
|
|
|
|
|
# read value if not done already (not necessary for subdir) |
8153
|
7259
|
50
|
66
|
|
|
19784
|
unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) { |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8154
|
874
|
|
100
|
|
|
2820
|
my $start = $parms{Start} || 0; |
8155
|
874
|
50
|
|
|
|
2011
|
my $dLen = $dataPt ? length($$dataPt) : -1; |
8156
|
874
|
|
|
|
|
1432
|
my $size = $parms{Size}; |
8157
|
874
|
100
|
|
|
|
1897
|
$size = $dLen unless defined $size; |
8158
|
|
|
|
|
|
|
# read from data in memory if possible |
8159
|
874
|
50
|
33
|
|
|
3087
|
if ($start >= 0 and $start + $size <= $dLen) { |
8160
|
874
|
|
100
|
|
|
2964
|
$format = $$tagInfo{Format} || $$tagTablePtr{FORMAT}; |
8161
|
874
|
50
|
100
|
|
|
3402
|
$format = $pfmt if not $format and $pfmt and $formatSize{$pfmt}; |
|
|
|
66
|
|
|
|
|
8162
|
874
|
100
|
|
|
|
1607
|
if ($format) { |
8163
|
422
|
|
|
|
|
1422
|
$val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational); |
8164
|
|
|
|
|
|
|
} else { |
8165
|
452
|
|
|
|
|
1288
|
$val = substr($$dataPt, $start, $size); |
8166
|
|
|
|
|
|
|
} |
8167
|
|
|
|
|
|
|
} else { |
8168
|
0
|
|
|
|
|
0
|
$self->Warn("Error extracting value for $$tagInfo{Name}"); |
8169
|
0
|
|
|
|
|
0
|
return undef; |
8170
|
|
|
|
|
|
|
} |
8171
|
|
|
|
|
|
|
} |
8172
|
|
|
|
|
|
|
# do verbose print if necessary |
8173
|
7259
|
100
|
|
|
|
15489
|
if ($verbose) { |
8174
|
51
|
50
|
|
|
|
127
|
undef $tagInfo if $noTagInfo; |
8175
|
51
|
|
|
|
|
101
|
$parms{Value} = $val; |
8176
|
51
|
50
|
|
|
|
109
|
$parms{Value} .= " ($rational)" if defined $rational; |
8177
|
51
|
|
|
|
|
82
|
$parms{Table} = $tagTablePtr; |
8178
|
51
|
50
|
|
|
|
102
|
if ($format) { |
8179
|
0
|
|
0
|
|
|
0
|
my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1)); |
|
|
|
0
|
|
|
|
|
8180
|
0
|
|
|
|
|
0
|
$parms{Format} = $format . "[$count]"; |
8181
|
|
|
|
|
|
|
} |
8182
|
51
|
|
|
|
|
233
|
$self->VerboseInfo($tag, $tagInfo, %parms); |
8183
|
|
|
|
|
|
|
} |
8184
|
7259
|
50
|
|
|
|
14319
|
if ($tagInfo) { |
8185
|
7259
|
100
|
|
|
|
13742
|
if ($subdir) { |
8186
|
747
|
|
|
|
|
1429
|
my $subdirStart = $parms{Start}; |
8187
|
747
|
|
|
|
|
1354
|
my $subdirLen = $parms{Size}; |
8188
|
747
|
100
|
66
|
|
|
2206
|
if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) { |
8189
|
1
|
|
|
|
|
3
|
my $conv = $$tagInfo{RawConv}; |
8190
|
1
|
|
|
|
|
5
|
local $SIG{'__WARN__'} = \&SetWarning; |
8191
|
1
|
|
|
|
|
3
|
undef $evalWarning; |
8192
|
1
|
50
|
|
|
|
3
|
if (ref $conv eq 'CODE') { |
8193
|
0
|
|
|
|
|
0
|
$val = &$conv($val, $self); |
8194
|
|
|
|
|
|
|
} else { |
8195
|
1
|
|
|
|
|
2
|
my ($priority, @grps); |
8196
|
|
|
|
|
|
|
# NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm |
8197
|
|
|
|
|
|
|
#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) |
8198
|
1
|
|
|
|
|
103
|
$val = eval $conv; |
8199
|
1
|
50
|
|
|
|
7
|
$@ and $evalWarning = $@; |
8200
|
|
|
|
|
|
|
} |
8201
|
1
|
50
|
|
|
|
4
|
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; |
8202
|
1
|
50
|
|
|
|
3
|
return undef unless defined $val; |
8203
|
1
|
50
|
|
|
|
6
|
$val = $$val if ref $val eq 'SCALAR'; |
8204
|
1
|
|
|
|
|
3
|
$dataPt = \$val; |
8205
|
1
|
|
|
|
|
2
|
$subdirStart = 0; |
8206
|
1
|
|
|
|
|
7
|
$subdirLen = length $val; |
8207
|
|
|
|
|
|
|
} |
8208
|
747
|
100
|
|
|
|
1971
|
if ($$subdir{Start}) { |
8209
|
8
|
|
|
|
|
20
|
my $valuePtr = 0; |
8210
|
|
|
|
|
|
|
#### eval Start ($valuePtr) |
8211
|
8
|
|
|
|
|
436
|
my $off = eval $$subdir{Start}; |
8212
|
8
|
|
|
|
|
45
|
$subdirStart += $off; |
8213
|
8
|
|
|
|
|
21
|
$subdirLen -= $off; |
8214
|
|
|
|
|
|
|
} |
8215
|
747
|
100
|
|
|
|
1845
|
$dataPt or $dataPt = \$val; |
8216
|
|
|
|
|
|
|
# process subdirectory information |
8217
|
|
|
|
|
|
|
my %dirInfo = ( |
8218
|
|
|
|
|
|
|
DirName => $$subdir{DirName} || $$tagInfo{Name}, |
8219
|
|
|
|
|
|
|
DataPt => $dataPt, |
8220
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
8221
|
|
|
|
|
|
|
DataPos => $parms{DataPos}, |
8222
|
|
|
|
|
|
|
DirStart => $subdirStart, |
8223
|
|
|
|
|
|
|
DirLen => $subdirLen, |
8224
|
|
|
|
|
|
|
Parent => $parms{Parent}, |
8225
|
|
|
|
|
|
|
Base => $parms{Base}, |
8226
|
|
|
|
|
|
|
Multi => $$subdir{Multi}, |
8227
|
|
|
|
|
|
|
TagInfo => $tagInfo, |
8228
|
|
|
|
|
|
|
RAF => $parms{RAF}, |
8229
|
747
|
|
66
|
|
|
7119
|
); |
8230
|
747
|
|
|
|
|
1937
|
my $oldOrder = GetByteOrder(); |
8231
|
747
|
100
|
|
|
|
2115
|
if ($$subdir{ByteOrder}) { |
8232
|
3
|
100
|
|
|
|
16
|
if ($$subdir{ByteOrder} eq 'Unknown') { |
8233
|
1
|
50
|
|
|
|
4
|
if ($subdirStart + 2 <= $subdirLen) { |
8234
|
|
|
|
|
|
|
# attempt to determine the byte ordering of an IFD-style subdirectory |
8235
|
1
|
|
|
|
|
4
|
my $num = Get16u($dataPt, $subdirStart); |
8236
|
1
|
50
|
33
|
|
|
13
|
ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff); |
8237
|
|
|
|
|
|
|
} |
8238
|
|
|
|
|
|
|
} else { |
8239
|
2
|
|
|
|
|
7
|
SetByteOrder($$subdir{ByteOrder}); |
8240
|
|
|
|
|
|
|
} |
8241
|
|
|
|
|
|
|
} |
8242
|
747
|
|
33
|
|
|
2133
|
my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr; |
8243
|
747
|
|
100
|
|
|
4576
|
$self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc}); |
8244
|
747
|
|
|
|
|
2300
|
SetByteOrder($oldOrder); |
8245
|
|
|
|
|
|
|
# return now unless directory is writable as a block |
8246
|
747
|
50
|
|
|
|
5769
|
return undef unless $$tagInfo{Writable}; |
8247
|
|
|
|
|
|
|
} |
8248
|
6512
|
|
|
|
|
14220
|
my $key = $self->FoundTag($tagInfo, $val); |
8249
|
|
|
|
|
|
|
# save original components of rational numbers |
8250
|
6512
|
100
|
66
|
|
|
17429
|
$$self{RATIONAL}{$key} = $rational if defined $rational and defined $key; |
8251
|
6512
|
|
|
|
|
22184
|
return $key; |
8252
|
|
|
|
|
|
|
} |
8253
|
0
|
|
|
|
|
0
|
return undef; |
8254
|
|
|
|
|
|
|
} |
8255
|
|
|
|
|
|
|
|
8256
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8257
|
|
|
|
|
|
|
# Add tag to hash of extracted information |
8258
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8259
|
|
|
|
|
|
|
# 1) reference to tagInfo hash or tag name |
8260
|
|
|
|
|
|
|
# 2) data value (or reference to require hash if Composite) |
8261
|
|
|
|
|
|
|
# 3) optional family 0 group, 4) optional family 1 group |
8262
|
|
|
|
|
|
|
# Returns: tag key or undef if no value |
8263
|
|
|
|
|
|
|
sub FoundTag($$$;@) |
8264
|
|
|
|
|
|
|
{ |
8265
|
58147
|
|
|
58147
|
0
|
89915
|
local $_; |
8266
|
58147
|
|
|
|
|
112318
|
my ($self, $tagInfo, $value, @grps) = @_; |
8267
|
58147
|
|
|
|
|
85911
|
my ($tag, $noListDel, $tbl); |
8268
|
58147
|
|
|
|
|
97058
|
my $options = $$self{OPTIONS}; |
8269
|
|
|
|
|
|
|
|
8270
|
58147
|
100
|
|
|
|
123881
|
if (ref $tagInfo eq 'HASH') { |
8271
|
50844
|
50
|
|
|
|
140570
|
$tag = $$tagInfo{Name} or warn("No tag name\n"), return undef; |
8272
|
50844
|
|
|
|
|
88618
|
$tbl = $$tagInfo{Table}; |
8273
|
|
|
|
|
|
|
} else { |
8274
|
7303
|
|
|
|
|
10834
|
$tag = $tagInfo; |
8275
|
|
|
|
|
|
|
# look for tag in Extra |
8276
|
7303
|
|
|
|
|
14761
|
$tbl = GetTagTable('Image::ExifTool::Extra'); |
8277
|
7303
|
|
|
|
|
17679
|
$tagInfo = $self->GetTagInfo($tbl, $tag); |
8278
|
|
|
|
|
|
|
# make temporary hash if tag doesn't exist in Extra |
8279
|
|
|
|
|
|
|
# (not advised to do this since the tag won't show in list) |
8280
|
7303
|
100
|
|
|
|
15438
|
$tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool }; |
8281
|
7303
|
100
|
|
|
|
15993
|
$$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value); |
8282
|
|
|
|
|
|
|
} |
8283
|
|
|
|
|
|
|
# get tag priority |
8284
|
58147
|
|
|
|
|
89425
|
my $priority = $$tagInfo{Priority}; |
8285
|
58147
|
100
|
|
|
|
115516
|
unless (defined $priority) { |
8286
|
53765
|
|
|
|
|
84686
|
$priority = $$tbl{PRIORITY}; |
8287
|
53765
|
100
|
100
|
|
|
181443
|
$priority = 0 if not defined $priority and $$tagInfo{Avoid}; |
8288
|
|
|
|
|
|
|
} |
8289
|
58147
|
100
|
|
|
|
130715
|
$grps[0] or $grps[0] = $$self{SET_GROUP0}; |
8290
|
58147
|
100
|
|
|
|
118667
|
$grps[1] or $grps[1] = $$self{SET_GROUP1}; |
8291
|
58147
|
|
|
|
|
90093
|
my $valueHash = $$self{VALUE}; |
8292
|
|
|
|
|
|
|
|
8293
|
58147
|
100
|
|
|
|
116987
|
if ($$tagInfo{RawConv}) { |
8294
|
|
|
|
|
|
|
# initialize @val for use in Composite RawConv expressions |
8295
|
9045
|
|
|
|
|
14123
|
my @val; |
8296
|
9045
|
50
|
66
|
|
|
25214
|
if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) { |
8297
|
1729
|
|
|
|
|
4740
|
foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; } |
|
5810
|
|
|
|
|
14441
|
|
8298
|
|
|
|
|
|
|
} |
8299
|
9045
|
|
|
|
|
17415
|
my $conv = $$tagInfo{RawConv}; |
8300
|
9045
|
|
|
|
|
43783
|
local $SIG{'__WARN__'} = \&SetWarning; |
8301
|
9045
|
|
|
|
|
17440
|
undef $evalWarning; |
8302
|
9045
|
100
|
|
|
|
18267
|
if (ref $conv eq 'CODE') { |
8303
|
217
|
|
|
|
|
1088
|
$value = &$conv($value, $self); |
8304
|
217
|
50
|
|
|
|
798
|
$$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps}; |
|
0
|
|
|
|
|
0
|
|
8305
|
|
|
|
|
|
|
} else { |
8306
|
8828
|
|
|
|
|
14732
|
my $val = $value; # do this so eval can use $val |
8307
|
|
|
|
|
|
|
# NOTE: RawConv is also evaluated in Writer.pl |
8308
|
|
|
|
|
|
|
#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) |
8309
|
8828
|
|
|
|
|
782889
|
$value = eval $conv; |
8310
|
8828
|
50
|
|
|
|
38916
|
$@ and $evalWarning = $@; |
8311
|
|
|
|
|
|
|
} |
8312
|
9045
|
50
|
|
|
|
20022
|
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; |
8313
|
9045
|
100
|
|
|
|
40816
|
return undef unless defined $value; |
8314
|
|
|
|
|
|
|
} |
8315
|
|
|
|
|
|
|
# ignore specified tags (AFTER doing RawConv if necessary!) |
8316
|
55633
|
50
|
|
|
|
113200
|
if ($$options{IgnoreTags}) { |
8317
|
0
|
0
|
|
|
|
0
|
if ($$options{IgnoreTags}{all}) { |
8318
|
0
|
0
|
|
|
|
0
|
return undef unless $$self{REQ_TAG_LOOKUP}{lc $tag}; |
8319
|
|
|
|
|
|
|
} else { |
8320
|
0
|
0
|
|
|
|
0
|
return undef if $$options{IgnoreTags}{lc $tag}; |
8321
|
|
|
|
|
|
|
} |
8322
|
|
|
|
|
|
|
} |
8323
|
|
|
|
|
|
|
# handle duplicate tag names |
8324
|
55633
|
100
|
|
|
|
144845
|
if (defined $$valueHash{$tag}) { |
|
|
100
|
|
|
|
|
|
8325
|
|
|
|
|
|
|
# add to list if there is an active list for this tag |
8326
|
6596
|
100
|
|
|
|
18860
|
if ($$self{LIST_TAGS}{$tagInfo}) { |
8327
|
642
|
|
|
|
|
1582
|
$tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag |
8328
|
642
|
100
|
|
|
|
1449
|
if (defined $$self{NO_LIST}) { |
8329
|
|
|
|
|
|
|
# accumulate list in TAG_EXTRA "NoList" element |
8330
|
65
|
100
|
|
|
|
206
|
if (defined $$self{TAG_EXTRA}{$tag}{NoList}) { |
8331
|
31
|
|
|
|
|
71
|
push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value; |
|
31
|
|
|
|
|
157
|
|
8332
|
|
|
|
|
|
|
} else { |
8333
|
34
|
|
|
|
|
155
|
$$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ]; |
8334
|
|
|
|
|
|
|
} |
8335
|
65
|
|
|
|
|
149
|
$noListDel = 1; # set flag to delete this tag if re-listed |
8336
|
|
|
|
|
|
|
} else { |
8337
|
577
|
100
|
|
|
|
1724
|
if (ref $$valueHash{$tag} ne 'ARRAY') { |
8338
|
298
|
|
|
|
|
1007
|
$$valueHash{$tag} = [ $$valueHash{$tag} ]; |
8339
|
|
|
|
|
|
|
} |
8340
|
577
|
|
|
|
|
961
|
push @{$$valueHash{$tag}}, $value; |
|
577
|
|
|
|
|
1841
|
|
8341
|
577
|
|
|
|
|
2304
|
return $tag; # return without creating a new entry |
8342
|
|
|
|
|
|
|
} |
8343
|
|
|
|
|
|
|
} |
8344
|
|
|
|
|
|
|
# get next available tag key |
8345
|
6019
|
|
100
|
|
|
25982
|
my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1; |
8346
|
6019
|
|
|
|
|
15944
|
my $nextTag = "$tag ($nextInd)"; |
8347
|
|
|
|
|
|
|
# |
8348
|
|
|
|
|
|
|
# take tag with highest priority |
8349
|
|
|
|
|
|
|
# |
8350
|
|
|
|
|
|
|
# promote existing 0-priority tag so it takes precedence over a new 0-tag |
8351
|
|
|
|
|
|
|
# (unless old tag was a sub-document and new tag isn't. Also, never override |
8352
|
|
|
|
|
|
|
# a Warning tag because they may be added by ValueConv, which could be confusing) |
8353
|
6019
|
|
|
|
|
11724
|
my $oldPriority = $$self{PRIORITY}{$tag}; |
8354
|
6019
|
100
|
|
|
|
12551
|
unless ($oldPriority) { |
8355
|
5111
|
100
|
100
|
|
|
29799
|
if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8356
|
|
|
|
|
|
|
not $$self{TAG_EXTRA}{$tag}{G3}) |
8357
|
|
|
|
|
|
|
{ |
8358
|
5076
|
|
|
|
|
8963
|
$oldPriority = 1; |
8359
|
|
|
|
|
|
|
} else { |
8360
|
35
|
|
|
|
|
61
|
$oldPriority = 0; # don't promote sub-document tag over main document |
8361
|
|
|
|
|
|
|
} |
8362
|
|
|
|
|
|
|
} |
8363
|
|
|
|
|
|
|
# set priority for this tag |
8364
|
6019
|
100
|
100
|
|
|
26428
|
if (defined $priority) { |
|
|
100
|
33
|
|
|
|
|
8365
|
|
|
|
|
|
|
# increase 0-priority tags if this is the priority directory |
8366
|
|
|
|
|
|
|
$priority = 1 if not $priority and $$self{DIR_NAME} and |
8367
|
2014
|
100
|
100
|
|
|
11206
|
$$self{DIR_NAME} eq $$self{PRIORITY_DIR}; |
|
|
|
100
|
|
|
|
|
8368
|
|
|
|
|
|
|
} elsif ($$self{LOW_PRIORITY_DIR}{'*'} or |
8369
|
|
|
|
|
|
|
($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}})) |
8370
|
|
|
|
|
|
|
{ |
8371
|
411
|
|
|
|
|
674
|
$priority = 0; # default is 0 for a LOW_PRIORITY_DIR |
8372
|
|
|
|
|
|
|
} else { |
8373
|
3594
|
|
|
|
|
5844
|
$priority = 1; # the normal default |
8374
|
|
|
|
|
|
|
} |
8375
|
6019
|
100
|
100
|
|
|
28144
|
if ($priority >= $oldPriority and (not $$self{DOC_NUM} or |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8376
|
|
|
|
|
|
|
($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and |
8377
|
|
|
|
|
|
|
$$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel) |
8378
|
|
|
|
|
|
|
{ |
8379
|
|
|
|
|
|
|
# move existing tag out of the way since this tag is higher priority |
8380
|
|
|
|
|
|
|
# (NOTE: any new members added here must also be added to DeleteTag()) |
8381
|
2728
|
|
|
|
|
8807
|
$$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag}; |
8382
|
2728
|
|
|
|
|
7027
|
$$valueHash{$nextTag} = $$valueHash{$tag}; |
8383
|
2728
|
|
|
|
|
6416
|
$$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag}; |
8384
|
2728
|
|
|
|
|
7048
|
my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag}; |
8385
|
2728
|
|
|
|
|
5860
|
foreach ('TAG_EXTRA','RATIONAL') { |
8386
|
5456
|
100
|
|
|
|
13811
|
if ($$self{$_}{$tag}) { |
8387
|
1880
|
|
|
|
|
4338
|
$$self{$_}{$nextTag} = $$self{$_}{$tag}; |
8388
|
1880
|
|
|
|
|
4691
|
delete $$self{$_}{$tag}; |
8389
|
|
|
|
|
|
|
} |
8390
|
|
|
|
|
|
|
} |
8391
|
2728
|
|
|
|
|
4637
|
delete $$self{BOTH}{$tag}; |
8392
|
|
|
|
|
|
|
# update tag key for list if necessary |
8393
|
2728
|
100
|
|
|
|
6773
|
$$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo}; |
8394
|
|
|
|
|
|
|
# update this key if used in a Composite tag |
8395
|
2728
|
100
|
|
|
|
7587
|
if ($$self{COMP_KEYS}{$tag}) { |
8396
|
86
|
|
|
|
|
143
|
$$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}}; |
|
86
|
|
|
|
|
389
|
|
8397
|
86
|
|
|
|
|
255
|
$$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag}; |
8398
|
86
|
|
|
|
|
213
|
delete $$self{COMP_KEYS}{$tag}; |
8399
|
|
|
|
|
|
|
} |
8400
|
|
|
|
|
|
|
} else { |
8401
|
3291
|
|
|
|
|
5668
|
$tag = $nextTag; # don't override the existing tag |
8402
|
|
|
|
|
|
|
} |
8403
|
6019
|
|
|
|
|
15080
|
$$self{PRIORITY}{$tag} = $priority; |
8404
|
6019
|
100
|
|
|
|
13589
|
$$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel; |
8405
|
|
|
|
|
|
|
} elsif ($priority) { |
8406
|
|
|
|
|
|
|
# set tag priority (only if exists and is non-zero) |
8407
|
209
|
|
|
|
|
898
|
$$self{PRIORITY}{$tag} = $priority; |
8408
|
|
|
|
|
|
|
} |
8409
|
|
|
|
|
|
|
|
8410
|
|
|
|
|
|
|
# save the raw value, file order, tagInfo ref, group1 name, |
8411
|
|
|
|
|
|
|
# and tag key for lists if necessary |
8412
|
55056
|
|
|
|
|
149914
|
$$valueHash{$tag} = $value; |
8413
|
55056
|
|
|
|
|
120119
|
$$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND}; |
8414
|
55056
|
|
|
|
|
108516
|
$$self{TAG_INFO}{$tag} = $tagInfo; |
8415
|
|
|
|
|
|
|
# set dynamic groups 0, 1 and 3 if necessary |
8416
|
55056
|
100
|
|
|
|
105636
|
$$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0]; |
8417
|
55056
|
100
|
|
|
|
107487
|
$$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1]; |
8418
|
55056
|
100
|
|
|
|
109135
|
if ($$self{DOC_NUM}) { |
8419
|
1749
|
|
|
|
|
4458
|
$$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM}; |
8420
|
1749
|
50
|
|
|
|
7073
|
if ($$self{DOC_NUM} =~ /^(\d+)/) { |
8421
|
|
|
|
|
|
|
# keep track of maximum 1st-level sub-document number |
8422
|
1749
|
100
|
|
|
|
5821
|
$$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1; |
8423
|
|
|
|
|
|
|
} |
8424
|
|
|
|
|
|
|
} |
8425
|
|
|
|
|
|
|
# save path if requested |
8426
|
55056
|
100
|
|
|
|
110329
|
$$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath}; |
8427
|
|
|
|
|
|
|
|
8428
|
|
|
|
|
|
|
# remember this tagInfo if we will be accumulating values in a list |
8429
|
|
|
|
|
|
|
# (but don't override earlier list if this may be deleted by NoListDel flag) |
8430
|
55056
|
100
|
100
|
|
|
126305
|
if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) { |
|
|
|
100
|
|
|
|
|
8431
|
1108
|
|
|
|
|
4076
|
$$self{LIST_TAGS}{$tagInfo} = $tag; |
8432
|
|
|
|
|
|
|
} |
8433
|
|
|
|
|
|
|
|
8434
|
|
|
|
|
|
|
# validate tag if requested (but only for simple values -- could result |
8435
|
|
|
|
|
|
|
# in infinite recursion if called for a Composite tag (HASH ref value) |
8436
|
|
|
|
|
|
|
# because FoundTag is called in the middle of building Composite tags |
8437
|
55056
|
100
|
100
|
|
|
117992
|
if ($$options{Validate} and not ref $value) { |
8438
|
213
|
|
|
|
|
663
|
Image::ExifTool::Validate::ValidateRaw($self, $tag, $value); |
8439
|
|
|
|
|
|
|
} |
8440
|
|
|
|
|
|
|
|
8441
|
55056
|
|
|
|
|
150411
|
return $tag; |
8442
|
|
|
|
|
|
|
} |
8443
|
|
|
|
|
|
|
|
8444
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8445
|
|
|
|
|
|
|
# Make current directory the priority directory if not set already |
8446
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8447
|
|
|
|
|
|
|
sub SetPriorityDir($) |
8448
|
|
|
|
|
|
|
{ |
8449
|
22
|
|
|
22
|
0
|
68
|
my $self = shift; |
8450
|
22
|
50
|
|
|
|
530
|
$$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR}; |
8451
|
|
|
|
|
|
|
} |
8452
|
|
|
|
|
|
|
|
8453
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8454
|
|
|
|
|
|
|
# Set family 0 or 1 group name specific to this tag instance |
8455
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag key, 2) group name, 3) family (default 1) |
8456
|
|
|
|
|
|
|
sub SetGroup($$$;$) |
8457
|
|
|
|
|
|
|
{ |
8458
|
13237
|
|
|
13237
|
0
|
29203
|
my ($self, $tagKey, $extra, $fam) = @_; |
8459
|
13237
|
50
|
|
|
|
56939
|
$$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra; |
8460
|
|
|
|
|
|
|
} |
8461
|
|
|
|
|
|
|
|
8462
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8463
|
|
|
|
|
|
|
# Delete specified tag |
8464
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag key |
8465
|
|
|
|
|
|
|
sub DeleteTag($$) |
8466
|
|
|
|
|
|
|
{ |
8467
|
224
|
|
|
224
|
0
|
451
|
my ($self, $tag) = @_; |
8468
|
224
|
|
|
|
|
443
|
delete $$self{VALUE}{$tag}; |
8469
|
224
|
|
|
|
|
409
|
delete $$self{FILE_ORDER}{$tag}; |
8470
|
224
|
|
|
|
|
364
|
delete $$self{TAG_INFO}{$tag}; |
8471
|
224
|
|
|
|
|
452
|
delete $$self{TAG_EXTRA}{$tag}; |
8472
|
224
|
|
|
|
|
352
|
delete $$self{PRIORITY}{$tag}; |
8473
|
224
|
|
|
|
|
343
|
delete $$self{RATIONAL}{$tag}; |
8474
|
224
|
|
|
|
|
601
|
delete $$self{BOTH}{$tag}; |
8475
|
|
|
|
|
|
|
} |
8476
|
|
|
|
|
|
|
|
8477
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8478
|
|
|
|
|
|
|
# Escape all elements of a value |
8479
|
|
|
|
|
|
|
# Inputs: 0) value, 1) escape proc |
8480
|
|
|
|
|
|
|
sub DoEscape($$) |
8481
|
|
|
|
|
|
|
{ |
8482
|
173
|
|
|
173
|
0
|
254
|
my ($val, $key); |
8483
|
173
|
100
|
|
|
|
335
|
if (not ref $_[0]) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
8484
|
167
|
|
|
|
|
239
|
$_[0] = &{$_[1]}($_[0]); |
|
167
|
|
|
|
|
434
|
|
8485
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'ARRAY') { |
8486
|
4
|
|
|
|
|
8
|
foreach $val (@{$_[0]}) { |
|
4
|
|
|
|
|
17
|
|
8487
|
10
|
|
|
|
|
28
|
DoEscape($val, $_[1]); |
8488
|
|
|
|
|
|
|
} |
8489
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'HASH') { |
8490
|
0
|
|
|
|
|
0
|
foreach $key (keys %{$_[0]}) { |
|
0
|
|
|
|
|
0
|
|
8491
|
0
|
|
|
|
|
0
|
DoEscape($_[0]{$key}, $_[1]); |
8492
|
|
|
|
|
|
|
} |
8493
|
|
|
|
|
|
|
} |
8494
|
|
|
|
|
|
|
} |
8495
|
|
|
|
|
|
|
|
8496
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8497
|
|
|
|
|
|
|
# Set the FileType and MIMEType tags |
8498
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8499
|
|
|
|
|
|
|
# 1) Optional file type (uses FILE_TYPE if not specified) |
8500
|
|
|
|
|
|
|
# 2) Optional MIME type (uses our lookup if not specified) |
8501
|
|
|
|
|
|
|
# 3) Optional recommended extension (converted to lower case; uses FileType if undef) |
8502
|
|
|
|
|
|
|
# Notes: Will NOT set file type twice (subsequent calls ignored) |
8503
|
|
|
|
|
|
|
sub SetFileType($;$$$) |
8504
|
|
|
|
|
|
|
{ |
8505
|
638
|
|
|
638
|
0
|
2416
|
my ($self, $fileType, $mimeType, $normExt) = @_; |
8506
|
638
|
100
|
66
|
|
|
4604
|
unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) { |
8507
|
590
|
|
|
|
|
1566
|
my $baseType = $$self{FILE_TYPE}; |
8508
|
590
|
|
|
|
|
1458
|
my $ext = $$self{FILE_EXT}; |
8509
|
590
|
100
|
|
|
|
2051
|
$fileType or $fileType = $baseType; |
8510
|
|
|
|
|
|
|
# handle sub-types which are identified by extension |
8511
|
590
|
100
|
100
|
|
|
4475
|
if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) { |
|
|
|
66
|
|
|
|
|
8512
|
257
|
|
|
|
|
1111
|
my ($f,$e) = @fileTypeLookup{$fileType,$ext}; |
8513
|
257
|
100
|
100
|
|
|
2072
|
if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) { |
|
|
|
100
|
|
|
|
|
8514
|
|
|
|
|
|
|
# make sure $fileType was a root type and not another sub-type |
8515
|
10
|
100
|
66
|
|
|
77
|
$fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]}; |
8516
|
|
|
|
|
|
|
} |
8517
|
|
|
|
|
|
|
} |
8518
|
590
|
100
|
|
|
|
2739
|
$mimeType or $mimeType = $mimeType{$fileType}; |
8519
|
|
|
|
|
|
|
# use base file type if necessary (except if 'TIFF', which is a special case) |
8520
|
590
|
100
|
66
|
|
|
2534
|
$mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF'; |
8521
|
590
|
100
|
|
|
|
1891
|
unless (defined $normExt) { |
8522
|
580
|
|
|
|
|
1741
|
$normExt = $fileTypeExt{$fileType}; |
8523
|
580
|
100
|
|
|
|
2094
|
$normExt = $fileType unless defined $normExt; |
8524
|
|
|
|
|
|
|
} |
8525
|
590
|
|
|
|
|
1589
|
$$self{FileType} = $fileType; |
8526
|
590
|
|
|
|
|
2528
|
$self->FoundTag('FileType', $fileType); |
8527
|
590
|
|
|
|
|
3739
|
$self->FoundTag('FileTypeExtension', uc $normExt); |
8528
|
590
|
|
100
|
|
|
3891
|
$self->FoundTag('MIMEType', $mimeType || 'application/unknown'); |
8529
|
|
|
|
|
|
|
} |
8530
|
|
|
|
|
|
|
} |
8531
|
|
|
|
|
|
|
|
8532
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8533
|
|
|
|
|
|
|
# Override the FileType and MIMEType tags |
8534
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension (lower case) |
8535
|
|
|
|
|
|
|
# Notes: does nothing if FileType was not previously defined (ie. when writing) |
8536
|
|
|
|
|
|
|
sub OverrideFileType($$;$$) |
8537
|
|
|
|
|
|
|
{ |
8538
|
18
|
|
|
18
|
0
|
81
|
my ($self, $fileType, $mimeType, $normExt) = @_; |
8539
|
18
|
100
|
66
|
|
|
154
|
if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) { |
8540
|
12
|
|
|
|
|
48
|
$$self{FileType} = $fileType; |
8541
|
12
|
|
|
|
|
37
|
$$self{VALUE}{FileType} = $fileType; |
8542
|
12
|
100
|
|
|
|
49
|
unless (defined $normExt) { |
8543
|
5
|
|
|
|
|
15
|
$normExt = $fileTypeExt{$fileType}; |
8544
|
5
|
50
|
|
|
|
23
|
$normExt = $fileType unless defined $normExt; |
8545
|
|
|
|
|
|
|
} |
8546
|
12
|
|
|
|
|
33
|
$$self{VALUE}{FileTypeExtension} = uc $normExt; |
8547
|
12
|
50
|
|
|
|
56
|
$mimeType or $mimeType = $mimeType{$fileType}; |
8548
|
12
|
100
|
|
|
|
42
|
$$self{VALUE}{MIMEType} = $mimeType if $mimeType; |
8549
|
12
|
50
|
|
|
|
141
|
if ($$self{OPTIONS}{Verbose}) { |
8550
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n"); |
8551
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n"); |
8552
|
0
|
0
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType; |
8553
|
|
|
|
|
|
|
} |
8554
|
|
|
|
|
|
|
} |
8555
|
|
|
|
|
|
|
} |
8556
|
|
|
|
|
|
|
|
8557
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8558
|
|
|
|
|
|
|
# Modify the value of the MIMEType tag |
8559
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) file or MIME type |
8560
|
|
|
|
|
|
|
# Notes: combines existing type with new type: ie) a/b + c/d => c/b-d |
8561
|
|
|
|
|
|
|
sub ModifyMimeType($;$) |
8562
|
|
|
|
|
|
|
{ |
8563
|
8
|
|
|
8
|
0
|
30
|
my ($self, $mime) = @_; |
8564
|
8
|
50
|
33
|
|
|
58
|
$mime =~ m{/} or $mime = $mimeType{$mime} or return; |
8565
|
8
|
|
|
|
|
31
|
my $old = $$self{VALUE}{MIMEType}; |
8566
|
8
|
50
|
|
|
|
26
|
if (defined $old) { |
8567
|
8
|
|
|
|
|
46
|
my ($a, $b) = split '/', $old; |
8568
|
8
|
|
|
|
|
39
|
my ($c, $d) = split '/', $mime; |
8569
|
8
|
|
|
|
|
23
|
$d =~ s/^x-//; |
8570
|
8
|
|
|
|
|
34
|
$$self{VALUE}{MIMEType} = "$c/$b-$d"; |
8571
|
8
|
|
|
|
|
44
|
$self->VPrint(0, " Modified MIMEType = $c/$b-$d\n"); |
8572
|
|
|
|
|
|
|
} else { |
8573
|
0
|
|
|
|
|
0
|
$self->FoundTag('MIMEType', $mime); |
8574
|
|
|
|
|
|
|
} |
8575
|
|
|
|
|
|
|
} |
8576
|
|
|
|
|
|
|
|
8577
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8578
|
|
|
|
|
|
|
# Print verbose output |
8579
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args |
8580
|
|
|
|
|
|
|
sub VPrint($$@) |
8581
|
|
|
|
|
|
|
{ |
8582
|
9156
|
|
|
9156
|
0
|
16673
|
my $self = shift; |
8583
|
9156
|
|
|
|
|
14070
|
my $level = shift; |
8584
|
9156
|
100
|
66
|
|
|
34202
|
if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) { |
8585
|
4
|
|
|
|
|
9
|
my $out = $$self{OPTIONS}{TextOut}; |
8586
|
4
|
|
|
|
|
20
|
print $out @_; |
8587
|
4
|
50
|
|
|
|
28
|
print $out "\n" unless $_[-1] =~ /\n$/; |
8588
|
|
|
|
|
|
|
} |
8589
|
|
|
|
|
|
|
} |
8590
|
|
|
|
|
|
|
|
8591
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8592
|
|
|
|
|
|
|
# Print verbose directory information |
8593
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref |
8594
|
|
|
|
|
|
|
# 2) number of entries in directory (or 0 if unknown) |
8595
|
|
|
|
|
|
|
# 3) optional size of directory in bytes |
8596
|
|
|
|
|
|
|
sub VerboseDir($$;$$) |
8597
|
|
|
|
|
|
|
{ |
8598
|
449
|
|
|
449
|
0
|
1215
|
my ($self, $name, $entries, $size) = @_; |
8599
|
449
|
100
|
|
|
|
1765
|
return unless $$self{OPTIONS}{Verbose}; |
8600
|
44
|
50
|
|
|
|
120
|
if (ref $name eq 'HASH') { |
8601
|
0
|
0
|
|
|
|
0
|
$size = $$name{DirLen} unless $size; |
8602
|
0
|
|
0
|
|
|
0
|
$name = $$name{Name} || $$name{DirName}; |
8603
|
|
|
|
|
|
|
} |
8604
|
44
|
|
|
|
|
104
|
my $indent = substr($$self{INDENT}, 0, -2); |
8605
|
44
|
|
|
|
|
82
|
my $out = $$self{OPTIONS}{TextOut}; |
8606
|
44
|
100
|
66
|
|
|
196
|
my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : ''; |
8607
|
44
|
100
|
|
|
|
119
|
$str .= ", $size bytes" if $size; |
8608
|
44
|
|
|
|
|
174
|
print $out "$indent+ [$name directory$str]\n"; |
8609
|
|
|
|
|
|
|
} |
8610
|
|
|
|
|
|
|
|
8611
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8612
|
|
|
|
|
|
|
# Verbose dump |
8613
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options |
8614
|
|
|
|
|
|
|
sub VerboseDump($$;%) |
8615
|
|
|
|
|
|
|
{ |
8616
|
128
|
|
|
128
|
0
|
240
|
my $self = shift; |
8617
|
128
|
|
|
|
|
201
|
my $dataPt = shift; |
8618
|
128
|
|
|
|
|
252
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8619
|
128
|
50
|
33
|
|
|
420
|
if ($verbose and $verbose > 2) { |
8620
|
|
|
|
|
|
|
my %parms = ( |
8621
|
|
|
|
|
|
|
Prefix => $$self{INDENT}, |
8622
|
|
|
|
|
|
|
Out => $$self{OPTIONS}{TextOut}, |
8623
|
0
|
0
|
|
|
|
0
|
MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef, |
|
|
0
|
|
|
|
|
|
8624
|
|
|
|
|
|
|
); |
8625
|
0
|
|
|
|
|
0
|
HexDump($dataPt, undef, %parms, @_); |
8626
|
|
|
|
|
|
|
} |
8627
|
|
|
|
|
|
|
} |
8628
|
|
|
|
|
|
|
|
8629
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8630
|
|
|
|
|
|
|
# Print data in hex |
8631
|
|
|
|
|
|
|
# Inputs: 0) data |
8632
|
|
|
|
|
|
|
# Returns: hex string |
8633
|
|
|
|
|
|
|
# (this is a convenience function for use in debugging PrintConv statements) |
8634
|
|
|
|
|
|
|
sub PrintHex($) |
8635
|
|
|
|
|
|
|
{ |
8636
|
0
|
|
|
0
|
0
|
0
|
my $val = shift; |
8637
|
0
|
|
|
|
|
0
|
return join(' ', unpack('H2' x length($val), $val)); |
8638
|
|
|
|
|
|
|
} |
8639
|
|
|
|
|
|
|
|
8640
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8641
|
|
|
|
|
|
|
# Extract binary data from file |
8642
|
|
|
|
|
|
|
# 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional |
8643
|
|
|
|
|
|
|
# Returns: binary data, or undef on error |
8644
|
|
|
|
|
|
|
# Notes: Returns "Binary data #### bytes" instead of data unless tag is |
8645
|
|
|
|
|
|
|
# specifically requested or the Binary option is set |
8646
|
|
|
|
|
|
|
sub ExtractBinary($$$;$) |
8647
|
|
|
|
|
|
|
{ |
8648
|
47
|
|
|
47
|
0
|
186
|
my ($self, $offset, $length, $tag) = @_; |
8649
|
47
|
|
|
|
|
102
|
my ($isPreview, $buff); |
8650
|
|
|
|
|
|
|
|
8651
|
47
|
100
|
|
|
|
151
|
if ($tag) { |
8652
|
43
|
100
|
|
|
|
176
|
if ($tag eq 'PreviewImage') { |
8653
|
|
|
|
|
|
|
# save PreviewImage start/length in case we want to dump trailer |
8654
|
29
|
|
|
|
|
114
|
$$self{PreviewImageStart} = $offset; |
8655
|
29
|
|
|
|
|
104
|
$$self{PreviewImageLength} = $length; |
8656
|
29
|
|
|
|
|
82
|
$isPreview = 1; |
8657
|
|
|
|
|
|
|
} |
8658
|
43
|
|
|
|
|
139
|
my $lcTag = lc $tag; |
8659
|
43
|
50
|
66
|
|
|
475
|
if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
8660
|
|
|
|
|
|
|
not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag}) |
8661
|
|
|
|
|
|
|
{ |
8662
|
34
|
|
|
|
|
208
|
return "Binary data $length bytes"; |
8663
|
|
|
|
|
|
|
} |
8664
|
|
|
|
|
|
|
} |
8665
|
13
|
100
|
66
|
|
|
68
|
unless ($$self{RAF}->Seek($offset,0) |
8666
|
|
|
|
|
|
|
and $$self{RAF}->Read($buff, $length) == $length) |
8667
|
|
|
|
|
|
|
{ |
8668
|
5
|
50
|
|
|
|
27
|
$tag or $tag = 'binary data'; |
8669
|
5
|
50
|
33
|
|
|
47
|
if ($isPreview and not $$self{BuildingComposite}) { |
8670
|
0
|
|
|
|
|
0
|
$$self{PreviewError} = 1; |
8671
|
|
|
|
|
|
|
} else { |
8672
|
5
|
|
|
|
|
46
|
$self->Warn("Error reading $tag from file", $isPreview); |
8673
|
|
|
|
|
|
|
} |
8674
|
5
|
|
|
|
|
65
|
return undef; |
8675
|
|
|
|
|
|
|
} |
8676
|
8
|
|
|
|
|
37
|
return $buff; |
8677
|
|
|
|
|
|
|
} |
8678
|
|
|
|
|
|
|
|
8679
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8680
|
|
|
|
|
|
|
# Process binary data |
8681
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref |
8682
|
|
|
|
|
|
|
# Returns: 1 on success |
8683
|
|
|
|
|
|
|
# Notes: dirInfo may contain VarFormatData (reference to empty list) to return |
8684
|
|
|
|
|
|
|
# details about any variable-length-format tags in the table (used when writing) |
8685
|
|
|
|
|
|
|
sub ProcessBinaryData($$$) |
8686
|
|
|
|
|
|
|
{ |
8687
|
2070
|
|
|
2070
|
0
|
4604
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
8688
|
2070
|
|
|
|
|
4262
|
my $dataPt = $$dirInfo{DataPt}; |
8689
|
2070
|
|
100
|
|
|
7154
|
my $offset = $$dirInfo{DirStart} || 0; |
8690
|
2070
|
|
66
|
|
|
5423
|
my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset); |
8691
|
2070
|
|
100
|
|
|
5873
|
my $base = $$dirInfo{Base} || 0; |
8692
|
2070
|
|
|
|
|
4236
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8693
|
2070
|
|
|
|
|
3753
|
my $unknown = $$self{OPTIONS}{Unknown}; |
8694
|
2070
|
|
100
|
|
|
6302
|
my $dataPos = $$dirInfo{DataPos} || 0; |
8695
|
|
|
|
|
|
|
|
8696
|
|
|
|
|
|
|
# get default format ('int8u' unless specified) |
8697
|
2070
|
|
100
|
|
|
7175
|
my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u'; |
8698
|
2070
|
|
|
|
|
4330
|
my $increment = $formatSize{$defaultFormat}; |
8699
|
2070
|
50
|
|
|
|
4498
|
unless ($increment) { |
8700
|
0
|
|
|
|
|
0
|
warn "Unknown format $defaultFormat\n"; |
8701
|
0
|
|
|
|
|
0
|
$defaultFormat = 'int8u'; |
8702
|
0
|
|
|
|
|
0
|
$increment = $formatSize{$defaultFormat}; |
8703
|
|
|
|
|
|
|
} |
8704
|
|
|
|
|
|
|
# prepare list of tag numbers to extract |
8705
|
2070
|
|
|
|
|
3750
|
my (@tags, $topIndex); |
8706
|
2070
|
50
|
33
|
|
|
9580
|
if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8707
|
|
|
|
|
|
|
# don't create a stupid number of tags if data is huge |
8708
|
0
|
0
|
|
|
|
0
|
my $sizeLimit = $size < 65536 ? $size : 65536; |
8709
|
|
|
|
|
|
|
# scan through entire binary table |
8710
|
0
|
|
|
|
|
0
|
$topIndex = int($sizeLimit/$increment); |
8711
|
0
|
|
|
|
|
0
|
@tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1)); |
8712
|
|
|
|
|
|
|
# add in floating point tag ID's if they exist |
8713
|
0
|
|
|
|
|
0
|
my @ftags = grep /\./, TagTableKeys($tagTablePtr); |
8714
|
0
|
0
|
|
|
|
0
|
@tags = sort { $a <=> $b } @tags, @ftags if @ftags; |
|
0
|
|
|
|
|
0
|
|
8715
|
|
|
|
|
|
|
} elsif ($$dirInfo{DataMember}) { |
8716
|
192
|
|
|
|
|
345
|
@tags = @{$$dirInfo{DataMember}}; |
|
192
|
|
|
|
|
630
|
|
8717
|
192
|
|
|
|
|
395
|
$verbose = 0; # no verbose output of extracted values when writing |
8718
|
|
|
|
|
|
|
} elsif ($$dirInfo{MixedTags}) { |
8719
|
|
|
|
|
|
|
# process sorted integer-ID tags only |
8720
|
38
|
|
|
|
|
129
|
@tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr); |
|
468
|
|
|
|
|
865
|
|
8721
|
|
|
|
|
|
|
} else { |
8722
|
|
|
|
|
|
|
# extract known tags in numerical order |
8723
|
1840
|
50
|
|
|
|
4739
|
@tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr); |
|
54027
|
50
|
|
|
|
105054
|
|
8724
|
|
|
|
|
|
|
} |
8725
|
2070
|
100
|
|
|
|
6856
|
$self->VerboseDir('BinaryData', undef, $size) if $verbose; |
8726
|
|
|
|
|
|
|
# avoid creating unknown tags for tags that fail condition if Unknown is 1 |
8727
|
2070
|
50
|
|
|
|
6570
|
$$self{NO_UNKNOWN} = 1 if $unknown < 2; |
8728
|
2070
|
|
|
|
|
3471
|
my ($index, %val); |
8729
|
2070
|
|
|
|
|
4111
|
my $nextIndex = 0; |
8730
|
2070
|
|
|
|
|
3211
|
my $varSize = 0; |
8731
|
2070
|
|
|
|
|
4638
|
foreach $index (@tags) { |
8732
|
17209
|
|
|
|
|
29429
|
my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational); |
8733
|
17209
|
50
|
0
|
|
|
38900
|
if ($$tagTablePtr{$index}) { |
|
|
0
|
|
|
|
|
|
8734
|
17209
|
|
|
|
|
38581
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index); |
8735
|
17209
|
100
|
|
|
|
37114
|
unless ($tagInfo) { |
8736
|
718
|
100
|
|
|
|
1884
|
next unless defined $tagInfo; |
8737
|
44
|
|
|
|
|
209
|
my $entry = int($index) * $increment + $varSize; |
8738
|
44
|
50
|
|
|
|
178
|
if ($entry < 0) { |
8739
|
0
|
|
|
|
|
0
|
$entry += $size; |
8740
|
0
|
0
|
|
|
|
0
|
next if $entry < 0; |
8741
|
|
|
|
|
|
|
} |
8742
|
44
|
100
|
|
|
|
235
|
next if $entry >= $size; |
8743
|
4
|
|
|
|
|
13
|
my $more = $size - $entry; |
8744
|
4
|
50
|
|
|
|
18
|
$more = 128 if $more > 128; |
8745
|
4
|
|
|
|
|
15
|
my $v = substr($$dataPt, $entry+$offset, $more); |
8746
|
4
|
|
|
|
|
20
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index, \$v); |
8747
|
4
|
50
|
|
|
|
19
|
next unless $tagInfo; |
8748
|
|
|
|
|
|
|
} |
8749
|
|
|
|
|
|
|
next if $$tagInfo{Unknown} and |
8750
|
16495
|
100
|
66
|
|
|
34513
|
($$tagInfo{Unknown} > $unknown or $index < $nextIndex); |
|
|
|
66
|
|
|
|
|
8751
|
|
|
|
|
|
|
} elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) { |
8752
|
0
|
0
|
|
|
|
0
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next; |
8753
|
|
|
|
|
|
|
} else { |
8754
|
|
|
|
|
|
|
# don't generate unknown tags in binary tables unless Unknown > 1 |
8755
|
0
|
0
|
|
|
|
0
|
next unless $unknown > 1; |
8756
|
0
|
0
|
|
|
|
0
|
next if $index < $nextIndex; # skip if data already used |
8757
|
0
|
0
|
|
|
|
0
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next; |
8758
|
0
|
|
|
|
|
0
|
$$tagInfo{Unknown} = 2; # set unknown to 2 for binary unknowns |
8759
|
|
|
|
|
|
|
} |
8760
|
|
|
|
|
|
|
# get relative offset of this entry |
8761
|
16494
|
|
|
|
|
29892
|
my $entry = int($index) * $increment + $varSize; |
8762
|
|
|
|
|
|
|
# allow negative indices to represent bytes from end |
8763
|
16494
|
50
|
|
|
|
31659
|
if ($entry < 0) { |
8764
|
0
|
|
|
|
|
0
|
$entry += $size; |
8765
|
0
|
0
|
|
|
|
0
|
next if $entry < 0; |
8766
|
|
|
|
|
|
|
} |
8767
|
16494
|
|
|
|
|
24585
|
my $more = $size - $entry; |
8768
|
16494
|
100
|
|
|
|
31239
|
last if $more <= 0; # all done if we have reached the end of data |
8769
|
16235
|
|
|
|
|
22865
|
my $count = 1; |
8770
|
16235
|
|
|
|
|
31378
|
my $format = $$tagInfo{Format}; |
8771
|
16235
|
100
|
|
|
|
42971
|
if (not $format) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8772
|
9356
|
|
|
|
|
14994
|
$format = $defaultFormat; |
8773
|
|
|
|
|
|
|
} elsif ($format eq 'string') { |
8774
|
|
|
|
|
|
|
# string with no specified count runs to end of block |
8775
|
104
|
|
|
|
|
263
|
$count = $more; |
8776
|
|
|
|
|
|
|
} elsif ($format eq 'pstring') { |
8777
|
0
|
|
|
|
|
0
|
$format = 'string'; |
8778
|
0
|
|
|
|
|
0
|
$count = Get8u($dataPt, ($entry++)+$offset); |
8779
|
0
|
|
|
|
|
0
|
--$more; |
8780
|
|
|
|
|
|
|
} elsif (not $formatSize{$format}) { |
8781
|
3124
|
100
|
|
|
|
17582
|
if ($format =~ /(.*)\[(.*)\]/) { |
|
|
50
|
|
|
|
|
|
8782
|
|
|
|
|
|
|
# handle format count field |
8783
|
2939
|
|
|
|
|
7904
|
$format = $1; |
8784
|
2939
|
|
|
|
|
5598
|
$count = $2; |
8785
|
|
|
|
|
|
|
# evaluate count to allow count to be based on previous values |
8786
|
|
|
|
|
|
|
#### eval Format size (%val, $size, $self) |
8787
|
2939
|
|
|
|
|
132076
|
$count = eval $count; |
8788
|
2939
|
50
|
|
|
|
11548
|
$@ and warn("Format $$tagInfo{Name}: $@"), next; |
8789
|
2939
|
50
|
|
|
|
7053
|
next if $count < 0; |
8790
|
|
|
|
|
|
|
# allow a variable-length value of any format |
8791
|
|
|
|
|
|
|
# (note: the next incremental index points to data immediately after |
8792
|
|
|
|
|
|
|
# this value, regardless of the size of this value, even if it is zero) |
8793
|
2939
|
50
|
|
|
|
7676
|
if ($format =~ s/^var_//) { |
8794
|
0
|
|
0
|
|
|
0
|
$varSize += $count * ($formatSize{$format} || 1) - $increment; |
8795
|
0
|
|
|
|
|
0
|
$wasVar = 1; |
8796
|
|
|
|
|
|
|
# save variable size data if required for writing |
8797
|
0
|
0
|
|
|
|
0
|
if ($$dirInfo{VarFormatData}) { |
8798
|
0
|
|
|
|
|
0
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
0
|
|
|
|
|
0
|
|
8799
|
|
|
|
|
|
|
} |
8800
|
|
|
|
|
|
|
# don't extract value if large and we wanted it just to get |
8801
|
|
|
|
|
|
|
# the variable-format information when writing |
8802
|
0
|
0
|
0
|
|
|
0
|
next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData}; |
8803
|
|
|
|
|
|
|
} |
8804
|
|
|
|
|
|
|
} elsif ($format =~ /^var_/) { |
8805
|
|
|
|
|
|
|
# handle variable-length string formats |
8806
|
185
|
|
|
|
|
526
|
$format = substr($format, 4); |
8807
|
185
|
|
|
|
|
719
|
pos($$dataPt) = $entry + $offset; |
8808
|
185
|
|
|
|
|
447
|
undef $count; |
8809
|
185
|
50
|
100
|
|
|
1162
|
if ($format eq 'ustring') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
8810
|
0
|
0
|
|
|
|
0
|
$count = pos($$dataPt) - ($entry+$offset) if $$dataPt =~ /\G(..)*?\0\0/sg; |
8811
|
0
|
|
|
|
|
0
|
$varSize -= 2; # ($count includes base size of 2 bytes) |
8812
|
|
|
|
|
|
|
} elsif ($format eq 'pstring') { |
8813
|
0
|
|
|
|
|
0
|
$count = Get8u($dataPt, ($entry++)+$offset); |
8814
|
0
|
|
|
|
|
0
|
--$more; |
8815
|
|
|
|
|
|
|
} elsif ($format eq 'pstr32' or $format eq 'ustr32') { |
8816
|
170
|
50
|
|
|
|
419
|
last if $more < 4; |
8817
|
170
|
|
|
|
|
497
|
$count = Get32u($dataPt, $entry + $offset); |
8818
|
170
|
100
|
|
|
|
572
|
$count *= 2 if $format eq 'ustr32'; |
8819
|
170
|
|
|
|
|
291
|
$entry += 4; |
8820
|
170
|
|
|
|
|
281
|
$more -= 4; |
8821
|
170
|
|
|
|
|
433
|
$nextIndex += 4 / $increment; # (increment next index for int32u) |
8822
|
|
|
|
|
|
|
} elsif ($format eq 'int16u') { |
8823
|
|
|
|
|
|
|
# int16u size of binary data to follow |
8824
|
10
|
50
|
|
|
|
32
|
last if $more < 2; |
8825
|
10
|
|
|
|
|
30
|
$count = Get16u($dataPt, $entry + $offset) + 2; |
8826
|
10
|
|
|
|
|
21
|
$varSize -= 2; # ($count includes size word) |
8827
|
10
|
|
|
|
|
21
|
$format = 'undef'; |
8828
|
|
|
|
|
|
|
} elsif ($format eq 'ue7') { |
8829
|
3
|
|
|
|
|
15
|
require Image::ExifTool::BPG; |
8830
|
3
|
|
|
|
|
13
|
($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $offset); |
8831
|
3
|
50
|
|
|
|
8
|
last unless defined $val; |
8832
|
3
|
|
|
|
|
5
|
--$varSize; # ($count includes base size of 1 byte) |
8833
|
|
|
|
|
|
|
} elsif ($$dataPt =~ /\0/g) { |
8834
|
2
|
|
|
|
|
6
|
$count = pos($$dataPt) - ($entry+$offset); |
8835
|
2
|
|
|
|
|
4
|
--$varSize; # ($count includes base size of 1 byte) |
8836
|
|
|
|
|
|
|
} |
8837
|
185
|
50
|
33
|
|
|
850
|
$count = $more if not defined $count or $count > $more; |
8838
|
185
|
|
|
|
|
317
|
$varSize += $count; # shift subsequent indices |
8839
|
185
|
100
|
|
|
|
462
|
unless (defined $val) { |
8840
|
182
|
|
|
|
|
488
|
$val = substr($$dataPt, $entry+$offset, $count); |
8841
|
182
|
100
|
66
|
|
|
1076
|
$val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32'; |
8842
|
182
|
100
|
|
|
|
627
|
$val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null |
8843
|
|
|
|
|
|
|
} |
8844
|
185
|
|
|
|
|
352
|
$wasVar = 1; |
8845
|
|
|
|
|
|
|
# save variable size data if required for writing |
8846
|
185
|
100
|
|
|
|
556
|
if ($$dirInfo{VarFormatData}) { |
8847
|
5
|
|
|
|
|
9
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
5
|
|
|
|
|
20
|
|
8848
|
|
|
|
|
|
|
} |
8849
|
|
|
|
|
|
|
} |
8850
|
|
|
|
|
|
|
} |
8851
|
|
|
|
|
|
|
# hook to allow format, etc to be set dynamically |
8852
|
16235
|
100
|
|
|
|
36640
|
if (defined $$tagInfo{Hook}) { |
8853
|
540
|
|
|
|
|
838
|
my $oldVarSize = $varSize; |
8854
|
540
|
|
|
|
|
873
|
my $pos = $entry + $offset; |
8855
|
|
|
|
|
|
|
#### eval Hook ($format, $varSize, $size, $dataPt, $pos) |
8856
|
540
|
|
|
|
|
34833
|
eval $$tagInfo{Hook}; |
8857
|
|
|
|
|
|
|
# save variable size data if required for writing (in case changed by Hook) |
8858
|
540
|
100
|
66
|
|
|
2917
|
if ($$dirInfo{VarFormatData}) { |
|
|
50
|
|
|
|
|
|
8859
|
247
|
50
|
|
|
|
617
|
$#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag |
|
0
|
|
|
|
|
0
|
|
8860
|
247
|
|
|
|
|
336
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
247
|
|
|
|
|
940
|
|
8861
|
|
|
|
|
|
|
} elsif ($varSize != $oldVarSize and $verbose > 2) { |
8862
|
0
|
|
|
|
|
0
|
my ($tmp, $sign) = ($varSize, '+'); |
8863
|
0
|
0
|
|
|
|
0
|
$tmp < 0 and $tmp = -$tmp, $sign = '-'; |
8864
|
0
|
|
|
|
|
0
|
$self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index)); |
8865
|
|
|
|
|
|
|
} |
8866
|
|
|
|
|
|
|
} |
8867
|
16235
|
50
|
|
|
|
32208
|
if ($unknown > 1) { |
8868
|
|
|
|
|
|
|
# calculate next valid index for unknown tag |
8869
|
0
|
|
|
|
|
0
|
my $ni = int $index; |
8870
|
0
|
0
|
0
|
|
|
0
|
$ni += (($formatSize{$format} || 1) * $count) / $increment unless $wasVar; |
8871
|
0
|
|
|
|
|
0
|
$saveNextIndex = $nextIndex; |
8872
|
0
|
0
|
|
|
|
0
|
$nextIndex = $ni unless $nextIndex > $ni; |
8873
|
|
|
|
|
|
|
} |
8874
|
|
|
|
|
|
|
# allow large tags to be excluded from extraction |
8875
|
|
|
|
|
|
|
# (provides a work-around for some tight memory situations) |
8876
|
16235
|
50
|
33
|
|
|
34657
|
next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}}; |
8877
|
|
|
|
|
|
|
# read value now if necessary |
8878
|
16235
|
100
|
66
|
|
|
36072
|
unless (defined $val and not $$tagInfo{SubDirectory}) { |
8879
|
16050
|
|
|
|
|
39708
|
$val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational); |
8880
|
16050
|
50
|
|
|
|
32751
|
next unless defined $val; |
8881
|
16050
|
|
|
|
|
28901
|
$mask = $$tagInfo{Mask}; |
8882
|
16050
|
100
|
|
|
|
30726
|
$val = ($val & $mask) >> $$tagInfo{BitShift} if $mask; |
8883
|
|
|
|
|
|
|
} |
8884
|
16235
|
100
|
66
|
|
|
33216
|
if ($verbose and not $$tagInfo{Hidden}) { |
8885
|
198
|
50
|
33
|
|
|
502
|
if (not $$tagInfo{SubDirectory} or $$tagInfo{Format}) { |
8886
|
198
|
|
50
|
|
|
455
|
$len = $count * ($formatSize{$format} || 1); |
8887
|
198
|
50
|
|
|
|
408
|
$len = $more if $len > $more; |
8888
|
|
|
|
|
|
|
} else { |
8889
|
0
|
|
|
|
|
0
|
$len = $more; |
8890
|
|
|
|
|
|
|
} |
8891
|
198
|
50
|
|
|
|
937
|
$self->VerboseInfo($index, $tagInfo, |
8892
|
|
|
|
|
|
|
Table => $tagTablePtr, |
8893
|
|
|
|
|
|
|
Value => $val, |
8894
|
|
|
|
|
|
|
DataPt => $dataPt, |
8895
|
|
|
|
|
|
|
Size => $len, |
8896
|
|
|
|
|
|
|
Start => $entry+$offset, |
8897
|
|
|
|
|
|
|
Addr => $entry+$offset+$base+$dataPos, |
8898
|
|
|
|
|
|
|
Format => $format, |
8899
|
|
|
|
|
|
|
Count => $count, |
8900
|
|
|
|
|
|
|
Extra => $mask ? sprintf(', mask 0x%.2x',$mask) : undef, |
8901
|
|
|
|
|
|
|
); |
8902
|
|
|
|
|
|
|
} |
8903
|
|
|
|
|
|
|
# parse nested BinaryData directories |
8904
|
16235
|
100
|
|
|
|
32494
|
if ($$tagInfo{SubDirectory}) { |
8905
|
14
|
|
|
|
|
56
|
my $subdir = $$tagInfo{SubDirectory}; |
8906
|
14
|
|
|
|
|
75
|
my $subTablePtr = GetTagTable($$subdir{TagTable}); |
8907
|
|
|
|
|
|
|
# use specified subdirectory length if given |
8908
|
14
|
100
|
66
|
|
|
136
|
if ($$tagInfo{Format} and $formatSize{$format}) { |
8909
|
12
|
|
|
|
|
41
|
$len = $count * $formatSize{$format}; |
8910
|
12
|
50
|
|
|
|
47
|
$len = $more if $len > $more; |
8911
|
|
|
|
|
|
|
} else { |
8912
|
2
|
|
|
|
|
4
|
$len = $more; # directory size is all of remaining data |
8913
|
2
|
50
|
33
|
|
|
18
|
if ($$subTablePtr{PROCESS_PROC} and |
8914
|
|
|
|
|
|
|
$$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData) |
8915
|
|
|
|
|
|
|
{ |
8916
|
|
|
|
|
|
|
# the rest of the data will be printed in the subdirectory |
8917
|
2
|
|
|
|
|
9
|
$nextIndex = $size / $increment; |
8918
|
|
|
|
|
|
|
} |
8919
|
|
|
|
|
|
|
} |
8920
|
14
|
|
|
|
|
36
|
my $subdirBase = $base; |
8921
|
14
|
50
|
|
|
|
53
|
if (defined $$subdir{Base}) { |
8922
|
|
|
|
|
|
|
#### eval Base ($start,$base) |
8923
|
0
|
|
|
|
|
0
|
my $start = $entry + $offset + $dataPos; |
8924
|
0
|
|
|
|
|
0
|
$subdirBase = eval($$subdir{Base}) + $base; |
8925
|
|
|
|
|
|
|
} |
8926
|
14
|
|
50
|
|
|
74
|
my $start = $$subdir{Start} || 0; |
8927
|
14
|
|
|
|
|
105
|
my %subdirInfo = ( |
8928
|
|
|
|
|
|
|
DataPt => $dataPt, |
8929
|
|
|
|
|
|
|
DataPos => $dataPos, |
8930
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
8931
|
|
|
|
|
|
|
DirStart => $entry + $offset + $start, |
8932
|
|
|
|
|
|
|
DirLen => $len - $start, |
8933
|
|
|
|
|
|
|
Base => $subdirBase, |
8934
|
|
|
|
|
|
|
); |
8935
|
14
|
|
|
|
|
45
|
delete $$self{NO_UNKNOWN}; |
8936
|
14
|
|
|
|
|
139
|
$self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc}); |
8937
|
14
|
50
|
|
|
|
91
|
$$self{NO_UNKNOWN} = 1 if $unknown < 2; |
8938
|
14
|
|
|
|
|
58
|
next; |
8939
|
|
|
|
|
|
|
} |
8940
|
16221
|
100
|
66
|
|
|
37120
|
if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') { |
8941
|
38
|
|
|
|
|
95
|
my $et = $self; |
8942
|
|
|
|
|
|
|
#### eval IsOffset ($val, $et) |
8943
|
38
|
100
|
|
|
|
2317
|
$val += $base + $$self{BASE} if eval $$tagInfo{IsOffset}; |
8944
|
|
|
|
|
|
|
} |
8945
|
16221
|
|
|
|
|
36497
|
$val{$index} = $val; |
8946
|
16221
|
|
|
|
|
22148
|
my $oldBase; |
8947
|
16221
|
50
|
|
|
|
30981
|
if ($$tagInfo{SetBase}) { |
8948
|
0
|
|
|
|
|
0
|
$oldBase = $$self{BASE}; |
8949
|
0
|
|
|
|
|
0
|
$$self{BASE} += $base; |
8950
|
|
|
|
|
|
|
} |
8951
|
16221
|
|
|
|
|
38945
|
my $key = $self->FoundTag($tagInfo,$val); |
8952
|
16221
|
50
|
|
|
|
35324
|
$$self{BASE} = $oldBase if defined $oldBase; |
8953
|
16221
|
100
|
|
|
|
27874
|
if ($key) { |
8954
|
14878
|
100
|
|
|
|
38502
|
$$self{RATIONAL}{$key} = $rational if defined $rational; |
8955
|
|
|
|
|
|
|
} else { |
8956
|
|
|
|
|
|
|
# don't increment nextIndex if we didn't extract a tag |
8957
|
1343
|
50
|
|
|
|
4286
|
$nextIndex = $saveNextIndex if defined $saveNextIndex; |
8958
|
|
|
|
|
|
|
} |
8959
|
|
|
|
|
|
|
} |
8960
|
2070
|
|
|
|
|
4826
|
delete $$self{NO_UNKNOWN}; |
8961
|
2070
|
|
|
|
|
10135
|
return 1; |
8962
|
|
|
|
|
|
|
} |
8963
|
|
|
|
|
|
|
|
8964
|
|
|
|
|
|
|
#.............................................................................. |
8965
|
|
|
|
|
|
|
# Load .ExifTool_config file from user's home directory |
8966
|
|
|
|
|
|
|
# (use of noConfig is now deprecated, use configFile = '' instead) |
8967
|
|
|
|
|
|
|
until ($Image::ExifTool::noConfig) { |
8968
|
|
|
|
|
|
|
my $config = $Image::ExifTool::configFile; |
8969
|
|
|
|
|
|
|
my $file; |
8970
|
|
|
|
|
|
|
if (not defined $config) { |
8971
|
|
|
|
|
|
|
$config = '.ExifTool_config'; |
8972
|
|
|
|
|
|
|
# get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell) |
8973
|
|
|
|
|
|
|
my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} || |
8974
|
|
|
|
|
|
|
($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.'; |
8975
|
|
|
|
|
|
|
# look for the config file in 1) the home directory, 2) the program dir |
8976
|
|
|
|
|
|
|
$file = "$home/$config"; |
8977
|
|
|
|
|
|
|
} else { |
8978
|
|
|
|
|
|
|
length $config or last; # filename of "" disables configuration |
8979
|
|
|
|
|
|
|
$file = $config; |
8980
|
|
|
|
|
|
|
} |
8981
|
|
|
|
|
|
|
# also check executable directory unless path is absolute |
8982
|
|
|
|
|
|
|
$exeDir = ($0 =~ /(.*)[\\\/]/) ? $1 : '.' unless defined $exeDir; |
8983
|
|
|
|
|
|
|
-r $file or $config =~ /^\// or $file = "$exeDir/$config"; |
8984
|
|
|
|
|
|
|
unless (-r $file) { |
8985
|
|
|
|
|
|
|
warn("Config file not found\n") if defined $Image::ExifTool::configFile; |
8986
|
|
|
|
|
|
|
last; |
8987
|
|
|
|
|
|
|
} |
8988
|
|
|
|
|
|
|
unshift @INC, '.'; # look in current directory first |
8989
|
|
|
|
|
|
|
eval { require $file }; # load the config file |
8990
|
|
|
|
|
|
|
shift @INC; |
8991
|
|
|
|
|
|
|
# print warning (minus "Compilation failed" part) |
8992
|
|
|
|
|
|
|
$@ and $_=$@, s/Compilation failed.*//s, warn $_; |
8993
|
|
|
|
|
|
|
last; |
8994
|
|
|
|
|
|
|
} |
8995
|
|
|
|
|
|
|
# read user-defined lenses (may have been defined by script instead of config file) |
8996
|
|
|
|
|
|
|
if (@Image::ExifTool::UserDefined::Lenses) { |
8997
|
|
|
|
|
|
|
foreach (@Image::ExifTool::UserDefined::Lenses) { |
8998
|
|
|
|
|
|
|
$Image::ExifTool::userLens{$_} = 1; |
8999
|
|
|
|
|
|
|
} |
9000
|
|
|
|
|
|
|
} |
9001
|
|
|
|
|
|
|
# add user-defined file types |
9002
|
|
|
|
|
|
|
if (%Image::ExifTool::UserDefined::FileTypes) { |
9003
|
|
|
|
|
|
|
foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) { |
9004
|
|
|
|
|
|
|
my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_}; |
9005
|
|
|
|
|
|
|
my $type = uc $_; |
9006
|
|
|
|
|
|
|
ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next; |
9007
|
|
|
|
|
|
|
my $baseType = $$fileInfo{BaseType}; |
9008
|
|
|
|
|
|
|
if ($baseType) { |
9009
|
|
|
|
|
|
|
if ($$fileInfo{Description}) { |
9010
|
|
|
|
|
|
|
$fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ]; |
9011
|
|
|
|
|
|
|
} else { |
9012
|
|
|
|
|
|
|
$fileTypeLookup{$type} = $baseType; |
9013
|
|
|
|
|
|
|
} |
9014
|
|
|
|
|
|
|
if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) { |
9015
|
|
|
|
|
|
|
# first make sure we are using an actual base type and not a derived type |
9016
|
|
|
|
|
|
|
$baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType}; |
9017
|
|
|
|
|
|
|
# mark this type as not writable |
9018
|
|
|
|
|
|
|
$noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ]; |
9019
|
|
|
|
|
|
|
push @{$noWriteFile{$baseType}}, $type; |
9020
|
|
|
|
|
|
|
} |
9021
|
|
|
|
|
|
|
} else { |
9022
|
|
|
|
|
|
|
$fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ]; |
9023
|
|
|
|
|
|
|
$moduleName{$type} = 0; # not supported |
9024
|
|
|
|
|
|
|
if ($$fileInfo{Magic}) { |
9025
|
|
|
|
|
|
|
$magicNumber{$type} = $$fileInfo{Magic}; |
9026
|
|
|
|
|
|
|
push @fileTypes, $type unless grep /^$type$/, @fileTypes; |
9027
|
|
|
|
|
|
|
} |
9028
|
|
|
|
|
|
|
} |
9029
|
|
|
|
|
|
|
$mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType}; |
9030
|
|
|
|
|
|
|
} |
9031
|
|
|
|
|
|
|
} |
9032
|
|
|
|
|
|
|
|
9033
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
9034
|
|
|
|
|
|
|
1; # end |