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
|
104
|
|
|
104
|
|
201845
|
use strict; |
|
104
|
|
|
|
|
758
|
|
|
104
|
|
|
|
|
3585
|
|
19
|
|
|
|
|
|
|
require 5.004; # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do) |
20
|
|
|
|
|
|
|
require Exporter; |
21
|
104
|
|
|
104
|
|
39258
|
use File::RandomAccess; |
|
104
|
|
|
|
|
283
|
|
|
104
|
|
|
|
|
4986
|
|
22
|
104
|
|
|
104
|
|
103064
|
use overload; |
|
104
|
|
|
|
|
140904
|
|
|
104
|
|
|
|
|
864
|
|
23
|
|
|
|
|
|
|
|
24
|
104
|
|
|
|
|
569973
|
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
|
104
|
|
|
104
|
|
7978
|
%static_vars); |
|
104
|
|
|
|
|
1444
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$VERSION = '12.42'; |
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
|
|
|
|
|
|
|
PICT PNG MNG FLIF DjVu DPX OpenEXR ZISRAW MRC LIF MRC::FEI12 MIFF PCX PGF |
143
|
|
|
|
|
|
|
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 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
|
|
|
|
|
|
|
my %writeTypes; # lookup for writable file types (hash filled if required) |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
# file extensions that we can't write for various base types |
202
|
|
|
|
|
|
|
%noWriteFile = ( |
203
|
|
|
|
|
|
|
TIFF => [ qw(3FR DCR K25 KDC SRF) ], |
204
|
|
|
|
|
|
|
XMP => [ qw(SVG INX) ], |
205
|
|
|
|
|
|
|
JP2 => [ qw(J2C JPC) ], |
206
|
|
|
|
|
|
|
MOV => [ qw(INSV) ], |
207
|
|
|
|
|
|
|
); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# file types that we can create from scratch |
210
|
|
|
|
|
|
|
# - must update CanCreate() documentation if this list is changed! |
211
|
|
|
|
|
|
|
my %createTypes = map { $_ => 1 } qw(XMP ICC MIE VRD DR4 EXIF EXV); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# file type lookup for all recognized file extensions (upper case) |
214
|
|
|
|
|
|
|
# (if extension may be more than one type, the type is a list where |
215
|
|
|
|
|
|
|
# the writable type should come first if it exists) |
216
|
|
|
|
|
|
|
%fileTypeLookup = ( |
217
|
|
|
|
|
|
|
'360' => ['MOV', 'GoPro 360 video'], |
218
|
|
|
|
|
|
|
'3FR' => ['TIFF', 'Hasselblad RAW format'], |
219
|
|
|
|
|
|
|
'3G2' => ['MOV', '3rd Gen. Partnership Project 2 audio/video'], |
220
|
|
|
|
|
|
|
'3GP' => ['MOV', '3rd Gen. Partnership Project audio/video'], |
221
|
|
|
|
|
|
|
'3GP2'=> '3G2', |
222
|
|
|
|
|
|
|
'3GPP'=> '3GP', |
223
|
|
|
|
|
|
|
A => ['EXE', 'Static library'], |
224
|
|
|
|
|
|
|
AA => ['AA', 'Audible Audiobook'], |
225
|
|
|
|
|
|
|
AAE => ['PLIST','Apple edit information'], |
226
|
|
|
|
|
|
|
AAX => ['MOV', 'Audible Enhanced Audiobook'], |
227
|
|
|
|
|
|
|
ACR => ['DICOM','American College of Radiology ACR-NEMA'], |
228
|
|
|
|
|
|
|
ACFM => ['Font', 'Adobe Composite Font Metrics'], |
229
|
|
|
|
|
|
|
AFM => ['Font', 'Adobe Font Metrics'], |
230
|
|
|
|
|
|
|
AMFM => ['Font', 'Adobe Multiple Master Font Metrics'], |
231
|
|
|
|
|
|
|
AI => [['PDF','PS'], 'Adobe Illustrator'], |
232
|
|
|
|
|
|
|
AIF => 'AIFF', |
233
|
|
|
|
|
|
|
AIFC => ['AIFF', 'Audio Interchange File Format Compressed'], |
234
|
|
|
|
|
|
|
AIFF => ['AIFF', 'Audio Interchange File Format'], |
235
|
|
|
|
|
|
|
AIT => 'AI', |
236
|
|
|
|
|
|
|
ALIAS=> ['ALIAS','MacOS file alias'], |
237
|
|
|
|
|
|
|
APE => ['APE', "Monkey's Audio format"], |
238
|
|
|
|
|
|
|
APNG => ['PNG', 'Animated Portable Network Graphics'], |
239
|
|
|
|
|
|
|
ARW => ['TIFF', 'Sony Alpha RAW format'], |
240
|
|
|
|
|
|
|
ARQ => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'], |
241
|
|
|
|
|
|
|
ASF => ['ASF', 'Microsoft Advanced Systems Format'], |
242
|
|
|
|
|
|
|
AVC => ['AVC', 'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID) |
243
|
|
|
|
|
|
|
AVI => ['RIFF', 'Audio Video Interleaved'], |
244
|
|
|
|
|
|
|
AVIF => ['MOV', 'AV1 Image File Format'], |
245
|
|
|
|
|
|
|
AZW => 'MOBI', # (see http://wiki.mobileread.com/wiki/AZW) |
246
|
|
|
|
|
|
|
AZW3 => 'MOBI', |
247
|
|
|
|
|
|
|
BMP => ['BMP', 'Windows Bitmap'], |
248
|
|
|
|
|
|
|
BPG => ['BPG', 'Better Portable Graphics'], |
249
|
|
|
|
|
|
|
BTF => ['BTF', 'Big Tagged Image File Format'], #(unofficial) |
250
|
|
|
|
|
|
|
BZ2 => ['BZ2', 'BZIP2 archive'], |
251
|
|
|
|
|
|
|
CHM => ['CHM', 'Microsoft Compiled HTML format'], |
252
|
|
|
|
|
|
|
CIFF => ['CRW', 'Camera Image File Format'], |
253
|
|
|
|
|
|
|
COS => ['COS', 'Capture One Settings'], |
254
|
|
|
|
|
|
|
CR2 => ['TIFF', 'Canon RAW 2 format'], |
255
|
|
|
|
|
|
|
CR3 => ['MOV', 'Canon RAW 3 format'], |
256
|
|
|
|
|
|
|
CRM => ['MOV', 'Canon RAW Movie'], |
257
|
|
|
|
|
|
|
CRW => ['CRW', 'Canon RAW format'], |
258
|
|
|
|
|
|
|
CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW'], |
259
|
|
|
|
|
|
|
CSV => ['TXT', 'Comma-Separated Values'], |
260
|
|
|
|
|
|
|
CZI => ['CZI', 'Zeiss Integrated Software RAW'], |
261
|
|
|
|
|
|
|
DC3 => 'DICM', |
262
|
|
|
|
|
|
|
DCM => 'DICM', |
263
|
|
|
|
|
|
|
DCP => ['TIFF', 'DNG Camera Profile'], |
264
|
|
|
|
|
|
|
DCR => ['TIFF', 'Kodak Digital Camera RAW'], |
265
|
|
|
|
|
|
|
DCX => ['DCX', 'Multi-page PC Paintbrush'], |
266
|
|
|
|
|
|
|
DEX => ['DEX', 'Dalvik Executable format'], |
267
|
|
|
|
|
|
|
DFONT=> ['Font', 'Macintosh Data fork Font'], |
268
|
|
|
|
|
|
|
DIB => ['BMP', 'Device Independent Bitmap'], |
269
|
|
|
|
|
|
|
DIC => 'DICM', |
270
|
|
|
|
|
|
|
DICM => ['DICOM','Digital Imaging and Communications in Medicine'], |
271
|
|
|
|
|
|
|
DIR => ['DIR', 'Directory'], |
272
|
|
|
|
|
|
|
DIVX => ['ASF', 'DivX media format'], |
273
|
|
|
|
|
|
|
DJV => 'DJVU', |
274
|
|
|
|
|
|
|
DJVU => ['AIFF', 'DjVu image'], |
275
|
|
|
|
|
|
|
DLL => ['EXE', 'Windows Dynamic Link Library'], |
276
|
|
|
|
|
|
|
DNG => ['TIFF', 'Digital Negative'], |
277
|
|
|
|
|
|
|
DOC => ['FPX', 'Microsoft Word Document'], |
278
|
|
|
|
|
|
|
DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'], |
279
|
|
|
|
|
|
|
# Note: I have seen a password-protected DOCX file which was FPX-like, so I assume |
280
|
|
|
|
|
|
|
# that any other MS Office file could be like this too. The only difference is |
281
|
|
|
|
|
|
|
# that the ZIP and FPX formats are checked first, so if this is wrong, no biggie. |
282
|
|
|
|
|
|
|
DOCX => [['ZIP','FPX'], 'Office Open XML Document'], |
283
|
|
|
|
|
|
|
DOT => ['FPX', 'Microsoft Word Template'], |
284
|
|
|
|
|
|
|
DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'], |
285
|
|
|
|
|
|
|
DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'], |
286
|
|
|
|
|
|
|
DPX => ['DPX', 'Digital Picture Exchange' ], |
287
|
|
|
|
|
|
|
DR4 => ['DR4', 'Canon VRD version 4 Recipe'], |
288
|
|
|
|
|
|
|
DS2 => ['DSS', 'Digital Speech Standard 2'], |
289
|
|
|
|
|
|
|
DSS => ['DSS', 'Digital Speech Standard'], |
290
|
|
|
|
|
|
|
DV => ['DV', 'Digital Video'], |
291
|
|
|
|
|
|
|
DVB => ['MOV', 'Digital Video Broadcasting'], |
292
|
|
|
|
|
|
|
'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'], |
293
|
|
|
|
|
|
|
DWF => ['DWF', 'Autodesk drawing (Design Web Format)'], |
294
|
|
|
|
|
|
|
DWG => ['DWG', 'AutoCAD Drawing'], |
295
|
|
|
|
|
|
|
DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'], |
296
|
|
|
|
|
|
|
DXF => ['DXF', 'AutoCAD Drawing Exchange Format'], |
297
|
|
|
|
|
|
|
EIP => ['ZIP', 'Capture One Enhanced Image Package'], |
298
|
|
|
|
|
|
|
EPS => ['EPS', 'Encapsulated PostScript Format'], |
299
|
|
|
|
|
|
|
EPS2 => 'EPS', |
300
|
|
|
|
|
|
|
EPS3 => 'EPS', |
301
|
|
|
|
|
|
|
EPSF => 'EPS', |
302
|
|
|
|
|
|
|
EPUB => ['ZIP', 'Electronic Publication'], |
303
|
|
|
|
|
|
|
ERF => ['TIFF', 'Epson Raw Format'], |
304
|
|
|
|
|
|
|
EXE => ['EXE', 'Windows executable file'], |
305
|
|
|
|
|
|
|
EXR => ['EXR', 'Open EXR'], |
306
|
|
|
|
|
|
|
EXIF => ['EXIF', 'Exchangable Image File Metadata'], |
307
|
|
|
|
|
|
|
EXV => ['EXV', 'Exiv2 metadata'], |
308
|
|
|
|
|
|
|
F4A => ['MOV', 'Adobe Flash Player 9+ Audio'], |
309
|
|
|
|
|
|
|
F4B => ['MOV', 'Adobe Flash Player 9+ audio Book'], |
310
|
|
|
|
|
|
|
F4P => ['MOV', 'Adobe Flash Player 9+ Protected'], |
311
|
|
|
|
|
|
|
F4V => ['MOV', 'Adobe Flash Player 9+ Video'], |
312
|
|
|
|
|
|
|
FFF => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'], |
313
|
|
|
|
|
|
|
FIT => 'FITS', |
314
|
|
|
|
|
|
|
FITS => ['FITS', 'Flexible Image Transport System'], |
315
|
|
|
|
|
|
|
FLAC => ['FLAC', 'Free Lossless Audio Codec'], |
316
|
|
|
|
|
|
|
FLA => ['FPX', 'Macromedia/Adobe Flash project'], |
317
|
|
|
|
|
|
|
FLIF => ['FLIF', 'Free Lossless Image Format'], |
318
|
|
|
|
|
|
|
FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension) |
319
|
|
|
|
|
|
|
FLV => ['FLV', 'Flash Video'], |
320
|
|
|
|
|
|
|
FPF => ['FPF', 'FLIR Public image Format'], |
321
|
|
|
|
|
|
|
FPX => ['FPX', 'FlashPix'], |
322
|
|
|
|
|
|
|
GIF => ['GIF', 'Compuserve Graphics Interchange Format'], |
323
|
|
|
|
|
|
|
GPR => ['TIFF', 'General Purpose RAW'], # https://gopro.github.io/gpr/ |
324
|
|
|
|
|
|
|
GZ => 'GZIP', |
325
|
|
|
|
|
|
|
GZIP => ['GZIP', 'GNU ZIP compressed archive'], |
326
|
|
|
|
|
|
|
HDP => ['TIFF', 'Windows HD Photo'], |
327
|
|
|
|
|
|
|
HDR => ['HDR', 'Radiance RGBE High Dynamic Range'], |
328
|
|
|
|
|
|
|
HEIC => ['MOV', 'High Efficiency Image Format still image'], |
329
|
|
|
|
|
|
|
HEIF => ['MOV', 'High Efficiency Image Format'], |
330
|
|
|
|
|
|
|
HIF => 'HEIF', |
331
|
|
|
|
|
|
|
HTM => 'HTML', |
332
|
|
|
|
|
|
|
HTML => ['HTML', 'HyperText Markup Language'], |
333
|
|
|
|
|
|
|
ICAL => 'ICS', |
334
|
|
|
|
|
|
|
ICC => ['ICC', 'International Color Consortium'], |
335
|
|
|
|
|
|
|
ICM => 'ICC', |
336
|
|
|
|
|
|
|
ICS => ['VCard','iCalendar Schedule'], |
337
|
|
|
|
|
|
|
IDML => ['ZIP', 'Adobe InDesign Markup Language'], |
338
|
|
|
|
|
|
|
IIQ => ['TIFF', 'Phase One Intelligent Image Quality RAW'], |
339
|
|
|
|
|
|
|
IND => ['IND', 'Adobe InDesign'], |
340
|
|
|
|
|
|
|
INDD => ['IND', 'Adobe InDesign Document'], |
341
|
|
|
|
|
|
|
INDT => ['IND', 'Adobe InDesign Template'], |
342
|
|
|
|
|
|
|
INSV => ['MOV', 'Insta360 Video'], |
343
|
|
|
|
|
|
|
INSP => ['JPEG', 'Insta360 Picture'], |
344
|
|
|
|
|
|
|
INX => ['XMP', 'Adobe InDesign Interchange'], |
345
|
|
|
|
|
|
|
ISO => ['ISO', 'ISO 9660 disk image'], |
346
|
|
|
|
|
|
|
ITC => ['ITC', 'iTunes Cover Flow'], |
347
|
|
|
|
|
|
|
J2C => ['JP2', 'JPEG 2000 codestream'], |
348
|
|
|
|
|
|
|
J2K => 'J2C', |
349
|
|
|
|
|
|
|
JNG => ['PNG', 'JPG Network Graphics'], |
350
|
|
|
|
|
|
|
JP2 => ['JP2', 'JPEG 2000 file'], |
351
|
|
|
|
|
|
|
# JP4? - looks like a JPEG but the image data is different |
352
|
|
|
|
|
|
|
JPC => 'J2C', |
353
|
|
|
|
|
|
|
JPE => 'JPEG', |
354
|
|
|
|
|
|
|
JPEG => ['JPEG', 'Joint Photographic Experts Group'], |
355
|
|
|
|
|
|
|
JPF => 'JP2', |
356
|
|
|
|
|
|
|
JPG => 'JPEG', |
357
|
|
|
|
|
|
|
JPM => ['JP2', 'JPEG 2000 compound image'], |
358
|
|
|
|
|
|
|
JPS => ['JPEG', 'JPEG Stereo image'], |
359
|
|
|
|
|
|
|
JPX => ['JP2', 'JPEG 2000 with extensions'], |
360
|
|
|
|
|
|
|
JSON => ['JSON', 'JavaScript Object Notation'], |
361
|
|
|
|
|
|
|
JXL => ['JXL', 'JPEG XL'], |
362
|
|
|
|
|
|
|
JXR => ['TIFF', 'JPEG XR'], |
363
|
|
|
|
|
|
|
K25 => ['TIFF', 'Kodak DC25 RAW'], |
364
|
|
|
|
|
|
|
KDC => ['TIFF', 'Kodak Digital Camera RAW'], |
365
|
|
|
|
|
|
|
KEY => ['ZIP', 'Apple Keynote presentation'], |
366
|
|
|
|
|
|
|
KTH => ['ZIP', 'Apple Keynote Theme'], |
367
|
|
|
|
|
|
|
LA => ['RIFF', 'Lossless Audio'], |
368
|
|
|
|
|
|
|
LFP => ['LFP', 'Lytro Light Field Picture'], |
369
|
|
|
|
|
|
|
LFR => 'LFP', # (Light Field RAW) |
370
|
|
|
|
|
|
|
LIF => ['LIF', 'Leica Image File'], |
371
|
|
|
|
|
|
|
LNK => ['LNK', 'Windows shortcut'], |
372
|
|
|
|
|
|
|
LRI => ['LRI', 'Light RAW'], |
373
|
|
|
|
|
|
|
LRV => ['MOV', 'Low-Resolution Video'], |
374
|
|
|
|
|
|
|
M2T => 'M2TS', |
375
|
|
|
|
|
|
|
M2TS => ['M2TS', 'MPEG-2 Transport Stream'], |
376
|
|
|
|
|
|
|
M2V => ['MPEG', 'MPEG-2 Video'], |
377
|
|
|
|
|
|
|
M4A => ['MOV', 'MPEG-4 Audio'], |
378
|
|
|
|
|
|
|
M4B => ['MOV', 'MPEG-4 audio Book'], |
379
|
|
|
|
|
|
|
M4P => ['MOV', 'MPEG-4 Protected'], |
380
|
|
|
|
|
|
|
M4V => ['MOV', 'MPEG-4 Video'], |
381
|
|
|
|
|
|
|
MAX => ['FPX', '3D Studio MAX'], |
382
|
|
|
|
|
|
|
MEF => ['TIFF', 'Mamiya (RAW) Electronic Format'], |
383
|
|
|
|
|
|
|
MIE => ['MIE', 'Meta Information Encapsulation format'], |
384
|
|
|
|
|
|
|
MIF => 'MIFF', |
385
|
|
|
|
|
|
|
MIFF => ['MIFF', 'Magick Image File Format'], |
386
|
|
|
|
|
|
|
MKA => ['MKV', 'Matroska Audio'], |
387
|
|
|
|
|
|
|
MKS => ['MKV', 'Matroska Subtitle'], |
388
|
|
|
|
|
|
|
MKV => ['MKV', 'Matroska Video'], |
389
|
|
|
|
|
|
|
MNG => ['PNG', 'Multiple-image Network Graphics'], |
390
|
|
|
|
|
|
|
MOBI => ['PDB', 'Mobipocket electronic book'], |
391
|
|
|
|
|
|
|
MODD => ['PLIST','Sony Picture Motion metadata'], |
392
|
|
|
|
|
|
|
MOI => ['MOI', 'MOD Information file'], |
393
|
|
|
|
|
|
|
MOS => ['TIFF', 'Creo Leaf Mosaic'], |
394
|
|
|
|
|
|
|
MOV => ['MOV', 'Apple QuickTime movie'], |
395
|
|
|
|
|
|
|
MP3 => ['MP3', 'MPEG-1 Layer 3 audio'], |
396
|
|
|
|
|
|
|
MP4 => ['MOV', 'MPEG-4 video'], |
397
|
|
|
|
|
|
|
MPC => ['MPC', 'Musepack Audio'], |
398
|
|
|
|
|
|
|
MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'], |
399
|
|
|
|
|
|
|
MPG => 'MPEG', |
400
|
|
|
|
|
|
|
MPO => ['JPEG', 'Extended Multi-Picture format'], |
401
|
|
|
|
|
|
|
MQV => ['MOV', 'Sony Mobile Quicktime Video'], |
402
|
|
|
|
|
|
|
MRC => ['MRC', 'Medical Research Council image'], |
403
|
|
|
|
|
|
|
MRW => ['MRW', 'Minolta RAW format'], |
404
|
|
|
|
|
|
|
MTS => 'M2TS', |
405
|
|
|
|
|
|
|
MXF => ['MXF', 'Material Exchange Format'], |
406
|
|
|
|
|
|
|
# NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'], |
407
|
|
|
|
|
|
|
NEF => ['TIFF', 'Nikon (RAW) Electronic Format'], |
408
|
|
|
|
|
|
|
NEWER => 'COS', |
409
|
|
|
|
|
|
|
NKSC => ['XMP', 'Nikon Sidecar'], |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
NMBTEMPLATE => ['ZIP','Apple Numbers Template'], |
412
|
|
|
|
|
|
|
NRW => ['TIFF', 'Nikon RAW (2)'], |
413
|
|
|
|
|
|
|
NUMBERS => ['ZIP','Apple Numbers spreadsheet'], |
414
|
|
|
|
|
|
|
O => ['EXE', 'Relocatable Object'], |
415
|
|
|
|
|
|
|
ODB => ['ZIP', 'Open Document Database'], |
416
|
|
|
|
|
|
|
ODC => ['ZIP', 'Open Document Chart'], |
417
|
|
|
|
|
|
|
ODF => ['ZIP', 'Open Document Formula'], |
418
|
|
|
|
|
|
|
ODG => ['ZIP', 'Open Document Graphics'], |
419
|
|
|
|
|
|
|
ODI => ['ZIP', 'Open Document Image'], |
420
|
|
|
|
|
|
|
ODP => ['ZIP', 'Open Document Presentation'], |
421
|
|
|
|
|
|
|
ODS => ['ZIP', 'Open Document Spreadsheet'], |
422
|
|
|
|
|
|
|
ODT => ['ZIP', 'Open Document Text file'], |
423
|
|
|
|
|
|
|
OFR => ['RIFF', 'OptimFROG audio'], |
424
|
|
|
|
|
|
|
OGG => ['OGG', 'Ogg Vorbis audio file'], |
425
|
|
|
|
|
|
|
OGV => ['OGG', 'Ogg Video file'], |
426
|
|
|
|
|
|
|
ONP => ['JSON', 'ON1 Presets'], |
427
|
|
|
|
|
|
|
OPUS => ['OGG', 'Ogg Opus audio file'], |
428
|
|
|
|
|
|
|
ORF => ['ORF', 'Olympus RAW format'], |
429
|
|
|
|
|
|
|
ORI => 'ORF', |
430
|
|
|
|
|
|
|
OTF => ['Font', 'Open Type Font'], |
431
|
|
|
|
|
|
|
PAC => ['RIFF', 'Lossless Predictive Audio Compression'], |
432
|
|
|
|
|
|
|
PAGES => ['ZIP', 'Apple Pages document'], |
433
|
|
|
|
|
|
|
PBM => ['PPM', 'Portable BitMap'], |
434
|
|
|
|
|
|
|
PCD => ['PCD', 'Kodak Photo CD Image Pac'], |
435
|
|
|
|
|
|
|
PCT => 'PICT', |
436
|
|
|
|
|
|
|
PCX => ['PCX', 'PC Paintbrush'], |
437
|
|
|
|
|
|
|
PDB => ['PDB', 'Palm Database'], |
438
|
|
|
|
|
|
|
PDF => ['PDF', 'Adobe Portable Document Format'], |
439
|
|
|
|
|
|
|
PEF => ['TIFF', 'Pentax (RAW) Electronic Format'], |
440
|
|
|
|
|
|
|
PFA => ['Font', 'PostScript Font ASCII'], |
441
|
|
|
|
|
|
|
PFB => ['Font', 'PostScript Font Binary'], |
442
|
|
|
|
|
|
|
PFM => [['Font','PFM2'], 'Printer Font Metrics'], # (description is overridden for Portable FloatMap images) |
443
|
|
|
|
|
|
|
PGF => ['PGF', 'Progressive Graphics File'], |
444
|
|
|
|
|
|
|
PGM => ['PPM', 'Portable Gray Map'], |
445
|
|
|
|
|
|
|
PHP => ['PHP', 'PHP Hypertext Preprocessor'], |
446
|
|
|
|
|
|
|
PHP3 => 'PHP', |
447
|
|
|
|
|
|
|
PHP4 => 'PHP', |
448
|
|
|
|
|
|
|
PHP5 => 'PHP', |
449
|
|
|
|
|
|
|
PHPS => 'PHP', |
450
|
|
|
|
|
|
|
PHTML=> 'PHP', |
451
|
|
|
|
|
|
|
PICT => ['PICT', 'Apple PICTure'], |
452
|
|
|
|
|
|
|
PLIST=> ['PLIST','Apple Property List'], |
453
|
|
|
|
|
|
|
PMP => ['PMP', 'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;) |
454
|
|
|
|
|
|
|
PNG => ['PNG', 'Portable Network Graphics'], |
455
|
|
|
|
|
|
|
POT => ['FPX', 'Microsoft PowerPoint Template'], |
456
|
|
|
|
|
|
|
POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'], |
457
|
|
|
|
|
|
|
POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'], |
458
|
|
|
|
|
|
|
PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'], |
459
|
|
|
|
|
|
|
PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'], |
460
|
|
|
|
|
|
|
PPM => ['PPM', 'Portable Pixel Map'], |
461
|
|
|
|
|
|
|
PPS => ['FPX', 'Microsoft PowerPoint Slideshow'], |
462
|
|
|
|
|
|
|
PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'], |
463
|
|
|
|
|
|
|
PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'], |
464
|
|
|
|
|
|
|
PPT => ['FPX', 'Microsoft PowerPoint Presentation'], |
465
|
|
|
|
|
|
|
PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'], |
466
|
|
|
|
|
|
|
PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'], |
467
|
|
|
|
|
|
|
PRC => ['PDB', 'Palm Database'], |
468
|
|
|
|
|
|
|
PS => ['PS', 'PostScript'], |
469
|
|
|
|
|
|
|
PS2 => 'PS', |
470
|
|
|
|
|
|
|
PS3 => 'PS', |
471
|
|
|
|
|
|
|
PSB => ['PSD', 'Photoshop Large Document'], |
472
|
|
|
|
|
|
|
PSD => ['PSD', 'Photoshop Document'], |
473
|
|
|
|
|
|
|
PSDT => ['PSD', 'Photoshop Document Template'], |
474
|
|
|
|
|
|
|
PSP => ['PSP', 'Paint Shop Pro'], |
475
|
|
|
|
|
|
|
PSPFRAME => 'PSP', |
476
|
|
|
|
|
|
|
PSPIMAGE => 'PSP', |
477
|
|
|
|
|
|
|
PSPSHAPE => 'PSP', |
478
|
|
|
|
|
|
|
PSPTUBE => 'PSP', |
479
|
|
|
|
|
|
|
QIF => 'QTIF', |
480
|
|
|
|
|
|
|
QT => 'MOV', |
481
|
|
|
|
|
|
|
QTI => 'QTIF', |
482
|
|
|
|
|
|
|
QTIF => ['QTIF', 'QuickTime Image File'], |
483
|
|
|
|
|
|
|
R3D => ['R3D', 'Redcode RAW Video'], |
484
|
|
|
|
|
|
|
RA => ['Real', 'Real Audio'], |
485
|
|
|
|
|
|
|
RAF => ['RAF', 'FujiFilm RAW Format'], |
486
|
|
|
|
|
|
|
RAM => ['Real', 'Real Audio Metafile'], |
487
|
|
|
|
|
|
|
RAR => ['RAR', 'RAR Archive'], |
488
|
|
|
|
|
|
|
RAW => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'], |
489
|
|
|
|
|
|
|
RIF => 'RIFF', |
490
|
|
|
|
|
|
|
RIFF => ['RIFF', 'Resource Interchange File Format'], |
491
|
|
|
|
|
|
|
RM => ['Real', 'Real Media'], |
492
|
|
|
|
|
|
|
RMVB => ['Real', 'Real Media Variable Bitrate'], |
493
|
|
|
|
|
|
|
RPM => ['Real', 'Real Media Plug-in Metafile'], |
494
|
|
|
|
|
|
|
RSRC => ['RSRC', 'Mac OS Resource'], |
495
|
|
|
|
|
|
|
RTF => ['RTF', 'Rich Text Format'], |
496
|
|
|
|
|
|
|
RV => ['Real', 'Real Video'], |
497
|
|
|
|
|
|
|
RW2 => ['TIFF', 'Panasonic RAW 2'], |
498
|
|
|
|
|
|
|
RWL => ['TIFF', 'Leica RAW'], |
499
|
|
|
|
|
|
|
RWZ => ['RWZ', 'Rawzor compressed image'], |
500
|
|
|
|
|
|
|
SEQ => ['FLIR', 'FLIR image Sequence'], |
501
|
|
|
|
|
|
|
SKETCH => ['ZIP', 'Sketch design file'], |
502
|
|
|
|
|
|
|
SO => ['EXE', 'Shared Object file'], |
503
|
|
|
|
|
|
|
SR2 => ['TIFF', 'Sony RAW Format 2'], |
504
|
|
|
|
|
|
|
SRF => ['TIFF', 'Sony RAW Format'], |
505
|
|
|
|
|
|
|
SRW => ['TIFF', 'Samsung RAW format'], |
506
|
|
|
|
|
|
|
SVG => ['XMP', 'Scalable Vector Graphics'], |
507
|
|
|
|
|
|
|
SWF => ['SWF', 'Shockwave Flash'], |
508
|
|
|
|
|
|
|
TAR => ['TAR', 'TAR archive'], |
509
|
|
|
|
|
|
|
THM => ['JPEG', 'Thumbnail'], |
510
|
|
|
|
|
|
|
THMX => [['ZIP','FPX'], 'Office Open XML Theme'], |
511
|
|
|
|
|
|
|
TIF => 'TIFF', |
512
|
|
|
|
|
|
|
TIFF => ['TIFF', 'Tagged Image File Format'], |
513
|
|
|
|
|
|
|
TORRENT => ['Torrent', 'BitTorrent description file'], |
514
|
|
|
|
|
|
|
TS => 'M2TS', |
515
|
|
|
|
|
|
|
TTC => ['Font', 'True Type Font Collection'], |
516
|
|
|
|
|
|
|
TTF => ['Font', 'True Type Font'], |
517
|
|
|
|
|
|
|
TUB => 'PSP', |
518
|
|
|
|
|
|
|
TXT => ['TXT', 'Text file'], |
519
|
|
|
|
|
|
|
VCARD=> ['VCard','Virtual Card'], |
520
|
|
|
|
|
|
|
VCF => 'VCARD', |
521
|
|
|
|
|
|
|
VOB => ['MPEG', 'Video Object'], |
522
|
|
|
|
|
|
|
VRD => ['VRD', 'Canon VRD Recipe Data'], |
523
|
|
|
|
|
|
|
VSD => ['FPX', 'Microsoft Visio Drawing'], |
524
|
|
|
|
|
|
|
WAV => ['RIFF', 'WAVeform (Windows digital audio)'], |
525
|
|
|
|
|
|
|
WDP => ['TIFF', 'Windows Media Photo'], |
526
|
|
|
|
|
|
|
WEBM => ['MKV', 'Google Web Movie'], |
527
|
|
|
|
|
|
|
WEBP => ['RIFF', 'Google Web Picture'], |
528
|
|
|
|
|
|
|
WMA => ['ASF', 'Windows Media Audio'], |
529
|
|
|
|
|
|
|
WMF => ['WMF', 'Windows Metafile Format'], |
530
|
|
|
|
|
|
|
WMV => ['ASF', 'Windows Media Video'], |
531
|
|
|
|
|
|
|
WV => ['RIFF', 'WavePack lossless audio'], |
532
|
|
|
|
|
|
|
X3F => ['X3F', 'Sigma RAW format'], |
533
|
|
|
|
|
|
|
MACOS=> ['MacOS','MacOS ._ sidecar file'], |
534
|
|
|
|
|
|
|
XCF => ['XCF', 'GIMP native image format'], |
535
|
|
|
|
|
|
|
XHTML=> ['HTML', 'Extensible HyperText Markup Language'], |
536
|
|
|
|
|
|
|
XLA => ['FPX', 'Microsoft Excel Add-in'], |
537
|
|
|
|
|
|
|
XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'], |
538
|
|
|
|
|
|
|
XLS => ['FPX', 'Microsoft Excel Spreadsheet'], |
539
|
|
|
|
|
|
|
XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'], |
540
|
|
|
|
|
|
|
XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'], |
541
|
|
|
|
|
|
|
XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'], |
542
|
|
|
|
|
|
|
XLT => ['FPX', 'Microsoft Excel Template'], |
543
|
|
|
|
|
|
|
XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'], |
544
|
|
|
|
|
|
|
XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'], |
545
|
|
|
|
|
|
|
XMP => ['XMP', 'Extensible Metadata Platform'], |
546
|
|
|
|
|
|
|
WOFF => ['Font', 'Web Open Font Format'], |
547
|
|
|
|
|
|
|
WOFF2=> ['Font', 'Web Open Font Format2'], |
548
|
|
|
|
|
|
|
WTV => ['WTV', 'Windows recorded TV show'], |
549
|
|
|
|
|
|
|
ZIP => ['ZIP', 'ZIP archive'], |
550
|
|
|
|
|
|
|
); |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
# typical extension for each file type (if different than FileType) |
553
|
|
|
|
|
|
|
# - case is not significant |
554
|
|
|
|
|
|
|
my %fileTypeExt = ( |
555
|
|
|
|
|
|
|
'Canon 1D RAW' => 'tif', |
556
|
|
|
|
|
|
|
DICOM => 'dcm', |
557
|
|
|
|
|
|
|
FLIR => 'fff', |
558
|
|
|
|
|
|
|
GZIP => 'gz', |
559
|
|
|
|
|
|
|
JPEG => 'jpg', |
560
|
|
|
|
|
|
|
M2TS => 'mts', |
561
|
|
|
|
|
|
|
MPEG => 'mpg', |
562
|
|
|
|
|
|
|
TIFF => 'tif', |
563
|
|
|
|
|
|
|
VCard => 'vcf', |
564
|
|
|
|
|
|
|
); |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
# descriptions for file types not found in above file extension lookup |
567
|
|
|
|
|
|
|
my %fileDescription = ( |
568
|
|
|
|
|
|
|
DICOM => 'Digital Imaging and Communications in Medicine', |
569
|
|
|
|
|
|
|
XML => 'Extensible Markup Language', |
570
|
|
|
|
|
|
|
'Win32 EXE' => 'Windows 32-bit Executable', |
571
|
|
|
|
|
|
|
'Win32 DLL' => 'Windows 32-bit Dynamic Link Library', |
572
|
|
|
|
|
|
|
'Win64 EXE' => 'Windows 64-bit Executable', |
573
|
|
|
|
|
|
|
'Win64 DLL' => 'Windows 64-bit Dynamic Link Library', |
574
|
|
|
|
|
|
|
); |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
# MIME types for applicable file types above |
577
|
|
|
|
|
|
|
# (missing entries default to 'application/unknown', but note that other MIME |
578
|
|
|
|
|
|
|
# types may be specified by some modules, eg. QuickTime.pm and RIFF.pm) |
579
|
|
|
|
|
|
|
%mimeType = ( |
580
|
|
|
|
|
|
|
'3FR' => 'image/x-hasselblad-3fr', |
581
|
|
|
|
|
|
|
AA => 'audio/audible', |
582
|
|
|
|
|
|
|
AAE => 'application/vnd.apple.photos', |
583
|
|
|
|
|
|
|
AI => 'application/vnd.adobe.illustrator', |
584
|
|
|
|
|
|
|
AIFF => 'audio/x-aiff', |
585
|
|
|
|
|
|
|
ALIAS=> 'application/x-macos', |
586
|
|
|
|
|
|
|
APE => 'audio/x-monkeys-audio', |
587
|
|
|
|
|
|
|
APNG => 'image/apng', |
588
|
|
|
|
|
|
|
ASF => 'video/x-ms-asf', |
589
|
|
|
|
|
|
|
ARW => 'image/x-sony-arw', |
590
|
|
|
|
|
|
|
BMP => 'image/bmp', |
591
|
|
|
|
|
|
|
BPG => 'image/bpg', |
592
|
|
|
|
|
|
|
BTF => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html) |
593
|
|
|
|
|
|
|
BZ2 => 'application/bzip2', |
594
|
|
|
|
|
|
|
'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension) |
595
|
|
|
|
|
|
|
CHM => 'application/x-chm', |
596
|
|
|
|
|
|
|
COS => 'application/octet-stream', #PH (NC) |
597
|
|
|
|
|
|
|
CR2 => 'image/x-canon-cr2', |
598
|
|
|
|
|
|
|
CR3 => 'image/x-canon-cr3', |
599
|
|
|
|
|
|
|
CRM => 'video/x-canon-crm', |
600
|
|
|
|
|
|
|
CRW => 'image/x-canon-crw', |
601
|
|
|
|
|
|
|
CSV => 'text/csv', |
602
|
|
|
|
|
|
|
CZI => 'image/x-zeiss-czi', #PH (NC) |
603
|
|
|
|
|
|
|
DCP => 'application/octet-stream', #PH (NC) |
604
|
|
|
|
|
|
|
DCR => 'image/x-kodak-dcr', |
605
|
|
|
|
|
|
|
DCX => 'image/dcx', |
606
|
|
|
|
|
|
|
DEX => 'application/octet-stream', |
607
|
|
|
|
|
|
|
DFONT=> 'application/x-dfont', |
608
|
|
|
|
|
|
|
DICOM=> 'application/dicom', |
609
|
|
|
|
|
|
|
DIVX => 'video/divx', |
610
|
|
|
|
|
|
|
DJVU => 'image/vnd.djvu', |
611
|
|
|
|
|
|
|
DNG => 'image/x-adobe-dng', |
612
|
|
|
|
|
|
|
DOC => 'application/msword', |
613
|
|
|
|
|
|
|
DOCM => 'application/vnd.ms-word.document.macroEnabled.12', |
614
|
|
|
|
|
|
|
DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document', |
615
|
|
|
|
|
|
|
DOT => 'application/msword', |
616
|
|
|
|
|
|
|
DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate', |
617
|
|
|
|
|
|
|
DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template', |
618
|
|
|
|
|
|
|
DPX => 'image/x-dpx', |
619
|
|
|
|
|
|
|
DR4 => 'application/octet-stream', #PH (NC) |
620
|
|
|
|
|
|
|
DS2 => 'audio/x-ds2', |
621
|
|
|
|
|
|
|
DSS => 'audio/x-dss', |
622
|
|
|
|
|
|
|
DV => 'video/x-dv', |
623
|
|
|
|
|
|
|
'DVR-MS' => 'video/x-ms-dvr', |
624
|
|
|
|
|
|
|
DWF => 'model/vnd.dwf', |
625
|
|
|
|
|
|
|
DWG => 'image/vnd.dwg', |
626
|
|
|
|
|
|
|
DXF => 'application/dxf', |
627
|
|
|
|
|
|
|
EIP => 'application/x-captureone', #(NC) |
628
|
|
|
|
|
|
|
EPS => 'application/postscript', |
629
|
|
|
|
|
|
|
ERF => 'image/x-epson-erf', |
630
|
|
|
|
|
|
|
EXE => 'application/octet-stream', |
631
|
|
|
|
|
|
|
EXR => 'image/x-exr', |
632
|
|
|
|
|
|
|
EXV => 'image/x-exv', |
633
|
|
|
|
|
|
|
FFF => 'image/x-hasselblad-fff', |
634
|
|
|
|
|
|
|
FITS => 'image/fits', |
635
|
|
|
|
|
|
|
FLA => 'application/vnd.adobe.fla', |
636
|
|
|
|
|
|
|
FLAC => 'audio/flac', |
637
|
|
|
|
|
|
|
FLIF => 'image/flif', |
638
|
|
|
|
|
|
|
FLIR => 'image/x-flir-fff', #PH (NC) |
639
|
|
|
|
|
|
|
FLV => 'video/x-flv', |
640
|
|
|
|
|
|
|
Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM) |
641
|
|
|
|
|
|
|
FPF => 'image/x-flir-fpf', #PH (NC) |
642
|
|
|
|
|
|
|
FPX => 'image/vnd.fpx', |
643
|
|
|
|
|
|
|
GIF => 'image/gif', |
644
|
|
|
|
|
|
|
GPR => 'image/x-gopro-gpr', |
645
|
|
|
|
|
|
|
GZIP => 'application/x-gzip', |
646
|
|
|
|
|
|
|
HDP => 'image/vnd.ms-photo', |
647
|
|
|
|
|
|
|
HDR => 'image/vnd.radiance', |
648
|
|
|
|
|
|
|
HTML => 'text/html', |
649
|
|
|
|
|
|
|
ICC => 'application/vnd.iccprofile', |
650
|
|
|
|
|
|
|
ICS => 'text/calendar', |
651
|
|
|
|
|
|
|
IDML => 'application/vnd.adobe.indesign-idml-package', |
652
|
|
|
|
|
|
|
IIQ => 'image/x-raw', |
653
|
|
|
|
|
|
|
IND => 'application/x-indesign', |
654
|
|
|
|
|
|
|
INX => 'application/x-indesign-interchange', #PH (NC) |
655
|
|
|
|
|
|
|
ISO => 'application/x-iso9660-image', |
656
|
|
|
|
|
|
|
ITC => 'application/itunes', |
657
|
|
|
|
|
|
|
J2C => 'image/x-j2c', #PH (NC) |
658
|
|
|
|
|
|
|
JNG => 'image/jng', |
659
|
|
|
|
|
|
|
JP2 => 'image/jp2', |
660
|
|
|
|
|
|
|
JPEG => 'image/jpeg', |
661
|
|
|
|
|
|
|
JPM => 'image/jpm', |
662
|
|
|
|
|
|
|
JPS => 'image/x-jps', |
663
|
|
|
|
|
|
|
JPX => 'image/jpx', |
664
|
|
|
|
|
|
|
JSON => 'application/json', |
665
|
|
|
|
|
|
|
JXL => 'image/jxl', #PH (NC) |
666
|
|
|
|
|
|
|
JXR => 'image/jxr', |
667
|
|
|
|
|
|
|
K25 => 'image/x-kodak-k25', |
668
|
|
|
|
|
|
|
KDC => 'image/x-kodak-kdc', |
669
|
|
|
|
|
|
|
KEY => 'application/x-iwork-keynote-sffkey', |
670
|
|
|
|
|
|
|
LFP => 'image/x-lytro-lfp', #PH (NC) |
671
|
|
|
|
|
|
|
LIF => 'image/x-lif', |
672
|
|
|
|
|
|
|
LNK => 'application/octet-stream', |
673
|
|
|
|
|
|
|
LRI => 'image/x-light-lri', |
674
|
|
|
|
|
|
|
M2T => 'video/mpeg', |
675
|
|
|
|
|
|
|
M2TS => 'video/m2ts', |
676
|
|
|
|
|
|
|
MAX => 'application/x-3ds', |
677
|
|
|
|
|
|
|
MEF => 'image/x-mamiya-mef', |
678
|
|
|
|
|
|
|
MIE => 'application/x-mie', |
679
|
|
|
|
|
|
|
MIFF => 'application/x-magick-image', |
680
|
|
|
|
|
|
|
MKA => 'audio/x-matroska', |
681
|
|
|
|
|
|
|
MKS => 'application/x-matroska', |
682
|
|
|
|
|
|
|
MKV => 'video/x-matroska', |
683
|
|
|
|
|
|
|
MNG => 'video/mng', |
684
|
|
|
|
|
|
|
MOBI => 'application/x-mobipocket-ebook', |
685
|
|
|
|
|
|
|
MOI => 'application/octet-stream', #PH (NC) |
686
|
|
|
|
|
|
|
MOS => 'image/x-raw', |
687
|
|
|
|
|
|
|
MOV => 'video/quicktime', |
688
|
|
|
|
|
|
|
MP3 => 'audio/mpeg', |
689
|
|
|
|
|
|
|
MP4 => 'video/mp4', |
690
|
|
|
|
|
|
|
MPC => 'audio/x-musepack', |
691
|
|
|
|
|
|
|
MPEG => 'video/mpeg', |
692
|
|
|
|
|
|
|
MRC => 'image/x-mrc', |
693
|
|
|
|
|
|
|
MRW => 'image/x-minolta-mrw', |
694
|
|
|
|
|
|
|
MXF => 'application/mxf', |
695
|
|
|
|
|
|
|
NEF => 'image/x-nikon-nef', |
696
|
|
|
|
|
|
|
NKSC => 'application/x-nikon-nxstudio', |
697
|
|
|
|
|
|
|
NRW => 'image/x-nikon-nrw', |
698
|
|
|
|
|
|
|
NUMBERS => 'application/x-iwork-numbers-sffnumbers', |
699
|
|
|
|
|
|
|
ODB => 'application/vnd.oasis.opendocument.database', |
700
|
|
|
|
|
|
|
ODC => 'application/vnd.oasis.opendocument.chart', |
701
|
|
|
|
|
|
|
ODF => 'application/vnd.oasis.opendocument.formula', |
702
|
|
|
|
|
|
|
ODG => 'application/vnd.oasis.opendocument.graphics', |
703
|
|
|
|
|
|
|
ODI => 'application/vnd.oasis.opendocument.image', |
704
|
|
|
|
|
|
|
ODP => 'application/vnd.oasis.opendocument.presentation', |
705
|
|
|
|
|
|
|
ODS => 'application/vnd.oasis.opendocument.spreadsheet', |
706
|
|
|
|
|
|
|
ODT => 'application/vnd.oasis.opendocument.text', |
707
|
|
|
|
|
|
|
OGG => 'audio/ogg', |
708
|
|
|
|
|
|
|
OGV => 'video/ogg', |
709
|
|
|
|
|
|
|
ONP => 'application/on1', |
710
|
|
|
|
|
|
|
ORF => 'image/x-olympus-orf', |
711
|
|
|
|
|
|
|
OTF => 'application/x-font-otf', |
712
|
|
|
|
|
|
|
PAGES=> 'application/x-iwork-pages-sffpages', |
713
|
|
|
|
|
|
|
PBM => 'image/x-portable-bitmap', |
714
|
|
|
|
|
|
|
PCD => 'image/x-photo-cd', |
715
|
|
|
|
|
|
|
PCX => 'image/pcx', |
716
|
|
|
|
|
|
|
PDB => 'application/vnd.palm', |
717
|
|
|
|
|
|
|
PDF => 'application/pdf', |
718
|
|
|
|
|
|
|
PEF => 'image/x-pentax-pef', |
719
|
|
|
|
|
|
|
PFA => 'application/x-font-type1', # (needed if handled by PostScript module) |
720
|
|
|
|
|
|
|
PGF => 'image/pgf', |
721
|
|
|
|
|
|
|
PGM => 'image/x-portable-graymap', |
722
|
|
|
|
|
|
|
PHP => 'application/x-httpd-php', |
723
|
|
|
|
|
|
|
PICT => 'image/pict', |
724
|
|
|
|
|
|
|
PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time) |
725
|
|
|
|
|
|
|
PMP => 'image/x-sony-pmp', #PH (NC) |
726
|
|
|
|
|
|
|
PNG => 'image/png', |
727
|
|
|
|
|
|
|
POT => 'application/vnd.ms-powerpoint', |
728
|
|
|
|
|
|
|
POTM => 'application/vnd.ms-powerpoint.template.macroEnabled.12', |
729
|
|
|
|
|
|
|
POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template', |
730
|
|
|
|
|
|
|
PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled.12', |
731
|
|
|
|
|
|
|
PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented) |
732
|
|
|
|
|
|
|
PPM => 'image/x-portable-pixmap', |
733
|
|
|
|
|
|
|
PPS => 'application/vnd.ms-powerpoint', |
734
|
|
|
|
|
|
|
PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled.12', |
735
|
|
|
|
|
|
|
PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow', |
736
|
|
|
|
|
|
|
PPT => 'application/vnd.ms-powerpoint', |
737
|
|
|
|
|
|
|
PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled.12', |
738
|
|
|
|
|
|
|
PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation', |
739
|
|
|
|
|
|
|
PS => 'application/postscript', |
740
|
|
|
|
|
|
|
PSD => 'application/vnd.adobe.photoshop', |
741
|
|
|
|
|
|
|
PSP => 'image/x-paintshoppro', #(NC) |
742
|
|
|
|
|
|
|
QTIF => 'image/x-quicktime', |
743
|
|
|
|
|
|
|
R3D => 'video/x-red-r3d', #PH (invented) |
744
|
|
|
|
|
|
|
RA => 'audio/x-pn-realaudio', |
745
|
|
|
|
|
|
|
RAF => 'image/x-fujifilm-raf', |
746
|
|
|
|
|
|
|
RAM => 'audio/x-pn-realaudio', |
747
|
|
|
|
|
|
|
RAR => 'application/x-rar-compressed', |
748
|
|
|
|
|
|
|
RAW => 'image/x-raw', |
749
|
|
|
|
|
|
|
RM => 'application/vnd.rn-realmedia', |
750
|
|
|
|
|
|
|
RMVB => 'application/vnd.rn-realmedia-vbr', |
751
|
|
|
|
|
|
|
RPM => 'audio/x-pn-realaudio-plugin', |
752
|
|
|
|
|
|
|
RSRC => 'application/ResEdit', |
753
|
|
|
|
|
|
|
RTF => 'text/rtf', |
754
|
|
|
|
|
|
|
RV => 'video/vnd.rn-realvideo', |
755
|
|
|
|
|
|
|
RW2 => 'image/x-panasonic-rw2', |
756
|
|
|
|
|
|
|
RWL => 'image/x-leica-rwl', |
757
|
|
|
|
|
|
|
RWZ => 'image/x-rawzor', #(duplicated in Rawzor.pm) |
758
|
|
|
|
|
|
|
SEQ => 'image/x-flir-seq', #PH (NC) |
759
|
|
|
|
|
|
|
SKETCH => 'application/sketch', |
760
|
|
|
|
|
|
|
SR2 => 'image/x-sony-sr2', |
761
|
|
|
|
|
|
|
SRF => 'image/x-sony-srf', |
762
|
|
|
|
|
|
|
SRW => 'image/x-samsung-srw', |
763
|
|
|
|
|
|
|
SVG => 'image/svg+xml', |
764
|
|
|
|
|
|
|
SWF => 'application/x-shockwave-flash', |
765
|
|
|
|
|
|
|
TAR => 'application/x-tar', |
766
|
|
|
|
|
|
|
THMX => 'application/vnd.ms-officetheme', |
767
|
|
|
|
|
|
|
TIFF => 'image/tiff', |
768
|
|
|
|
|
|
|
Torrent => 'application/x-bittorrent', |
769
|
|
|
|
|
|
|
TTC => 'application/x-font-ttf', |
770
|
|
|
|
|
|
|
TTF => 'application/x-font-ttf', |
771
|
|
|
|
|
|
|
TXT => 'text/plain', |
772
|
|
|
|
|
|
|
VCard=> 'text/vcard', |
773
|
|
|
|
|
|
|
VRD => 'application/octet-stream', #PH (NC) |
774
|
|
|
|
|
|
|
VSD => 'application/x-visio', |
775
|
|
|
|
|
|
|
WDP => 'image/vnd.ms-photo', |
776
|
|
|
|
|
|
|
WEBM => 'video/webm', |
777
|
|
|
|
|
|
|
WMA => 'audio/x-ms-wma', |
778
|
|
|
|
|
|
|
WMF => 'application/x-wmf', |
779
|
|
|
|
|
|
|
WMV => 'video/x-ms-wmv', |
780
|
|
|
|
|
|
|
WTV => 'video/x-ms-wtv', |
781
|
|
|
|
|
|
|
X3F => 'image/x-sigma-x3f', |
782
|
|
|
|
|
|
|
XCF => 'image/x-xcf', |
783
|
|
|
|
|
|
|
XLA => 'application/vnd.ms-excel', |
784
|
|
|
|
|
|
|
XLAM => 'application/vnd.ms-excel.addin.macroEnabled.12', |
785
|
|
|
|
|
|
|
XLS => 'application/vnd.ms-excel', |
786
|
|
|
|
|
|
|
XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled.12', |
787
|
|
|
|
|
|
|
XLSM => 'application/vnd.ms-excel.sheet.macroEnabled.12', |
788
|
|
|
|
|
|
|
XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', |
789
|
|
|
|
|
|
|
XLT => 'application/vnd.ms-excel', |
790
|
|
|
|
|
|
|
XLTM => 'application/vnd.ms-excel.template.macroEnabled.12', |
791
|
|
|
|
|
|
|
XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template', |
792
|
|
|
|
|
|
|
XML => 'application/xml', |
793
|
|
|
|
|
|
|
XMP => 'application/rdf+xml', |
794
|
|
|
|
|
|
|
ZIP => 'application/zip', |
795
|
|
|
|
|
|
|
); |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# module names for processing routines of each file type |
798
|
|
|
|
|
|
|
# - undefined entries default to same module name as file type |
799
|
|
|
|
|
|
|
# - module name '' defaults to Image::ExifTool |
800
|
|
|
|
|
|
|
# - module name '0' indicates a recognized but unsupported file |
801
|
|
|
|
|
|
|
my %moduleName = ( |
802
|
|
|
|
|
|
|
AA => 'Audible', |
803
|
|
|
|
|
|
|
ALIAS=> 0, |
804
|
|
|
|
|
|
|
AVC => 0, |
805
|
|
|
|
|
|
|
BTF => 'BigTIFF', |
806
|
|
|
|
|
|
|
BZ2 => 0, |
807
|
|
|
|
|
|
|
CRW => 'CanonRaw', |
808
|
|
|
|
|
|
|
CHM => 'EXE', |
809
|
|
|
|
|
|
|
COS => 'CaptureOne', |
810
|
|
|
|
|
|
|
CZI => 'ZISRAW', |
811
|
|
|
|
|
|
|
DEX => 0, |
812
|
|
|
|
|
|
|
DOCX => 'OOXML', |
813
|
|
|
|
|
|
|
DCX => 0, |
814
|
|
|
|
|
|
|
DIR => 0, |
815
|
|
|
|
|
|
|
DR4 => 'CanonVRD', |
816
|
|
|
|
|
|
|
DSS => 'Olympus', |
817
|
|
|
|
|
|
|
DWF => 0, |
818
|
|
|
|
|
|
|
DWG => 0, |
819
|
|
|
|
|
|
|
DXF => 0, |
820
|
|
|
|
|
|
|
EPS => 'PostScript', |
821
|
|
|
|
|
|
|
EXIF => '', |
822
|
|
|
|
|
|
|
EXR => 'OpenEXR', |
823
|
|
|
|
|
|
|
EXV => '', |
824
|
|
|
|
|
|
|
ICC => 'ICC_Profile', |
825
|
|
|
|
|
|
|
IND => 'InDesign', |
826
|
|
|
|
|
|
|
FLV => 'Flash', |
827
|
|
|
|
|
|
|
FPF => 'FLIR', |
828
|
|
|
|
|
|
|
FPX => 'FlashPix', |
829
|
|
|
|
|
|
|
GZIP => 'ZIP', |
830
|
|
|
|
|
|
|
HDR => 'Radiance', |
831
|
|
|
|
|
|
|
JP2 => 'Jpeg2000', |
832
|
|
|
|
|
|
|
JPEG => '', |
833
|
|
|
|
|
|
|
JXL => 'Jpeg2000', |
834
|
|
|
|
|
|
|
LFP => 'Lytro', |
835
|
|
|
|
|
|
|
LRI => 0, |
836
|
|
|
|
|
|
|
MOV => 'QuickTime', |
837
|
|
|
|
|
|
|
MKV => 'Matroska', |
838
|
|
|
|
|
|
|
MP3 => 'ID3', |
839
|
|
|
|
|
|
|
MRW => 'MinoltaRaw', |
840
|
|
|
|
|
|
|
OGG => 'Ogg', |
841
|
|
|
|
|
|
|
ORF => 'Olympus', |
842
|
|
|
|
|
|
|
PDB => 'Palm', |
843
|
|
|
|
|
|
|
PCD => 'PhotoCD', |
844
|
|
|
|
|
|
|
PFM2 => 'Other', |
845
|
|
|
|
|
|
|
PHP => 0, |
846
|
|
|
|
|
|
|
PMP => 'Sony', |
847
|
|
|
|
|
|
|
PS => 'PostScript', |
848
|
|
|
|
|
|
|
PSD => 'Photoshop', |
849
|
|
|
|
|
|
|
QTIF => 'QuickTime', |
850
|
|
|
|
|
|
|
R3D => 'Red', |
851
|
|
|
|
|
|
|
RAF => 'FujiFilm', |
852
|
|
|
|
|
|
|
RAR => 'ZIP', |
853
|
|
|
|
|
|
|
RAW => 'KyoceraRaw', |
854
|
|
|
|
|
|
|
RWZ => 'Rawzor', |
855
|
|
|
|
|
|
|
SWF => 'Flash', |
856
|
|
|
|
|
|
|
TAR => 0, |
857
|
|
|
|
|
|
|
TIFF => '', |
858
|
|
|
|
|
|
|
TXT => 'Text', |
859
|
|
|
|
|
|
|
VRD => 'CanonVRD', |
860
|
|
|
|
|
|
|
WMF => 0, |
861
|
|
|
|
|
|
|
X3F => 'SigmaRaw', |
862
|
|
|
|
|
|
|
XCF => 'GIMP', |
863
|
|
|
|
|
|
|
); |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
$testLen = 1024; # number of bytes to read when testing for magic number |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
# quick "magic number" file test used to avoid loading module unnecessarily: |
868
|
|
|
|
|
|
|
# - regular expression evaluated on first $testLen bytes of file |
869
|
|
|
|
|
|
|
# - must match beginning at first byte in file |
870
|
|
|
|
|
|
|
# - this test must not be more stringent than module logic |
871
|
|
|
|
|
|
|
%magicNumber = ( |
872
|
|
|
|
|
|
|
AA => '.{4}\x57\x90\x75\x36', |
873
|
|
|
|
|
|
|
AIFF => '(FORM....AIF[FC]|AT&TFORM)', |
874
|
|
|
|
|
|
|
ALIAS=> "book\0\0\0\0mark\0\0\0\0", |
875
|
|
|
|
|
|
|
APE => '(MAC |APETAGEX|ID3)', |
876
|
|
|
|
|
|
|
ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c', |
877
|
|
|
|
|
|
|
AVC => '\+A\+V\+C\+', |
878
|
|
|
|
|
|
|
Torrent => 'd\d+:\w+', |
879
|
|
|
|
|
|
|
BMP => 'BM', |
880
|
|
|
|
|
|
|
BPG => "BPG\xfb", |
881
|
|
|
|
|
|
|
BTF => '(II\x2b\0|MM\0\x2b)', |
882
|
|
|
|
|
|
|
BZ2 => 'BZh[1-9]\x31\x41\x59\x26\x53\x59', |
883
|
|
|
|
|
|
|
CHM => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec', |
884
|
|
|
|
|
|
|
CRW => '(II|MM).{4}HEAP(CCDR|JPGM)', |
885
|
|
|
|
|
|
|
CZI => 'ZISRAWFILE\0{6}', |
886
|
|
|
|
|
|
|
DCX => '\xb1\x68\xde\x3a', |
887
|
|
|
|
|
|
|
DEX => "dex\n035\0", |
888
|
|
|
|
|
|
|
DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)', |
889
|
|
|
|
|
|
|
DOCX => 'PK\x03\x04', |
890
|
|
|
|
|
|
|
DPX => '(SDPX|XPDS)', |
891
|
|
|
|
|
|
|
DR4 => 'IIII\x04\0\x04\0', |
892
|
|
|
|
|
|
|
DSS => '(\x02dss|\x03ds2)', |
893
|
|
|
|
|
|
|
DV => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized) |
894
|
|
|
|
|
|
|
DWF => '\(DWF V\d', |
895
|
|
|
|
|
|
|
DWG => 'AC10\d{2}\0', |
896
|
|
|
|
|
|
|
DXF => '\s*0\s+\0?\s*SECTION\s+2\s+HEADER', |
897
|
|
|
|
|
|
|
EPS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', |
898
|
|
|
|
|
|
|
EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!\x0a)', |
899
|
|
|
|
|
|
|
EXIF => '(II\x2a\0|MM\0\x2a)', |
900
|
|
|
|
|
|
|
EXR => '\x76\x2f\x31\x01', |
901
|
|
|
|
|
|
|
EXV => '\xff\x01Exiv2', |
902
|
|
|
|
|
|
|
FITS => 'SIMPLE = {20}T', |
903
|
|
|
|
|
|
|
FLAC => '(fLaC|ID3)', |
904
|
|
|
|
|
|
|
FLIF => 'FLIF[0-\x6f][0-2]', |
905
|
|
|
|
|
|
|
FLIR => '[AF]FF\0', |
906
|
|
|
|
|
|
|
FLV => 'FLV\x01', |
907
|
|
|
|
|
|
|
Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' . |
908
|
|
|
|
|
|
|
'(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])', |
909
|
|
|
|
|
|
|
FPF => 'FPF Public Image Format\0', |
910
|
|
|
|
|
|
|
FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1', |
911
|
|
|
|
|
|
|
GIF => 'GIF8[79]a', |
912
|
|
|
|
|
|
|
GZIP => '\x1f\x8b\x08', |
913
|
|
|
|
|
|
|
HDR => '#\?(RADIANCE|RGBE)\x0a', |
914
|
|
|
|
|
|
|
HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive) |
915
|
|
|
|
|
|
|
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}', |
916
|
|
|
|
|
|
|
IND => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d', |
917
|
|
|
|
|
|
|
# ISO => signature is at byte 32768 |
918
|
|
|
|
|
|
|
ITC => '.{4}itch', |
919
|
|
|
|
|
|
|
JP2 => '(\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)', |
920
|
|
|
|
|
|
|
JPEG => '\xff\xd8\xff', |
921
|
|
|
|
|
|
|
JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:', |
922
|
|
|
|
|
|
|
JXL => '\xff\x0a|\0\0\0\x0cJXL \x0d\x0a......ftypjxl ', |
923
|
|
|
|
|
|
|
LFP => '\x89LFP\x0d\x0a\x1a\x0a', |
924
|
|
|
|
|
|
|
LIF => '\x70\0{3}.{4}\x2a.{4}<\0', |
925
|
|
|
|
|
|
|
LNK => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46', |
926
|
|
|
|
|
|
|
LRI => 'LELR \0', |
927
|
|
|
|
|
|
|
M2TS => '(....)?\x47', |
928
|
|
|
|
|
|
|
MIE => '~[\x10\x18]\x04.0MIE', |
929
|
|
|
|
|
|
|
MIFF => 'id=ImageMagick', |
930
|
|
|
|
|
|
|
MKV => '\x1a\x45\xdf\xa3', |
931
|
|
|
|
|
|
|
MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!) |
932
|
|
|
|
|
|
|
# MP3 => difficult to rule out |
933
|
|
|
|
|
|
|
MPC => '(MP\+|ID3)', |
934
|
|
|
|
|
|
|
MOI => 'V6', |
935
|
|
|
|
|
|
|
MPEG => '\0\0\x01[\xb0-\xbf]', |
936
|
|
|
|
|
|
|
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', |
937
|
|
|
|
|
|
|
MRW => '\0MR[MI]', |
938
|
|
|
|
|
|
|
MXF => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized) |
939
|
|
|
|
|
|
|
OGG => '(OggS|ID3)', |
940
|
|
|
|
|
|
|
ORF => '(II|MM)', |
941
|
|
|
|
|
|
|
# PCD => signature is at byte 2048 |
942
|
|
|
|
|
|
|
PCX => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]', |
943
|
|
|
|
|
|
|
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)', |
944
|
|
|
|
|
|
|
PDF => '\s*%PDF-\d+\.\d+', |
945
|
|
|
|
|
|
|
PFM => 'P[Ff]\x0a\d+ \d+\x0a[-+0-9.]+\x0a', |
946
|
|
|
|
|
|
|
PGF => 'PGF', |
947
|
|
|
|
|
|
|
PHP => '<\?php\s', |
948
|
|
|
|
|
|
|
PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)', |
949
|
|
|
|
|
|
|
PLIST=> '(bplist0|\s*<|\xfe\xff\x00)', |
950
|
|
|
|
|
|
|
PMP => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb', |
951
|
|
|
|
|
|
|
PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n', |
952
|
|
|
|
|
|
|
PPM => 'P[1-6]\s+', |
953
|
|
|
|
|
|
|
PS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', |
954
|
|
|
|
|
|
|
PSD => '8BPS\0[\x01\x02]', |
955
|
|
|
|
|
|
|
PSP => 'Paint Shop Pro Image File\x0a\x1a\0{5}', |
956
|
|
|
|
|
|
|
QTIF => '.{4}(idsc|idat|iicc)', |
957
|
|
|
|
|
|
|
R3D => '\0\0..RED(1|2)', |
958
|
|
|
|
|
|
|
RAF => 'FUJIFILM', |
959
|
|
|
|
|
|
|
RAR => 'Rar!\x1a\x07\0', |
960
|
|
|
|
|
|
|
RAW => '(.{25}ARECOYK|II|MM)', |
961
|
|
|
|
|
|
|
Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)', |
962
|
|
|
|
|
|
|
RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants |
963
|
|
|
|
|
|
|
RSRC => '(....)?\0\0\x01\0', |
964
|
|
|
|
|
|
|
RTF => '[\n\r]*\\{[\n\r]*\\\\rtf', |
965
|
|
|
|
|
|
|
RWZ => 'rawzor', |
966
|
|
|
|
|
|
|
SWF => '[FC]WS[^\0]', |
967
|
|
|
|
|
|
|
TAR => '.{257}ustar( )?\0', # (this doesn't catch old-style tar files) |
968
|
|
|
|
|
|
|
TXT => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)', |
969
|
|
|
|
|
|
|
TIFF => '(II|MM)', # don't test magic number (some raw formats are different) |
970
|
|
|
|
|
|
|
VCard=> '(?i)BEGIN:(VCARD|VCALENDAR)\r\n', |
971
|
|
|
|
|
|
|
VRD => 'CANON OPTIONAL DATA\0', |
972
|
|
|
|
|
|
|
WMF => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)', |
973
|
|
|
|
|
|
|
WTV => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d', |
974
|
|
|
|
|
|
|
X3F => 'FOVb', |
975
|
|
|
|
|
|
|
MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X ', |
976
|
|
|
|
|
|
|
XCF => 'gimp xcf ', |
977
|
|
|
|
|
|
|
XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<', |
978
|
|
|
|
|
|
|
ZIP => 'PK\x03\x04', |
979
|
|
|
|
|
|
|
); |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
# file types with weak magic number recognition |
982
|
|
|
|
|
|
|
my %weakMagic = ( MP3 => 1 ); |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
# file types that are determined by the process proc when FastScan == 3 |
985
|
|
|
|
|
|
|
# (when done, the process proc must exit after SetFileType if FastScan is 3) |
986
|
|
|
|
|
|
|
my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT); |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
# Compact/XMPShorthand option settings |
989
|
|
|
|
|
|
|
my %compactOpt = ( |
990
|
|
|
|
|
|
|
nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline', |
991
|
|
|
|
|
|
|
shorthand => 'Shorthand', onedesc => 'OneDesc', |
992
|
|
|
|
|
|
|
all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'], |
993
|
|
|
|
|
|
|
allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'], |
994
|
|
|
|
|
|
|
# aliases to cover anticipated user typos |
995
|
|
|
|
|
|
|
nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent', |
996
|
|
|
|
|
|
|
nopad => 'NoPadding', onedescr => 'OneDesc', |
997
|
|
|
|
|
|
|
# allow numerical settings for backward compatibility |
998
|
|
|
|
|
|
|
0 => 'None', |
999
|
|
|
|
|
|
|
1 => 'NoPadding', |
1000
|
|
|
|
|
|
|
2 => ['NoPadding','NoIndent'], |
1001
|
|
|
|
|
|
|
3 => ['NoPadding','NoIndent','OneDesc'], |
1002
|
|
|
|
|
|
|
4 => ['NoPadding','NoIndent','OneDesc','NoNewline'], |
1003
|
|
|
|
|
|
|
5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'], |
1004
|
|
|
|
|
|
|
); |
1005
|
|
|
|
|
|
|
my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] ); |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
# lookup for valid character set names (keys are all lower case) |
1008
|
|
|
|
|
|
|
%charsetName = ( |
1009
|
|
|
|
|
|
|
# Charset setting alias(es) |
1010
|
|
|
|
|
|
|
# ------------------------- -------------------------------------------- |
1011
|
|
|
|
|
|
|
utf8 => 'UTF8', cp65001 => 'UTF8', 'utf-8' => 'UTF8', |
1012
|
|
|
|
|
|
|
latin => 'Latin', cp1252 => 'Latin', latin1 => 'Latin', |
1013
|
|
|
|
|
|
|
latin2 => 'Latin2', cp1250 => 'Latin2', |
1014
|
|
|
|
|
|
|
cyrillic => 'Cyrillic', cp1251 => 'Cyrillic', russian => 'Cyrillic', |
1015
|
|
|
|
|
|
|
greek => 'Greek', cp1253 => 'Greek', |
1016
|
|
|
|
|
|
|
turkish => 'Turkish', cp1254 => 'Turkish', |
1017
|
|
|
|
|
|
|
hebrew => 'Hebrew', cp1255 => 'Hebrew', |
1018
|
|
|
|
|
|
|
arabic => 'Arabic', cp1256 => 'Arabic', |
1019
|
|
|
|
|
|
|
baltic => 'Baltic', cp1257 => 'Baltic', |
1020
|
|
|
|
|
|
|
vietnam => 'Vietnam', cp1258 => 'Vietnam', |
1021
|
|
|
|
|
|
|
thai => 'Thai', cp874 => 'Thai', |
1022
|
|
|
|
|
|
|
doslatinus => 'DOSLatinUS', cp437 => 'DOSLatinUS', |
1023
|
|
|
|
|
|
|
doslatin1 => 'DOSLatin1', cp850 => 'DOSLatin1', |
1024
|
|
|
|
|
|
|
doscyrillic => 'DOSCyrillic', cp866 => 'DOSCyrillic', |
1025
|
|
|
|
|
|
|
macroman => 'MacRoman', cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman', |
1026
|
|
|
|
|
|
|
maclatin2 => 'MacLatin2', cp10029 => 'MacLatin2', |
1027
|
|
|
|
|
|
|
maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic', |
1028
|
|
|
|
|
|
|
macgreek => 'MacGreek', cp10006 => 'MacGreek', |
1029
|
|
|
|
|
|
|
macturkish => 'MacTurkish', cp10081 => 'MacTurkish', |
1030
|
|
|
|
|
|
|
macromanian => 'MacRomanian', cp10010 => 'MacRomanian', |
1031
|
|
|
|
|
|
|
maciceland => 'MacIceland', cp10079 => 'MacIceland', |
1032
|
|
|
|
|
|
|
maccroatian => 'MacCroatian', cp10082 => 'MacCroatian', |
1033
|
|
|
|
|
|
|
); |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
# default family 0 group priority for writing |
1036
|
|
|
|
|
|
|
# (NOTE: tags in groups not specified here will not be written unless |
1037
|
|
|
|
|
|
|
# overridden by the module or specified when writing) |
1038
|
|
|
|
|
|
|
my @defaultWriteGroups = qw( |
1039
|
|
|
|
|
|
|
EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe |
1040
|
|
|
|
|
|
|
); |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
# group hash for ExifTool-generated tags |
1043
|
|
|
|
|
|
|
my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' ); |
1044
|
|
|
|
|
|
|
|
1045
|
|
|
|
|
|
|
# special tag names (not used for tag info) |
1046
|
|
|
|
|
|
|
%specialTags = map { $_ => 1 } qw( |
1047
|
|
|
|
|
|
|
TABLE_NAME SHORT_NAME PROCESS_PROC WRITE_PROC CHECK_PROC |
1048
|
|
|
|
|
|
|
GROUPS FORMAT FIRST_ENTRY TAG_PREFIX PRINT_CONV |
1049
|
|
|
|
|
|
|
WRITABLE TABLE_DESC NOTES IS_OFFSET IS_SUBDIR |
1050
|
|
|
|
|
|
|
EXTRACT_UNKNOWN NAMESPACE PREFERRED SRC_TABLE PRIORITY |
1051
|
|
|
|
|
|
|
AVOID WRITE_GROUP LANG_INFO VARS DATAMEMBER |
1052
|
|
|
|
|
|
|
SET_GROUP1 PERMANENT INIT_TABLE |
1053
|
|
|
|
|
|
|
); |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
# headers for various segment types |
1056
|
|
|
|
|
|
|
$exifAPP1hdr = "Exif\0\0"; |
1057
|
|
|
|
|
|
|
$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0"; |
1058
|
|
|
|
|
|
|
$xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0"; |
1059
|
|
|
|
|
|
|
$psAPP13hdr = "Photoshop 3.0\0"; |
1060
|
|
|
|
|
|
|
$psAPP13old = 'Adobe_Photoshop2.5:'; |
1061
|
|
|
|
|
|
|
|
1062
|
730
|
|
|
730
|
0
|
2169
|
sub DummyWriteProc { return 1; } |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
# lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses |
1065
|
|
|
|
|
|
|
%Image::ExifTool::userLens = ( ); |
1066
|
|
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
# queued plug-in tags to add to lookup |
1068
|
|
|
|
|
|
|
@Image::ExifTool::pluginTags = ( ); |
1069
|
|
|
|
|
|
|
%Image::ExifTool::pluginTags = ( ); |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
my %systemTagsNotes = ( |
1072
|
|
|
|
|
|
|
Notes => q{ |
1073
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1074
|
|
|
|
|
|
|
option is set |
1075
|
|
|
|
|
|
|
}, |
1076
|
|
|
|
|
|
|
); |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
# tag information for preview image -- this should be used for all |
1079
|
|
|
|
|
|
|
# PreviewImage tags so they are handled properly when reading/writing |
1080
|
|
|
|
|
|
|
%Image::ExifTool::previewImageTagInfo = ( |
1081
|
|
|
|
|
|
|
Name => 'PreviewImage', |
1082
|
|
|
|
|
|
|
Writable => 'undef', |
1083
|
|
|
|
|
|
|
# a value of 'none' is ok... |
1084
|
|
|
|
|
|
|
WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)', |
1085
|
|
|
|
|
|
|
DataTag => 'PreviewImage', |
1086
|
|
|
|
|
|
|
# accept either scalar or scalar reference |
1087
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1088
|
|
|
|
|
|
|
# we allow preview image to be set to '', but we don't want a zero-length value |
1089
|
|
|
|
|
|
|
# in the IFD, so set it temporarily to 'none'. Note that the length is <= 4, |
1090
|
|
|
|
|
|
|
# so this value will fit in the IFD so the preview fixup won't be generated. |
1091
|
|
|
|
|
|
|
ValueConvInv => '$val eq "" and $val="none"; $val', |
1092
|
|
|
|
|
|
|
); |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
# extra tags that aren't truly EXIF tags, but are generated by the script |
1095
|
|
|
|
|
|
|
# Note: any tag in this list with a name corresponding to a Group0 name is |
1096
|
|
|
|
|
|
|
# used to write the entire corresponding directory as a block. |
1097
|
|
|
|
|
|
|
%Image::ExifTool::Extra = ( |
1098
|
|
|
|
|
|
|
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, |
1099
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags |
1100
|
|
|
|
|
|
|
WRITE_PROC => \&DummyWriteProc, |
1101
|
|
|
|
|
|
|
Error => { |
1102
|
|
|
|
|
|
|
Priority => 0, |
1103
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1104
|
|
|
|
|
|
|
Notes => q{ |
1105
|
|
|
|
|
|
|
returns errors that may have occurred while reading or writing a file. Any |
1106
|
|
|
|
|
|
|
Error will prevent the file from being processed. Minor errors may be |
1107
|
|
|
|
|
|
|
downgraded to warnings with the -m or L option |
1108
|
|
|
|
|
|
|
}, |
1109
|
|
|
|
|
|
|
}, |
1110
|
|
|
|
|
|
|
Warning => { |
1111
|
|
|
|
|
|
|
Priority => 0, |
1112
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1113
|
|
|
|
|
|
|
Notes => q{ |
1114
|
|
|
|
|
|
|
returns warnings that may have occurred while reading or writing a file. |
1115
|
|
|
|
|
|
|
Use the -a or L option to see all warnings if more than one |
1116
|
|
|
|
|
|
|
occurred. Minor warnings may be ignored with the -m or L |
1117
|
|
|
|
|
|
|
option. Minor warnings with a capital "M" in the "[Minor]" designation |
1118
|
|
|
|
|
|
|
indicate that the processing is affected by ignoring the warning |
1119
|
|
|
|
|
|
|
}, |
1120
|
|
|
|
|
|
|
}, |
1121
|
|
|
|
|
|
|
Comment => { |
1122
|
|
|
|
|
|
|
Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image', |
1123
|
|
|
|
|
|
|
Writable => 1, |
1124
|
|
|
|
|
|
|
WriteGroup => 'Comment', |
1125
|
|
|
|
|
|
|
Priority => 0, # to preserve order of JPEG COM segments |
1126
|
|
|
|
|
|
|
}, |
1127
|
|
|
|
|
|
|
Directory => { |
1128
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1129
|
|
|
|
|
|
|
Notes => q{ |
1130
|
|
|
|
|
|
|
the directory of the file as specified in the call to ExifTool, or "." if no |
1131
|
|
|
|
|
|
|
directory was specified. May be written to move the file to another |
1132
|
|
|
|
|
|
|
directory that will be created if doesn't already exist |
1133
|
|
|
|
|
|
|
}, |
1134
|
|
|
|
|
|
|
Writable => 1, |
1135
|
|
|
|
|
|
|
WritePseudo => 1, |
1136
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1137
|
|
|
|
|
|
|
Protected => 1, |
1138
|
|
|
|
|
|
|
RawConv => '$self->ConvertFileName($val)', |
1139
|
|
|
|
|
|
|
# translate backslashes in directory names and add trailing '/' |
1140
|
|
|
|
|
|
|
ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_', |
1141
|
|
|
|
|
|
|
}, |
1142
|
|
|
|
|
|
|
FileName => { |
1143
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1144
|
|
|
|
|
|
|
Writable => 1, |
1145
|
|
|
|
|
|
|
WritePseudo => 1, |
1146
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1147
|
|
|
|
|
|
|
Protected => 1, |
1148
|
|
|
|
|
|
|
Notes => q{ |
1149
|
|
|
|
|
|
|
may be written with a full path name to set FileName and Directory in one |
1150
|
|
|
|
|
|
|
operation. This is such a powerful feature that a TestName tag is provided |
1151
|
|
|
|
|
|
|
to allow dry-run tests before actually writing the file name. See |
1152
|
|
|
|
|
|
|
L for more information on writing the |
1153
|
|
|
|
|
|
|
FileName, Directory and TestName tags |
1154
|
|
|
|
|
|
|
}, |
1155
|
|
|
|
|
|
|
RawConv => '$self->ConvertFileName($val)', |
1156
|
|
|
|
|
|
|
ValueConvInv => '$self->InverseFileName($val)', |
1157
|
|
|
|
|
|
|
}, |
1158
|
|
|
|
|
|
|
BaseName => { |
1159
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1160
|
|
|
|
|
|
|
Notes => q{ |
1161
|
|
|
|
|
|
|
file name without extension. Not generated unless specifically requested or |
1162
|
|
|
|
|
|
|
the API L option is set |
1163
|
|
|
|
|
|
|
}, |
1164
|
|
|
|
|
|
|
}, |
1165
|
|
|
|
|
|
|
FilePath => { |
1166
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1167
|
|
|
|
|
|
|
Notes => q{ |
1168
|
|
|
|
|
|
|
absolute path of source file. Not generated unless specifically requested or |
1169
|
|
|
|
|
|
|
the API L option is set. Does not support Windows Unicode file |
1170
|
|
|
|
|
|
|
names |
1171
|
|
|
|
|
|
|
}, |
1172
|
|
|
|
|
|
|
}, |
1173
|
|
|
|
|
|
|
TestName => { |
1174
|
|
|
|
|
|
|
Writable => 1, |
1175
|
|
|
|
|
|
|
WritePseudo => 1, |
1176
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1177
|
|
|
|
|
|
|
Protected => 1, |
1178
|
|
|
|
|
|
|
WriteOnly => 1, |
1179
|
|
|
|
|
|
|
Notes => q{ |
1180
|
|
|
|
|
|
|
this write-only tag may be used instead of FileName for dry-run tests of the |
1181
|
|
|
|
|
|
|
file renaming feature. Writing this tag prints the old and new file names |
1182
|
|
|
|
|
|
|
to the console, but does not affect the file itself |
1183
|
|
|
|
|
|
|
}, |
1184
|
|
|
|
|
|
|
ValueConvInv => '$self->InverseFileName($val)', |
1185
|
|
|
|
|
|
|
}, |
1186
|
|
|
|
|
|
|
FileSequence => { |
1187
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1188
|
|
|
|
|
|
|
Notes => q{ |
1189
|
|
|
|
|
|
|
sequence number for each source file when extracting or copying information, |
1190
|
|
|
|
|
|
|
including files that fail the -if condition of the command-line application, |
1191
|
|
|
|
|
|
|
beginning at 0 for the first file. Not generated unless specifically |
1192
|
|
|
|
|
|
|
requested or the API L option is set |
1193
|
|
|
|
|
|
|
}, |
1194
|
|
|
|
|
|
|
}, |
1195
|
|
|
|
|
|
|
FileSize => { |
1196
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1197
|
|
|
|
|
|
|
Notes => q{ |
1198
|
|
|
|
|
|
|
note that the print conversion for this tag uses historic prefixes: 1 kB = |
1199
|
|
|
|
|
|
|
1024 bytes, etc. |
1200
|
|
|
|
|
|
|
}, |
1201
|
|
|
|
|
|
|
PrintConv => \&ConvertFileSize, |
1202
|
|
|
|
|
|
|
}, |
1203
|
|
|
|
|
|
|
ResourceForkSize => { |
1204
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1205
|
|
|
|
|
|
|
Notes => q{ |
1206
|
|
|
|
|
|
|
size of the file's resource fork if it contains data. Mac OS only. If this |
1207
|
|
|
|
|
|
|
tag is generated the L option may be used to extract |
1208
|
|
|
|
|
|
|
resource-fork information as a sub-document. When writing, the resource |
1209
|
|
|
|
|
|
|
fork is preserved by default, but it may be deleted with C<-rsrc:all=> on |
1210
|
|
|
|
|
|
|
the command line |
1211
|
|
|
|
|
|
|
}, |
1212
|
|
|
|
|
|
|
PrintConv => \&ConvertFileSize, |
1213
|
|
|
|
|
|
|
}, |
1214
|
|
|
|
|
|
|
ZoneIdentifier => { |
1215
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1216
|
|
|
|
|
|
|
Notes => q{ |
1217
|
|
|
|
|
|
|
Windows only. Existence indicates that the file has a Zone.Identifier |
1218
|
|
|
|
|
|
|
alternate data stream, which is used by some Windows browsers to mark |
1219
|
|
|
|
|
|
|
downloaded files as possibly unsafe to run. May be deleted to remove this |
1220
|
|
|
|
|
|
|
stream. Requires Win32API::File |
1221
|
|
|
|
|
|
|
}, |
1222
|
|
|
|
|
|
|
Writable => 1, |
1223
|
|
|
|
|
|
|
WritePseudo => 1, |
1224
|
|
|
|
|
|
|
Protected => 1, |
1225
|
|
|
|
|
|
|
}, |
1226
|
|
|
|
|
|
|
FileType => { |
1227
|
|
|
|
|
|
|
Groups => { 2 => 'Other' }, |
1228
|
|
|
|
|
|
|
Notes => q{ |
1229
|
|
|
|
|
|
|
a short description of the file type. For many file types this is the just |
1230
|
|
|
|
|
|
|
the uppercase file extension |
1231
|
|
|
|
|
|
|
}, |
1232
|
|
|
|
|
|
|
}, |
1233
|
|
|
|
|
|
|
FileTypeExtension => { |
1234
|
|
|
|
|
|
|
Groups => { 2 => 'Other' }, |
1235
|
|
|
|
|
|
|
Notes => q{ |
1236
|
|
|
|
|
|
|
a common lowercase extension for this file type, or uppercase with the -n |
1237
|
|
|
|
|
|
|
option |
1238
|
|
|
|
|
|
|
}, |
1239
|
|
|
|
|
|
|
PrintConv => 'lc $val', |
1240
|
|
|
|
|
|
|
}, |
1241
|
|
|
|
|
|
|
FileModifyDate => { |
1242
|
|
|
|
|
|
|
Description => 'File Modification Date/Time', |
1243
|
|
|
|
|
|
|
Notes => q{ |
1244
|
|
|
|
|
|
|
the filesystem modification date/time. Note that ExifTool may not be able |
1245
|
|
|
|
|
|
|
to handle filesystem dates before 1970 depending on the limitations of the |
1246
|
|
|
|
|
|
|
system's standard libraries |
1247
|
|
|
|
|
|
|
}, |
1248
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1249
|
|
|
|
|
|
|
Writable => 1, |
1250
|
|
|
|
|
|
|
WritePseudo => 1, |
1251
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1252
|
|
|
|
|
|
|
# all writable pseudo-tags must be protected so -tagsfromfile fails with |
1253
|
|
|
|
|
|
|
# unrecognized files unless a pseudo tag is specified explicitly |
1254
|
|
|
|
|
|
|
Protected => 1, |
1255
|
|
|
|
|
|
|
Shift => 'Time', |
1256
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1257
|
|
|
|
|
|
|
ValueConvInv => 'GetUnixTime($val,1)', |
1258
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1259
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
1260
|
|
|
|
|
|
|
}, |
1261
|
|
|
|
|
|
|
FileAccessDate => { |
1262
|
|
|
|
|
|
|
Description => 'File Access Date/Time', |
1263
|
|
|
|
|
|
|
Notes => q{ |
1264
|
|
|
|
|
|
|
the date/time of last access of the file. Note that this access time is |
1265
|
|
|
|
|
|
|
updated whenever any software, including ExifTool, reads the file |
1266
|
|
|
|
|
|
|
}, |
1267
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1268
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1269
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1270
|
|
|
|
|
|
|
}, |
1271
|
|
|
|
|
|
|
FileCreateDate => { |
1272
|
|
|
|
|
|
|
Description => 'File Creation Date/Time', |
1273
|
|
|
|
|
|
|
Notes => q{ |
1274
|
|
|
|
|
|
|
the filesystem creation date/time. Windows/Mac only. In Windows, the file |
1275
|
|
|
|
|
|
|
creation date/time is preserved by default when writing if Win32API::File |
1276
|
|
|
|
|
|
|
and Win32::API are available. On Mac, this tag is extracted only if it or |
1277
|
|
|
|
|
|
|
the MacOS group is specifically requested or the API L option is |
1278
|
|
|
|
|
|
|
set to 2 or higher. Requires "setfile" for writing on Mac, which may be |
1279
|
|
|
|
|
|
|
installed by typing C in the Terminal |
1280
|
|
|
|
|
|
|
}, |
1281
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1282
|
|
|
|
|
|
|
Writable => 1, |
1283
|
|
|
|
|
|
|
WritePseudo => 1, |
1284
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1285
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1286
|
|
|
|
|
|
|
Shift => 'Time', |
1287
|
|
|
|
|
|
|
ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)', |
1288
|
|
|
|
|
|
|
ValueConvInv => q{ |
1289
|
|
|
|
|
|
|
return GetUnixTime($val,1) if $^O eq 'MSWin32'; |
1290
|
|
|
|
|
|
|
return $val if $^O eq 'darwin'; |
1291
|
|
|
|
|
|
|
warn "This tag is Windows/Mac only\n"; |
1292
|
|
|
|
|
|
|
return undef; |
1293
|
|
|
|
|
|
|
}, |
1294
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1295
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
1296
|
|
|
|
|
|
|
}, |
1297
|
|
|
|
|
|
|
FileInodeChangeDate => { |
1298
|
|
|
|
|
|
|
Description => 'File Inode Change Date/Time', |
1299
|
|
|
|
|
|
|
Notes => q{ |
1300
|
|
|
|
|
|
|
the date/time when the file's directory information was last changed. |
1301
|
|
|
|
|
|
|
Non-Windows systems only |
1302
|
|
|
|
|
|
|
}, |
1303
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1304
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1305
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1306
|
|
|
|
|
|
|
}, |
1307
|
|
|
|
|
|
|
FilePermissions => { |
1308
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1309
|
|
|
|
|
|
|
Notes => q{ |
1310
|
|
|
|
|
|
|
r=read, w=write and x=execute permissions for the file owner, group and |
1311
|
|
|
|
|
|
|
others. The ValueConv value is an octal number so bit test operations on |
1312
|
|
|
|
|
|
|
this value should be done in octal, eg. 'oct($filePermissions#) & 0200' |
1313
|
|
|
|
|
|
|
}, |
1314
|
|
|
|
|
|
|
Writable => 1, |
1315
|
|
|
|
|
|
|
WritePseudo => 1, |
1316
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1317
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1318
|
|
|
|
|
|
|
ValueConv => 'sprintf("%.3o", $val)', |
1319
|
|
|
|
|
|
|
ValueConvInv => 'oct($val & 07777)', |
1320
|
|
|
|
|
|
|
PrintConv => sub { |
1321
|
|
|
|
|
|
|
my ($mask, $val) = (0400, oct(shift)); |
1322
|
|
|
|
|
|
|
my %types = ( |
1323
|
|
|
|
|
|
|
0010000 => 'p', |
1324
|
|
|
|
|
|
|
0020000 => 'c', |
1325
|
|
|
|
|
|
|
0040000 => 'd', |
1326
|
|
|
|
|
|
|
0060000 => 'b', |
1327
|
|
|
|
|
|
|
0120000 => 'l', |
1328
|
|
|
|
|
|
|
0140000 => 's', |
1329
|
|
|
|
|
|
|
); |
1330
|
|
|
|
|
|
|
my $str = $types{$val & 0170000} || '-'; |
1331
|
|
|
|
|
|
|
while ($mask) { |
1332
|
|
|
|
|
|
|
foreach (qw(r w x)) { |
1333
|
|
|
|
|
|
|
$str .= $val & $mask ? $_ : '-'; |
1334
|
|
|
|
|
|
|
$mask >>= 1; |
1335
|
|
|
|
|
|
|
} |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
return $str; |
1338
|
|
|
|
|
|
|
}, |
1339
|
|
|
|
|
|
|
PrintConvInv => sub { |
1340
|
|
|
|
|
|
|
my ($bit, $val, $str) = (8, 0, shift); |
1341
|
|
|
|
|
|
|
$str = substr($str, 1) if length($str) == 10; |
1342
|
|
|
|
|
|
|
return undef if length($str) != 9; |
1343
|
|
|
|
|
|
|
while ($bit >= 0) { |
1344
|
|
|
|
|
|
|
foreach (qw(r w x)) { |
1345
|
|
|
|
|
|
|
$val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_; |
1346
|
|
|
|
|
|
|
--$bit; |
1347
|
|
|
|
|
|
|
} |
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
return sprintf('%.3o', $val); |
1350
|
|
|
|
|
|
|
}, |
1351
|
|
|
|
|
|
|
}, |
1352
|
|
|
|
|
|
|
FileAttributes => { |
1353
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1354
|
|
|
|
|
|
|
Notes => q{ |
1355
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1356
|
|
|
|
|
|
|
option is set. 2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows |
1357
|
|
|
|
|
|
|
attribute bits if Win32API::File is available |
1358
|
|
|
|
|
|
|
}, |
1359
|
|
|
|
|
|
|
PrintHex => 1, |
1360
|
|
|
|
|
|
|
PrintConvColumns => 2, |
1361
|
|
|
|
|
|
|
PrintConv => [{ # stat device types (bitmask 0xf000) |
1362
|
|
|
|
|
|
|
0x0000 => 'Unknown', |
1363
|
|
|
|
|
|
|
0x1000 => 'FIFO', |
1364
|
|
|
|
|
|
|
0x2000 => 'Character', |
1365
|
|
|
|
|
|
|
0x3000 => 'Mux Character', |
1366
|
|
|
|
|
|
|
0x4000 => 'Directory', |
1367
|
|
|
|
|
|
|
0x5000 => 'XENIX Named', |
1368
|
|
|
|
|
|
|
0x6000 => 'Block', |
1369
|
|
|
|
|
|
|
0x7000 => 'Mux Block', |
1370
|
|
|
|
|
|
|
0x8000 => 'Regular', |
1371
|
|
|
|
|
|
|
0x9000 => 'VxFS Compressed', |
1372
|
|
|
|
|
|
|
0xa000 => 'Symbolic Link', |
1373
|
|
|
|
|
|
|
0xb000 => 'Solaris Shadow Inode', |
1374
|
|
|
|
|
|
|
0xc000 => 'Socket', |
1375
|
|
|
|
|
|
|
0xd000 => 'Solaris Door', |
1376
|
|
|
|
|
|
|
0xe000 => 'BSD Whiteout', |
1377
|
|
|
|
|
|
|
},{ BITMASK => { # stat attribute bits (bitmask 0x0e00) |
1378
|
|
|
|
|
|
|
9 => 'Sticky', |
1379
|
|
|
|
|
|
|
10 => 'Set Group ID', |
1380
|
|
|
|
|
|
|
11 => 'Set User ID', |
1381
|
|
|
|
|
|
|
}},{ BITMASK => { # Windows attribute bits |
1382
|
|
|
|
|
|
|
0 => 'Read Only', |
1383
|
|
|
|
|
|
|
1 => 'Hidden', |
1384
|
|
|
|
|
|
|
2 => 'System', |
1385
|
|
|
|
|
|
|
3 => 'Volume Label', |
1386
|
|
|
|
|
|
|
4 => 'Directory', |
1387
|
|
|
|
|
|
|
5 => 'Archive', |
1388
|
|
|
|
|
|
|
6 => 'Device', |
1389
|
|
|
|
|
|
|
7 => 'Normal', |
1390
|
|
|
|
|
|
|
8 => 'Temporary', |
1391
|
|
|
|
|
|
|
9 => 'Sparse File', |
1392
|
|
|
|
|
|
|
10 => 'Reparse Point', |
1393
|
|
|
|
|
|
|
11 => 'Compressed', |
1394
|
|
|
|
|
|
|
12 => 'Offline', |
1395
|
|
|
|
|
|
|
13 => 'Not Content Indexed', |
1396
|
|
|
|
|
|
|
14 => 'Encrypted', |
1397
|
|
|
|
|
|
|
}}], |
1398
|
|
|
|
|
|
|
}, |
1399
|
|
|
|
|
|
|
FileDeviceID => { |
1400
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1401
|
|
|
|
|
|
|
%systemTagsNotes, |
1402
|
|
|
|
|
|
|
PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor) |
1403
|
|
|
|
|
|
|
}, |
1404
|
|
|
|
|
|
|
FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1405
|
|
|
|
|
|
|
FileInodeNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1406
|
|
|
|
|
|
|
FileHardLinks => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1407
|
|
|
|
|
|
|
FileUserID => { |
1408
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1409
|
|
|
|
|
|
|
Notes => q{ |
1410
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1411
|
|
|
|
|
|
|
option is set. Returns user ID number with the -n option, or name |
1412
|
|
|
|
|
|
|
otherwise. May be written with either user name or number |
1413
|
|
|
|
|
|
|
}, |
1414
|
|
|
|
|
|
|
Writable => 1, |
1415
|
|
|
|
|
|
|
WritePseudo => 1, |
1416
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1417
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1418
|
|
|
|
|
|
|
PrintConv => 'eval { getpwuid($val) } || $val', |
1419
|
|
|
|
|
|
|
PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', |
1420
|
|
|
|
|
|
|
}, |
1421
|
|
|
|
|
|
|
FileGroupID => { |
1422
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1423
|
|
|
|
|
|
|
Notes => q{ |
1424
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1425
|
|
|
|
|
|
|
option is set. Returns group ID number with the -n option, or name |
1426
|
|
|
|
|
|
|
otherwise. May be written with either group name or number |
1427
|
|
|
|
|
|
|
}, |
1428
|
|
|
|
|
|
|
Writable => 1, |
1429
|
|
|
|
|
|
|
WritePseudo => 1, |
1430
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1431
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1432
|
|
|
|
|
|
|
PrintConv => 'eval { getgrgid($val) } || $val', |
1433
|
|
|
|
|
|
|
PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', |
1434
|
|
|
|
|
|
|
}, |
1435
|
|
|
|
|
|
|
FileBlockSize => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1436
|
|
|
|
|
|
|
FileBlockCount => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1437
|
|
|
|
|
|
|
HardLink => { |
1438
|
|
|
|
|
|
|
Writable => 1, |
1439
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1440
|
|
|
|
|
|
|
WriteOnly => 1, |
1441
|
|
|
|
|
|
|
WritePseudo => 1, |
1442
|
|
|
|
|
|
|
Protected => 1, |
1443
|
|
|
|
|
|
|
Notes => q{ |
1444
|
|
|
|
|
|
|
this write-only tag is used to create a hard link with the specified name to |
1445
|
|
|
|
|
|
|
the source file. If the source file is edited, copied, renamed or moved in |
1446
|
|
|
|
|
|
|
the same operation as writing HardLink, then the link is made to the updated |
1447
|
|
|
|
|
|
|
file. Note that subsequent editing of either hard-linked file by exiftool |
1448
|
|
|
|
|
|
|
will break the link unless the -overwrite_original_in_place option is used |
1449
|
|
|
|
|
|
|
}, |
1450
|
|
|
|
|
|
|
ValueConvInv => '$val=~tr/\\\\/\//; $val', |
1451
|
|
|
|
|
|
|
}, |
1452
|
|
|
|
|
|
|
SymLink => { |
1453
|
|
|
|
|
|
|
Writable => 1, |
1454
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1455
|
|
|
|
|
|
|
WriteOnly => 1, |
1456
|
|
|
|
|
|
|
WritePseudo => 1, |
1457
|
|
|
|
|
|
|
Protected => 1, |
1458
|
|
|
|
|
|
|
Notes => q{ |
1459
|
|
|
|
|
|
|
this write-only tag is used to create a symbolic link with the specified |
1460
|
|
|
|
|
|
|
name to the source file. If the source file is edited, copied, renamed or |
1461
|
|
|
|
|
|
|
moved in the same operation as writing SymLink, then the link is made to the |
1462
|
|
|
|
|
|
|
updated file. The link uses an absolute path unless it is created in the |
1463
|
|
|
|
|
|
|
current working directory. Valid only for file systems that support |
1464
|
|
|
|
|
|
|
symbolic links. Note that subsequent editing of the file via the symbolic |
1465
|
|
|
|
|
|
|
link by exiftool will cause the link to be replaced by the edited file |
1466
|
|
|
|
|
|
|
without changing the original unless the -overwrite_original_in_place option |
1467
|
|
|
|
|
|
|
is used |
1468
|
|
|
|
|
|
|
}, |
1469
|
|
|
|
|
|
|
ValueConvInv => '$val=~tr/\\\\/\//; $val', |
1470
|
|
|
|
|
|
|
}, |
1471
|
|
|
|
|
|
|
MIMEType => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } }, |
1472
|
|
|
|
|
|
|
ImageWidth => { Notes => 'the width of the image in number of pixels' }, |
1473
|
|
|
|
|
|
|
ImageHeight => { Notes => 'the height of the image in number of pixels' }, |
1474
|
|
|
|
|
|
|
XResolution => { Notes => 'the horizontal pixel resolution' }, |
1475
|
|
|
|
|
|
|
YResolution => { Notes => 'the vertical pixel resolution' }, |
1476
|
|
|
|
|
|
|
MaxVal => { Notes => 'maximum pixel value in PPM or PGM image' }, |
1477
|
|
|
|
|
|
|
EXIF => { |
1478
|
|
|
|
|
|
|
Notes => q{ |
1479
|
|
|
|
|
|
|
the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag |
1480
|
|
|
|
|
|
|
is generated only if specifically requested |
1481
|
|
|
|
|
|
|
}, |
1482
|
|
|
|
|
|
|
Groups => { 0 => 'EXIF', 1 => 'EXIF' }, |
1483
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1484
|
|
|
|
|
|
|
WriteCheck => q{ |
1485
|
|
|
|
|
|
|
return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/; |
1486
|
|
|
|
|
|
|
return 'Invalid EXIF data'; |
1487
|
|
|
|
|
|
|
}, |
1488
|
|
|
|
|
|
|
}, |
1489
|
|
|
|
|
|
|
IPTC => { |
1490
|
|
|
|
|
|
|
Notes => q{ |
1491
|
|
|
|
|
|
|
the full IPTC data block. This tag is generated only if specifically |
1492
|
|
|
|
|
|
|
requested |
1493
|
|
|
|
|
|
|
}, |
1494
|
|
|
|
|
|
|
Groups => { 0 => 'IPTC', 1 => 'IPTC' }, |
1495
|
|
|
|
|
|
|
Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], |
1496
|
|
|
|
|
|
|
Priority => 0, # so main IPTC (which hopefully comes first) takes priority |
1497
|
|
|
|
|
|
|
WriteCheck => q{ |
1498
|
|
|
|
|
|
|
return undef if $val =~ /^(\x1c|\0+$)/; |
1499
|
|
|
|
|
|
|
return 'Invalid IPTC data'; |
1500
|
|
|
|
|
|
|
}, |
1501
|
|
|
|
|
|
|
}, |
1502
|
|
|
|
|
|
|
XMP => { |
1503
|
|
|
|
|
|
|
Notes => q{ |
1504
|
|
|
|
|
|
|
the XMP data block, but note that extended XMP in JPEG images may be split |
1505
|
|
|
|
|
|
|
into multiple blocks. This tag is generated only if specifically requested |
1506
|
|
|
|
|
|
|
}, |
1507
|
|
|
|
|
|
|
Groups => { 0 => 'XMP', 1 => 'XMP' }, |
1508
|
|
|
|
|
|
|
Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], |
1509
|
|
|
|
|
|
|
Priority => 0, # so main xmp (which usually comes first) takes priority |
1510
|
|
|
|
|
|
|
WriteCheck => q{ |
1511
|
|
|
|
|
|
|
require Image::ExifTool::XMP; |
1512
|
|
|
|
|
|
|
return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val); |
1513
|
|
|
|
|
|
|
}, |
1514
|
|
|
|
|
|
|
}, |
1515
|
|
|
|
|
|
|
XML => { |
1516
|
|
|
|
|
|
|
Notes => 'the XML data block, extracted for some file types', |
1517
|
|
|
|
|
|
|
Groups => { 0 => 'XML', 1 => 'XML' }, |
1518
|
|
|
|
|
|
|
Binary => 1, |
1519
|
|
|
|
|
|
|
}, |
1520
|
|
|
|
|
|
|
ICC_Profile => { |
1521
|
|
|
|
|
|
|
Notes => q{ |
1522
|
|
|
|
|
|
|
the full ICC_Profile data block. This tag is generated only if specifically |
1523
|
|
|
|
|
|
|
requested |
1524
|
|
|
|
|
|
|
}, |
1525
|
|
|
|
|
|
|
Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' }, |
1526
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1527
|
|
|
|
|
|
|
WriteCheck => q{ |
1528
|
|
|
|
|
|
|
require Image::ExifTool::ICC_Profile; |
1529
|
|
|
|
|
|
|
return Image::ExifTool::ICC_Profile::ValidateICC(\$val); |
1530
|
|
|
|
|
|
|
}, |
1531
|
|
|
|
|
|
|
}, |
1532
|
|
|
|
|
|
|
CanonVRD => { |
1533
|
|
|
|
|
|
|
Notes => q{ |
1534
|
|
|
|
|
|
|
the full Canon DPP VRD trailer block. This tag is generated only if |
1535
|
|
|
|
|
|
|
specifically requested |
1536
|
|
|
|
|
|
|
}, |
1537
|
|
|
|
|
|
|
Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, |
1538
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1539
|
|
|
|
|
|
|
Permanent => 0, # (this is 1 by default for MakerNotes tags) |
1540
|
|
|
|
|
|
|
WriteCheck => q{ |
1541
|
|
|
|
|
|
|
return undef if $val =~ /^CANON OPTIONAL DATA\0/; |
1542
|
|
|
|
|
|
|
return 'Invalid CanonVRD data'; |
1543
|
|
|
|
|
|
|
}, |
1544
|
|
|
|
|
|
|
}, |
1545
|
|
|
|
|
|
|
CanonDR4 => { |
1546
|
|
|
|
|
|
|
Notes => q{ |
1547
|
|
|
|
|
|
|
the full Canon DPP version 4 DR4 block. This tag is generated only if |
1548
|
|
|
|
|
|
|
specifically requested |
1549
|
|
|
|
|
|
|
}, |
1550
|
|
|
|
|
|
|
Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, |
1551
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary'], |
1552
|
|
|
|
|
|
|
Permanent => 0, # (this is 1 by default for MakerNotes tags) |
1553
|
|
|
|
|
|
|
WriteCheck => q{ |
1554
|
|
|
|
|
|
|
return undef if $val =~ /^IIII\x04\0\x04\0/; |
1555
|
|
|
|
|
|
|
return 'Invalid CanonDR4 data'; |
1556
|
|
|
|
|
|
|
}, |
1557
|
|
|
|
|
|
|
}, |
1558
|
|
|
|
|
|
|
Adobe => { |
1559
|
|
|
|
|
|
|
Notes => q{ |
1560
|
|
|
|
|
|
|
the JPEG APP14 Adobe segment. Extracted only if specified. See the |
1561
|
|
|
|
|
|
|
L for more information |
1562
|
|
|
|
|
|
|
}, |
1563
|
|
|
|
|
|
|
Groups => { 0 => 'APP14', 1 => 'Adobe' }, |
1564
|
|
|
|
|
|
|
WriteGroup => 'Adobe', |
1565
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary'], |
1566
|
|
|
|
|
|
|
}, |
1567
|
|
|
|
|
|
|
CurrentIPTCDigest => { |
1568
|
|
|
|
|
|
|
Notes => q{ |
1569
|
|
|
|
|
|
|
MD5 digest of existing IPTC data. All zeros if IPTC exists but Digest::MD5 |
1570
|
|
|
|
|
|
|
is not installed. Only calculated for IPTC in the standard location as |
1571
|
|
|
|
|
|
|
specified by the L. ExifTool |
1572
|
|
|
|
|
|
|
automates the handling of this tag in the MWG module -- see the |
1573
|
|
|
|
|
|
|
L for details |
1574
|
|
|
|
|
|
|
}, |
1575
|
|
|
|
|
|
|
ValueConv => 'unpack("H*", $val)', |
1576
|
|
|
|
|
|
|
}, |
1577
|
|
|
|
|
|
|
PreviewImage => { |
1578
|
|
|
|
|
|
|
Notes => 'JPEG-format embedded preview image', |
1579
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1580
|
|
|
|
|
|
|
Writable => 1, |
1581
|
|
|
|
|
|
|
WriteCheck => '$self->CheckImage(\$val)', |
1582
|
|
|
|
|
|
|
WriteGroup => 'All', |
1583
|
|
|
|
|
|
|
# can't delete, so set to empty string and return no error |
1584
|
|
|
|
|
|
|
DelCheck => '$val = ""; return undef', |
1585
|
|
|
|
|
|
|
# accept either scalar or scalar reference |
1586
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1587
|
|
|
|
|
|
|
}, |
1588
|
|
|
|
|
|
|
ThumbnailImage => { |
1589
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1590
|
|
|
|
|
|
|
Notes => 'JPEG-format embedded thumbnail image', |
1591
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1592
|
|
|
|
|
|
|
}, |
1593
|
|
|
|
|
|
|
OtherImage => { |
1594
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1595
|
|
|
|
|
|
|
Notes => 'other JPEG-format embedded image', |
1596
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1597
|
|
|
|
|
|
|
}, |
1598
|
|
|
|
|
|
|
PreviewPNG => { |
1599
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1600
|
|
|
|
|
|
|
Notes => 'PNG-format embedded preview image', |
1601
|
|
|
|
|
|
|
Binary => 1, |
1602
|
|
|
|
|
|
|
}, |
1603
|
|
|
|
|
|
|
PreviewWMF => { |
1604
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1605
|
|
|
|
|
|
|
Notes => 'WMF-format embedded preview image', |
1606
|
|
|
|
|
|
|
Binary => 1, |
1607
|
|
|
|
|
|
|
}, |
1608
|
|
|
|
|
|
|
PreviewTIFF => { |
1609
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1610
|
|
|
|
|
|
|
Notes => 'TIFF-format embedded preview image', |
1611
|
|
|
|
|
|
|
Binary => 1, |
1612
|
|
|
|
|
|
|
}, |
1613
|
|
|
|
|
|
|
PreviewPDF => { |
1614
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1615
|
|
|
|
|
|
|
Notes => 'PDF-format embedded preview image', |
1616
|
|
|
|
|
|
|
Binary => 1, |
1617
|
|
|
|
|
|
|
}, |
1618
|
|
|
|
|
|
|
ExifByteOrder => { |
1619
|
|
|
|
|
|
|
Writable => 1, |
1620
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1621
|
|
|
|
|
|
|
Notes => q{ |
1622
|
|
|
|
|
|
|
represents the byte order of EXIF information. May be written to set the |
1623
|
|
|
|
|
|
|
byte order only for newly created EXIF segments |
1624
|
|
|
|
|
|
|
}, |
1625
|
|
|
|
|
|
|
PrintConv => { |
1626
|
|
|
|
|
|
|
II => 'Little-endian (Intel, II)', |
1627
|
|
|
|
|
|
|
MM => 'Big-endian (Motorola, MM)', |
1628
|
|
|
|
|
|
|
}, |
1629
|
|
|
|
|
|
|
}, |
1630
|
|
|
|
|
|
|
ExifUnicodeByteOrder => { |
1631
|
|
|
|
|
|
|
Writable => 1, |
1632
|
|
|
|
|
|
|
WriteOnly => 1, |
1633
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1634
|
|
|
|
|
|
|
Notes => q{ |
1635
|
|
|
|
|
|
|
specifies the byte order to use when writing EXIF Unicode text. The EXIF |
1636
|
|
|
|
|
|
|
specification is particularly vague about this byte ordering, and different |
1637
|
|
|
|
|
|
|
applications use different conventions. By default ExifTool writes Unicode |
1638
|
|
|
|
|
|
|
text in EXIF byte order, but this write-only tag may be used to force a |
1639
|
|
|
|
|
|
|
specific order. Applies to the EXIF UserComment tag when writing special |
1640
|
|
|
|
|
|
|
characters |
1641
|
|
|
|
|
|
|
}, |
1642
|
|
|
|
|
|
|
PrintConv => { |
1643
|
|
|
|
|
|
|
II => 'Little-endian (Intel, II)', |
1644
|
|
|
|
|
|
|
MM => 'Big-endian (Motorola, MM)', |
1645
|
|
|
|
|
|
|
}, |
1646
|
|
|
|
|
|
|
}, |
1647
|
|
|
|
|
|
|
ExifToolVersion => { |
1648
|
|
|
|
|
|
|
Description => 'ExifTool Version Number', |
1649
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1650
|
|
|
|
|
|
|
Notes => 'the version of ExifTool currently running', |
1651
|
|
|
|
|
|
|
}, |
1652
|
|
|
|
|
|
|
ProcessingTime => { |
1653
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1654
|
|
|
|
|
|
|
Notes => q{ |
1655
|
|
|
|
|
|
|
the clock time in seconds taken by ExifTool to extract information from this |
1656
|
|
|
|
|
|
|
file. Not generated unless specifically requested or the L API |
1657
|
|
|
|
|
|
|
option is set. Requires Time::HiRes |
1658
|
|
|
|
|
|
|
}, |
1659
|
|
|
|
|
|
|
PrintConv => 'sprintf("%.3g s", $val)', |
1660
|
|
|
|
|
|
|
}, |
1661
|
|
|
|
|
|
|
RAFVersion => { Notes => 'RAF file version number' }, |
1662
|
|
|
|
|
|
|
JPEGDigest => { |
1663
|
|
|
|
|
|
|
Notes => q{ |
1664
|
|
|
|
|
|
|
an MD5 digest of the JPEG quantization tables is combined with the component |
1665
|
|
|
|
|
|
|
sub-sampling values to generate the value of this tag. The result is |
1666
|
|
|
|
|
|
|
compared to known values in an attempt to deduce the originating software |
1667
|
|
|
|
|
|
|
based only on the JPEG image data. For performance reasons, this tag is |
1668
|
|
|
|
|
|
|
generated only if specifically requested or the API L option is set |
1669
|
|
|
|
|
|
|
to 3 or higher |
1670
|
|
|
|
|
|
|
}, |
1671
|
|
|
|
|
|
|
}, |
1672
|
|
|
|
|
|
|
JPEGQualityEstimate => { |
1673
|
|
|
|
|
|
|
Notes => q{ |
1674
|
|
|
|
|
|
|
an estimate of the IJG JPEG quality setting for the image, calculated from |
1675
|
|
|
|
|
|
|
the quantization tables. For performance reasons, this tag is generated |
1676
|
|
|
|
|
|
|
only if specifically requested or the API L option is set to 3 or |
1677
|
|
|
|
|
|
|
higher |
1678
|
|
|
|
|
|
|
}, |
1679
|
|
|
|
|
|
|
}, |
1680
|
|
|
|
|
|
|
JPEGImageLength => { |
1681
|
|
|
|
|
|
|
Notes => q{ |
1682
|
|
|
|
|
|
|
byte length of JPEG image without metadata. For performance reasons, this |
1683
|
|
|
|
|
|
|
tag is generated only if specifically requested or the API L option |
1684
|
|
|
|
|
|
|
is set to 3 or higher |
1685
|
|
|
|
|
|
|
}, |
1686
|
|
|
|
|
|
|
}, |
1687
|
|
|
|
|
|
|
# Validate (added from Validate.pm) |
1688
|
|
|
|
|
|
|
Now => { |
1689
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' }, |
1690
|
|
|
|
|
|
|
Notes => q{ |
1691
|
|
|
|
|
|
|
the current date/time. Useful when setting the tag values, eg. |
1692
|
|
|
|
|
|
|
C<"-modifydate. Not generated unless specifically requested or the |
1693
|
|
|
|
|
|
|
API L option is set |
1694
|
|
|
|
|
|
|
}, |
1695
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1696
|
|
|
|
|
|
|
}, |
1697
|
|
|
|
|
|
|
NewGUID => { |
1698
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1699
|
|
|
|
|
|
|
Notes => q{ |
1700
|
|
|
|
|
|
|
generates a new, random GUID with format |
1701
|
|
|
|
|
|
|
YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour, |
1702
|
|
|
|
|
|
|
M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and |
1703
|
|
|
|
|
|
|
R=random hex number; without dashes with the -n option. Not generated |
1704
|
|
|
|
|
|
|
unless specifically requested or the API L option is set |
1705
|
|
|
|
|
|
|
}, |
1706
|
|
|
|
|
|
|
PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val', |
1707
|
|
|
|
|
|
|
}, |
1708
|
|
|
|
|
|
|
ID3Size => { Notes => 'size of the ID3 data block' }, |
1709
|
|
|
|
|
|
|
Geotag => { |
1710
|
|
|
|
|
|
|
Writable => 1, |
1711
|
|
|
|
|
|
|
WriteOnly => 1, |
1712
|
|
|
|
|
|
|
WriteNothing => 1, |
1713
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1714
|
|
|
|
|
|
|
Notes => q{ |
1715
|
|
|
|
|
|
|
this write-only tag is used to define the GPS track log data or track log |
1716
|
|
|
|
|
|
|
file name. Currently supported track log formats are GPX, NMEA RMC/GGA/GLL, |
1717
|
|
|
|
|
|
|
KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus |
1718
|
|
|
|
|
|
|
Beacon text, and Bramor gEO log files. May be set to the special value of |
1719
|
|
|
|
|
|
|
"DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points |
1720
|
|
|
|
|
|
|
are available. See L for details |
1721
|
|
|
|
|
|
|
}, |
1722
|
|
|
|
|
|
|
DelCheck => q{ |
1723
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1724
|
|
|
|
|
|
|
# delete associated tags |
1725
|
|
|
|
|
|
|
Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); |
1726
|
|
|
|
|
|
|
}, |
1727
|
|
|
|
|
|
|
ValueConvInv => q{ |
1728
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1729
|
|
|
|
|
|
|
# always warn because this tag is never set (warning is "\n" on success) |
1730
|
|
|
|
|
|
|
my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val); |
1731
|
|
|
|
|
|
|
return '' if not defined $result; # deleting geo tags |
1732
|
|
|
|
|
|
|
return $result if ref $result; # geotag data hash reference |
1733
|
|
|
|
|
|
|
warn "$result\n"; # error string |
1734
|
|
|
|
|
|
|
}, |
1735
|
|
|
|
|
|
|
}, |
1736
|
|
|
|
|
|
|
Geotime => { |
1737
|
|
|
|
|
|
|
Writable => 1, |
1738
|
|
|
|
|
|
|
WriteOnly => 1, |
1739
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1740
|
|
|
|
|
|
|
Notes => q{ |
1741
|
|
|
|
|
|
|
this write-only tag is used to define a date/time for interpolating a |
1742
|
|
|
|
|
|
|
position in the GPS track specified by the Geotag tag. Writing this tag |
1743
|
|
|
|
|
|
|
causes GPS information to be written into the EXIF or XMP of the target |
1744
|
|
|
|
|
|
|
files. The local system timezone is assumed if the date/time value does not |
1745
|
|
|
|
|
|
|
contain a timezone. May be deleted to delete associated GPS tags. A group |
1746
|
|
|
|
|
|
|
name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP |
1747
|
|
|
|
|
|
|
GPS tags |
1748
|
|
|
|
|
|
|
}, |
1749
|
|
|
|
|
|
|
DelCheck => q{ |
1750
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1751
|
|
|
|
|
|
|
# delete associated tags |
1752
|
|
|
|
|
|
|
Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); |
1753
|
|
|
|
|
|
|
}, |
1754
|
|
|
|
|
|
|
ValueConvInv => q{ |
1755
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1756
|
|
|
|
|
|
|
warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n"; |
1757
|
|
|
|
|
|
|
return undef; |
1758
|
|
|
|
|
|
|
}, |
1759
|
|
|
|
|
|
|
}, |
1760
|
|
|
|
|
|
|
Geosync => { |
1761
|
|
|
|
|
|
|
Writable => 1, |
1762
|
|
|
|
|
|
|
WriteOnly => 1, |
1763
|
|
|
|
|
|
|
WriteNothing => 1, |
1764
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1765
|
|
|
|
|
|
|
Shift => 'Time', # enables "+=" syntax as well as "=+" |
1766
|
|
|
|
|
|
|
Notes => q{ |
1767
|
|
|
|
|
|
|
this write-only tag specifies a time difference to add to Geotime for |
1768
|
|
|
|
|
|
|
synchronization with the GPS clock. For example, set this to "-12" if the |
1769
|
|
|
|
|
|
|
camera clock is 12 seconds faster than GPS time. Input format is |
1770
|
|
|
|
|
|
|
"[+-][[[DD ]HH:]MM:]SS[.ss]". Additional features allow calculation of time |
1771
|
|
|
|
|
|
|
differences and time drifts, and extraction of synchronization times from |
1772
|
|
|
|
|
|
|
image files. See the L for details |
1773
|
|
|
|
|
|
|
}, |
1774
|
|
|
|
|
|
|
ValueConvInv => q{ |
1775
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1776
|
|
|
|
|
|
|
return Image::ExifTool::Geotag::ConvertGeosync($self, $val); |
1777
|
|
|
|
|
|
|
}, |
1778
|
|
|
|
|
|
|
}, |
1779
|
|
|
|
|
|
|
ForceWrite => { |
1780
|
|
|
|
|
|
|
Groups => { 0 => '*', 1 => '*', 2 => '*' }, |
1781
|
|
|
|
|
|
|
Writable => 1, |
1782
|
|
|
|
|
|
|
WriteOnly => 1, |
1783
|
|
|
|
|
|
|
Notes => q{ |
1784
|
|
|
|
|
|
|
write-only tag used to force metadata in a file to be rewritten even if no |
1785
|
|
|
|
|
|
|
tag values are changed. May be set to "EXIF", "IPTC", "XMP" or "PNG" to |
1786
|
|
|
|
|
|
|
force the corresponding metadata type to be rewritten, "FixBase" to cause |
1787
|
|
|
|
|
|
|
EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All" |
1788
|
|
|
|
|
|
|
to rewrite all of these metadata types. Values are case insensitive, and |
1789
|
|
|
|
|
|
|
multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp> |
1790
|
|
|
|
|
|
|
}, |
1791
|
|
|
|
|
|
|
}, |
1792
|
|
|
|
|
|
|
EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } }, |
1793
|
|
|
|
|
|
|
Trailer => { |
1794
|
|
|
|
|
|
|
Groups => { 0 => 'Trailer' }, |
1795
|
|
|
|
|
|
|
Notes => q{ |
1796
|
|
|
|
|
|
|
the full JPEG trailer data block. Extracted only if specifically requested |
1797
|
|
|
|
|
|
|
or the API RequestAll option is set to 3 or higher |
1798
|
|
|
|
|
|
|
}, |
1799
|
|
|
|
|
|
|
Writable => 1, |
1800
|
|
|
|
|
|
|
Protected => 1, |
1801
|
|
|
|
|
|
|
}, |
1802
|
|
|
|
|
|
|
PageCount => { Notes => 'the number of pages in a multi-page TIFF document' }, |
1803
|
|
|
|
|
|
|
); |
1804
|
|
|
|
|
|
|
|
1805
|
|
|
|
|
|
|
# tags defined by UserParam option (added at runtime) |
1806
|
|
|
|
|
|
|
%Image::ExifTool::UserParam = ( |
1807
|
|
|
|
|
|
|
GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' }, |
1808
|
|
|
|
|
|
|
PRIORITY => 0, |
1809
|
|
|
|
|
|
|
); |
1810
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
# YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP) |
1812
|
|
|
|
|
|
|
%Image::ExifTool::JPEG::yCbCrSubSampling = ( |
1813
|
|
|
|
|
|
|
'1 1' => 'YCbCr4:4:4 (1 1)', #PH |
1814
|
|
|
|
|
|
|
'2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm |
1815
|
|
|
|
|
|
|
'2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm |
1816
|
|
|
|
|
|
|
'4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm |
1817
|
|
|
|
|
|
|
'4 2' => 'YCbCr4:1:0 (4 2)', #PH |
1818
|
|
|
|
|
|
|
'1 2' => 'YCbCr4:4:0 (1 2)', #PH |
1819
|
|
|
|
|
|
|
'1 4' => 'YCbCr4:4:1 (1 4)', #JD |
1820
|
|
|
|
|
|
|
'2 4' => 'YCbCr4:2:1 (2 4)', #JD |
1821
|
|
|
|
|
|
|
); |
1822
|
|
|
|
|
|
|
|
1823
|
|
|
|
|
|
|
# define common JPEG segments here to avoid overhead of loading JPEG module |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
# JPEG SOF (start of frame) tags |
1826
|
|
|
|
|
|
|
# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf) |
1827
|
|
|
|
|
|
|
%Image::ExifTool::JPEG::SOF = ( |
1828
|
|
|
|
|
|
|
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, |
1829
|
|
|
|
|
|
|
NOTES => 'This information is extracted from the JPEG Start Of Frame segment.', |
1830
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags |
1831
|
|
|
|
|
|
|
EncodingProcess => { |
1832
|
|
|
|
|
|
|
PrintHex => 1, |
1833
|
|
|
|
|
|
|
PrintConv => { |
1834
|
|
|
|
|
|
|
0x0 => 'Baseline DCT, Huffman coding', |
1835
|
|
|
|
|
|
|
0x1 => 'Extended sequential DCT, Huffman coding', |
1836
|
|
|
|
|
|
|
0x2 => 'Progressive DCT, Huffman coding', |
1837
|
|
|
|
|
|
|
0x3 => 'Lossless, Huffman coding', |
1838
|
|
|
|
|
|
|
0x5 => 'Sequential DCT, differential Huffman coding', |
1839
|
|
|
|
|
|
|
0x6 => 'Progressive DCT, differential Huffman coding', |
1840
|
|
|
|
|
|
|
0x7 => 'Lossless, Differential Huffman coding', |
1841
|
|
|
|
|
|
|
0x9 => 'Extended sequential DCT, arithmetic coding', |
1842
|
|
|
|
|
|
|
0xa => 'Progressive DCT, arithmetic coding', |
1843
|
|
|
|
|
|
|
0xb => 'Lossless, arithmetic coding', |
1844
|
|
|
|
|
|
|
0xd => 'Sequential DCT, differential arithmetic coding', |
1845
|
|
|
|
|
|
|
0xe => 'Progressive DCT, differential arithmetic coding', |
1846
|
|
|
|
|
|
|
0xf => 'Lossless, differential arithmetic coding', |
1847
|
|
|
|
|
|
|
} |
1848
|
|
|
|
|
|
|
}, |
1849
|
|
|
|
|
|
|
BitsPerSample => { }, |
1850
|
|
|
|
|
|
|
ImageHeight => { }, |
1851
|
|
|
|
|
|
|
ImageWidth => { }, |
1852
|
|
|
|
|
|
|
ColorComponents => { }, |
1853
|
|
|
|
|
|
|
YCbCrSubSampling => { |
1854
|
|
|
|
|
|
|
Notes => 'calculated from components table', |
1855
|
|
|
|
|
|
|
PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling, |
1856
|
|
|
|
|
|
|
}, |
1857
|
|
|
|
|
|
|
); |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
# JPEG JFIF APP0 definitions |
1860
|
|
|
|
|
|
|
%Image::ExifTool::JFIF::Main = ( |
1861
|
|
|
|
|
|
|
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, |
1862
|
|
|
|
|
|
|
WRITE_PROC => \&Image::ExifTool::WriteBinaryData, |
1863
|
|
|
|
|
|
|
CHECK_PROC => \&Image::ExifTool::CheckBinaryData, |
1864
|
|
|
|
|
|
|
GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' }, |
1865
|
|
|
|
|
|
|
DATAMEMBER => [ 2, 3, 5 ], |
1866
|
|
|
|
|
|
|
0 => { |
1867
|
|
|
|
|
|
|
Name => 'JFIFVersion', |
1868
|
|
|
|
|
|
|
Format => 'int8u[2]', |
1869
|
|
|
|
|
|
|
PrintConv => 'sprintf("%d.%.2d", split(" ",$val))', |
1870
|
|
|
|
|
|
|
Mandatory => 1, |
1871
|
|
|
|
|
|
|
}, |
1872
|
|
|
|
|
|
|
2 => { |
1873
|
|
|
|
|
|
|
Name => 'ResolutionUnit', |
1874
|
|
|
|
|
|
|
Writable => 1, |
1875
|
|
|
|
|
|
|
RawConv => '$$self{JFIFResolutionUnit} = $val', |
1876
|
|
|
|
|
|
|
PrintConv => { |
1877
|
|
|
|
|
|
|
0 => 'None', |
1878
|
|
|
|
|
|
|
1 => 'inches', |
1879
|
|
|
|
|
|
|
2 => 'cm', |
1880
|
|
|
|
|
|
|
}, |
1881
|
|
|
|
|
|
|
Priority => -1, |
1882
|
|
|
|
|
|
|
Mandatory => 1, |
1883
|
|
|
|
|
|
|
}, |
1884
|
|
|
|
|
|
|
3 => { |
1885
|
|
|
|
|
|
|
Name => 'XResolution', |
1886
|
|
|
|
|
|
|
Format => 'int16u', |
1887
|
|
|
|
|
|
|
Writable => 1, |
1888
|
|
|
|
|
|
|
Priority => -1, |
1889
|
|
|
|
|
|
|
RawConv => '$$self{JFIFXResolution} = $val', |
1890
|
|
|
|
|
|
|
Mandatory => 1, |
1891
|
|
|
|
|
|
|
}, |
1892
|
|
|
|
|
|
|
5 => { |
1893
|
|
|
|
|
|
|
Name => 'YResolution', |
1894
|
|
|
|
|
|
|
Format => 'int16u', |
1895
|
|
|
|
|
|
|
Writable => 1, |
1896
|
|
|
|
|
|
|
Priority => -1, |
1897
|
|
|
|
|
|
|
RawConv => '$$self{JFIFYResolution} = $val', |
1898
|
|
|
|
|
|
|
Mandatory => 1, |
1899
|
|
|
|
|
|
|
}, |
1900
|
|
|
|
|
|
|
7 => { |
1901
|
|
|
|
|
|
|
Name => 'ThumbnailWidth', |
1902
|
|
|
|
|
|
|
RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef', |
1903
|
|
|
|
|
|
|
}, |
1904
|
|
|
|
|
|
|
8 => { |
1905
|
|
|
|
|
|
|
Name => 'ThumbnailHeight', |
1906
|
|
|
|
|
|
|
RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef', |
1907
|
|
|
|
|
|
|
}, |
1908
|
|
|
|
|
|
|
9 => { |
1909
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1910
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1911
|
|
|
|
|
|
|
Format => 'undef[3*($val{7}||0)*($val{8}||0)]', |
1912
|
|
|
|
|
|
|
Notes => 'raw RGB thumbnail data, extracted as a TIFF image', |
1913
|
|
|
|
|
|
|
RawConv => 'length($val) ? $val : undef', |
1914
|
|
|
|
|
|
|
ValueConv => sub { |
1915
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1916
|
|
|
|
|
|
|
my $len = length $val; |
1917
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1918
|
|
|
|
|
|
|
my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val; |
1919
|
|
|
|
|
|
|
return \$img; |
1920
|
|
|
|
|
|
|
}, |
1921
|
|
|
|
|
|
|
}, |
1922
|
|
|
|
|
|
|
); |
1923
|
|
|
|
|
|
|
%Image::ExifTool::JFIF::Extension = ( |
1924
|
|
|
|
|
|
|
GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' }, |
1925
|
|
|
|
|
|
|
NOTES => 'Thumbnail images extracted from the JFXX segment.', |
1926
|
|
|
|
|
|
|
0x10 => { |
1927
|
|
|
|
|
|
|
Name => 'ThumbnailImage', |
1928
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1929
|
|
|
|
|
|
|
Notes => 'JPEG-format thumbnail image', |
1930
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(\$val,$tag)', |
1931
|
|
|
|
|
|
|
}, |
1932
|
|
|
|
|
|
|
0x11 => { # (untested) |
1933
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1934
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1935
|
|
|
|
|
|
|
Notes => 'raw palette-color thumbnail data, extracted as a TIFF image', |
1936
|
|
|
|
|
|
|
RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef', |
1937
|
|
|
|
|
|
|
ValueConv => sub { |
1938
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1939
|
|
|
|
|
|
|
my $len = length $val; |
1940
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1941
|
|
|
|
|
|
|
my ($w, $h) = unpack('CC', $val); |
1942
|
|
|
|
|
|
|
my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770); |
1943
|
|
|
|
|
|
|
return \$img; |
1944
|
|
|
|
|
|
|
}, |
1945
|
|
|
|
|
|
|
}, |
1946
|
|
|
|
|
|
|
0x13 => { |
1947
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1948
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1949
|
|
|
|
|
|
|
Notes => 'raw RGB thumbnail data, extracted as a TIFF image', |
1950
|
|
|
|
|
|
|
RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef', |
1951
|
|
|
|
|
|
|
ValueConv => sub { |
1952
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1953
|
|
|
|
|
|
|
my $len = length $val; |
1954
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1955
|
|
|
|
|
|
|
my ($w, $h) = unpack('CC', $val); |
1956
|
|
|
|
|
|
|
my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2); |
1957
|
|
|
|
|
|
|
return \$img; |
1958
|
|
|
|
|
|
|
}, |
1959
|
|
|
|
|
|
|
}, |
1960
|
|
|
|
|
|
|
# Apple may add "AMPF" to the end of the JFIF record, |
1961
|
|
|
|
|
|
|
# possibly indicating the existence of MPF images (ref forum12677) |
1962
|
|
|
|
|
|
|
); |
1963
|
|
|
|
|
|
|
|
1964
|
|
|
|
|
|
|
# Composite tags (accumulation of all Composite tag tables) |
1965
|
|
|
|
|
|
|
%Image::ExifTool::Composite = ( |
1966
|
|
|
|
|
|
|
GROUPS => { 0 => 'Composite', 1 => 'Composite' }, |
1967
|
|
|
|
|
|
|
TABLE_NAME => 'Image::ExifTool::Composite', |
1968
|
|
|
|
|
|
|
SHORT_NAME => 'Composite', |
1969
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags |
1970
|
|
|
|
|
|
|
WRITE_PROC => \&DummyWriteProc, |
1971
|
|
|
|
|
|
|
); |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
my %compositeID; # lookup for new ID's of Composite tags based on original ID |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
# static private ExifTool variables |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
%allTables = ( ); # list of all tables loaded (except Composite tags) |
1978
|
|
|
|
|
|
|
@tableOrder = ( ); # order the tables were loaded |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1981
|
|
|
|
|
|
|
# Warning handler routines (warning string stored in $evalWarning) |
1982
|
|
|
|
|
|
|
# |
1983
|
|
|
|
|
|
|
# Set warning message |
1984
|
|
|
|
|
|
|
# Inputs: 0) warning string (undef to reset warning) |
1985
|
38
|
|
|
38
|
0
|
476
|
sub SetWarning($) { $evalWarning = $_[0]; } |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
# Get warning message |
1988
|
17
|
|
|
17
|
0
|
61
|
sub GetWarning() { return $evalWarning; } |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
# Clean unnecessary information (line number, LF) from warning |
1991
|
|
|
|
|
|
|
# Inputs: 0) warning string or undef to use $evalWarning |
1992
|
|
|
|
|
|
|
# Returns: cleaned warning |
1993
|
|
|
|
|
|
|
sub CleanWarning(;$) |
1994
|
|
|
|
|
|
|
{ |
1995
|
223
|
|
|
223
|
0
|
358
|
my $str = shift; |
1996
|
223
|
50
|
|
|
|
579
|
unless (defined $str) { |
1997
|
223
|
50
|
|
|
|
478
|
return undef unless defined $evalWarning; |
1998
|
223
|
|
|
|
|
345
|
$str = $evalWarning; |
1999
|
|
|
|
|
|
|
} |
2000
|
223
|
100
|
|
|
|
1215
|
$str = $1 if $str =~ /(.*) at /s; |
2001
|
223
|
|
|
|
|
777
|
$str =~ s/\s+$//s; |
2002
|
223
|
|
|
|
|
826
|
return $str; |
2003
|
|
|
|
|
|
|
} |
2004
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
#============================================================================== |
2006
|
|
|
|
|
|
|
# New - create new ExifTool object |
2007
|
|
|
|
|
|
|
# Inputs: 0) reference to exiftool object or ExifTool class name |
2008
|
|
|
|
|
|
|
# Returns: blessed ExifTool object ref |
2009
|
|
|
|
|
|
|
sub new |
2010
|
|
|
|
|
|
|
{ |
2011
|
471
|
|
|
471
|
1
|
103541
|
local $_; |
2012
|
471
|
|
|
|
|
1086
|
my $that = shift; |
2013
|
471
|
|
50
|
|
|
3030
|
my $class = ref($that) || $that || 'Image::ExifTool'; |
2014
|
471
|
|
|
|
|
1425
|
my $self = bless {}, $class; |
2015
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
# make sure our main Exif tag table has been loaded |
2017
|
471
|
|
|
|
|
1692
|
GetTagTable("Image::ExifTool::Exif::Main"); |
2018
|
|
|
|
|
|
|
|
2019
|
471
|
|
|
|
|
2350
|
$self->ClearOptions(); # create default options hash |
2020
|
471
|
|
|
|
|
1114
|
$$self{VALUE} = { }; # must initialize this for warning messages |
2021
|
471
|
|
|
|
|
1280
|
$$self{PATH} = [ ]; # (this too) |
2022
|
471
|
|
|
|
|
1141
|
$$self{DEL_GROUP} = { }; # lookup for groups to delete when writing |
2023
|
471
|
|
|
|
|
1072
|
$$self{SAVE_COUNT} = 0; # count calls to SaveNewValues() |
2024
|
471
|
|
|
|
|
1000
|
$$self{FILE_SEQUENCE} = 0; # sequence number for files when reading |
2025
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
# initialize our new groups for writing |
2027
|
471
|
|
|
|
|
2338
|
$self->SetNewGroups(@defaultWriteGroups); |
2028
|
|
|
|
|
|
|
|
2029
|
471
|
|
|
|
|
1938
|
return $self; |
2030
|
|
|
|
|
|
|
} |
2031
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2033
|
|
|
|
|
|
|
# ImageInfo - return specified information from image file |
2034
|
|
|
|
|
|
|
# Inputs: 0) [optional] ExifTool object reference |
2035
|
|
|
|
|
|
|
# 1) filename, file reference, or scalar data reference |
2036
|
|
|
|
|
|
|
# 2-N) list of tag names to find (or tag list reference or options reference) |
2037
|
|
|
|
|
|
|
# Returns: reference to hash of tag/value pairs (with "Error" entry on error) |
2038
|
|
|
|
|
|
|
# Notes: |
2039
|
|
|
|
|
|
|
# - if no tags names are specified, the values of all tags are returned |
2040
|
|
|
|
|
|
|
# - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv |
2041
|
|
|
|
|
|
|
# - can pass a reference to list of tags to find, in which case the list will |
2042
|
|
|
|
|
|
|
# be updated with the tags found in the proper case and in the specified order. |
2043
|
|
|
|
|
|
|
# - can pass reference to hash specifying options |
2044
|
|
|
|
|
|
|
# - returned tag values may be scalar references indicating binary data |
2045
|
|
|
|
|
|
|
# - see ClearOptions() below for a list of options and their default values |
2046
|
|
|
|
|
|
|
# Examples: |
2047
|
|
|
|
|
|
|
# use Image::ExifTool 'ImageInfo'; |
2048
|
|
|
|
|
|
|
# my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize'); |
2049
|
|
|
|
|
|
|
# - or - |
2050
|
|
|
|
|
|
|
# my $et = new Image::ExifTool; |
2051
|
|
|
|
|
|
|
# my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} ); |
2052
|
|
|
|
|
|
|
sub ImageInfo($;@) |
2053
|
|
|
|
|
|
|
{ |
2054
|
506
|
|
|
506
|
1
|
22217
|
local $_; |
2055
|
|
|
|
|
|
|
# get our ExifTool object ($self) or create one if necessary |
2056
|
506
|
|
|
|
|
1045
|
my $self; |
2057
|
506
|
100
|
100
|
|
|
4536
|
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) { |
2058
|
497
|
|
|
|
|
1177
|
$self = shift; |
2059
|
|
|
|
|
|
|
} else { |
2060
|
9
|
|
|
|
|
61
|
$self = new Image::ExifTool; |
2061
|
|
|
|
|
|
|
} |
2062
|
506
|
|
|
|
|
917
|
my %saveOptions = %{$$self{OPTIONS}}; # save original options |
|
506
|
|
|
|
|
18705
|
|
2063
|
|
|
|
|
|
|
|
2064
|
|
|
|
|
|
|
# initialize file information |
2065
|
506
|
|
|
|
|
3191
|
$$self{FILENAME} = $$self{RAF} = undef; |
2066
|
|
|
|
|
|
|
|
2067
|
506
|
|
|
|
|
2283
|
$self->ParseArguments(@_); # parse our function arguments |
2068
|
506
|
|
|
|
|
2237
|
$self->ExtractInfo(undef); # extract meta information from image |
2069
|
506
|
|
|
|
|
2128
|
my $info = $self->GetInfo(undef); # get requested information |
2070
|
|
|
|
|
|
|
|
2071
|
506
|
|
|
|
|
6540
|
$$self{OPTIONS} = \%saveOptions; # restore original options |
2072
|
|
|
|
|
|
|
|
2073
|
506
|
|
|
|
|
2680
|
return $info; # return requested information |
2074
|
|
|
|
|
|
|
} |
2075
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2077
|
|
|
|
|
|
|
# Get/set ExifTool options |
2078
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, |
2079
|
|
|
|
|
|
|
# 1) Parameter name (case insensitive), 2) Value to set the option |
2080
|
|
|
|
|
|
|
# 3-N) More parameter/value pairs |
2081
|
|
|
|
|
|
|
# Returns: original value of last option specified |
2082
|
|
|
|
|
|
|
sub Options($$;@) |
2083
|
|
|
|
|
|
|
{ |
2084
|
17747
|
|
|
17747
|
1
|
46998
|
local $_; |
2085
|
17747
|
|
|
|
|
22124
|
my $self = shift; |
2086
|
17747
|
|
|
|
|
23853
|
my $options = $$self{OPTIONS}; |
2087
|
17747
|
|
|
|
|
20407
|
my $oldVal; |
2088
|
|
|
|
|
|
|
|
2089
|
17747
|
|
|
|
|
32851
|
while (@_) { |
2090
|
20395
|
|
|
|
|
27103
|
my $param = shift; |
2091
|
|
|
|
|
|
|
# fix parameter case if necessary |
2092
|
20395
|
100
|
|
|
|
38430
|
unless (exists $$options{$param}) { |
2093
|
372
|
|
|
|
|
18328
|
my ($fixed) = grep /^$param$/i, keys %$options; |
2094
|
372
|
50
|
|
|
|
1959
|
if ($fixed) { |
2095
|
0
|
|
|
|
|
0
|
$param = $fixed; |
2096
|
|
|
|
|
|
|
} else { |
2097
|
372
|
|
|
|
|
1306
|
$param =~ s/^Group(\d*)$/Group$1/i; |
2098
|
|
|
|
|
|
|
} |
2099
|
|
|
|
|
|
|
} |
2100
|
20395
|
|
|
|
|
27695
|
$oldVal = $$options{$param}; |
2101
|
20395
|
50
|
33
|
|
|
35822
|
if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) { |
|
|
|
66
|
|
|
|
|
2102
|
|
|
|
|
|
|
# get previous Compact/XMPShorthand setting |
2103
|
0
|
|
|
|
|
0
|
$oldVal = $$oldVal{$param}; |
2104
|
|
|
|
|
|
|
} |
2105
|
20395
|
100
|
|
|
|
36204
|
last unless @_; |
2106
|
4780
|
|
|
|
|
5776
|
my $newVal = shift; |
2107
|
4780
|
100
|
66
|
|
|
30015
|
if ($param eq 'Lang') { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2108
|
|
|
|
|
|
|
# allow this to be set to undef to select the default language |
2109
|
76
|
50
|
|
|
|
282
|
$newVal = $defaultLang unless defined $newVal; |
2110
|
76
|
100
|
|
|
|
259
|
if ($newVal eq $defaultLang) { |
2111
|
58
|
|
|
|
|
139
|
$$options{$param} = $newVal; |
2112
|
58
|
|
|
|
|
154
|
delete $$self{CUR_LANG}; |
2113
|
|
|
|
|
|
|
# make sure the language is available |
2114
|
|
|
|
|
|
|
} else { |
2115
|
18
|
|
|
|
|
84
|
my %langs = map { $_ => 1 } @langs; |
|
324
|
|
|
|
|
838
|
|
2116
|
18
|
50
|
33
|
|
|
2377
|
if ($langs{$newVal} and eval "require Image::ExifTool::Lang::$newVal") { |
2117
|
18
|
|
|
|
|
172
|
my $xlat = "Image::ExifTool::Lang::${newVal}::Translate"; |
2118
|
104
|
|
|
104
|
|
1079
|
no strict 'refs'; |
|
104
|
|
|
|
|
232
|
|
|
104
|
|
|
|
|
333944
|
|
2119
|
18
|
50
|
|
|
|
217
|
if (%$xlat) { |
2120
|
18
|
|
|
|
|
141
|
$$self{CUR_LANG} = \%$xlat; |
2121
|
18
|
|
|
|
|
392
|
$$options{$param} = $newVal; |
2122
|
|
|
|
|
|
|
} |
2123
|
|
|
|
|
|
|
} |
2124
|
|
|
|
|
|
|
} # else don't change Lang |
2125
|
|
|
|
|
|
|
} elsif ($param eq 'Exclude' and defined $newVal) { |
2126
|
|
|
|
|
|
|
# clone Exclude list and expand shortcuts |
2127
|
7
|
|
|
|
|
24
|
my @exclude; |
2128
|
7
|
100
|
|
|
|
33
|
if (ref $newVal eq 'ARRAY') { |
2129
|
6
|
|
|
|
|
21
|
@exclude = @$newVal; |
2130
|
|
|
|
|
|
|
} else { |
2131
|
1
|
|
|
|
|
3
|
@exclude = ($newVal); |
2132
|
|
|
|
|
|
|
} |
2133
|
7
|
|
|
|
|
29
|
ExpandShortcuts(\@exclude, 1); # (also remove '#' suffix) |
2134
|
7
|
|
|
|
|
30
|
$$options{$param} = \@exclude; |
2135
|
|
|
|
|
|
|
} elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') { |
2136
|
|
|
|
|
|
|
# only allow valid character sets to be set |
2137
|
358
|
100
|
66
|
|
|
1137
|
if ($newVal) { |
|
|
50
|
33
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2138
|
241
|
|
|
|
|
539
|
my $charset = $charsetName{lc $newVal}; |
2139
|
241
|
50
|
|
|
|
430
|
if ($charset) { |
2140
|
241
|
|
|
|
|
406
|
$$options{$param} = $charset; |
2141
|
|
|
|
|
|
|
# maintain backward-compatibility with old IPTCCharset option |
2142
|
241
|
100
|
|
|
|
762
|
$$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset'; |
2143
|
|
|
|
|
|
|
} else { |
2144
|
0
|
|
|
|
|
0
|
warn "Invalid Charset $newVal\n"; |
2145
|
|
|
|
|
|
|
} |
2146
|
|
|
|
|
|
|
} elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') { |
2147
|
117
|
|
|
|
|
304
|
$$options{$param} = $newVal; # only these may be set to a false value |
2148
|
|
|
|
|
|
|
} elsif ($param eq 'CharsetQuickTime') { |
2149
|
0
|
|
|
|
|
0
|
$$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman |
2150
|
|
|
|
|
|
|
} else { |
2151
|
0
|
|
|
|
|
0
|
$$options{$param} = 'Latin'; # all others default to Latin |
2152
|
|
|
|
|
|
|
} |
2153
|
|
|
|
|
|
|
} elsif ($param eq 'UserParam') { |
2154
|
|
|
|
|
|
|
# clear options if $newVal is undef |
2155
|
58
|
50
|
|
|
|
208
|
defined $newVal or $$options{$param} = {}, next; |
2156
|
58
|
|
|
|
|
187
|
my $table = GetTagTable('Image::ExifTool::UserParam'); |
2157
|
|
|
|
|
|
|
# allow initialization of entire UserParam hash |
2158
|
58
|
50
|
|
|
|
257
|
if (ref $newVal eq 'HASH') { |
2159
|
58
|
|
|
|
|
119
|
my %newParams; |
2160
|
58
|
|
|
|
|
284
|
foreach (sort keys %$newVal) { |
2161
|
0
|
|
|
|
|
0
|
my $lcTag = lc $_; |
2162
|
0
|
|
|
|
|
0
|
$newParams{$lcTag} = $$newVal{$_}; |
2163
|
0
|
|
|
|
|
0
|
delete $$table{$lcTag}; |
2164
|
0
|
|
|
|
|
0
|
AddTagToTable($table, $lcTag, $_); |
2165
|
|
|
|
|
|
|
} |
2166
|
58
|
|
|
|
|
156
|
$$options{$param} = \%newParams; |
2167
|
58
|
|
|
|
|
183
|
next; |
2168
|
|
|
|
|
|
|
} |
2169
|
0
|
|
|
|
|
0
|
my ($force, $paramName); |
2170
|
|
|
|
|
|
|
# set/reset single UserParam parameter |
2171
|
0
|
0
|
|
|
|
0
|
if ($newVal =~ /(.*?)=(.*)/s) { |
2172
|
0
|
|
|
|
|
0
|
$paramName = $1; |
2173
|
0
|
|
|
|
|
0
|
$newVal = $2; |
2174
|
0
|
0
|
|
|
|
0
|
$force = 1 if $paramName =~ s/\^$//; |
2175
|
0
|
|
|
|
|
0
|
$paramName =~ tr/-_a-zA-Z0-9#//dc; |
2176
|
0
|
|
|
|
|
0
|
$param = lc $paramName; |
2177
|
|
|
|
|
|
|
} else { |
2178
|
0
|
|
|
|
|
0
|
($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc; |
2179
|
0
|
|
|
|
|
0
|
undef $newVal; |
2180
|
|
|
|
|
|
|
} |
2181
|
0
|
|
|
|
|
0
|
delete $$table{$param}; |
2182
|
0
|
|
|
|
|
0
|
$oldVal = $$options{UserParam}{$param}; |
2183
|
0
|
0
|
|
|
|
0
|
if (defined $newVal) { |
2184
|
0
|
0
|
0
|
|
|
0
|
if (length $newVal or $force) { |
2185
|
0
|
|
|
|
|
0
|
$$options{UserParam}{$param} = $newVal; |
2186
|
0
|
|
|
|
|
0
|
AddTagToTable($table, $param, $paramName); |
2187
|
|
|
|
|
|
|
} else { |
2188
|
0
|
|
|
|
|
0
|
delete $$options{UserParam}{$param}; |
2189
|
|
|
|
|
|
|
} |
2190
|
|
|
|
|
|
|
} |
2191
|
|
|
|
|
|
|
# remove alternate version of tag |
2192
|
0
|
0
|
|
|
|
0
|
$param .= '#' unless $param =~ s/#$//; |
2193
|
0
|
|
|
|
|
0
|
delete $$table{$param}; |
2194
|
0
|
|
|
|
|
0
|
delete $$options{UserParam}{$param}; |
2195
|
|
|
|
|
|
|
} elsif ($param eq 'RequestTags') { |
2196
|
100
|
100
|
|
|
|
305
|
if (defined $newVal) { |
2197
|
|
|
|
|
|
|
# parse list from delimited string if necessary |
2198
|
42
|
50
|
|
|
|
234
|
my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); |
2199
|
42
|
|
|
|
|
164
|
ExpandShortcuts(\@reqList); |
2200
|
|
|
|
|
|
|
# add to existing list |
2201
|
42
|
50
|
|
|
|
214
|
$$options{$param} or $$options{$param} = [ ]; |
2202
|
42
|
|
|
|
|
137
|
foreach (@reqList) { |
2203
|
56
|
50
|
|
|
|
336
|
/^(.*:)?([-\w?*]*)#?$/ or next; |
2204
|
56
|
50
|
|
|
|
413
|
push @{$$options{$param}}, lc($2) if $2; |
|
56
|
|
|
|
|
205
|
|
2205
|
56
|
50
|
|
|
|
260
|
next unless $1; |
2206
|
|
|
|
|
|
|
# add requested groups with trailing colon |
2207
|
0
|
|
|
|
|
0
|
push @{$$options{$param}}, lc($_).':' foreach split /:/, $1; |
|
0
|
|
|
|
|
0
|
|
2208
|
|
|
|
|
|
|
} |
2209
|
|
|
|
|
|
|
} else { |
2210
|
58
|
|
|
|
|
164
|
$$options{$param} = undef; # clear the list |
2211
|
|
|
|
|
|
|
} |
2212
|
|
|
|
|
|
|
} elsif ($param eq 'ListJoin') { |
2213
|
10
|
|
|
|
|
30
|
$$options{$param} = $newVal; |
2214
|
|
|
|
|
|
|
# set the old List and ListSep options for backward compatibility |
2215
|
10
|
100
|
|
|
|
31
|
if (defined $newVal) { |
2216
|
4
|
|
|
|
|
13
|
$$options{List} = 0; |
2217
|
4
|
|
|
|
|
13
|
$$options{ListSep} = $newVal; |
2218
|
|
|
|
|
|
|
} else { |
2219
|
6
|
|
|
|
|
20
|
$$options{List} = 1; |
2220
|
|
|
|
|
|
|
# (ListSep must be defined) |
2221
|
|
|
|
|
|
|
} |
2222
|
|
|
|
|
|
|
} elsif ($param eq 'List') { |
2223
|
77
|
|
|
|
|
183
|
$$options{$param} = $newVal; |
2224
|
|
|
|
|
|
|
# set the new ListJoin option for forward compatibility |
2225
|
77
|
50
|
|
|
|
322
|
$$options{ListJoin} = $newVal ? undef : $$options{ListSep}; |
2226
|
|
|
|
|
|
|
} elsif ($param eq 'Compact' or $param eq 'XMPShorthand') { |
2227
|
|
|
|
|
|
|
# set Compact and XMPShorthand options, preserving backward compatibility |
2228
|
1
|
|
|
|
|
3
|
my ($p, %compact); |
2229
|
1
|
|
|
|
|
4
|
foreach $p ('Compact','XMPShorthand') { |
2230
|
2
|
100
|
|
|
|
7
|
my $val = $param eq $p ? $newVal : $$options{Compact}{$p}; |
2231
|
2
|
100
|
|
|
|
5
|
if (defined $val) { |
2232
|
1
|
|
|
|
|
7
|
my @v = ($val =~ /\w+/g); |
2233
|
1
|
50
|
|
|
|
4
|
my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt; |
2234
|
1
|
|
|
|
|
3
|
foreach (@v) { |
2235
|
1
|
50
|
|
|
|
6
|
my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal; |
2236
|
1
|
50
|
|
|
|
6
|
ref $set or $compact{$set} = 1, next; |
2237
|
0
|
|
|
|
|
0
|
$compact{$_} = 1 foreach @$set; |
2238
|
|
|
|
|
|
|
} |
2239
|
|
|
|
|
|
|
} |
2240
|
2
|
|
|
|
|
6
|
$compact{$p} = $val; # preserve most recent setting |
2241
|
|
|
|
|
|
|
} |
2242
|
1
|
|
|
|
|
5
|
$$options{Compact} = $$options{XMPShorthand} = \%compact; |
2243
|
|
|
|
|
|
|
} else { |
2244
|
4093
|
100
|
66
|
|
|
13326
|
if ($param eq 'Escape') { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2245
|
|
|
|
|
|
|
# set ESCAPE_PROC |
2246
|
64
|
50
|
66
|
|
|
507
|
if (defined $newVal and $newVal eq 'XML') { |
|
|
100
|
66
|
|
|
|
|
2247
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
2248
|
0
|
|
|
|
|
0
|
$$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML; |
2249
|
|
|
|
|
|
|
} elsif (defined $newVal and $newVal eq 'HTML') { |
2250
|
5
|
|
|
|
|
1237
|
require Image::ExifTool::HTML; |
2251
|
5
|
|
|
|
|
20
|
$$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML; |
2252
|
|
|
|
|
|
|
} else { |
2253
|
59
|
|
|
|
|
143
|
delete $$self{ESCAPE_PROC}; |
2254
|
|
|
|
|
|
|
} |
2255
|
|
|
|
|
|
|
# must forget saved values since they depend on Escape method |
2256
|
64
|
|
|
|
|
304
|
$$self{BOTH} = { }; |
2257
|
|
|
|
|
|
|
} elsif ($param eq 'GlobalTimeShift') { |
2258
|
59
|
|
|
|
|
150
|
delete $$self{GLOBAL_TIME_OFFSET}; # reset our calculated offset |
2259
|
|
|
|
|
|
|
} elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) { |
2260
|
0
|
|
|
|
|
0
|
$ENV{TZ} = $newVal; |
2261
|
0
|
|
|
|
|
0
|
eval { require POSIX; POSIX::tzset() }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2262
|
|
|
|
|
|
|
} elsif ($param eq 'Validate') { |
2263
|
|
|
|
|
|
|
# load Validate module if Validate option enabled |
2264
|
59
|
100
|
|
|
|
906
|
$newVal and require Image::ExifTool::Validate; |
2265
|
|
|
|
|
|
|
} |
2266
|
4093
|
|
|
|
|
8624
|
$$options{$param} = $newVal; |
2267
|
|
|
|
|
|
|
} |
2268
|
|
|
|
|
|
|
} |
2269
|
17747
|
|
|
|
|
43670
|
return $oldVal; |
2270
|
|
|
|
|
|
|
} |
2271
|
|
|
|
|
|
|
|
2272
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2273
|
|
|
|
|
|
|
# ClearOptions - set options to default values |
2274
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2275
|
|
|
|
|
|
|
sub ClearOptions($) |
2276
|
|
|
|
|
|
|
{ |
2277
|
471
|
|
|
471
|
1
|
955
|
local $_; |
2278
|
471
|
|
|
|
|
827
|
my $self = shift; |
2279
|
|
|
|
|
|
|
|
2280
|
|
|
|
|
|
|
# create options hash with default values |
2281
|
|
|
|
|
|
|
# +-----------------------------------------------------+ |
2282
|
|
|
|
|
|
|
# ! DON'T FORGET!! When adding any new option, must ! |
2283
|
|
|
|
|
|
|
# ! decide how it is handled in SetNewValuesFromFile() ! |
2284
|
|
|
|
|
|
|
# +-----------------------------------------------------+ |
2285
|
|
|
|
|
|
|
# (Note: All options must exist in this lookup, even if undefined, |
2286
|
|
|
|
|
|
|
# to facilitate case-insensitive options. 'Group#' is handled specially) |
2287
|
|
|
|
|
|
|
$$self{OPTIONS} = { |
2288
|
471
|
|
|
|
|
32176
|
Binary => undef, # flag to extract binary values even if tag not specified |
2289
|
|
|
|
|
|
|
ByteOrder => undef, # default byte order when creating EXIF information |
2290
|
|
|
|
|
|
|
Charset => 'UTF8', # character set for converting Unicode characters |
2291
|
|
|
|
|
|
|
CharsetEXIF => undef, # internal EXIF "ASCII" string encoding |
2292
|
|
|
|
|
|
|
CharsetFileName => undef, # external encoding for file names |
2293
|
|
|
|
|
|
|
CharsetID3 => 'Latin', # internal ID3v1 character set |
2294
|
|
|
|
|
|
|
CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet |
2295
|
|
|
|
|
|
|
CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names |
2296
|
|
|
|
|
|
|
CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding |
2297
|
|
|
|
|
|
|
CharsetRIFF => 0, # internal RIFF string encoding (0=default to Latin) |
2298
|
|
|
|
|
|
|
Compact => { }, # write compact XMP |
2299
|
|
|
|
|
|
|
Composite => 1, # flag to calculate Composite tags |
2300
|
|
|
|
|
|
|
Compress => undef, # flag to write new values as compressed if possible |
2301
|
|
|
|
|
|
|
CoordFormat => undef, # GPS lat/long coordinate format |
2302
|
|
|
|
|
|
|
DateFormat => undef, # format for date/time |
2303
|
|
|
|
|
|
|
Duplicates => 1, # flag to save duplicate tag values |
2304
|
|
|
|
|
|
|
Escape => undef, # escape special characters |
2305
|
|
|
|
|
|
|
Exclude => undef, # tags to exclude |
2306
|
|
|
|
|
|
|
ExtendedXMP => 1, # strategy for reading extended XMP |
2307
|
|
|
|
|
|
|
ExtractEmbedded =>undef,# flag to extract information from embedded documents |
2308
|
|
|
|
|
|
|
FastScan => undef, # flag to avoid scanning for trailer |
2309
|
|
|
|
|
|
|
Filter => undef, # output filter for all tag values |
2310
|
|
|
|
|
|
|
FilterW => undef, # input filter when writing tag values |
2311
|
|
|
|
|
|
|
FixBase => undef, # fix maker notes base offsets |
2312
|
|
|
|
|
|
|
GeoMaxIntSecs => 1800, # geotag maximum interpolation time (secs) |
2313
|
|
|
|
|
|
|
GeoMaxExtSecs => 1800, # geotag maximum extrapolation time (secs) |
2314
|
|
|
|
|
|
|
GeoMaxHDOP => undef, # geotag maximum HDOP |
2315
|
|
|
|
|
|
|
GeoMaxPDOP => undef, # geotag maximum PDOP |
2316
|
|
|
|
|
|
|
GeoMinSats => undef, # geotag minimum satellites |
2317
|
|
|
|
|
|
|
GeoSpeedRef => undef, # geotag GPSSpeedRef |
2318
|
|
|
|
|
|
|
GlobalTimeShift => undef, # apply time shift to all extracted date/time values |
2319
|
|
|
|
|
|
|
# Group# => undef, # return tags for specified groups in family # |
2320
|
|
|
|
|
|
|
HexTagIDs => 0, # use hex tag ID's in family 7 group names |
2321
|
|
|
|
|
|
|
HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit) |
2322
|
|
|
|
|
|
|
HtmlDumpBase => undef, # base address for HTML dump |
2323
|
|
|
|
|
|
|
IgnoreMinorErrors => undef, # ignore minor errors when reading/writing |
2324
|
|
|
|
|
|
|
Lang => $defaultLang,# localized language for descriptions etc |
2325
|
|
|
|
|
|
|
LargeFileSupport => undef, # flag indicating support of 64-bit file offsets |
2326
|
|
|
|
|
|
|
List => undef, # extract lists of PrintConv values into arrays [no longer documented] |
2327
|
|
|
|
|
|
|
ListItem => undef, # used to return a specific item from lists |
2328
|
|
|
|
|
|
|
ListJoin => ', ', # join lists together with this separator |
2329
|
|
|
|
|
|
|
ListSep => ', ', # list item separator [no longer documented] |
2330
|
|
|
|
|
|
|
ListSplit => undef, # regex for splitting list-type tag values when writing |
2331
|
|
|
|
|
|
|
MakerNotes => undef, # extract maker notes as a block |
2332
|
|
|
|
|
|
|
MDItemTags => undef, # extract MacOS metadata item tags |
2333
|
|
|
|
|
|
|
MissingTagValue =>undef,# value for missing tags when expanded in expressions |
2334
|
|
|
|
|
|
|
NoMultiExif => undef, # raise error when writing multi-segment EXIF |
2335
|
|
|
|
|
|
|
NoPDFList => undef, # flag to avoid splitting PDF List-type tag values |
2336
|
|
|
|
|
|
|
Password => undef, # password for password-protected PDF documents |
2337
|
|
|
|
|
|
|
PrintConv => 1, # flag to enable print conversion |
2338
|
|
|
|
|
|
|
QuickTimeHandler => 1, # flag to add mdir Handler to newly created Meta box |
2339
|
|
|
|
|
|
|
QuickTimePad=> undef, # flag to preserve padding of QuickTime CR3 tags |
2340
|
|
|
|
|
|
|
QuickTimeUTC=> undef, # assume that QuickTime date/time tags are stored as UTC |
2341
|
|
|
|
|
|
|
RequestAll => undef, # extract all tags that must be specifically requested |
2342
|
|
|
|
|
|
|
RequestTags => undef, # extra tags to request (on top of those in the tag list) |
2343
|
|
|
|
|
|
|
SaveFormat => undef, # save family 6 tag TIFF format |
2344
|
|
|
|
|
|
|
SavePath => undef, # save family 5 location path |
2345
|
|
|
|
|
|
|
ScanForXMP => undef, # flag to scan for XMP information in all files |
2346
|
|
|
|
|
|
|
Sort => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#) |
2347
|
|
|
|
|
|
|
Sort2 => 'File', # secondary sort order for tags in a group (File, Tag, Descr) |
2348
|
|
|
|
|
|
|
StrictDate => undef, # flag to return undef for invalid date conversions |
2349
|
|
|
|
|
|
|
Struct => undef, # return structures as hash references |
2350
|
|
|
|
|
|
|
SystemTags => undef, # extract additional File System tags |
2351
|
|
|
|
|
|
|
TextOut => \*STDOUT,# file for Verbose/HtmlDump output |
2352
|
|
|
|
|
|
|
TimeZone => undef, # local time zone |
2353
|
|
|
|
|
|
|
Unknown => 0, # flag to get values of unknown tags (0-2) |
2354
|
|
|
|
|
|
|
UserParam => { }, # user parameters for additional user-defined tag values |
2355
|
|
|
|
|
|
|
Validate => undef, # perform additional validation |
2356
|
|
|
|
|
|
|
Verbose => 0, # print verbose messages (0-5, higher # = more verbose) |
2357
|
|
|
|
|
|
|
WriteMode => 'wcg', # enable all write modes by default |
2358
|
|
|
|
|
|
|
XAttrTags => undef, # extract MacOS extended attribute tags |
2359
|
|
|
|
|
|
|
XMPAutoConv => 1, # automatic conversion of unknown XMP tag values |
2360
|
|
|
|
|
|
|
XMPShorthand=> 0, # (unused, but needed for backward compatibility) |
2361
|
|
|
|
|
|
|
}; |
2362
|
|
|
|
|
|
|
# keep necessary member variables in sync with options |
2363
|
471
|
|
|
|
|
1339
|
delete $$self{CUR_LANG}; |
2364
|
471
|
|
|
|
|
897
|
delete $$self{ESCAPE_PROC}; |
2365
|
|
|
|
|
|
|
|
2366
|
|
|
|
|
|
|
# load user-defined default options |
2367
|
471
|
50
|
|
|
|
1752
|
if (%Image::ExifTool::UserDefined::Options) { |
2368
|
0
|
|
|
|
|
0
|
foreach (keys %Image::ExifTool::UserDefined::Options) { |
2369
|
0
|
|
|
|
|
0
|
$self->Options($_, $Image::ExifTool::UserDefined::Options{$_}); |
2370
|
|
|
|
|
|
|
} |
2371
|
|
|
|
|
|
|
} |
2372
|
|
|
|
|
|
|
} |
2373
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2375
|
|
|
|
|
|
|
# Extract meta information from image |
2376
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2377
|
|
|
|
|
|
|
# 1-N) Same as ImageInfo() |
2378
|
|
|
|
|
|
|
# Returns: 1 if this was a valid image, 0 otherwise |
2379
|
|
|
|
|
|
|
# Notes: pass an undefined value to avoid parsing arguments |
2380
|
|
|
|
|
|
|
# Internal 'ReEntry' option allows this routine to be called recursively |
2381
|
|
|
|
|
|
|
sub ExtractInfo($;@) |
2382
|
|
|
|
|
|
|
{ |
2383
|
513
|
|
|
513
|
1
|
1027
|
local $_; |
2384
|
513
|
|
|
|
|
964
|
my $self = shift; |
2385
|
513
|
|
|
|
|
1094
|
my $options = $$self{OPTIONS}; # pointer to current options |
2386
|
513
|
|
100
|
|
|
2281
|
my $fast = $$options{FastScan} || 0; |
2387
|
513
|
|
|
|
|
1061
|
my $req = $$self{REQ_TAG_LOOKUP}; |
2388
|
513
|
|
100
|
|
|
1950
|
my $reqAll = $$options{RequestAll} || 0; |
2389
|
513
|
|
|
|
|
1134
|
my (%saveOptions, $reEntry, $rsize, $zid, $type, @startTime, $saveOrder, $isDir); |
2390
|
|
|
|
|
|
|
|
2391
|
|
|
|
|
|
|
# check for internal ReEntry option to allow recursive calls to ExtractInfo |
2392
|
513
|
100
|
100
|
|
|
2282
|
if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2393
|
|
|
|
|
|
|
(ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB')) |
2394
|
|
|
|
|
|
|
{ |
2395
|
|
|
|
|
|
|
# save necessary members for restoring later |
2396
|
|
|
|
|
|
|
$reEntry = { |
2397
|
|
|
|
|
|
|
RAF => $$self{RAF}, |
2398
|
|
|
|
|
|
|
PROCESSED => $$self{PROCESSED}, |
2399
|
|
|
|
|
|
|
EXIF_DATA => $$self{EXIF_DATA}, |
2400
|
|
|
|
|
|
|
EXIF_POS => $$self{EXIF_POS}, |
2401
|
|
|
|
|
|
|
FILE_TYPE => $$self{FILE_TYPE}, |
2402
|
2
|
|
|
|
|
17
|
}; |
2403
|
|
|
|
|
|
|
$saveOrder = GetByteOrder(), |
2404
|
2
|
|
|
|
|
7
|
$$self{RAF} = new File::RandomAccess($_[0]); |
2405
|
2
|
|
|
|
|
6
|
$$self{PROCESSED} = { }; |
2406
|
2
|
|
|
|
|
4
|
delete $$self{EXIF_DATA}; |
2407
|
2
|
|
|
|
|
4
|
delete $$self{EXIF_POS}; |
2408
|
|
|
|
|
|
|
} else { |
2409
|
511
|
100
|
66
|
|
|
4204
|
if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) { |
|
|
|
66
|
|
|
|
|
2410
|
6
|
|
|
|
|
157
|
%saveOptions = %$options; # save original options |
2411
|
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
|
# require duplicates for html dump |
2413
|
6
|
50
|
|
|
|
33
|
$self->Options(Duplicates => 1) if $$options{HtmlDump}; |
2414
|
|
|
|
|
|
|
# enable Validate option if Validate tag is requested |
2415
|
6
|
100
|
|
|
|
22
|
$self->Options(Validate => 1) if $$req{validate}; |
2416
|
|
|
|
|
|
|
|
2417
|
6
|
100
|
|
|
|
17
|
if (defined $_[0]) { |
2418
|
|
|
|
|
|
|
# only initialize filename if called with arguments |
2419
|
5
|
|
|
|
|
12
|
$$self{FILENAME} = undef; # name of file (or '' if we didn't open it) |
2420
|
5
|
|
|
|
|
10
|
$$self{RAF} = undef; # RandomAccess object reference |
2421
|
|
|
|
|
|
|
|
2422
|
5
|
|
|
|
|
19
|
$self->ParseArguments(@_); # initialize from our arguments |
2423
|
|
|
|
|
|
|
} |
2424
|
|
|
|
|
|
|
} |
2425
|
|
|
|
|
|
|
# initialize ExifTool object members |
2426
|
511
|
|
|
|
|
1954
|
$self->Init(); |
2427
|
|
|
|
|
|
|
|
2428
|
511
|
|
|
|
|
1121
|
delete $$self{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes |
2429
|
511
|
|
|
|
|
873
|
delete $$self{MAKER_NOTE_BYTE_ORDER}; |
2430
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
# return our version number |
2432
|
511
|
|
|
|
|
2735
|
$self->FoundTag('ExifToolVersion', "$VERSION$RELEASE"); |
2433
|
511
|
100
|
66
|
|
|
3151
|
$self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll; |
2434
|
511
|
100
|
66
|
|
|
2873
|
$self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll; |
2435
|
|
|
|
|
|
|
# generate sequence number if necessary |
2436
|
511
|
100
|
66
|
|
|
2581
|
$self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll; |
2437
|
|
|
|
|
|
|
|
2438
|
511
|
100
|
66
|
|
|
2498
|
if ($$req{processingtime} or $reqAll) { |
2439
|
58
|
|
|
|
|
143
|
eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() }; |
|
58
|
|
|
|
|
7901
|
|
|
58
|
|
|
|
|
19213
|
|
2440
|
58
|
0
|
33
|
|
|
233
|
if (not @startTime and $$req{processingtime}) { |
2441
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Time::HiRes to generate ProcessingTime'); |
2442
|
|
|
|
|
|
|
} |
2443
|
|
|
|
|
|
|
} |
2444
|
|
|
|
|
|
|
|
2445
|
511
|
|
|
|
|
1061
|
++$$self{FILE_SEQUENCE}; # count files read |
2446
|
|
|
|
|
|
|
} |
2447
|
|
|
|
|
|
|
|
2448
|
513
|
|
|
|
|
1203
|
my $filename = $$self{FILENAME}; # image file name ('' if already open) |
2449
|
513
|
|
|
|
|
1023
|
my $raf = $$self{RAF}; # RandomAccess object |
2450
|
|
|
|
|
|
|
|
2451
|
513
|
|
|
|
|
1541
|
local *EXIFTOOL_FILE; # avoid clashes with global namespace |
2452
|
|
|
|
|
|
|
|
2453
|
513
|
|
|
|
|
1029
|
my $realname = $filename; |
2454
|
513
|
100
|
|
|
|
1359
|
unless ($raf) { |
2455
|
|
|
|
|
|
|
# save file name |
2456
|
469
|
50
|
33
|
|
|
2313
|
if (defined $filename and $filename ne '') { |
2457
|
469
|
50
|
|
|
|
1496
|
unless ($filename eq '-') { |
2458
|
|
|
|
|
|
|
# extract file name from pipe if necessary |
2459
|
469
|
50
|
|
|
|
1783
|
$realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s; |
2460
|
469
|
|
|
|
|
1747
|
my ($dir, $name) = SplitFileName($realname); |
2461
|
469
|
|
|
|
|
1756
|
$self->FoundTag('FileName', $name); |
2462
|
469
|
100
|
66
|
|
|
3157
|
if ($$req{basename} or |
|
|
|
66
|
|
|
|
|
2463
|
|
|
|
|
|
|
($reqAll and not $$self{EXCL_TAG_LOOKUP}{basename})) |
2464
|
|
|
|
|
|
|
{ |
2465
|
58
|
50
|
|
|
|
480
|
$self->FoundTag('BaseName', $name =~ /(.*)\./ ? $1 : $name); |
2466
|
|
|
|
|
|
|
} |
2467
|
469
|
50
|
33
|
|
|
3261
|
$self->FoundTag('Directory', $dir) if defined $dir and length $dir; |
2468
|
469
|
100
|
66
|
|
|
3625
|
if ($$req{filepath} or |
|
|
|
66
|
|
|
|
|
2469
|
|
|
|
|
|
|
($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath})) |
2470
|
|
|
|
|
|
|
{ |
2471
|
58
|
|
|
|
|
286
|
local $SIG{'__WARN__'} = \&SetWarning; |
2472
|
58
|
50
|
|
|
|
141
|
if (eval { require Cwd }) { |
|
58
|
0
|
|
|
|
397
|
|
2473
|
58
|
|
|
|
|
134
|
my $path = eval { Cwd::abs_path($filename) }; |
|
58
|
|
|
|
|
2360
|
|
2474
|
58
|
50
|
|
|
|
384
|
$self->FoundTag('FilePath', $path) if defined $path; |
2475
|
|
|
|
|
|
|
} elsif ($$req{filepath}) { |
2476
|
0
|
|
|
|
|
0
|
$self->WarnOnce('The Perl Cwd module must be installed to use FilePath'); |
2477
|
|
|
|
|
|
|
} |
2478
|
|
|
|
|
|
|
} |
2479
|
|
|
|
|
|
|
# get size of resource fork on Mac OS |
2480
|
469
|
50
|
33
|
|
|
2565
|
$rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE}; |
2481
|
|
|
|
|
|
|
# check to see if Zone.Identifier file exists in Windows |
2482
|
469
|
50
|
33
|
|
|
1883
|
if ($^O eq 'MSWin32' and eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
2483
|
0
|
|
|
|
|
0
|
my $wattr; |
2484
|
0
|
|
|
|
|
0
|
my $zfile = "${filename}:Zone.Identifier"; |
2485
|
0
|
0
|
|
|
|
0
|
if ($self->EncodeFileName($zfile)) { |
2486
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributesW($zfile) }; |
|
0
|
|
|
|
|
0
|
|
2487
|
|
|
|
|
|
|
} else { |
2488
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributes($zfile) }; |
|
0
|
|
|
|
|
0
|
|
2489
|
|
|
|
|
|
|
} |
2490
|
0
|
0
|
|
|
|
0
|
$zid = 1 unless $wattr == Win32API::File::INVALID_FILE_ATTRIBUTES(); |
2491
|
|
|
|
|
|
|
} |
2492
|
|
|
|
|
|
|
} |
2493
|
|
|
|
|
|
|
# open the file |
2494
|
469
|
50
|
|
|
|
2280
|
if ($self->Open(\*EXIFTOOL_FILE, $filename)) { |
|
|
0
|
|
|
|
|
|
2495
|
|
|
|
|
|
|
# create random access file object |
2496
|
469
|
|
|
|
|
4726
|
$raf = new File::RandomAccess(\*EXIFTOOL_FILE); |
2497
|
|
|
|
|
|
|
# patch to force pipe to be buffered because seek returns success |
2498
|
|
|
|
|
|
|
# in Windows cmd shell pipe even though it really failed |
2499
|
469
|
50
|
33
|
|
|
3262
|
$$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/; |
2500
|
469
|
|
|
|
|
1360
|
$$self{RAF} = $raf; |
2501
|
|
|
|
|
|
|
} elsif ($self->IsDirectory($filename)) { |
2502
|
0
|
|
|
|
|
0
|
$isDir = 1; |
2503
|
|
|
|
|
|
|
} else { |
2504
|
0
|
|
|
|
|
0
|
$self->Error('Error opening file'); |
2505
|
|
|
|
|
|
|
} |
2506
|
|
|
|
|
|
|
} else { |
2507
|
0
|
|
|
|
|
0
|
$self->Error('No file specified'); |
2508
|
|
|
|
|
|
|
} |
2509
|
|
|
|
|
|
|
} |
2510
|
|
|
|
|
|
|
|
2511
|
513
|
|
33
|
|
|
1896
|
while ($raf or $isDir) { |
2512
|
513
|
|
|
|
|
1114
|
my (@stat, $plainFile); |
2513
|
513
|
100
|
|
|
|
6970
|
if ($reEntry) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2514
|
|
|
|
|
|
|
# we already set these tags |
2515
|
|
|
|
|
|
|
} elsif (not $raf) { |
2516
|
0
|
|
|
|
|
0
|
@stat = stat $filename; |
2517
|
|
|
|
|
|
|
} elsif (not $$raf{FILE_PT}) { |
2518
|
|
|
|
|
|
|
# get file size from image in memory |
2519
|
22
|
|
|
|
|
48
|
$self->FoundTag('FileSize', length ${$$raf{BUFF_PT}}); |
|
22
|
|
|
|
|
99
|
|
2520
|
|
|
|
|
|
|
} elsif (-f $$raf{FILE_PT}) { |
2521
|
|
|
|
|
|
|
# get file tags if this is a plain file |
2522
|
489
|
|
|
|
|
2307
|
@stat = stat _; |
2523
|
489
|
|
|
|
|
1025
|
$plainFile = 1; |
2524
|
|
|
|
|
|
|
# hack to patch Windows daylight savings time bug |
2525
|
489
|
50
|
|
|
|
1936
|
@stat[8,9,10] = $self->GetFileTime($$raf{FILE_PT}) if $^O eq 'MSWin32'; |
2526
|
|
|
|
|
|
|
} else { |
2527
|
|
|
|
|
|
|
# (note that Windows directories will still show the |
2528
|
|
|
|
|
|
|
# daylight savings time bug -- should fix this sometime) |
2529
|
0
|
|
|
|
|
0
|
@stat = stat $$raf{FILE_PT}; |
2530
|
|
|
|
|
|
|
} |
2531
|
513
|
|
|
|
|
1112
|
my $fileSize = $stat[7]; |
2532
|
513
|
100
|
|
|
|
2639
|
$self->FoundTag('FileSize', $stat[7]) if defined $stat[7]; |
2533
|
513
|
50
|
|
|
|
1693
|
$self->FoundTag('ResourceForkSize', $rsize) if $rsize; |
2534
|
513
|
50
|
|
|
|
1442
|
$self->FoundTag('ZoneIdentifier', 'Exists') if $zid; |
2535
|
513
|
100
|
|
|
|
2171
|
$self->FoundTag('FileModifyDate', $stat[9]) if defined $stat[9]; |
2536
|
513
|
100
|
|
|
|
2333
|
$self->FoundTag('FileAccessDate', $stat[8]) if defined $stat[8]; |
2537
|
513
|
50
|
|
|
|
2076
|
my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate'; |
2538
|
513
|
100
|
|
|
|
2266
|
$self->FoundTag($cTag, $stat[10]) if defined $stat[10]; |
2539
|
513
|
100
|
|
|
|
2467
|
$self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2]; |
2540
|
|
|
|
|
|
|
# extract more system info if SystemTags option is set |
2541
|
513
|
100
|
|
|
|
1721
|
if (@stat) { |
2542
|
489
|
|
66
|
|
|
2790
|
my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags}); |
2543
|
489
|
100
|
66
|
|
|
2893
|
if ($sys or $$req{fileattributes}) { |
2544
|
58
|
|
|
|
|
203
|
my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00); |
2545
|
|
|
|
|
|
|
# add Windows file attributes if available |
2546
|
58
|
0
|
33
|
|
|
273
|
if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2547
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
2548
|
0
|
0
|
|
|
|
0
|
if (eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
2549
|
0
|
|
|
|
|
0
|
my $wattr; |
2550
|
0
|
|
|
|
|
0
|
my $file = $filename; |
2551
|
0
|
0
|
|
|
|
0
|
if ($self->EncodeFileName($file)) { |
2552
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributesW($file) }; |
|
0
|
|
|
|
|
0
|
|
2553
|
|
|
|
|
|
|
} else { |
2554
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributes($file) }; |
|
0
|
|
|
|
|
0
|
|
2555
|
|
|
|
|
|
|
} |
2556
|
0
|
0
|
0
|
|
|
0
|
push @attr, $wattr if defined $wattr and $wattr != 0xffffffff; |
2557
|
|
|
|
|
|
|
} |
2558
|
|
|
|
|
|
|
} |
2559
|
58
|
|
|
|
|
332
|
$self->FoundTag('FileAttributes', "@attr"); |
2560
|
|
|
|
|
|
|
} |
2561
|
489
|
100
|
66
|
|
|
2431
|
$self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber}; |
2562
|
489
|
100
|
66
|
|
|
2458
|
$self->FoundTag('FileInodeNumber', $stat[1]) if $sys or $$req{fileinodenumber}; |
2563
|
489
|
100
|
66
|
|
|
2429
|
$self->FoundTag('FileHardLinks', $stat[3]) if $sys or $$req{filehardlinks}; |
2564
|
489
|
100
|
66
|
|
|
2305
|
$self->FoundTag('FileUserID', $stat[4]) if $sys or $$req{fileuserid}; |
2565
|
489
|
100
|
66
|
|
|
2371
|
$self->FoundTag('FileGroupID', $stat[5]) if $sys or $$req{filegroupid}; |
2566
|
489
|
100
|
66
|
|
|
2279
|
$self->FoundTag('FileDeviceID', $stat[6]) if $sys or $$req{filedeviceid}; |
2567
|
489
|
100
|
66
|
|
|
2568
|
$self->FoundTag('FileBlockSize', $stat[11]) if $sys or $$req{fileblocksize}; |
2568
|
489
|
100
|
66
|
|
|
2292
|
$self->FoundTag('FileBlockCount', $stat[12]) if $sys or $$req{fileblockcount}; |
2569
|
|
|
|
|
|
|
} |
2570
|
|
|
|
|
|
|
# extract MDItem tags if requested (only on plain files) |
2571
|
513
|
0
|
33
|
|
|
2071
|
if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2572
|
0
|
|
0
|
|
|
0
|
my $reqMacOS = ($reqAll > 1 or $$req{'macos:'}); |
2573
|
0
|
|
0
|
|
|
0
|
my $crDate = ($reqMacOS || $$req{filecreatedate}); |
2574
|
0
|
|
0
|
|
|
0
|
my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req); |
2575
|
0
|
|
0
|
|
|
0
|
my $xattr = ($reqMacOS || $$options{XAttrTags} || grep /^xattr/, keys %$req); |
2576
|
0
|
0
|
0
|
|
|
0
|
if ($crDate or $mdItem or $xattr) { |
|
|
|
0
|
|
|
|
|
2577
|
0
|
|
|
|
|
0
|
require Image::ExifTool::MacOS; |
2578
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate; |
2579
|
0
|
0
|
0
|
|
|
0
|
Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem and $plainFile; |
2580
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr; |
2581
|
|
|
|
|
|
|
} |
2582
|
|
|
|
|
|
|
} |
2583
|
|
|
|
|
|
|
# do whatever else we can with directories, then return |
2584
|
513
|
50
|
66
|
|
|
3481
|
if ($isDir or (defined $stat[2] and ($stat[2] & 0170000) == 0040000)) { |
|
|
|
33
|
|
|
|
|
2585
|
0
|
|
|
|
|
0
|
$self->FoundTag('FileType', 'DIR'); |
2586
|
0
|
|
|
|
|
0
|
$self->FoundTag('FileTypeExtension', ''); |
2587
|
0
|
0
|
|
|
|
0
|
$self->BuildCompositeTags() if $$options{Composite}; |
2588
|
0
|
0
|
|
|
|
0
|
$raf->Close() if $raf; |
2589
|
0
|
|
|
|
|
0
|
return 1; |
2590
|
|
|
|
|
|
|
} |
2591
|
|
|
|
|
|
|
# get list of file types to check |
2592
|
513
|
|
|
|
|
1112
|
my ($tiffType, %noMagic, $recognizedExt); |
2593
|
513
|
|
|
|
|
2322
|
my $ext = $$self{FILE_EXT} = GetFileExtension($realname); |
2594
|
|
|
|
|
|
|
# set $recognizedExt if this file type is recognized by extension only |
2595
|
|
|
|
|
|
|
$recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and |
2596
|
513
|
50
|
100
|
|
|
4757
|
defined $moduleName{$ext} and not $moduleName{$ext}; |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2597
|
513
|
|
|
|
|
1818
|
my @fileTypeList = GetFileType($realname); |
2598
|
513
|
50
|
|
|
|
1713
|
if ($fast >= 4) { |
2599
|
0
|
0
|
|
|
|
0
|
if (@fileTypeList) { |
2600
|
0
|
|
|
|
|
0
|
$type = shift @fileTypeList; |
2601
|
0
|
|
|
|
|
0
|
$self->SetFileType($$self{FILE_TYPE} = $type); |
2602
|
|
|
|
|
|
|
} else { |
2603
|
0
|
|
|
|
|
0
|
$self->Error('Unknown file type'); |
2604
|
|
|
|
|
|
|
} |
2605
|
0
|
0
|
0
|
|
|
0
|
$self->BuildCompositeTags() if $fast == 4 and $$options{Composite}; |
2606
|
0
|
|
|
|
|
0
|
last; # don't read the file |
2607
|
|
|
|
|
|
|
} |
2608
|
513
|
100
|
|
|
|
1437
|
if (@fileTypeList) { |
2609
|
|
|
|
|
|
|
# add remaining types to end of list so we test them all |
2610
|
466
|
|
|
|
|
1576
|
my $pat = join '|', @fileTypeList; |
2611
|
466
|
|
|
|
|
33946
|
push @fileTypeList, grep(!/^($pat)$/, @fileTypes); |
2612
|
466
|
|
|
|
|
1510
|
$tiffType = $$self{FILE_EXT}; |
2613
|
466
|
100
|
|
|
|
1586
|
unless ($fast == 3) { |
2614
|
465
|
|
|
|
|
1286
|
$noMagic{MXF} = 1; # don't do magic number test on MXF or DV files |
2615
|
465
|
|
|
|
|
1280
|
$noMagic{DV} = 1; |
2616
|
|
|
|
|
|
|
} |
2617
|
|
|
|
|
|
|
} else { |
2618
|
|
|
|
|
|
|
# scan through all recognized file types |
2619
|
47
|
|
|
|
|
668
|
@fileTypeList = @fileTypes; |
2620
|
47
|
|
|
|
|
117
|
$tiffType = 'TIFF'; |
2621
|
|
|
|
|
|
|
} |
2622
|
513
|
|
|
|
|
1206
|
push @fileTypeList, ''; # end of list marker |
2623
|
|
|
|
|
|
|
# initialize the input file for seeking in binary data |
2624
|
513
|
|
|
|
|
2549
|
$raf->BinMode(); # set binary mode before we start reading |
2625
|
513
|
|
|
|
|
1624
|
my $pos = $raf->Tell(); # get file position so we can rewind |
2626
|
|
|
|
|
|
|
# loop through list of file types to test |
2627
|
513
|
|
|
|
|
1029
|
my ($buff, $seekErr); |
2628
|
513
|
|
|
|
|
2488
|
my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff ); |
2629
|
|
|
|
|
|
|
# read start of file for testing |
2630
|
513
|
50
|
|
|
|
2110
|
$raf->Read($buff, $testLen) or $buff = ''; |
2631
|
513
|
50
|
|
|
|
2147
|
$raf->Seek($pos, 0) or $seekErr = 1; |
2632
|
513
|
|
|
|
|
1803
|
until ($seekErr) { |
2633
|
1900
|
|
|
|
|
2913
|
my $unkHeader; |
2634
|
1900
|
|
|
|
|
2841
|
$type = shift @fileTypeList; |
2635
|
1900
|
50
|
|
|
|
3232
|
if ($type) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2636
|
1900
|
100
|
|
|
|
3956
|
if ($magicNumber{$type}) { |
2637
|
|
|
|
|
|
|
# do quick test for this file type to avoid loading module unnecessarily |
2638
|
1864
|
100
|
100
|
|
|
30478
|
next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type}; |
2639
|
|
|
|
|
|
|
} else { |
2640
|
|
|
|
|
|
|
# keep checking for other types if we recognize this file only by extension |
2641
|
36
|
50
|
66
|
|
|
190
|
next if defined $moduleName{$type} and not $moduleName{$type}; |
2642
|
36
|
50
|
|
|
|
84
|
next if $fast > 2; # keep checking if we aren't processing the file |
2643
|
|
|
|
|
|
|
} |
2644
|
553
|
50
|
66
|
|
|
2526
|
next if $weakMagic{$type} and defined $recognizedExt; |
2645
|
|
|
|
|
|
|
} elsif (not defined $type) { |
2646
|
0
|
|
|
|
|
0
|
last; |
2647
|
|
|
|
|
|
|
} elsif ($recognizedExt) { |
2648
|
0
|
|
|
|
|
0
|
$type = $recognizedExt; # set type from recognized file extension only |
2649
|
|
|
|
|
|
|
} else { |
2650
|
|
|
|
|
|
|
# last ditch effort to scan past unknown header for JPEG/TIFF |
2651
|
0
|
0
|
|
|
|
0
|
next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g; |
2652
|
0
|
0
|
|
|
|
0
|
$type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF'; |
2653
|
0
|
|
|
|
|
0
|
my $skip = pos($buff) - length($1); |
2654
|
0
|
|
|
|
|
0
|
$dirInfo{Base} = $pos + $skip; |
2655
|
0
|
0
|
|
|
|
0
|
$raf->Seek($pos + $skip, 0) or $seekErr = 1, last; |
2656
|
0
|
|
|
|
|
0
|
$self->Warn("Processing $type-like data after unknown $skip-byte header"); |
2657
|
0
|
0
|
|
|
|
0
|
$unkHeader = 1 unless $$self{DOC_NUM}; |
2658
|
|
|
|
|
|
|
} |
2659
|
|
|
|
|
|
|
# save file type in member variable |
2660
|
553
|
|
|
|
|
1387
|
$$self{FILE_TYPE} = $type; |
2661
|
553
|
100
|
|
|
|
2139
|
$dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type; |
2662
|
|
|
|
|
|
|
# don't process the file when FastScan == 3 |
2663
|
553
|
50
|
66
|
|
|
2044
|
if ($fast == 3 and not $processType{$type}) { |
2664
|
0
|
0
|
0
|
|
|
0
|
unless ($weakMagic{$type} and (not $ext or $ext ne $type)) { |
|
|
|
0
|
|
|
|
|
2665
|
0
|
|
|
|
|
0
|
$self->SetFileType($dirInfo{Parent}); |
2666
|
|
|
|
|
|
|
} |
2667
|
0
|
|
|
|
|
0
|
last; |
2668
|
|
|
|
|
|
|
} |
2669
|
553
|
|
|
|
|
1149
|
my $module = $moduleName{$type}; |
2670
|
553
|
100
|
|
|
|
1484
|
$module = $type unless defined $module; |
2671
|
553
|
|
|
|
|
1337
|
my $func = "Process$type"; |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
# load module if necessary |
2674
|
553
|
100
|
|
|
|
1612
|
if ($module) { |
|
|
50
|
|
|
|
|
|
2675
|
301
|
|
|
|
|
19263
|
require "Image/ExifTool/$module.pm"; |
2676
|
301
|
|
|
|
|
1042
|
$func = "Image::ExifTool::${module}::$func"; |
2677
|
|
|
|
|
|
|
} elsif ($module eq '0') { |
2678
|
0
|
|
|
|
|
0
|
$self->SetFileType(); |
2679
|
0
|
|
|
|
|
0
|
$self->Warn('Unsupported file type'); |
2680
|
0
|
|
|
|
|
0
|
last; |
2681
|
|
|
|
|
|
|
} |
2682
|
553
|
|
|
|
|
893
|
push @{$$self{PATH}}, $type; # save file type in metadata PATH |
|
553
|
|
|
|
|
1719
|
|
2683
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
# process the file |
2685
|
104
|
|
|
104
|
|
964
|
no strict 'refs'; |
|
104
|
|
|
|
|
206
|
|
|
104
|
|
|
|
|
6421
|
|
2686
|
553
|
|
|
|
|
3752
|
my $result = &$func($self, \%dirInfo); |
2687
|
104
|
|
|
104
|
|
593
|
use strict 'refs'; |
|
104
|
|
|
|
|
187
|
|
|
104
|
|
|
|
|
1202470
|
|
2688
|
|
|
|
|
|
|
|
2689
|
553
|
|
|
|
|
1168
|
pop @{$$self{PATH}}; |
|
553
|
|
|
|
|
1599
|
|
2690
|
|
|
|
|
|
|
|
2691
|
553
|
100
|
|
|
|
1603
|
if ($result) { # all done if successful |
2692
|
513
|
50
|
|
|
|
1303
|
if ($unkHeader) { |
2693
|
0
|
|
|
|
|
0
|
$self->DeleteTag('FileType'); |
2694
|
0
|
|
|
|
|
0
|
$self->DeleteTag('FileTypeExtension'); |
2695
|
0
|
|
|
|
|
0
|
$self->DeleteTag('MIMEType'); |
2696
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"Reset file type due to unknown header\n"); |
2697
|
|
|
|
|
|
|
} |
2698
|
513
|
|
|
|
|
1111
|
last; |
2699
|
|
|
|
|
|
|
} |
2700
|
|
|
|
|
|
|
# seek back to try again from the same position in the file |
2701
|
40
|
50
|
|
|
|
110
|
$raf->Seek($pos, 0) or $seekErr = 1, last; |
2702
|
|
|
|
|
|
|
} |
2703
|
513
|
0
|
33
|
|
|
1569
|
if (not defined $type and not $$self{DOC_NUM}) { |
2704
|
|
|
|
|
|
|
# if we were given a single image with a known type there |
2705
|
|
|
|
|
|
|
# must be a format error since we couldn't read it, otherwise |
2706
|
|
|
|
|
|
|
# it is likely we don't support images of this type |
2707
|
0
|
|
0
|
|
|
0
|
my $fileType = GetFileType($realname) || ''; |
2708
|
0
|
|
|
|
|
0
|
my $err; |
2709
|
0
|
0
|
|
|
|
0
|
if (not length $buff) { |
2710
|
0
|
|
|
|
|
0
|
$err = 'File is empty'; |
2711
|
|
|
|
|
|
|
} else { |
2712
|
0
|
|
|
|
|
0
|
my $ch = substr($buff, 0, 1); |
2713
|
0
|
0
|
0
|
|
|
0
|
if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) { |
2714
|
0
|
0
|
|
|
|
0
|
if ($fileType eq 'RAW') { |
|
|
0
|
|
|
|
|
|
2715
|
0
|
|
|
|
|
0
|
$err = 'Unsupported RAW file type'; |
2716
|
|
|
|
|
|
|
} elsif ($fileType) { |
2717
|
0
|
|
|
|
|
0
|
$err = 'File format error'; |
2718
|
|
|
|
|
|
|
} else { |
2719
|
0
|
|
|
|
|
0
|
$err = 'Unknown file type'; |
2720
|
|
|
|
|
|
|
} |
2721
|
|
|
|
|
|
|
} else { |
2722
|
|
|
|
|
|
|
# provide some insight into the content of some corrupted files |
2723
|
0
|
0
|
|
|
|
0
|
if ($$self{OPTIONS}{FastScan}) { |
2724
|
0
|
|
|
|
|
0
|
$err = 'File header is all'; |
2725
|
|
|
|
|
|
|
} else { |
2726
|
0
|
|
|
|
|
0
|
my $num = 0; |
2727
|
0
|
|
|
|
|
0
|
for (;;) { |
2728
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, 65536) or undef($num), last; |
2729
|
0
|
0
|
|
|
|
0
|
$buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last; |
2730
|
0
|
|
|
|
|
0
|
$num += length($buff); |
2731
|
|
|
|
|
|
|
} |
2732
|
0
|
0
|
|
|
|
0
|
if ($num) { |
2733
|
0
|
|
|
|
|
0
|
$err = 'First ' . ConvertFileSize($num) . ' of file is'; |
2734
|
|
|
|
|
|
|
} else { |
2735
|
0
|
|
|
|
|
0
|
$err = 'Entire file is'; |
2736
|
|
|
|
|
|
|
} |
2737
|
|
|
|
|
|
|
} |
2738
|
0
|
0
|
|
|
|
0
|
if ($ch eq "\0") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2739
|
0
|
|
|
|
|
0
|
$err .= ' binary zeros'; |
2740
|
|
|
|
|
|
|
} elsif ($ch eq ' ') { |
2741
|
0
|
|
|
|
|
0
|
$err .= ' ASCII spaces'; |
2742
|
|
|
|
|
|
|
} elsif ($ch =~ /[a-zA-Z0-9]/) { |
2743
|
0
|
|
|
|
|
0
|
$err .= " ASCII '${ch}' characters"; |
2744
|
|
|
|
|
|
|
} else { |
2745
|
0
|
|
|
|
|
0
|
$err .= sprintf(" binary 0x%.2x's", ord $ch); |
2746
|
|
|
|
|
|
|
} |
2747
|
|
|
|
|
|
|
} |
2748
|
|
|
|
|
|
|
} |
2749
|
0
|
|
|
|
|
0
|
$self->Error($err); |
2750
|
|
|
|
|
|
|
} |
2751
|
513
|
50
|
0
|
|
|
2255
|
if ($seekErr) { |
|
|
50
|
33
|
|
|
|
|
2752
|
0
|
|
|
|
|
0
|
$self->Error('Error seeking in file'); |
2753
|
|
|
|
|
|
|
} elsif ($self->Options('ScanForXMP') and (not defined $type or |
2754
|
|
|
|
|
|
|
(not $fast and not $$self{FoundXMP}))) |
2755
|
|
|
|
|
|
|
{ |
2756
|
|
|
|
|
|
|
# scan for XMP |
2757
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
2758
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
2759
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = ''; |
2760
|
|
|
|
|
|
|
} |
2761
|
|
|
|
|
|
|
# extract binary EXIF data block only if requested |
2762
|
513
|
100
|
100
|
|
|
3874
|
if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
2763
|
|
|
|
|
|
|
($$req{exif} or |
2764
|
|
|
|
|
|
|
# (not extracted normally, so check TAGS_FROM_FILE) |
2765
|
|
|
|
|
|
|
($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif}))) |
2766
|
|
|
|
|
|
|
{ |
2767
|
36
|
|
|
|
|
141
|
$self->FoundTag('EXIF', $$self{EXIF_DATA}); |
2768
|
|
|
|
|
|
|
} |
2769
|
513
|
100
|
|
|
|
1443
|
unless ($reEntry) { |
2770
|
511
|
|
|
|
|
1518
|
$$self{PATH} = [ ]; # reset PATH |
2771
|
|
|
|
|
|
|
# calculate Composite tags |
2772
|
511
|
100
|
|
|
|
2981
|
$self->BuildCompositeTags() if $$options{Composite}; |
2773
|
|
|
|
|
|
|
# do our HTML dump if requested |
2774
|
511
|
50
|
|
|
|
1886
|
if ($$self{HTML_DUMP}) { |
2775
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); # seek to end of file |
2776
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell()); |
2777
|
0
|
|
|
|
|
0
|
my $pos = $$options{HtmlDumpBase}; |
2778
|
0
|
0
|
0
|
|
|
0
|
$pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos; |
2779
|
0
|
0
|
|
|
|
0
|
my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef; |
2780
|
0
|
0
|
0
|
|
|
0
|
undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS}; |
2781
|
0
|
0
|
|
|
|
0
|
undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous |
2782
|
|
|
|
|
|
|
my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos, |
2783
|
|
|
|
|
|
|
$$options{TextOut}, $$options{HtmlDump}, |
2784
|
0
|
0
|
|
|
|
0
|
$$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump'); |
2785
|
0
|
0
|
|
|
|
0
|
$self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0; |
2786
|
|
|
|
|
|
|
} |
2787
|
|
|
|
|
|
|
} |
2788
|
513
|
100
|
|
|
|
1673
|
if ($filename) { |
2789
|
471
|
|
|
|
|
2762
|
$raf->Close(); # close the file if we opened it |
2790
|
|
|
|
|
|
|
# process the resource fork as an embedded file on Mac filesystems |
2791
|
471
|
0
|
33
|
|
|
1603
|
if ($rsize and $$options{ExtractEmbedded}) { |
2792
|
0
|
|
|
|
|
0
|
local *RESOURCE_FILE; |
2793
|
0
|
0
|
|
|
|
0
|
if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) { |
2794
|
0
|
|
|
|
|
0
|
$$self{DOC_NUM} = $$self{DOC_COUNT} + 1; |
2795
|
0
|
|
|
|
|
0
|
$$self{IN_RESOURCE} = 1; |
2796
|
0
|
|
|
|
|
0
|
$self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 }); |
2797
|
0
|
|
|
|
|
0
|
close RESOURCE_FILE; |
2798
|
0
|
|
|
|
|
0
|
delete $$self{IN_RESOURCE}; |
2799
|
|
|
|
|
|
|
} else { |
2800
|
0
|
|
|
|
|
0
|
$self->Warn('Error opening resource fork'); |
2801
|
|
|
|
|
|
|
} |
2802
|
|
|
|
|
|
|
} |
2803
|
|
|
|
|
|
|
} |
2804
|
513
|
|
|
|
|
7490
|
last; # (loop was a cheap "goto") |
2805
|
|
|
|
|
|
|
} |
2806
|
|
|
|
|
|
|
|
2807
|
|
|
|
|
|
|
# generate Validate tag if requested |
2808
|
513
|
100
|
66
|
|
|
2021
|
if ($$options{Validate} and not $reEntry) { |
2809
|
1
|
|
|
|
|
9
|
Image::ExifTool::Validate::FinishValidate($self, $$req{validate}); |
2810
|
|
|
|
|
|
|
} |
2811
|
|
|
|
|
|
|
|
2812
|
513
|
100
|
|
|
|
1877
|
@startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime)); |
2813
|
|
|
|
|
|
|
|
2814
|
|
|
|
|
|
|
# add user-defined parameters that ended with '!' |
2815
|
513
|
50
|
|
|
|
935
|
if (%{$$options{UserParam}}) { |
|
513
|
|
|
|
|
1936
|
|
2816
|
0
|
|
|
|
|
0
|
my $doMsg = $$options{Verbose}; |
2817
|
0
|
|
|
|
|
0
|
my $table = GetTagTable('Image::ExifTool::UserParam'); |
2818
|
0
|
|
|
|
|
0
|
foreach (sort keys %{$$options{UserParam}}) { |
|
0
|
|
|
|
|
0
|
|
2819
|
0
|
0
|
|
|
|
0
|
next unless /#$/; |
2820
|
0
|
0
|
|
|
|
0
|
if ($doMsg) { |
2821
|
0
|
|
|
|
|
0
|
$self->VPrint(0, "UserParam tags:\n"); |
2822
|
0
|
|
|
|
|
0
|
undef $doMsg; |
2823
|
|
|
|
|
|
|
} |
2824
|
0
|
|
|
|
|
0
|
$self->HandleTag($table, $_, $$options{UserParam}{$_}); |
2825
|
|
|
|
|
|
|
} |
2826
|
|
|
|
|
|
|
} |
2827
|
|
|
|
|
|
|
|
2828
|
|
|
|
|
|
|
# restore original options |
2829
|
513
|
100
|
|
|
|
1405
|
%saveOptions and $$self{OPTIONS} = \%saveOptions; |
2830
|
|
|
|
|
|
|
|
2831
|
513
|
100
|
|
|
|
1339
|
if ($reEntry) { |
2832
|
|
|
|
|
|
|
# restore necessary members when exiting re-entrant code |
2833
|
2
|
|
|
|
|
17
|
$$self{$_} = $$reEntry{$_} foreach keys %$reEntry; |
2834
|
2
|
|
|
|
|
15
|
SetByteOrder($saveOrder); |
2835
|
|
|
|
|
|
|
} |
2836
|
|
|
|
|
|
|
|
2837
|
|
|
|
|
|
|
# ($type may be undef without an Error when processing sub-documents) |
2838
|
513
|
50
|
33
|
|
|
3286
|
return 0 if not defined $type or exists $$self{VALUE}{Error}; |
2839
|
513
|
|
|
|
|
2404
|
return 1; |
2840
|
|
|
|
|
|
|
} |
2841
|
|
|
|
|
|
|
|
2842
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2843
|
|
|
|
|
|
|
# Get hash of extracted meta information |
2844
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2845
|
|
|
|
|
|
|
# 1-N) options hash reference, tag list reference or tag names |
2846
|
|
|
|
|
|
|
# Returns: Reference to information hash |
2847
|
|
|
|
|
|
|
# Notes: - pass an undefined value to avoid parsing arguments |
2848
|
|
|
|
|
|
|
# - If groups are specified, first groups take precedence if duplicate |
2849
|
|
|
|
|
|
|
# tags found but Duplicates option not set. |
2850
|
|
|
|
|
|
|
# - tag names may end in '#' to extract ValueConv value |
2851
|
|
|
|
|
|
|
sub GetInfo($;@) |
2852
|
|
|
|
|
|
|
{ |
2853
|
683
|
|
|
683
|
1
|
2748
|
local $_; |
2854
|
683
|
|
|
|
|
1198
|
my $self = shift; |
2855
|
683
|
|
|
|
|
1112
|
my %saveOptions; |
2856
|
|
|
|
|
|
|
|
2857
|
683
|
100
|
66
|
|
|
3357
|
unless (@_ and not defined $_[0]) { |
2858
|
177
|
|
|
|
|
370
|
%saveOptions = %{$$self{OPTIONS}}; # save original options |
|
177
|
|
|
|
|
8451
|
|
2859
|
|
|
|
|
|
|
# must set FILENAME so it isn't parsed from the arguments |
2860
|
177
|
100
|
|
|
|
1250
|
$$self{FILENAME} = '' unless defined $$self{FILENAME}; |
2861
|
177
|
|
|
|
|
777
|
$self->ParseArguments(@_); |
2862
|
|
|
|
|
|
|
} |
2863
|
|
|
|
|
|
|
|
2864
|
|
|
|
|
|
|
# get reference to list of tags for which we will return info |
2865
|
683
|
|
|
|
|
3134
|
my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags(); |
2866
|
|
|
|
|
|
|
|
2867
|
|
|
|
|
|
|
# build hash of tag information |
2868
|
683
|
|
|
|
|
1257
|
my (%info, %ignored); |
2869
|
683
|
100
|
|
|
|
2353
|
my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; |
2870
|
683
|
|
|
|
|
1661
|
foreach (@$rtnTags) { |
2871
|
35002
|
|
|
|
|
55659
|
my $val = $self->GetValue($_, $conv); |
2872
|
35002
|
100
|
|
|
|
55874
|
defined $val or $ignored{$_} = 1, next; |
2873
|
34057
|
|
|
|
|
65074
|
$info{$_} = $val; |
2874
|
|
|
|
|
|
|
} |
2875
|
|
|
|
|
|
|
|
2876
|
|
|
|
|
|
|
# override specified tags with ValueConv value if necessary |
2877
|
683
|
100
|
|
|
|
2415
|
if (@$byValue) { |
2878
|
|
|
|
|
|
|
# first determine the number of times each non-ValueConv value is used |
2879
|
4
|
|
|
|
|
7
|
my %nonVal; |
2880
|
4
|
|
100
|
|
|
63
|
$nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags; |
2881
|
4
|
|
|
|
|
22
|
--$nonVal{$$rtnTags[$_]} foreach @$byValue; |
2882
|
|
|
|
|
|
|
# loop through ValueConv tags, updating tag keys and returned values |
2883
|
4
|
|
|
|
|
9
|
foreach (@$byValue) { |
2884
|
25
|
|
|
|
|
30
|
my $tag = $$rtnTags[$_]; |
2885
|
25
|
|
|
|
|
42
|
my $val = $self->GetValue($tag, 'ValueConv'); |
2886
|
25
|
100
|
|
|
|
44
|
next unless defined $val; |
2887
|
16
|
|
|
|
|
22
|
my $vtag = $tag; |
2888
|
|
|
|
|
|
|
# generate a new tag key like "Tag #" or "Tag #(1)" |
2889
|
16
|
|
|
|
|
75
|
$vtag =~ s/( |$)/ #/; |
2890
|
16
|
50
|
|
|
|
42
|
unless (defined $$self{VALUE}{$vtag}) { |
2891
|
16
|
|
|
|
|
31
|
$$self{VALUE}{$vtag} = $$self{VALUE}{$tag}; |
2892
|
16
|
|
|
|
|
35
|
$$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag}; |
2893
|
16
|
|
|
|
|
35
|
$$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag}; |
2894
|
16
|
|
|
|
|
28
|
$$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag}; |
2895
|
|
|
|
|
|
|
# remove existing PrintConv entry unless we are using it too |
2896
|
16
|
100
|
|
|
|
38
|
delete $info{$tag} unless $nonVal{$tag}; |
2897
|
|
|
|
|
|
|
} |
2898
|
16
|
|
|
|
|
23
|
$$rtnTags[$_] = $vtag; # store ValueConv value with new tag key |
2899
|
16
|
|
|
|
|
40
|
$info{$vtag} = $val; # return ValueConv value |
2900
|
|
|
|
|
|
|
} |
2901
|
|
|
|
|
|
|
} |
2902
|
|
|
|
|
|
|
|
2903
|
|
|
|
|
|
|
# remove ignored tags from the list |
2904
|
683
|
|
50
|
|
|
2284
|
my $reqTags = $$self{REQUESTED_TAGS} || [ ]; |
2905
|
683
|
100
|
|
|
|
1810
|
if (%ignored) { |
2906
|
401
|
100
|
|
|
|
1407
|
if (not @$reqTags) { |
|
|
100
|
|
|
|
|
|
2907
|
188
|
|
|
|
|
341
|
my @goodTags; |
2908
|
188
|
|
|
|
|
509
|
foreach (@$rtnTags) { |
2909
|
22434
|
100
|
|
|
|
36419
|
push @goodTags, $_ unless $ignored{$_}; |
2910
|
|
|
|
|
|
|
} |
2911
|
188
|
|
|
|
|
1345
|
$rtnTags = $$self{FOUND_TAGS} = \@goodTags; |
2912
|
|
|
|
|
|
|
} elsif (@$wildTags) { |
2913
|
|
|
|
|
|
|
# only remove tags specified by wildcard |
2914
|
41
|
|
|
|
|
59
|
my @goodTags; |
2915
|
41
|
|
|
|
|
59
|
my $i = 0; |
2916
|
41
|
|
|
|
|
72
|
foreach (@$rtnTags) { |
2917
|
356
|
100
|
100
|
|
|
698
|
if (@$wildTags and $i == $$wildTags[0]) { |
2918
|
197
|
|
|
|
|
217
|
shift @$wildTags; |
2919
|
197
|
50
|
|
|
|
355
|
push @goodTags, $_ unless $ignored{$_}; |
2920
|
|
|
|
|
|
|
} else { |
2921
|
159
|
|
|
|
|
216
|
push @goodTags, $_; |
2922
|
|
|
|
|
|
|
} |
2923
|
356
|
|
|
|
|
392
|
++$i; |
2924
|
|
|
|
|
|
|
} |
2925
|
41
|
|
|
|
|
139
|
$rtnTags = $$self{FOUND_TAGS} = \@goodTags; |
2926
|
|
|
|
|
|
|
} |
2927
|
|
|
|
|
|
|
} |
2928
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
# return sorted tag list if provided with a list reference |
2930
|
683
|
100
|
|
|
|
2251
|
if ($$self{IO_TAG_LIST}) { |
2931
|
|
|
|
|
|
|
# use file order by default if no tags specified |
2932
|
|
|
|
|
|
|
# (no such thing as 'Input' order in this case) |
2933
|
4
|
|
|
|
|
8
|
my $sort = $$self{OPTIONS}{Sort}; |
2934
|
4
|
50
|
33
|
|
|
22
|
$sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input'); |
|
|
|
66
|
|
|
|
|
2935
|
|
|
|
|
|
|
# return tags in specified sort order |
2936
|
4
|
|
|
|
|
18
|
@{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2}); |
|
4
|
|
|
|
|
22
|
|
2937
|
|
|
|
|
|
|
} |
2938
|
|
|
|
|
|
|
|
2939
|
|
|
|
|
|
|
# restore original options |
2940
|
683
|
100
|
|
|
|
2923
|
%saveOptions and $$self{OPTIONS} = \%saveOptions; |
2941
|
|
|
|
|
|
|
|
2942
|
683
|
|
|
|
|
2873
|
return \%info; |
2943
|
|
|
|
|
|
|
} |
2944
|
|
|
|
|
|
|
|
2945
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2946
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2947
|
|
|
|
|
|
|
# 1) [optional] reference to info hash or tag list ref (default is found tags) |
2948
|
|
|
|
|
|
|
# 2) [optional] sort order ('File', 'Input', ...) |
2949
|
|
|
|
|
|
|
# 3) [optional] secondary sort order |
2950
|
|
|
|
|
|
|
# Returns: List of tags in specified order |
2951
|
|
|
|
|
|
|
sub GetTagList($;$$$) |
2952
|
|
|
|
|
|
|
{ |
2953
|
425
|
|
|
425
|
1
|
65912
|
local $_; |
2954
|
425
|
|
|
|
|
1432
|
my ($self, $info, $sort, $sort2) = @_; |
2955
|
|
|
|
|
|
|
|
2956
|
425
|
|
|
|
|
744
|
my $foundTags; |
2957
|
425
|
100
|
|
|
|
1806
|
if (ref $info eq 'HASH') { |
|
|
50
|
|
|
|
|
|
2958
|
420
|
|
|
|
|
5140
|
my @tags = keys %$info; |
2959
|
420
|
|
|
|
|
1274
|
$foundTags = \@tags; |
2960
|
|
|
|
|
|
|
} elsif (ref $info eq 'ARRAY') { |
2961
|
5
|
|
|
|
|
8
|
$foundTags = $info; |
2962
|
|
|
|
|
|
|
} |
2963
|
425
|
|
|
|
|
1276
|
my $fileOrder = $$self{FILE_ORDER}; |
2964
|
|
|
|
|
|
|
|
2965
|
425
|
50
|
|
|
|
1134
|
if ($foundTags) { |
2966
|
|
|
|
|
|
|
# make sure a FILE_ORDER entry exists for all tags |
2967
|
|
|
|
|
|
|
# (note: already generated bogus entries for FOUND_TAGS case below) |
2968
|
425
|
|
|
|
|
1196
|
foreach (@$foundTags) { |
2969
|
23843
|
50
|
|
|
|
37427
|
next if defined $$fileOrder{$_}; |
2970
|
0
|
|
|
|
|
0
|
$$fileOrder{$_} = 999; |
2971
|
|
|
|
|
|
|
} |
2972
|
|
|
|
|
|
|
} else { |
2973
|
0
|
0
|
0
|
|
|
0
|
$sort = $info if $info and not $sort; |
2974
|
0
|
0
|
0
|
|
|
0
|
$foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; |
2975
|
|
|
|
|
|
|
} |
2976
|
425
|
100
|
|
|
|
1431
|
$sort or $sort = $$self{OPTIONS}{Sort}; |
2977
|
|
|
|
|
|
|
|
2978
|
|
|
|
|
|
|
# return original list if no sort order specified |
2979
|
425
|
100
|
66
|
|
|
2616
|
return @$foundTags unless $sort and $sort ne 'Input'; |
2980
|
|
|
|
|
|
|
|
2981
|
407
|
50
|
33
|
|
|
4788
|
if ($sort eq 'Tag' or $sort eq 'Alpha') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2982
|
0
|
|
|
|
|
0
|
return sort @$foundTags; |
2983
|
|
|
|
|
|
|
} elsif ($sort =~ /^Group(\d*(:\d+)*)/) { |
2984
|
405
|
|
50
|
|
|
2140
|
my $family = $1 || 0; |
2985
|
|
|
|
|
|
|
# want to maintain a basic file order with the groups |
2986
|
|
|
|
|
|
|
# ordered in the way they appear in the file |
2987
|
405
|
|
|
|
|
844
|
my (%groupCount, %groupOrder); |
2988
|
405
|
|
|
|
|
733
|
my $numGroups = 0; |
2989
|
405
|
|
|
|
|
697
|
my $tag; |
2990
|
405
|
|
|
|
|
2213
|
foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) { |
|
129571
|
|
|
|
|
143319
|
|
2991
|
23134
|
|
|
|
|
32860
|
my $group = $self->GetGroup($tag, $family); |
2992
|
23134
|
|
|
|
|
31186
|
my $num = $groupCount{$group}; |
2993
|
23134
|
100
|
|
|
|
32921
|
$num or $num = $groupCount{$group} = ++$numGroups; |
2994
|
23134
|
|
|
|
|
37265
|
$groupOrder{$tag} = $num; |
2995
|
|
|
|
|
|
|
} |
2996
|
405
|
50
|
|
|
|
1963
|
$sort2 or $sort2 = $$self{OPTIONS}{Sort2}; |
2997
|
405
|
50
|
|
|
|
1386
|
if ($sort2) { |
2998
|
405
|
50
|
33
|
|
|
2587
|
if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') { |
|
|
50
|
|
|
|
|
|
2999
|
0
|
0
|
|
|
|
0
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags; |
|
0
|
|
|
|
|
0
|
|
3000
|
|
|
|
|
|
|
} elsif ($sort2 eq 'Descr') { |
3001
|
0
|
|
|
|
|
0
|
my $desc = $self->GetDescriptions($foundTags); |
3002
|
0
|
|
|
|
|
0
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or |
3003
|
0
|
0
|
|
|
|
0
|
$$desc{$a} cmp $$desc{$b} } @$foundTags; |
3004
|
|
|
|
|
|
|
} |
3005
|
|
|
|
|
|
|
} |
3006
|
405
|
|
|
|
|
1982
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or |
3007
|
129472
|
50
|
|
|
|
192817
|
$$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; |
3008
|
|
|
|
|
|
|
} elsif ($sort eq 'Descr') { |
3009
|
0
|
|
|
|
|
0
|
my $desc = $self->GetDescriptions($foundTags); |
3010
|
0
|
|
|
|
|
0
|
return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags; |
|
0
|
|
|
|
|
0
|
|
3011
|
|
|
|
|
|
|
} else { |
3012
|
2
|
|
|
|
|
14
|
return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; |
|
3718
|
|
|
|
|
4217
|
|
3013
|
|
|
|
|
|
|
} |
3014
|
|
|
|
|
|
|
} |
3015
|
|
|
|
|
|
|
|
3016
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3017
|
|
|
|
|
|
|
# Get list of found tags in specified sort order |
3018
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...) |
3019
|
|
|
|
|
|
|
# 2) secondary sort order |
3020
|
|
|
|
|
|
|
# Returns: List of tag keys in specified order |
3021
|
|
|
|
|
|
|
# Notes: If not specified, sort order is taken from OPTIONS |
3022
|
|
|
|
|
|
|
sub GetFoundTags($;$$) |
3023
|
|
|
|
|
|
|
{ |
3024
|
1
|
|
|
1
|
1
|
175
|
local $_; |
3025
|
1
|
|
|
|
|
4
|
my ($self, $sort, $sort2) = @_; |
3026
|
1
|
50
|
33
|
|
|
5
|
my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; |
3027
|
1
|
|
|
|
|
6
|
return $self->GetTagList($foundTags, $sort, $sort2); |
3028
|
|
|
|
|
|
|
} |
3029
|
|
|
|
|
|
|
|
3030
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3031
|
|
|
|
|
|
|
# Get list of requested tags |
3032
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3033
|
|
|
|
|
|
|
# Returns: List of requested tag keys |
3034
|
|
|
|
|
|
|
sub GetRequestedTags($) |
3035
|
|
|
|
|
|
|
{ |
3036
|
2
|
|
|
2
|
1
|
4
|
local $_; |
3037
|
2
|
|
|
|
|
4
|
return @{$_[0]{REQUESTED_TAGS}}; |
|
2
|
|
|
|
|
9
|
|
3038
|
|
|
|
|
|
|
} |
3039
|
|
|
|
|
|
|
|
3040
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3041
|
|
|
|
|
|
|
# Get tag value |
3042
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3043
|
|
|
|
|
|
|
# 1) tag key or tag name with optional group names (case sensitive) |
3044
|
|
|
|
|
|
|
# (or flattened tagInfo for getting field values, not part of public API) |
3045
|
|
|
|
|
|
|
# 2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default |
3046
|
|
|
|
|
|
|
# is PrintConv or ValueConv, depending on the PrintConv option setting |
3047
|
|
|
|
|
|
|
# 3) raw field value (not part of public API) |
3048
|
|
|
|
|
|
|
# Returns: Scalar context: tag value or undefined |
3049
|
|
|
|
|
|
|
# List context: list of values or empty list |
3050
|
|
|
|
|
|
|
sub GetValue($$;$) |
3051
|
|
|
|
|
|
|
{ |
3052
|
52529
|
|
|
52529
|
1
|
57634
|
local $_; |
3053
|
52529
|
|
|
|
|
76370
|
my ($self, $tag, $type) = @_; # plus: ($fieldValue) |
3054
|
52529
|
|
|
|
|
59294
|
my (@convTypes, $tagInfo, $valueConv, $both); |
3055
|
52529
|
|
|
|
|
62707
|
my $rawValue = $$self{VALUE}; |
3056
|
|
|
|
|
|
|
|
3057
|
|
|
|
|
|
|
# get specific tag key if tag has a group name |
3058
|
52529
|
50
|
|
|
|
91872
|
if ($tag =~ /^(.*):(.+)/) { |
3059
|
0
|
|
|
|
|
0
|
my ($gp, $tg) = ($1, $2); |
3060
|
0
|
|
|
|
|
0
|
my ($i, $key, @keys); |
3061
|
|
|
|
|
|
|
# build list of tag keys in the order of priority (no index |
3062
|
|
|
|
|
|
|
# is top priority, otherwise higher index is higher priority) |
3063
|
0
|
|
0
|
|
|
0
|
for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) { |
3064
|
0
|
0
|
|
|
|
0
|
push @keys, $key if defined $$rawValue{$key}; |
3065
|
0
|
0
|
|
|
|
0
|
last if $i <= 0; |
3066
|
0
|
|
|
|
|
0
|
$key = "$tg ($i)"; |
3067
|
|
|
|
|
|
|
} |
3068
|
0
|
0
|
|
|
|
0
|
if (@keys) { |
3069
|
0
|
|
|
|
|
0
|
$key = $self->GroupMatches($gp, \@keys); |
3070
|
0
|
0
|
|
|
|
0
|
$tag = $key if $key; |
3071
|
|
|
|
|
|
|
} |
3072
|
|
|
|
|
|
|
} |
3073
|
|
|
|
|
|
|
# figure out what conversions to do |
3074
|
52529
|
100
|
|
|
|
69515
|
if ($type) { |
3075
|
52514
|
50
|
|
|
|
74969
|
return $$self{RATIONAL}{$tag} if $type eq 'Rational'; |
3076
|
|
|
|
|
|
|
} else { |
3077
|
15
|
50
|
|
|
|
101
|
$type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; |
3078
|
|
|
|
|
|
|
} |
3079
|
|
|
|
|
|
|
|
3080
|
|
|
|
|
|
|
# start with the raw value |
3081
|
52529
|
|
|
|
|
77938
|
my $value = $$rawValue{$tag}; |
3082
|
52529
|
100
|
|
|
|
71359
|
if (not defined $value) { |
3083
|
9972
|
100
|
|
|
|
22903
|
return () unless ref $tag; |
3084
|
|
|
|
|
|
|
# get the value of a structure field |
3085
|
194
|
|
|
|
|
257
|
$tagInfo = $tag; |
3086
|
194
|
|
|
|
|
286
|
$tag = $$tagInfo{Name}; |
3087
|
194
|
|
|
|
|
256
|
$value = $_[3]; |
3088
|
|
|
|
|
|
|
# (note: type "Both" is not allowed for structure fields) |
3089
|
194
|
50
|
|
|
|
326
|
if ($type ne 'Raw') { |
3090
|
194
|
|
|
|
|
266
|
push @convTypes, 'ValueConv'; |
3091
|
194
|
100
|
|
|
|
373
|
push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; |
3092
|
|
|
|
|
|
|
} |
3093
|
|
|
|
|
|
|
} else { |
3094
|
42557
|
|
|
|
|
63321
|
$tagInfo = $$self{TAG_INFO}{$tag}; |
3095
|
42557
|
100
|
66
|
|
|
78453
|
if ($$tagInfo{Struct} and ref $value) { |
3096
|
|
|
|
|
|
|
# must load XMPStruct.pl just in case (should already be loaded if |
3097
|
|
|
|
|
|
|
# a structure was extracted, but we could also arrive here if a simple |
3098
|
|
|
|
|
|
|
# list of values was stored incorrectly in a Struct tag) |
3099
|
53
|
|
|
|
|
1090
|
require 'Image/ExifTool/XMPStruct.pl'; |
3100
|
|
|
|
|
|
|
# convert strucure field values |
3101
|
53
|
100
|
|
|
|
135
|
unless ($type eq 'Both') { |
3102
|
|
|
|
|
|
|
# (note: ConvertStruct handles the filtering and escaping too if necessary) |
3103
|
48
|
|
|
|
|
188
|
return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type); |
3104
|
|
|
|
|
|
|
} |
3105
|
5
|
|
|
|
|
18
|
$valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv'); |
3106
|
5
|
|
|
|
|
17
|
$value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv'); |
3107
|
|
|
|
|
|
|
# (must not save these in $$self{BOTH} because the values may have been escaped) |
3108
|
5
|
|
|
|
|
23
|
return ($valueConv, $value); |
3109
|
|
|
|
|
|
|
} |
3110
|
42504
|
50
|
|
|
|
62681
|
if ($type ne 'Raw') { |
3111
|
|
|
|
|
|
|
# use values we calculated already if we stored them |
3112
|
42504
|
|
|
|
|
54531
|
$both = $$self{BOTH}{$tag}; |
3113
|
42504
|
100
|
|
|
|
54654
|
if ($both) { |
3114
|
6331
|
100
|
|
|
|
10939
|
if ($type eq 'PrintConv') { |
|
|
100
|
|
|
|
|
|
3115
|
2136
|
|
|
|
|
3854
|
$value = $$both[1]; |
3116
|
|
|
|
|
|
|
} elsif ($type eq 'ValueConv') { |
3117
|
94
|
|
|
|
|
154
|
$value = $$both[0]; |
3118
|
94
|
100
|
|
|
|
186
|
$value = $$both[1] unless defined $value; |
3119
|
|
|
|
|
|
|
} else { |
3120
|
4101
|
|
|
|
|
6729
|
($valueConv, $value) = @$both; |
3121
|
|
|
|
|
|
|
} |
3122
|
|
|
|
|
|
|
} else { |
3123
|
36173
|
|
|
|
|
47217
|
push @convTypes, 'ValueConv'; |
3124
|
36173
|
100
|
|
|
|
60579
|
push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; |
3125
|
|
|
|
|
|
|
} |
3126
|
|
|
|
|
|
|
} |
3127
|
|
|
|
|
|
|
} |
3128
|
|
|
|
|
|
|
|
3129
|
|
|
|
|
|
|
# do the conversions |
3130
|
42698
|
|
|
|
|
50062
|
my (@val, @prt, @raw, $convType); |
3131
|
42698
|
|
|
|
|
53923
|
foreach $convType (@convTypes) { |
3132
|
|
|
|
|
|
|
# don't convert a scalar reference or structure |
3133
|
69978
|
100
|
66
|
|
|
112071
|
last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary}; |
3134
|
69332
|
|
|
|
|
100514
|
my $conv = $$tagInfo{$convType}; |
3135
|
69332
|
100
|
|
|
|
98493
|
unless (defined $conv) { |
3136
|
45369
|
100
|
|
|
|
59464
|
if ($convType eq 'ValueConv') { |
3137
|
28823
|
100
|
|
|
|
52528
|
next unless $$tagInfo{Binary}; |
3138
|
400
|
|
|
|
|
801
|
$conv = '\$val'; # return scalar reference for binary values |
3139
|
|
|
|
|
|
|
} else { |
3140
|
|
|
|
|
|
|
# use PRINT_CONV from tag table if PrintConv doesn't exist |
3141
|
16546
|
100
|
|
|
|
38727
|
next unless defined($conv = $$tagInfo{Table}{PRINT_CONV}); |
3142
|
201
|
100
|
|
|
|
472
|
next if exists $$tagInfo{$convType}; |
3143
|
|
|
|
|
|
|
} |
3144
|
|
|
|
|
|
|
} |
3145
|
|
|
|
|
|
|
# save old ValueConv value if we want Both |
3146
|
24515
|
100
|
100
|
|
|
45101
|
$valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv'; |
3147
|
24515
|
|
|
|
|
29869
|
my ($i, $val, $vals, @values, $convList); |
3148
|
|
|
|
|
|
|
# split into list if conversion is an array |
3149
|
24515
|
100
|
|
|
|
38360
|
if (ref $conv eq 'ARRAY') { |
3150
|
124
|
|
|
|
|
300
|
$convList = $conv; |
3151
|
124
|
|
|
|
|
299
|
$conv = $$convList[0]; |
3152
|
124
|
50
|
|
|
|
579
|
my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value; |
3153
|
|
|
|
|
|
|
# reorganize list if specified (Note: The writer currently doesn't |
3154
|
|
|
|
|
|
|
# relist values, so they may be grouped but the order must not change) |
3155
|
124
|
|
|
|
|
246
|
my $relist = $$tagInfo{Relist}; |
3156
|
124
|
100
|
|
|
|
284
|
if ($relist) { |
3157
|
7
|
|
|
|
|
19
|
my (@newList, $oldIndex); |
3158
|
7
|
|
|
|
|
35
|
foreach $oldIndex (@$relist) { |
3159
|
14
|
|
|
|
|
23
|
my ($newVal, @join); |
3160
|
14
|
100
|
|
|
|
32
|
if (ref $oldIndex) { |
3161
|
7
|
|
|
|
|
21
|
foreach (@$oldIndex) { |
3162
|
16
|
50
|
|
|
|
49
|
push @join, $valList[$_] if defined $valList[$_]; |
3163
|
|
|
|
|
|
|
} |
3164
|
7
|
50
|
|
|
|
34
|
$newVal = join(' ', @join) if @join; |
3165
|
|
|
|
|
|
|
} else { |
3166
|
7
|
|
|
|
|
15
|
$newVal = $valList[$oldIndex]; |
3167
|
|
|
|
|
|
|
} |
3168
|
14
|
100
|
|
|
|
44
|
push @newList, $newVal if defined $newVal; |
3169
|
|
|
|
|
|
|
} |
3170
|
7
|
|
|
|
|
18
|
$value = \@newList; |
3171
|
|
|
|
|
|
|
} else { |
3172
|
117
|
|
|
|
|
253
|
$value = \@valList; |
3173
|
|
|
|
|
|
|
} |
3174
|
124
|
50
|
|
|
|
381
|
return () unless @$value; |
3175
|
|
|
|
|
|
|
} |
3176
|
|
|
|
|
|
|
# initialize array so we can iterate over values in list |
3177
|
24515
|
100
|
|
|
|
34680
|
if (ref $value eq 'ARRAY') { |
3178
|
155
|
100
|
|
|
|
408
|
if (defined $$tagInfo{RawJoin}) { |
3179
|
7
|
|
|
|
|
30
|
$val = join ' ', @$value; |
3180
|
|
|
|
|
|
|
} else { |
3181
|
148
|
|
|
|
|
248
|
$i = 0; |
3182
|
148
|
|
|
|
|
227
|
$vals = $value; |
3183
|
148
|
|
|
|
|
270
|
$val = $$vals[0]; |
3184
|
|
|
|
|
|
|
} |
3185
|
|
|
|
|
|
|
} else { |
3186
|
24360
|
|
|
|
|
29509
|
$val = $value; |
3187
|
|
|
|
|
|
|
} |
3188
|
|
|
|
|
|
|
# loop through all values in list |
3189
|
24515
|
|
|
|
|
26717
|
for (;;) { |
3190
|
24728
|
100
|
|
|
|
32802
|
if (defined $conv) { |
3191
|
|
|
|
|
|
|
# get values of required tags if this is a Composite tag |
3192
|
24709
|
100
|
66
|
|
|
46175
|
if (ref $val eq 'HASH' and not @val) { |
3193
|
|
|
|
|
|
|
# disable escape of source values so we don't double escape them |
3194
|
2861
|
|
|
|
|
4107
|
my $oldEscape = $$self{ESCAPE_PROC}; |
3195
|
2861
|
|
|
|
|
3903
|
delete $$self{ESCAPE_PROC}; |
3196
|
|
|
|
|
|
|
# temporarily delete filter so it isn't applied to the Require'd values |
3197
|
2861
|
|
|
|
|
3832
|
my $oldFilter = $$self{OPTIONS}{Filter}; |
3198
|
2861
|
|
|
|
|
3857
|
delete $$self{OPTIONS}{Filter}; |
3199
|
2861
|
|
|
|
|
9022
|
foreach (keys %$val) { |
3200
|
16778
|
50
|
|
|
|
27303
|
next unless defined $$val{$_}; |
3201
|
16778
|
|
|
|
|
33114
|
$raw[$_] = $$rawValue{$$val{$_}}; |
3202
|
16778
|
|
|
|
|
28139
|
($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both'); |
3203
|
16778
|
100
|
100
|
|
|
42995
|
next if defined $val[$_] or not $$tagInfo{Require}{$_}; |
3204
|
378
|
50
|
|
|
|
886
|
$$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; |
3205
|
378
|
|
|
|
|
601
|
$$self{ESCAPE_PROC} = $oldEscape; |
3206
|
378
|
|
|
|
|
1302
|
return (); |
3207
|
|
|
|
|
|
|
} |
3208
|
2483
|
100
|
|
|
|
5521
|
$$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; |
3209
|
2483
|
|
|
|
|
4150
|
$$self{ESCAPE_PROC} = $oldEscape; |
3210
|
|
|
|
|
|
|
# set $val to $val[0], or \@val for a CODE ref conversion |
3211
|
2483
|
50
|
|
|
|
5495
|
$val = ref $conv eq 'CODE' ? \@val : $val[0]; |
3212
|
|
|
|
|
|
|
} |
3213
|
24331
|
100
|
|
|
|
34474
|
if (ref $conv eq 'HASH') { |
3214
|
|
|
|
|
|
|
# look up converted value in hash |
3215
|
7542
|
100
|
|
|
|
23475
|
if (not defined($value = $$conv{$val})) { |
3216
|
435
|
100
|
|
|
|
1233
|
if ($$conv{BITMASK}) { |
3217
|
121
|
|
|
|
|
578
|
$value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord}); |
3218
|
|
|
|
|
|
|
} else { |
3219
|
|
|
|
|
|
|
# use alternate conversion routine if available |
3220
|
314
|
100
|
|
|
|
921
|
if ($$conv{OTHER}) { |
3221
|
243
|
|
|
|
|
1016
|
local $SIG{'__WARN__'} = \&SetWarning; |
3222
|
243
|
|
|
|
|
501
|
undef $evalWarning; |
3223
|
243
|
|
|
|
|
458
|
$value = &{$$conv{OTHER}}($val, undef, $conv); |
|
243
|
|
|
|
|
975
|
|
3224
|
243
|
50
|
|
|
|
858
|
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; |
3225
|
|
|
|
|
|
|
} |
3226
|
314
|
100
|
|
|
|
842
|
if (not defined $value) { |
3227
|
71
|
50
|
66
|
|
|
295
|
if ($$tagInfo{PrintHex} and $val and IsInt($val) and |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
3228
|
|
|
|
|
|
|
$convType eq 'PrintConv') |
3229
|
|
|
|
|
|
|
{ |
3230
|
0
|
|
|
|
|
0
|
$value = sprintf('Unknown (0x%x)',$val); |
3231
|
|
|
|
|
|
|
} else { |
3232
|
71
|
|
|
|
|
204
|
$value = "Unknown ($val)"; |
3233
|
|
|
|
|
|
|
} |
3234
|
|
|
|
|
|
|
} |
3235
|
|
|
|
|
|
|
} |
3236
|
|
|
|
|
|
|
} |
3237
|
|
|
|
|
|
|
# override with our localized language PrintConv if available |
3238
|
7542
|
|
|
|
|
8646
|
my $tmp; |
3239
|
7542
|
100
|
66
|
|
|
16362
|
if ($$self{CUR_LANG} and $convType eq 'PrintConv' and |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3240
|
|
|
|
|
|
|
# (no need to check for lang-alt tag names -- they won't have a PrintConv) |
3241
|
|
|
|
|
|
|
ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and |
3242
|
|
|
|
|
|
|
($tmp = $$tmp{PrintConv})) |
3243
|
|
|
|
|
|
|
{ |
3244
|
244
|
50
|
33
|
|
|
1056
|
if ($$conv{BITMASK} and not defined $$conv{$val}) { |
|
|
100
|
|
|
|
|
|
3245
|
0
|
|
|
|
|
0
|
my @vals = split ', ', $value; |
3246
|
0
|
|
|
|
|
0
|
foreach (@vals) { |
3247
|
0
|
0
|
|
|
|
0
|
$_ = $$tmp{$_} if defined $$tmp{$_}; |
3248
|
|
|
|
|
|
|
} |
3249
|
0
|
|
|
|
|
0
|
$value = join ', ', @vals; |
3250
|
|
|
|
|
|
|
} elsif (defined($tmp = $$tmp{$value})) { |
3251
|
200
|
|
|
|
|
511
|
$value = $self->Decode($tmp, 'UTF8'); |
3252
|
|
|
|
|
|
|
} |
3253
|
|
|
|
|
|
|
} |
3254
|
|
|
|
|
|
|
} else { |
3255
|
|
|
|
|
|
|
# call subroutine or do eval to convert value |
3256
|
16789
|
|
|
|
|
53616
|
local $SIG{'__WARN__'} = \&SetWarning; |
3257
|
16789
|
|
|
|
|
24850
|
undef $evalWarning; |
3258
|
16789
|
100
|
|
|
|
24397
|
if (ref $conv eq 'CODE') { |
3259
|
829
|
|
|
|
|
2900
|
$value = &$conv($val, $self); |
3260
|
|
|
|
|
|
|
} else { |
3261
|
|
|
|
|
|
|
#### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw) |
3262
|
15960
|
|
|
|
|
833270
|
$value = eval $conv; |
3263
|
15960
|
50
|
|
|
|
52282
|
$@ and $evalWarning = $@; |
3264
|
|
|
|
|
|
|
} |
3265
|
16789
|
50
|
|
|
|
46258
|
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; |
3266
|
|
|
|
|
|
|
} |
3267
|
|
|
|
|
|
|
} else { |
3268
|
19
|
|
|
|
|
32
|
$value = $val; |
3269
|
|
|
|
|
|
|
} |
3270
|
24350
|
100
|
|
|
|
41247
|
last unless $vals; |
3271
|
|
|
|
|
|
|
# must store a separate copy of each binary data value in the list |
3272
|
361
|
100
|
|
|
|
824
|
if (ref $value eq 'SCALAR') { |
3273
|
3
|
|
|
|
|
4
|
my $tval = $$value; |
3274
|
3
|
|
|
|
|
5
|
$value = \$tval; |
3275
|
|
|
|
|
|
|
} |
3276
|
|
|
|
|
|
|
# save this converted value and step to next value in list |
3277
|
361
|
50
|
|
|
|
768
|
push @values, $value if defined $value; |
3278
|
361
|
100
|
|
|
|
792
|
if (++$i >= scalar(@$vals)) { |
3279
|
148
|
50
|
|
|
|
443
|
$value = \@values if @values; |
3280
|
148
|
|
|
|
|
243
|
last; |
3281
|
|
|
|
|
|
|
} |
3282
|
213
|
|
|
|
|
349
|
$val = $$vals[$i]; |
3283
|
213
|
100
|
|
|
|
447
|
if ($convList) { |
3284
|
132
|
|
|
|
|
236
|
my $nextConv = $$convList[$i]; |
3285
|
132
|
50
|
66
|
|
|
581
|
if ($nextConv and $nextConv eq 'REPEAT') { |
3286
|
0
|
|
|
|
|
0
|
undef $convList; |
3287
|
|
|
|
|
|
|
} else { |
3288
|
132
|
|
|
|
|
232
|
$conv = $nextConv; |
3289
|
|
|
|
|
|
|
} |
3290
|
|
|
|
|
|
|
} |
3291
|
|
|
|
|
|
|
} |
3292
|
|
|
|
|
|
|
# return undefined now if no value |
3293
|
24137
|
100
|
|
|
|
39270
|
return () unless defined $value; |
3294
|
|
|
|
|
|
|
# join back into single value if split for conversion list |
3295
|
23579
|
100
|
66
|
|
|
50222
|
if ($convList and ref $value eq 'ARRAY') { |
3296
|
124
|
100
|
|
|
|
685
|
$value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value); |
3297
|
|
|
|
|
|
|
} |
3298
|
|
|
|
|
|
|
} |
3299
|
41762
|
100
|
|
|
|
63733
|
if ($type eq 'Both') { |
3300
|
|
|
|
|
|
|
# save both (unescaped) values because we often need them again |
3301
|
|
|
|
|
|
|
# (Composite tags need "Both" and often Require one tag for various Composite tags) |
3302
|
7364
|
100
|
|
|
|
17337
|
$$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both; |
3303
|
|
|
|
|
|
|
# escape values if necessary |
3304
|
7364
|
50
|
|
|
|
15952
|
if ($$self{ESCAPE_PROC}) { |
|
|
100
|
|
|
|
|
|
3305
|
0
|
|
|
|
|
0
|
DoEscape($value, $$self{ESCAPE_PROC}); |
3306
|
0
|
0
|
|
|
|
0
|
if (defined $valueConv) { |
3307
|
0
|
|
|
|
|
0
|
DoEscape($valueConv, $$self{ESCAPE_PROC}); |
3308
|
|
|
|
|
|
|
} else { |
3309
|
0
|
|
|
|
|
0
|
$valueConv = $value; |
3310
|
|
|
|
|
|
|
} |
3311
|
|
|
|
|
|
|
} elsif (not defined $valueConv) { |
3312
|
|
|
|
|
|
|
# $valueConv is undefined if there was no print conversion done |
3313
|
3718
|
|
|
|
|
4543
|
$valueConv = $value; |
3314
|
|
|
|
|
|
|
} |
3315
|
7364
|
|
|
|
|
22327
|
$self->Filter($$self{OPTIONS}{Filter}, \$value); |
3316
|
|
|
|
|
|
|
# return Both values as a list (ValueConv, PrintConv) |
3317
|
7364
|
|
|
|
|
24447
|
return ($valueConv, $value); |
3318
|
|
|
|
|
|
|
} |
3319
|
|
|
|
|
|
|
# escape value if necessary |
3320
|
34398
|
100
|
|
|
|
53591
|
DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; |
3321
|
|
|
|
|
|
|
|
3322
|
|
|
|
|
|
|
# filter if necessary |
3323
|
34398
|
100
|
100
|
|
|
60276
|
$self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv'; |
3324
|
|
|
|
|
|
|
|
3325
|
34398
|
100
|
|
|
|
49525
|
if (ref $value eq 'ARRAY') { |
3326
|
289
|
100
|
100
|
|
|
2417
|
if (defined $$self{OPTIONS}{ListItem}) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3327
|
3
|
|
|
|
|
8
|
$value = $$value[$$self{OPTIONS}{ListItem}]; |
3328
|
|
|
|
|
|
|
} elsif (wantarray) { |
3329
|
|
|
|
|
|
|
# return array if requested |
3330
|
1
|
|
|
|
|
6
|
return @$value; |
3331
|
|
|
|
|
|
|
} elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) { |
3332
|
|
|
|
|
|
|
# join PrintConv values in comma-separated string if List option not used |
3333
|
|
|
|
|
|
|
# and list contains simple scalars (otherwise return ARRAY ref) |
3334
|
162
|
|
|
|
|
648
|
$value = join $$self{OPTIONS}{ListSep}, @$value; |
3335
|
|
|
|
|
|
|
} |
3336
|
|
|
|
|
|
|
} |
3337
|
34397
|
|
|
|
|
70020
|
return $value; |
3338
|
|
|
|
|
|
|
} |
3339
|
|
|
|
|
|
|
|
3340
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3341
|
|
|
|
|
|
|
# Get tag identification number |
3342
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3343
|
|
|
|
|
|
|
# Returns: Scalar context: tag ID if available, otherwise '' |
3344
|
|
|
|
|
|
|
# List context: 0) tag ID (or ''), 1) language code (or undef) |
3345
|
|
|
|
|
|
|
sub GetTagID($$) |
3346
|
|
|
|
|
|
|
{ |
3347
|
23147
|
|
|
23147
|
1
|
110677
|
my ($self, $tag) = @_; |
3348
|
23147
|
|
|
|
|
32203
|
my $tagInfo = $$self{TAG_INFO}{$tag}; |
3349
|
23147
|
100
|
66
|
|
|
61239
|
return '' unless $tagInfo and defined $$tagInfo{TagID}; |
3350
|
23145
|
|
100
|
|
|
50015
|
my $id = $$tagInfo{KeysID} || $$tagInfo{TagID}; |
3351
|
23145
|
50
|
|
|
|
34822
|
return ($id, $$tagInfo{LangCode}) if wantarray; |
3352
|
23145
|
|
|
|
|
39170
|
return $id; |
3353
|
|
|
|
|
|
|
} |
3354
|
|
|
|
|
|
|
|
3355
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3356
|
|
|
|
|
|
|
# Get description for specified tag |
3357
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3358
|
|
|
|
|
|
|
# Returns: Tag description |
3359
|
|
|
|
|
|
|
# Notes: Will always return a defined value, even if description isn't available |
3360
|
|
|
|
|
|
|
sub GetDescription($$) |
3361
|
|
|
|
|
|
|
{ |
3362
|
23147
|
|
|
23147
|
1
|
54309
|
local $_; |
3363
|
23147
|
|
|
|
|
30665
|
my ($self, $tag) = @_; |
3364
|
23147
|
|
|
|
|
26847
|
my ($desc, $name); |
3365
|
23147
|
|
|
|
|
29627
|
my $tagInfo = $$self{TAG_INFO}{$tag}; |
3366
|
|
|
|
|
|
|
# ($tagInfo won't be defined for missing tags extracted with -f) |
3367
|
23147
|
50
|
|
|
|
35701
|
if ($tagInfo) { |
3368
|
|
|
|
|
|
|
# use alternate language description if available |
3369
|
23147
|
|
|
|
|
37119
|
while ($$self{CUR_LANG}) { |
3370
|
800
|
|
|
|
|
2316
|
$desc = $$self{CUR_LANG}{$$tagInfo{Name}}; |
3371
|
800
|
100
|
|
|
|
1284
|
if ($desc) { |
3372
|
|
|
|
|
|
|
# must look up Description if this tag also has a PrintConv |
3373
|
671
|
100
|
100
|
|
|
1737
|
$desc = $$desc{Description} or last if ref $desc; |
3374
|
|
|
|
|
|
|
} else { |
3375
|
|
|
|
|
|
|
# look up default language of lang-alt tag |
3376
|
|
|
|
|
|
|
last unless $$tagInfo{LangCode} and |
3377
|
|
|
|
|
|
|
($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and |
3378
|
129
|
50
|
66
|
|
|
388
|
$desc = $$self{CUR_LANG}{$name}; |
|
|
|
66
|
|
|
|
|
3379
|
1
|
50
|
0
|
|
|
4
|
$desc = $$desc{Description} or last if ref $desc; |
3380
|
1
|
|
|
|
|
14
|
$desc .= " ($$tagInfo{LangCode})"; |
3381
|
|
|
|
|
|
|
} |
3382
|
|
|
|
|
|
|
# escape description if necessary |
3383
|
663
|
50
|
|
|
|
1160
|
DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; |
3384
|
|
|
|
|
|
|
# return description in proper Charset |
3385
|
663
|
|
|
|
|
1238
|
return $self->Decode($desc, 'UTF8'); |
3386
|
|
|
|
|
|
|
} |
3387
|
22484
|
|
|
|
|
33230
|
$desc = $$tagInfo{Description}; |
3388
|
|
|
|
|
|
|
} |
3389
|
|
|
|
|
|
|
# just make the tag more readable if description doesn't exist |
3390
|
22484
|
100
|
|
|
|
34027
|
unless ($desc) { |
3391
|
9371
|
|
|
|
|
14038
|
$desc = MakeDescription(GetTagName($tag)); |
3392
|
|
|
|
|
|
|
# save description in tag information |
3393
|
9371
|
50
|
|
|
|
22626
|
$$tagInfo{Description} = $desc if $tagInfo; |
3394
|
|
|
|
|
|
|
} |
3395
|
22484
|
|
|
|
|
39194
|
return $desc; |
3396
|
|
|
|
|
|
|
} |
3397
|
|
|
|
|
|
|
|
3398
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3399
|
|
|
|
|
|
|
# Get group name for specified tag |
3400
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3401
|
|
|
|
|
|
|
# 1) tag key (or reference to tagInfo hash, not part of the public API) |
3402
|
|
|
|
|
|
|
# 2) [optional] group family (-1 to get extended group list, or multiple |
3403
|
|
|
|
|
|
|
# families separated by colons to return multiple groups as a string) |
3404
|
|
|
|
|
|
|
# Returns: Scalar context: group name (for family 0 if not otherwise specified) |
3405
|
|
|
|
|
|
|
# List context: group name if family specified, otherwise list of |
3406
|
|
|
|
|
|
|
# group names for each family. Returns '' for undefined tag. |
3407
|
|
|
|
|
|
|
# Notes: Multiple families may be specified with ':' in family argument (eg. '1:2') |
3408
|
|
|
|
|
|
|
sub GetGroup($$;$) |
3409
|
|
|
|
|
|
|
{ |
3410
|
189505
|
|
|
189505
|
1
|
549242
|
local $_; |
3411
|
189505
|
|
|
|
|
266087
|
my ($self, $tag, $family) = @_; |
3412
|
189505
|
|
|
|
|
220354
|
my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID); |
3413
|
189505
|
100
|
|
|
|
283709
|
if (ref $tag eq 'HASH') { |
3414
|
119867
|
|
|
|
|
137659
|
$tagInfo = $tag; |
3415
|
119867
|
|
|
|
|
173608
|
$tag = $$tagInfo{Name}; |
3416
|
|
|
|
|
|
|
# set flag so we don't get extra information for an extracted tag |
3417
|
119867
|
|
|
|
|
133369
|
$byTagInfo = 1; |
3418
|
|
|
|
|
|
|
} else { |
3419
|
69638
|
|
50
|
|
|
137942
|
$tagInfo = $$self{TAG_INFO}{$tag} || { }; |
3420
|
69638
|
|
|
|
|
93079
|
$ex = $$self{TAG_EXTRA}{$tag}; |
3421
|
|
|
|
|
|
|
} |
3422
|
189505
|
|
|
|
|
275943
|
my $groups = $$tagInfo{Groups}; |
3423
|
|
|
|
|
|
|
# fill in default groups unless already done |
3424
|
|
|
|
|
|
|
# (after this, Groups 0-2 in tagInfo are guaranteed to be defined) |
3425
|
189505
|
100
|
|
|
|
315810
|
unless ($$tagInfo{GotGroups}) { |
3426
|
35451
|
|
50
|
|
|
56799
|
my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } }; |
3427
|
|
|
|
|
|
|
# construct our group list |
3428
|
35451
|
100
|
|
|
|
70507
|
$groups or $groups = $$tagInfo{Groups} = { }; |
3429
|
|
|
|
|
|
|
# fill in default groups |
3430
|
35451
|
|
|
|
|
54210
|
foreach (0..2) { |
3431
|
106353
|
100
|
50
|
|
|
302458
|
$$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_}; |
3432
|
|
|
|
|
|
|
} |
3433
|
|
|
|
|
|
|
# set flag indicating group list was built |
3434
|
35451
|
|
|
|
|
57187
|
$$tagInfo{GotGroups} = 1; |
3435
|
|
|
|
|
|
|
} |
3436
|
189505
|
100
|
100
|
|
|
415998
|
if (defined $family and $family ne '-1') { |
3437
|
98337
|
100
|
|
|
|
178703
|
if ($family =~ /[^\d]/) { |
3438
|
2736
|
|
|
|
|
7314
|
@families = ($family =~ /\d+/g); |
3439
|
2736
|
50
|
0
|
|
|
4638
|
return(($ex && $$ex{G0}) || $$groups{0}) unless @families; |
3440
|
2736
|
50
|
|
|
|
4966
|
$simplify = 1 unless $family =~ /^:/; |
3441
|
2736
|
|
|
|
|
3095
|
undef $family; |
3442
|
2736
|
|
|
|
|
4016
|
foreach (0..2) { $groups[$_] = $$groups{$_}; } |
|
8208
|
|
|
|
|
12868
|
|
3443
|
2736
|
50
|
33
|
|
|
4573
|
$noID = 1 if @families == 1 and $families[0] != 7; |
3444
|
|
|
|
|
|
|
} else { |
3445
|
95601
|
100
|
66
|
|
|
391728
|
return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2; |
|
|
|
100
|
|
|
|
|
3446
|
28377
|
|
|
|
|
63988
|
$groups[1] = $$groups{1}; |
3447
|
|
|
|
|
|
|
} |
3448
|
|
|
|
|
|
|
} else { |
3449
|
91168
|
100
|
33
|
|
|
137954
|
return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray; |
3450
|
90787
|
|
|
|
|
128215
|
foreach (0..2) { $groups[$_] = $$groups{$_}; } |
|
272361
|
|
|
|
|
474433
|
|
3451
|
|
|
|
|
|
|
} |
3452
|
121900
|
|
|
|
|
159125
|
$groups[3] = 'Main'; |
3453
|
121900
|
100
|
|
|
|
235390
|
$groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : ''; |
3454
|
|
|
|
|
|
|
# handle dynamic group names if necessary |
3455
|
121900
|
100
|
|
|
|
188011
|
unless ($byTagInfo) { |
3456
|
44208
|
100
|
|
|
|
62585
|
if ($ex) { |
3457
|
17218
|
100
|
|
|
|
30112
|
$groups[0] = $$ex{G0} if $$ex{G0}; |
3458
|
17218
|
100
|
|
|
|
41302
|
$groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1}; |
|
|
100
|
|
|
|
|
|
3459
|
17218
|
100
|
|
|
|
27216
|
$groups[3] = 'Doc' . $$ex{G3} if $$ex{G3}; |
3460
|
17218
|
100
|
66
|
|
|
26616
|
$groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5}; |
3461
|
17218
|
50
|
|
|
|
26089
|
if (defined $$ex{G6}) { |
3462
|
0
|
0
|
|
|
|
0
|
$groups[5] = '' unless defined $groups[5]; # (can't leave a hole in the array) |
3463
|
0
|
|
|
|
|
0
|
$groups[6] = $$ex{G6}; |
3464
|
|
|
|
|
|
|
} |
3465
|
|
|
|
|
|
|
} |
3466
|
|
|
|
|
|
|
# generate tag ID group names unless obviously not needed |
3467
|
44208
|
50
|
|
|
|
61468
|
unless ($noID) { |
3468
|
44208
|
|
100
|
|
|
117624
|
my $id = $$tagInfo{KeysID} || $$tagInfo{TagID}; |
3469
|
44208
|
100
|
|
|
|
113577
|
if (not defined $id) { |
|
|
100
|
|
|
|
|
|
3470
|
2
|
|
|
|
|
3
|
$id = ''; # (just to be safe) |
3471
|
|
|
|
|
|
|
} elsif ($id =~ /^\d+$/) { |
3472
|
27872
|
50
|
|
|
|
51729
|
$id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs}; |
3473
|
|
|
|
|
|
|
} else { |
3474
|
16334
|
|
|
|
|
29492
|
$id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge; |
|
1268
|
|
|
|
|
4970
|
|
3475
|
|
|
|
|
|
|
} |
3476
|
44208
|
|
|
|
|
73185
|
$groups[7] = 'ID-' . $id; |
3477
|
44208
|
|
100
|
|
|
126881
|
defined $groups[$_] or $groups[$_] = '' foreach (5,6); |
3478
|
|
|
|
|
|
|
} |
3479
|
|
|
|
|
|
|
} |
3480
|
121900
|
100
|
|
|
|
186867
|
if ($family) { |
3481
|
43522
|
100
|
50
|
|
|
139752
|
return $groups[$family] || '' if $family > 0; |
3482
|
|
|
|
|
|
|
# add additional matching group names to list |
3483
|
|
|
|
|
|
|
# eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1 |
3484
|
|
|
|
|
|
|
# and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc |
3485
|
15145
|
100
|
|
|
|
24736
|
if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) { |
3486
|
31
|
|
50
|
|
|
196
|
push @groups, 'MIE' . ($1 || '1'); |
3487
|
31
|
50
|
|
|
|
152
|
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3"; |
3488
|
31
|
50
|
|
|
|
132
|
push @groups, "MIE$1-$2" . ($3 ? '' : '1'); |
3489
|
31
|
50
|
|
|
|
153
|
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1'); |
|
|
50
|
|
|
|
|
|
3490
|
|
|
|
|
|
|
} |
3491
|
|
|
|
|
|
|
} |
3492
|
93523
|
100
|
|
|
|
146139
|
if (@families) { |
3493
|
2736
|
|
|
|
|
2894
|
my @grps; |
3494
|
|
|
|
|
|
|
# create list of group names (without identical adjacent groups if simplifying) |
3495
|
2736
|
|
|
|
|
3488
|
foreach (@families) { |
3496
|
5472
|
|
|
|
|
7658
|
my $grp = $groups[$_]; |
3497
|
5472
|
50
|
|
|
|
7364
|
unless ($grp) { |
3498
|
0
|
0
|
|
|
|
0
|
next if $simplify; |
3499
|
0
|
|
|
|
|
0
|
$grp = ''; |
3500
|
|
|
|
|
|
|
} |
3501
|
5472
|
100
|
66
|
|
|
18388
|
push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1]; |
|
|
|
100
|
|
|
|
|
3502
|
|
|
|
|
|
|
} |
3503
|
|
|
|
|
|
|
# remove leading "Main:" if simplifying |
3504
|
2736
|
50
|
66
|
|
|
8955
|
shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main'; |
|
|
|
66
|
|
|
|
|
3505
|
|
|
|
|
|
|
# return colon-separated string of group names |
3506
|
2736
|
|
|
|
|
8169
|
return join ':', @grps; |
3507
|
|
|
|
|
|
|
} |
3508
|
90787
|
|
|
|
|
285595
|
return @groups; |
3509
|
|
|
|
|
|
|
} |
3510
|
|
|
|
|
|
|
|
3511
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3512
|
|
|
|
|
|
|
# Get group names for specified tags |
3513
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3514
|
|
|
|
|
|
|
# 1) [optional] information hash reference (default all extracted info) |
3515
|
|
|
|
|
|
|
# 2) [optional] group family (default 0) |
3516
|
|
|
|
|
|
|
# Returns: List of group names in alphabetical order |
3517
|
|
|
|
|
|
|
sub GetGroups($;$$) |
3518
|
|
|
|
|
|
|
{ |
3519
|
3
|
|
|
3
|
1
|
16
|
local $_; |
3520
|
3
|
|
|
|
|
5
|
my $self = shift; |
3521
|
3
|
|
|
|
|
4
|
my $info = shift; |
3522
|
3
|
|
|
|
|
4
|
my $family; |
3523
|
|
|
|
|
|
|
|
3524
|
|
|
|
|
|
|
# figure out our arguments |
3525
|
3
|
100
|
|
|
|
9
|
if (ref $info ne 'HASH') { |
3526
|
2
|
|
|
|
|
3
|
$family = $info; |
3527
|
2
|
|
|
|
|
4
|
$info = $$self{VALUE}; |
3528
|
|
|
|
|
|
|
} else { |
3529
|
1
|
|
|
|
|
2
|
$family = shift; |
3530
|
|
|
|
|
|
|
} |
3531
|
3
|
50
|
|
|
|
6
|
$family = 0 unless defined $family; |
3532
|
|
|
|
|
|
|
|
3533
|
|
|
|
|
|
|
# get a list of all groups in specified information |
3534
|
3
|
|
|
|
|
5
|
my ($tag, %groups); |
3535
|
3
|
|
|
|
|
46
|
foreach $tag (keys %$info) { |
3536
|
383
|
|
|
|
|
602
|
$groups{ $self->GetGroup($tag, $family) } = 1; |
3537
|
|
|
|
|
|
|
} |
3538
|
3
|
|
|
|
|
43
|
return sort keys %groups; |
3539
|
|
|
|
|
|
|
} |
3540
|
|
|
|
|
|
|
|
3541
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3542
|
|
|
|
|
|
|
# Set priority for group where new values are written |
3543
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, |
3544
|
|
|
|
|
|
|
# 1-N) group names (reset to default if no groups specified) |
3545
|
|
|
|
|
|
|
# - used when new tag values are set (ie. before files are written) |
3546
|
|
|
|
|
|
|
sub SetNewGroups($;@) |
3547
|
|
|
|
|
|
|
{ |
3548
|
471
|
|
|
471
|
1
|
779
|
local $_; |
3549
|
471
|
|
|
|
|
1944
|
my ($self, @groups) = @_; |
3550
|
471
|
50
|
|
|
|
1401
|
@groups or @groups = @defaultWriteGroups; |
3551
|
471
|
|
|
|
|
1159
|
my $count = @groups * 10; |
3552
|
471
|
|
|
|
|
802
|
my %priority; |
3553
|
471
|
|
|
|
|
1133
|
foreach (@groups) { |
3554
|
4239
|
|
|
|
|
7215
|
$priority{lc($_)} = $count; |
3555
|
4239
|
|
|
|
|
5102
|
$count -= 10; |
3556
|
|
|
|
|
|
|
} |
3557
|
471
|
|
|
|
|
1226
|
$priority{file} = 500; # 'File' group is always written (Comment) |
3558
|
471
|
|
|
|
|
1289
|
$priority{composite} = 500; # 'Composite' group is always written |
3559
|
|
|
|
|
|
|
# set write priority (higher # is higher priority) |
3560
|
471
|
|
|
|
|
1096
|
$$self{WRITE_PRIORITY} = \%priority; |
3561
|
471
|
|
|
|
|
1493
|
$$self{WRITE_GROUPS} = \@groups; |
3562
|
|
|
|
|
|
|
} |
3563
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3565
|
|
|
|
|
|
|
# Build Composite tags from Require'd/Desire'd tags |
3566
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3567
|
|
|
|
|
|
|
# Note: Tag values are calculated in alphabetical order unless a tag Require's |
3568
|
|
|
|
|
|
|
# or Desire's another Composite tag, in which case the calculation is |
3569
|
|
|
|
|
|
|
# deferred until after the other tag is calculated. |
3570
|
|
|
|
|
|
|
sub BuildCompositeTags($) |
3571
|
|
|
|
|
|
|
{ |
3572
|
502
|
|
|
502
|
1
|
823
|
local $_; |
3573
|
502
|
|
|
|
|
955
|
my $self = shift; |
3574
|
|
|
|
|
|
|
|
3575
|
502
|
|
|
|
|
1167
|
$$self{BuildingComposite} = 1; |
3576
|
|
|
|
|
|
|
|
3577
|
502
|
|
|
|
|
1332
|
my $compTable = GetTagTable('Image::ExifTool::Composite'); |
3578
|
502
|
|
|
|
|
25851
|
my @tagList = sort keys %$compTable; |
3579
|
502
|
|
|
|
|
2330
|
my $rawValue = $$self{VALUE}; |
3580
|
502
|
|
|
|
|
1107
|
my $compKeys = $$self{COMP_KEYS}; |
3581
|
502
|
|
|
|
|
1260
|
my (%cache, $allBuilt); |
3582
|
|
|
|
|
|
|
|
3583
|
502
|
|
|
|
|
807
|
for (;;) { |
3584
|
2195
|
|
|
|
|
3299
|
my (%notBuilt, $tag, @deferredTags); |
3585
|
2195
|
|
|
|
|
4012
|
foreach (@tagList) { |
3586
|
42788
|
100
|
|
|
|
106983
|
$notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_}; |
3587
|
|
|
|
|
|
|
} |
3588
|
|
|
|
|
|
|
COMPOSITE_TAG: |
3589
|
2195
|
|
|
|
|
3670
|
foreach $tag (@tagList) { |
3590
|
42788
|
100
|
|
|
|
71580
|
next if $specialTags{$tag}; |
3591
|
39776
|
|
|
|
|
68882
|
my $tagInfo = $self->GetTagInfo($compTable, $tag); |
3592
|
39776
|
100
|
|
|
|
62863
|
next unless $tagInfo; |
3593
|
39527
|
|
|
|
|
55799
|
my $tagName = $$compTable{$tag}{Name}; |
3594
|
|
|
|
|
|
|
# put required tags into array and make sure they all exist |
3595
|
39527
|
|
100
|
|
|
67593
|
my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT}); |
3596
|
39527
|
|
100
|
|
|
76858
|
my $require = $$tagInfo{Require} || { }; |
3597
|
39527
|
|
100
|
|
|
82791
|
my $desire = $$tagInfo{Desire} || { }; |
3598
|
39527
|
|
100
|
|
|
82766
|
my $inhibit = $$tagInfo{Inhibit} || { }; |
3599
|
|
|
|
|
|
|
# loop through sub-documents if necessary |
3600
|
39527
|
|
|
|
|
44576
|
my $docNum = 0; |
3601
|
39527
|
|
|
|
|
41991
|
for (;;) { |
3602
|
39527
|
|
|
|
|
46423
|
my (%tagKey, $found, $index); |
3603
|
|
|
|
|
|
|
# save Require'd and Desire'd tag values in list |
3604
|
39527
|
|
|
|
|
46845
|
for ($index=0; ; ++$index) { |
3605
|
94204
|
|
100
|
|
|
247177
|
my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index}; |
3606
|
94204
|
100
|
|
|
|
131525
|
unless ($reqTag) { |
3607
|
|
|
|
|
|
|
# allow Composite with no Require'd or Desire'd tags |
3608
|
8808
|
50
|
|
|
|
13994
|
$found = 1 if $index == 0; |
3609
|
8808
|
|
|
|
|
11583
|
last; |
3610
|
|
|
|
|
|
|
} |
3611
|
85396
|
100
|
66
|
|
|
245019
|
if ($subDoc) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3612
|
|
|
|
|
|
|
# handle SubDoc tags specially to cache tag keys for faster |
3613
|
|
|
|
|
|
|
# processing when there are a large number of sub-documents |
3614
|
|
|
|
|
|
|
# - get document number from the tag groups if specified, |
3615
|
|
|
|
|
|
|
# otherwise we are looping through all documents for this tag |
3616
|
285
|
50
|
0
|
|
|
659
|
my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum; |
3617
|
|
|
|
|
|
|
# make fast lookup for keys of this tag with specified groups other than doc group |
3618
|
|
|
|
|
|
|
# (similar to code in InsertTagValues(), but this is case-sensitive) |
3619
|
285
|
|
|
|
|
407
|
my $cacheTag = $cache{$reqTag}; |
3620
|
285
|
50
|
|
|
|
468
|
unless ($cacheTag) { |
3621
|
285
|
|
|
|
|
656
|
$cacheTag = $cache{$reqTag} = [ ]; |
3622
|
285
|
|
|
|
|
353
|
my $reqGroup; |
3623
|
285
|
50
|
|
|
|
1218
|
$reqTag =~ s/^(.*):// and $reqGroup = $1; |
3624
|
285
|
|
|
|
|
445
|
my ($i, $key, @keys); |
3625
|
|
|
|
|
|
|
# build list of tag keys in order of precedence |
3626
|
285
|
|
50
|
|
|
940
|
for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) { |
3627
|
285
|
50
|
|
|
|
569
|
push @keys, $key if defined $$rawValue{$key}; |
3628
|
285
|
50
|
|
|
|
511
|
last if $i <= 0; |
3629
|
0
|
|
|
|
|
0
|
$key = "$reqTag ($i)"; |
3630
|
|
|
|
|
|
|
} |
3631
|
285
|
50
|
|
|
|
703
|
@keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup; |
3632
|
285
|
50
|
|
|
|
559
|
if (@keys) { |
3633
|
0
|
|
|
|
|
0
|
my $ex = $$self{TAG_EXTRA}; |
3634
|
|
|
|
|
|
|
# loop through tags in reverse order of precedence so the higher |
3635
|
|
|
|
|
|
|
# priority tag will win in the case of duplicates within a doc |
3636
|
0
|
0
|
0
|
|
|
0
|
$$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys; |
3637
|
|
|
|
|
|
|
} |
3638
|
|
|
|
|
|
|
} |
3639
|
|
|
|
|
|
|
# (set $reqTag to a bogus key if not found) |
3640
|
285
|
|
33
|
|
|
878
|
$reqTag = $$cacheTag[$doc] || "$reqTag (0)"; |
3641
|
|
|
|
|
|
|
} elsif ($reqTag =~ /^(.*):(.+)/) { |
3642
|
26525
|
|
|
|
|
59264
|
my ($reqGroup, $name) = ($1, $2); |
3643
|
26525
|
100
|
100
|
|
|
48131
|
if ($reqGroup eq 'Composite' and $notBuilt{$name}) { |
3644
|
|
|
|
|
|
|
# defer only until all other tags are built if |
3645
|
|
|
|
|
|
|
# we are inhibiting based on another Composite tag |
3646
|
2076
|
100
|
100
|
|
|
7030
|
unless ($$inhibit{$index} and $allBuilt) { |
3647
|
1640
|
|
|
|
|
2776
|
push @deferredTags, $tag; |
3648
|
1640
|
|
|
|
|
5149
|
next COMPOSITE_TAG; |
3649
|
|
|
|
|
|
|
} |
3650
|
|
|
|
|
|
|
} |
3651
|
|
|
|
|
|
|
# (CAREFUL! keys may not be sequential if one was deleted) |
3652
|
24885
|
|
|
|
|
29012
|
my ($i, $key, @keys); |
3653
|
24885
|
|
100
|
|
|
66784
|
for ($key=$name, $i=$$self{DUPL_TAG}{$name} || 0; ; --$i) { |
3654
|
25524
|
100
|
|
|
|
48474
|
push @keys, $key if defined $$rawValue{$key}; |
3655
|
25524
|
100
|
|
|
|
41098
|
last if $i <= 0; |
3656
|
639
|
|
|
|
|
1629
|
$key = "$name ($i)"; |
3657
|
|
|
|
|
|
|
} |
3658
|
|
|
|
|
|
|
# find first matching tag |
3659
|
24885
|
|
|
|
|
46518
|
$key = $self->GroupMatches($reqGroup, \@keys); |
3660
|
24885
|
|
66
|
|
|
69226
|
$reqTag = $key || "$name (0)"; |
3661
|
|
|
|
|
|
|
} elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) { |
3662
|
|
|
|
|
|
|
# calculate this tag later if it relies on another |
3663
|
|
|
|
|
|
|
# Composite tag which hasn't been calculated yet |
3664
|
4883
|
|
|
|
|
7280
|
push @deferredTags, $tag; |
3665
|
4883
|
|
|
|
|
10547
|
next COMPOSITE_TAG; |
3666
|
|
|
|
|
|
|
} |
3667
|
78873
|
100
|
|
|
|
151737
|
if (defined $$rawValue{$reqTag}) { |
|
|
100
|
|
|
|
|
|
3668
|
15739
|
100
|
|
|
|
21507
|
if ($$inhibit{$index}) { |
3669
|
66
|
|
|
|
|
158
|
$found = 0; |
3670
|
66
|
|
|
|
|
126
|
last; |
3671
|
|
|
|
|
|
|
} else { |
3672
|
15673
|
|
|
|
|
18062
|
$found = 1; |
3673
|
|
|
|
|
|
|
} |
3674
|
|
|
|
|
|
|
} elsif ($$require{$index}) { |
3675
|
24130
|
|
|
|
|
28220
|
$found = 0; |
3676
|
24130
|
|
|
|
|
29229
|
last; # don't continue since we require this tag |
3677
|
|
|
|
|
|
|
} |
3678
|
54677
|
|
|
|
|
92449
|
$tagKey{$index} = $reqTag; |
3679
|
|
|
|
|
|
|
} |
3680
|
33004
|
50
|
|
|
|
65172
|
if ($docNum) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3681
|
0
|
0
|
|
|
|
0
|
if ($found) { |
3682
|
0
|
|
|
|
|
0
|
$$self{DOC_NUM} = $docNum; |
3683
|
|
|
|
|
|
|
# save pointers to all used tag keys |
3684
|
0
|
|
|
|
|
0
|
foreach (keys %tagKey) { |
3685
|
0
|
0
|
|
|
|
0
|
$$compKeys{$_} or $$compKeys{$_} = [ ]; |
3686
|
0
|
|
|
|
|
0
|
push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; |
|
0
|
|
|
|
|
0
|
|
3687
|
|
|
|
|
|
|
} |
3688
|
0
|
|
|
|
|
0
|
$self->FoundTag($tagInfo, \%tagKey); |
3689
|
0
|
|
|
|
|
0
|
delete $$self{DOC_NUM}; |
3690
|
|
|
|
|
|
|
} |
3691
|
0
|
0
|
|
|
|
0
|
next if ++$docNum <= $$self{DOC_COUNT}; |
3692
|
0
|
|
|
|
|
0
|
last; |
3693
|
|
|
|
|
|
|
} elsif ($found) { |
3694
|
5119
|
|
|
|
|
9031
|
delete $notBuilt{$tagName}; # this tag is OK to build now |
3695
|
|
|
|
|
|
|
# keep track of all Require'd tag keys |
3696
|
5119
|
|
|
|
|
15512
|
foreach (keys %tagKey) { |
3697
|
|
|
|
|
|
|
# only tag keys with same name as a Composite tag |
3698
|
|
|
|
|
|
|
# can be replaced (also eliminates keys with |
3699
|
|
|
|
|
|
|
# instance numbers which can't be replaced either) |
3700
|
22715
|
100
|
|
|
|
41745
|
next unless $compositeID{$tagKey{$_}}; |
3701
|
|
|
|
|
|
|
} |
3702
|
|
|
|
|
|
|
# save pointers to all used tag keys |
3703
|
5119
|
|
|
|
|
10225
|
foreach (keys %tagKey) { |
3704
|
22715
|
100
|
|
|
|
40877
|
$$compKeys{$_} or $$compKeys{$_} = [ ]; |
3705
|
22715
|
|
|
|
|
23770
|
push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; |
|
22715
|
|
|
|
|
68022
|
|
3706
|
|
|
|
|
|
|
} |
3707
|
|
|
|
|
|
|
# save reference to tag key lookup as value for Composite tag |
3708
|
5119
|
|
|
|
|
12600
|
my $key = $self->FoundTag($tagInfo, \%tagKey); |
3709
|
|
|
|
|
|
|
} elsif (not defined $found) { |
3710
|
3689
|
|
|
|
|
6757
|
delete $notBuilt{$tagName}; # tag can't be built anyway |
3711
|
|
|
|
|
|
|
} |
3712
|
33004
|
100
|
|
|
|
77657
|
last unless $subDoc; |
3713
|
|
|
|
|
|
|
# don't process sub-documents if there is no chance to build this tag |
3714
|
|
|
|
|
|
|
# (can be very time-consuming if there are many docs) |
3715
|
195
|
100
|
|
|
|
343
|
if (%$require) { |
3716
|
165
|
|
|
|
|
420
|
foreach (keys %$require) { |
3717
|
165
|
|
|
|
|
295
|
my $reqTag = $$require{$_}; |
3718
|
165
|
|
|
|
|
492
|
$reqTag =~ s/.*://; |
3719
|
165
|
50
|
|
|
|
612
|
next COMPOSITE_TAG unless defined $$rawValue{$reqTag}; |
3720
|
|
|
|
|
|
|
} |
3721
|
0
|
|
|
|
|
0
|
$docNum = 1; # go ahead and process the 1st sub-document |
3722
|
|
|
|
|
|
|
} else { |
3723
|
30
|
50
|
|
|
|
110
|
my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire; |
|
30
|
|
|
|
|
95
|
|
3724
|
|
|
|
|
|
|
# at least one of the specified desire tags must exist |
3725
|
30
|
|
|
|
|
2861
|
foreach (@try) { |
3726
|
60
|
50
|
|
|
|
187
|
my $desTag = $$desire{$_} or next; |
3727
|
60
|
|
|
|
|
224
|
$desTag =~ s/.*://; |
3728
|
60
|
50
|
|
|
|
176
|
defined $$rawValue{$desTag} and $docNum = 1, last; |
3729
|
|
|
|
|
|
|
} |
3730
|
30
|
50
|
|
|
|
154
|
last unless $docNum; |
3731
|
|
|
|
|
|
|
} |
3732
|
|
|
|
|
|
|
} |
3733
|
|
|
|
|
|
|
} |
3734
|
2195
|
100
|
|
|
|
5277
|
last unless @deferredTags; |
3735
|
1693
|
100
|
|
|
|
4200
|
if (@deferredTags == @tagList) { |
3736
|
436
|
50
|
|
|
|
1248
|
if ($allBuilt) { |
3737
|
|
|
|
|
|
|
# everything was deferred in the last pass, |
3738
|
|
|
|
|
|
|
# must be a circular dependency |
3739
|
0
|
|
|
|
|
0
|
warn "Circular dependency in Composite tags\n"; |
3740
|
0
|
|
|
|
|
0
|
last; |
3741
|
|
|
|
|
|
|
} |
3742
|
436
|
|
|
|
|
861
|
$allBuilt = 1; # try once more, ignoring Composite Inhibit tags |
3743
|
|
|
|
|
|
|
} |
3744
|
1693
|
|
|
|
|
10030
|
@tagList = @deferredTags; # calculate deferred tags now |
3745
|
|
|
|
|
|
|
} |
3746
|
502
|
|
|
|
|
1842
|
delete $$self{BuildingComposite}; |
3747
|
|
|
|
|
|
|
} |
3748
|
|
|
|
|
|
|
|
3749
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3750
|
|
|
|
|
|
|
# Get reference to Composite tag info hash |
3751
|
|
|
|
|
|
|
# Inputs: 0) case-sensitive Composite tag name |
3752
|
|
|
|
|
|
|
# Returns: tagInfo hash or undef |
3753
|
|
|
|
|
|
|
sub GetCompositeTagInfo($) |
3754
|
|
|
|
|
|
|
{ |
3755
|
11
|
|
|
11
|
0
|
25
|
my $tag = shift; |
3756
|
11
|
50
|
|
|
|
52
|
return undef unless $compositeID{$tag}; |
3757
|
11
|
|
|
|
|
50
|
return $Image::ExifTool::Composite{$compositeID{$tag}[0]}; |
3758
|
|
|
|
|
|
|
} |
3759
|
|
|
|
|
|
|
|
3760
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3761
|
|
|
|
|
|
|
# Get tag name (removes copy index) |
3762
|
|
|
|
|
|
|
# Inputs: 0) Tag key |
3763
|
|
|
|
|
|
|
# Returns: Tag name |
3764
|
|
|
|
|
|
|
sub GetTagName($) |
3765
|
|
|
|
|
|
|
{ |
3766
|
16704
|
|
|
16704
|
1
|
19760
|
local $_; |
3767
|
16704
|
|
|
|
|
33251
|
$_[0] =~ /^(\S+)/; |
3768
|
16704
|
|
|
|
|
38929
|
return $1; |
3769
|
|
|
|
|
|
|
} |
3770
|
|
|
|
|
|
|
|
3771
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3772
|
|
|
|
|
|
|
# Get list of shortcuts |
3773
|
|
|
|
|
|
|
# Returns: Shortcut list (sorted alphabetically) |
3774
|
|
|
|
|
|
|
sub GetShortcuts() |
3775
|
|
|
|
|
|
|
{ |
3776
|
0
|
|
|
0
|
1
|
0
|
local $_; |
3777
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Shortcuts; |
3778
|
0
|
|
|
|
|
0
|
return sort keys %Image::ExifTool::Shortcuts::Main; |
3779
|
|
|
|
|
|
|
} |
3780
|
|
|
|
|
|
|
|
3781
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3782
|
|
|
|
|
|
|
# Get file type for specified extension |
3783
|
|
|
|
|
|
|
# Inputs: 0) file name or extension (case is not significant), |
3784
|
|
|
|
|
|
|
# or FileType value if a description is requested |
3785
|
|
|
|
|
|
|
# 1) flag to return long description instead of type ('0' to return any recognized type) |
3786
|
|
|
|
|
|
|
# Returns: File type (or desc) or undef if extension not supported or if |
3787
|
|
|
|
|
|
|
# description is the same as the input FileType. In list context, |
3788
|
|
|
|
|
|
|
# may return more than one file type if the file may be different formats. |
3789
|
|
|
|
|
|
|
# Returns list of all supported extensions if no file specified |
3790
|
|
|
|
|
|
|
sub GetFileType(;$$) |
3791
|
|
|
|
|
|
|
{ |
3792
|
943
|
|
|
943
|
1
|
1493
|
local $_; |
3793
|
943
|
|
|
|
|
2135
|
my ($file, $desc) = @_; |
3794
|
943
|
50
|
|
|
|
2281
|
unless (defined $file) { |
3795
|
0
|
|
|
|
|
0
|
my @types; |
3796
|
0
|
0
|
0
|
|
|
0
|
if (defined $desc and $desc eq '0') { |
3797
|
|
|
|
|
|
|
# return all recognized types |
3798
|
0
|
|
|
|
|
0
|
@types = sort keys %fileTypeLookup; |
3799
|
|
|
|
|
|
|
} else { |
3800
|
|
|
|
|
|
|
# return all supported types |
3801
|
0
|
|
|
|
|
0
|
foreach (sort keys %fileTypeLookup) { |
3802
|
0
|
|
|
|
|
0
|
my $module = $moduleName{$_}; |
3803
|
0
|
0
|
|
|
|
0
|
$module = $moduleName{$fileTypeLookup{$_}} unless defined $module; |
3804
|
0
|
0
|
0
|
|
|
0
|
push @types, $_ unless defined $module and $module eq '0'; |
3805
|
|
|
|
|
|
|
} |
3806
|
|
|
|
|
|
|
} |
3807
|
0
|
|
|
|
|
0
|
return @types; |
3808
|
|
|
|
|
|
|
} |
3809
|
943
|
|
|
|
|
1715
|
my ($fileType, $subType); |
3810
|
943
|
|
|
|
|
1816
|
my $fileExt = GetFileExtension($file); |
3811
|
943
|
100
|
|
|
|
2495
|
unless ($fileExt) { |
3812
|
66
|
50
|
|
|
|
231
|
if ($file =~ s/ \((.*)\)$//) { |
3813
|
0
|
|
|
|
|
0
|
$subType = $1; |
3814
|
0
|
|
|
|
|
0
|
$fileExt = GetFileExtension($file); |
3815
|
|
|
|
|
|
|
} |
3816
|
66
|
50
|
|
|
|
225
|
$fileExt = uc($file) unless $fileExt; |
3817
|
|
|
|
|
|
|
} |
3818
|
943
|
100
|
|
|
|
3103
|
$fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type |
3819
|
943
|
|
100
|
|
|
5874
|
$fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType; |
3820
|
|
|
|
|
|
|
# return description if specified |
3821
|
|
|
|
|
|
|
# (allow input $file to be a FileType for this purpose) |
3822
|
943
|
50
|
33
|
|
|
5126
|
if ($desc) { |
|
|
100
|
66
|
|
|
|
|
3823
|
0
|
0
|
|
|
|
0
|
if ($fileType) { |
3824
|
0
|
0
|
0
|
|
|
0
|
if ($static_vars{OverrideFileDescription} and $static_vars{OverrideFileDescription}{$fileExt}) { |
3825
|
0
|
|
|
|
|
0
|
$desc = $static_vars{OverrideFileDescription}{$fileExt}; |
3826
|
|
|
|
|
|
|
} else { |
3827
|
0
|
|
|
|
|
0
|
$desc = $$fileType[1]; |
3828
|
|
|
|
|
|
|
} |
3829
|
|
|
|
|
|
|
} else { |
3830
|
0
|
|
|
|
|
0
|
$desc = $fileDescription{$file}; |
3831
|
|
|
|
|
|
|
} |
3832
|
0
|
0
|
|
|
|
0
|
$desc .= ", $subType" if $subType; |
3833
|
0
|
|
|
|
|
0
|
return $desc; |
3834
|
|
|
|
|
|
|
} elsif ($fileType and (not defined $desc or $desc ne '0')) { |
3835
|
|
|
|
|
|
|
# return only supported file types |
3836
|
894
|
|
|
|
|
2537
|
my $mod = $moduleName{$$fileType[0]}; |
3837
|
894
|
50
|
66
|
|
|
3369
|
undef $fileType if defined $mod and $mod eq '0'; |
3838
|
|
|
|
|
|
|
} |
3839
|
943
|
100
|
|
|
|
2237
|
$fileType or return (); |
3840
|
894
|
|
|
|
|
1581
|
$fileType = $$fileType[0]; # get file type (or list of types) |
3841
|
894
|
100
|
|
|
|
2263
|
if (wantarray) { |
|
|
50
|
|
|
|
|
|
3842
|
668
|
100
|
|
|
|
1830
|
return @$fileType if ref $fileType eq 'ARRAY'; |
3843
|
|
|
|
|
|
|
} elsif ($fileType) { |
3844
|
226
|
50
|
|
|
|
702
|
$fileType = $fileExt if ref $fileType eq 'ARRAY'; |
3845
|
|
|
|
|
|
|
} |
3846
|
890
|
|
|
|
|
2377
|
return $fileType; |
3847
|
|
|
|
|
|
|
} |
3848
|
|
|
|
|
|
|
|
3849
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3850
|
|
|
|
|
|
|
# Return true if we can write the specified file type |
3851
|
|
|
|
|
|
|
# Inputs: 0) file name or ext |
3852
|
|
|
|
|
|
|
# Returns: true if writable, 0 if not writable, undef if unrecognized |
3853
|
|
|
|
|
|
|
sub CanWrite($) |
3854
|
|
|
|
|
|
|
{ |
3855
|
0
|
|
|
0
|
1
|
0
|
local $_; |
3856
|
0
|
0
|
|
|
|
0
|
my $file = shift or return undef; |
3857
|
0
|
0
|
|
|
|
0
|
my ($type) = GetFileType($file) or return undef; |
3858
|
0
|
0
|
|
|
|
0
|
if ($noWriteFile{$type}) { |
3859
|
|
|
|
|
|
|
# can't write TIFF files with certain extensions (various RAW formats) |
3860
|
0
|
|
0
|
|
|
0
|
my $ext = GetFileExtension($file) || uc($file); |
3861
|
0
|
0
|
|
|
|
0
|
return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext; |
|
0
|
0
|
|
|
|
0
|
|
3862
|
|
|
|
|
|
|
} |
3863
|
0
|
0
|
|
|
|
0
|
unless (%writeTypes) { |
3864
|
0
|
|
|
|
|
0
|
$writeTypes{$_} = 1 foreach @writeTypes; |
3865
|
|
|
|
|
|
|
} |
3866
|
0
|
|
|
|
|
0
|
return $writeTypes{$type}; |
3867
|
|
|
|
|
|
|
} |
3868
|
|
|
|
|
|
|
|
3869
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3870
|
|
|
|
|
|
|
# Return true if we can create the specified file type |
3871
|
|
|
|
|
|
|
# Inputs: 0) file name or ext |
3872
|
|
|
|
|
|
|
# Returns: true if creatable, 0 if not writable, undef if unrecognized |
3873
|
|
|
|
|
|
|
sub CanCreate($) |
3874
|
|
|
|
|
|
|
{ |
3875
|
23
|
|
|
23
|
1
|
49
|
local $_; |
3876
|
23
|
50
|
|
|
|
77
|
my $file = shift or return undef; |
3877
|
23
|
|
33
|
|
|
112
|
my $ext = GetFileExtension($file) || uc($file); |
3878
|
23
|
50
|
|
|
|
96
|
my $type = GetFileType($file) or return undef; |
3879
|
23
|
50
|
33
|
|
|
172
|
return 1 if $createTypes{$ext} or $createTypes{$type}; |
3880
|
0
|
|
|
|
|
0
|
return 0; |
3881
|
|
|
|
|
|
|
} |
3882
|
|
|
|
|
|
|
|
3883
|
|
|
|
|
|
|
#============================================================================== |
3884
|
|
|
|
|
|
|
# Functions below this are not part of the public API |
3885
|
|
|
|
|
|
|
|
3886
|
|
|
|
|
|
|
# Initialize member variables for reading or writing a new file |
3887
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3888
|
|
|
|
|
|
|
sub Init($) |
3889
|
|
|
|
|
|
|
{ |
3890
|
763
|
|
|
763
|
0
|
1393
|
local $_; |
3891
|
763
|
|
|
|
|
1469
|
my $self = shift; |
3892
|
|
|
|
|
|
|
# delete all DataMember variables (lower-case names) |
3893
|
763
|
|
|
|
|
5863
|
foreach (keys %$self) { |
3894
|
22952
|
100
|
|
|
|
41258
|
/[a-z]/ and delete $$self{$_}; |
3895
|
|
|
|
|
|
|
} |
3896
|
763
|
|
|
|
|
2716
|
undef %static_vars; # clear all static variables |
3897
|
763
|
|
|
|
|
1928
|
delete $$self{FOUND_TAGS}; # list of found tags |
3898
|
763
|
|
|
|
|
1424
|
delete $$self{EXIF_DATA}; # the EXIF data block |
3899
|
763
|
|
|
|
|
1482
|
delete $$self{EXIF_POS}; # EXIF position in file |
3900
|
763
|
|
|
|
|
1521
|
delete $$self{FIRST_EXIF_POS}; # position of first EXIF in file |
3901
|
763
|
|
|
|
|
1288
|
delete $$self{HTML_DUMP}; # html dump information |
3902
|
763
|
|
|
|
|
1197
|
delete $$self{SET_GROUP0}; # group0 name override |
3903
|
763
|
|
|
|
|
1212
|
delete $$self{SET_GROUP1}; # group1 name override |
3904
|
763
|
|
|
|
|
1241
|
delete $$self{DOC_NUM}; # current embedded document number |
3905
|
763
|
|
|
|
|
1724
|
$$self{DOC_COUNT} = 0; # count of embedded documents processed |
3906
|
763
|
|
|
|
|
1650
|
$$self{BASE} = 0; # base for offsets from start of file |
3907
|
763
|
|
|
|
|
3287
|
$$self{FILE_ORDER} = { }; # * hash of tag order in file ('*' = based on tag key) |
3908
|
763
|
|
|
|
|
4162
|
$$self{VALUE} = { }; # * hash of raw tag values |
3909
|
763
|
|
|
|
|
2252
|
$$self{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags |
3910
|
763
|
|
|
|
|
2161
|
$$self{RATIONAL} = { }; # * hash of original rational components |
3911
|
763
|
|
|
|
|
3505
|
$$self{TAG_INFO} = { }; # * hash of tag information |
3912
|
763
|
|
|
|
|
3795
|
$$self{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names) |
3913
|
763
|
|
|
|
|
2102
|
$$self{PRIORITY} = { }; # * priority of current tags |
3914
|
763
|
|
|
|
|
1749
|
$$self{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags |
3915
|
763
|
|
|
|
|
2132
|
$$self{PROCESSED} = { }; # hash of processed directory start positions |
3916
|
763
|
|
|
|
|
1656
|
$$self{DIR_COUNT} = { }; # count various types of directories |
3917
|
763
|
|
|
|
|
1670
|
$$self{DUPL_TAG} = { }; # last-used index for duplicate-tag keys |
3918
|
763
|
|
|
|
|
1491
|
$$self{WARNED_ONCE}= { }; # WarnOnce() warnings already issued |
3919
|
763
|
|
|
|
|
1539
|
$$self{WRITTEN} = { }; # list of tags written (selected tags only) |
3920
|
763
|
|
|
|
|
1585
|
$$self{FORCE_WRITE}= { }; # ForceWrite lookup (set from ForceWrite tag) |
3921
|
763
|
|
|
|
|
1816
|
$$self{FOUND_DIR} = { }; # hash of directory names found in file |
3922
|
763
|
|
|
|
|
5660
|
$$self{COMP_KEYS} = { }; # lookup for tag keys used in Composite tags |
3923
|
763
|
|
|
|
|
1727
|
$$self{PATH} = [ ]; # current subdirectory path in file when reading |
3924
|
763
|
|
|
|
|
1737
|
$$self{NUM_FOUND} = 0; # total number of tags found (incl. duplicates) |
3925
|
763
|
|
|
|
|
1439
|
$$self{CHANGED} = 0; # number of tags changed (writer only) |
3926
|
763
|
|
|
|
|
1494
|
$$self{INDENT} = ' '; # initial indent for verbose messages |
3927
|
763
|
|
|
|
|
1439
|
$$self{PRIORITY_DIR} = ''; # the priority directory name |
3928
|
763
|
|
|
|
|
2282
|
$$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories |
3929
|
763
|
|
|
|
|
1714
|
$$self{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...) |
3930
|
763
|
|
|
|
|
1561
|
$$self{FMT_EXPR} = undef; # current advanced formatting expression |
3931
|
763
|
|
|
|
|
1517
|
$$self{Make} = ''; # camera make |
3932
|
763
|
|
|
|
|
1459
|
$$self{Model} = ''; # camera model |
3933
|
763
|
|
|
|
|
1447
|
$$self{CameraType} = ''; # Olympus camera type |
3934
|
763
|
|
|
|
|
1484
|
$$self{FileType} = ''; # identified file type |
3935
|
763
|
50
|
|
|
|
2325
|
if ($self->Options('HtmlDump')) { |
3936
|
0
|
|
|
|
|
0
|
require Image::ExifTool::HtmlDump; |
3937
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP} = new Image::ExifTool::HtmlDump; |
3938
|
|
|
|
|
|
|
} |
3939
|
|
|
|
|
|
|
# make sure our TextOut is a file reference |
3940
|
763
|
50
|
|
|
|
2961
|
$$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut}; |
3941
|
|
|
|
|
|
|
} |
3942
|
|
|
|
|
|
|
|
3943
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3944
|
|
|
|
|
|
|
# Combine information from a list of info hashes |
3945
|
|
|
|
|
|
|
# Unless Duplicates is enabled, first entry found takes priority |
3946
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1-N) list of info hash references |
3947
|
|
|
|
|
|
|
# Returns: Combined information hash reference |
3948
|
|
|
|
|
|
|
sub CombineInfo($;@) |
3949
|
|
|
|
|
|
|
{ |
3950
|
2
|
|
|
2
|
0
|
933
|
local $_; |
3951
|
2
|
|
|
|
|
4
|
my $self = shift; |
3952
|
2
|
|
|
|
|
3
|
my (%combinedInfo, $info, $tag, %haveInfo); |
3953
|
|
|
|
|
|
|
|
3954
|
2
|
50
|
|
|
|
6
|
if ($$self{OPTIONS}{Duplicates}) { |
3955
|
0
|
|
|
|
|
0
|
while ($info = shift) { |
3956
|
0
|
|
|
|
|
0
|
foreach $tag (keys %$info) { |
3957
|
0
|
|
|
|
|
0
|
$combinedInfo{$tag} = $$info{$tag}; |
3958
|
|
|
|
|
|
|
} |
3959
|
|
|
|
|
|
|
} |
3960
|
|
|
|
|
|
|
} else { |
3961
|
2
|
|
|
|
|
8
|
while ($info = shift) { |
3962
|
4
|
|
|
|
|
35
|
foreach $tag (keys %$info) { |
3963
|
266
|
|
|
|
|
339
|
my $tagName = GetTagName($tag); |
3964
|
266
|
100
|
|
|
|
412
|
next if $haveInfo{$tagName}; |
3965
|
252
|
|
|
|
|
312
|
$haveInfo{$tagName} = 1; |
3966
|
252
|
|
|
|
|
371
|
$combinedInfo{$tag} = $$info{$tag}; |
3967
|
|
|
|
|
|
|
} |
3968
|
|
|
|
|
|
|
} |
3969
|
|
|
|
|
|
|
} |
3970
|
2
|
|
|
|
|
28
|
return \%combinedInfo; |
3971
|
|
|
|
|
|
|
} |
3972
|
|
|
|
|
|
|
|
3973
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3974
|
|
|
|
|
|
|
# Get tag table name |
3975
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3976
|
|
|
|
|
|
|
# Returns: Table name if available, otherwise '' |
3977
|
|
|
|
|
|
|
sub GetTableName($$) |
3978
|
|
|
|
|
|
|
{ |
3979
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag) = @_; |
3980
|
0
|
0
|
|
|
|
0
|
my $tagInfo = $$self{TAG_INFO}{$tag} or return ''; |
3981
|
0
|
|
|
|
|
0
|
return $$tagInfo{Table}{SHORT_NAME}; |
3982
|
|
|
|
|
|
|
} |
3983
|
|
|
|
|
|
|
|
3984
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3985
|
|
|
|
|
|
|
# Get tag index number |
3986
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3987
|
|
|
|
|
|
|
# Returns: Table index number, or undefined if this tag isn't indexed |
3988
|
|
|
|
|
|
|
sub GetTagIndex($$) |
3989
|
|
|
|
|
|
|
{ |
3990
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag) = @_; |
3991
|
0
|
0
|
|
|
|
0
|
my $tagInfo = $$self{TAG_INFO}{$tag} or return undef; |
3992
|
0
|
|
|
|
|
0
|
return $$tagInfo{Index}; |
3993
|
|
|
|
|
|
|
} |
3994
|
|
|
|
|
|
|
|
3995
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3996
|
|
|
|
|
|
|
# Find value for specified tag |
3997
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1) |
3998
|
|
|
|
|
|
|
# Returns: value or undef |
3999
|
|
|
|
|
|
|
sub FindValue($$$) |
4000
|
|
|
|
|
|
|
{ |
4001
|
72
|
|
|
72
|
0
|
131
|
my ($et, $tag, $grp) = @_; |
4002
|
72
|
|
|
|
|
91
|
my ($i, $val); |
4003
|
72
|
|
|
|
|
102
|
my $value = $$et{VALUE}; |
4004
|
72
|
|
|
|
|
97
|
for ($i=0; ; ++$i) { |
4005
|
144
|
100
|
|
|
|
339
|
my $key = $tag . ($i ? " ($i)" : ''); |
4006
|
144
|
100
|
|
|
|
283
|
last unless defined $$value{$key}; |
4007
|
142
|
100
|
|
|
|
225
|
if ($et->GetGroup($key, 1) eq $grp) { |
4008
|
70
|
|
|
|
|
117
|
$val = $$value{$key}; |
4009
|
70
|
|
|
|
|
89
|
last; |
4010
|
|
|
|
|
|
|
} |
4011
|
|
|
|
|
|
|
} |
4012
|
72
|
|
|
|
|
156
|
return $val; |
4013
|
|
|
|
|
|
|
} |
4014
|
|
|
|
|
|
|
|
4015
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4016
|
|
|
|
|
|
|
# Get tag key for next existing tag |
4017
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name |
4018
|
|
|
|
|
|
|
# Returns: Key of next existing tag, or undef if no more |
4019
|
|
|
|
|
|
|
# Notes: This routine is provided for iterating through duplicate tags in the |
4020
|
|
|
|
|
|
|
# ValueConv of Composite tags. |
4021
|
|
|
|
|
|
|
sub NextTagKey($$) |
4022
|
|
|
|
|
|
|
{ |
4023
|
18
|
|
|
18
|
0
|
62
|
my ($self, $tag) = @_; |
4024
|
18
|
50
|
|
|
|
75
|
my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1; |
4025
|
18
|
|
|
|
|
69
|
$tag = "$tag ($i)"; |
4026
|
18
|
50
|
|
|
|
60
|
return $tag if defined $$self{VALUE}{$tag}; |
4027
|
18
|
|
|
|
|
328
|
return undef; |
4028
|
|
|
|
|
|
|
} |
4029
|
|
|
|
|
|
|
|
4030
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4031
|
|
|
|
|
|
|
# Split file name into directory and name parts |
4032
|
|
|
|
|
|
|
# Inptus: 0) file name |
4033
|
|
|
|
|
|
|
# Returns: 0) directory, 1) filename |
4034
|
|
|
|
|
|
|
sub SplitFileName($) |
4035
|
|
|
|
|
|
|
{ |
4036
|
469
|
|
|
469
|
0
|
955
|
my $file = shift; |
4037
|
469
|
|
|
|
|
980
|
my ($dir, $name); |
4038
|
469
|
50
|
|
|
|
943
|
if (eval { require File::Basename }) { |
|
469
|
|
|
|
|
3803
|
|
4039
|
469
|
|
|
|
|
22945
|
$dir = File::Basename::dirname($file); |
4040
|
469
|
|
|
|
|
9938
|
$name = File::Basename::basename($file); |
4041
|
|
|
|
|
|
|
} else { |
4042
|
0
|
|
|
|
|
0
|
($name = $file) =~ tr/\\/\//; |
4043
|
|
|
|
|
|
|
# remove path |
4044
|
0
|
0
|
|
|
|
0
|
$dir = length($1) ? $1 : '/' if $name =~ s/(.*)\///; |
|
|
0
|
|
|
|
|
|
4045
|
|
|
|
|
|
|
} |
4046
|
469
|
|
|
|
|
1680
|
return ($dir, $name); |
4047
|
|
|
|
|
|
|
} |
4048
|
|
|
|
|
|
|
|
4049
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4050
|
|
|
|
|
|
|
# Encode file name for calls to system i/o routines |
4051
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion |
4052
|
|
|
|
|
|
|
# Returns: true if Windows Unicode routines should be used (in which case |
4053
|
|
|
|
|
|
|
# the file name will be encoded as a null-terminated UTF-16LE string) |
4054
|
|
|
|
|
|
|
sub EncodeFileName($$;$) |
4055
|
|
|
|
|
|
|
{ |
4056
|
1123
|
|
|
1123
|
0
|
2419
|
my ($self, $file, $force) = @_; |
4057
|
1123
|
|
|
|
|
2159
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
4058
|
1123
|
50
|
33
|
|
|
5267
|
if ($enc) { |
|
|
50
|
33
|
|
|
|
|
4059
|
0
|
0
|
0
|
|
|
0
|
if ($file =~ /[\x80-\xff]/ or $force) { |
4060
|
|
|
|
|
|
|
# encode for use in Windows Unicode functions if necessary |
4061
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MSWin32') { |
4062
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4063
|
0
|
0
|
|
|
|
0
|
if (eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
4064
|
|
|
|
|
|
|
# recode as UTF-16LE and add null terminator |
4065
|
0
|
|
|
|
|
0
|
$_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0"; |
4066
|
0
|
|
|
|
|
0
|
return 1; |
4067
|
|
|
|
|
|
|
} |
4068
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32API::File for Windows Unicode file support'); |
4069
|
|
|
|
|
|
|
} else { |
4070
|
|
|
|
|
|
|
# recode as UTF-8 for other platforms if necessary |
4071
|
0
|
0
|
|
|
|
0
|
$_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8'; |
4072
|
|
|
|
|
|
|
} |
4073
|
|
|
|
|
|
|
} |
4074
|
|
|
|
|
|
|
} elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) { |
4075
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
4076
|
0
|
0
|
|
|
|
0
|
if (Image::ExifTool::XMP::IsUTF8(\$file) < 0) { |
4077
|
0
|
|
|
|
|
0
|
$self->WarnOnce('FileName encoding not specified'); |
4078
|
|
|
|
|
|
|
} |
4079
|
|
|
|
|
|
|
} |
4080
|
1123
|
|
|
|
|
2885
|
return 0; |
4081
|
|
|
|
|
|
|
} |
4082
|
|
|
|
|
|
|
|
4083
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4084
|
|
|
|
|
|
|
# Modified perl open() routine to properly handle special characters in file names |
4085
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) filehandle, 2) filename, |
4086
|
|
|
|
|
|
|
# 3) mode: '<' or undef = read, '>' = write, '+<' = update |
4087
|
|
|
|
|
|
|
# Returns: true on success |
4088
|
|
|
|
|
|
|
# Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid |
4089
|
|
|
|
|
|
|
# "unopened filehandle" errors due to a change in scope of the filehandle |
4090
|
|
|
|
|
|
|
sub Open($*$;$) |
4091
|
|
|
|
|
|
|
{ |
4092
|
898
|
|
|
898
|
0
|
2746
|
my ($self, $fh, $file, $mode) = @_; |
4093
|
|
|
|
|
|
|
|
4094
|
898
|
|
|
|
|
2910
|
$file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand |
4095
|
|
|
|
|
|
|
# default to read mode ('<') unless input is a trusted pipe |
4096
|
898
|
50
|
33
|
|
|
4245
|
$mode = (($file =~ /\|$/ and $$self{TRUST_PIPE}) ? '' : '<') unless $mode; |
|
|
100
|
|
|
|
|
|
4097
|
898
|
|
|
|
|
1817
|
delete $$self{TRUST_PIPE}; |
4098
|
898
|
50
|
|
|
|
2125
|
if ($mode) { |
4099
|
898
|
50
|
|
|
|
2505
|
if ($self->EncodeFileName($file)) { |
4100
|
|
|
|
|
|
|
# handle Windows Unicode file name |
4101
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4102
|
0
|
|
|
|
|
0
|
my ($access, $create); |
4103
|
0
|
0
|
|
|
|
0
|
if ($mode eq '>') { |
4104
|
0
|
|
|
|
|
0
|
eval { |
4105
|
0
|
|
|
|
|
0
|
$access = Win32API::File::GENERIC_WRITE(); |
4106
|
0
|
|
|
|
|
0
|
$create = Win32API::File::CREATE_ALWAYS(); |
4107
|
|
|
|
|
|
|
} |
4108
|
|
|
|
|
|
|
} else { |
4109
|
0
|
|
|
|
|
0
|
eval { |
4110
|
0
|
|
|
|
|
0
|
$access = Win32API::File::GENERIC_READ(); |
4111
|
0
|
0
|
|
|
|
0
|
$access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update |
4112
|
0
|
|
|
|
|
0
|
$create = Win32API::File::OPEN_EXISTING(); |
4113
|
|
|
|
|
|
|
} |
4114
|
|
|
|
|
|
|
} |
4115
|
0
|
|
|
|
|
0
|
my $share = 0; |
4116
|
0
|
|
|
|
|
0
|
eval { |
4117
|
0
|
0
|
|
|
|
0
|
unless ($access & Win32API::File::GENERIC_WRITE()) { |
4118
|
0
|
|
|
|
|
0
|
$share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE(); |
4119
|
|
|
|
|
|
|
} |
4120
|
|
|
|
|
|
|
}; |
4121
|
0
|
|
|
|
|
0
|
my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) }; |
|
0
|
|
|
|
|
0
|
|
4122
|
0
|
0
|
|
|
|
0
|
return undef unless $wh; |
4123
|
0
|
|
|
|
|
0
|
my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) }; |
|
0
|
|
|
|
|
0
|
|
4124
|
0
|
0
|
0
|
|
|
0
|
if (not defined $fd or $fd < 0) { |
4125
|
0
|
|
|
|
|
0
|
eval { Win32API::File::CloseHandle($wh) }; |
|
0
|
|
|
|
|
0
|
|
4126
|
0
|
|
|
|
|
0
|
return undef; |
4127
|
|
|
|
|
|
|
} |
4128
|
0
|
|
|
|
|
0
|
$file = "&=$fd"; # specify file by descriptor |
4129
|
|
|
|
|
|
|
} else { |
4130
|
|
|
|
|
|
|
# add leading space to protect against leading characters like '>' |
4131
|
|
|
|
|
|
|
# in file name, and trailing "\0" to protect trailing spaces |
4132
|
898
|
|
|
|
|
2391
|
$file = " $file\0"; |
4133
|
|
|
|
|
|
|
} |
4134
|
|
|
|
|
|
|
} |
4135
|
898
|
|
|
|
|
52801
|
return open $fh, "$mode$file"; |
4136
|
|
|
|
|
|
|
} |
4137
|
|
|
|
|
|
|
|
4138
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4139
|
|
|
|
|
|
|
# Check to see if a file exists (with Windows Unicode support) |
4140
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name |
4141
|
|
|
|
|
|
|
# Returns: true if file exists |
4142
|
|
|
|
|
|
|
sub Exists($$) |
4143
|
|
|
|
|
|
|
{ |
4144
|
218
|
|
|
218
|
0
|
620
|
my ($self, $file) = @_; |
4145
|
|
|
|
|
|
|
|
4146
|
218
|
50
|
|
|
|
689
|
if ($self->EncodeFileName($file)) { |
4147
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4148
|
0
|
|
|
|
|
0
|
my $wh = eval { Win32API::File::CreateFileW($file, |
|
0
|
|
|
|
|
0
|
|
4149
|
|
|
|
|
|
|
Win32API::File::GENERIC_READ(), |
4150
|
|
|
|
|
|
|
Win32API::File::FILE_SHARE_READ(), [], |
4151
|
|
|
|
|
|
|
Win32API::File::OPEN_EXISTING(), 0, []) }; |
4152
|
0
|
0
|
|
|
|
0
|
return 0 unless $wh; |
4153
|
0
|
|
|
|
|
0
|
eval { Win32API::File::CloseHandle($wh) }; |
|
0
|
|
|
|
|
0
|
|
4154
|
|
|
|
|
|
|
} else { |
4155
|
|
|
|
|
|
|
# (named pipes already exist, but we pretend that they don't |
4156
|
|
|
|
|
|
|
# so we will be able to write them, so test with for pipe -p) |
4157
|
218
|
|
33
|
|
|
4091
|
return(-e $file and not -p $file); |
4158
|
|
|
|
|
|
|
} |
4159
|
0
|
|
|
|
|
0
|
return 1; |
4160
|
|
|
|
|
|
|
} |
4161
|
|
|
|
|
|
|
|
4162
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4163
|
|
|
|
|
|
|
# Return true if file is a directory (with Windows Unicode support) |
4164
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name |
4165
|
|
|
|
|
|
|
# Returns: true if file is a directory (false if file isn't, or doesn't exist) |
4166
|
|
|
|
|
|
|
sub IsDirectory($$) |
4167
|
|
|
|
|
|
|
{ |
4168
|
1
|
|
|
1
|
0
|
3
|
my ($et, $file) = @_; |
4169
|
1
|
50
|
|
|
|
5
|
if ($et->EncodeFileName($file)) { |
4170
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4171
|
0
|
|
|
|
|
0
|
my $attrs = eval { Win32API::File::GetFileAttributesW($file) }; |
|
0
|
|
|
|
|
0
|
|
4172
|
0
|
|
0
|
|
|
0
|
my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0; |
4173
|
0
|
0
|
0
|
|
|
0
|
return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit; |
|
|
|
0
|
|
|
|
|
4174
|
|
|
|
|
|
|
} else { |
4175
|
1
|
|
|
|
|
18
|
return -d $file; |
4176
|
|
|
|
|
|
|
} |
4177
|
0
|
|
|
|
|
0
|
return 0; |
4178
|
|
|
|
|
|
|
} |
4179
|
|
|
|
|
|
|
|
4180
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4181
|
|
|
|
|
|
|
# Get file times (Unix seconds since the epoch) |
4182
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name or ref |
4183
|
|
|
|
|
|
|
# Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error) |
4184
|
|
|
|
|
|
|
my $k32GetFileTime; |
4185
|
|
|
|
|
|
|
sub GetFileTime($$) |
4186
|
|
|
|
|
|
|
{ |
4187
|
0
|
|
|
0
|
0
|
0
|
my ($self, $file) = @_; |
4188
|
|
|
|
|
|
|
|
4189
|
|
|
|
|
|
|
# open file by name if necessary |
4190
|
0
|
0
|
|
|
|
0
|
unless (ref $file) { |
4191
|
0
|
|
|
|
|
0
|
local *FH; |
4192
|
0
|
0
|
|
|
|
0
|
unless ($self->Open(\*FH, $file)) { |
4193
|
0
|
0
|
|
|
|
0
|
if ($self->IsDirectory($file)) { |
4194
|
0
|
|
|
|
|
0
|
my @rtn = (stat $file)[8, 9, 10]; |
4195
|
0
|
0
|
|
|
|
0
|
return @rtn if defined $rtn[0]; |
4196
|
|
|
|
|
|
|
} |
4197
|
0
|
|
|
|
|
0
|
$self->Warn("GetFileTime error for '${file}'"); |
4198
|
0
|
|
|
|
|
0
|
return (); |
4199
|
|
|
|
|
|
|
} |
4200
|
0
|
|
|
|
|
0
|
$file = *FH; # (not \*FH, so *FH will be kept open until $file goes out of scope) |
4201
|
|
|
|
|
|
|
} |
4202
|
|
|
|
|
|
|
# on Windows, try to work around incorrect file times when daylight saving time is in effect |
4203
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MSWin32') { |
4204
|
0
|
0
|
|
|
|
0
|
if (not eval { require Win32::API }) { |
|
0
|
0
|
|
|
|
0
|
|
4205
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32::API for proper handling of Windows file times'); |
4206
|
0
|
|
|
|
|
0
|
} elsif (not eval { require Win32API::File }) { |
4207
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32API::File for proper handling of Windows file times'); |
4208
|
|
|
|
|
|
|
} else { |
4209
|
|
|
|
|
|
|
# get Win32 handle, needed for GetFileTime |
4210
|
0
|
|
|
|
|
0
|
my $win32Handle = eval { Win32API::File::GetOsFHandle($file) }; |
|
0
|
|
|
|
|
0
|
|
4211
|
0
|
0
|
|
|
|
0
|
unless ($win32Handle) { |
4212
|
0
|
|
|
|
|
0
|
$self->Warn("Win32API::File::GetOsFHandle returned invalid handle"); |
4213
|
0
|
|
|
|
|
0
|
return (); |
4214
|
|
|
|
|
|
|
} |
4215
|
|
|
|
|
|
|
# get FILETIME structs |
4216
|
0
|
|
|
|
|
0
|
my ($atime, $mtime, $ctime, $time); |
4217
|
0
|
|
|
|
|
0
|
$atime = $mtime = $ctime = pack 'LL', 0, 0; |
4218
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime) { |
4219
|
0
|
0
|
|
|
|
0
|
return () if defined $k32GetFileTime; |
4220
|
0
|
|
|
|
|
0
|
$k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I'); |
4221
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime) { |
4222
|
0
|
|
|
|
|
0
|
$self->Warn('Error calling Win32::API::GetFileTime'); |
4223
|
0
|
|
|
|
|
0
|
$k32GetFileTime = 0; |
4224
|
0
|
|
|
|
|
0
|
return (); |
4225
|
|
|
|
|
|
|
} |
4226
|
|
|
|
|
|
|
} |
4227
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) { |
4228
|
0
|
|
|
|
|
0
|
$self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError()); |
4229
|
0
|
|
|
|
|
0
|
return (); |
4230
|
|
|
|
|
|
|
} |
4231
|
|
|
|
|
|
|
# convert FILETIME structs to Unix seconds |
4232
|
0
|
|
|
|
|
0
|
foreach $time ($atime, $mtime, $ctime) { |
4233
|
0
|
|
|
|
|
0
|
my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct |
4234
|
|
|
|
|
|
|
# FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601 |
4235
|
|
|
|
|
|
|
# (89 leap years between 1601 and 1970) |
4236
|
0
|
|
|
|
|
0
|
$time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600); |
4237
|
|
|
|
|
|
|
} |
4238
|
0
|
|
|
|
|
0
|
return ($atime, $mtime, $ctime); |
4239
|
|
|
|
|
|
|
} |
4240
|
|
|
|
|
|
|
} |
4241
|
|
|
|
|
|
|
# other os (or Windows fallback) |
4242
|
0
|
|
|
|
|
0
|
return (stat $file)[8, 9, 10]; |
4243
|
|
|
|
|
|
|
} |
4244
|
|
|
|
|
|
|
|
4245
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4246
|
|
|
|
|
|
|
# Parse function arguments and set member variables accordingly |
4247
|
|
|
|
|
|
|
# Inputs: Same as ImageInfo() |
4248
|
|
|
|
|
|
|
# - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS |
4249
|
|
|
|
|
|
|
sub ParseArguments($;@) |
4250
|
|
|
|
|
|
|
{ |
4251
|
688
|
|
|
688
|
0
|
1249
|
my $self = shift; |
4252
|
688
|
|
|
|
|
1415
|
my $options = $$self{OPTIONS}; |
4253
|
688
|
|
|
|
|
1277
|
my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}}; |
|
688
|
|
|
|
|
11158
|
|
4254
|
688
|
|
|
|
|
2678
|
my (@exclude, $wasExcludeOpt); |
4255
|
|
|
|
|
|
|
|
4256
|
688
|
|
|
|
|
1919
|
$$self{REQUESTED_TAGS} = [ ]; |
4257
|
688
|
|
|
|
|
1848
|
$$self{REQ_TAG_LOOKUP} = { }; |
4258
|
688
|
|
|
|
|
1646
|
$$self{EXCL_TAG_LOOKUP} = { }; |
4259
|
688
|
|
|
|
|
1477
|
$$self{IO_TAG_LIST} = undef; |
4260
|
688
|
|
|
|
|
1354
|
delete $$self{EXCL_XMP_LOOKUP}; |
4261
|
|
|
|
|
|
|
|
4262
|
|
|
|
|
|
|
# handle our input arguments |
4263
|
688
|
|
|
|
|
2137
|
while (@_) { |
4264
|
1486
|
|
|
|
|
2345
|
my $arg = shift; |
4265
|
1486
|
100
|
66
|
|
|
5274
|
if (ref $arg and not overload::Method($arg, q[""])) { |
|
|
100
|
|
|
|
|
|
4266
|
153
|
100
|
100
|
|
|
5582
|
if (ref $arg eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4267
|
4
|
|
|
|
|
11
|
$$self{IO_TAG_LIST} = $arg; |
4268
|
4
|
|
|
|
|
12
|
foreach (@$arg) { |
4269
|
12
|
100
|
|
|
|
25
|
if (/^-(.*)/) { |
4270
|
2
|
|
|
|
|
7
|
push @exclude, $1; |
4271
|
|
|
|
|
|
|
} else { |
4272
|
10
|
|
|
|
|
11
|
push @{$$self{REQUESTED_TAGS}}, $_; |
|
10
|
|
|
|
|
20
|
|
4273
|
|
|
|
|
|
|
} |
4274
|
|
|
|
|
|
|
} |
4275
|
|
|
|
|
|
|
} elsif (ref $arg eq 'HASH') { |
4276
|
107
|
|
|
|
|
189
|
my $opt; |
4277
|
107
|
|
|
|
|
375
|
foreach $opt (keys %$arg) { |
4278
|
|
|
|
|
|
|
# a single new group option overrides all old group options |
4279
|
171
|
50
|
33
|
|
|
520
|
if (@oldGroupOpts and $opt =~ /^Group/) { |
4280
|
0
|
|
|
|
|
0
|
foreach (@oldGroupOpts) { |
4281
|
0
|
|
|
|
|
0
|
delete $$options{$_}; |
4282
|
|
|
|
|
|
|
} |
4283
|
0
|
|
|
|
|
0
|
undef @oldGroupOpts; |
4284
|
|
|
|
|
|
|
} |
4285
|
171
|
|
|
|
|
545
|
$self->Options($opt, $$arg{$opt}); |
4286
|
171
|
50
|
|
|
|
578
|
$opt eq 'Exclude' and $wasExcludeOpt = 1; |
4287
|
|
|
|
|
|
|
} |
4288
|
|
|
|
|
|
|
} elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) { |
4289
|
23
|
50
|
|
|
|
84
|
next if defined $$self{RAF}; |
4290
|
|
|
|
|
|
|
# convert image data from UTF-8 to character stream if necessary |
4291
|
|
|
|
|
|
|
# (patches RHEL 3 UTF8 LANG problem) |
4292
|
23
|
50
|
66
|
|
|
157
|
if (ref $arg eq 'SCALAR' and $] >= 5.006 and |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
4293
|
|
|
|
|
|
|
(eval { require Encode; Encode::is_utf8($$arg) } or $@)) |
4294
|
|
|
|
|
|
|
{ |
4295
|
|
|
|
|
|
|
# repack by hand if Encode isn't available |
4296
|
0
|
0
|
|
|
|
0
|
my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg); |
|
|
0
|
|
|
|
|
|
4297
|
0
|
|
|
|
|
0
|
$arg = \$buff; |
4298
|
|
|
|
|
|
|
} |
4299
|
23
|
|
|
|
|
143
|
$$self{RAF} = new File::RandomAccess($arg); |
4300
|
|
|
|
|
|
|
# set filename to empty string to indicate that |
4301
|
|
|
|
|
|
|
# we have a file but we didn't open it |
4302
|
23
|
|
|
|
|
79
|
$$self{FILENAME} = ''; |
4303
|
|
|
|
|
|
|
} elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) { |
4304
|
19
|
|
|
|
|
38
|
$$self{RAF} = $arg; |
4305
|
19
|
|
|
|
|
45
|
$$self{FILENAME} = ''; |
4306
|
|
|
|
|
|
|
} else { |
4307
|
0
|
|
|
|
|
0
|
warn "Don't understand ImageInfo argument $arg\n"; |
4308
|
|
|
|
|
|
|
} |
4309
|
|
|
|
|
|
|
} elsif (defined $$self{FILENAME}) { |
4310
|
864
|
100
|
|
|
|
1859
|
if ($arg =~ /^-(.*)/) { |
4311
|
54
|
|
|
|
|
240
|
push @exclude, $1; |
4312
|
|
|
|
|
|
|
} else { |
4313
|
810
|
|
|
|
|
1105
|
push @{$$self{REQUESTED_TAGS}}, $arg; |
|
810
|
|
|
|
|
2231
|
|
4314
|
|
|
|
|
|
|
} |
4315
|
|
|
|
|
|
|
} else { |
4316
|
469
|
|
|
|
|
1433
|
$$self{FILENAME} = $arg; |
4317
|
|
|
|
|
|
|
} |
4318
|
|
|
|
|
|
|
} |
4319
|
|
|
|
|
|
|
# add additional requested tags to lookup |
4320
|
688
|
100
|
|
|
|
2046
|
if ($$options{RequestTags}) { |
4321
|
42
|
|
|
|
|
99
|
$$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}}; |
|
42
|
|
|
|
|
218
|
|
4322
|
|
|
|
|
|
|
} |
4323
|
|
|
|
|
|
|
# expand shortcuts in tag arguments if provided |
4324
|
688
|
100
|
|
|
|
1075
|
if (@{$$self{REQUESTED_TAGS}}) { |
|
688
|
|
|
|
|
2036
|
|
4325
|
353
|
|
|
|
|
1409
|
ExpandShortcuts($$self{REQUESTED_TAGS}); |
4326
|
|
|
|
|
|
|
# initialize lookup for requested tags |
4327
|
353
|
|
|
|
|
595
|
foreach (@{$$self{REQUESTED_TAGS}}) { |
|
353
|
|
|
|
|
1010
|
|
4328
|
863
|
50
|
|
|
|
3610
|
/^(.*:)?([-\w?*]*)#?$/ or next; |
4329
|
863
|
50
|
|
|
|
3326
|
$$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2; |
4330
|
863
|
100
|
|
|
|
2044
|
next unless $1; |
4331
|
234
|
|
|
|
|
1116
|
$$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1; |
4332
|
|
|
|
|
|
|
} |
4333
|
|
|
|
|
|
|
} |
4334
|
688
|
100
|
66
|
|
|
3362
|
if (@exclude or $wasExcludeOpt) { |
4335
|
|
|
|
|
|
|
# must add existing excluded tags |
4336
|
41
|
100
|
|
|
|
159
|
push @exclude, @{$$options{Exclude}} if $$options{Exclude}; |
|
1
|
|
|
|
|
3
|
|
4337
|
41
|
|
|
|
|
114
|
$$options{Exclude} = \@exclude; |
4338
|
|
|
|
|
|
|
# expand shortcuts in new exclude list |
4339
|
41
|
|
|
|
|
150
|
ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix) |
4340
|
|
|
|
|
|
|
} |
4341
|
|
|
|
|
|
|
# generate lookup for excluded tags |
4342
|
688
|
100
|
|
|
|
2518
|
if ($$options{Exclude}) { |
4343
|
47
|
|
|
|
|
101
|
foreach (@{$$options{Exclude}}) { |
|
47
|
|
|
|
|
939
|
|
4344
|
64
|
100
|
|
|
|
552
|
/([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc $1} = 1; |
4345
|
64
|
50
|
|
|
|
262
|
if (/(xmp-.*:[-\w]+)#?/i) { |
4346
|
0
|
0
|
|
|
|
0
|
$$self{EXCL_XMP_LOOKUP} or $$self{EXCL_XMP_LOOKUP} = { }; |
4347
|
0
|
|
|
|
|
0
|
$$self{EXCL_XMP_LOOKUP}{lc $1} = 1; |
4348
|
|
|
|
|
|
|
} |
4349
|
|
|
|
|
|
|
} |
4350
|
|
|
|
|
|
|
# exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set |
4351
|
47
|
100
|
|
|
|
210
|
undef $$options{Exclude} if $$self{TAGS_FROM_FILE}; |
4352
|
|
|
|
|
|
|
} |
4353
|
|
|
|
|
|
|
} |
4354
|
|
|
|
|
|
|
|
4355
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4356
|
|
|
|
|
|
|
# Does group name match the tag ID? |
4357
|
|
|
|
|
|
|
# Inputs: 0) tag ID, 1) group name (with "ID-" removed) |
4358
|
|
|
|
|
|
|
# Returns: true on success |
4359
|
|
|
|
|
|
|
sub IsSameID($$) |
4360
|
|
|
|
|
|
|
{ |
4361
|
2
|
|
|
2
|
0
|
6
|
my ($id, $grp) = @_; |
4362
|
2
|
100
|
|
|
|
8
|
return 1 if $grp eq $id; # decimal ID's or raw ID's |
4363
|
1
|
50
|
|
|
|
5
|
if ($id =~ /^\d+$/) { # numerical numerical ID's may be in hex |
4364
|
0
|
0
|
0
|
|
|
0
|
return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id); |
4365
|
|
|
|
|
|
|
} else { # other ID's may conform to ExifTool group name conventions |
4366
|
1
|
50
|
33
|
|
|
7
|
return 1 if $id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $id; |
|
1
|
|
|
|
|
13
|
|
4367
|
|
|
|
|
|
|
} |
4368
|
1
|
|
|
|
|
4
|
return 0; |
4369
|
|
|
|
|
|
|
} |
4370
|
|
|
|
|
|
|
|
4371
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4372
|
|
|
|
|
|
|
# Get list of tags in specified group |
4373
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys |
4374
|
|
|
|
|
|
|
# Returns: list of matching tags in list context, or first match in scalar context |
4375
|
|
|
|
|
|
|
# Notes: Group spec may contain multiple groups separated by colons, each |
4376
|
|
|
|
|
|
|
# possibly with a leading family number |
4377
|
|
|
|
|
|
|
sub GroupMatches($$$) |
4378
|
|
|
|
|
|
|
{ |
4379
|
25437
|
|
|
25437
|
0
|
38011
|
my ($self, $group, $tagList) = @_; |
4380
|
25437
|
50
|
|
|
|
41670
|
$tagList = [ $tagList ] unless ref $tagList; |
4381
|
25437
|
|
|
|
|
29262
|
my ($tag, @matches); |
4382
|
|
|
|
|
|
|
# check each group name individually (eg. "Author:1IPTC") |
4383
|
25437
|
|
|
|
|
48900
|
my @grps = split ':', $group; |
4384
|
25437
|
|
|
|
|
31609
|
my (@fmys, $g); |
4385
|
25437
|
|
|
|
|
44884
|
for ($g=0; $g<@grps; ++$g) { |
4386
|
26006
|
50
|
|
|
|
90546
|
if ($grps[$g] =~ s/^(\d*)(id-)?//i) { |
4387
|
26006
|
100
|
|
|
|
49981
|
$fmys[$g] = $1 if length $1; |
4388
|
26006
|
50
|
|
|
|
42697
|
if ($2) { |
4389
|
0
|
|
|
|
|
0
|
$fmys[$g] = 7; |
4390
|
0
|
|
|
|
|
0
|
next; # (don't convert tag ID's to lower case) |
4391
|
|
|
|
|
|
|
} |
4392
|
|
|
|
|
|
|
} |
4393
|
26006
|
|
|
|
|
41420
|
$grps[$g] = lc $grps[$g]; |
4394
|
26006
|
50
|
|
|
|
57610
|
$grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag |
4395
|
|
|
|
|
|
|
} |
4396
|
25437
|
|
|
|
|
40337
|
foreach $tag (@$tagList) { |
4397
|
15145
|
|
|
|
|
27404
|
my @groups = $self->GetGroup($tag, -1); |
4398
|
15145
|
|
|
|
|
29135
|
for ($g=0; $g<@grps; ++$g) { |
4399
|
15610
|
|
|
|
|
20533
|
my $grp = $grps[$g]; |
4400
|
15610
|
50
|
33
|
|
|
38847
|
next if $grp eq '*' or $grp eq 'all'; |
4401
|
15610
|
|
|
|
|
16701
|
my $f; |
4402
|
15610
|
100
|
|
|
|
22747
|
if (defined($f = $fmys[$g])) { |
4403
|
3
|
50
|
|
|
|
7
|
last unless defined $groups[$f]; |
4404
|
3
|
50
|
|
|
|
8
|
if ($f == 7) { |
4405
|
0
|
0
|
|
|
|
0
|
next if IsSameID($self->GetTagID($tag), $grp); |
4406
|
|
|
|
|
|
|
} else { |
4407
|
3
|
100
|
|
|
|
8
|
next if $grp eq lc $groups[$f]; |
4408
|
|
|
|
|
|
|
} |
4409
|
1
|
|
|
|
|
2
|
last; |
4410
|
|
|
|
|
|
|
} else { |
4411
|
15607
|
100
|
|
|
|
125289
|
last unless grep /^$grp$/i, @groups; |
4412
|
|
|
|
|
|
|
} |
4413
|
|
|
|
|
|
|
} |
4414
|
15145
|
100
|
|
|
|
34627
|
if ($g == @grps) { |
4415
|
4368
|
100
|
|
|
|
10538
|
return $tag unless wantarray; |
4416
|
2407
|
|
|
|
|
4996
|
push @matches, $tag; |
4417
|
|
|
|
|
|
|
} |
4418
|
|
|
|
|
|
|
} |
4419
|
23476
|
100
|
|
|
|
50506
|
return wantarray ? @matches : $matches[0]; |
4420
|
|
|
|
|
|
|
} |
4421
|
|
|
|
|
|
|
|
4422
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4423
|
|
|
|
|
|
|
# Remove specified tags from returned tag list, updating indices in other lists |
4424
|
|
|
|
|
|
|
# Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref, |
4425
|
|
|
|
|
|
|
# 4) true to include tags from hash instead of excluding |
4426
|
|
|
|
|
|
|
# Returns: nothing, but updates input lists |
4427
|
|
|
|
|
|
|
sub RemoveTagsFromList($$$$;$) |
4428
|
|
|
|
|
|
|
{ |
4429
|
69
|
|
|
69
|
0
|
108
|
local $_; |
4430
|
69
|
|
|
|
|
162
|
my ($tags, $list1, $list2, $exclude, $inv) = @_; |
4431
|
69
|
|
|
|
|
109
|
my @filteredTags; |
4432
|
|
|
|
|
|
|
|
4433
|
69
|
100
|
100
|
|
|
367
|
if (@$list1 or @$list2) { |
4434
|
6
|
|
|
|
|
24
|
while (@$tags) { |
4435
|
233
|
|
|
|
|
273
|
my $tag = pop @$tags; |
4436
|
233
|
|
|
|
|
256
|
my $i = @$tags; |
4437
|
233
|
100
|
50
|
|
|
510
|
if ($$exclude{$tag} xor $inv) { |
4438
|
|
|
|
|
|
|
# remove index of excluded tag from each list |
4439
|
154
|
100
|
|
|
|
184
|
@$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1; |
|
12
|
100
|
|
|
|
26
|
|
4440
|
154
|
100
|
|
|
|
191
|
@$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2; |
|
8245
|
100
|
|
|
|
10414
|
|
4441
|
|
|
|
|
|
|
} else { |
4442
|
79
|
|
|
|
|
179
|
unshift @filteredTags, $tag; |
4443
|
|
|
|
|
|
|
} |
4444
|
|
|
|
|
|
|
} |
4445
|
|
|
|
|
|
|
} else { |
4446
|
63
|
|
|
|
|
147
|
foreach (@$tags) { |
4447
|
6865
|
100
|
100
|
|
|
16136
|
push @filteredTags, $_ unless $$exclude{$_} xor $inv; |
4448
|
|
|
|
|
|
|
} |
4449
|
|
|
|
|
|
|
} |
4450
|
69
|
|
|
|
|
484
|
$_[0] = \@filteredTags; # update tag list |
4451
|
|
|
|
|
|
|
} |
4452
|
|
|
|
|
|
|
|
4453
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4454
|
|
|
|
|
|
|
# Set list of found tags from previously requested tags |
4455
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
4456
|
|
|
|
|
|
|
# Returns: 0) Reference to list of found tag keys (in order of requested tags) |
4457
|
|
|
|
|
|
|
# 1) Reference to list of indices for tags requested by value |
4458
|
|
|
|
|
|
|
# 2) Reference to list of indices for tags specified by wildcard or "all" |
4459
|
|
|
|
|
|
|
# Notes: index lists are returned in increasing order |
4460
|
|
|
|
|
|
|
sub SetFoundTags($) |
4461
|
|
|
|
|
|
|
{ |
4462
|
683
|
|
|
683
|
0
|
1187
|
my $self = shift; |
4463
|
683
|
|
|
|
|
1329
|
my $options = $$self{OPTIONS}; |
4464
|
683
|
|
50
|
|
|
2624
|
my $reqTags = $$self{REQUESTED_TAGS} || [ ]; |
4465
|
683
|
|
|
|
|
1334
|
my $duplicates = $$options{Duplicates}; |
4466
|
683
|
|
|
|
|
1367
|
my $exclude = $$options{Exclude}; |
4467
|
683
|
|
|
|
|
1206
|
my $fileOrder = $$self{FILE_ORDER}; |
4468
|
683
|
|
|
|
|
14840
|
my @groupOptions = sort grep /^Group/, keys %$options; |
4469
|
683
|
|
100
|
|
|
3802
|
my $doDups = $duplicates || $exclude || @groupOptions; |
4470
|
683
|
|
|
|
|
1319
|
my ($tag, $rtnTags, @byValue, @wildTags); |
4471
|
|
|
|
|
|
|
|
4472
|
|
|
|
|
|
|
# only return requested tags if specified |
4473
|
683
|
100
|
|
|
|
2031
|
if (@$reqTags) { |
4474
|
353
|
50
|
|
|
|
1078
|
$rtnTags or $rtnTags = [ ]; |
4475
|
|
|
|
|
|
|
# scan through the requested tags and generate a list of tags we found |
4476
|
353
|
|
|
|
|
725
|
my $tagHash = $$self{VALUE}; |
4477
|
353
|
|
|
|
|
551
|
my $reqTag; |
4478
|
353
|
|
|
|
|
852
|
foreach $reqTag (@$reqTags) { |
4479
|
863
|
|
|
|
|
1358
|
my (@matches, $group, $allGrp, $allTag, $byValue); |
4480
|
863
|
100
|
|
|
|
2635
|
if ($reqTag =~ /^(.*):(.+)/) { |
4481
|
234
|
|
|
|
|
860
|
($group, $tag) = ($1, $2); |
4482
|
234
|
50
|
|
|
|
1412
|
if ($group =~ /^(\*|all)$/i) { |
|
|
50
|
|
|
|
|
|
4483
|
0
|
|
|
|
|
0
|
$allGrp = 1; |
4484
|
|
|
|
|
|
|
} elsif ($group !~ /^[-\w:]*$/) { |
4485
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid group name '${group}'"); |
4486
|
0
|
|
|
|
|
0
|
$group = 'invalid'; |
4487
|
|
|
|
|
|
|
} |
4488
|
|
|
|
|
|
|
} else { |
4489
|
629
|
|
|
|
|
1023
|
$tag = $reqTag; |
4490
|
|
|
|
|
|
|
} |
4491
|
863
|
50
|
66
|
|
|
2180
|
$byValue = 1 if $tag =~ s/#$// and $$options{PrintConv}; |
4492
|
863
|
50
|
66
|
|
|
5553
|
if (defined $$tagHash{$reqTag} and not $doDups) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4493
|
0
|
|
|
|
|
0
|
$matches[0] = $tag; |
4494
|
|
|
|
|
|
|
} elsif ($tag =~ /^(\*|all)$/i) { |
4495
|
|
|
|
|
|
|
# tag name of '*' or 'all' matches all tags |
4496
|
138
|
100
|
66
|
|
|
518
|
if ($doDups or $allGrp) { |
4497
|
137
|
|
|
|
|
4320
|
@matches = grep(!/#/, keys %$tagHash); |
4498
|
|
|
|
|
|
|
} else { |
4499
|
1
|
|
|
|
|
53
|
@matches = grep(!/ /, keys %$tagHash); |
4500
|
|
|
|
|
|
|
} |
4501
|
138
|
50
|
|
|
|
697
|
next unless @matches; # don't want entry in list for '*' tag |
4502
|
138
|
|
|
|
|
254
|
$allTag = 1; |
4503
|
|
|
|
|
|
|
} elsif ($tag =~ /[*?]/) { |
4504
|
|
|
|
|
|
|
# allow wildcards in tag names |
4505
|
3
|
|
|
|
|
8
|
$tag =~ s/\*/[-\\w]*/g; |
4506
|
3
|
|
|
|
|
9
|
$tag =~ s/\?/[-\\w]/g; |
4507
|
3
|
50
|
33
|
|
|
22
|
$tag .= '( \\(.*)?' if $doDups or $allGrp; |
4508
|
3
|
|
|
|
|
569
|
@matches = grep(/^$tag$/i, keys %$tagHash); |
4509
|
3
|
50
|
|
|
|
29
|
next unless @matches; # don't want entry in list for wildcard tags |
4510
|
3
|
|
|
|
|
6
|
$allTag = 1; |
4511
|
|
|
|
|
|
|
} elsif ($doDups or defined $group) { |
4512
|
|
|
|
|
|
|
# must also look for tags like "Tag (1)" |
4513
|
|
|
|
|
|
|
# (but be sure not to match temporary ValueConv entries like "Tag #") |
4514
|
722
|
|
|
|
|
41998
|
@matches = grep(/^$tag( \(|$)/i, keys %$tagHash); |
4515
|
|
|
|
|
|
|
} elsif ($tag =~ /^[-\w]+$/) { |
4516
|
|
|
|
|
|
|
# find first matching value |
4517
|
|
|
|
|
|
|
# (use in list context to return value instead of count) |
4518
|
0
|
|
|
|
|
0
|
($matches[0]) = grep /^$tag$/i, keys %$tagHash; |
4519
|
0
|
0
|
|
|
|
0
|
defined $matches[0] or undef @matches; |
4520
|
|
|
|
|
|
|
} else { |
4521
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid tag name '${tag}'"); |
4522
|
|
|
|
|
|
|
} |
4523
|
863
|
100
|
66
|
|
|
4392
|
if (defined $group and not $allGrp) { |
4524
|
|
|
|
|
|
|
# keep only specified group |
4525
|
234
|
|
|
|
|
672
|
@matches = $self->GroupMatches($group, \@matches); |
4526
|
234
|
100
|
100
|
|
|
907
|
next unless @matches or not $allTag; |
4527
|
|
|
|
|
|
|
} |
4528
|
848
|
100
|
|
|
|
2533
|
if (@matches > 1) { |
|
|
100
|
|
|
|
|
|
4529
|
|
|
|
|
|
|
# maintain original file order for multiple tags |
4530
|
143
|
|
|
|
|
773
|
@matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches; |
|
7714
|
|
|
|
|
9848
|
|
4531
|
|
|
|
|
|
|
# return only the highest priority tag unless duplicates wanted |
4532
|
143
|
50
|
66
|
|
|
582
|
unless ($doDups or $allTag or $allGrp) { |
|
|
|
33
|
|
|
|
|
4533
|
0
|
|
|
|
|
0
|
$tag = shift @matches; |
4534
|
0
|
|
0
|
|
|
0
|
my $oldPriority = $$self{PRIORITY}{$tag} || 1; |
4535
|
0
|
|
|
|
|
0
|
foreach (@matches) { |
4536
|
0
|
|
|
|
|
0
|
my $priority = $$self{PRIORITY}{$_}; |
4537
|
0
|
0
|
|
|
|
0
|
$priority = 1 unless defined $priority; |
4538
|
0
|
0
|
|
|
|
0
|
next unless $priority >= $oldPriority; |
4539
|
0
|
|
|
|
|
0
|
$tag = $_; |
4540
|
0
|
|
0
|
|
|
0
|
$oldPriority = $priority || 1; |
4541
|
|
|
|
|
|
|
} |
4542
|
0
|
|
|
|
|
0
|
@matches = ( $tag ); |
4543
|
|
|
|
|
|
|
} |
4544
|
|
|
|
|
|
|
} elsif (not @matches) { |
4545
|
|
|
|
|
|
|
# put entry in return list even without value (value is undef) |
4546
|
437
|
100
|
|
|
|
1213
|
$matches[0] = $byValue ? "$tag #(0)" : "$tag (0)"; |
4547
|
|
|
|
|
|
|
# bogus file order entry to avoid warning if sorting in file order |
4548
|
437
|
|
|
|
|
1195
|
$$self{FILE_ORDER}{$matches[0]} = 9999; |
4549
|
|
|
|
|
|
|
} |
4550
|
|
|
|
|
|
|
# save indices of tags extracted by value |
4551
|
848
|
100
|
|
|
|
1721
|
push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue; |
4552
|
|
|
|
|
|
|
# save indices of wildcard tags |
4553
|
848
|
100
|
|
|
|
2321
|
push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag; |
4554
|
848
|
|
|
|
|
2724
|
push @$rtnTags, @matches; |
4555
|
|
|
|
|
|
|
} |
4556
|
|
|
|
|
|
|
} else { |
4557
|
|
|
|
|
|
|
# no requested tags, so we want all tags |
4558
|
330
|
|
|
|
|
537
|
my @allTags; |
4559
|
330
|
50
|
|
|
|
799
|
if ($doDups) { |
4560
|
330
|
|
|
|
|
577
|
@allTags = keys %{$$self{VALUE}}; |
|
330
|
|
|
|
|
7172
|
|
4561
|
|
|
|
|
|
|
} else { |
4562
|
|
|
|
|
|
|
# only include tag if it doesn't end in a copy number |
4563
|
0
|
|
|
|
|
0
|
@allTags = grep(!/ /, keys %{$$self{VALUE}}); |
|
0
|
|
|
|
|
0
|
|
4564
|
|
|
|
|
|
|
} |
4565
|
330
|
|
|
|
|
996
|
$rtnTags = \@allTags; |
4566
|
|
|
|
|
|
|
} |
4567
|
|
|
|
|
|
|
|
4568
|
|
|
|
|
|
|
# filter excluded tags and group options |
4569
|
683
|
|
100
|
|
|
3935
|
while (($exclude or @groupOptions) and @$rtnTags) { |
|
|
|
66
|
|
|
|
|
4570
|
68
|
100
|
|
|
|
193
|
if ($exclude) { |
4571
|
41
|
|
|
|
|
85
|
my ($pat, %exclude); |
4572
|
41
|
|
|
|
|
118
|
foreach $pat (@$exclude) { |
4573
|
57
|
|
|
|
|
193
|
my $group; |
4574
|
57
|
100
|
|
|
|
291
|
if ($pat =~ /^(.*):(.+)/) { |
4575
|
30
|
|
|
|
|
141
|
($group, $tag) = ($1, $2); |
4576
|
30
|
50
|
|
|
|
246
|
if ($group =~ /^(\*|all)$/i) { |
|
|
50
|
|
|
|
|
|
4577
|
0
|
|
|
|
|
0
|
undef $group; |
4578
|
|
|
|
|
|
|
} elsif ($group !~ /^[-\w:]*$/) { |
4579
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid group name '${group}'"); |
4580
|
0
|
|
|
|
|
0
|
$group = 'invalid'; |
4581
|
|
|
|
|
|
|
} |
4582
|
|
|
|
|
|
|
} else { |
4583
|
27
|
|
|
|
|
73
|
$tag = $pat; |
4584
|
|
|
|
|
|
|
} |
4585
|
57
|
|
|
|
|
101
|
my @matches; |
4586
|
57
|
100
|
|
|
|
244
|
if ($tag =~ /^(\*|all)$/i) { |
4587
|
30
|
|
|
|
|
165
|
@matches = @$rtnTags; |
4588
|
|
|
|
|
|
|
} else { |
4589
|
|
|
|
|
|
|
# allow wildcards in tag names |
4590
|
27
|
|
|
|
|
60
|
$tag =~ s/\*/[-\\w]*/g; |
4591
|
27
|
|
|
|
|
47
|
$tag =~ s/\?/[-\\w]/g; |
4592
|
27
|
|
|
|
|
2100
|
@matches = grep(/^$tag( |$)/i, @$rtnTags); |
4593
|
|
|
|
|
|
|
} |
4594
|
57
|
100
|
66
|
|
|
320
|
@matches = $self->GroupMatches($group, \@matches) if $group and @matches; |
4595
|
57
|
|
|
|
|
401
|
$exclude{$_} = 1 foreach @matches; |
4596
|
|
|
|
|
|
|
} |
4597
|
41
|
50
|
|
|
|
157
|
if (%exclude) { |
4598
|
|
|
|
|
|
|
# remove excluded tags from return list(s) |
4599
|
41
|
|
|
|
|
217
|
RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude); |
4600
|
41
|
50
|
|
|
|
130
|
last unless @$rtnTags; # all done if nothing left |
4601
|
|
|
|
|
|
|
} |
4602
|
41
|
100
|
66
|
|
|
280
|
last if $duplicates and not @groupOptions; |
4603
|
|
|
|
|
|
|
} |
4604
|
|
|
|
|
|
|
# filter groups if requested, or to remove duplicates |
4605
|
28
|
|
|
|
|
53
|
my (%keepTags, %wantGroup, $family, $groupOpt); |
4606
|
28
|
|
|
|
|
42
|
my $allGroups = 1; |
4607
|
|
|
|
|
|
|
# build hash of requested/excluded group names for each group family |
4608
|
28
|
|
|
|
|
35
|
my $wantOrder = 0; |
4609
|
28
|
|
|
|
|
55
|
foreach $groupOpt (@groupOptions) { |
4610
|
29
|
50
|
|
|
|
141
|
$groupOpt =~ /^Group(\d*(:\d+)*)/ or next; |
4611
|
29
|
|
100
|
|
|
108
|
$family = $1 || 0; |
4612
|
29
|
50
|
|
|
|
86
|
$wantGroup{$family} or $wantGroup{$family} = { }; |
4613
|
29
|
|
|
|
|
46
|
my $groupList; |
4614
|
29
|
100
|
|
|
|
82
|
if (ref $$options{$groupOpt} eq 'ARRAY') { |
4615
|
4
|
|
|
|
|
7
|
$groupList = $$options{$groupOpt}; |
4616
|
|
|
|
|
|
|
} else { |
4617
|
25
|
|
|
|
|
54
|
$groupList = [ $$options{$groupOpt} ]; |
4618
|
|
|
|
|
|
|
} |
4619
|
29
|
|
|
|
|
60
|
foreach (@$groupList) { |
4620
|
|
|
|
|
|
|
# groups have priority in order they were specified |
4621
|
33
|
|
|
|
|
44
|
++$wantOrder; |
4622
|
33
|
|
|
|
|
47
|
my ($groupName, $want); |
4623
|
33
|
100
|
|
|
|
71
|
if (/^-(.*)/) { |
4624
|
|
|
|
|
|
|
# excluded group begins with '-' |
4625
|
2
|
|
|
|
|
5
|
$groupName = $1; |
4626
|
2
|
|
|
|
|
3
|
$want = 0; # we don't want tags in this group |
4627
|
|
|
|
|
|
|
} else { |
4628
|
31
|
|
|
|
|
50
|
$groupName = $_; |
4629
|
31
|
|
|
|
|
35
|
$want = $wantOrder; # we want tags in this group |
4630
|
31
|
|
|
|
|
42
|
$allGroups = 0; # don't want all groups if we requested one |
4631
|
|
|
|
|
|
|
} |
4632
|
33
|
|
|
|
|
103
|
$wantGroup{$family}{$groupName} = $want; |
4633
|
|
|
|
|
|
|
} |
4634
|
|
|
|
|
|
|
} |
4635
|
|
|
|
|
|
|
# loop through all tags and decide which ones we want |
4636
|
28
|
|
|
|
|
41
|
my (@tags, %bestTag); |
4637
|
28
|
|
|
|
|
47
|
GR_TAG: foreach $tag (@$rtnTags) { |
4638
|
4505
|
|
|
|
|
4709
|
my $wantTag = $allGroups; # want tag by default if want all groups |
4639
|
4505
|
|
|
|
|
6741
|
foreach $family (keys %wantGroup) { |
4640
|
4591
|
|
|
|
|
6710
|
my $group = $self->GetGroup($tag, $family); |
4641
|
4591
|
|
|
|
|
6836
|
my $wanted = $wantGroup{$family}{$group}; |
4642
|
4591
|
100
|
|
|
|
7299
|
next unless defined $wanted; |
4643
|
1153
|
100
|
|
|
|
1590
|
next GR_TAG unless $wanted; # skip tag if group excluded |
4644
|
|
|
|
|
|
|
# take lowest non-zero want flag |
4645
|
976
|
50
|
33
|
|
|
1452
|
next if $wantTag and $wantTag < $wanted; |
4646
|
976
|
|
|
|
|
1268
|
$wantTag = $wanted; |
4647
|
|
|
|
|
|
|
} |
4648
|
4328
|
100
|
|
|
|
7090
|
next unless $wantTag; |
4649
|
1047
|
100
|
|
|
|
1994
|
$duplicates and $keepTags{$tag} = 1, next; |
4650
|
|
|
|
|
|
|
# determine which tag we want to keep |
4651
|
665
|
|
|
|
|
874
|
my $tagName = GetTagName($tag); |
4652
|
665
|
|
|
|
|
892
|
my $bestTag = $bestTag{$tagName}; |
4653
|
665
|
100
|
|
|
|
951
|
if (defined $bestTag) { |
4654
|
28
|
100
|
|
|
|
60
|
next if $wantTag > $keepTags{$bestTag}; |
4655
|
12
|
50
|
|
|
|
23
|
if ($wantTag == $keepTags{$bestTag}) { |
4656
|
|
|
|
|
|
|
# want two tags with the same name -- keep the latest one |
4657
|
0
|
0
|
|
|
|
0
|
if ($tag =~ / \((\d+)\)$/) { |
4658
|
0
|
|
|
|
|
0
|
my $tagNum = $1; |
4659
|
0
|
0
|
0
|
|
|
0
|
next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum; |
4660
|
|
|
|
|
|
|
} |
4661
|
|
|
|
|
|
|
} |
4662
|
|
|
|
|
|
|
# this tag is better, so delete old best tag |
4663
|
12
|
|
|
|
|
21
|
delete $keepTags{$bestTag}; |
4664
|
|
|
|
|
|
|
} |
4665
|
649
|
|
|
|
|
926
|
$keepTags{$tag} = $wantTag; # keep this tag (for now...) |
4666
|
649
|
|
|
|
|
981
|
$bestTag{$tagName} = $tag; # this is our current best tag |
4667
|
|
|
|
|
|
|
} |
4668
|
|
|
|
|
|
|
# include only tags we want to keep in return lists |
4669
|
28
|
|
|
|
|
128
|
RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1); |
4670
|
28
|
|
|
|
|
173
|
last; |
4671
|
|
|
|
|
|
|
} |
4672
|
683
|
|
|
|
|
1941
|
$$self{FOUND_TAGS} = $rtnTags; # save found tags |
4673
|
|
|
|
|
|
|
|
4674
|
|
|
|
|
|
|
# return reference to found tag keys (and list of indices of tags to extract by value) |
4675
|
683
|
50
|
|
|
|
3788
|
return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags; |
4676
|
|
|
|
|
|
|
} |
4677
|
|
|
|
|
|
|
|
4678
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4679
|
|
|
|
|
|
|
# Utility to load our write routines if required (called via AUTOLOAD) |
4680
|
|
|
|
|
|
|
# Inputs: 0) autoload function, 1-N) function arguments |
4681
|
|
|
|
|
|
|
# Returns: result of function or dies if function not available |
4682
|
|
|
|
|
|
|
sub DoAutoLoad(@) |
4683
|
|
|
|
|
|
|
{ |
4684
|
713
|
|
|
713
|
0
|
2366
|
my $autoload = shift; |
4685
|
713
|
|
|
|
|
3287
|
my @callInfo = split(/::/, $autoload); |
4686
|
713
|
|
|
|
|
1662
|
my $file = 'Image/ExifTool/Write'; |
4687
|
|
|
|
|
|
|
|
4688
|
713
|
100
|
|
|
|
120243
|
return if $callInfo[$#callInfo] eq 'DESTROY'; |
4689
|
242
|
100
|
|
|
|
981
|
if (@callInfo == 4) { |
|
|
100
|
|
|
|
|
|
4690
|
|
|
|
|
|
|
# load Image/ExifTool/WriteMODULE.pl |
4691
|
184
|
|
|
|
|
530
|
$file .= "$callInfo[2].pl"; |
4692
|
|
|
|
|
|
|
} elsif ($callInfo[-1] eq 'ShiftTime') { |
4693
|
1
|
|
|
|
|
2
|
$file = 'Image/ExifTool/Shift.pl'; # load Shift.pl |
4694
|
|
|
|
|
|
|
} else { |
4695
|
|
|
|
|
|
|
# load Image/ExifTool/Writer.pl |
4696
|
57
|
|
|
|
|
169
|
$file .= 'r.pl'; |
4697
|
|
|
|
|
|
|
} |
4698
|
|
|
|
|
|
|
# attempt to load the package |
4699
|
242
|
50
|
|
|
|
533
|
eval { require $file } or die "Error while attempting to call $autoload\n$@\n"; |
|
242
|
|
|
|
|
196285
|
|
4700
|
242
|
50
|
|
|
|
1569
|
unless (defined &$autoload) { |
4701
|
0
|
|
|
|
|
0
|
my @caller = caller(0); |
4702
|
|
|
|
|
|
|
# reproduce Perl's standard 'undefined subroutine' message: |
4703
|
0
|
|
|
|
|
0
|
die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n"; |
4704
|
|
|
|
|
|
|
} |
4705
|
104
|
|
|
104
|
|
1139
|
no strict 'refs'; |
|
104
|
|
|
|
|
230
|
|
|
104
|
|
|
|
|
108311
|
|
4706
|
242
|
|
|
|
|
1434
|
return &$autoload(@_); # call the function |
4707
|
|
|
|
|
|
|
} |
4708
|
|
|
|
|
|
|
|
4709
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4710
|
|
|
|
|
|
|
# AutoLoad our writer routines when necessary |
4711
|
|
|
|
|
|
|
# |
4712
|
|
|
|
|
|
|
sub AUTOLOAD |
4713
|
|
|
|
|
|
|
{ |
4714
|
529
|
|
|
529
|
|
313322
|
return DoAutoLoad($AUTOLOAD, @_); |
4715
|
|
|
|
|
|
|
} |
4716
|
|
|
|
|
|
|
|
4717
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4718
|
|
|
|
|
|
|
# Add warning tag |
4719
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) warning message |
4720
|
|
|
|
|
|
|
# 2) true if minor (2 if behaviour changes when warning is ignored, |
4721
|
|
|
|
|
|
|
# or 3 if warning shouldn't be issued when Validate option is used) |
4722
|
|
|
|
|
|
|
# Returns: true if warning tag was added |
4723
|
|
|
|
|
|
|
sub Warn($$;$) |
4724
|
|
|
|
|
|
|
{ |
4725
|
87
|
|
|
87
|
0
|
226
|
my ($self, $str, $ignorable) = @_; |
4726
|
87
|
100
|
|
|
|
301
|
if ($ignorable) { |
4727
|
32
|
100
|
|
|
|
190
|
return 0 if $$self{OPTIONS}{IgnoreMinorErrors}; |
4728
|
31
|
50
|
66
|
|
|
145
|
return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate}; |
4729
|
31
|
100
|
|
|
|
117
|
$str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str"; |
4730
|
|
|
|
|
|
|
} |
4731
|
86
|
|
|
|
|
339
|
$self->FoundTag('Warning', $str); |
4732
|
86
|
|
|
|
|
256
|
return 1; |
4733
|
|
|
|
|
|
|
} |
4734
|
|
|
|
|
|
|
|
4735
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4736
|
|
|
|
|
|
|
# Add warning tag only once per processed file |
4737
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor |
4738
|
|
|
|
|
|
|
# Returns: true if warning tag was added |
4739
|
|
|
|
|
|
|
sub WarnOnce($$;$) |
4740
|
|
|
|
|
|
|
{ |
4741
|
48
|
|
|
48
|
0
|
134
|
my ($self, $str, $ignorable) = @_; |
4742
|
48
|
50
|
66
|
|
|
151
|
return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors}; |
4743
|
48
|
100
|
|
|
|
142
|
unless ($$self{WARNED_ONCE}{$str}) { |
4744
|
41
|
|
|
|
|
192
|
$self->Warn($str, $ignorable); |
4745
|
41
|
|
|
|
|
145
|
$$self{WARNED_ONCE}{$str} = 1; |
4746
|
|
|
|
|
|
|
} |
4747
|
48
|
|
|
|
|
123
|
return 1; |
4748
|
|
|
|
|
|
|
} |
4749
|
|
|
|
|
|
|
|
4750
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4751
|
|
|
|
|
|
|
# Add error tag |
4752
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor |
4753
|
|
|
|
|
|
|
# Returns: true if error tag was added, otherwise warning was added |
4754
|
|
|
|
|
|
|
sub Error($$;$) |
4755
|
|
|
|
|
|
|
{ |
4756
|
1
|
|
|
1
|
0
|
4
|
my ($self, $str, $ignorable) = @_; |
4757
|
1
|
50
|
|
|
|
12
|
if ($$self{DemoteErrors}) { |
|
|
50
|
|
|
|
|
|
4758
|
0
|
0
|
|
|
|
0
|
$self->Warn($str) and ++$$self{DemoteErrors}; |
4759
|
0
|
|
|
|
|
0
|
return 1; |
4760
|
|
|
|
|
|
|
} elsif ($ignorable) { |
4761
|
1
|
50
|
|
|
|
10
|
$$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0; |
4762
|
0
|
|
|
|
|
0
|
$str = "[minor] $str"; |
4763
|
|
|
|
|
|
|
} |
4764
|
0
|
|
|
|
|
0
|
$self->FoundTag('Error', $str); |
4765
|
0
|
|
|
|
|
0
|
return 1; |
4766
|
|
|
|
|
|
|
} |
4767
|
|
|
|
|
|
|
|
4768
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4769
|
|
|
|
|
|
|
# Expand shortcuts |
4770
|
|
|
|
|
|
|
# Inputs: 0) reference to list of tags, 1) set to remove trailing '#' |
4771
|
|
|
|
|
|
|
# Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv, |
4772
|
|
|
|
|
|
|
# multiple group names, and redirected tags |
4773
|
|
|
|
|
|
|
sub ExpandShortcuts($;$) |
4774
|
|
|
|
|
|
|
{ |
4775
|
501
|
|
|
501
|
0
|
1143
|
my ($tagList, $removeSuffix) = @_; |
4776
|
501
|
50
|
33
|
|
|
2264
|
return unless $tagList and @$tagList; |
4777
|
|
|
|
|
|
|
|
4778
|
501
|
|
|
|
|
24330
|
require Image::ExifTool::Shortcuts; |
4779
|
|
|
|
|
|
|
|
4780
|
|
|
|
|
|
|
# expand shortcuts |
4781
|
501
|
100
|
|
|
|
1517
|
my $suffix = $removeSuffix ? '' : '#'; |
4782
|
501
|
|
|
|
|
752
|
my @expandedTags; |
4783
|
501
|
|
|
|
|
975
|
my ($entry, $tag, $excl); |
4784
|
501
|
|
|
|
|
1101
|
foreach $entry (@$tagList) { |
4785
|
|
|
|
|
|
|
# skip things like options hash references in list |
4786
|
1019
|
100
|
|
|
|
2049
|
if (ref $entry) { |
4787
|
1
|
|
|
|
|
3
|
push @expandedTags, $entry; |
4788
|
1
|
|
|
|
|
2
|
next; |
4789
|
|
|
|
|
|
|
} |
4790
|
|
|
|
|
|
|
# remove leading '-' |
4791
|
1018
|
|
|
|
|
4571
|
($excl, $tag) = $entry =~ /^(-?)(.*)/s; |
4792
|
1018
|
|
|
|
|
2024
|
my ($post, @post, $pre, $v); |
4793
|
|
|
|
|
|
|
# handle redirection |
4794
|
1018
|
100
|
100
|
|
|
8736
|
if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) { |
4795
|
23
|
|
|
|
|
84
|
($tag, $post) = ($1, $2); |
4796
|
23
|
100
|
100
|
|
|
154
|
if ($post =~ /^[-+]?>/ or $post !~ /\$/) { |
4797
|
|
|
|
|
|
|
# expand shortcuts in postfix (rhs of redirection) |
4798
|
18
|
|
|
|
|
102
|
my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/); |
4799
|
18
|
100
|
|
|
|
75
|
$p2 = '' unless defined $p2; |
4800
|
18
|
50
|
|
|
|
78
|
$v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix |
4801
|
18
|
|
|
|
|
324
|
my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main; |
4802
|
18
|
50
|
|
|
|
80
|
if ($match) { |
4803
|
0
|
|
|
|
|
0
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
0
|
|
|
|
|
0
|
|
4804
|
0
|
0
|
|
|
|
0
|
/^-/ and next; # ignore excluded tags |
4805
|
0
|
0
|
0
|
|
|
0
|
if ($p2 and /(.+:)(.+)/) { |
4806
|
0
|
|
|
|
|
0
|
push @post, "$op$_$v"; |
4807
|
|
|
|
|
|
|
} else { |
4808
|
0
|
|
|
|
|
0
|
push @post, "$op$p2$_$v"; |
4809
|
|
|
|
|
|
|
} |
4810
|
|
|
|
|
|
|
} |
4811
|
0
|
0
|
|
|
|
0
|
next unless @post; |
4812
|
0
|
|
|
|
|
0
|
$post = shift @post; |
4813
|
|
|
|
|
|
|
} |
4814
|
|
|
|
|
|
|
} |
4815
|
|
|
|
|
|
|
} else { |
4816
|
995
|
|
|
|
|
1680
|
$post = ''; |
4817
|
|
|
|
|
|
|
} |
4818
|
|
|
|
|
|
|
# handle group names |
4819
|
1018
|
100
|
|
|
|
2653
|
if ($tag =~ /(.+:)(.+)/) { |
4820
|
298
|
|
|
|
|
1027
|
($pre, $tag) = ($1, $2); |
4821
|
|
|
|
|
|
|
} else { |
4822
|
720
|
|
|
|
|
970
|
$pre = ''; |
4823
|
|
|
|
|
|
|
} |
4824
|
1018
|
100
|
|
|
|
2199
|
$v = ($tag =~ s/#$//) ? $suffix : ''; # ValueConv suffix |
4825
|
|
|
|
|
|
|
# loop over all postfixes |
4826
|
1018
|
|
|
|
|
1463
|
for (;;) { |
4827
|
|
|
|
|
|
|
# expand the tag name |
4828
|
1018
|
|
|
|
|
17179
|
my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main; |
4829
|
1018
|
100
|
|
|
|
2765
|
if ($match) { |
4830
|
17
|
50
|
66
|
|
|
110
|
if ($excl) { |
|
|
100
|
66
|
|
|
|
|
4831
|
|
|
|
|
|
|
# entry starts with '-', so exclude all tags in this shortcut |
4832
|
0
|
|
|
|
|
0
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
0
|
|
|
|
|
0
|
|
4833
|
0
|
0
|
|
|
|
0
|
/^-/ and next; # ignore excluded exclude tags |
4834
|
|
|
|
|
|
|
# group of expanded tag takes precedence |
4835
|
0
|
0
|
0
|
|
|
0
|
if ($pre and /(.+:)(.+)/) { |
4836
|
0
|
|
|
|
|
0
|
push @expandedTags, "$excl$_"; |
4837
|
|
|
|
|
|
|
} else { |
4838
|
0
|
|
|
|
|
0
|
push @expandedTags, "$excl$pre$_"; |
4839
|
|
|
|
|
|
|
} |
4840
|
|
|
|
|
|
|
} |
4841
|
|
|
|
|
|
|
} elsif (length $pre or length $post or $v) { |
4842
|
1
|
|
|
|
|
3
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
1
|
|
|
|
|
4
|
|
4843
|
12
|
|
|
|
|
36
|
/(-?)(.+:)?(.+)/; |
4844
|
12
|
50
|
|
|
|
18
|
if ($2) { |
4845
|
|
|
|
|
|
|
# group from expanded tag takes precedence |
4846
|
0
|
|
|
|
|
0
|
push @expandedTags, "$_$v$post"; |
4847
|
|
|
|
|
|
|
} else { |
4848
|
12
|
|
|
|
|
30
|
push @expandedTags, "$1$pre$3$v$post"; |
4849
|
|
|
|
|
|
|
} |
4850
|
|
|
|
|
|
|
} |
4851
|
|
|
|
|
|
|
} else { |
4852
|
16
|
|
|
|
|
25
|
push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}}; |
|
16
|
|
|
|
|
41
|
|
4853
|
|
|
|
|
|
|
} |
4854
|
|
|
|
|
|
|
} else { |
4855
|
1001
|
|
|
|
|
2735
|
push @expandedTags, "$excl$pre$tag$v$post"; |
4856
|
|
|
|
|
|
|
} |
4857
|
1018
|
50
|
|
|
|
2866
|
last unless @post; |
4858
|
0
|
|
|
|
|
0
|
$post = shift @post; |
4859
|
|
|
|
|
|
|
} |
4860
|
|
|
|
|
|
|
} |
4861
|
501
|
|
|
|
|
1666
|
@$tagList = @expandedTags; |
4862
|
|
|
|
|
|
|
} |
4863
|
|
|
|
|
|
|
|
4864
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4865
|
|
|
|
|
|
|
# Add hash of Composite tags to our composites |
4866
|
|
|
|
|
|
|
# Inputs: 0) hash reference to table of Composite tags to add or module name, |
4867
|
|
|
|
|
|
|
# 1) override existing tag definition |
4868
|
|
|
|
|
|
|
sub AddCompositeTags($;$) |
4869
|
|
|
|
|
|
|
{ |
4870
|
585
|
|
|
585
|
0
|
1460
|
local $_; |
4871
|
585
|
|
|
|
|
1853
|
my ($add, $override) = @_; |
4872
|
585
|
|
|
|
|
1205
|
my ($module, $prefix, $tagID); |
4873
|
585
|
50
|
|
|
|
2175
|
unless (ref $add) { |
4874
|
585
|
|
|
|
|
5827
|
($prefix = $add) =~ s/.*:://; |
4875
|
585
|
|
|
|
|
1313
|
$module = $add; |
4876
|
585
|
|
|
|
|
1686
|
$add .= '::Composite'; |
4877
|
104
|
|
|
104
|
|
759
|
no strict 'refs'; |
|
104
|
|
|
|
|
262
|
|
|
104
|
|
|
|
|
761653
|
|
4878
|
585
|
|
|
|
|
2844
|
$add = \%$add; |
4879
|
585
|
|
|
|
|
1382
|
$prefix .= '-'; |
4880
|
|
|
|
|
|
|
} else { |
4881
|
0
|
|
|
|
|
0
|
$prefix = 'UserDefined-'; |
4882
|
|
|
|
|
|
|
} |
4883
|
585
|
|
|
|
|
1610
|
my $defaultGroups = $$add{GROUPS}; |
4884
|
585
|
|
|
|
|
2143
|
my $compTable = GetTagTable('Image::ExifTool::Composite'); |
4885
|
|
|
|
|
|
|
|
4886
|
|
|
|
|
|
|
# make sure default groups are defined in families 0 and 1 |
4887
|
585
|
100
|
|
|
|
1514
|
if ($defaultGroups) { |
4888
|
489
|
100
|
|
|
|
1821
|
$$defaultGroups{0} or $$defaultGroups{0} = 'Composite'; |
4889
|
489
|
100
|
|
|
|
1523
|
$$defaultGroups{1} or $$defaultGroups{1} = 'Composite'; |
4890
|
489
|
50
|
|
|
|
1532
|
$$defaultGroups{2} or $$defaultGroups{2} = 'Other'; |
4891
|
|
|
|
|
|
|
} else { |
4892
|
96
|
|
|
|
|
504
|
$defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' }; |
4893
|
|
|
|
|
|
|
} |
4894
|
585
|
|
|
|
|
1935
|
SetupTagTable($add); # generate Name, TagID, etc |
4895
|
585
|
|
|
|
|
4428
|
foreach $tagID (sort keys %$add) { |
4896
|
5651
|
100
|
|
|
|
9955
|
next if $specialTags{$tagID}; # must skip special tags |
4897
|
5063
|
|
|
|
|
6159
|
my $tagInfo = $$add{$tagID}; |
4898
|
5063
|
|
|
|
|
8712
|
my $new = $prefix . $tagID; # new tag ID for Composite table |
4899
|
5063
|
100
|
|
|
|
8602
|
$$tagInfo{Module} = $module if $$tagInfo{Writable}; |
4900
|
5063
|
50
|
33
|
|
|
8019
|
$$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override}; |
4901
|
5063
|
|
|
|
|
7533
|
$$tagInfo{IsComposite} = 1; |
4902
|
|
|
|
|
|
|
# handle Composite tags with the same name |
4903
|
5063
|
100
|
|
|
|
8833
|
if ($compositeID{$tagID}) { |
4904
|
|
|
|
|
|
|
# determine if we want to override this tag |
4905
|
|
|
|
|
|
|
# (=0 keep both, >0 override, <0 keep existing) |
4906
|
336
|
|
50
|
|
|
2745
|
my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0); |
|
|
|
50
|
|
|
|
|
4907
|
336
|
50
|
|
|
|
949
|
next if $over < 0; |
4908
|
336
|
50
|
|
|
|
871
|
if ($over) { |
4909
|
|
|
|
|
|
|
# remove existing tags with this ID |
4910
|
0
|
|
|
|
|
0
|
delete $$compTable{$_} foreach @{$compositeID{$tagID}}; |
|
0
|
|
|
|
|
0
|
|
4911
|
0
|
|
|
|
|
0
|
delete $compositeID{$tagID}; |
4912
|
|
|
|
|
|
|
} |
4913
|
|
|
|
|
|
|
} |
4914
|
|
|
|
|
|
|
# make sure new TagID is unique by adding index if necessary |
4915
|
|
|
|
|
|
|
# (could only happen for UserDefined tags now that module name is added to tag ID) |
4916
|
5063
|
|
|
|
|
5754
|
my $n = 0; |
4917
|
5063
|
|
|
|
|
8977
|
while ($$compTable{$new}) { |
4918
|
0
|
0
|
|
|
|
0
|
$new =~ s/-\d+$// if $n++; |
4919
|
0
|
|
|
|
|
0
|
$new .= "-$n"; |
4920
|
|
|
|
|
|
|
} |
4921
|
|
|
|
|
|
|
# use new ID and save it so we can use it in TagLookup |
4922
|
5063
|
50
|
|
|
|
10391
|
$$tagInfo{NewTagID} = $new unless $tagID eq $new; |
4923
|
|
|
|
|
|
|
|
4924
|
|
|
|
|
|
|
# add new ID to lookup of Composite tag ID's |
4925
|
5063
|
100
|
|
|
|
11169
|
$compositeID{$tagID} = [ ] unless $compositeID{$tagID}; |
4926
|
5063
|
|
|
|
|
6003
|
unshift @{$compositeID{$tagID}}, $new; # (most recent one first) |
|
5063
|
|
|
|
|
10286
|
|
4927
|
|
|
|
|
|
|
|
4928
|
|
|
|
|
|
|
# convert scalar Require/Desire/Inhibit entries |
4929
|
5063
|
|
|
|
|
6706
|
my ($type, @hashes, @scalars, %used); |
4930
|
5063
|
|
|
|
|
6637
|
foreach $type ('Require','Desire','Inhibit') { |
4931
|
15189
|
100
|
|
|
|
26061
|
my $req = $$tagInfo{$type} or next; |
4932
|
6529
|
100
|
|
|
|
6913
|
push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type; |
|
6529
|
|
|
|
|
14379
|
|
4933
|
|
|
|
|
|
|
} |
4934
|
5063
|
100
|
|
|
|
8004
|
if (@scalars) { |
4935
|
|
|
|
|
|
|
# make lookup for indices that are used |
4936
|
943
|
|
|
|
|
1489
|
foreach $type (@hashes) { |
4937
|
104
|
|
|
|
|
264
|
$used{$_} = 1 foreach keys %{$$tagInfo{$type}}; |
|
104
|
|
|
|
|
1188
|
|
4938
|
|
|
|
|
|
|
} |
4939
|
943
|
|
|
|
|
1238
|
my $next = 0; |
4940
|
943
|
|
|
|
|
1318
|
foreach $type (@scalars) { |
4941
|
943
|
|
|
|
|
1989
|
++$next while $used{$next}; |
4942
|
943
|
|
|
|
|
2795
|
$$tagInfo{$type} = { $next++ => $$tagInfo{$type} }; |
4943
|
|
|
|
|
|
|
} |
4944
|
|
|
|
|
|
|
} |
4945
|
|
|
|
|
|
|
# add this Composite tag to our main Composite table |
4946
|
5063
|
|
|
|
|
6608
|
$$tagInfo{Table} = $compTable; |
4947
|
|
|
|
|
|
|
# (use the original TagID, even if we changed it, so don't do this:) |
4948
|
5063
|
|
|
|
|
6133
|
$$tagInfo{TagID} = $new; |
4949
|
|
|
|
|
|
|
# save tag under new ID in Composite table |
4950
|
5063
|
|
|
|
|
10026
|
$$compTable{$new} = $tagInfo; |
4951
|
|
|
|
|
|
|
# set all default groups in tag |
4952
|
5063
|
|
|
|
|
6017
|
my $groups = $$tagInfo{Groups}; |
4953
|
5063
|
100
|
|
|
|
9121
|
$groups or $groups = $$tagInfo{Groups} = { }; |
4954
|
|
|
|
|
|
|
# fill in default groups |
4955
|
5063
|
|
|
|
|
10006
|
foreach (keys %$defaultGroups) { |
4956
|
15189
|
100
|
|
|
|
27265
|
$$groups{$_} or $$groups{$_} = $$defaultGroups{$_}; |
4957
|
|
|
|
|
|
|
} |
4958
|
|
|
|
|
|
|
# set flag indicating group list was built |
4959
|
5063
|
|
|
|
|
11376
|
$$tagInfo{GotGroups} = 1; |
4960
|
|
|
|
|
|
|
} |
4961
|
|
|
|
|
|
|
} |
4962
|
|
|
|
|
|
|
|
4963
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4964
|
|
|
|
|
|
|
# Add tags to TagLookup (used for writing) |
4965
|
|
|
|
|
|
|
# Inputs: 0) source hash of tag definitions, 1) name of destination tag table |
4966
|
|
|
|
|
|
|
sub AddTagsToLookup($$) |
4967
|
|
|
|
|
|
|
{ |
4968
|
1
|
|
|
1
|
0
|
3
|
my ($tagHash, $table) = @_; |
4969
|
1
|
50
|
|
|
|
9
|
if (defined &Image::ExifTool::TagLookup::AddTags) { |
|
|
50
|
|
|
|
|
|
4970
|
0
|
|
|
|
|
0
|
Image::ExifTool::TagLookup::AddTags($tagHash, $table); |
4971
|
|
|
|
|
|
|
} elsif (not $Image::ExifTool::pluginTags{$tagHash}) { |
4972
|
|
|
|
|
|
|
# queue these tags until TagLookup is loaded |
4973
|
1
|
|
|
|
|
3
|
push @Image::ExifTool::pluginTags, [ $tagHash, $table ]; |
4974
|
|
|
|
|
|
|
# set flag so we don't load same tags twice |
4975
|
1
|
|
|
|
|
4
|
$Image::ExifTool::pluginTags{$tagHash} = 1; |
4976
|
|
|
|
|
|
|
} |
4977
|
|
|
|
|
|
|
} |
4978
|
|
|
|
|
|
|
|
4979
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4980
|
|
|
|
|
|
|
# Expand tagInfo Flags |
4981
|
|
|
|
|
|
|
# Inputs: 0) tagInfo hash ref |
4982
|
|
|
|
|
|
|
# Notes: $$tagInfo{Flags} must be defined to call this routine |
4983
|
|
|
|
|
|
|
sub ExpandFlags($) |
4984
|
|
|
|
|
|
|
{ |
4985
|
4634
|
|
|
4634
|
0
|
5799
|
my $tagInfo = shift; |
4986
|
4634
|
|
|
|
|
5882
|
my $flags = $$tagInfo{Flags}; |
4987
|
4634
|
100
|
|
|
|
8649
|
if (ref $flags eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
4988
|
2339
|
|
|
|
|
4232
|
foreach (@$flags) { |
4989
|
6209
|
|
|
|
|
11361
|
$$tagInfo{$_} = 1; |
4990
|
|
|
|
|
|
|
} |
4991
|
|
|
|
|
|
|
} elsif (ref $flags eq 'HASH') { |
4992
|
0
|
|
|
|
|
0
|
my $key; |
4993
|
0
|
|
|
|
|
0
|
foreach $key (keys %$flags) { |
4994
|
0
|
|
|
|
|
0
|
$$tagInfo{$key} = $$flags{$key}; |
4995
|
|
|
|
|
|
|
} |
4996
|
|
|
|
|
|
|
} else { |
4997
|
2295
|
|
|
|
|
4573
|
$$tagInfo{$flags} = 1; |
4998
|
|
|
|
|
|
|
} |
4999
|
|
|
|
|
|
|
} |
5000
|
|
|
|
|
|
|
|
5001
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5002
|
|
|
|
|
|
|
# Set up tag table (must be done once for each tag table used) |
5003
|
|
|
|
|
|
|
# Inputs: 0) Reference to tag table |
5004
|
|
|
|
|
|
|
# Notes: - generates 'Name' field from key if it doesn't exist |
5005
|
|
|
|
|
|
|
# - stores 'Table' pointer and 'TagID' value |
5006
|
|
|
|
|
|
|
# - expands 'Flags' for quick lookup |
5007
|
|
|
|
|
|
|
sub SetupTagTable($) |
5008
|
|
|
|
|
|
|
{ |
5009
|
5073
|
|
|
5073
|
0
|
7299
|
my $tagTablePtr = shift; |
5010
|
5073
|
|
|
|
|
7634
|
my $avoid = $$tagTablePtr{AVOID}; |
5011
|
5073
|
|
|
|
|
7306
|
my ($tagID, $tagInfo); |
5012
|
5073
|
|
|
|
|
10163
|
foreach $tagID (TagTableKeys($tagTablePtr)) { |
5013
|
201452
|
|
|
|
|
253704
|
my @infoArray = GetTagInfoList($tagTablePtr,$tagID); |
5014
|
|
|
|
|
|
|
# process conditional tagInfo arrays |
5015
|
201452
|
|
|
|
|
236325
|
foreach $tagInfo (@infoArray) { |
5016
|
221583
|
|
|
|
|
311016
|
$$tagInfo{Table} = $tagTablePtr; |
5017
|
221583
|
|
|
|
|
279927
|
$$tagInfo{TagID} = $tagID; |
5018
|
221583
|
100
|
|
|
|
342592
|
$$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID); |
5019
|
221583
|
100
|
|
|
|
307466
|
$$tagInfo{Flags} and ExpandFlags($tagInfo); |
5020
|
221583
|
100
|
|
|
|
294107
|
$$tagInfo{Avoid} = $avoid if defined $avoid; |
5021
|
|
|
|
|
|
|
# calculate BitShift from Mask if necessary |
5022
|
221583
|
100
|
100
|
|
|
354300
|
if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) { |
5023
|
3024
|
|
|
|
|
4236
|
my ($mask, $bitShift) = ($$tagInfo{Mask}, 0); |
5024
|
3024
|
|
|
|
|
7613
|
++$bitShift until $mask & (1 << $bitShift); |
5025
|
3024
|
|
|
|
|
4582
|
$$tagInfo{BitShift} = $bitShift; |
5026
|
|
|
|
|
|
|
} |
5027
|
|
|
|
|
|
|
} |
5028
|
201452
|
100
|
|
|
|
330416
|
next unless @infoArray > 1; |
5029
|
|
|
|
|
|
|
# add an "Index" member to each tagInfo in a list |
5030
|
3634
|
|
|
|
|
4793
|
my $index = 0; |
5031
|
3634
|
|
|
|
|
4760
|
foreach $tagInfo (@infoArray) { |
5032
|
23765
|
|
|
|
|
31513
|
$$tagInfo{Index} = $index++; |
5033
|
|
|
|
|
|
|
} |
5034
|
|
|
|
|
|
|
} |
5035
|
|
|
|
|
|
|
} |
5036
|
|
|
|
|
|
|
|
5037
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5038
|
|
|
|
|
|
|
# Utilities to check for numerical types |
5039
|
|
|
|
|
|
|
# Inputs: 0) value; Returns: true if value is a numerical type |
5040
|
|
|
|
|
|
|
# Notes: May change commas to decimals in floats for use in other locales |
5041
|
|
|
|
|
|
|
sub IsFloat($) { |
5042
|
7737
|
100
|
|
7737
|
0
|
67197
|
return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; |
5043
|
|
|
|
|
|
|
# allow comma separators (for other locales) |
5044
|
2181
|
50
|
|
|
|
13666
|
return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/; |
5045
|
0
|
|
|
|
|
0
|
$_[0] =~ tr/,/./; # but translate ',' to '.' |
5046
|
0
|
|
|
|
|
0
|
return 1; |
5047
|
|
|
|
|
|
|
} |
5048
|
19659
|
|
|
19659
|
0
|
76294
|
sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); } |
5049
|
3045
|
|
|
3045
|
0
|
10801
|
sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); } |
5050
|
16
|
|
|
16
|
0
|
117
|
sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); } |
5051
|
|
|
|
|
|
|
|
5052
|
|
|
|
|
|
|
# round floating point value to specified number of significant digits |
5053
|
|
|
|
|
|
|
# Inputs: 0) value, 1) number of sig digits; Returns: rounded number |
5054
|
|
|
|
|
|
|
sub RoundFloat($$) |
5055
|
|
|
|
|
|
|
{ |
5056
|
3358
|
|
|
3358
|
0
|
5867
|
my ($val, $sig) = @_; |
5057
|
3358
|
|
|
|
|
21081
|
return sprintf("%.${sig}g", $val); |
5058
|
|
|
|
|
|
|
} |
5059
|
|
|
|
|
|
|
|
5060
|
|
|
|
|
|
|
# Convert strings to floating point numbers (or undef) |
5061
|
|
|
|
|
|
|
# Inputs: 0-N) list of strings (may be undef) |
5062
|
|
|
|
|
|
|
# Returns: last value converted |
5063
|
|
|
|
|
|
|
sub ToFloat(@) |
5064
|
|
|
|
|
|
|
{ |
5065
|
960
|
|
|
960
|
0
|
1589
|
local $_; |
5066
|
960
|
|
|
|
|
2102
|
foreach (@_) { |
5067
|
10335
|
100
|
|
|
|
15539
|
next unless defined $_; |
5068
|
|
|
|
|
|
|
# (add 0 to convert "0.0" to "0" for tests) |
5069
|
3878
|
100
|
|
|
|
18482
|
$_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef; |
5070
|
|
|
|
|
|
|
} |
5071
|
960
|
|
|
|
|
7900
|
return $_[-1]; |
5072
|
|
|
|
|
|
|
} |
5073
|
|
|
|
|
|
|
|
5074
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5075
|
|
|
|
|
|
|
# Utility routines to for reading binary data values from file |
5076
|
|
|
|
|
|
|
|
5077
|
|
|
|
|
|
|
my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' ); |
5078
|
|
|
|
|
|
|
my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' ); |
5079
|
|
|
|
|
|
|
my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' ); |
5080
|
|
|
|
|
|
|
|
5081
|
|
|
|
|
|
|
# the following 4 variables are defined in 'use vars' instead of using 'my' |
5082
|
|
|
|
|
|
|
# because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my' |
5083
|
|
|
|
|
|
|
# variables from within subroutines (ref communication with Pavel Merdin): |
5084
|
|
|
|
|
|
|
# $swapBytes - set if EXIF header is not native byte ordering |
5085
|
|
|
|
|
|
|
# $swapWords - swap 32-bit words in doubles (ARM quirk) |
5086
|
|
|
|
|
|
|
$currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM') |
5087
|
|
|
|
|
|
|
%unpackStd = %unpackMotorola; |
5088
|
|
|
|
|
|
|
|
5089
|
|
|
|
|
|
|
# Swap bytes in data if necessary |
5090
|
|
|
|
|
|
|
# Inputs: 0) data, 1) number of bytes |
5091
|
|
|
|
|
|
|
# Returns: swapped data |
5092
|
|
|
|
|
|
|
sub SwapBytes($$) |
5093
|
|
|
|
|
|
|
{ |
5094
|
1358
|
100
|
|
1358
|
0
|
3039
|
return $_[0] unless $swapBytes; |
5095
|
204
|
|
|
|
|
387
|
my ($val, $bytes) = @_; |
5096
|
204
|
|
|
|
|
309
|
my $newVal = ''; |
5097
|
204
|
|
|
|
|
1195
|
$newVal .= substr($val, $bytes, 1) while $bytes--; |
5098
|
204
|
|
|
|
|
479
|
return $newVal; |
5099
|
|
|
|
|
|
|
} |
5100
|
|
|
|
|
|
|
# Swap words. Inputs: 8 bytes of data, Returns: swapped data |
5101
|
|
|
|
|
|
|
sub SwapWords($) |
5102
|
|
|
|
|
|
|
{ |
5103
|
1298
|
50
|
33
|
1298
|
0
|
4225
|
return $_[0] unless $swapWords and length($_[0]) == 8; |
5104
|
0
|
|
|
|
|
0
|
return substr($_[0],4,4) . substr($_[0],0,4) |
5105
|
|
|
|
|
|
|
} |
5106
|
|
|
|
|
|
|
|
5107
|
|
|
|
|
|
|
# Unpack value, letting unpack() handle byte swapping |
5108
|
|
|
|
|
|
|
# Inputs: 0) unpack template, 1) data reference, 2) offset |
5109
|
|
|
|
|
|
|
# Returns: unpacked number |
5110
|
|
|
|
|
|
|
# - uses value of %unpackStd to determine the unpack template |
5111
|
|
|
|
|
|
|
# - can only be called for 'S' or 'L' templates since these are the only |
5112
|
|
|
|
|
|
|
# templates for which you can specify the byte ordering. |
5113
|
|
|
|
|
|
|
sub DoUnpackStd(@) |
5114
|
|
|
|
|
|
|
{ |
5115
|
154694
|
100
|
|
154694
|
0
|
312744
|
$_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]}); |
|
150329
|
|
|
|
|
320840
|
|
5116
|
4365
|
|
|
|
|
6463
|
return unpack($unpackStd{$_[0]}, ${$_[1]}); |
|
4365
|
|
|
|
|
11143
|
|
5117
|
|
|
|
|
|
|
} |
5118
|
|
|
|
|
|
|
# same, but with reversed byte order |
5119
|
|
|
|
|
|
|
sub DoUnpackRev(@) |
5120
|
|
|
|
|
|
|
{ |
5121
|
12
|
|
|
12
|
0
|
23
|
my $fmt = $unpackRev{$unpackStd{$_[0]}}; |
5122
|
12
|
50
|
|
|
|
26
|
$_[2] and return unpack("x$_[2] $fmt", ${$_[1]}); |
|
12
|
|
|
|
|
86
|
|
5123
|
0
|
|
|
|
|
0
|
return unpack($fmt, ${$_[1]}); |
|
0
|
|
|
|
|
0
|
|
5124
|
|
|
|
|
|
|
} |
5125
|
|
|
|
|
|
|
# Pack value |
5126
|
|
|
|
|
|
|
# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref) |
5127
|
|
|
|
|
|
|
# Returns: packed value |
5128
|
|
|
|
|
|
|
sub DoPackStd(@) |
5129
|
|
|
|
|
|
|
{ |
5130
|
31883
|
|
|
31883
|
0
|
52915
|
my $val = pack($unpackStd{$_[0]}, $_[1]); |
5131
|
31883
|
100
|
|
|
|
46313
|
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; |
|
7713
|
|
|
|
|
10887
|
|
5132
|
31883
|
|
|
|
|
63579
|
return $val; |
5133
|
|
|
|
|
|
|
} |
5134
|
|
|
|
|
|
|
# same, but with reversed byte order |
5135
|
|
|
|
|
|
|
sub DoPackRev(@) |
5136
|
|
|
|
|
|
|
{ |
5137
|
0
|
|
|
0
|
0
|
0
|
my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]); |
5138
|
0
|
0
|
|
|
|
0
|
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; |
|
0
|
|
|
|
|
0
|
|
5139
|
0
|
|
|
|
|
0
|
return $val; |
5140
|
|
|
|
|
|
|
} |
5141
|
|
|
|
|
|
|
|
5142
|
|
|
|
|
|
|
# Unpack value, handling the byte swapping manually |
5143
|
|
|
|
|
|
|
# Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset |
5144
|
|
|
|
|
|
|
# Returns: unpacked number |
5145
|
|
|
|
|
|
|
# - uses value of $swapBytes to determine byte ordering |
5146
|
|
|
|
|
|
|
sub DoUnpack(@) |
5147
|
|
|
|
|
|
|
{ |
5148
|
27162
|
|
|
27162
|
0
|
38294
|
my ($bytes, $template, $dataPt, $pos) = @_; |
5149
|
27162
|
|
|
|
|
28899
|
my $val; |
5150
|
27162
|
100
|
|
|
|
35840
|
if ($swapBytes) { |
5151
|
5396
|
|
|
|
|
6156
|
$val = ''; |
5152
|
5396
|
|
|
|
|
18816
|
$val .= substr($$dataPt,$pos+$bytes,1) while $bytes--; |
5153
|
|
|
|
|
|
|
} else { |
5154
|
21766
|
|
|
|
|
30468
|
$val = substr($$dataPt,$pos,$bytes); |
5155
|
|
|
|
|
|
|
} |
5156
|
27162
|
50
|
|
|
|
39549
|
defined($val) or return undef; |
5157
|
27162
|
|
|
|
|
50934
|
return unpack($template,$val); |
5158
|
|
|
|
|
|
|
} |
5159
|
|
|
|
|
|
|
|
5160
|
|
|
|
|
|
|
# Unpack double value |
5161
|
|
|
|
|
|
|
# Inputs: 0) unpack template, 1) data reference, 2) offset |
5162
|
|
|
|
|
|
|
# Returns: unpacked number |
5163
|
|
|
|
|
|
|
sub DoUnpackDbl(@) |
5164
|
|
|
|
|
|
|
{ |
5165
|
1236
|
|
|
1236
|
0
|
1884
|
my ($template, $dataPt, $pos) = @_; |
5166
|
1236
|
|
|
|
|
1885
|
my $val = substr($$dataPt,$pos,8); |
5167
|
1236
|
50
|
|
|
|
1913
|
defined($val) or return undef; |
5168
|
|
|
|
|
|
|
# swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value |
5169
|
1236
|
|
|
|
|
1875
|
return unpack($template, SwapWords(SwapBytes($val, 8))); |
5170
|
|
|
|
|
|
|
} |
5171
|
|
|
|
|
|
|
|
5172
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) offset into data |
5173
|
129
|
|
|
129
|
0
|
323
|
sub Get8s($$) { return DoUnpackStd('c', @_); } |
5174
|
7680
|
|
|
7680
|
0
|
12066
|
sub Get8u($$) { return DoUnpackStd('C', @_); } |
5175
|
14499
|
|
|
14499
|
0
|
20729
|
sub Get16s($$) { return DoUnpack(2, 's', @_); } |
5176
|
73902
|
|
|
73902
|
0
|
107384
|
sub Get16u($$) { return DoUnpackStd('S', @_); } |
5177
|
12020
|
|
|
12020
|
0
|
17884
|
sub Get32s($$) { return DoUnpack(4, 'l', @_); } |
5178
|
72983
|
|
|
72983
|
0
|
103534
|
sub Get32u($$) { return DoUnpackStd('L', @_); } |
5179
|
643
|
|
|
643
|
0
|
1304
|
sub GetFloat($$) { return DoUnpack(4, 'f', @_); } |
5180
|
1236
|
|
|
1236
|
0
|
2049
|
sub GetDouble($$) { return DoUnpackDbl('d', @_); } |
5181
|
12
|
|
|
12
|
0
|
27
|
sub Get16uRev($$) { return DoUnpackRev('S', @_); } |
5182
|
0
|
|
|
0
|
0
|
0
|
sub Get32uRev($$) { return DoUnpackRev('L', @_); } |
5183
|
|
|
|
|
|
|
|
5184
|
|
|
|
|
|
|
# rationals may be a floating point number, 'inf' or 'undef' |
5185
|
|
|
|
|
|
|
my ($ratNumer, $ratDenom); |
5186
|
|
|
|
|
|
|
sub GetRational32s($$) |
5187
|
|
|
|
|
|
|
{ |
5188
|
12
|
|
|
12
|
0
|
21
|
my ($dataPt, $pos) = @_; |
5189
|
12
|
|
|
|
|
21
|
$ratNumer = Get16s($dataPt,$pos); |
5190
|
12
|
0
|
|
|
|
23
|
$ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5191
|
|
|
|
|
|
|
# round off to a reasonable number of significant figures |
5192
|
12
|
|
|
|
|
28
|
return RoundFloat($ratNumer / $ratDenom, 7); |
5193
|
|
|
|
|
|
|
} |
5194
|
|
|
|
|
|
|
sub GetRational32u($$) |
5195
|
|
|
|
|
|
|
{ |
5196
|
12
|
|
|
12
|
0
|
23
|
my ($dataPt, $pos) = @_; |
5197
|
12
|
|
|
|
|
23
|
$ratNumer = Get16u($dataPt,$pos); |
5198
|
12
|
0
|
|
|
|
28
|
$ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5199
|
12
|
|
|
|
|
37
|
return RoundFloat($ratNumer / $ratDenom, 7); |
5200
|
|
|
|
|
|
|
} |
5201
|
|
|
|
|
|
|
sub GetRational64s($$) |
5202
|
|
|
|
|
|
|
{ |
5203
|
654
|
|
|
654
|
0
|
1351
|
my ($dataPt, $pos) = @_; |
5204
|
654
|
|
|
|
|
1265
|
$ratNumer = Get32s($dataPt,$pos); |
5205
|
654
|
0
|
|
|
|
1477
|
$ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5206
|
654
|
|
|
|
|
1582
|
return RoundFloat($ratNumer / $ratDenom, 10); |
5207
|
|
|
|
|
|
|
} |
5208
|
|
|
|
|
|
|
sub GetRational64u($$) |
5209
|
|
|
|
|
|
|
{ |
5210
|
2697
|
|
|
2697
|
0
|
4415
|
my ($dataPt, $pos) = @_; |
5211
|
2697
|
|
|
|
|
4350
|
$ratNumer = Get32u($dataPt,$pos); |
5212
|
2697
|
50
|
|
|
|
5355
|
$ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; |
|
|
100
|
|
|
|
|
|
5213
|
2680
|
|
|
|
|
7064
|
return RoundFloat($ratNumer / $ratDenom, 10); |
5214
|
|
|
|
|
|
|
} |
5215
|
|
|
|
|
|
|
sub GetFixed16s($$) |
5216
|
|
|
|
|
|
|
{ |
5217
|
13
|
|
|
13
|
0
|
49
|
my ($dataPt, $pos) = @_; |
5218
|
13
|
|
|
|
|
42
|
my $val = Get16s($dataPt, $pos) / 0x100; |
5219
|
13
|
50
|
|
|
|
73
|
return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000; |
5220
|
|
|
|
|
|
|
} |
5221
|
|
|
|
|
|
|
sub GetFixed16u($$) |
5222
|
|
|
|
|
|
|
{ |
5223
|
0
|
|
|
0
|
0
|
0
|
my ($dataPt, $pos) = @_; |
5224
|
0
|
|
|
|
|
0
|
return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000; |
5225
|
|
|
|
|
|
|
} |
5226
|
|
|
|
|
|
|
sub GetFixed32s($$) |
5227
|
|
|
|
|
|
|
{ |
5228
|
1754
|
|
|
1754
|
0
|
2408
|
my ($dataPt, $pos) = @_; |
5229
|
1754
|
|
|
|
|
2362
|
my $val = Get32s($dataPt, $pos) / 0x10000; |
5230
|
|
|
|
|
|
|
# remove insignificant digits |
5231
|
1754
|
100
|
|
|
|
4191
|
return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5; |
5232
|
|
|
|
|
|
|
} |
5233
|
|
|
|
|
|
|
sub GetFixed32u($$) |
5234
|
|
|
|
|
|
|
{ |
5235
|
156
|
|
|
156
|
0
|
290
|
my ($dataPt, $pos) = @_; |
5236
|
|
|
|
|
|
|
# remove insignificant digits |
5237
|
156
|
|
|
|
|
264
|
return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5; |
5238
|
|
|
|
|
|
|
} |
5239
|
|
|
|
|
|
|
# Inputs: 0) value, 1) data ref, 2) offset |
5240
|
5
|
|
|
5
|
0
|
14
|
sub Set8s(@) { return DoPackStd('c', @_); } |
5241
|
275
|
|
|
275
|
0
|
474
|
sub Set8u(@) { return DoPackStd('C', @_); } |
5242
|
12834
|
|
|
12834
|
0
|
18359
|
sub Set16u(@) { return DoPackStd('S', @_); } |
5243
|
18769
|
|
|
18769
|
0
|
26769
|
sub Set32u(@) { return DoPackStd('L', @_); } |
5244
|
0
|
|
|
0
|
0
|
0
|
sub Set16uRev(@) { return DoPackRev('S', @_); } |
5245
|
|
|
|
|
|
|
|
5246
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5247
|
|
|
|
|
|
|
# Get current byte order ('II' or 'MM') |
5248
|
13928
|
|
|
13928
|
0
|
30947
|
sub GetByteOrder() { return $currentByteOrder; } |
5249
|
|
|
|
|
|
|
|
5250
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5251
|
|
|
|
|
|
|
# Set byte ordering |
5252
|
|
|
|
|
|
|
# Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian') |
5253
|
|
|
|
|
|
|
# Returns: 1 on success |
5254
|
|
|
|
|
|
|
sub SetByteOrder($) |
5255
|
|
|
|
|
|
|
{ |
5256
|
15068
|
|
|
15068
|
0
|
23319
|
my $order = shift; |
5257
|
|
|
|
|
|
|
|
5258
|
15068
|
100
|
|
|
|
30210
|
if ($order eq 'MM') { # big endian (Motorola) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
5259
|
7816
|
|
|
|
|
29432
|
%unpackStd = %unpackMotorola; |
5260
|
|
|
|
|
|
|
} elsif ($order eq 'II') { # little endian (Intel) |
5261
|
7061
|
|
|
|
|
28422
|
%unpackStd = %unpackIntel; |
5262
|
|
|
|
|
|
|
} elsif ($order =~ /^Big/i) { |
5263
|
15
|
|
|
|
|
31
|
$order = 'MM'; |
5264
|
15
|
|
|
|
|
93
|
%unpackStd = %unpackMotorola; |
5265
|
|
|
|
|
|
|
} elsif ($order =~ /^Little/i) { |
5266
|
11
|
|
|
|
|
22
|
$order = 'II'; |
5267
|
11
|
|
|
|
|
70
|
%unpackStd = %unpackIntel; |
5268
|
|
|
|
|
|
|
} else { |
5269
|
165
|
|
|
|
|
519
|
return 0; |
5270
|
|
|
|
|
|
|
} |
5271
|
14903
|
|
|
|
|
32027
|
my $val = unpack('S','A '); |
5272
|
14903
|
|
|
|
|
18399
|
my $nativeOrder; |
5273
|
14903
|
50
|
|
|
|
29754
|
if ($val == 0x4120) { # big endian |
|
|
50
|
|
|
|
|
|
5274
|
0
|
|
|
|
|
0
|
$nativeOrder = 'MM'; |
5275
|
|
|
|
|
|
|
} elsif ($val == 0x2041) { # little endian |
5276
|
14903
|
|
|
|
|
19402
|
$nativeOrder = 'II'; |
5277
|
|
|
|
|
|
|
} else { |
5278
|
0
|
|
|
|
|
0
|
warn sprintf("Unknown native byte order! (pattern %x)\n",$val); |
5279
|
0
|
|
|
|
|
0
|
return 0; |
5280
|
|
|
|
|
|
|
} |
5281
|
14903
|
|
|
|
|
18740
|
$currentByteOrder = $order; # save current byte order |
5282
|
|
|
|
|
|
|
|
5283
|
|
|
|
|
|
|
# swap bytes if our native CPU byte ordering is not the same as the EXIF |
5284
|
14903
|
|
|
|
|
21275
|
$swapBytes = ($order ne $nativeOrder); |
5285
|
|
|
|
|
|
|
|
5286
|
|
|
|
|
|
|
# little-endian ARM has big-endian words for doubles (thanks Riku Voipio) |
5287
|
|
|
|
|
|
|
# (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since |
5288
|
|
|
|
|
|
|
# 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?) |
5289
|
14903
|
|
|
|
|
18487
|
my $pack1d = pack('d', 1); |
5290
|
14903
|
|
33
|
|
|
39528
|
$swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or |
5291
|
|
|
|
|
|
|
$pack1d eq "\0\0\xf0\x3f\0\0\0\0"); |
5292
|
14903
|
|
|
|
|
26065
|
return 1; |
5293
|
|
|
|
|
|
|
} |
5294
|
|
|
|
|
|
|
|
5295
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5296
|
|
|
|
|
|
|
# Change byte order |
5297
|
|
|
|
|
|
|
sub ToggleByteOrder() |
5298
|
|
|
|
|
|
|
{ |
5299
|
39
|
100
|
|
39
|
0
|
123
|
SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II'); |
5300
|
|
|
|
|
|
|
} |
5301
|
|
|
|
|
|
|
|
5302
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5303
|
|
|
|
|
|
|
# hash lookups for reading values from data |
5304
|
|
|
|
|
|
|
my %formatSize = ( |
5305
|
|
|
|
|
|
|
int8s => 1, |
5306
|
|
|
|
|
|
|
int8u => 1, |
5307
|
|
|
|
|
|
|
int16s => 2, |
5308
|
|
|
|
|
|
|
int16u => 2, |
5309
|
|
|
|
|
|
|
int16uRev => 2, |
5310
|
|
|
|
|
|
|
int32s => 4, |
5311
|
|
|
|
|
|
|
int32u => 4, |
5312
|
|
|
|
|
|
|
int32uRev => 4, |
5313
|
|
|
|
|
|
|
int64s => 8, |
5314
|
|
|
|
|
|
|
int64u => 8, |
5315
|
|
|
|
|
|
|
rational32s => 4, |
5316
|
|
|
|
|
|
|
rational32u => 4, |
5317
|
|
|
|
|
|
|
rational64s => 8, |
5318
|
|
|
|
|
|
|
rational64u => 8, |
5319
|
|
|
|
|
|
|
fixed16s => 2, |
5320
|
|
|
|
|
|
|
fixed16u => 2, |
5321
|
|
|
|
|
|
|
fixed32s => 4, |
5322
|
|
|
|
|
|
|
fixed32u => 4, |
5323
|
|
|
|
|
|
|
fixed64s => 8, |
5324
|
|
|
|
|
|
|
float => 4, |
5325
|
|
|
|
|
|
|
double => 8, |
5326
|
|
|
|
|
|
|
extended => 10, |
5327
|
|
|
|
|
|
|
unicode => 2, |
5328
|
|
|
|
|
|
|
complex => 8, |
5329
|
|
|
|
|
|
|
string => 1, |
5330
|
|
|
|
|
|
|
binary => 1, |
5331
|
|
|
|
|
|
|
'undef' => 1, |
5332
|
|
|
|
|
|
|
ifd => 4, |
5333
|
|
|
|
|
|
|
ifd64 => 8, |
5334
|
|
|
|
|
|
|
ue7 => 1, |
5335
|
|
|
|
|
|
|
); |
5336
|
|
|
|
|
|
|
my %readValueProc = ( |
5337
|
|
|
|
|
|
|
int8s => \&Get8s, |
5338
|
|
|
|
|
|
|
int8u => \&Get8u, |
5339
|
|
|
|
|
|
|
int16s => \&Get16s, |
5340
|
|
|
|
|
|
|
int16u => \&Get16u, |
5341
|
|
|
|
|
|
|
int16uRev => \&Get16uRev, |
5342
|
|
|
|
|
|
|
int32s => \&Get32s, |
5343
|
|
|
|
|
|
|
int32u => \&Get32u, |
5344
|
|
|
|
|
|
|
int32uRev => \&Get32uRev, |
5345
|
|
|
|
|
|
|
int64s => \&Get64s, |
5346
|
|
|
|
|
|
|
int64u => \&Get64u, |
5347
|
|
|
|
|
|
|
rational32s => \&GetRational32s, |
5348
|
|
|
|
|
|
|
rational32u => \&GetRational32u, |
5349
|
|
|
|
|
|
|
rational64s => \&GetRational64s, |
5350
|
|
|
|
|
|
|
rational64u => \&GetRational64u, |
5351
|
|
|
|
|
|
|
fixed16s => \&GetFixed16s, |
5352
|
|
|
|
|
|
|
fixed16u => \&GetFixed16u, |
5353
|
|
|
|
|
|
|
fixed32s => \&GetFixed32s, |
5354
|
|
|
|
|
|
|
fixed32u => \&GetFixed32u, |
5355
|
|
|
|
|
|
|
fixed64s => \&GetFixed64s, |
5356
|
|
|
|
|
|
|
float => \&GetFloat, |
5357
|
|
|
|
|
|
|
double => \&GetDouble, |
5358
|
|
|
|
|
|
|
extended => \&GetExtended, |
5359
|
|
|
|
|
|
|
ifd => \&Get32u, |
5360
|
|
|
|
|
|
|
ifd64 => \&Get64u, |
5361
|
|
|
|
|
|
|
); |
5362
|
|
|
|
|
|
|
# lookup for all rational types |
5363
|
|
|
|
|
|
|
my %isRational = ( |
5364
|
|
|
|
|
|
|
rational32u => 1, |
5365
|
|
|
|
|
|
|
rational32s => 1, |
5366
|
|
|
|
|
|
|
rational64u => 1, |
5367
|
|
|
|
|
|
|
rational64s => 1, |
5368
|
|
|
|
|
|
|
); |
5369
|
1515
|
|
|
1515
|
0
|
3561
|
sub FormatSize($) { return $formatSize{$_[0]}; } |
5370
|
|
|
|
|
|
|
|
5371
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5372
|
|
|
|
|
|
|
# Read value from binary data (with current byte ordering) |
5373
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) value offset, 2) format string, |
5374
|
|
|
|
|
|
|
# 3) number of values (or undef to use all data), |
5375
|
|
|
|
|
|
|
# 4) valid data length relative to offset (or undef to use all data), |
5376
|
|
|
|
|
|
|
# 5) optional pointer to returned rational |
5377
|
|
|
|
|
|
|
# Returns: converted value, or undefined if data isn't there |
5378
|
|
|
|
|
|
|
# or list of values in list context |
5379
|
|
|
|
|
|
|
sub ReadValue($$$;$$$) |
5380
|
|
|
|
|
|
|
{ |
5381
|
35324
|
|
|
35324
|
0
|
64664
|
my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_; |
5382
|
|
|
|
|
|
|
|
5383
|
35324
|
|
|
|
|
53088
|
my $len = $formatSize{$format}; |
5384
|
35324
|
50
|
|
|
|
56734
|
unless ($len) { |
5385
|
0
|
|
|
|
|
0
|
warn "Unknown format $format"; |
5386
|
0
|
|
|
|
|
0
|
$len = 1; |
5387
|
|
|
|
|
|
|
} |
5388
|
35324
|
50
|
|
|
|
52963
|
$size = length($$dataPt) - $offset unless defined $size; |
5389
|
35324
|
100
|
|
|
|
50646
|
unless ($count) { |
5390
|
1358
|
100
|
100
|
|
|
4431
|
return '' if defined $count or $size < $len; |
5391
|
1329
|
|
|
|
|
2393
|
$count = int($size / $len); |
5392
|
|
|
|
|
|
|
} |
5393
|
|
|
|
|
|
|
# make sure entry is inside data |
5394
|
35295
|
100
|
|
|
|
58248
|
if ($len * $count > $size) { |
5395
|
3
|
|
|
|
|
9
|
$count = int($size / $len); # shorten count if necessary |
5396
|
3
|
50
|
|
|
|
15
|
$count < 1 and return undef; # return undefined if no data |
5397
|
|
|
|
|
|
|
} |
5398
|
35292
|
|
|
|
|
40592
|
my @vals; |
5399
|
35292
|
|
|
|
|
48173
|
my $proc = $readValueProc{$format}; |
5400
|
35292
|
100
|
100
|
|
|
86213
|
if (not $proc) { |
|
|
100
|
|
|
|
|
|
5401
|
|
|
|
|
|
|
# handle undef/binary/string (also unsupported unicode/complex) |
5402
|
6150
|
|
|
|
|
16159
|
$vals[0] = substr($$dataPt, $offset, $count * $len); |
5403
|
|
|
|
|
|
|
# truncate string at null terminator if necessary |
5404
|
6150
|
100
|
|
|
|
23935
|
$vals[0] =~ s/\0.*//s if $format eq 'string'; |
5405
|
|
|
|
|
|
|
} elsif ($isRational{$format} and $ratPt) { |
5406
|
|
|
|
|
|
|
# store rationals separately as string fractions |
5407
|
2988
|
|
|
|
|
3719
|
my @rat; |
5408
|
2988
|
|
|
|
|
3652
|
for (;;) { |
5409
|
3287
|
|
|
|
|
7160
|
push @vals, &$proc($dataPt, $offset); |
5410
|
3287
|
|
|
|
|
8089
|
push @rat, "$ratNumer/$ratDenom"; |
5411
|
3287
|
100
|
|
|
|
6872
|
last if --$count <= 0; |
5412
|
299
|
|
|
|
|
397
|
$offset += $len; |
5413
|
|
|
|
|
|
|
} |
5414
|
2988
|
|
|
|
|
6868
|
$$ratPt = join(' ',@rat); |
5415
|
|
|
|
|
|
|
} else { |
5416
|
26154
|
|
|
|
|
30404
|
for (;;) { |
5417
|
48343
|
|
|
|
|
71242
|
push @vals, &$proc($dataPt, $offset); |
5418
|
48343
|
100
|
|
|
|
83713
|
last if --$count <= 0; |
5419
|
22189
|
|
|
|
|
24600
|
$offset += $len; |
5420
|
|
|
|
|
|
|
} |
5421
|
|
|
|
|
|
|
} |
5422
|
35292
|
100
|
|
|
|
58100
|
return @vals if wantarray; |
5423
|
34880
|
100
|
|
|
|
73752
|
return join(' ', @vals) if @vals > 1; |
5424
|
31324
|
|
|
|
|
62538
|
return $vals[0]; |
5425
|
|
|
|
|
|
|
} |
5426
|
|
|
|
|
|
|
|
5427
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5428
|
|
|
|
|
|
|
# Decode string with specified encoding |
5429
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) string to decode |
5430
|
|
|
|
|
|
|
# 2) source character set name (undef for current Charset) |
5431
|
|
|
|
|
|
|
# 3) optional source byte order (2-byte and 4-byte fixed-width sets only) |
5432
|
|
|
|
|
|
|
# 4) optional destination character set (defaults to Charset setting) |
5433
|
|
|
|
|
|
|
# 5) optional destination byte order (2-byte and 4-byte fixed-width only) |
5434
|
|
|
|
|
|
|
# Returns: string in destination encoding |
5435
|
|
|
|
|
|
|
# Note: ExifTool ref may be undef if character both character sets are provided |
5436
|
|
|
|
|
|
|
# (but in this case no warnings will be issued) |
5437
|
|
|
|
|
|
|
sub Decode($$$;$$$) |
5438
|
|
|
|
|
|
|
{ |
5439
|
6158
|
|
|
6158
|
0
|
11534
|
my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_; |
5440
|
6158
|
100
|
|
|
|
10384
|
$from or $from = $$self{OPTIONS}{Charset}; |
5441
|
6158
|
100
|
|
|
|
12869
|
$to or $to = $$self{OPTIONS}{Charset}; |
5442
|
6158
|
100
|
100
|
|
|
13519
|
if ($from ne $to and length $val) { |
5443
|
1089
|
|
|
|
|
22720
|
require Image::ExifTool::Charset; |
5444
|
1089
|
|
|
|
|
1932
|
my $cs1 = $Image::ExifTool::Charset::csType{$from}; |
5445
|
1089
|
|
|
|
|
1468
|
my $cs2 = $Image::ExifTool::Charset::csType{$to}; |
5446
|
1089
|
50
|
33
|
|
|
4580
|
if ($cs1 and $cs2 and not $cs2 & 0x002) { |
|
|
0
|
33
|
|
|
|
|
5447
|
|
|
|
|
|
|
# treat as straight ASCII if no character will need remapping |
5448
|
1089
|
100
|
100
|
|
|
3291
|
if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) { |
5449
|
776
|
|
|
|
|
1981
|
my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder); |
5450
|
776
|
|
|
|
|
1723
|
$val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder); |
5451
|
|
|
|
|
|
|
} |
5452
|
|
|
|
|
|
|
} elsif ($self) { |
5453
|
0
|
0
|
|
|
|
0
|
my $set = $cs1 ? $to : $from; |
5454
|
0
|
0
|
|
|
|
0
|
unless ($$self{"DecodeWarn$set"}) { |
5455
|
0
|
|
|
|
|
0
|
$self->Warn("Unsupported character set ($set)"); |
5456
|
0
|
|
|
|
|
0
|
$$self{"DecodeWarn$set"} = 1; |
5457
|
|
|
|
|
|
|
} |
5458
|
|
|
|
|
|
|
} |
5459
|
|
|
|
|
|
|
} |
5460
|
6158
|
|
|
|
|
13299
|
return $val; |
5461
|
|
|
|
|
|
|
} |
5462
|
|
|
|
|
|
|
|
5463
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5464
|
|
|
|
|
|
|
# Encode string with specified encoding |
5465
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name, |
5466
|
|
|
|
|
|
|
# 3) optional destination byte order (2-byte and 4-byte fixed-width sets only) |
5467
|
|
|
|
|
|
|
# Returns: string in specified encoding |
5468
|
|
|
|
|
|
|
sub Encode($$$;$) |
5469
|
|
|
|
|
|
|
{ |
5470
|
59
|
|
|
59
|
0
|
161
|
my ($self, $val, $to, $toOrder) = @_; |
5471
|
59
|
|
|
|
|
198
|
return $self->Decode($val, undef, undef, $to, $toOrder); |
5472
|
|
|
|
|
|
|
} |
5473
|
|
|
|
|
|
|
|
5474
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5475
|
|
|
|
|
|
|
# Decode bit mask |
5476
|
|
|
|
|
|
|
# Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef) |
5477
|
|
|
|
|
|
|
# 2) optional bits per word (defaults to 32) |
5478
|
|
|
|
|
|
|
sub DecodeBits($$;$) |
5479
|
|
|
|
|
|
|
{ |
5480
|
169
|
|
|
169
|
0
|
639
|
my ($vals, $lookup, $bits) = @_; |
5481
|
169
|
100
|
|
|
|
495
|
$bits or $bits = 32; |
5482
|
169
|
|
|
|
|
295
|
my ($val, $i, @bitList); |
5483
|
169
|
|
|
|
|
282
|
my $num = 0; |
5484
|
169
|
|
|
|
|
534
|
foreach $val (split ' ', $vals) { |
5485
|
237
|
|
|
|
|
639
|
for ($i=0; $i<$bits; ++$i) { |
5486
|
5888
|
100
|
|
|
|
10200
|
next unless $val & (1 << $i); |
5487
|
134
|
|
|
|
|
221
|
my $n = $i + $num; |
5488
|
134
|
100
|
|
|
|
408
|
if (not $lookup) { |
|
|
100
|
|
|
|
|
|
5489
|
19
|
|
|
|
|
54
|
push @bitList, $n; |
5490
|
|
|
|
|
|
|
} elsif ($$lookup{$n}) { |
5491
|
109
|
|
|
|
|
273
|
push @bitList, $$lookup{$n}; |
5492
|
|
|
|
|
|
|
} else { |
5493
|
6
|
|
|
|
|
18
|
push @bitList, "[$n]"; |
5494
|
|
|
|
|
|
|
} |
5495
|
|
|
|
|
|
|
} |
5496
|
237
|
|
|
|
|
558
|
$num += $bits; |
5497
|
|
|
|
|
|
|
} |
5498
|
169
|
100
|
|
|
|
664
|
return '(none)' unless @bitList; |
5499
|
93
|
100
|
|
|
|
614
|
return join($lookup ? ', ' : ',', @bitList); |
5500
|
|
|
|
|
|
|
} |
5501
|
|
|
|
|
|
|
|
5502
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5503
|
|
|
|
|
|
|
# Validate an extracted image and repair if necessary |
5504
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key |
5505
|
|
|
|
|
|
|
# Returns: image reference or undef if it wasn't valid |
5506
|
|
|
|
|
|
|
# Note: should be called from RawConv, not ValueConv |
5507
|
|
|
|
|
|
|
sub ValidateImage($$$) |
5508
|
|
|
|
|
|
|
{ |
5509
|
199
|
|
|
199
|
0
|
644
|
my ($self, $imagePt, $tag) = @_; |
5510
|
199
|
50
|
|
|
|
616
|
return undef if $$imagePt eq 'none'; |
5511
|
199
|
100
|
66
|
|
|
1623
|
unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or |
|
|
|
100
|
|
|
|
|
5512
|
|
|
|
|
|
|
# the first byte of the preview of some Minolta cameras is wrong, |
5513
|
|
|
|
|
|
|
# so check for this and set it back to 0xff if necessary |
5514
|
|
|
|
|
|
|
$$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or |
5515
|
|
|
|
|
|
|
$self->Options('IgnoreMinorErrors')) |
5516
|
|
|
|
|
|
|
{ |
5517
|
|
|
|
|
|
|
# issue warning only if the tag was specifically requested |
5518
|
113
|
50
|
|
|
|
485
|
if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) { |
5519
|
0
|
|
|
|
|
0
|
$self->Warn("$tag is not a valid JPEG image",1); |
5520
|
0
|
|
|
|
|
0
|
return undef; |
5521
|
|
|
|
|
|
|
} |
5522
|
|
|
|
|
|
|
} |
5523
|
199
|
|
|
|
|
1828
|
return $imagePt; |
5524
|
|
|
|
|
|
|
} |
5525
|
|
|
|
|
|
|
|
5526
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5527
|
|
|
|
|
|
|
# Validate a tag name argument (including group name and wildcards, etc) |
5528
|
|
|
|
|
|
|
# Inputs: 0) tag name |
5529
|
|
|
|
|
|
|
# Returns: true if tag name is valid |
5530
|
|
|
|
|
|
|
# - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9] |
5531
|
|
|
|
|
|
|
# - tag names may contain wildcards [?*], and end with a hash [#] |
5532
|
|
|
|
|
|
|
# - may have group name prefixes (which may have family number prefix), separated by colons |
5533
|
|
|
|
|
|
|
# - a group name may be zero or more characters |
5534
|
|
|
|
|
|
|
sub ValidTagName($) |
5535
|
|
|
|
|
|
|
{ |
5536
|
41
|
|
|
41
|
0
|
71
|
my $tag = shift; |
5537
|
41
|
|
|
|
|
288
|
return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/; |
5538
|
|
|
|
|
|
|
} |
5539
|
|
|
|
|
|
|
|
5540
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5541
|
|
|
|
|
|
|
# Generate a valid tag name based on the tag ID or name |
5542
|
|
|
|
|
|
|
# Inputs: 0) tag ID or name |
5543
|
|
|
|
|
|
|
# Returns: valid tag name |
5544
|
|
|
|
|
|
|
sub MakeTagName($) |
5545
|
|
|
|
|
|
|
{ |
5546
|
33611
|
|
|
33611
|
0
|
37665
|
my $name = shift; |
5547
|
33611
|
|
|
|
|
49163
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
5548
|
33611
|
|
|
|
|
44630
|
$name = ucfirst $name; # capitalize first letter |
5549
|
33611
|
50
|
|
|
|
48910
|
$name = "Tag$name" if length($name) < 2; # must at least 2 characters long |
5550
|
33611
|
|
|
|
|
51552
|
return $name; |
5551
|
|
|
|
|
|
|
} |
5552
|
|
|
|
|
|
|
|
5553
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5554
|
|
|
|
|
|
|
# Make description from a tag name |
5555
|
|
|
|
|
|
|
# Inputs: 0) tag name 1) optional tagID to add at end of description |
5556
|
|
|
|
|
|
|
# Returns: description |
5557
|
|
|
|
|
|
|
sub MakeDescription($;$) |
5558
|
|
|
|
|
|
|
{ |
5559
|
10175
|
|
|
10175
|
0
|
15419
|
my ($tag, $tagID) = @_; |
5560
|
|
|
|
|
|
|
# start with the tag name and force first letter to be upper case |
5561
|
10175
|
|
|
|
|
15812
|
my $desc = ucfirst($tag); |
5562
|
|
|
|
|
|
|
# translate underlines to spaces |
5563
|
10175
|
|
|
|
|
14235
|
$desc =~ tr/_/ /; |
5564
|
|
|
|
|
|
|
# remove hex TagID from name (to avoid inserting spaces in the number) |
5565
|
10175
|
100
|
66
|
|
|
24906
|
$desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID; |
5566
|
|
|
|
|
|
|
# put a space between lower/UPPER case and lower/number combinations |
5567
|
10175
|
|
|
|
|
50488
|
$desc =~ s/([a-z])([A-Z\d])/$1 $2/g; |
5568
|
|
|
|
|
|
|
# put a space between acronyms and words |
5569
|
10175
|
|
|
|
|
22307
|
$desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g; |
5570
|
|
|
|
|
|
|
# put spaces after numbers (if more than one character follows the number) |
5571
|
10175
|
|
|
|
|
13919
|
$desc =~ s/(\d)([A-Z]\S)/$1 $2/g; |
5572
|
|
|
|
|
|
|
# add TagID to description |
5573
|
10175
|
100
|
|
|
|
16182
|
$desc .= ' ' . $tagID if defined $tagID; |
5574
|
10175
|
|
|
|
|
21827
|
return $desc; |
5575
|
|
|
|
|
|
|
} |
5576
|
|
|
|
|
|
|
|
5577
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5578
|
|
|
|
|
|
|
# Get descriptions for all tags in an array |
5579
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) reference to list of tag keys |
5580
|
|
|
|
|
|
|
# Returns: reference to hash lookup for descriptions |
5581
|
|
|
|
|
|
|
# Note: Returned descriptions are NOT escaped by ESCAPE_PROC |
5582
|
|
|
|
|
|
|
sub GetDescriptions($$) |
5583
|
|
|
|
|
|
|
{ |
5584
|
0
|
|
|
0
|
0
|
0
|
local $_; |
5585
|
0
|
|
|
|
|
0
|
my ($self, $tags) = @_; |
5586
|
0
|
|
|
|
|
0
|
my %desc; |
5587
|
0
|
|
|
|
|
0
|
my $oldEscape = $$self{ESCAPE_PROC}; |
5588
|
0
|
|
|
|
|
0
|
delete $$self{ESCAPE_PROC}; |
5589
|
0
|
|
|
|
|
0
|
$desc{$_} = $self->GetDescription($_) foreach @$tags; |
5590
|
0
|
|
|
|
|
0
|
$$self{ESCAPE_PROC} = $oldEscape; |
5591
|
0
|
|
|
|
|
0
|
return \%desc; |
5592
|
|
|
|
|
|
|
} |
5593
|
|
|
|
|
|
|
|
5594
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5595
|
|
|
|
|
|
|
# Apply filter to value(s) if necessary |
5596
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter |
5597
|
|
|
|
|
|
|
# Returns: true unless a filter returned undef; changes value if necessary |
5598
|
|
|
|
|
|
|
sub Filter($$$) |
5599
|
|
|
|
|
|
|
{ |
5600
|
12951
|
|
|
12951
|
1
|
16547
|
local $_; |
5601
|
12951
|
|
|
|
|
23838
|
my ($self, $filter, $valPt) = @_; |
5602
|
12951
|
100
|
66
|
|
|
35540
|
return 1 unless defined $filter and defined $$valPt; |
5603
|
463
|
|
|
|
|
576
|
my $rtnVal; |
5604
|
463
|
100
|
|
|
|
820
|
if (not ref $$valPt) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5605
|
447
|
|
|
|
|
649
|
$_ = $$valPt; |
5606
|
|
|
|
|
|
|
#### eval Filter ($_, $self) |
5607
|
447
|
|
|
|
|
19523
|
eval $filter; |
5608
|
447
|
50
|
|
|
|
1370
|
if (defined $_) { |
5609
|
447
|
|
|
|
|
721
|
$$valPt = $_; |
5610
|
447
|
|
|
|
|
615
|
$rtnVal = 1; |
5611
|
|
|
|
|
|
|
} |
5612
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'SCALAR') { |
5613
|
12
|
|
|
|
|
22
|
my $val = $$$valPt; # make a copy to avoid filtering twice |
5614
|
12
|
|
|
|
|
32
|
$rtnVal = $self->Filter($filter, \$val); |
5615
|
12
|
|
|
|
|
30
|
$$valPt = \$val; |
5616
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'ARRAY') { |
5617
|
4
|
|
|
|
|
7
|
my @val = @{$$valPt}; # make a copy to avoid filtering twice |
|
4
|
|
|
|
|
15
|
|
5618
|
4
|
|
50
|
|
|
15
|
$self->Filter($filter, \$_) and $rtnVal = 1 foreach @val; |
5619
|
4
|
|
|
|
|
10
|
$$valPt = \@val; |
5620
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'HASH') { |
5621
|
0
|
|
|
|
|
0
|
my %val = %{$$valPt}; # make a copy to avoid filtering twice |
|
0
|
|
|
|
|
0
|
|
5622
|
0
|
|
0
|
|
|
0
|
$self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val; |
5623
|
0
|
|
|
|
|
0
|
$$valPt = \%val; |
5624
|
|
|
|
|
|
|
} else { |
5625
|
0
|
|
|
|
|
0
|
$rtnVal = 1; |
5626
|
|
|
|
|
|
|
} |
5627
|
463
|
|
|
|
|
666
|
return $rtnVal; |
5628
|
|
|
|
|
|
|
} |
5629
|
|
|
|
|
|
|
|
5630
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5631
|
|
|
|
|
|
|
# Return printable value |
5632
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
5633
|
|
|
|
|
|
|
# 1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited) |
5634
|
|
|
|
|
|
|
sub Printable($;$) |
5635
|
|
|
|
|
|
|
{ |
5636
|
593
|
|
|
593
|
0
|
910
|
my ($self, $outStr, $maxLen) = @_; |
5637
|
593
|
50
|
|
|
|
997
|
return '(undef)' unless defined $outStr; |
5638
|
593
|
|
|
|
|
1018
|
$outStr =~ tr/\x01-\x1f\x7f-\xff/./; |
5639
|
593
|
|
|
|
|
1346
|
$outStr =~ s/\x00//g; |
5640
|
593
|
|
|
|
|
861
|
my $verbose = $$self{OPTIONS}{Verbose}; |
5641
|
593
|
50
|
|
|
|
962
|
if ($verbose < 4) { |
5642
|
593
|
100
|
|
|
|
852
|
if ($maxLen) { |
|
|
50
|
|
|
|
|
|
5643
|
592
|
50
|
|
|
|
973
|
$maxLen = 20 if $maxLen < 20; # minimum length is 20 |
5644
|
|
|
|
|
|
|
} elsif (defined $maxLen) { |
5645
|
1
|
|
|
|
|
3
|
$maxLen = length $outStr; # 0 is unlimited |
5646
|
|
|
|
|
|
|
} else { |
5647
|
0
|
|
|
|
|
0
|
$maxLen = 60; # default maximum is 60 |
5648
|
|
|
|
|
|
|
} |
5649
|
|
|
|
|
|
|
} else { |
5650
|
0
|
|
|
|
|
0
|
$maxLen = length $outStr; |
5651
|
|
|
|
|
|
|
# limit to 2048 characters if verbose < 5 |
5652
|
0
|
0
|
0
|
|
|
0
|
$maxLen = 2048 if $maxLen > 2048 and $verbose < 5; |
5653
|
|
|
|
|
|
|
} |
5654
|
|
|
|
|
|
|
|
5655
|
|
|
|
|
|
|
# limit length if necessary |
5656
|
593
|
100
|
|
|
|
985
|
$outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen; |
5657
|
593
|
|
|
|
|
1436
|
return $outStr; |
5658
|
|
|
|
|
|
|
} |
5659
|
|
|
|
|
|
|
|
5660
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5661
|
|
|
|
|
|
|
# Convert date/time from Exif format |
5662
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format |
5663
|
|
|
|
|
|
|
# Returns: Formatted date/time string |
5664
|
|
|
|
|
|
|
sub ConvertDateTime($$) |
5665
|
|
|
|
|
|
|
{ |
5666
|
1767
|
|
|
1767
|
0
|
3960
|
my ($self, $date) = @_; |
5667
|
1767
|
|
|
|
|
3649
|
my $fmt = $$self{OPTIONS}{DateFormat}; |
5668
|
1767
|
|
|
|
|
2732
|
my $shift = $$self{OPTIONS}{GlobalTimeShift}; |
5669
|
1767
|
100
|
|
|
|
3928
|
if ($shift) { |
5670
|
8
|
50
|
33
|
|
|
59
|
my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1; |
5671
|
8
|
|
|
|
|
18
|
my $offset = $$self{GLOBAL_TIME_OFFSET}; |
5672
|
8
|
100
|
|
|
|
17
|
$offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { }; |
5673
|
8
|
|
|
|
|
27
|
ShiftTime($date, $shift, $dir, $offset); |
5674
|
|
|
|
|
|
|
} |
5675
|
|
|
|
|
|
|
# only convert date if a format was specified and the date is recognizable |
5676
|
1767
|
100
|
|
|
|
3369
|
if ($fmt) { |
5677
|
|
|
|
|
|
|
# separate time zone if it exists |
5678
|
5
|
|
|
|
|
9
|
my $tz; |
5679
|
5
|
100
|
|
|
|
28
|
$date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1; |
5680
|
|
|
|
|
|
|
# a few cameras use incorrect date/time formatting: |
5681
|
|
|
|
|
|
|
# - slashes instead of colons in date (RolleiD330, ImpressCam) |
5682
|
|
|
|
|
|
|
# - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar) |
5683
|
|
|
|
|
|
|
# - single-digit seconds with leading space (HP scanners) |
5684
|
5
|
|
|
|
|
30
|
my @a = reverse ($date =~ /\d+/g); # be very flexible about date/time format |
5685
|
5
|
50
|
33
|
|
|
39
|
if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) { |
|
5
|
0
|
33
|
|
|
28
|
|
|
|
|
33
|
|
|
|
|
5686
|
5
|
|
|
|
|
13
|
shift @a while @a > 6; # remove superfluous entries |
5687
|
5
|
|
|
|
|
13
|
unshift @a, 1 while @a < 3; # add month and day if necessary |
5688
|
5
|
|
|
|
|
11
|
unshift @a, 0 while @a < 6; # add h,m,s if necessary |
5689
|
5
|
|
|
|
|
10
|
$a[4] -= 1; # base month is 1 |
5690
|
|
|
|
|
|
|
# parse our %f fractional seconds first (and round up seconds if necessary) |
5691
|
|
|
|
|
|
|
# - if there are multiple %f codes, they all get the same number of digits as the first |
5692
|
5
|
50
|
|
|
|
22
|
if ($fmt =~ /%\.?(\d*)f/) { |
5693
|
0
|
|
|
|
|
0
|
my $dig = $1; |
5694
|
0
|
0
|
|
|
|
0
|
my $frac = $date =~ /(\.\d+)/ ? $1 : ''; |
5695
|
0
|
0
|
|
|
|
0
|
if (not $frac) { |
|
|
0
|
|
|
|
|
|
5696
|
0
|
0
|
|
|
|
0
|
$frac = '.' . ('0' x $dig) if $dig; |
5697
|
|
|
|
|
|
|
} elsif (length $dig) { |
5698
|
0
|
0
|
|
|
|
0
|
if ($dig+1 > length($frac)) { |
|
|
0
|
|
|
|
|
|
5699
|
0
|
|
|
|
|
0
|
$frac .= '0' x ($dig+1-length($frac)); |
5700
|
|
|
|
|
|
|
} elsif ($dig+1 < length($frac)) { |
5701
|
0
|
|
|
|
|
0
|
$frac = sprintf("%.${dig}f", $frac); |
5702
|
0
|
|
0
|
|
|
0
|
while ($frac =~ s/^(\d)// and $1 ne '0') { |
5703
|
|
|
|
|
|
|
# this is a pain, but we must round up to the next second |
5704
|
0
|
0
|
|
|
|
0
|
++$a[0] < 60 and last; |
5705
|
0
|
|
|
|
|
0
|
$a[0] = 0; |
5706
|
0
|
0
|
|
|
|
0
|
++$a[1] < 60 and last; |
5707
|
0
|
|
|
|
|
0
|
$a[1] = 0; |
5708
|
0
|
0
|
|
|
|
0
|
++$a[2] < 24 and last; |
5709
|
0
|
|
|
|
|
0
|
$a[2] = 0; |
5710
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/Shift.pl'; |
5711
|
0
|
0
|
|
|
|
0
|
++$a[3] <= DaysInMonth($a[4]+1, $a[5]) and last; |
5712
|
0
|
|
|
|
|
0
|
$a[3] = 1; |
5713
|
0
|
0
|
|
|
|
0
|
++$a[4] < 12 and last; |
5714
|
0
|
|
|
|
|
0
|
$a[4] = 0; |
5715
|
0
|
|
|
|
|
0
|
++$a[5]; |
5716
|
0
|
|
|
|
|
0
|
last; # (this was a goto) |
5717
|
|
|
|
|
|
|
} |
5718
|
|
|
|
|
|
|
} |
5719
|
|
|
|
|
|
|
} |
5720
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%\.?\d*f/$1$2$frac/g; |
5721
|
|
|
|
|
|
|
} |
5722
|
|
|
|
|
|
|
# parse %z and %s ourself (to handle time zones properly) |
5723
|
5
|
50
|
|
|
|
16
|
if ($fmt =~ /%[sz]/) { |
5724
|
|
|
|
|
|
|
# use system time zone unless otherwise specified |
5725
|
0
|
0
|
0
|
|
|
0
|
$tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local }; |
|
0
|
|
|
|
|
0
|
|
5726
|
|
|
|
|
|
|
# remove colon, setting to UTC if time zone is not numeric |
5727
|
0
|
0
|
0
|
|
|
0
|
$tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000'; |
5728
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g; # convert '%z' format codes |
5729
|
0
|
0
|
0
|
|
|
0
|
if ($fmt =~ /%s/ and eval { require Time::Local }) { |
|
0
|
|
|
|
|
0
|
|
5730
|
|
|
|
|
|
|
# calculate seconds since the Epoch, UTC |
5731
|
0
|
|
|
|
|
0
|
my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40); |
5732
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g; # convert '%s' format codes |
5733
|
|
|
|
|
|
|
} |
5734
|
|
|
|
|
|
|
} |
5735
|
5
|
|
|
|
|
7
|
$a[5] -= 1900; # strftime year starts from 1900 |
5736
|
5
|
|
|
|
|
170
|
$date = POSIX::strftime($fmt, @a); # generate the formatted date/time |
5737
|
|
|
|
|
|
|
} elsif ($$self{OPTIONS}{StrictDate}) { |
5738
|
0
|
|
|
|
|
0
|
undef $date; |
5739
|
|
|
|
|
|
|
} |
5740
|
|
|
|
|
|
|
} |
5741
|
1767
|
|
|
|
|
9361
|
return $date; |
5742
|
|
|
|
|
|
|
} |
5743
|
|
|
|
|
|
|
|
5744
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5745
|
|
|
|
|
|
|
# Print conversion for time span value |
5746
|
|
|
|
|
|
|
# Inputs: 0) time ticks, 1) number of seconds per tick (default 1) |
5747
|
|
|
|
|
|
|
# Returns: readable time |
5748
|
|
|
|
|
|
|
sub ConvertTimeSpan($;$) |
5749
|
|
|
|
|
|
|
{ |
5750
|
3
|
|
|
3
|
0
|
10
|
my ($val, $mult) = @_; |
5751
|
3
|
50
|
33
|
|
|
39
|
if (Image::ExifTool::IsFloat($val) and $val != 0) { |
5752
|
3
|
100
|
|
|
|
10
|
$val *= $mult if $mult; |
5753
|
3
|
50
|
|
|
|
13
|
if ($val < 60) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5754
|
0
|
|
|
|
|
0
|
$val = "$val seconds"; |
5755
|
|
|
|
|
|
|
} elsif ($val < 3600) { |
5756
|
3
|
100
|
66
|
|
|
15
|
my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f'; |
5757
|
3
|
100
|
66
|
|
|
13
|
my $s = ($val == 60 and $mult) ? '' : 's'; |
5758
|
3
|
|
|
|
|
24
|
$val = sprintf("$fmt minute$s", $val / 60); |
5759
|
|
|
|
|
|
|
} elsif ($val < 24 * 3600) { |
5760
|
0
|
|
|
|
|
0
|
$val = sprintf("%.1f hours", $val / 3600); |
5761
|
|
|
|
|
|
|
} else { |
5762
|
0
|
|
|
|
|
0
|
$val = sprintf("%.1f days", $val / (24 * 3600)); |
5763
|
|
|
|
|
|
|
} |
5764
|
|
|
|
|
|
|
} |
5765
|
3
|
|
|
|
|
21
|
return $val; |
5766
|
|
|
|
|
|
|
} |
5767
|
|
|
|
|
|
|
|
5768
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5769
|
|
|
|
|
|
|
# Patched timelocal() that fixes ActivePerl timezone bug |
5770
|
|
|
|
|
|
|
# Inputs/Returns: same as timelocal() |
5771
|
|
|
|
|
|
|
# Notes: must 'require Time::Local' before calling this routine |
5772
|
|
|
|
|
|
|
sub TimeLocal(@) |
5773
|
|
|
|
|
|
|
{ |
5774
|
36
|
|
|
36
|
0
|
1328
|
my $tm = Time::Local::timelocal(@_); |
5775
|
36
|
50
|
|
|
|
2348
|
if ($^O eq 'MSWin32') { |
5776
|
|
|
|
|
|
|
# patch for ActivePerl timezone bug |
5777
|
0
|
|
|
|
|
0
|
my @t2 = localtime($tm); |
5778
|
0
|
|
|
|
|
0
|
my $t2 = Time::Local::timelocal(@t2); |
5779
|
|
|
|
|
|
|
# adjust timelocal() return value to be consistent with localtime() |
5780
|
0
|
|
|
|
|
0
|
$tm += $tm - $t2; |
5781
|
|
|
|
|
|
|
} |
5782
|
36
|
|
|
|
|
98
|
return $tm; |
5783
|
|
|
|
|
|
|
} |
5784
|
|
|
|
|
|
|
|
5785
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5786
|
|
|
|
|
|
|
# Get time zone in minutes |
5787
|
|
|
|
|
|
|
# Inputs: 0) localtime array ref, 1) gmtime array ref |
5788
|
|
|
|
|
|
|
# Returns: time zone offset in minutes |
5789
|
|
|
|
|
|
|
sub GetTimeZone($$) |
5790
|
|
|
|
|
|
|
{ |
5791
|
918
|
|
|
918
|
0
|
3083
|
my ($tm, $gm) = @_; |
5792
|
|
|
|
|
|
|
# compute the number of minutes between localtime and gmtime |
5793
|
918
|
|
|
|
|
2906
|
my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]); |
5794
|
918
|
50
|
|
|
|
2114
|
if ($$tm[3] != $$gm[3]) { |
5795
|
|
|
|
|
|
|
# account for case where one date wraps to the first of the next month |
5796
|
0
|
0
|
|
|
|
0
|
$$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1; |
|
|
0
|
|
|
|
|
|
5797
|
|
|
|
|
|
|
# adjust for the +/- one day difference |
5798
|
0
|
|
|
|
|
0
|
$min += ($$tm[3] - $$gm[3]) * 24 * 60; |
5799
|
|
|
|
|
|
|
} |
5800
|
|
|
|
|
|
|
# MirBSD patch to round to the nearest 30 minutes because |
5801
|
|
|
|
|
|
|
# it includes leap seconds in localtime but not gmtime |
5802
|
918
|
0
|
|
|
|
3075
|
$min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd'; |
|
|
50
|
|
|
|
|
|
5803
|
918
|
|
|
|
|
2290
|
return $min; |
5804
|
|
|
|
|
|
|
} |
5805
|
|
|
|
|
|
|
|
5806
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5807
|
|
|
|
|
|
|
# Get time zone string |
5808
|
|
|
|
|
|
|
# Inputs: 0) time zone offset in minutes |
5809
|
|
|
|
|
|
|
# or 0) localtime array ref, 1) corresponding time value |
5810
|
|
|
|
|
|
|
# Returns: time zone string ("+/-HH:MM") |
5811
|
|
|
|
|
|
|
sub TimeZoneString($;$) |
5812
|
|
|
|
|
|
|
{ |
5813
|
959
|
|
|
959
|
0
|
1843
|
my $min = shift; |
5814
|
959
|
100
|
|
|
|
2721
|
if (ref $min) { |
5815
|
918
|
|
|
|
|
4400
|
my @gm = gmtime(shift); |
5816
|
918
|
|
|
|
|
2490
|
$min = GetTimeZone($min, \@gm); |
5817
|
|
|
|
|
|
|
} |
5818
|
959
|
|
|
|
|
2150
|
my $sign = '+'; |
5819
|
959
|
100
|
|
|
|
2302
|
$min < 0 and $sign = '-', $min = -$min; |
5820
|
959
|
|
|
|
|
2230
|
$min = int($min + 0.5); # round off to nearest minute |
5821
|
959
|
|
|
|
|
1813
|
my $h = int($min / 60); |
5822
|
959
|
|
|
|
|
4813
|
return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60); |
5823
|
|
|
|
|
|
|
} |
5824
|
|
|
|
|
|
|
|
5825
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5826
|
|
|
|
|
|
|
# Convert Unix time to EXIF date/time string |
5827
|
|
|
|
|
|
|
# Inputs: 0) Unix time value, 1) non-zero to convert to local time, |
5828
|
|
|
|
|
|
|
# 2) number of digits after the decimal for fractional seconds |
5829
|
|
|
|
|
|
|
# Returns: EXIF date/time string (with timezone for local times) |
5830
|
|
|
|
|
|
|
sub ConvertUnixTime($;$$) |
5831
|
|
|
|
|
|
|
{ |
5832
|
1024
|
|
|
1024
|
0
|
2544
|
my ($time, $toLocal, $dec) = @_; |
5833
|
1024
|
100
|
|
|
|
2402
|
return '0000:00:00 00:00:00' if $time == 0; |
5834
|
1023
|
|
|
|
|
1621
|
my (@tm, $tz); |
5835
|
1023
|
50
|
|
|
|
1954
|
if ($dec) { |
5836
|
0
|
|
|
|
|
0
|
my $frac = $time - int($time); |
5837
|
0
|
|
|
|
|
0
|
$time = int($time); |
5838
|
0
|
0
|
|
|
|
0
|
$frac < 0 and $frac += 1, $time -= 1; |
5839
|
0
|
|
|
|
|
0
|
$dec = sprintf('%.*f', $dec, $frac); |
5840
|
|
|
|
|
|
|
# remove number before decimal and increment integer time if it was rounded up |
5841
|
0
|
0
|
0
|
|
|
0
|
$dec =~ s/^(\d)// and $1 eq '1' and $time += 1; |
5842
|
|
|
|
|
|
|
} else { |
5843
|
1023
|
100
|
|
|
|
2293
|
$time = int($time + 1e-6) if $time != int($time); # avoid round-off errors |
5844
|
1023
|
|
|
|
|
1572
|
$dec = ''; |
5845
|
|
|
|
|
|
|
} |
5846
|
1023
|
100
|
|
|
|
2235
|
if ($toLocal) { |
5847
|
859
|
|
|
|
|
26004
|
@tm = localtime($time); |
5848
|
859
|
|
|
|
|
3539
|
$tz = TimeZoneString(\@tm, $time); |
5849
|
|
|
|
|
|
|
} else { |
5850
|
164
|
|
|
|
|
893
|
@tm = gmtime($time); |
5851
|
164
|
|
|
|
|
279
|
$tz = ''; |
5852
|
|
|
|
|
|
|
} |
5853
|
1023
|
|
|
|
|
6212
|
my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s", |
5854
|
|
|
|
|
|
|
$tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz); |
5855
|
1023
|
|
|
|
|
7402
|
return $str; |
5856
|
|
|
|
|
|
|
} |
5857
|
|
|
|
|
|
|
|
5858
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5859
|
|
|
|
|
|
|
# Get Unix time from EXIF-formatted date/time string with optional timezone |
5860
|
|
|
|
|
|
|
# Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC |
5861
|
|
|
|
|
|
|
# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error |
5862
|
|
|
|
|
|
|
sub GetUnixTime($;$) |
5863
|
|
|
|
|
|
|
{ |
5864
|
162
|
|
|
162
|
0
|
28343
|
my ($timeStr, $isLocal) = @_; |
5865
|
162
|
50
|
|
|
|
409
|
return 0 if $timeStr eq '0000:00:00 00:00:00'; |
5866
|
162
|
|
|
|
|
844
|
my @tm = ($timeStr =~ /^(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)(.*)/); |
5867
|
162
|
50
|
|
|
|
507
|
return undef unless @tm == 7; |
5868
|
162
|
50
|
|
|
|
255
|
unless (eval { require Time::Local }) { |
|
162
|
|
|
|
|
4607
|
|
5869
|
0
|
|
|
|
|
0
|
warn "Time::Local is not installed\n"; |
5870
|
0
|
|
|
|
|
0
|
return undef; |
5871
|
|
|
|
|
|
|
} |
5872
|
162
|
|
|
|
|
16187
|
my ($tzStr, $tzSec) = (pop(@tm), 0); |
5873
|
|
|
|
|
|
|
# use specified timezone offset (if given) instead of local system time |
5874
|
|
|
|
|
|
|
# if we are converting a local time value |
5875
|
162
|
100
|
|
|
|
343
|
if ($isLocal) { |
5876
|
113
|
50
|
|
|
|
348
|
if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) { |
|
|
0
|
|
|
|
|
|
5877
|
|
|
|
|
|
|
# use specified timezone if one exists |
5878
|
113
|
100
|
|
|
|
435
|
$tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1; |
|
|
100
|
|
|
|
|
|
5879
|
113
|
|
|
|
|
166
|
undef $isLocal; # convert using GMT corrected for specified timezone |
5880
|
|
|
|
|
|
|
} elsif ($isLocal eq '2') { |
5881
|
0
|
|
|
|
|
0
|
undef $isLocal; |
5882
|
|
|
|
|
|
|
} |
5883
|
|
|
|
|
|
|
} |
5884
|
162
|
|
|
|
|
306
|
$tm[1] -= 1; # convert month |
5885
|
162
|
|
|
|
|
250
|
@tm = reverse @tm; # change to order required by timelocal() |
5886
|
162
|
50
|
|
|
|
548
|
my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec; |
5887
|
|
|
|
|
|
|
# handle fractional seconds |
5888
|
160
|
100
|
100
|
|
|
4498
|
$val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/; |
5889
|
160
|
|
|
|
|
1065
|
return $val; |
5890
|
|
|
|
|
|
|
} |
5891
|
|
|
|
|
|
|
|
5892
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5893
|
|
|
|
|
|
|
# Print conversion for file size |
5894
|
|
|
|
|
|
|
# Inputs: 0) file size in bytes |
5895
|
|
|
|
|
|
|
# Returns: converted file size |
5896
|
|
|
|
|
|
|
sub ConvertFileSize($) |
5897
|
|
|
|
|
|
|
{ |
5898
|
295
|
|
|
295
|
0
|
666
|
my $val = shift; |
5899
|
295
|
100
|
|
|
|
1134
|
$val < 2000 and return "$val bytes"; |
5900
|
190
|
100
|
|
|
|
1519
|
$val < 10000 and return sprintf('%.1f kB', $val / 1000); |
5901
|
50
|
100
|
|
|
|
385
|
$val < 2000000 and return sprintf('%.0f kB', $val / 1000); |
5902
|
4
|
100
|
|
|
|
37
|
$val < 10000000 and return sprintf('%.1f MB', $val / 1000000); |
5903
|
1
|
50
|
|
|
|
10
|
$val < 2000000000 and return sprintf('%.0f MB', $val / 1000000); |
5904
|
0
|
0
|
|
|
|
0
|
$val < 10000000000 and return sprintf('%.1f GB', $val / 1000000000); |
5905
|
0
|
|
|
|
|
0
|
return sprintf('%.0f GB', $val / 1000000000); |
5906
|
|
|
|
|
|
|
} |
5907
|
|
|
|
|
|
|
|
5908
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5909
|
|
|
|
|
|
|
# Convert seconds to duration string (handles negative durations) |
5910
|
|
|
|
|
|
|
# Inputs: 0) floating point seconds |
5911
|
|
|
|
|
|
|
# Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS" |
5912
|
|
|
|
|
|
|
sub ConvertDuration($) |
5913
|
|
|
|
|
|
|
{ |
5914
|
130
|
|
|
130
|
0
|
260
|
my $time = shift; |
5915
|
130
|
50
|
|
|
|
285
|
return $time unless IsFloat($time); |
5916
|
130
|
100
|
|
|
|
633
|
return '0 s' if $time == 0; |
5917
|
61
|
50
|
|
|
|
199
|
my $sign = ($time > 0 ? '' : (($time = -$time), '-')); |
5918
|
61
|
100
|
|
|
|
706
|
return sprintf("$sign%.2f s", $time) if $time < 30; |
5919
|
4
|
|
|
|
|
7
|
$time += 0.5; # to round off to nearest second |
5920
|
4
|
|
|
|
|
12
|
my $h = int($time / 3600); |
5921
|
4
|
|
|
|
|
10
|
$time -= $h * 3600; |
5922
|
4
|
|
|
|
|
8
|
my $m = int($time / 60); |
5923
|
4
|
|
|
|
|
8
|
$time -= $m * 60; |
5924
|
4
|
50
|
|
|
|
21
|
if ($h > 24) { |
5925
|
0
|
|
|
|
|
0
|
my $d = int($h / 24); |
5926
|
0
|
|
|
|
|
0
|
$h -= $d * 24; |
5927
|
0
|
|
|
|
|
0
|
$sign = "$sign$d days "; |
5928
|
|
|
|
|
|
|
} |
5929
|
4
|
|
|
|
|
42
|
return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time)); |
5930
|
|
|
|
|
|
|
} |
5931
|
|
|
|
|
|
|
|
5932
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5933
|
|
|
|
|
|
|
# Print conversion for bitrate values |
5934
|
|
|
|
|
|
|
# Inputs: 0) bitrate in bits per second |
5935
|
|
|
|
|
|
|
# Returns: human-readable bitrate string |
5936
|
|
|
|
|
|
|
# Notes: returns input value without formatting if it isn't numerical |
5937
|
|
|
|
|
|
|
sub ConvertBitrate($) |
5938
|
|
|
|
|
|
|
{ |
5939
|
20
|
|
|
20
|
0
|
43
|
my $bitrate = shift; |
5940
|
20
|
50
|
|
|
|
58
|
IsFloat($bitrate) or return $bitrate; |
5941
|
20
|
|
|
|
|
74
|
my @units = ('bps', 'kbps', 'Mbps', 'Gbps'); |
5942
|
20
|
|
|
|
|
33
|
for (;;) { |
5943
|
38
|
|
|
|
|
58
|
my $units = shift @units; |
5944
|
38
|
100
|
66
|
|
|
144
|
$bitrate >= 1000 and @units and $bitrate /= 1000, next; |
5945
|
20
|
100
|
|
|
|
58
|
my $fmt = $bitrate < 100 ? '%.3g' : '%.0f'; |
5946
|
20
|
|
|
|
|
235
|
return sprintf("$fmt $units", $bitrate); |
5947
|
|
|
|
|
|
|
} |
5948
|
|
|
|
|
|
|
} |
5949
|
|
|
|
|
|
|
|
5950
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5951
|
|
|
|
|
|
|
# Convert file name for printing |
5952
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set |
5953
|
|
|
|
|
|
|
# Returns: converted file name in external character set |
5954
|
|
|
|
|
|
|
sub ConvertFileName($$) |
5955
|
|
|
|
|
|
|
{ |
5956
|
938
|
|
|
938
|
0
|
2672
|
my ($self, $val) = @_; |
5957
|
938
|
|
|
|
|
2028
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
5958
|
938
|
50
|
|
|
|
2157
|
$val = $self->Decode($val, $enc) if $enc; |
5959
|
938
|
|
|
|
|
6227
|
return $val; |
5960
|
|
|
|
|
|
|
} |
5961
|
|
|
|
|
|
|
|
5962
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5963
|
|
|
|
|
|
|
# Inverse conversion for file name (encode in CharsetFileName) |
5964
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in external character set |
5965
|
|
|
|
|
|
|
# Returns: file name in CharsetFileName character set |
5966
|
|
|
|
|
|
|
sub InverseFileName($$) |
5967
|
|
|
|
|
|
|
{ |
5968
|
1
|
|
|
1
|
0
|
4
|
my ($self, $val) = @_; |
5969
|
1
|
|
|
|
|
3
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
5970
|
1
|
50
|
|
|
|
5
|
$val = $self->Encode($val, $enc) if $enc; |
5971
|
1
|
|
|
|
|
4
|
$val =~ tr/\\/\//; # make sure we are using forward slashes |
5972
|
1
|
|
|
|
|
7
|
return $val; |
5973
|
|
|
|
|
|
|
} |
5974
|
|
|
|
|
|
|
|
5975
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5976
|
|
|
|
|
|
|
# Save information for HTML dump |
5977
|
|
|
|
|
|
|
# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size |
5978
|
|
|
|
|
|
|
# 3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name |
5979
|
|
|
|
|
|
|
sub HDump($$$$;$$$) |
5980
|
|
|
|
|
|
|
{ |
5981
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
5982
|
0
|
0
|
|
|
|
0
|
$$self{HTML_DUMP} or return; |
5983
|
0
|
|
|
|
|
0
|
my ($pos, $len, $com, $tip, $flg, $ifd) = @_; |
5984
|
0
|
0
|
|
|
|
0
|
$pos += $$self{BASE} if $$self{BASE}; |
5985
|
|
|
|
|
|
|
# skip structural data blocks which have been removed from the middle of this dump |
5986
|
|
|
|
|
|
|
# (SkipData list contains ordered [start,end+1] offsets to skip) |
5987
|
0
|
0
|
|
|
|
0
|
if ($$self{SkipData}) { |
5988
|
0
|
|
|
|
|
0
|
my $end = $pos + $len; |
5989
|
0
|
|
|
|
|
0
|
my $skip; |
5990
|
0
|
|
|
|
|
0
|
foreach $skip (@{$$self{SkipData}}) { |
|
0
|
|
|
|
|
0
|
|
5991
|
0
|
0
|
|
|
|
0
|
$end <= $$skip[0] and last; |
5992
|
0
|
0
|
|
|
|
0
|
$pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next; |
5993
|
0
|
0
|
|
|
|
0
|
if ($pos != $$skip[0]) { |
5994
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd); |
5995
|
0
|
|
|
|
|
0
|
$len -= $$skip[0] - $pos; |
5996
|
0
|
|
|
|
|
0
|
$tip = 'SAME'; |
5997
|
|
|
|
|
|
|
} |
5998
|
0
|
|
|
|
|
0
|
$pos = $$skip[1]; |
5999
|
|
|
|
|
|
|
} |
6000
|
|
|
|
|
|
|
} |
6001
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd); |
6002
|
|
|
|
|
|
|
} |
6003
|
|
|
|
|
|
|
|
6004
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6005
|
|
|
|
|
|
|
# Identify trailer ending at specified offset from end of file |
6006
|
|
|
|
|
|
|
# Inputs: 0) RAF reference, 1) offset from end of file (0 by default) |
6007
|
|
|
|
|
|
|
# Returns: Trailer info hash (with RAF and DirName set), |
6008
|
|
|
|
|
|
|
# or undef if no recognized trailer was found |
6009
|
|
|
|
|
|
|
# Notes: leaves file position unchanged |
6010
|
|
|
|
|
|
|
sub IdentifyTrailer($;$) |
6011
|
|
|
|
|
|
|
{ |
6012
|
566
|
|
|
566
|
0
|
1219
|
my $raf = shift; |
6013
|
566
|
|
100
|
|
|
1790
|
my $offset = shift || 0; |
6014
|
566
|
|
|
|
|
2025
|
my $pos = $raf->Tell(); |
6015
|
566
|
|
|
|
|
1173
|
my ($buff, $type, $len); |
6016
|
566
|
|
33
|
|
|
1952
|
while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) { |
6017
|
|
|
|
|
|
|
# read up to 64 bytes before specified offset from end of file |
6018
|
566
|
50
|
|
|
|
1670
|
$len = 64 if $len > 64; |
6019
|
566
|
50
|
33
|
|
|
1577
|
$raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last; |
6020
|
566
|
100
|
66
|
|
|
9647
|
if ($buff =~ /AXS(!|\*).{8}$/s) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6021
|
29
|
|
|
|
|
68
|
$type = 'AFCP'; |
6022
|
|
|
|
|
|
|
} elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) { |
6023
|
29
|
|
|
|
|
78
|
$type = 'FotoStation'; |
6024
|
|
|
|
|
|
|
} elsif ($buff =~ /cbipcbbl$/) { |
6025
|
34
|
|
|
|
|
76
|
$type = 'PhotoMechanic'; |
6026
|
|
|
|
|
|
|
} elsif ($buff =~ /^CANON OPTIONAL DATA\0/) { |
6027
|
41
|
|
|
|
|
105
|
$type = 'CanonVRD'; |
6028
|
|
|
|
|
|
|
} elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or |
6029
|
|
|
|
|
|
|
$buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s) |
6030
|
|
|
|
|
|
|
{ |
6031
|
26
|
|
|
|
|
57
|
$type = 'MIE'; |
6032
|
|
|
|
|
|
|
} elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) { |
6033
|
26
|
|
|
|
|
60
|
$type = 'Samsung'; |
6034
|
|
|
|
|
|
|
} elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) { |
6035
|
0
|
|
|
|
|
0
|
$type = 'Insta360'; |
6036
|
|
|
|
|
|
|
} elsif ($buff =~ m(\0{6}/NIKON APP$)) { |
6037
|
0
|
|
|
|
|
0
|
$type = 'NikonApp'; |
6038
|
|
|
|
|
|
|
} |
6039
|
566
|
|
|
|
|
1080
|
last; |
6040
|
|
|
|
|
|
|
} |
6041
|
566
|
|
|
|
|
1828
|
$raf->Seek($pos, 0); # restore original file position |
6042
|
566
|
100
|
|
|
|
2647
|
return $type ? { RAF => $raf, DirName => $type } : undef; |
6043
|
|
|
|
|
|
|
} |
6044
|
|
|
|
|
|
|
|
6045
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6046
|
|
|
|
|
|
|
# Read/rewrite trailer information (including multiple trailers) |
6047
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) DirInfo ref: |
6048
|
|
|
|
|
|
|
# - requires RAF and DirName |
6049
|
|
|
|
|
|
|
# - OutFile is a scalar reference for writing |
6050
|
|
|
|
|
|
|
# - scans from current file position if ScanForAFCP is set |
6051
|
|
|
|
|
|
|
# Returns: 1 if trailer was processed or couldn't be processed (or written OK) |
6052
|
|
|
|
|
|
|
# 0 if trailer was recognized but offsets need fixing (or write error) |
6053
|
|
|
|
|
|
|
# - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated |
6054
|
|
|
|
|
|
|
# - preserves current file position and byte order |
6055
|
|
|
|
|
|
|
sub ProcessTrailers($$) |
6056
|
|
|
|
|
|
|
{ |
6057
|
57
|
|
|
57
|
0
|
165
|
my ($self, $dirInfo) = @_; |
6058
|
57
|
|
|
|
|
139
|
my $dirName = $$dirInfo{DirName}; |
6059
|
57
|
|
|
|
|
114
|
my $outfile = $$dirInfo{OutFile}; |
6060
|
57
|
|
50
|
|
|
260
|
my $offset = $$dirInfo{Offset} || 0; |
6061
|
57
|
|
|
|
|
119
|
my $fixup = $$dirInfo{Fixup}; |
6062
|
57
|
|
|
|
|
115
|
my $raf = $$dirInfo{RAF}; |
6063
|
57
|
|
|
|
|
170
|
my $pos = $raf->Tell(); |
6064
|
57
|
|
|
|
|
183
|
my $byteOrder = GetByteOrder(); |
6065
|
57
|
|
|
|
|
123
|
my $success = 1; |
6066
|
57
|
|
|
|
|
113
|
my $path = $$self{PATH}; |
6067
|
|
|
|
|
|
|
|
6068
|
57
|
|
|
|
|
125
|
for (;;) { # loop through all trailers |
6069
|
185
|
|
|
|
|
319
|
my ($proc, $outBuff); |
6070
|
185
|
50
|
|
|
|
622
|
if ($dirName eq 'Insta360') { |
|
|
50
|
|
|
|
|
|
6071
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/QuickTimeStream.pl'; |
6072
|
0
|
|
|
|
|
0
|
$proc = 'Image::ExifTool::QuickTime::ProcessInsta360'; |
6073
|
|
|
|
|
|
|
} elsif ($dirName eq 'NikonApp') { |
6074
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Nikon; |
6075
|
0
|
|
|
|
|
0
|
$proc = 'Image::ExifTool::Nikon::ProcessNikonApp'; |
6076
|
|
|
|
|
|
|
} else { |
6077
|
185
|
|
|
|
|
14520
|
require "Image/ExifTool/$dirName.pm"; |
6078
|
185
|
|
|
|
|
542
|
$proc = "Image::ExifTool::${dirName}::Process$dirName"; |
6079
|
|
|
|
|
|
|
} |
6080
|
185
|
100
|
|
|
|
486
|
if ($outfile) { |
6081
|
|
|
|
|
|
|
# write to local buffer so we can add trailer in proper order later |
6082
|
50
|
100
|
|
|
|
147
|
$$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = ''; |
6083
|
|
|
|
|
|
|
# must generate new fixup if necessary so we can shift |
6084
|
|
|
|
|
|
|
# the old fixup separately after we prepend this trailer |
6085
|
50
|
|
|
|
|
86
|
delete $$dirInfo{Fixup}; |
6086
|
|
|
|
|
|
|
} |
6087
|
185
|
|
|
|
|
313
|
delete $$dirInfo{DirLen}; # reset trailer length |
6088
|
185
|
|
|
|
|
373
|
$$dirInfo{Offset} = $offset; # set offset from end of file |
6089
|
185
|
|
|
|
|
319
|
$$dirInfo{Trailer} = 1; # set Trailer flag in case proc cares |
6090
|
|
|
|
|
|
|
# add trailer and DirName to SubDirectory PATH |
6091
|
185
|
|
|
|
|
416
|
push @$path, 'Trailer', $dirName; |
6092
|
|
|
|
|
|
|
|
6093
|
|
|
|
|
|
|
# read or write this trailer |
6094
|
|
|
|
|
|
|
# (proc takes Offset as positive offset from end of trailer to end of file, |
6095
|
|
|
|
|
|
|
# and returns DataPos and DirLen, and Fixup if applicable, and updates |
6096
|
|
|
|
|
|
|
# OutFile when writing) |
6097
|
104
|
|
|
104
|
|
1136
|
no strict 'refs'; |
|
104
|
|
|
|
|
226
|
|
|
104
|
|
|
|
|
4949
|
|
6098
|
185
|
|
|
|
|
1461
|
my $result = &$proc($self, $dirInfo); |
6099
|
104
|
|
|
104
|
|
593
|
use strict 'refs'; |
|
104
|
|
|
|
|
223
|
|
|
104
|
|
|
|
|
1119533
|
|
6100
|
|
|
|
|
|
|
|
6101
|
|
|
|
|
|
|
# restore PATH (pop last 2 items) |
6102
|
185
|
|
|
|
|
492
|
splice @$path, -2; |
6103
|
|
|
|
|
|
|
|
6104
|
|
|
|
|
|
|
# check result |
6105
|
185
|
100
|
|
|
|
585
|
if ($outfile) { |
|
|
50
|
|
|
|
|
|
6106
|
50
|
50
|
|
|
|
108
|
if ($result > 0) { |
6107
|
50
|
100
|
|
|
|
135
|
if ($outBuff) { |
6108
|
|
|
|
|
|
|
# write trailers to OutFile in original order |
6109
|
33
|
|
|
|
|
239
|
$$outfile = $outBuff . $$outfile; |
6110
|
|
|
|
|
|
|
# must adjust old fixup start if it exists |
6111
|
33
|
50
|
|
|
|
101
|
$$fixup{Start} += length($outBuff) if $fixup; |
6112
|
33
|
|
|
|
|
52
|
$outBuff = ''; # free memory |
6113
|
|
|
|
|
|
|
} |
6114
|
50
|
100
|
|
|
|
130
|
if ($$dirInfo{Fixup}) { |
6115
|
15
|
100
|
|
|
|
57
|
if ($fixup) { |
6116
|
|
|
|
|
|
|
# add fixup for subsequent trailers to the fixup for this trailer |
6117
|
|
|
|
|
|
|
# (but first we must adjust for the new start position) |
6118
|
7
|
|
|
|
|
18
|
$$fixup{Shift} += $$dirInfo{Fixup}{Start}; |
6119
|
7
|
|
|
|
|
18
|
$$fixup{Start} -= $$dirInfo{Fixup}{Start}; |
6120
|
7
|
|
|
|
|
25
|
$$dirInfo{Fixup}->AddFixup($fixup); |
6121
|
|
|
|
|
|
|
} |
6122
|
15
|
|
|
|
|
34
|
$fixup = $$dirInfo{Fixup}; # save fixup |
6123
|
|
|
|
|
|
|
} |
6124
|
|
|
|
|
|
|
} else { |
6125
|
0
|
0
|
|
|
|
0
|
$success = 0 if $self->Error("Error rewriting $dirName trailer", 2); |
6126
|
0
|
|
|
|
|
0
|
last; |
6127
|
|
|
|
|
|
|
} |
6128
|
|
|
|
|
|
|
} elsif ($result < 0) { |
6129
|
|
|
|
|
|
|
# can't continue if we must scan for this trailer |
6130
|
0
|
|
|
|
|
0
|
$success = 0; |
6131
|
0
|
|
|
|
|
0
|
last; |
6132
|
|
|
|
|
|
|
} |
6133
|
185
|
50
|
33
|
|
|
850
|
last unless $result > 0 and $$dirInfo{DirLen}; |
6134
|
|
|
|
|
|
|
# look for next trailer |
6135
|
185
|
|
|
|
|
377
|
$offset += $$dirInfo{DirLen}; |
6136
|
185
|
100
|
|
|
|
436
|
my $nextTrail = IdentifyTrailer($raf, $offset) or last; |
6137
|
128
|
|
|
|
|
333
|
$dirName = $$dirInfo{DirName} = $$nextTrail{DirName}; |
6138
|
128
|
|
|
|
|
344
|
$raf->Seek($pos, 0); |
6139
|
|
|
|
|
|
|
} |
6140
|
57
|
|
|
|
|
235
|
SetByteOrder($byteOrder); # restore original byte order |
6141
|
57
|
|
|
|
|
257
|
$raf->Seek($pos, 0); # restore original file position |
6142
|
57
|
|
|
|
|
210
|
$$dirInfo{OutFile} = $outfile; # restore original outfile |
6143
|
57
|
|
|
|
|
138
|
$$dirInfo{Offset} = $offset; # return offset from EOF to start of first trailer |
6144
|
57
|
|
|
|
|
185
|
$$dirInfo{Fixup} = $fixup; # return fixup information |
6145
|
57
|
|
|
|
|
296
|
return $success; |
6146
|
|
|
|
|
|
|
} |
6147
|
|
|
|
|
|
|
|
6148
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6149
|
|
|
|
|
|
|
# JPEG constants |
6150
|
|
|
|
|
|
|
|
6151
|
|
|
|
|
|
|
# JPEG marker names |
6152
|
|
|
|
|
|
|
%jpegMarker = ( |
6153
|
|
|
|
|
|
|
0x00 => 'NULL', |
6154
|
|
|
|
|
|
|
0x01 => 'TEM', |
6155
|
|
|
|
|
|
|
0xc0 => 'SOF0', # to SOF15, with a few exceptions below |
6156
|
|
|
|
|
|
|
0xc4 => 'DHT', |
6157
|
|
|
|
|
|
|
0xc8 => 'JPGA', |
6158
|
|
|
|
|
|
|
0xcc => 'DAC', |
6159
|
|
|
|
|
|
|
0xd0 => 'RST0', # to RST7 |
6160
|
|
|
|
|
|
|
0xd8 => 'SOI', |
6161
|
|
|
|
|
|
|
0xd9 => 'EOI', |
6162
|
|
|
|
|
|
|
0xda => 'SOS', |
6163
|
|
|
|
|
|
|
0xdb => 'DQT', |
6164
|
|
|
|
|
|
|
0xdc => 'DNL', |
6165
|
|
|
|
|
|
|
0xdd => 'DRI', |
6166
|
|
|
|
|
|
|
0xde => 'DHP', |
6167
|
|
|
|
|
|
|
0xdf => 'EXP', |
6168
|
|
|
|
|
|
|
0xe0 => 'APP0', # to APP15 |
6169
|
|
|
|
|
|
|
0xf0 => 'JPG0', |
6170
|
|
|
|
|
|
|
0xfe => 'COM', |
6171
|
|
|
|
|
|
|
); |
6172
|
|
|
|
|
|
|
|
6173
|
|
|
|
|
|
|
# lookup for size of JPEG marker length word |
6174
|
|
|
|
|
|
|
# (2 bytes assumed unless specified here) |
6175
|
|
|
|
|
|
|
my %markerLenBytes = ( |
6176
|
|
|
|
|
|
|
0x00 => 0, 0x01 => 0, |
6177
|
|
|
|
|
|
|
0xd0 => 0, 0xd1 => 0, 0xd2 => 0, 0xd3 => 0, 0xd4 => 0, 0xd5 => 0, 0xd6 => 0, 0xd7 => 0, |
6178
|
|
|
|
|
|
|
0xd8 => 0, 0xd9 => 0, 0xda => 0, |
6179
|
|
|
|
|
|
|
# J2C |
6180
|
|
|
|
|
|
|
0x30 => 0, 0x31 => 0, 0x32 => 0, 0x33 => 0, 0x34 => 0, 0x35 => 0, 0x36 => 0, 0x37 => 0, |
6181
|
|
|
|
|
|
|
0x38 => 0, 0x39 => 0, 0x3a => 0, 0x3b => 0, 0x3c => 0, 0x3d => 0, 0x3e => 0, 0x3f => 0, |
6182
|
|
|
|
|
|
|
0x4f => 0, |
6183
|
|
|
|
|
|
|
0x92 => 0, 0x93 => 0, |
6184
|
|
|
|
|
|
|
# J2C extensions |
6185
|
|
|
|
|
|
|
0x74 => 4, 0x75 => 4, 0x77 => 4, |
6186
|
|
|
|
|
|
|
); |
6187
|
|
|
|
|
|
|
|
6188
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6189
|
|
|
|
|
|
|
# Get JPEG marker name |
6190
|
|
|
|
|
|
|
# Inputs: 0) Jpeg number |
6191
|
|
|
|
|
|
|
# Returns: marker name |
6192
|
|
|
|
|
|
|
sub JpegMarkerName($) |
6193
|
|
|
|
|
|
|
{ |
6194
|
3055
|
|
|
3055
|
0
|
4513
|
my $marker = shift; |
6195
|
3055
|
|
|
|
|
5875
|
my $markerName = $jpegMarker{$marker}; |
6196
|
3055
|
100
|
|
|
|
5338
|
unless ($markerName) { |
6197
|
1157
|
|
|
|
|
2769
|
$markerName = $jpegMarker{$marker & 0xf0}; |
6198
|
1157
|
50
|
33
|
|
|
7707
|
if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) { |
6199
|
1157
|
|
|
|
|
3682
|
$markerName = $1 . ($marker & 0x0f); |
6200
|
|
|
|
|
|
|
} else { |
6201
|
0
|
|
|
|
|
0
|
$markerName = sprintf("marker 0x%.2x", $marker); |
6202
|
|
|
|
|
|
|
} |
6203
|
|
|
|
|
|
|
} |
6204
|
3055
|
|
|
|
|
5908
|
return $markerName; |
6205
|
|
|
|
|
|
|
} |
6206
|
|
|
|
|
|
|
|
6207
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6208
|
|
|
|
|
|
|
# Adjust directory start position |
6209
|
|
|
|
|
|
|
# Inputs: 0) dirInfo ref, 1) start offset |
6210
|
|
|
|
|
|
|
# 2) Base for offsets (relative to DataPos, defaults to absolute Base of 0) |
6211
|
|
|
|
|
|
|
sub DirStart($$;$) |
6212
|
|
|
|
|
|
|
{ |
6213
|
560
|
|
|
560
|
0
|
1300
|
my ($dirInfo, $start, $base) = @_; |
6214
|
560
|
|
|
|
|
1006
|
$$dirInfo{DirStart} = $start; |
6215
|
560
|
|
|
|
|
960
|
$$dirInfo{DirLen} -= $start; |
6216
|
560
|
100
|
|
|
|
1437
|
if (defined $base) { |
6217
|
263
|
|
|
|
|
590
|
$$dirInfo{Base} = $$dirInfo{DataPos} + $base; |
6218
|
263
|
|
|
|
|
654
|
$$dirInfo{DataPos} = -$base; # (relative to Base!) |
6219
|
|
|
|
|
|
|
} |
6220
|
|
|
|
|
|
|
} |
6221
|
|
|
|
|
|
|
|
6222
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6223
|
|
|
|
|
|
|
# Extract metadata from a jpg image |
6224
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set |
6225
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG file |
6226
|
|
|
|
|
|
|
sub ProcessJPEG($$) |
6227
|
|
|
|
|
|
|
{ |
6228
|
233
|
|
|
233
|
0
|
590
|
local $_; |
6229
|
233
|
|
|
|
|
592
|
my ($self, $dirInfo) = @_; |
6230
|
233
|
|
|
|
|
464
|
my ($ch, $s, $length); |
6231
|
233
|
|
|
|
|
539
|
my $options = $$self{OPTIONS}; |
6232
|
233
|
|
|
|
|
486
|
my $verbose = $$options{Verbose}; |
6233
|
233
|
|
|
|
|
518
|
my $out = $$options{TextOut}; |
6234
|
233
|
|
100
|
|
|
1179
|
my $fast = $$options{FastScan} || 0; |
6235
|
233
|
|
|
|
|
493
|
my $raf = $$dirInfo{RAF}; |
6236
|
233
|
|
|
|
|
446
|
my $req = $$self{REQ_TAG_LOOKUP}; |
6237
|
233
|
|
|
|
|
449
|
my $htmlDump = $$self{HTML_DUMP}; |
6238
|
233
|
|
|
|
|
701
|
my %dumpParms = ( Out => $out ); |
6239
|
233
|
|
|
|
|
1197
|
my ($success, $wantTrailer, $trailInfo, $foundSOS, %jumbfChunk); |
6240
|
233
|
|
|
|
|
0
|
my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal); |
6241
|
233
|
|
|
|
|
0
|
my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP); |
6242
|
|
|
|
|
|
|
|
6243
|
|
|
|
|
|
|
# check to be sure this is a valid JPG (or J2C, or EXV) file |
6244
|
233
|
50
|
33
|
|
|
855
|
return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/; |
6245
|
233
|
100
|
|
|
|
876
|
if ($s eq "\xff\x01") { |
6246
|
2
|
50
|
33
|
|
|
10
|
return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2'; |
6247
|
2
|
|
|
|
|
5
|
$$self{FILE_TYPE} = 'EXV'; |
6248
|
|
|
|
|
|
|
} |
6249
|
233
|
|
|
|
|
471
|
my $appBytes = 0; |
6250
|
233
|
|
|
|
|
523
|
my $calcImageLen = $$req{jpegimagelength}; |
6251
|
233
|
50
|
66
|
|
|
1021
|
if ($$options{RequestAll} and $$options{RequestAll} > 2) { |
6252
|
0
|
|
|
|
|
0
|
$calcImageLen = 1; |
6253
|
|
|
|
|
|
|
} |
6254
|
233
|
100
|
66
|
|
|
1036
|
if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) { |
|
|
|
66
|
|
|
|
|
6255
|
225
|
|
|
|
|
1112
|
$self->SetFileType(); # set FileType tag |
6256
|
225
|
100
|
|
|
|
986
|
return 1 if $fast == 3; # don't process file when FastScan == 3 |
6257
|
224
|
|
|
|
|
735
|
$$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags |
6258
|
|
|
|
|
|
|
} |
6259
|
232
|
100
|
|
|
|
744
|
$$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode |
6260
|
|
|
|
|
|
|
|
6261
|
232
|
50
|
|
|
|
1056
|
$dumpParms{MaxLen} = 128 if $verbose < 4; |
6262
|
232
|
50
|
|
|
|
660
|
if ($htmlDump) { |
6263
|
0
|
|
|
|
|
0
|
$dumpEnd = $raf->Tell(); |
6264
|
0
|
0
|
|
|
|
0
|
my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI'); |
6265
|
0
|
|
|
|
|
0
|
my $pos = $dumpEnd - $n; |
6266
|
0
|
0
|
|
|
|
0
|
$self->HDump(0, $pos, '[unknown header]') if $pos; |
6267
|
0
|
|
|
|
|
0
|
$self->HDump($pos, $n, "$t header", "$m Marker"); |
6268
|
|
|
|
|
|
|
} |
6269
|
232
|
|
|
|
|
499
|
my $path = $$self{PATH}; |
6270
|
232
|
|
|
|
|
507
|
my $pn = scalar @$path; |
6271
|
|
|
|
|
|
|
|
6272
|
|
|
|
|
|
|
# set input record separator to 0xff (the JPEG marker) to make reading quicker |
6273
|
232
|
|
|
|
|
1177
|
local $/ = "\xff"; |
6274
|
|
|
|
|
|
|
|
6275
|
232
|
|
|
|
|
642
|
my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData); |
6276
|
|
|
|
|
|
|
|
6277
|
|
|
|
|
|
|
# read file until we reach an end of image (EOI) or start of scan (SOS) |
6278
|
232
|
|
|
|
|
387
|
Marker: for (;;) { |
6279
|
|
|
|
|
|
|
# set marker and data pointer for current segment |
6280
|
2053
|
|
|
|
|
3239
|
my $marker = $nextMarker; |
6281
|
2053
|
|
|
|
|
2521
|
my $segDataPt = $nextSegDataPt; |
6282
|
2053
|
|
|
|
|
2566
|
my $segPos = $nextSegPos; |
6283
|
2053
|
|
|
|
|
2454
|
my $skipped; |
6284
|
2053
|
|
|
|
|
2651
|
undef $nextMarker; |
6285
|
2053
|
|
|
|
|
2801
|
undef $nextSegDataPt; |
6286
|
|
|
|
|
|
|
# |
6287
|
|
|
|
|
|
|
# read ahead to the next segment unless we have reached EOI, SOS or SOD |
6288
|
|
|
|
|
|
|
# |
6289
|
2053
|
100
|
100
|
|
|
11961
|
unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer) or $marker==0x93)) { |
|
|
|
100
|
|
|
|
|
6290
|
|
|
|
|
|
|
# read up to next marker (JPEG markers begin with 0xff) |
6291
|
1820
|
|
|
|
|
2452
|
my $buff; |
6292
|
1820
|
50
|
|
|
|
6713
|
$raf->ReadLine($buff) or last; |
6293
|
1820
|
|
|
|
|
3052
|
$skipped = length($buff) - 1; |
6294
|
|
|
|
|
|
|
# JPEG markers can be padded with unlimited 0xff's |
6295
|
1820
|
|
|
|
|
2508
|
for (;;) { |
6296
|
1820
|
50
|
|
|
|
4146
|
$raf->Read($ch, 1) or last Marker; |
6297
|
1820
|
|
|
|
|
3148
|
$nextMarker = ord($ch); |
6298
|
1820
|
50
|
|
|
|
4085
|
last unless $nextMarker == 0xff; |
6299
|
0
|
|
|
|
|
0
|
++$skipped; |
6300
|
|
|
|
|
|
|
} |
6301
|
|
|
|
|
|
|
# read segment data if it exists |
6302
|
1820
|
100
|
|
|
|
5406
|
if (not defined $markerLenBytes{$nextMarker}) { |
|
|
50
|
|
|
|
|
|
6303
|
|
|
|
|
|
|
# read record length word |
6304
|
1587
|
50
|
|
|
|
4382
|
last unless $raf->Read($s, 2) == 2; |
6305
|
1587
|
|
|
|
|
4087
|
my $len = unpack('n',$s); # get data length |
6306
|
1587
|
50
|
33
|
|
|
5905
|
last unless defined($len) and $len >= 2; |
6307
|
1587
|
|
|
|
|
3725
|
$nextSegPos = $raf->Tell(); |
6308
|
1587
|
|
|
|
|
2408
|
$len -= 2; # subtract size of length word |
6309
|
1587
|
50
|
|
|
|
3114
|
last unless $raf->Read($buff, $len) == $len; |
6310
|
1587
|
|
|
|
|
2697
|
$nextSegDataPt = \$buff; # set pointer to our next data |
6311
|
|
|
|
|
|
|
} elsif ($markerLenBytes{$nextMarker} == 4) { |
6312
|
|
|
|
|
|
|
# handle J2C extensions with 4-byte length word |
6313
|
0
|
0
|
|
|
|
0
|
last unless $raf->Read($s, 4) == 4; |
6314
|
0
|
|
|
|
|
0
|
my $len = unpack('N',$s); # get data length |
6315
|
0
|
0
|
0
|
|
|
0
|
last unless defined($len) and $len >= 4; |
6316
|
0
|
|
|
|
|
0
|
$nextSegPos = $raf->Tell(); |
6317
|
0
|
|
|
|
|
0
|
$len -= 4; # subtract size of length word |
6318
|
0
|
0
|
|
|
|
0
|
last unless $raf->Seek($len, 1); |
6319
|
|
|
|
|
|
|
} |
6320
|
|
|
|
|
|
|
# read second segment too if this was the first |
6321
|
1820
|
100
|
|
|
|
4044
|
next unless defined $marker; |
6322
|
|
|
|
|
|
|
} |
6323
|
|
|
|
|
|
|
# set some useful variables for the current segment |
6324
|
1820
|
|
|
|
|
3800
|
my $markerName = JpegMarkerName($marker); |
6325
|
1820
|
|
|
|
|
3368
|
$$path[$pn] = $markerName; |
6326
|
|
|
|
|
|
|
# issue warning if we skipped some garbage |
6327
|
1820
|
0
|
33
|
|
|
4024
|
if ($skipped and not $foundSOS and $markerName ne 'SOS') { |
|
|
|
33
|
|
|
|
|
6328
|
0
|
|
|
|
|
0
|
$self->Warn("Skipped unknown $skipped bytes after JPEG $markerName segment", 1); |
6329
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
6330
|
0
|
|
|
|
|
0
|
$self->HDump($nextSegPos-4-$skipped, $skipped, "[unknown $skipped bytes]", undef, 0x08); |
6331
|
0
|
|
|
|
|
0
|
$dumpEnd = $nextSegPos - 4; |
6332
|
|
|
|
|
|
|
} |
6333
|
|
|
|
|
|
|
} |
6334
|
|
|
|
|
|
|
# |
6335
|
|
|
|
|
|
|
# parse the current segment |
6336
|
|
|
|
|
|
|
# |
6337
|
|
|
|
|
|
|
# handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc) |
6338
|
1820
|
100
|
66
|
|
|
14756
|
if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
6339
|
229
|
|
|
|
|
424
|
$length = length $$segDataPt; |
6340
|
229
|
100
|
|
|
|
900
|
if ($verbose) { |
|
|
50
|
|
|
|
|
|
6341
|
2
|
|
|
|
|
8
|
print $out "JPEG $markerName ($length bytes):\n"; |
6342
|
2
|
100
|
|
|
|
13
|
HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2; |
6343
|
|
|
|
|
|
|
} elsif ($htmlDump) { |
6344
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08); |
6345
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6346
|
|
|
|
|
|
|
} |
6347
|
229
|
50
|
|
|
|
656
|
next unless $length >= 6; |
6348
|
|
|
|
|
|
|
# extract some useful information |
6349
|
229
|
|
|
|
|
930
|
my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt); |
6350
|
229
|
|
|
|
|
784
|
my $sof = GetTagTable('Image::ExifTool::JPEG::SOF'); |
6351
|
229
|
|
|
|
|
1090
|
$self->HandleTag($sof, 'ImageWidth', $w); |
6352
|
229
|
|
|
|
|
782
|
$self->HandleTag($sof, 'ImageHeight', $h); |
6353
|
229
|
|
|
|
|
982
|
$self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0); |
6354
|
229
|
|
|
|
|
836
|
$self->HandleTag($sof, 'BitsPerSample', $p); |
6355
|
229
|
|
|
|
|
917
|
$self->HandleTag($sof, 'ColorComponents', $n); |
6356
|
229
|
50
|
33
|
|
|
1408
|
next unless $n == 3 and $length >= 15; |
6357
|
229
|
|
|
|
|
585
|
my ($i, $hmin, $hmax, $vmin, $vmax); |
6358
|
|
|
|
|
|
|
# loop through all components to determine sampling frequency |
6359
|
229
|
|
|
|
|
540
|
$subSampling = ''; |
6360
|
229
|
|
|
|
|
900
|
for ($i=0; $i<$n; ++$i) { |
6361
|
687
|
|
|
|
|
1536
|
my $sf = Get8u($segDataPt, 7 + 3 * $i); |
6362
|
687
|
|
|
|
|
2196
|
$subSampling .= sprintf('%.2x', $sf); |
6363
|
|
|
|
|
|
|
# isolate horizontal and vertical components |
6364
|
687
|
|
|
|
|
1356
|
my ($hf, $vf) = ($sf >> 4, $sf & 0x0f); |
6365
|
687
|
100
|
|
|
|
1344
|
unless ($i) { |
6366
|
229
|
|
|
|
|
472
|
$hmin = $hmax = $hf; |
6367
|
229
|
|
|
|
|
411
|
$vmin = $vmax = $vf; |
6368
|
229
|
|
|
|
|
561
|
next; |
6369
|
|
|
|
|
|
|
} |
6370
|
|
|
|
|
|
|
# determine min/max frequencies |
6371
|
458
|
100
|
|
|
|
1064
|
$hmin = $hf if $hf < $hmin; |
6372
|
458
|
50
|
|
|
|
929
|
$hmax = $hf if $hf > $hmax; |
6373
|
458
|
100
|
|
|
|
1016
|
$vmin = $vf if $vf < $vmin; |
6374
|
458
|
50
|
|
|
|
1249
|
$vmax = $vf if $vf > $vmax; |
6375
|
|
|
|
|
|
|
} |
6376
|
229
|
50
|
33
|
|
|
1170
|
if ($hmin and $vmin) { |
6377
|
229
|
|
|
|
|
763
|
my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin); |
6378
|
229
|
|
|
|
|
2024
|
$self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs"); |
6379
|
|
|
|
|
|
|
} |
6380
|
229
|
|
|
|
|
635
|
next; |
6381
|
|
|
|
|
|
|
} elsif ($marker == 0xd9) { # EOI |
6382
|
3
|
|
|
|
|
10
|
pop @$path; |
6383
|
3
|
100
|
|
|
|
13
|
$verbose and print $out "JPEG EOI\n"; |
6384
|
3
|
|
|
|
|
12
|
my $pos = $raf->Tell(); |
6385
|
3
|
50
|
33
|
|
|
16
|
if ($htmlDump and $dumpEnd) { |
6386
|
0
|
|
|
|
|
0
|
$self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08); |
6387
|
0
|
|
|
|
|
0
|
$self->HDump($pos-2, 2, 'JPEG EOI', undef); |
6388
|
0
|
|
|
|
|
0
|
$dumpEnd = 0; |
6389
|
|
|
|
|
|
|
} |
6390
|
3
|
50
|
66
|
|
|
20
|
if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') { |
6391
|
3
|
|
|
|
|
8
|
$success = 1; |
6392
|
|
|
|
|
|
|
} else { |
6393
|
0
|
|
|
|
|
0
|
$self->Warn('Missing JPEG SOS'); |
6394
|
|
|
|
|
|
|
} |
6395
|
3
|
50
|
|
|
|
13
|
if ($$req{trailer}) { |
6396
|
|
|
|
|
|
|
# read entire trailer into memory |
6397
|
0
|
0
|
|
|
|
0
|
if ($raf->Seek(0,2)) { |
6398
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $pos; |
6399
|
0
|
0
|
|
|
|
0
|
if ($len) { |
6400
|
0
|
|
|
|
|
0
|
my $buff; |
6401
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6402
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len; |
6403
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6404
|
|
|
|
|
|
|
} |
6405
|
|
|
|
|
|
|
} else { |
6406
|
0
|
|
|
|
|
0
|
$self->Warn('Error seeking in file'); |
6407
|
|
|
|
|
|
|
} |
6408
|
|
|
|
|
|
|
} |
6409
|
|
|
|
|
|
|
# we are here because we are looking for trailer information |
6410
|
3
|
50
|
|
|
|
10
|
if ($wantTrailer) { |
6411
|
0
|
|
|
|
|
0
|
my $start = $$self{PreviewImageStart}; |
6412
|
0
|
0
|
0
|
|
|
0
|
if ($start or $$options{ExtractEmbedded}) { |
6413
|
0
|
|
|
|
|
0
|
my $buff; |
6414
|
|
|
|
|
|
|
# most previews start right after the JPEG EOI, but the Olympus E-20 |
6415
|
|
|
|
|
|
|
# preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is |
6416
|
|
|
|
|
|
|
# 979 bytes in, and Sony previews can start up to 32 kB into the trailer. |
6417
|
|
|
|
|
|
|
# (and Minolta and Sony previews can have a random first byte...) |
6418
|
0
|
0
|
|
|
|
0
|
my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024; |
6419
|
0
|
0
|
|
|
|
0
|
if ($raf->Read($buff, $scanLen)) { |
6420
|
0
|
0
|
0
|
|
|
0
|
if ($buff =~ /^.{4}ftyp/s) { |
|
|
0
|
0
|
|
|
|
|
6421
|
0
|
|
|
|
|
0
|
my $val; |
6422
|
0
|
0
|
|
|
|
0
|
if ($raf->Seek(0,2)) { |
6423
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $pos; |
6424
|
0
|
0
|
|
|
|
0
|
if ($$options{Binary}) { |
6425
|
0
|
0
|
0
|
|
|
0
|
$val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len; |
6426
|
|
|
|
|
|
|
} else { |
6427
|
0
|
|
|
|
|
0
|
$val = \ "Binary data $len bytes"; |
6428
|
|
|
|
|
|
|
} |
6429
|
0
|
0
|
|
|
|
0
|
if ($val) { |
6430
|
0
|
|
|
|
|
0
|
$self->FoundTag('EmbeddedVideo', $val); |
6431
|
|
|
|
|
|
|
} else { |
6432
|
0
|
|
|
|
|
0
|
$self->Warn('Error reading trailer'); |
6433
|
|
|
|
|
|
|
} |
6434
|
|
|
|
|
|
|
} else { |
6435
|
0
|
|
|
|
|
0
|
$self->Warn('Error seeking to end of file'); |
6436
|
|
|
|
|
|
|
} |
6437
|
|
|
|
|
|
|
} elsif ($buff =~ /\xff\xd8\xff./g or |
6438
|
|
|
|
|
|
|
($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)) |
6439
|
|
|
|
|
|
|
{ |
6440
|
|
|
|
|
|
|
# adjust PreviewImageStart to this location |
6441
|
0
|
|
|
|
|
0
|
my $actual = $pos + pos($buff) - 4; |
6442
|
0
|
0
|
0
|
|
|
0
|
if ($start and $start ne $actual and $verbose > 1) { |
|
|
|
0
|
|
|
|
|
6443
|
0
|
|
|
|
|
0
|
print $out "(Fixed PreviewImage location: $start -> $actual)\n"; |
6444
|
|
|
|
|
|
|
} |
6445
|
|
|
|
|
|
|
# update preview image offsets |
6446
|
0
|
0
|
|
|
|
0
|
if ($start) { |
6447
|
0
|
0
|
|
|
|
0
|
$$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart}; |
6448
|
0
|
|
|
|
|
0
|
$$self{PreviewImageStart} = $actual; |
6449
|
|
|
|
|
|
|
} |
6450
|
|
|
|
|
|
|
# load preview now if we tried and failed earlier |
6451
|
0
|
0
|
0
|
|
|
0
|
if ($$self{PreviewError} and $$self{PreviewImageLength}) { |
6452
|
0
|
0
|
0
|
|
|
0
|
if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) { |
6453
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $buff); |
6454
|
0
|
|
|
|
|
0
|
delete $$self{PreviewError}; |
6455
|
|
|
|
|
|
|
} |
6456
|
|
|
|
|
|
|
} |
6457
|
|
|
|
|
|
|
} |
6458
|
|
|
|
|
|
|
} |
6459
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6460
|
|
|
|
|
|
|
} |
6461
|
|
|
|
|
|
|
} |
6462
|
|
|
|
|
|
|
# process trailer now or finish processing trailers |
6463
|
|
|
|
|
|
|
# and scan for AFCP if necessary |
6464
|
3
|
|
|
|
|
9
|
my $fromEnd = 0; |
6465
|
3
|
50
|
|
|
|
12
|
if ($trailInfo) { |
6466
|
0
|
|
|
|
|
0
|
$$trailInfo{ScanForAFCP} = 1; # scan now if necessary |
6467
|
0
|
|
|
|
|
0
|
$self->ProcessTrailers($trailInfo); |
6468
|
|
|
|
|
|
|
# save offset from end of file to start of first trailer |
6469
|
0
|
|
|
|
|
0
|
$fromEnd = $$trailInfo{Offset}; |
6470
|
0
|
|
|
|
|
0
|
undef $trailInfo; |
6471
|
|
|
|
|
|
|
} |
6472
|
3
|
50
|
|
|
|
12
|
if ($$self{LeicaTrailer}) { |
6473
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); |
6474
|
0
|
|
|
|
|
0
|
$$self{LeicaTrailer}{TrailPos} = $pos; |
6475
|
0
|
|
|
|
|
0
|
$$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd; |
6476
|
0
|
|
|
|
|
0
|
Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); |
6477
|
|
|
|
|
|
|
} |
6478
|
|
|
|
|
|
|
# finally, dump remaining information in JPEG trailer |
6479
|
3
|
100
|
66
|
|
|
20
|
if ($verbose or $htmlDump) { |
6480
|
1
|
|
|
|
|
2
|
my $endPos = $$self{LeicaTrailerPos}; |
6481
|
1
|
50
|
|
|
|
4
|
unless ($endPos) { |
6482
|
1
|
|
|
|
|
8
|
$raf->Seek(0, 2); |
6483
|
1
|
|
|
|
|
5
|
$endPos = $raf->Tell() - $fromEnd; |
6484
|
|
|
|
|
|
|
} |
6485
|
|
|
|
|
|
|
$self->DumpUnknownTrailer({ |
6486
|
1
|
50
|
|
|
|
3
|
RAF => $raf, |
6487
|
|
|
|
|
|
|
DataPos => $pos, |
6488
|
|
|
|
|
|
|
DirLen => $endPos - $pos |
6489
|
|
|
|
|
|
|
}) if $endPos > $pos; |
6490
|
|
|
|
|
|
|
} |
6491
|
3
|
50
|
|
|
|
12
|
$self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen; |
6492
|
3
|
|
|
|
|
10
|
last; # all done parsing file |
6493
|
|
|
|
|
|
|
} elsif ($marker == 0xda) { # SOS |
6494
|
229
|
|
|
|
|
545
|
pop @$path; |
6495
|
229
|
|
|
|
|
459
|
$foundSOS = 1; |
6496
|
|
|
|
|
|
|
# all done with meta information unless we have a trailer |
6497
|
229
|
100
|
|
|
|
642
|
$verbose and print $out "JPEG SOS\n"; |
6498
|
229
|
100
|
|
|
|
704
|
unless ($fast) { |
6499
|
228
|
|
|
|
|
779
|
$trailInfo = IdentifyTrailer($raf); |
6500
|
|
|
|
|
|
|
# process trailer now unless we are doing verbose dump |
6501
|
228
|
50
|
66
|
|
|
1100
|
if ($trailInfo and $verbose < 3 and not $htmlDump) { |
|
|
|
66
|
|
|
|
|
6502
|
|
|
|
|
|
|
# process trailers (keep trailInfo to finish processing later |
6503
|
|
|
|
|
|
|
# only if we can't finish without scanning from end of file) |
6504
|
28
|
50
|
|
|
|
124
|
$self->ProcessTrailers($trailInfo) and undef $trailInfo; |
6505
|
|
|
|
|
|
|
} |
6506
|
228
|
0
|
33
|
|
|
683
|
if ($wantTrailer and $$self{PreviewImageStart}) { |
6507
|
|
|
|
|
|
|
# seek ahead and validate preview image |
6508
|
0
|
|
|
|
|
0
|
my $buff; |
6509
|
0
|
|
|
|
|
0
|
my $curPos = $raf->Tell(); |
6510
|
0
|
0
|
0
|
|
|
0
|
if ($raf->Seek($$self{PreviewImageStart}, 0) and |
|
|
|
0
|
|
|
|
|
6511
|
|
|
|
|
|
|
$raf->Read($buff, 4) == 4 and |
6512
|
|
|
|
|
|
|
$buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/) |
6513
|
|
|
|
|
|
|
{ |
6514
|
0
|
|
|
|
|
0
|
undef $wantTrailer; |
6515
|
|
|
|
|
|
|
} |
6516
|
0
|
0
|
|
|
|
0
|
$raf->Seek($curPos, 0) or last; |
6517
|
|
|
|
|
|
|
} |
6518
|
|
|
|
|
|
|
# seek ahead and process Leica trailer |
6519
|
228
|
50
|
|
|
|
795
|
if ($$self{LeicaTrailer}) { |
6520
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Panasonic; |
6521
|
0
|
|
|
|
|
0
|
Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); |
6522
|
0
|
0
|
|
|
|
0
|
$wantTrailer = 1 if $$self{LeicaTrailer}; |
6523
|
|
|
|
|
|
|
} else { |
6524
|
228
|
50
|
|
|
|
713
|
$wantTrailer = 1 if $$options{ExtractEmbedded}; |
6525
|
|
|
|
|
|
|
} |
6526
|
228
|
100
|
33
|
|
|
2029
|
next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump; |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
6527
|
|
|
|
|
|
|
} |
6528
|
|
|
|
|
|
|
# must scan to EOI if Validate or JpegCompressionFactor used |
6529
|
228
|
50
|
33
|
|
|
1617
|
next if $$options{Validate} or $calcImageLen or $$req{trailer}; |
|
|
|
33
|
|
|
|
|
6530
|
|
|
|
|
|
|
# nothing interesting to parse after start of scan (SOS) |
6531
|
228
|
|
|
|
|
496
|
$success = 1; |
6532
|
228
|
|
|
|
|
473
|
last; # all done parsing file |
6533
|
|
|
|
|
|
|
} elsif ($marker == 0x93) { |
6534
|
1
|
|
|
|
|
2
|
pop @$path; |
6535
|
1
|
50
|
|
|
|
3
|
$verbose and print $out "JPEG SOD\n"; |
6536
|
1
|
|
|
|
|
2
|
$success = 1; |
6537
|
1
|
50
|
33
|
|
|
5
|
next if $verbose > 2 or $htmlDump; |
6538
|
1
|
|
|
|
|
3
|
last; # all done parsing file |
6539
|
|
|
|
|
|
|
} elsif (defined $markerLenBytes{$marker}) { |
6540
|
|
|
|
|
|
|
# handle other stand-alone markers and segments we skipped over |
6541
|
0
|
0
|
0
|
|
|
0
|
$verbose and $marker and print $out "JPEG $markerName\n"; |
6542
|
0
|
|
|
|
|
0
|
next; |
6543
|
|
|
|
|
|
|
} elsif ($marker == 0xdb and length($$segDataPt) and # DQT |
6544
|
|
|
|
|
|
|
# save the DQT data only if JPEGDigest has been requested |
6545
|
|
|
|
|
|
|
# (Note: since we aren't checking the API RequestAll option here, the application |
6546
|
|
|
|
|
|
|
# must use the RequestTags option to generate these tags if they have not been |
6547
|
|
|
|
|
|
|
# specifically requested. The reason is that there is too much overhead involved |
6548
|
|
|
|
|
|
|
# in the calculation of this tag to make this worth the CPU time.) |
6549
|
|
|
|
|
|
|
($$req{jpegdigest} or $$req{jpegqualityestimate} |
6550
|
|
|
|
|
|
|
or ($$options{RequestAll} and $$options{RequestAll} > 2))) |
6551
|
|
|
|
|
|
|
{ |
6552
|
1
|
|
|
|
|
4
|
my $num = unpack('C',$$segDataPt) & 0x0f; # get table index |
6553
|
1
|
50
|
|
|
|
5
|
$dqt[$num] = $$segDataPt if $num < 4; # save for MD5 calculation |
6554
|
|
|
|
|
|
|
} |
6555
|
|
|
|
|
|
|
# handle all other markers |
6556
|
1358
|
|
|
|
|
2094
|
my $dumpType = ''; |
6557
|
1358
|
|
|
|
|
2875
|
my ($desc, $tip, $xtra); |
6558
|
1358
|
|
|
|
|
2105
|
$length = length $$segDataPt; |
6559
|
1358
|
100
|
|
|
|
3040
|
$appBytes += $length + 4 if ($marker & 0xf0) == 0xe0; # total size of APP segments |
6560
|
1358
|
100
|
|
|
|
2575
|
if ($verbose) { |
6561
|
6
|
|
|
|
|
23
|
print $out "JPEG $markerName ($length bytes):\n"; |
6562
|
6
|
100
|
|
|
|
16
|
if ($verbose > 2) { |
6563
|
3
|
|
|
|
|
10
|
my %extraParms = ( Addr => $segPos ); |
6564
|
3
|
50
|
|
|
|
8
|
$extraParms{MaxLen} = 128 if $verbose == 4; |
6565
|
3
|
|
|
|
|
16
|
HexDump($segDataPt, undef, %dumpParms, %extraParms); |
6566
|
|
|
|
|
|
|
} |
6567
|
|
|
|
|
|
|
} |
6568
|
|
|
|
|
|
|
# prepare dirInfo hash for processing this information |
6569
|
1358
|
|
|
|
|
6593
|
my %dirInfo = ( |
6570
|
|
|
|
|
|
|
Parent => $markerName, |
6571
|
|
|
|
|
|
|
DataPt => $segDataPt, |
6572
|
|
|
|
|
|
|
DataPos => $segPos, |
6573
|
|
|
|
|
|
|
DataLen => $length, |
6574
|
|
|
|
|
|
|
DirStart => 0, |
6575
|
|
|
|
|
|
|
DirLen => $length, |
6576
|
|
|
|
|
|
|
Base => 0, |
6577
|
|
|
|
|
|
|
); |
6578
|
1358
|
100
|
|
|
|
12717
|
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
|
|
|
|
|
|
6579
|
106
|
100
|
|
|
|
944
|
if ($$segDataPt =~ /^JFIF\0/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6580
|
49
|
|
|
|
|
102
|
$dumpType = 'JFIF'; |
6581
|
49
|
|
|
|
|
176
|
DirStart(\%dirInfo, 5); # start at byte 5 |
6582
|
49
|
|
|
|
|
163
|
SetByteOrder('MM'); |
6583
|
49
|
|
|
|
|
162
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main'); |
6584
|
49
|
|
|
|
|
186
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6585
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) { |
6586
|
19
|
|
|
|
|
57
|
my $tag = ord $1; |
6587
|
19
|
|
|
|
|
44
|
$dumpType = 'JFXX'; |
6588
|
19
|
|
|
|
|
60
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension'); |
6589
|
19
|
|
|
|
|
71
|
my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag); |
6590
|
19
|
|
|
|
|
94
|
$self->FoundTag($tagInfo, substr($$segDataPt, 6)); |
6591
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) { |
6592
|
19
|
50
|
|
|
|
87
|
next if $fast > 1; # skip processing for very fast |
6593
|
19
|
|
|
|
|
49
|
$dumpType = 'CIFF'; |
6594
|
19
|
|
|
|
|
100
|
my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) ); |
6595
|
19
|
|
|
|
|
67
|
$$self{SET_GROUP1} = 'CIFF'; |
6596
|
19
|
|
|
|
|
40
|
push @{$$self{PATH}}, 'CIFF'; |
|
19
|
|
|
|
|
63
|
|
6597
|
19
|
|
|
|
|
1369
|
require Image::ExifTool::CanonRaw; |
6598
|
19
|
|
|
|
|
122
|
Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo); |
6599
|
19
|
|
|
|
|
40
|
pop @{$$self{PATH}}; |
|
19
|
|
|
|
|
55
|
|
6600
|
19
|
|
|
|
|
97
|
delete $$self{SET_GROUP1}; |
6601
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(AVI1|Ocad)/) { |
6602
|
19
|
|
|
|
|
67
|
$dumpType = $1; |
6603
|
19
|
|
|
|
|
67
|
SetByteOrder('MM'); |
6604
|
19
|
|
|
|
|
107
|
my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType"); |
6605
|
19
|
|
|
|
|
88
|
DirStart(\%dirInfo, 4); |
6606
|
19
|
|
|
|
|
76
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6607
|
|
|
|
|
|
|
} |
6608
|
|
|
|
|
|
|
} elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI, PARROT) |
6609
|
|
|
|
|
|
|
# (some Kodak cameras don't put a second "\0", and I have seen an |
6610
|
|
|
|
|
|
|
# example where there was a second 4-byte APP1 segment header) |
6611
|
259
|
100
|
66
|
|
|
2478
|
if ($$segDataPt =~ /^(.{0,4})Exif\0/is) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6612
|
187
|
|
|
|
|
409
|
undef $dumpType; # (will be dumped here) |
6613
|
|
|
|
|
|
|
# this is EXIF data -- |
6614
|
|
|
|
|
|
|
# get the data block (into a common variable) |
6615
|
187
|
|
|
|
|
401
|
my $hdrLen = length($exifAPP1hdr); |
6616
|
187
|
50
|
|
|
|
1226
|
if (length $1) { |
|
|
50
|
|
|
|
|
|
6617
|
0
|
|
|
|
|
0
|
$hdrLen += length $1; |
6618
|
0
|
|
|
|
|
0
|
$self->Warn('Unknown garbage at start of EXIF segment',1); |
6619
|
|
|
|
|
|
|
} elsif ($$segDataPt !~ /^Exif\0/) { |
6620
|
0
|
|
|
|
|
0
|
$self->Warn('Incorrect EXIF segment identifier',1); |
6621
|
|
|
|
|
|
|
} |
6622
|
187
|
50
|
|
|
|
596
|
if ($htmlDump) { |
6623
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes"); |
6624
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif'); |
6625
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6626
|
|
|
|
|
|
|
} |
6627
|
187
|
|
|
|
|
441
|
my $dataPt = $segDataPt; |
6628
|
187
|
50
|
|
|
|
590
|
if (defined $combinedSegData) { |
6629
|
0
|
|
|
|
|
0
|
push @skipData, [ $segPos-4, $segPos+$hdrLen ]; |
6630
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,$hdrLen); |
6631
|
0
|
|
|
|
|
0
|
undef $$segDataPt; |
6632
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
6633
|
0
|
|
|
|
|
0
|
$segPos = $firstSegPos; |
6634
|
|
|
|
|
|
|
} |
6635
|
|
|
|
|
|
|
# peek ahead to see if the next segment is extended EXIF |
6636
|
187
|
50
|
66
|
|
|
1161
|
if ($nextMarker == $marker and |
6637
|
|
|
|
|
|
|
$$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/) |
6638
|
|
|
|
|
|
|
{ |
6639
|
|
|
|
|
|
|
# initialize combined data if necessary |
6640
|
0
|
0
|
|
|
|
0
|
unless (defined $combinedSegData) { |
6641
|
0
|
|
|
|
|
0
|
$combinedSegData = $$segDataPt; |
6642
|
0
|
|
|
|
|
0
|
undef $$segDataPt; |
6643
|
0
|
|
|
|
|
0
|
$firstSegPos = $segPos; |
6644
|
0
|
|
|
|
|
0
|
$self->Warn('File contains multi-segment EXIF',1); |
6645
|
0
|
|
|
|
|
0
|
$$self{ExtendedEXIF} = 1; |
6646
|
|
|
|
|
|
|
} |
6647
|
0
|
|
|
|
|
0
|
next; |
6648
|
|
|
|
|
|
|
} |
6649
|
187
|
|
|
|
|
486
|
$dirInfo{DataPt} = $dataPt; |
6650
|
187
|
|
|
|
|
391
|
$dirInfo{DataPos} = $segPos; |
6651
|
187
|
|
|
|
|
519
|
$dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt; |
6652
|
187
|
|
|
|
|
791
|
DirStart(\%dirInfo, $hdrLen, $hdrLen); |
6653
|
187
|
50
|
|
|
|
603
|
$$self{SkipData} = \@skipData if @skipData; |
6654
|
|
|
|
|
|
|
# extract the EXIF information (it is in standard TIFF format) |
6655
|
187
|
50
|
|
|
|
847
|
$self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment'); |
6656
|
|
|
|
|
|
|
# avoid looking for preview unless necessary because it really slows |
6657
|
|
|
|
|
|
|
# us down -- only look for it if we found pointer, and preview is |
6658
|
|
|
|
|
|
|
# outside EXIF, and PreviewImage is specifically requested |
6659
|
187
|
|
|
|
|
857
|
my $start = $self->GetValue('PreviewImageStart', 'ValueConv'); |
6660
|
187
|
|
|
|
|
596
|
my $plen = $self->GetValue('PreviewImageLength', 'ValueConv'); |
6661
|
187
|
100
|
66
|
|
|
920
|
if (not $start or not $plen and $$self{PreviewError}) { |
|
|
|
66
|
|
|
|
|
6662
|
171
|
|
|
|
|
370
|
$start = $$self{PreviewImageStart}; |
6663
|
171
|
|
|
|
|
375
|
$plen = $$self{PreviewImageLength}; |
6664
|
|
|
|
|
|
|
} |
6665
|
187
|
0
|
100
|
|
|
779
|
if ($start and $plen and IsInt($start) and IsInt($plen) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
6666
|
|
|
|
|
|
|
$start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and |
6667
|
|
|
|
|
|
|
($$req{previewimage} or |
6668
|
|
|
|
|
|
|
# (extracted normally, so check Binary option) |
6669
|
|
|
|
|
|
|
($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage}))) |
6670
|
|
|
|
|
|
|
{ |
6671
|
0
|
|
|
|
|
0
|
$$self{PreviewImageStart} = $start; |
6672
|
0
|
|
|
|
|
0
|
$$self{PreviewImageLength} = $plen; |
6673
|
0
|
|
|
|
|
0
|
$wantTrailer = 1; |
6674
|
|
|
|
|
|
|
} |
6675
|
187
|
50
|
|
|
|
561
|
if (@skipData) { |
6676
|
0
|
|
|
|
|
0
|
undef @skipData; |
6677
|
0
|
|
|
|
|
0
|
delete $$self{SkipData}; |
6678
|
|
|
|
|
|
|
} |
6679
|
187
|
|
|
|
|
510
|
undef $$dataPt; |
6680
|
187
|
|
|
|
|
796
|
next; |
6681
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) { |
6682
|
|
|
|
|
|
|
# off len -- extended XMP header (75 bytes total): |
6683
|
|
|
|
|
|
|
# 0 35 bytes - signature |
6684
|
|
|
|
|
|
|
# 35 32 bytes - GUID (MD5 hash of full extended XMP data in ASCII) |
6685
|
|
|
|
|
|
|
# 67 4 bytes - total size of extended XMP data |
6686
|
|
|
|
|
|
|
# 71 4 bytes - offset for this XMP data portion |
6687
|
2
|
|
|
|
|
5
|
$dumpType = 'Extended XMP'; |
6688
|
2
|
50
|
|
|
|
6
|
if ($length > 75) { |
6689
|
2
|
|
|
|
|
8
|
my ($size, $off) = unpack('x67N2', $$segDataPt); |
6690
|
2
|
|
|
|
|
5
|
my $guid = substr($$segDataPt, 35, 32); |
6691
|
2
|
50
|
|
|
|
8
|
if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase) |
6692
|
0
|
|
|
|
|
0
|
$self->WarnOnce($tip = 'Invalid extended XMP GUID'); |
6693
|
|
|
|
|
|
|
} else { |
6694
|
2
|
|
|
|
|
5
|
my $extXMP = $extendedXMP{$guid}; |
6695
|
2
|
100
|
|
|
|
9
|
if (not $extXMP) { |
|
|
50
|
|
|
|
|
|
6696
|
1
|
|
|
|
|
4
|
$extXMP = $extendedXMP{$guid} = { }; |
6697
|
|
|
|
|
|
|
} elsif ($size != $$extXMP{Size}) { |
6698
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Inconsistent extended XMP size'); |
6699
|
|
|
|
|
|
|
} |
6700
|
2
|
|
|
|
|
6
|
$$extXMP{Size} = $size; |
6701
|
2
|
|
|
|
|
8
|
$$extXMP{$off} = substr($$segDataPt, 75); |
6702
|
2
|
|
|
|
|
11
|
$tip = "Full length: $size\nChunk offset: $off\nChunk length: " . |
6703
|
|
|
|
|
|
|
($length - 75) . "\nGUID: $guid"; |
6704
|
|
|
|
|
|
|
# (delay processing extended XMP until after reading all segments) |
6705
|
|
|
|
|
|
|
} |
6706
|
|
|
|
|
|
|
} else { |
6707
|
0
|
|
|
|
|
0
|
$self->WarnOnce($tip = 'Invalid extended XMP segment'); |
6708
|
|
|
|
|
|
|
} |
6709
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^QVCI\0/) { |
6710
|
1
|
|
|
|
|
2
|
$dumpType = 'QVCI'; |
6711
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI'); |
6712
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6713
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) { |
6714
|
1
|
|
|
|
|
2
|
$dumpType = 'FLIR'; |
6715
|
|
|
|
|
|
|
# must concatenate FLIR chunks (note: handle the case where |
6716
|
|
|
|
|
|
|
# some software erroneously writes zeros for the chunk counts) |
6717
|
1
|
|
|
|
|
11
|
my $chunkNum = Get8u($segDataPt, 6); |
6718
|
1
|
|
|
|
|
3
|
my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!) |
6719
|
1
|
50
|
|
|
|
4
|
$verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n", |
6720
|
|
|
|
|
|
|
$chunkNum + 1, $chunksTot; |
6721
|
1
|
50
|
|
|
|
4
|
if (defined $flirTotal) { |
6722
|
|
|
|
|
|
|
# abort parsing FLIR if the total chunk count is inconsistent |
6723
|
0
|
0
|
|
|
|
0
|
undef $flirCount if $chunksTot != $flirTotal; |
6724
|
|
|
|
|
|
|
} else { |
6725
|
1
|
|
|
|
|
2
|
$flirCount = 0; |
6726
|
1
|
|
|
|
|
2
|
$flirTotal = $chunksTot; |
6727
|
|
|
|
|
|
|
} |
6728
|
1
|
50
|
|
|
|
11
|
if (defined $flirCount) { |
6729
|
1
|
50
|
|
|
|
3
|
if (defined $flirChunk[$chunkNum]) { |
6730
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Duplicate FLIR chunk number(s)'); |
6731
|
0
|
|
|
|
|
0
|
$flirChunk[$chunkNum] .= substr($$segDataPt, 8); |
6732
|
|
|
|
|
|
|
} else { |
6733
|
1
|
|
|
|
|
10
|
$flirChunk[$chunkNum] = substr($$segDataPt, 8); |
6734
|
|
|
|
|
|
|
} |
6735
|
|
|
|
|
|
|
# process the FLIR information if we have all of the chunks |
6736
|
1
|
50
|
|
|
|
4
|
if (++$flirCount >= $flirTotal) { |
6737
|
1
|
|
|
|
|
2
|
my $flir = ''; |
6738
|
1
|
|
33
|
|
|
11
|
defined $_ and $flir .= $_ foreach @flirChunk; |
6739
|
1
|
|
|
|
|
3
|
undef @flirChunk; # free memory |
6740
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF'); |
6741
|
1
|
|
|
|
|
4
|
my %dirInfo = ( |
6742
|
|
|
|
|
|
|
DataPt => \$flir, |
6743
|
|
|
|
|
|
|
Parent => $markerName, |
6744
|
|
|
|
|
|
|
DirName => 'FLIR', |
6745
|
|
|
|
|
|
|
); |
6746
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6747
|
1
|
|
|
|
|
4
|
undef $flirCount; # prevent reprocessing |
6748
|
|
|
|
|
|
|
} |
6749
|
|
|
|
|
|
|
} else { |
6750
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Invalid or extraneous FLIR chunk(s)'); |
6751
|
|
|
|
|
|
|
} |
6752
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) { |
6753
|
|
|
|
|
|
|
# (don't know if this could span multiple segments) |
6754
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6755
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP1', $$segDataPt); |
6756
|
0
|
|
|
|
|
0
|
$dumpType = 'Parrot'; |
6757
|
|
|
|
|
|
|
} else { |
6758
|
|
|
|
|
|
|
# Hmmm. Could be XMP, let's see |
6759
|
68
|
|
|
|
|
164
|
my $processed; |
6760
|
68
|
50
|
33
|
|
|
477
|
if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) { |
6761
|
68
|
|
|
|
|
162
|
$dumpType = 'XMP'; |
6762
|
|
|
|
|
|
|
# also try to parse XMP with a non-standard header |
6763
|
|
|
|
|
|
|
# (note: this non-standard XMP is ignored when writing) |
6764
|
68
|
50
|
|
|
|
575
|
my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0; |
6765
|
68
|
|
|
|
|
248
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
6766
|
68
|
|
|
|
|
280
|
DirStart(\%dirInfo, $start); |
6767
|
68
|
50
|
|
|
|
449
|
$dirInfo{DirName} = $start ? 'XMP' : 'XML', |
6768
|
|
|
|
|
|
|
$processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6769
|
68
|
50
|
33
|
|
|
451
|
if ($processed and not $start) { |
6770
|
0
|
|
|
|
|
0
|
$self->Warn('Non-standard header for APP1 XMP segment'); |
6771
|
|
|
|
|
|
|
} |
6772
|
|
|
|
|
|
|
} |
6773
|
68
|
50
|
33
|
|
|
304
|
if ($verbose and not $processed) { |
6774
|
0
|
|
|
|
|
0
|
$self->Warn("Ignored APP1 segment length $length (unknown header)"); |
6775
|
|
|
|
|
|
|
} |
6776
|
|
|
|
|
|
|
} |
6777
|
|
|
|
|
|
|
} elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR, MPF, PreviewImage) |
6778
|
120
|
100
|
66
|
|
|
784
|
if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6779
|
34
|
|
|
|
|
78
|
$dumpType = 'ICC_Profile'; |
6780
|
|
|
|
|
|
|
# must concatenate profile chunks (note: handle the case where |
6781
|
|
|
|
|
|
|
# some software erroneously writes zeros for the chunk counts) |
6782
|
34
|
|
|
|
|
120
|
my $chunkNum = Get8u($segDataPt, 12); |
6783
|
34
|
|
|
|
|
101
|
my $chunksTot = Get8u($segDataPt, 13); |
6784
|
34
|
50
|
|
|
|
107
|
$verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n"; |
6785
|
34
|
50
|
|
|
|
108
|
if (defined $iccChunksTotal) { |
6786
|
|
|
|
|
|
|
# abort parsing ICC_Profile if the total chunk count is inconsistent |
6787
|
0
|
0
|
|
|
|
0
|
undef $iccChunkCount if $chunksTot != $iccChunksTotal; |
6788
|
|
|
|
|
|
|
} else { |
6789
|
34
|
|
|
|
|
66
|
$iccChunkCount = 0; |
6790
|
34
|
|
|
|
|
56
|
$iccChunksTotal = $chunksTot; |
6791
|
34
|
50
|
|
|
|
99
|
$self->Warn('ICC_Profile chunk count is zero') if !$chunksTot; |
6792
|
|
|
|
|
|
|
} |
6793
|
34
|
50
|
|
|
|
94
|
if (defined $iccChunkCount) { |
6794
|
34
|
50
|
|
|
|
107
|
if (defined $iccChunk[$chunkNum]) { |
6795
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Duplicate ICC_Profile chunk number(s)'); |
6796
|
0
|
|
|
|
|
0
|
$iccChunk[$chunkNum] .= substr($$segDataPt, 14); |
6797
|
|
|
|
|
|
|
} else { |
6798
|
34
|
|
|
|
|
173
|
$iccChunk[$chunkNum] = substr($$segDataPt, 14); |
6799
|
|
|
|
|
|
|
} |
6800
|
|
|
|
|
|
|
# process profile if we have all of the chunks |
6801
|
34
|
50
|
|
|
|
119
|
if (++$iccChunkCount >= $iccChunksTotal) { |
6802
|
34
|
|
|
|
|
75
|
my $icc_profile = ''; |
6803
|
34
|
|
66
|
|
|
250
|
defined $_ and $icc_profile .= $_ foreach @iccChunk; |
6804
|
34
|
|
|
|
|
85
|
undef @iccChunk; # free memory |
6805
|
34
|
|
|
|
|
103
|
my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main'); |
6806
|
34
|
|
|
|
|
208
|
my %dirInfo = ( |
6807
|
|
|
|
|
|
|
DataPt => \$icc_profile, |
6808
|
|
|
|
|
|
|
DataPos => $segPos + 14, |
6809
|
|
|
|
|
|
|
DataLen => length($icc_profile), |
6810
|
|
|
|
|
|
|
DirStart => 0, |
6811
|
|
|
|
|
|
|
DirLen => length($icc_profile), |
6812
|
|
|
|
|
|
|
Parent => $markerName, |
6813
|
|
|
|
|
|
|
); |
6814
|
34
|
|
|
|
|
162
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6815
|
34
|
|
|
|
|
185
|
undef $iccChunkCount; # prevent reprocessing |
6816
|
|
|
|
|
|
|
} |
6817
|
|
|
|
|
|
|
} else { |
6818
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)'); |
6819
|
|
|
|
|
|
|
} |
6820
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FPXR\0/) { |
6821
|
67
|
50
|
|
|
|
174
|
next if $fast > 1; # skip processing for very fast |
6822
|
67
|
|
|
|
|
116
|
$dumpType = 'FPXR'; |
6823
|
67
|
|
|
|
|
179
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); |
6824
|
|
|
|
|
|
|
# set flag if this is the last FPXR segment |
6825
|
67
|
|
100
|
|
|
548
|
$dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), |
6826
|
|
|
|
|
|
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6827
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^MPF\0/) { |
6828
|
19
|
|
|
|
|
52
|
undef $dumpType; # (will be dumped here) |
6829
|
19
|
|
|
|
|
81
|
DirStart(\%dirInfo, 4, 4); |
6830
|
19
|
|
|
|
|
65
|
$dirInfo{Multi} = 1; # the MP Attribute IFD will be MPF1 |
6831
|
19
|
50
|
|
|
|
57
|
if ($htmlDump) { |
6832
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes"); |
6833
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF'); |
6834
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6835
|
|
|
|
|
|
|
} |
6836
|
|
|
|
|
|
|
# extract the MPF information (it is in standard TIFF format) |
6837
|
19
|
|
|
|
|
55
|
my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main'); |
6838
|
19
|
|
|
|
|
86
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6839
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) { |
6840
|
|
|
|
|
|
|
# Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0", |
6841
|
|
|
|
|
|
|
# Digilife DDC-690/Rollei="BGTH" |
6842
|
0
|
|
|
|
|
0
|
$dumpType = 'Preview Image'; |
6843
|
0
|
|
|
|
|
0
|
$preview = substr($$segDataPt, length($1)); |
6844
|
|
|
|
|
|
|
} elsif ($preview) { |
6845
|
0
|
|
|
|
|
0
|
$dumpType = 'Preview Image'; |
6846
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
6847
|
|
|
|
|
|
|
} |
6848
|
120
|
50
|
33
|
|
|
421
|
if ($preview and $nextMarker ne $marker) { |
6849
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
6850
|
0
|
|
|
|
|
0
|
undef $preview; |
6851
|
|
|
|
|
|
|
} |
6852
|
|
|
|
|
|
|
} elsif ($marker == 0xe3) { # APP3 (Kodak "Meta", Stim) |
6853
|
20
|
100
|
|
|
|
149
|
if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6854
|
19
|
|
|
|
|
45
|
undef $dumpType; # (will be dumped here) |
6855
|
19
|
|
|
|
|
72
|
DirStart(\%dirInfo, 6, 6); |
6856
|
19
|
50
|
|
|
|
60
|
if ($htmlDump) { |
6857
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 10, 'APP3 Meta header'); |
6858
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6859
|
|
|
|
|
|
|
} |
6860
|
19
|
|
|
|
|
58
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta'); |
6861
|
19
|
|
|
|
|
82
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6862
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^Stim\0/) { |
6863
|
0
|
|
|
|
|
0
|
undef $dumpType; # (will be dumped here) |
6864
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 6, 6); |
6865
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
6866
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes"); |
6867
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim'); |
6868
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6869
|
|
|
|
|
|
|
} |
6870
|
|
|
|
|
|
|
# extract the Stim information (it is in standard TIFF format) |
6871
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main'); |
6872
|
0
|
|
|
|
|
0
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6873
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^_JPSJPS_/) { |
6874
|
1
|
|
|
|
|
5
|
$dumpType = 'JPS'; |
6875
|
1
|
50
|
|
|
|
7
|
$self->OverrideFileType('JPS') if $$self{FILE_TYPE} eq 'JPEG'; |
6876
|
1
|
|
|
|
|
5
|
SetByteOrder('MM'); |
6877
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::JPS'); |
6878
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6879
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI') { |
6880
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalData'; |
6881
|
|
|
|
|
|
|
# add this data to the combined data if it exists |
6882
|
0
|
|
|
|
|
0
|
my $dataPt = $segDataPt; |
6883
|
0
|
0
|
|
|
|
0
|
if (defined $combinedSegData) { |
6884
|
0
|
|
|
|
|
0
|
$combinedSegData .= $$segDataPt; |
6885
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
6886
|
|
|
|
|
|
|
} |
6887
|
0
|
0
|
|
|
|
0
|
if ($nextMarker == $marker) { |
6888
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
6889
|
|
|
|
|
|
|
} else { |
6890
|
|
|
|
|
|
|
# process DJI FLIR thermal data |
6891
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6892
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP3', $$dataPt); |
6893
|
0
|
|
|
|
|
0
|
undef $combinedSegData; |
6894
|
|
|
|
|
|
|
} |
6895
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) { |
6896
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; # (Samsung, HP, BenQ) |
6897
|
0
|
|
|
|
|
0
|
$preview = $$segDataPt; |
6898
|
|
|
|
|
|
|
} |
6899
|
20
|
50
|
33
|
|
|
92
|
if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4 |
6900
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
6901
|
0
|
|
|
|
|
0
|
undef $preview; |
6902
|
|
|
|
|
|
|
} |
6903
|
|
|
|
|
|
|
} elsif ($marker == 0xe4) { # APP4 ("SCALADO", FPXR, PreviewImage) |
6904
|
0
|
0
|
0
|
|
|
0
|
if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6905
|
0
|
|
|
|
|
0
|
$dumpType = 'SCALADO'; |
6906
|
0
|
|
|
|
|
0
|
my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt); |
6907
|
|
|
|
|
|
|
# assume that the segments are in order and just concatinate them |
6908
|
0
|
0
|
|
|
|
0
|
$scalado = '' unless defined $scalado; |
6909
|
0
|
|
|
|
|
0
|
$scalado .= substr($$segDataPt, 16); |
6910
|
0
|
0
|
|
|
|
0
|
if ($idx == $num - 1) { |
6911
|
0
|
0
|
|
|
|
0
|
if ($len != length $scalado) { |
6912
|
0
|
|
|
|
|
0
|
$self->Warn('Possibly corrupted APP4 SCALADO data', 1); |
6913
|
|
|
|
|
|
|
} |
6914
|
0
|
|
|
|
|
0
|
my %dirInfo = ( |
6915
|
|
|
|
|
|
|
Parent => $markerName, |
6916
|
|
|
|
|
|
|
DataPt => \$scalado, |
6917
|
|
|
|
|
|
|
); |
6918
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main'); |
6919
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6920
|
0
|
|
|
|
|
0
|
undef $scalado; |
6921
|
|
|
|
|
|
|
} |
6922
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FPXR\0/) { |
6923
|
0
|
0
|
|
|
|
0
|
next if $fast > 1; # skip processing for very fast |
6924
|
0
|
|
|
|
|
0
|
$dumpType = 'FPXR'; |
6925
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); |
6926
|
|
|
|
|
|
|
# set flag if this is the last FPXR segment |
6927
|
0
|
|
0
|
|
|
0
|
$dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), |
6928
|
|
|
|
|
|
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6929
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^\xaa\x55\x12\x06/) { |
6930
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalParams'; |
6931
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 0, 0); |
6932
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams'); |
6933
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6934
|
|
|
|
|
|
|
} elsif ($preview) { |
6935
|
|
|
|
|
|
|
# continued Samsung S1060 preview from APP3 |
6936
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; |
6937
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
6938
|
|
|
|
|
|
|
} |
6939
|
|
|
|
|
|
|
# (also seen "QTI Debug Metadata\0" segment in some newer Samsung images) |
6940
|
|
|
|
|
|
|
# BenQ DC E1050 continues preview in APP5 |
6941
|
0
|
0
|
0
|
|
|
0
|
if ($preview and $nextMarker ne 0xe5) { |
6942
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
6943
|
0
|
|
|
|
|
0
|
undef $preview; |
6944
|
|
|
|
|
|
|
} |
6945
|
|
|
|
|
|
|
} elsif ($marker == 0xe5) { # APP5 (Ricoh "RMETA") |
6946
|
20
|
50
|
|
|
|
119
|
if ($$segDataPt =~ /^RMETA\0/) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6947
|
|
|
|
|
|
|
# (NOTE: apparently these may span multiple segments, but I haven't seen |
6948
|
|
|
|
|
|
|
# a sample like this, so multi-segment support hasn't yet been implemented) |
6949
|
20
|
|
|
|
|
46
|
$dumpType = 'Ricoh RMETA'; |
6950
|
20
|
|
|
|
|
77
|
DirStart(\%dirInfo, 6, 6); |
6951
|
20
|
|
|
|
|
65
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA'); |
6952
|
20
|
|
|
|
|
84
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6953
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^ssuniqueid\0/) { |
6954
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5'); |
6955
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11)); |
6956
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI') { |
6957
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalCal'; |
6958
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6959
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP5', $$segDataPt); |
6960
|
|
|
|
|
|
|
} elsif ($preview) { |
6961
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; |
6962
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
6963
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
6964
|
0
|
|
|
|
|
0
|
undef $preview; |
6965
|
|
|
|
|
|
|
} |
6966
|
|
|
|
|
|
|
} elsif ($marker == 0xe6) { # APP6 (Toshiba EPPIM, NITF, HP_TDHD) |
6967
|
37
|
100
|
33
|
|
|
237
|
if ($$segDataPt =~ /^EPPIM\0/) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6968
|
18
|
|
|
|
|
38
|
undef $dumpType; # (will be dumped here) |
6969
|
18
|
|
|
|
|
64
|
DirStart(\%dirInfo, 6, 6); |
6970
|
18
|
50
|
|
|
|
60
|
if ($htmlDump) { |
6971
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 10, 'APP6 EPPIM header'); |
6972
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6973
|
|
|
|
|
|
|
} |
6974
|
18
|
|
|
|
|
58
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM'); |
6975
|
18
|
|
|
|
|
78
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
6976
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^NITF\0/) { |
6977
|
18
|
|
|
|
|
44
|
$dumpType = 'NITF'; |
6978
|
18
|
|
|
|
|
56
|
SetByteOrder('MM'); |
6979
|
18
|
|
|
|
|
83
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF'); |
6980
|
18
|
|
|
|
|
84
|
DirStart(\%dirInfo, 5); |
6981
|
18
|
|
|
|
|
68
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6982
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) { |
6983
|
|
|
|
|
|
|
# HP Photosmart R837 APP6 "TDHD" segment |
6984
|
0
|
|
|
|
|
0
|
$dumpType = 'TDHD'; |
6985
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD'); |
6986
|
|
|
|
|
|
|
# (ignore first TDHD element because size includes 12-byte tag header) |
6987
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 12); |
6988
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6989
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^GoPro\0/) { |
6990
|
|
|
|
|
|
|
# GoPro segment |
6991
|
1
|
|
|
|
|
3
|
$dumpType = 'GoPro'; |
6992
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF'); |
6993
|
1
|
|
|
|
|
4
|
DirStart(\%dirInfo, 6); |
6994
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6995
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^DTAT\0\0.\{/s) { |
6996
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI_DTAT'; |
6997
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6998
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP6', $$segDataPt); |
6999
|
|
|
|
|
|
|
} |
7000
|
|
|
|
|
|
|
} elsif ($marker == 0xe7) { # APP7 (Pentax, Huawei, Qualcomm) |
7001
|
19
|
50
|
|
|
|
245
|
if ($$segDataPt =~ /^PENTAX \0(II|MM)/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7002
|
|
|
|
|
|
|
# found in K-3 images (is this multi-segment??) |
7003
|
0
|
|
|
|
|
0
|
SetByteOrder($1); |
7004
|
0
|
|
|
|
|
0
|
undef $dumpType; # (dump this ourself) |
7005
|
0
|
|
|
|
|
0
|
my $hdrLen = 10; |
7006
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main'); |
7007
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, $hdrLen, 0); |
7008
|
0
|
|
|
|
|
0
|
$dirInfo{DirName} = 'Pentax APP7'; |
7009
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7010
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); |
7011
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax'); |
7012
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7013
|
|
|
|
|
|
|
} |
7014
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7015
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) { |
7016
|
0
|
|
|
|
|
0
|
SetByteOrder($1); |
7017
|
0
|
|
|
|
|
0
|
undef $dumpType; # (dump this ourself) |
7018
|
0
|
|
|
|
|
0
|
my $hdrLen = 16; |
7019
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main'); |
7020
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, $hdrLen, 8); |
7021
|
0
|
|
|
|
|
0
|
$dirInfo{DirName} = 'Huawei APP7'; |
7022
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7023
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); |
7024
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei'); |
7025
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7026
|
|
|
|
|
|
|
} |
7027
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP0} = 'APP7'; |
7028
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP1} = 'Huawei'; |
7029
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7030
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP0}; |
7031
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP1}; |
7032
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) { |
7033
|
|
|
|
|
|
|
# found in HP iPAQ_VoiceMessenger |
7034
|
19
|
|
|
|
|
47
|
$dumpType = 'Qualcomm'; |
7035
|
19
|
|
|
|
|
63
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main'); |
7036
|
19
|
|
|
|
|
99
|
DirStart(\%dirInfo, 27); |
7037
|
19
|
|
|
|
|
64
|
$dirInfo{DirName} = 'Qualcomm'; |
7038
|
19
|
|
|
|
|
80
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7039
|
|
|
|
|
|
|
} |
7040
|
|
|
|
|
|
|
} elsif ($marker == 0xe8) { # APP8 (SPIFF) |
7041
|
|
|
|
|
|
|
# my sample SPIFF has 32 bytes of data, but spec states 30 |
7042
|
19
|
50
|
33
|
|
|
138
|
if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) { |
7043
|
19
|
|
|
|
|
49
|
$dumpType = 'SPIFF'; |
7044
|
19
|
|
|
|
|
61
|
DirStart(\%dirInfo, 6); |
7045
|
19
|
|
|
|
|
79
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF'); |
7046
|
19
|
|
|
|
|
82
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7047
|
|
|
|
|
|
|
} |
7048
|
|
|
|
|
|
|
} elsif ($marker == 0xe9) { # APP9 (Media Jukebox) |
7049
|
19
|
50
|
33
|
|
|
164
|
if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) { |
7050
|
19
|
|
|
|
|
51
|
$dumpType = 'MediaJukebox'; |
7051
|
|
|
|
|
|
|
# (start parsing after the "") |
7052
|
19
|
|
|
|
|
68
|
DirStart(\%dirInfo, 22); |
7053
|
19
|
|
|
|
|
100
|
$dirInfo{DirName} = 'MediaJukebox'; |
7054
|
19
|
|
|
|
|
193
|
require Image::ExifTool::XMP; |
7055
|
19
|
|
|
|
|
89
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox'); |
7056
|
19
|
|
|
|
|
86
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP); |
7057
|
|
|
|
|
|
|
} |
7058
|
|
|
|
|
|
|
} elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments) |
7059
|
19
|
50
|
0
|
|
|
92
|
if ($$segDataPt =~ /^UNICODE\0/) { |
|
|
0
|
|
|
|
|
|
7060
|
19
|
|
|
|
|
44
|
$dumpType = 'PhotoStudio'; |
7061
|
19
|
|
|
|
|
91
|
my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM'); |
7062
|
19
|
|
|
|
|
74
|
$self->FoundTag('Comment', $comment); |
7063
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) { |
7064
|
|
|
|
|
|
|
# iPhone "AROT" segment containing integrated intensity per 16 scan lines |
7065
|
|
|
|
|
|
|
# (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz) |
7066
|
0
|
|
|
|
|
0
|
$xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')'; |
7067
|
|
|
|
|
|
|
} |
7068
|
|
|
|
|
|
|
} elsif ($marker == 0xeb) { # APP11 (JPEG-HDR, JUMBF) |
7069
|
38
|
100
|
33
|
|
|
291
|
if ($$segDataPt =~ /^HDR_RI /) { |
|
|
50
|
|
|
|
|
|
7070
|
19
|
|
|
|
|
43
|
$dumpType = 'JPEG-HDR'; |
7071
|
19
|
|
|
|
|
40
|
my $dataPt = $segDataPt; |
7072
|
19
|
50
|
|
|
|
58
|
if (defined $combinedSegData) { |
7073
|
0
|
0
|
|
|
|
0
|
if ($$segDataPt =~ /~\0/g) { |
7074
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,pos($$segDataPt)); |
7075
|
|
|
|
|
|
|
} else { |
7076
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid format for JPEG-HDR extended segment'); |
7077
|
|
|
|
|
|
|
} |
7078
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7079
|
|
|
|
|
|
|
} |
7080
|
19
|
50
|
33
|
|
|
122
|
if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) { |
7081
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7082
|
|
|
|
|
|
|
} else { |
7083
|
19
|
|
|
|
|
60
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR'); |
7084
|
19
|
|
|
|
|
65
|
my %dirInfo = ( DataPt => $dataPt ); |
7085
|
19
|
|
|
|
|
72
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7086
|
19
|
|
|
|
|
47
|
undef $combinedSegData; |
7087
|
|
|
|
|
|
|
} |
7088
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(JP..)/s and length($$segDataPt) >= 16) { |
7089
|
|
|
|
|
|
|
# JUMBF extension marker |
7090
|
19
|
|
|
|
|
52
|
my $hdr = $1; |
7091
|
19
|
|
|
|
|
37
|
$dumpType = 'JUMBF'; |
7092
|
19
|
|
|
|
|
58
|
SetByteOrder('MM'); |
7093
|
19
|
|
|
|
|
83
|
my $seq = Get32u($segDataPt, 4) - 1; # (start from 0) |
7094
|
19
|
|
|
|
|
57
|
my $len = Get32u($segDataPt, 8); |
7095
|
19
|
|
|
|
|
58
|
my $type = substr($$segDataPt, 12, 4); |
7096
|
19
|
|
|
|
|
45
|
my $hdrLen; |
7097
|
19
|
50
|
33
|
|
|
73
|
if ($len == 1 and length($$segDataPt) >= 24) { |
7098
|
0
|
|
|
|
|
0
|
$len = Get64u($$segDataPt, 16); |
7099
|
0
|
|
|
|
|
0
|
$hdrLen = 16; |
7100
|
|
|
|
|
|
|
} else { |
7101
|
19
|
|
|
|
|
41
|
$hdrLen = 8; |
7102
|
|
|
|
|
|
|
} |
7103
|
19
|
50
|
|
|
|
83
|
$jumbfChunk{$type} or $jumbfChunk{$type} = [ ]; |
7104
|
19
|
50
|
|
|
|
119
|
if ($len < $hdrLen) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7105
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid JUMBF segment'); |
7106
|
|
|
|
|
|
|
} elsif ($seq < 0) { |
7107
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid JUMBF sequence number'); |
7108
|
|
|
|
|
|
|
} elsif (defined $jumbfChunk{$type}[$seq]) { |
7109
|
0
|
|
|
|
|
0
|
$self->Warn('Duplicate JUMBF sequence number'); |
7110
|
|
|
|
|
|
|
} else { |
7111
|
|
|
|
|
|
|
# add to list of JUMBF chunks |
7112
|
19
|
|
|
|
|
75
|
$jumbfChunk{$type}[$seq] = substr($$segDataPt, 8 + $hdrLen); |
7113
|
|
|
|
|
|
|
# check to see if we have a complete JUMBF box |
7114
|
19
|
|
|
|
|
35
|
my $size = $hdrLen; |
7115
|
19
|
|
|
|
|
39
|
foreach (@{$jumbfChunk{$type}}) { |
|
19
|
|
|
|
|
61
|
|
7116
|
19
|
50
|
|
|
|
52
|
defined $_ or $size = 0, last; |
7117
|
19
|
|
|
|
|
96
|
$size += length $_; |
7118
|
|
|
|
|
|
|
} |
7119
|
19
|
50
|
|
|
|
68
|
if ($size == $len) { |
7120
|
19
|
|
|
|
|
52
|
my $buff = join '', substr($$segDataPt,8,$hdrLen), @{$jumbfChunk{$type}}; |
|
19
|
|
|
|
|
73
|
|
7121
|
19
|
|
|
|
|
47
|
$dirInfo{DataPt} = \$buff; |
7122
|
19
|
|
|
|
|
48
|
$dirInfo{DataPos} = $segPos + 8; # (shows correct offsets for single-segment JUMBF) |
7123
|
19
|
|
|
|
|
47
|
$dirInfo{DataLen} = $dirInfo{DirLen} = $size; |
7124
|
19
|
|
|
|
|
57
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main'); |
7125
|
19
|
|
|
|
|
90
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7126
|
19
|
|
|
|
|
86
|
delete $jumbfChunk{$type}; |
7127
|
|
|
|
|
|
|
} |
7128
|
|
|
|
|
|
|
} |
7129
|
|
|
|
|
|
|
} |
7130
|
|
|
|
|
|
|
} elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info) |
7131
|
40
|
100
|
|
|
|
168
|
if ($$segDataPt =~ /^Ducky/) { |
7132
|
21
|
|
|
|
|
57
|
$dumpType = 'Ducky'; |
7133
|
21
|
|
|
|
|
89
|
DirStart(\%dirInfo, 5); |
7134
|
21
|
|
|
|
|
80
|
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky'); |
7135
|
21
|
|
|
|
|
88
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7136
|
|
|
|
|
|
|
} else { |
7137
|
19
|
|
|
|
|
57
|
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo'); |
7138
|
19
|
50
|
|
|
|
79
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info'; |
7139
|
|
|
|
|
|
|
} |
7140
|
|
|
|
|
|
|
} elsif ($marker == 0xed) { # APP13 (Photoshop, Adobe_CM) |
7141
|
82
|
|
|
|
|
163
|
my $isOld; |
7142
|
82
|
100
|
50
|
|
|
1078
|
if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) { |
|
|
50
|
66
|
|
|
|
|
7143
|
63
|
|
|
|
|
243
|
$dumpType = 'Photoshop'; |
7144
|
|
|
|
|
|
|
# add this data to the combined data if it exists |
7145
|
63
|
|
|
|
|
117
|
my $dataPt = $segDataPt; |
7146
|
63
|
50
|
|
|
|
285
|
if (defined $combinedSegData) { |
7147
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,length($psAPP13hdr)); |
7148
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7149
|
|
|
|
|
|
|
} |
7150
|
|
|
|
|
|
|
# peek ahead to see if the next segment is photoshop data too |
7151
|
63
|
50
|
66
|
|
|
398
|
if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) { |
7152
|
|
|
|
|
|
|
# initialize combined data if necessary |
7153
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7154
|
|
|
|
|
|
|
# (will handle the Photoshop data the next time around) |
7155
|
|
|
|
|
|
|
} else { |
7156
|
63
|
50
|
|
|
|
209
|
my $hdrLen = $isOld ? 27 : 14; |
7157
|
|
|
|
|
|
|
# process APP13 Photoshop record |
7158
|
63
|
|
|
|
|
191
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); |
7159
|
63
|
|
|
|
|
419
|
my %dirInfo = ( |
7160
|
|
|
|
|
|
|
DataPt => $dataPt, |
7161
|
|
|
|
|
|
|
DataPos => $segPos, |
7162
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
7163
|
|
|
|
|
|
|
DirStart => $hdrLen, # directory starts after identifier |
7164
|
|
|
|
|
|
|
DirLen => length($$dataPt) - $hdrLen, |
7165
|
|
|
|
|
|
|
Parent => $markerName, |
7166
|
|
|
|
|
|
|
); |
7167
|
63
|
|
|
|
|
250
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7168
|
63
|
|
|
|
|
256
|
undef $combinedSegData; |
7169
|
|
|
|
|
|
|
} |
7170
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^Adobe_CM/) { |
7171
|
19
|
|
|
|
|
47
|
$dumpType = 'Adobe_CM'; |
7172
|
19
|
|
|
|
|
67
|
SetByteOrder('MM'); |
7173
|
19
|
|
|
|
|
78
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM'); |
7174
|
19
|
|
|
|
|
83
|
DirStart(\%dirInfo, 8); |
7175
|
19
|
|
|
|
|
74
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7176
|
|
|
|
|
|
|
} |
7177
|
|
|
|
|
|
|
} elsif ($marker == 0xee) { # APP14 (Adobe) |
7178
|
45
|
50
|
|
|
|
230
|
if ($$segDataPt =~ /^Adobe/) { |
7179
|
|
|
|
|
|
|
# extract as a block if requested, or if copying tags from file |
7180
|
45
|
100
|
66
|
|
|
358
|
if ($$req{adobe} or |
|
|
|
66
|
|
|
|
|
7181
|
|
|
|
|
|
|
# (not extracted normally, so check TAGS_FROM_FILE) |
7182
|
|
|
|
|
|
|
($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe})) |
7183
|
|
|
|
|
|
|
{ |
7184
|
16
|
|
|
|
|
70
|
$self->FoundTag('Adobe', $$segDataPt); |
7185
|
|
|
|
|
|
|
} |
7186
|
45
|
|
|
|
|
101
|
$dumpType = 'Adobe'; |
7187
|
45
|
|
|
|
|
161
|
SetByteOrder('MM'); |
7188
|
45
|
|
|
|
|
156
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe'); |
7189
|
45
|
|
|
|
|
169
|
DirStart(\%dirInfo, 5); |
7190
|
45
|
|
|
|
|
161
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7191
|
|
|
|
|
|
|
} |
7192
|
|
|
|
|
|
|
} elsif ($marker == 0xef) { # APP15 (GraphicConverter) |
7193
|
19
|
50
|
33
|
|
|
154
|
if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) { |
7194
|
19
|
|
|
|
|
45
|
$dumpType = 'GraphicConverter'; |
7195
|
19
|
|
|
|
|
59
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv'); |
7196
|
19
|
|
|
|
|
98
|
$self->HandleTag($tagTablePtr, 'Q', $1); |
7197
|
|
|
|
|
|
|
} |
7198
|
|
|
|
|
|
|
} elsif ($marker == 0xfe) { # COM (JPEG comment) |
7199
|
27
|
|
|
|
|
65
|
$dumpType = 'Comment'; |
7200
|
27
|
|
|
|
|
101
|
$$segDataPt =~ s/\0+$//; # some dumb softwares add null terminators |
7201
|
27
|
|
|
|
|
88
|
$self->FoundTag('Comment', $$segDataPt); |
7202
|
|
|
|
|
|
|
} elsif ($marker == 0x64) { # CME (J2C comment and extension) |
7203
|
2
|
|
|
|
|
3
|
$dumpType = 'Comment'; |
7204
|
2
|
50
|
|
|
|
5
|
if ($length > 2) { |
7205
|
2
|
|
|
|
|
4
|
my $reg = unpack('n', $$segDataPt); # get registration value |
7206
|
2
|
|
|
|
|
5
|
my $val = substr($$segDataPt, 2); |
7207
|
2
|
50
|
|
|
|
7
|
$val = $self->Decode($val, 'Latin') if $reg == 1; |
7208
|
|
|
|
|
|
|
# (actually an extension for $reg==65535, but store as binary comment) |
7209
|
2
|
50
|
33
|
|
|
23
|
$self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val); |
7210
|
|
|
|
|
|
|
} |
7211
|
|
|
|
|
|
|
} elsif ($marker == 0x51) { # SIZ (J2C) |
7212
|
1
|
|
|
|
|
3
|
my ($w, $h) = unpack('x2N2', $$segDataPt); |
7213
|
1
|
|
|
|
|
3
|
$self->FoundTag('ImageWidth', $w); |
7214
|
1
|
|
|
|
|
2
|
$self->FoundTag('ImageHeight', $h); |
7215
|
|
|
|
|
|
|
} elsif (($marker & 0xf0) != 0xe0) { |
7216
|
466
|
|
|
|
|
970
|
$dumpType = "$markerName segment"; |
7217
|
466
|
|
|
|
|
1035
|
$desc = "[JPEG $markerName]"; # (other known JPEG segments) |
7218
|
|
|
|
|
|
|
} |
7219
|
1171
|
100
|
|
|
|
2689
|
if (defined $dumpType) { |
7220
|
1115
|
50
|
33
|
|
|
2544
|
if (not $dumpType and ($$options{Unknown} or $$options{Validate})) { |
|
|
|
66
|
|
|
|
|
7221
|
0
|
0
|
|
|
|
0
|
my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : ''; |
7222
|
0
|
0
|
|
|
|
0
|
$xtra = 'segment' unless $xtra; |
7223
|
0
|
|
|
|
|
0
|
$self->Warn("Unknown $markerName$str $xtra", 1); |
7224
|
|
|
|
|
|
|
} |
7225
|
1115
|
50
|
|
|
|
2278
|
if ($htmlDump) { |
7226
|
0
|
0
|
|
|
|
0
|
$desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment'; |
|
|
0
|
|
|
|
|
|
7227
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, $length+4, $desc, $tip, 0x08); |
7228
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7229
|
|
|
|
|
|
|
} |
7230
|
|
|
|
|
|
|
} |
7231
|
1171
|
|
|
|
|
3787
|
undef $$segDataPt; |
7232
|
|
|
|
|
|
|
} |
7233
|
|
|
|
|
|
|
# process extended XMP now if it existed |
7234
|
232
|
100
|
|
|
|
724
|
if (%extendedXMP) { |
7235
|
1
|
|
|
|
|
5
|
my $guid; |
7236
|
|
|
|
|
|
|
# GUID indicated by the last main XMP segment |
7237
|
1
|
|
50
|
|
|
5
|
my $goodGuid = $$self{VALUE}{HasExtendedXMP} || ''; |
7238
|
|
|
|
|
|
|
# GUID of the extended XMP that we will process ('2' for all) |
7239
|
1
|
|
50
|
|
|
4
|
my $readGuid = $$options{ExtendedXMP} || 0; |
7240
|
1
|
50
|
|
|
|
5
|
$readGuid = $goodGuid if $readGuid eq '1'; |
7241
|
1
|
|
|
|
|
6
|
foreach $guid (sort keys %extendedXMP) { |
7242
|
1
|
50
|
|
|
|
5
|
next unless length $guid == 32; # ignore other (internal) keys |
7243
|
1
|
|
|
|
|
3
|
my $extXMP = $extendedXMP{$guid}; |
7244
|
1
|
|
|
|
|
2
|
my ($off, @offsets, $warn); |
7245
|
|
|
|
|
|
|
# make sure we have all chunks, and create a list of sorted offsets |
7246
|
1
|
|
|
|
|
5
|
for ($off=0; $off<$$extXMP{Size}; ) { |
7247
|
2
|
50
|
|
|
|
5
|
last unless defined $$extXMP{$off}; |
7248
|
2
|
|
|
|
|
5
|
push @offsets, $off; |
7249
|
2
|
|
|
|
|
5
|
$off += length $$extXMP{$off}; |
7250
|
|
|
|
|
|
|
} |
7251
|
1
|
50
|
|
|
|
4
|
unless ($off == $$extXMP{Size}) { |
7252
|
0
|
|
|
|
|
0
|
$self->Warn("Incomplete extended XMP (GUID $guid)"); |
7253
|
0
|
|
|
|
|
0
|
next; |
7254
|
|
|
|
|
|
|
} |
7255
|
1
|
50
|
33
|
|
|
5
|
if ($guid eq $readGuid or $readGuid eq '2') { |
7256
|
1
|
50
|
|
|
|
5
|
$warn = 'Reading non-' if $guid ne $goodGuid; |
7257
|
1
|
|
|
|
|
2
|
my $buff = ''; |
7258
|
|
|
|
|
|
|
# assemble XMP all together |
7259
|
1
|
|
|
|
|
6
|
$buff .= $$extXMP{$_} foreach @offsets; |
7260
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
7261
|
1
|
|
|
|
|
5
|
my %dirInfo = ( |
7262
|
|
|
|
|
|
|
DataPt => \$buff, |
7263
|
|
|
|
|
|
|
Parent => 'APP1', |
7264
|
|
|
|
|
|
|
IsExtended => 1, |
7265
|
|
|
|
|
|
|
); |
7266
|
1
|
|
|
|
|
3
|
$$path[$pn] = 'APP1'; |
7267
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7268
|
1
|
|
|
|
|
5
|
pop @$path; |
7269
|
|
|
|
|
|
|
} else { |
7270
|
0
|
|
|
|
|
0
|
$warn = 'Ignored '; |
7271
|
0
|
0
|
|
|
|
0
|
$warn .= 'non-' if $guid ne $goodGuid; |
7272
|
|
|
|
|
|
|
} |
7273
|
1
|
50
|
|
|
|
5
|
$self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn; |
7274
|
1
|
|
|
|
|
8
|
delete $extendedXMP{$guid}; |
7275
|
|
|
|
|
|
|
} |
7276
|
|
|
|
|
|
|
} |
7277
|
|
|
|
|
|
|
# calculate JPEGDigest if requested |
7278
|
232
|
100
|
|
|
|
736
|
if (@dqt) { |
7279
|
1
|
|
|
|
|
1290
|
require Image::ExifTool::JPEGDigest; |
7280
|
1
|
|
|
|
|
9
|
Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling); |
7281
|
|
|
|
|
|
|
} |
7282
|
|
|
|
|
|
|
# issue necessary warnings |
7283
|
232
|
50
|
|
|
|
610
|
$self->Warn('Invalid JUMBF size or missing JUMBF chunk') if %jumbfChunk; |
7284
|
232
|
50
|
|
|
|
638
|
$self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount; |
7285
|
232
|
50
|
|
|
|
624
|
$self->Warn('Incomplete FLIR record', 1) if defined $flirCount; |
7286
|
232
|
50
|
|
|
|
714
|
$self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError}; |
7287
|
232
|
50
|
|
|
|
616
|
$success or $self->Warn('JPEG format error'); |
7288
|
232
|
50
|
|
|
|
734
|
pop @$path if @$path > $pn; |
7289
|
232
|
|
|
|
|
1756
|
return 1; |
7290
|
|
|
|
|
|
|
} |
7291
|
|
|
|
|
|
|
|
7292
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7293
|
|
|
|
|
|
|
# Extract metadata from an Exiv2 EXV file |
7294
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set |
7295
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG file |
7296
|
|
|
|
|
|
|
sub ProcessEXV($$) |
7297
|
|
|
|
|
|
|
{ |
7298
|
2
|
|
|
2
|
0
|
9
|
my ($self, $dirInfo) = @_; |
7299
|
2
|
|
|
|
|
10
|
return $self->ProcessJPEG($dirInfo); |
7300
|
|
|
|
|
|
|
} |
7301
|
|
|
|
|
|
|
|
7302
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7303
|
|
|
|
|
|
|
# Process EXIF file |
7304
|
|
|
|
|
|
|
# Inputs/Returns: same as ProcessTIFF |
7305
|
|
|
|
|
|
|
sub ProcessEXIF($$;$) |
7306
|
|
|
|
|
|
|
{ |
7307
|
2
|
|
|
2
|
0
|
7
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7308
|
2
|
|
|
|
|
10
|
return $self->ProcessTIFF($dirInfo, $tagTablePtr); |
7309
|
|
|
|
|
|
|
} |
7310
|
|
|
|
|
|
|
|
7311
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7312
|
|
|
|
|
|
|
# Process TIFF data (wrapper for DoProcessTIFF to allow re-entry) |
7313
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref |
7314
|
|
|
|
|
|
|
# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error |
7315
|
|
|
|
|
|
|
sub ProcessTIFF($$;$) |
7316
|
|
|
|
|
|
|
{ |
7317
|
478
|
|
|
478
|
0
|
1358
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7318
|
478
|
|
|
|
|
967
|
my $exifData = $$self{EXIF_DATA}; |
7319
|
478
|
|
|
|
|
918
|
my $exifPos = $$self{EXIF_POS}; |
7320
|
478
|
|
|
|
|
1743
|
my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr); |
7321
|
|
|
|
|
|
|
# restore original EXIF information (in case ProcessTIFF is nested) |
7322
|
478
|
100
|
|
|
|
1467
|
if (defined $exifData) { |
7323
|
108
|
|
|
|
|
239
|
$$self{EXIF_DATA} = $exifData; |
7324
|
108
|
|
|
|
|
212
|
$$self{EXIF_POS} = $exifPos; |
7325
|
|
|
|
|
|
|
} |
7326
|
478
|
|
|
|
|
1614
|
return $rtnVal; |
7327
|
|
|
|
|
|
|
} |
7328
|
|
|
|
|
|
|
|
7329
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7330
|
|
|
|
|
|
|
# Process TIFF data |
7331
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref |
7332
|
|
|
|
|
|
|
# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error |
7333
|
|
|
|
|
|
|
sub DoProcessTIFF($$;$) |
7334
|
|
|
|
|
|
|
{ |
7335
|
478
|
|
|
478
|
0
|
1094
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7336
|
478
|
|
|
|
|
945
|
my $dataPt = $$dirInfo{DataPt}; |
7337
|
478
|
|
100
|
|
|
1578
|
my $fileType = $$dirInfo{Parent} || ''; |
7338
|
478
|
|
|
|
|
940
|
my $raf = $$dirInfo{RAF}; |
7339
|
478
|
|
100
|
|
|
2213
|
my $base = $$dirInfo{Base} || 0; |
7340
|
478
|
|
|
|
|
831
|
my $outfile = $$dirInfo{OutFile}; |
7341
|
478
|
|
|
|
|
1614
|
my ($err, $sig, $canonSig, $otherSig); |
7342
|
|
|
|
|
|
|
|
7343
|
|
|
|
|
|
|
# attempt to read TIFF header |
7344
|
478
|
|
|
|
|
1099
|
$$self{EXIF_DATA} = ''; |
7345
|
478
|
100
|
100
|
|
|
2625
|
if ($raf) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7346
|
47
|
100
|
|
|
|
130
|
if ($outfile) { |
7347
|
14
|
50
|
|
|
|
59
|
$raf->Seek(0, 0) or return 0; |
7348
|
14
|
50
|
|
|
|
59
|
if ($base) { |
7349
|
0
|
0
|
|
|
|
0
|
$raf->Read($$dataPt, $base) == $base or return 0; |
7350
|
0
|
0
|
|
|
|
0
|
Write($outfile, $$dataPt) or $err = 1; |
7351
|
|
|
|
|
|
|
} |
7352
|
|
|
|
|
|
|
} else { |
7353
|
33
|
50
|
|
|
|
121
|
$raf->Seek($base, 0) or return 0; |
7354
|
|
|
|
|
|
|
} |
7355
|
|
|
|
|
|
|
# extract full EXIF block (for block copy) from EXIF file |
7356
|
47
|
100
|
|
|
|
502
|
my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8; |
7357
|
47
|
|
|
|
|
189
|
my $n = $raf->Read($$self{EXIF_DATA}, $amount); |
7358
|
47
|
100
|
|
|
|
200
|
if ($n < 8) { |
7359
|
1
|
50
|
33
|
|
|
13
|
return 0 if $n or not $outfile or $fileType ne 'EXIF'; |
|
|
|
33
|
|
|
|
|
7360
|
|
|
|
|
|
|
# create EXIF file from scratch |
7361
|
1
|
|
|
|
|
3
|
delete $$self{EXIF_DATA}; |
7362
|
1
|
|
|
|
|
3
|
undef $raf; |
7363
|
|
|
|
|
|
|
} |
7364
|
47
|
100
|
|
|
|
164
|
if ($n > 8) { |
7365
|
2
|
|
|
|
|
10
|
$raf->Seek(8, 0); |
7366
|
2
|
50
|
|
|
|
12
|
if ($n == $amount) { |
7367
|
0
|
|
|
|
|
0
|
$$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8); |
7368
|
0
|
|
|
|
|
0
|
$self->Warn('EXIF too large to extract as a block'); #(shouldn't happen) |
7369
|
|
|
|
|
|
|
} |
7370
|
|
|
|
|
|
|
} |
7371
|
|
|
|
|
|
|
} elsif ($dataPt and length $$dataPt) { |
7372
|
|
|
|
|
|
|
# save a copy of the EXIF data |
7373
|
390
|
|
100
|
|
|
1123
|
my $dirStart = $$dirInfo{DirStart} || 0; |
7374
|
390
|
|
66
|
|
|
1937
|
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart); |
7375
|
390
|
|
|
|
|
1949
|
$$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen); |
7376
|
390
|
50
|
66
|
|
|
1553
|
$self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2; |
7377
|
|
|
|
|
|
|
} elsif ($outfile) { |
7378
|
41
|
|
|
|
|
125
|
delete $$self{EXIF_DATA}; # create from scratch |
7379
|
|
|
|
|
|
|
} else { |
7380
|
0
|
|
|
|
|
0
|
$$self{EXIF_DATA} = ''; |
7381
|
|
|
|
|
|
|
} |
7382
|
478
|
100
|
|
|
|
1462
|
unless (defined $$self{EXIF_DATA}) { |
7383
|
|
|
|
|
|
|
# set default byte order for creating new GPS in CR3 images |
7384
|
42
|
|
|
|
|
85
|
my $defaultByteOrder; |
7385
|
42
|
50
|
33
|
|
|
293
|
if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') { |
7386
|
0
|
|
|
|
|
0
|
$defaultByteOrder = $$self{SaveExifByteOrder}; |
7387
|
|
|
|
|
|
|
} |
7388
|
|
|
|
|
|
|
# create TIFF information from scratch |
7389
|
42
|
100
|
|
|
|
256
|
if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') { |
7390
|
33
|
|
|
|
|
105
|
$$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08"; |
7391
|
|
|
|
|
|
|
} else { |
7392
|
9
|
|
|
|
|
35
|
$$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0"; |
7393
|
|
|
|
|
|
|
} |
7394
|
|
|
|
|
|
|
} |
7395
|
478
|
|
|
|
|
1392
|
$$self{EXIF_POS} = $base + $$self{BASE}; |
7396
|
478
|
100
|
|
|
|
1741
|
$$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS}; |
7397
|
478
|
|
|
|
|
1045
|
$dataPt = \$$self{EXIF_DATA}; |
7398
|
|
|
|
|
|
|
|
7399
|
|
|
|
|
|
|
# set byte ordering |
7400
|
478
|
|
|
|
|
1204
|
my $byteOrder = substr($$dataPt,0,2); |
7401
|
478
|
100
|
|
|
|
1520
|
SetByteOrder($byteOrder) or return 0; |
7402
|
|
|
|
|
|
|
|
7403
|
|
|
|
|
|
|
# verify the byte ordering |
7404
|
472
|
|
|
|
|
1426
|
my $identifier = Get16u($dataPt, 2); |
7405
|
|
|
|
|
|
|
# identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF) |
7406
|
|
|
|
|
|
|
# no longer do this because various files use different values |
7407
|
|
|
|
|
|
|
# (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????) |
7408
|
|
|
|
|
|
|
# return 0 unless $identifier == 0x2a; |
7409
|
472
|
50
|
66
|
|
|
2208
|
$self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a; |
7410
|
|
|
|
|
|
|
|
7411
|
|
|
|
|
|
|
# get offset to IFD0 |
7412
|
472
|
50
|
|
|
|
1280
|
return 0 if length $$dataPt < 8; |
7413
|
472
|
|
|
|
|
1394
|
my $offset = Get32u($dataPt, 4); |
7414
|
472
|
50
|
|
|
|
1467
|
$offset >= 8 or return 0; |
7415
|
|
|
|
|
|
|
|
7416
|
472
|
100
|
|
|
|
1246
|
if ($raf) { |
7417
|
|
|
|
|
|
|
# check for canon or EXIF signature |
7418
|
|
|
|
|
|
|
# (Canon CR2 images should have an offset of 16, but it may be |
7419
|
|
|
|
|
|
|
# greater if edited by PhotoMechanic) |
7420
|
40
|
100
|
100
|
|
|
328
|
if ($identifier == 0x2a and $offset >= 16) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
7421
|
17
|
50
|
|
|
|
73
|
$raf->Read($sig, 8) == 8 or return 0; |
7422
|
17
|
|
|
|
|
43
|
$$dataPt .= $sig; |
7423
|
17
|
100
|
|
|
|
100
|
if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) { |
7424
|
10
|
100
|
|
|
|
36
|
if ($sig eq 'ExifMeta') { |
7425
|
1
|
|
|
|
|
7
|
$self->SetFileType($fileType = 'EXIF'); |
7426
|
1
|
|
|
|
|
2
|
$otherSig = $sig; |
7427
|
|
|
|
|
|
|
} else { |
7428
|
9
|
50
|
|
|
|
44
|
$fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW'; |
7429
|
9
|
|
|
|
|
18
|
$canonSig = $sig; |
7430
|
|
|
|
|
|
|
} |
7431
|
10
|
50
|
|
|
|
37
|
$self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP}; |
7432
|
|
|
|
|
|
|
} |
7433
|
|
|
|
|
|
|
} elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) { |
7434
|
|
|
|
|
|
|
# panasonic RAW, RW2 or RWL file |
7435
|
3
|
|
|
|
|
8
|
my $magic; |
7436
|
|
|
|
|
|
|
# test for RW2/RWL magic number |
7437
|
3
|
50
|
33
|
|
|
22
|
if ($offset >= 0x18 and $raf->Read($magic, 16) and |
|
|
|
33
|
|
|
|
|
7438
|
|
|
|
|
|
|
$magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a") |
7439
|
|
|
|
|
|
|
{ |
7440
|
3
|
50
|
|
|
|
15
|
$fileType = 'RW2' unless $fileType eq 'RWL'; |
7441
|
3
|
50
|
|
|
|
14
|
$self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP}; |
7442
|
3
|
|
|
|
|
9
|
$otherSig = $magic; # save signature for writing |
7443
|
|
|
|
|
|
|
} else { |
7444
|
0
|
|
|
|
|
0
|
$fileType = 'RAW'; |
7445
|
|
|
|
|
|
|
} |
7446
|
3
|
|
|
|
|
15
|
$tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main'); |
7447
|
|
|
|
|
|
|
} elsif ($fileType eq 'TIFF') { |
7448
|
13
|
50
|
33
|
|
|
113
|
if ($identifier == 0x2b) { |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7449
|
|
|
|
|
|
|
# this looks like a BigTIFF image |
7450
|
0
|
|
|
|
|
0
|
$raf->Seek(0); |
7451
|
0
|
|
|
|
|
0
|
require Image::ExifTool::BigTIFF; |
7452
|
0
|
|
|
|
|
0
|
my $result = Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo); |
7453
|
0
|
0
|
|
|
|
0
|
if ($result) { |
7454
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(PageCount => $$self{PageCount}) if $$self{MultiPage}; |
7455
|
0
|
|
|
|
|
0
|
return 1; |
7456
|
|
|
|
|
|
|
} |
7457
|
|
|
|
|
|
|
} elsif ($identifier == 0x4f52 or $identifier == 0x5352) { |
7458
|
|
|
|
|
|
|
# Olympus ORF image (set FileType now because base type is 'ORF') |
7459
|
0
|
|
|
|
|
0
|
$self->SetFileType($fileType = 'ORF'); |
7460
|
|
|
|
|
|
|
} elsif ($identifier == 0x4352) { |
7461
|
0
|
|
|
|
|
0
|
$fileType = 'DCP'; |
7462
|
|
|
|
|
|
|
} elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) { |
7463
|
0
|
|
|
|
|
0
|
$fileType = 'HDP'; # Windows HD Photo file |
7464
|
|
|
|
|
|
|
# check version number |
7465
|
0
|
|
|
|
|
0
|
my $ver = Get8u($dataPt, 3); |
7466
|
0
|
0
|
|
|
|
0
|
if ($ver > 1) { |
7467
|
0
|
|
|
|
|
0
|
$self->Error("Windows HD Photo version $ver files not yet supported"); |
7468
|
0
|
|
|
|
|
0
|
return 1; |
7469
|
|
|
|
|
|
|
} |
7470
|
|
|
|
|
|
|
} |
7471
|
|
|
|
|
|
|
} |
7472
|
|
|
|
|
|
|
# we have a valid TIFF (or whatever) file |
7473
|
40
|
100
|
66
|
|
|
251
|
if ($fileType and not $$self{VALUE}{FileType}) { |
7474
|
38
|
|
|
|
|
100
|
my $lookup = $fileTypeLookup{$fileType}; |
7475
|
38
|
50
|
33
|
|
|
173
|
$lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup; |
7476
|
|
|
|
|
|
|
# use file extension to pre-determine type if extension is TIFF-based or type is RAW |
7477
|
38
|
50
|
|
|
|
200
|
my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : ''; |
|
|
50
|
|
|
|
|
|
7478
|
38
|
100
|
66
|
|
|
183
|
my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef; |
7479
|
38
|
|
|
|
|
165
|
$self->SetFileType($t); |
7480
|
|
|
|
|
|
|
} |
7481
|
|
|
|
|
|
|
# don't process file if FastScan == 3 |
7482
|
40
|
50
|
66
|
|
|
311
|
return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3; |
|
|
|
33
|
|
|
|
|
7483
|
|
|
|
|
|
|
} |
7484
|
|
|
|
|
|
|
# (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level) |
7485
|
472
|
100
|
100
|
|
|
2975
|
my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0'; |
7486
|
472
|
100
|
100
|
|
|
2978
|
if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
7487
|
396
|
100
|
|
|
|
1394
|
$self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile; |
7488
|
|
|
|
|
|
|
} elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes) |
7489
|
19
|
|
|
|
|
50
|
$ifdName = $$tagTablePtr{GROUPS}{0}; |
7490
|
|
|
|
|
|
|
} else { |
7491
|
57
|
|
|
|
|
139
|
$ifdName = $$tagTablePtr{GROUPS}{1}; |
7492
|
|
|
|
|
|
|
} |
7493
|
472
|
50
|
|
|
|
1566
|
if ($$self{HTML_DUMP}) { |
7494
|
0
|
0
|
|
|
|
0
|
my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x", |
7495
|
|
|
|
|
|
|
($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset); |
7496
|
0
|
|
|
|
|
0
|
$self->HDump($base, 8, 'TIFF header', $tip, 0); |
7497
|
|
|
|
|
|
|
} |
7498
|
|
|
|
|
|
|
# remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...) |
7499
|
472
|
|
|
|
|
1064
|
$$self{TIFF_TYPE} = $fileType; |
7500
|
|
|
|
|
|
|
|
7501
|
|
|
|
|
|
|
# get reference to the main EXIF table |
7502
|
472
|
100
|
|
|
|
1468
|
$tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main'); |
7503
|
|
|
|
|
|
|
|
7504
|
|
|
|
|
|
|
# build directory information hash |
7505
|
|
|
|
|
|
|
my %dirInfo = ( |
7506
|
|
|
|
|
|
|
Base => $base, |
7507
|
|
|
|
|
|
|
DataPt => $dataPt, |
7508
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
7509
|
|
|
|
|
|
|
DataPos => 0, |
7510
|
|
|
|
|
|
|
DirStart => $offset, |
7511
|
|
|
|
|
|
|
DirLen => length($$dataPt) - $offset, |
7512
|
|
|
|
|
|
|
RAF => $raf, |
7513
|
|
|
|
|
|
|
DirName => $ifdName, |
7514
|
|
|
|
|
|
|
Parent => $fileType, |
7515
|
|
|
|
|
|
|
ImageData=> 'Main', # set flag to get information to copy main image data later |
7516
|
|
|
|
|
|
|
Multi => $$dirInfo{Multi}, |
7517
|
472
|
|
|
|
|
4304
|
); |
7518
|
|
|
|
|
|
|
|
7519
|
|
|
|
|
|
|
# extract information from the image |
7520
|
472
|
100
|
|
|
|
1355
|
unless ($outfile) { |
7521
|
|
|
|
|
|
|
# process the directory |
7522
|
350
|
|
|
|
|
1414
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7523
|
|
|
|
|
|
|
# process GeoTiff information if available |
7524
|
350
|
100
|
|
|
|
1526
|
if ($$self{VALUE}{GeoTiffDirectory}) { |
7525
|
7
|
|
|
|
|
749
|
require Image::ExifTool::GeoTiff; |
7526
|
7
|
|
|
|
|
32
|
Image::ExifTool::GeoTiff::ProcessGeoTiff($self); |
7527
|
|
|
|
|
|
|
} |
7528
|
|
|
|
|
|
|
# process information in recognized trailers |
7529
|
350
|
100
|
|
|
|
1040
|
if ($raf) { |
7530
|
27
|
|
|
|
|
116
|
my $trailInfo = IdentifyTrailer($raf); |
7531
|
27
|
100
|
|
|
|
189
|
if ($trailInfo) { |
7532
|
3
|
|
|
|
|
10
|
$$trailInfo{ScanForAFCP} = 1; # scan to find AFCP if necessary |
7533
|
3
|
|
|
|
|
12
|
$self->ProcessTrailers($trailInfo); |
7534
|
|
|
|
|
|
|
} |
7535
|
|
|
|
|
|
|
# dump any other known trailer (eg. A100 RAW Data) |
7536
|
27
|
0
|
33
|
|
|
130
|
if ($$self{HTML_DUMP} and $$self{KnownTrailer}) { |
7537
|
0
|
|
|
|
|
0
|
my $known = $$self{KnownTrailer}; |
7538
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); |
7539
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $$known{Start}; |
7540
|
0
|
0
|
|
|
|
0
|
$len -= $$trailInfo{Offset} if $trailInfo; # account for other trailers |
7541
|
0
|
0
|
|
|
|
0
|
$self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0; |
7542
|
|
|
|
|
|
|
} |
7543
|
|
|
|
|
|
|
} |
7544
|
|
|
|
|
|
|
# update FileType if necessary now that we know more about the file |
7545
|
350
|
50
|
66
|
|
|
1302
|
if ($$self{DNGVersion} and $$self{VALUE}{FileType} !~ /^(DNG|GPR)$/) { |
7546
|
|
|
|
|
|
|
# override whatever FileType we set since we now know it is DNG |
7547
|
0
|
|
|
|
|
0
|
$self->OverrideFileType($$self{TIFF_TYPE} = 'DNG'); |
7548
|
|
|
|
|
|
|
} |
7549
|
350
|
100
|
|
|
|
1121
|
if ($$self{TIFF_TYPE} eq 'TIFF') { |
7550
|
10
|
50
|
|
|
|
31
|
$self->FoundTag(PageCount => $$self{PageCount}) if $$self{MultiPage}; |
7551
|
|
|
|
|
|
|
} |
7552
|
350
|
|
|
|
|
1757
|
return 1; |
7553
|
|
|
|
|
|
|
} |
7554
|
|
|
|
|
|
|
# |
7555
|
|
|
|
|
|
|
# rewrite the image |
7556
|
|
|
|
|
|
|
# |
7557
|
122
|
100
|
|
|
|
685
|
if ($$dirInfo{NoTiffEnd}) { |
7558
|
1
|
|
|
|
|
2
|
delete $$self{TIFF_END}; |
7559
|
|
|
|
|
|
|
} else { |
7560
|
|
|
|
|
|
|
# initialize TIFF_END so it will be updated by WriteExif() |
7561
|
121
|
|
|
|
|
340
|
$$self{TIFF_END} = 0; |
7562
|
|
|
|
|
|
|
} |
7563
|
122
|
100
|
|
|
|
341
|
if ($canonSig) { |
7564
|
|
|
|
|
|
|
# write Canon CR2 specially because it has a header we want to preserve, |
7565
|
|
|
|
|
|
|
# and possibly trailers added by the Canon utilities and/or PhotoMechanic |
7566
|
3
|
|
|
|
|
8
|
$dirInfo{OutFile} = $outfile; |
7567
|
3
|
|
|
|
|
20
|
require Image::ExifTool::CanonRaw; |
7568
|
3
|
50
|
|
|
|
16
|
Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1; |
7569
|
|
|
|
|
|
|
} else { |
7570
|
|
|
|
|
|
|
# write TIFF header (8 bytes [plus optional signature] followed by IFD) |
7571
|
119
|
100
|
|
|
|
615
|
if ($fileType eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
7572
|
1
|
|
|
|
|
3
|
$otherSig = 'ExifMeta'; # force this signature for all EXIF files |
7573
|
|
|
|
|
|
|
} elsif (not defined $otherSig) { |
7574
|
117
|
|
|
|
|
249
|
$otherSig = ''; |
7575
|
|
|
|
|
|
|
} |
7576
|
119
|
|
|
|
|
373
|
my $offset = 8 + length($otherSig); |
7577
|
|
|
|
|
|
|
# construct tiff header |
7578
|
119
|
|
|
|
|
863
|
my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig; |
7579
|
119
|
|
|
|
|
346
|
$dirInfo{NewDataPos} = $offset; |
7580
|
119
|
|
|
|
|
328
|
$dirInfo{HeaderPtr} = \$header; |
7581
|
|
|
|
|
|
|
# preserve padding between image data blocks in ORF images |
7582
|
|
|
|
|
|
|
# (otherwise dcraw has problems because it assumes fixed block spacing) |
7583
|
119
|
100
|
66
|
|
|
698
|
$dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a; |
7584
|
119
|
|
|
|
|
833
|
my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr); |
7585
|
119
|
50
|
|
|
|
663
|
if (not defined $newData) { |
|
|
100
|
|
|
|
|
|
7586
|
0
|
|
|
|
|
0
|
$err = 1; |
7587
|
|
|
|
|
|
|
} elsif (length($newData)) { |
7588
|
|
|
|
|
|
|
# update header length in case more was added |
7589
|
113
|
|
|
|
|
252
|
my $hdrLen = length $header; |
7590
|
113
|
100
|
|
|
|
432
|
if ($hdrLen != 8) { |
7591
|
3
|
|
|
|
|
14
|
Set32u($hdrLen, \$header, 4); |
7592
|
|
|
|
|
|
|
# also update preview fixup if necessary |
7593
|
3
|
|
|
|
|
8
|
my $pi = $$self{PREVIEW_INFO}; |
7594
|
3
|
0
|
33
|
|
|
13
|
$$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup}; |
7595
|
|
|
|
|
|
|
} |
7596
|
113
|
50
|
33
|
|
|
536
|
if ($$self{TIFF_TYPE} eq 'ARW' and not $err) { |
7597
|
|
|
|
|
|
|
# write any required ARW trailer and patch other ARW quirks |
7598
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Sony; |
7599
|
|
|
|
|
|
|
my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, |
7600
|
0
|
|
|
|
|
0
|
$dirInfo{ImageData}); |
7601
|
0
|
0
|
|
|
|
0
|
$errStr and $self->Error($errStr); |
7602
|
0
|
|
|
|
|
0
|
delete $dirInfo{ImageData}; # (was copied by FinishARW) |
7603
|
|
|
|
|
|
|
} else { |
7604
|
113
|
50
|
|
|
|
468
|
Write($outfile, $header, $newData) or $err = 1; |
7605
|
|
|
|
|
|
|
} |
7606
|
113
|
|
|
|
|
358
|
undef $newData; # free memory |
7607
|
|
|
|
|
|
|
} |
7608
|
|
|
|
|
|
|
# copy over image data now if necessary |
7609
|
119
|
100
|
66
|
|
|
628
|
if (ref $dirInfo{ImageData} and not $err) { |
7610
|
10
|
50
|
|
|
|
72
|
$self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1; |
7611
|
10
|
|
|
|
|
46
|
delete $dirInfo{ImageData}; |
7612
|
|
|
|
|
|
|
} |
7613
|
|
|
|
|
|
|
} |
7614
|
|
|
|
|
|
|
# make local copy of TIFF_END now (it may be reset when processing trailers) |
7615
|
122
|
|
|
|
|
312
|
my $tiffEnd = $$self{TIFF_END}; |
7616
|
122
|
|
|
|
|
253
|
delete $$self{TIFF_END}; |
7617
|
|
|
|
|
|
|
|
7618
|
|
|
|
|
|
|
# rewrite trailers if they exist |
7619
|
122
|
100
|
100
|
|
|
540
|
if ($raf and $tiffEnd and not $err) { |
|
|
|
66
|
|
|
|
|
7620
|
12
|
|
|
|
|
27
|
my ($buf, $trailInfo); |
7621
|
12
|
50
|
|
|
|
41
|
$raf->Seek(0, 2) or $err = 1; |
7622
|
12
|
|
|
|
|
50
|
my $extra = $raf->Tell() - $tiffEnd; |
7623
|
|
|
|
|
|
|
# check for trailer and process if possible |
7624
|
12
|
|
|
|
|
24
|
for (;;) { |
7625
|
12
|
100
|
|
|
|
40
|
last unless $extra > 12; |
7626
|
3
|
|
|
|
|
9
|
$raf->Seek($tiffEnd); # seek back to end of image |
7627
|
3
|
|
|
|
|
12
|
$trailInfo = IdentifyTrailer($raf); |
7628
|
3
|
50
|
|
|
|
13
|
last unless $trailInfo; |
7629
|
0
|
|
|
|
|
0
|
my $tbuf = ''; |
7630
|
0
|
|
|
|
|
0
|
$$trailInfo{OutFile} = \$tbuf; # rewrite trailer(s) |
7631
|
0
|
|
|
|
|
0
|
$$trailInfo{ScanForAFCP} = 1; # scan for AFCP if necessary |
7632
|
|
|
|
|
|
|
# rewrite all trailers to buffer |
7633
|
0
|
0
|
|
|
|
0
|
unless ($self->ProcessTrailers($trailInfo)) { |
7634
|
0
|
|
|
|
|
0
|
undef $trailInfo; |
7635
|
0
|
|
|
|
|
0
|
$err = 1; |
7636
|
0
|
|
|
|
|
0
|
last; |
7637
|
|
|
|
|
|
|
} |
7638
|
|
|
|
|
|
|
# calculate unused bytes before trailer |
7639
|
0
|
|
|
|
|
0
|
$extra = $$trailInfo{DataPos} - $tiffEnd; |
7640
|
0
|
|
|
|
|
0
|
last; # yes, the 'for' loop was just a cheap 'goto' |
7641
|
|
|
|
|
|
|
} |
7642
|
|
|
|
|
|
|
# ignore a single zero byte if used for padding |
7643
|
12
|
100
|
100
|
|
|
60
|
if ($extra > 0 and $tiffEnd & 0x01) { |
7644
|
1
|
50
|
|
|
|
3
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7645
|
1
|
50
|
|
|
|
3
|
$raf->Read($buf, 1) or $err = 1; |
7646
|
1
|
50
|
33
|
|
|
6
|
defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd; |
7647
|
|
|
|
|
|
|
} |
7648
|
12
|
100
|
|
|
|
42
|
if ($extra > 0) { |
7649
|
3
|
|
|
|
|
7
|
my $known = $$self{KnownTrailer}; |
7650
|
3
|
50
|
33
|
|
|
18
|
if ($$self{DEL_GROUP}{Trailer} and not $known) { |
|
|
50
|
|
|
|
|
|
7651
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n"); |
7652
|
0
|
|
|
|
|
0
|
++$$self{CHANGED}; |
7653
|
|
|
|
|
|
|
} elsif ($known) { |
7654
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Copying $$known{Name} ($extra bytes)\n"); |
7655
|
0
|
0
|
|
|
|
0
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7656
|
0
|
0
|
|
|
|
0
|
CopyBlock($raf, $outfile, $extra) or $err = 1; |
7657
|
|
|
|
|
|
|
} else { |
7658
|
3
|
50
|
|
|
|
11
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7659
|
|
|
|
|
|
|
# preserve unknown trailer only if it contains non-null data |
7660
|
|
|
|
|
|
|
# (Photoshop CS adds a trailer with 2 null bytes) |
7661
|
3
|
|
|
|
|
12
|
my $size = $extra; |
7662
|
3
|
|
|
|
|
7
|
for (;;) { |
7663
|
3
|
50
|
|
|
|
7
|
my $n = $size > 65536 ? 65536 : $size; |
7664
|
3
|
50
|
|
|
|
10
|
$raf->Read($buf, $n) == $n or $err = 1, last; |
7665
|
3
|
50
|
|
|
|
17
|
if ($buf =~ /[^\0]/) { |
7666
|
3
|
|
|
|
|
19
|
$self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n"); |
7667
|
|
|
|
|
|
|
# copy the trailer since it contains non-null data |
7668
|
3
|
50
|
0
|
|
|
10
|
Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra; |
7669
|
3
|
50
|
|
|
|
9
|
Write($outfile, $buf) or $err = 1, last; |
7670
|
3
|
50
|
0
|
|
|
11
|
CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n; |
7671
|
3
|
|
|
|
|
6
|
last; |
7672
|
|
|
|
|
|
|
} |
7673
|
0
|
|
|
|
|
0
|
$size -= $n; |
7674
|
0
|
0
|
|
|
|
0
|
next if $size > 0; |
7675
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Deleting blank trailer ($extra bytes)\n"); |
7676
|
0
|
|
|
|
|
0
|
last; |
7677
|
|
|
|
|
|
|
} |
7678
|
|
|
|
|
|
|
} |
7679
|
|
|
|
|
|
|
} |
7680
|
|
|
|
|
|
|
# write trailer buffer if necessary |
7681
|
12
|
50
|
0
|
|
|
41
|
$self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo; |
7682
|
|
|
|
|
|
|
# add any new trailers we are creating |
7683
|
12
|
|
|
|
|
62
|
my $trailPt = $self->AddNewTrailers(); |
7684
|
12
|
100
|
50
|
|
|
50
|
Write($outfile, $$trailPt) or $err = 1 if $trailPt; |
7685
|
|
|
|
|
|
|
} |
7686
|
|
|
|
|
|
|
# check DNG version |
7687
|
122
|
100
|
|
|
|
429
|
if ($$self{DNGVersion}) { |
7688
|
1
|
|
|
|
|
2
|
my $ver = $$self{DNGVersion}; |
7689
|
|
|
|
|
|
|
# currently support up to DNG version 1.6 |
7690
|
1
|
50
|
33
|
|
|
31
|
unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.6) { |
7691
|
0
|
|
|
|
|
0
|
$ver =~ tr/ /./; |
7692
|
0
|
|
|
|
|
0
|
$self->Error("DNG Version $ver not yet tested", 1); |
7693
|
|
|
|
|
|
|
} |
7694
|
|
|
|
|
|
|
} |
7695
|
122
|
50
|
|
|
|
832
|
return $err ? -1 : 1; |
7696
|
|
|
|
|
|
|
} |
7697
|
|
|
|
|
|
|
|
7698
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7699
|
|
|
|
|
|
|
# Return list of tag table keys (ignoring special keys) |
7700
|
|
|
|
|
|
|
# Inputs: 0) reference to tag table |
7701
|
|
|
|
|
|
|
# Returns: List of table keys (unsorted) |
7702
|
|
|
|
|
|
|
sub TagTableKeys($) |
7703
|
|
|
|
|
|
|
{ |
7704
|
7562
|
|
|
7562
|
0
|
10289
|
local $_; |
7705
|
7562
|
|
|
|
|
10100
|
my $tagTablePtr = shift; |
7706
|
7562
|
|
|
|
|
10022
|
my @keyList; |
7707
|
7562
|
|
|
|
|
93751
|
foreach (keys %$tagTablePtr) { |
7708
|
445654
|
100
|
|
|
|
672439
|
push(@keyList, $_) unless $specialTags{$_}; |
7709
|
|
|
|
|
|
|
} |
7710
|
7562
|
|
|
|
|
62835
|
return @keyList; |
7711
|
|
|
|
|
|
|
} |
7712
|
|
|
|
|
|
|
|
7713
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7714
|
|
|
|
|
|
|
# GetTagTable |
7715
|
|
|
|
|
|
|
# Inputs: 0) table name |
7716
|
|
|
|
|
|
|
# Returns: tag table reference, or undefined if not found |
7717
|
|
|
|
|
|
|
# Notes: Always use this function instead of requiring module and using table |
7718
|
|
|
|
|
|
|
# directly since this function also does the following the first time the table |
7719
|
|
|
|
|
|
|
# is loaded: |
7720
|
|
|
|
|
|
|
# - requires new module if necessary |
7721
|
|
|
|
|
|
|
# - generates default GROUPS hash and Group 0 name from module name |
7722
|
|
|
|
|
|
|
# - registers Composite tags if Composite table found |
7723
|
|
|
|
|
|
|
# - saves descriptions for tags in specified table |
7724
|
|
|
|
|
|
|
# - generates default TAG_PREFIX to be used for unknown tags |
7725
|
|
|
|
|
|
|
sub GetTagTable($) |
7726
|
|
|
|
|
|
|
{ |
7727
|
88885
|
100
|
|
88885
|
0
|
154275
|
my $tableName = shift or return undef; |
7728
|
88881
|
|
|
|
|
146968
|
my $table = $allTables{$tableName}; |
7729
|
|
|
|
|
|
|
|
7730
|
88881
|
100
|
|
|
|
135133
|
unless ($table) { |
7731
|
104
|
|
|
104
|
|
1214
|
no strict 'refs'; |
|
104
|
|
|
|
|
229
|
|
|
104
|
|
|
|
|
16454
|
|
7732
|
4488
|
100
|
|
|
|
24102
|
unless (%$tableName) { |
7733
|
|
|
|
|
|
|
# try to load module for this table |
7734
|
864
|
50
|
|
|
|
5825
|
if ($tableName =~ /(.*)::/) { |
7735
|
864
|
|
|
|
|
2703
|
my $module = $1; |
7736
|
864
|
50
|
|
|
|
58671
|
if (eval "require $module") { |
7737
|
|
|
|
|
|
|
# load additional modules if required |
7738
|
864
|
100
|
|
|
|
6059
|
if (not %$tableName) { |
7739
|
28
|
50
|
|
|
|
137
|
if ($module eq 'Image::ExifTool::XMP') { |
|
|
0
|
|
|
|
|
|
7740
|
28
|
|
|
|
|
19420
|
require 'Image/ExifTool/XMP2.pl'; |
7741
|
|
|
|
|
|
|
} elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') { |
7742
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/QuickTimeStream.pl'; |
7743
|
|
|
|
|
|
|
} |
7744
|
|
|
|
|
|
|
} |
7745
|
|
|
|
|
|
|
} else { |
7746
|
0
|
0
|
|
|
|
0
|
$@ and warn $@; |
7747
|
|
|
|
|
|
|
} |
7748
|
|
|
|
|
|
|
} |
7749
|
864
|
50
|
|
|
|
4489
|
unless (%$tableName) { |
7750
|
0
|
|
|
|
|
0
|
warn "Can't find table $tableName\n"; |
7751
|
0
|
|
|
|
|
0
|
return undef; |
7752
|
|
|
|
|
|
|
} |
7753
|
|
|
|
|
|
|
} |
7754
|
104
|
|
|
104
|
|
673
|
no strict 'refs'; |
|
104
|
|
|
|
|
180
|
|
|
104
|
|
|
|
|
3784
|
|
7755
|
4488
|
|
|
|
|
9696
|
$table = \%$tableName; |
7756
|
104
|
|
|
104
|
|
530
|
use strict 'refs'; |
|
104
|
|
|
|
|
219
|
|
|
104
|
|
|
|
|
76436
|
|
7757
|
4488
|
100
|
|
|
|
11314
|
&{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE}; |
|
12
|
|
|
|
|
162
|
|
7758
|
4488
|
|
|
|
|
9129
|
$$table{TABLE_NAME} = $tableName; # set table name |
7759
|
4488
|
|
|
|
|
23297
|
($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://; |
7760
|
|
|
|
|
|
|
# set default group 0 and 1 from module name unless already specified |
7761
|
4488
|
|
|
|
|
9756
|
my $defaultGroups = $$table{GROUPS}; |
7762
|
4488
|
100
|
|
|
|
9128
|
$defaultGroups or $defaultGroups = $$table{GROUPS} = { }; |
7763
|
4488
|
100
|
100
|
|
|
16672
|
unless ($$defaultGroups{0} and $$defaultGroups{1}) { |
7764
|
3585
|
50
|
|
|
|
18089
|
if ($tableName =~ /Image::.*?::([^:]*)/) { |
7765
|
3585
|
100
|
|
|
|
10181
|
$$defaultGroups{0} = $1 unless $$defaultGroups{0}; |
7766
|
3585
|
100
|
|
|
|
11333
|
$$defaultGroups{1} = $1 unless $$defaultGroups{1}; |
7767
|
|
|
|
|
|
|
} else { |
7768
|
0
|
0
|
|
|
|
0
|
$$defaultGroups{0} = $tableName unless $$defaultGroups{0}; |
7769
|
0
|
0
|
|
|
|
0
|
$$defaultGroups{1} = $tableName unless $$defaultGroups{1}; |
7770
|
|
|
|
|
|
|
} |
7771
|
|
|
|
|
|
|
} |
7772
|
4488
|
100
|
|
|
|
9828
|
$$defaultGroups{2} = 'Other' unless $$defaultGroups{2}; |
7773
|
4488
|
100
|
100
|
|
|
15949
|
if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) { |
7774
|
|
|
|
|
|
|
# initialize some XMP table defaults |
7775
|
507
|
|
|
|
|
2836
|
require Image::ExifTool::XMP; |
7776
|
507
|
|
|
|
|
2021
|
Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces |
7777
|
|
|
|
|
|
|
# set default write/check procs |
7778
|
507
|
100
|
|
|
|
1377
|
$$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC}; |
7779
|
507
|
100
|
|
|
|
1341
|
$$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC}; |
7780
|
507
|
100
|
|
|
|
1270
|
$$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO}; |
7781
|
|
|
|
|
|
|
} |
7782
|
|
|
|
|
|
|
# generate a tag prefix for unknown tags if necessary |
7783
|
4488
|
100
|
|
|
|
9316
|
unless (defined $$table{TAG_PREFIX}) { |
7784
|
4388
|
|
|
|
|
5566
|
my $tagPrefix; |
7785
|
4388
|
50
|
66
|
|
|
22691
|
if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) { |
7786
|
4388
|
|
|
|
|
15885
|
($tagPrefix = $1) =~ s/::/_/g; |
7787
|
|
|
|
|
|
|
} else { |
7788
|
0
|
|
|
|
|
0
|
$tagPrefix = $tableName; |
7789
|
|
|
|
|
|
|
} |
7790
|
4388
|
|
|
|
|
10785
|
$$table{TAG_PREFIX} = $tagPrefix; |
7791
|
|
|
|
|
|
|
} |
7792
|
|
|
|
|
|
|
# set up the new table |
7793
|
4488
|
|
|
|
|
11666
|
SetupTagTable($table); |
7794
|
|
|
|
|
|
|
# add any user-defined tags (except Composite tags, which are handled specially) |
7795
|
4488
|
100
|
100
|
|
|
18002
|
if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) { |
|
|
|
66
|
|
|
|
|
7796
|
2
|
|
|
|
|
3
|
my $tagID; |
7797
|
2
|
|
|
|
|
6
|
foreach $tagID (TagTableKeys($UserDefined{$tableName})) { |
7798
|
3
|
50
|
|
|
|
9
|
next if $specialTags{$tagID}; |
7799
|
3
|
|
|
|
|
5
|
delete $$table{$tagID}; # replace any existing entry |
7800
|
3
|
|
|
|
|
12
|
AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1); |
7801
|
|
|
|
|
|
|
} |
7802
|
|
|
|
|
|
|
} |
7803
|
|
|
|
|
|
|
# remember order we loaded the tables in |
7804
|
4488
|
|
|
|
|
8463
|
push @tableOrder, $tableName; |
7805
|
|
|
|
|
|
|
# insert newly loaded table into list |
7806
|
4488
|
|
|
|
|
11966
|
$allTables{$tableName} = $table; |
7807
|
|
|
|
|
|
|
} |
7808
|
|
|
|
|
|
|
# must check each time to add UserDefined Composite tags because the Composite table |
7809
|
|
|
|
|
|
|
# may be loaded before the UserDefined tags are available |
7810
|
88881
|
50
|
66
|
|
|
201901
|
if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
7811
|
|
|
|
|
|
|
%UserDefined and $UserDefined{$tableName}) |
7812
|
|
|
|
|
|
|
{ |
7813
|
0
|
|
|
|
|
0
|
my $userComp = $UserDefined{$tableName}; |
7814
|
0
|
|
|
|
|
0
|
delete $UserDefined{$tableName}; # (must delete first to avoid infinite recursion) |
7815
|
0
|
|
|
|
|
0
|
AddCompositeTags($userComp, 1); |
7816
|
0
|
|
|
|
|
0
|
$UserDefined{$tableName} = $userComp; # (add back again for adding writable tags later) |
7817
|
0
|
|
|
|
|
0
|
$$table{VARS}{LOADED_USERDEFINED} = 1; # set flag to avoid doing this again |
7818
|
|
|
|
|
|
|
} |
7819
|
88881
|
|
|
|
|
167091
|
return $table; |
7820
|
|
|
|
|
|
|
} |
7821
|
|
|
|
|
|
|
|
7822
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7823
|
|
|
|
|
|
|
# Process an image directory |
7824
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) directory information reference |
7825
|
|
|
|
|
|
|
# 2) tag table reference, 3) optional reference to processing procedure |
7826
|
|
|
|
|
|
|
# Returns: Result from processing (1=success) |
7827
|
|
|
|
|
|
|
sub ProcessDirectory($$$;$) |
7828
|
|
|
|
|
|
|
{ |
7829
|
4862
|
|
|
4862
|
0
|
12287
|
my ($self, $dirInfo, $tagTablePtr, $proc) = @_; |
7830
|
|
|
|
|
|
|
|
7831
|
4862
|
50
|
33
|
|
|
16821
|
return 0 unless $tagTablePtr and $dirInfo; |
7832
|
|
|
|
|
|
|
# use default proc from tag table or EXIF proc as fallback if no proc specified |
7833
|
4862
|
100
|
100
|
|
|
16591
|
$proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif; |
7834
|
|
|
|
|
|
|
# set directory name from default group0 name if not done already |
7835
|
4862
|
|
|
|
|
7834
|
my $dirName = $$dirInfo{DirName}; |
7836
|
4862
|
100
|
|
|
|
8871
|
unless ($dirName) { |
7837
|
701
|
|
|
|
|
1958
|
$dirName = $$tagTablePtr{GROUPS}{0}; |
7838
|
701
|
100
|
|
|
|
2417
|
$dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name) |
7839
|
701
|
|
|
|
|
1496
|
$$dirInfo{DirName} = $dirName; |
7840
|
|
|
|
|
|
|
} |
7841
|
|
|
|
|
|
|
|
7842
|
|
|
|
|
|
|
# guard against cyclical recursion into the same directory |
7843
|
4862
|
100
|
100
|
|
|
23028
|
if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
7844
|
|
|
|
|
|
|
# directories don't overlap if the length is zero |
7845
|
|
|
|
|
|
|
($$dirInfo{DirLen} or not defined $$dirInfo{DirLen})) |
7846
|
|
|
|
|
|
|
{ |
7847
|
4057
|
|
100
|
|
|
12377
|
my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE}; |
7848
|
4057
|
50
|
|
|
|
10299
|
if ($$self{PROCESSED}{$addr}) { |
7849
|
0
|
|
|
|
|
0
|
$self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory"); |
7850
|
|
|
|
|
|
|
# patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer |
7851
|
0
|
0
|
0
|
|
|
0
|
return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD'; |
7852
|
|
|
|
|
|
|
} |
7853
|
4057
|
|
|
|
|
10380
|
$$self{PROCESSED}{$addr} = $dirName; |
7854
|
|
|
|
|
|
|
} |
7855
|
4862
|
|
|
|
|
10245
|
my $oldOrder = GetByteOrder(); |
7856
|
4862
|
|
|
|
|
15858
|
my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'}; |
7857
|
4862
|
|
|
|
|
11637
|
$$self{LIST_TAGS} = { }; # don't build lists across different directories |
7858
|
4862
|
|
|
|
|
8766
|
$$self{INDENT} .= '| '; |
7859
|
4862
|
|
|
|
|
7331
|
$$self{DIR_NAME} = $dirName; |
7860
|
4862
|
|
|
|
|
6084
|
push @{$$self{PATH}}, $dirName; |
|
4862
|
|
|
|
|
9868
|
|
7861
|
4862
|
|
|
|
|
11013
|
$$self{FOUND_DIR}{$dirName} = 1; |
7862
|
|
|
|
|
|
|
|
7863
|
|
|
|
|
|
|
# process the directory |
7864
|
104
|
|
|
104
|
|
745
|
no strict 'refs'; |
|
104
|
|
|
|
|
245
|
|
|
104
|
|
|
|
|
4328
|
|
7865
|
4862
|
|
|
|
|
19119
|
my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr); |
7866
|
104
|
|
|
104
|
|
603
|
use strict 'refs'; |
|
104
|
|
|
|
|
233
|
|
|
104
|
|
|
|
|
665544
|
|
7867
|
|
|
|
|
|
|
|
7868
|
4862
|
|
|
|
|
6760
|
pop @{$$self{PATH}}; |
|
4862
|
|
|
|
|
9558
|
|
7869
|
4862
|
|
|
|
|
15530
|
@$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save; |
7870
|
4862
|
|
|
|
|
11879
|
SetByteOrder($oldOrder); |
7871
|
4862
|
|
|
|
|
15861
|
return $rtnVal; |
7872
|
|
|
|
|
|
|
} |
7873
|
|
|
|
|
|
|
|
7874
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7875
|
|
|
|
|
|
|
# Get Metadata path |
7876
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref |
7877
|
|
|
|
|
|
|
# Return: Metadata path string |
7878
|
|
|
|
|
|
|
sub MetadataPath($) |
7879
|
|
|
|
|
|
|
{ |
7880
|
720
|
|
|
720
|
0
|
1142
|
my $self = shift; |
7881
|
720
|
|
|
|
|
979
|
return join '-', @{$$self{PATH}} |
|
720
|
|
|
|
|
2862
|
|
7882
|
|
|
|
|
|
|
} |
7883
|
|
|
|
|
|
|
|
7884
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7885
|
|
|
|
|
|
|
# Get standardized file extension |
7886
|
|
|
|
|
|
|
# Inputs: 0) file name |
7887
|
|
|
|
|
|
|
# Returns: standardized extension (all uppercase), or undefined if no extension |
7888
|
|
|
|
|
|
|
sub GetFileExtension($) |
7889
|
|
|
|
|
|
|
{ |
7890
|
1907
|
|
|
1907
|
0
|
2929
|
my $filename = shift; |
7891
|
1907
|
|
|
|
|
2459
|
my $fileExt; |
7892
|
1907
|
100
|
100
|
|
|
9916
|
if ($filename and $filename =~ /^.*\.([^.]+)$/s) { |
7893
|
1776
|
|
|
|
|
4808
|
$fileExt = uc($1); # change extension to upper case |
7894
|
|
|
|
|
|
|
# convert TIF extension to TIFF because we use the |
7895
|
|
|
|
|
|
|
# extension for the file type tag of TIFF images |
7896
|
1776
|
100
|
|
|
|
3661
|
$fileExt eq 'TIF' and $fileExt = 'TIFF'; |
7897
|
|
|
|
|
|
|
} |
7898
|
1907
|
|
|
|
|
5080
|
return $fileExt; |
7899
|
|
|
|
|
|
|
} |
7900
|
|
|
|
|
|
|
|
7901
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7902
|
|
|
|
|
|
|
# Get list of tag information hashes for given tag ID |
7903
|
|
|
|
|
|
|
# Inputs: 0) Tag table reference, 1) tag ID |
7904
|
|
|
|
|
|
|
# Returns: Array of tag information references |
7905
|
|
|
|
|
|
|
# Notes: Generates tagInfo hash if necessary |
7906
|
|
|
|
|
|
|
sub GetTagInfoList($$) |
7907
|
|
|
|
|
|
|
{ |
7908
|
526513
|
|
|
526513
|
0
|
686123
|
my ($tagTablePtr, $tagID) = @_; |
7909
|
526513
|
|
|
|
|
741598
|
my $tagInfo = $$tagTablePtr{$tagID}; |
7910
|
|
|
|
|
|
|
|
7911
|
526513
|
50
|
|
|
|
927940
|
if ($specialTags{$tagID}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
7912
|
|
|
|
|
|
|
# (hopefully this won't happen) |
7913
|
0
|
|
|
|
|
0
|
warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n"; |
7914
|
|
|
|
|
|
|
} elsif (ref $tagInfo eq 'HASH') { |
7915
|
482658
|
|
|
|
|
801226
|
return ($tagInfo); |
7916
|
|
|
|
|
|
|
} elsif (ref $tagInfo eq 'ARRAY') { |
7917
|
10897
|
|
|
|
|
34151
|
return @$tagInfo; |
7918
|
|
|
|
|
|
|
} elsif ($tagInfo) { |
7919
|
|
|
|
|
|
|
# create hash with name |
7920
|
28518
|
|
|
|
|
52042
|
$tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo }; |
7921
|
28518
|
|
|
|
|
46551
|
return ($tagInfo); |
7922
|
|
|
|
|
|
|
} |
7923
|
4440
|
|
|
|
|
6749
|
return (); |
7924
|
|
|
|
|
|
|
} |
7925
|
|
|
|
|
|
|
|
7926
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7927
|
|
|
|
|
|
|
# Find tag information, processing conditional tags |
7928
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID |
7929
|
|
|
|
|
|
|
# 3) optional value reference, 4) optional format type, 5) optional value count |
7930
|
|
|
|
|
|
|
# Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed |
7931
|
|
|
|
|
|
|
# Notes: You should always call this routine to find a tag in a table because |
7932
|
|
|
|
|
|
|
# this routine will evaluate conditional tags. |
7933
|
|
|
|
|
|
|
# Arguments 3-5 are only required if the information type allows $valPt, $format and/or |
7934
|
|
|
|
|
|
|
# $count in a Condition, and if not given when needed this routine returns ''. |
7935
|
|
|
|
|
|
|
sub GetTagInfo($$$;$$$) |
7936
|
|
|
|
|
|
|
{ |
7937
|
106161
|
|
|
106161
|
0
|
160926
|
my ($self, $tagTablePtr, $tagID) = @_; |
7938
|
106161
|
|
|
|
|
123152
|
my ($valPt, $format, $count); |
7939
|
|
|
|
|
|
|
|
7940
|
106161
|
|
|
|
|
160596
|
my @infoArray = GetTagInfoList($tagTablePtr, $tagID); |
7941
|
|
|
|
|
|
|
# evaluate condition |
7942
|
106161
|
|
|
|
|
119819
|
my $tagInfo; |
7943
|
106161
|
|
|
|
|
146160
|
foreach $tagInfo (@infoArray) { |
7944
|
110516
|
|
|
|
|
174621
|
my $condition = $$tagInfo{Condition}; |
7945
|
110516
|
100
|
|
|
|
170991
|
if ($condition) { |
7946
|
12594
|
100
|
|
|
|
24138
|
($valPt, $format, $count) = splice(@_, 3) if @_ > 3; |
7947
|
12594
|
100
|
100
|
|
|
57781
|
return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt; |
7948
|
|
|
|
|
|
|
# set old value for use in condition if needed |
7949
|
11932
|
|
|
|
|
42783
|
local $SIG{'__WARN__'} = \&SetWarning; |
7950
|
11932
|
|
|
|
|
18141
|
undef $evalWarning; |
7951
|
|
|
|
|
|
|
#### eval Condition ($self, [$valPt, $format, $count]) |
7952
|
11932
|
100
|
|
|
|
723778
|
unless (eval $condition) { |
7953
|
9521
|
50
|
|
|
|
19200
|
$@ and $evalWarning = $@; |
7954
|
9521
|
50
|
|
|
|
14922
|
$self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning; |
7955
|
9521
|
|
|
|
|
35062
|
next; |
7956
|
|
|
|
|
|
|
} |
7957
|
|
|
|
|
|
|
} |
7958
|
100333
|
100
|
100
|
|
|
199364
|
if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
7959
|
|
|
|
|
|
|
not $$self{OPTIONS}{Verbose} and not $$self{OPTIONS}{Validate} and |
7960
|
|
|
|
|
|
|
not $$self{HTML_DUMP}) |
7961
|
|
|
|
|
|
|
{ |
7962
|
|
|
|
|
|
|
# don't return Unknown tags unless that option is set |
7963
|
2061
|
|
|
|
|
4508
|
return undef; |
7964
|
|
|
|
|
|
|
} |
7965
|
|
|
|
|
|
|
# return the tag information we found |
7966
|
98272
|
|
|
|
|
187323
|
return $tagInfo; |
7967
|
|
|
|
|
|
|
} |
7968
|
|
|
|
|
|
|
# generate information for unknown tags (numerical only) if required |
7969
|
5166
|
100
|
100
|
|
|
28403
|
if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
7970
|
|
|
|
|
|
|
$tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN}) |
7971
|
|
|
|
|
|
|
{ |
7972
|
600
|
|
|
|
|
883
|
my $printConv; |
7973
|
600
|
100
|
|
|
|
1055
|
if (defined $$tagTablePtr{PRINT_CONV}) { |
7974
|
155
|
|
|
|
|
263
|
$printConv = $$tagTablePtr{PRINT_CONV}; |
7975
|
|
|
|
|
|
|
} else { |
7976
|
|
|
|
|
|
|
# limit length of printout (can be very long) |
7977
|
445
|
|
|
|
|
613
|
$printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val'; |
7978
|
|
|
|
|
|
|
} |
7979
|
600
|
|
|
|
|
1737
|
my $hex = sprintf("0x%.4x", $tagID); |
7980
|
600
|
|
|
|
|
978
|
my $prefix = $$tagTablePtr{TAG_PREFIX}; |
7981
|
600
|
|
|
|
|
1492
|
$tagInfo = { |
7982
|
|
|
|
|
|
|
Name => "${prefix}_$hex", |
7983
|
|
|
|
|
|
|
Description => MakeDescription($prefix, $hex), |
7984
|
|
|
|
|
|
|
Unknown => 1, |
7985
|
|
|
|
|
|
|
Writable => 0, # can't write unknown tags |
7986
|
|
|
|
|
|
|
PrintConv => $printConv, |
7987
|
|
|
|
|
|
|
}; |
7988
|
|
|
|
|
|
|
# add tag information to table |
7989
|
600
|
|
|
|
|
1326
|
AddTagToTable($tagTablePtr, $tagID, $tagInfo); |
7990
|
|
|
|
|
|
|
} else { |
7991
|
4566
|
|
|
|
|
5878
|
undef $tagInfo; |
7992
|
|
|
|
|
|
|
} |
7993
|
5166
|
|
|
|
|
9980
|
return $tagInfo; |
7994
|
|
|
|
|
|
|
} |
7995
|
|
|
|
|
|
|
|
7996
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7997
|
|
|
|
|
|
|
# Add new tag to table (must use this routine to add new tags to a table) |
7998
|
|
|
|
|
|
|
# Inputs: 0) reference to tag table, 1) tag ID |
7999
|
|
|
|
|
|
|
# 2) [optional] tag name or reference to tag information hash |
8000
|
|
|
|
|
|
|
# 3) [optional] flag to avoid adding prefix when generating tag name |
8001
|
|
|
|
|
|
|
# Returns: tagInfo ref |
8002
|
|
|
|
|
|
|
# Notes: - will not override existing entry in table |
8003
|
|
|
|
|
|
|
# - info need contain no entries when this routine is called |
8004
|
|
|
|
|
|
|
# - tag name is cleaned if necessary |
8005
|
|
|
|
|
|
|
sub AddTagToTable($$;$$) |
8006
|
|
|
|
|
|
|
{ |
8007
|
6033
|
|
|
6033
|
0
|
9972
|
my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_; |
8008
|
|
|
|
|
|
|
|
8009
|
|
|
|
|
|
|
# generate tag info hash if necessary |
8010
|
6033
|
0
|
|
|
|
10812
|
$tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH'; |
|
|
50
|
|
|
|
|
|
8011
|
|
|
|
|
|
|
|
8012
|
|
|
|
|
|
|
# define necessary entries in information hash |
8013
|
6033
|
100
|
|
|
|
9573
|
if ($$tagInfo{Groups}) { |
8014
|
|
|
|
|
|
|
# fill in default groups from table GROUPS |
8015
|
432
|
|
|
|
|
571
|
foreach (keys %{$$tagTablePtr{GROUPS}}) { |
|
432
|
|
|
|
|
1188
|
|
8016
|
1296
|
100
|
|
|
|
2324
|
next if $$tagInfo{Groups}{$_}; |
8017
|
558
|
|
|
|
|
1047
|
$$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_}; |
8018
|
|
|
|
|
|
|
} |
8019
|
|
|
|
|
|
|
} else { |
8020
|
5601
|
|
|
|
|
6363
|
$$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} }; |
|
5601
|
|
|
|
|
21207
|
|
8021
|
|
|
|
|
|
|
} |
8022
|
6033
|
100
|
|
|
|
11991
|
$$tagInfo{Flags} and ExpandFlags($tagInfo); |
8023
|
|
|
|
|
|
|
$$tagInfo{GotGroups} = 1, |
8024
|
6033
|
|
|
|
|
10837
|
$$tagInfo{Table} = $tagTablePtr; |
8025
|
6033
|
|
|
|
|
9541
|
$$tagInfo{TagID} = $tagID; |
8026
|
6033
|
100
|
100
|
|
|
13918
|
if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) { |
8027
|
1442
|
|
|
|
|
2382
|
$$tagInfo{Avoid} = $$tagTablePtr{AVOID}; |
8028
|
|
|
|
|
|
|
} |
8029
|
|
|
|
|
|
|
|
8030
|
6033
|
|
|
|
|
7394
|
my $name = $$tagInfo{Name}; |
8031
|
6033
|
100
|
|
|
|
9276
|
$name = $tagID unless defined $name; |
8032
|
6033
|
|
|
|
|
10688
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
8033
|
6033
|
|
|
|
|
8792
|
$name = ucfirst $name; # capitalize first letter |
8034
|
|
|
|
|
|
|
# add tag-name prefix if specified and tag name not provided |
8035
|
6033
|
100
|
100
|
|
|
11630
|
unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) { |
|
|
|
66
|
|
|
|
|
8036
|
|
|
|
|
|
|
# make description to prevent tagID from getting mangled by MakeDescription() |
8037
|
22
|
|
|
|
|
49
|
$$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name); |
8038
|
22
|
|
|
|
|
48
|
$name = "$$tagTablePtr{TAG_PREFIX}_$name"; |
8039
|
|
|
|
|
|
|
} |
8040
|
|
|
|
|
|
|
# tag names must be at least 2 characters long and prefer them to start with a letter |
8041
|
6033
|
100
|
100
|
|
|
23271
|
$name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i; |
8042
|
6033
|
|
|
|
|
9002
|
$$tagInfo{Name} = $name; |
8043
|
|
|
|
|
|
|
# add tag to table, but never override existing entries (could potentially happen |
8044
|
|
|
|
|
|
|
# if someone thinks there isn't any tagInfo because a condition wasn't satisfied) |
8045
|
6033
|
50
|
66
|
|
|
17661
|
unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) { |
8046
|
5950
|
|
|
|
|
13492
|
$$tagTablePtr{$tagID} = $tagInfo; |
8047
|
|
|
|
|
|
|
} |
8048
|
6033
|
|
|
|
|
11280
|
return $tagInfo; |
8049
|
|
|
|
|
|
|
} |
8050
|
|
|
|
|
|
|
|
8051
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8052
|
|
|
|
|
|
|
# Handle simple extraction of new tag information |
8053
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value, |
8054
|
|
|
|
|
|
|
# 4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent, |
8055
|
|
|
|
|
|
|
# TagInfo, ProcessProc, RAF, Format, Count |
8056
|
|
|
|
|
|
|
# Returns: tag key or undef if tag not found |
8057
|
|
|
|
|
|
|
# Notes: if value is not defined, it is extracted from DataPt using TagInfo |
8058
|
|
|
|
|
|
|
# Format and Count if provided |
8059
|
|
|
|
|
|
|
sub HandleTag($$$$;%) |
8060
|
|
|
|
|
|
|
{ |
8061
|
9343
|
|
|
9343
|
0
|
29863
|
my ($self, $tagTablePtr, $tag, $val, %parms) = @_; |
8062
|
9343
|
|
|
|
|
15065
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8063
|
9343
|
|
|
|
|
11536
|
my $pfmt = $parms{Format}; |
8064
|
9343
|
|
100
|
|
|
27845
|
my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count}); |
8065
|
9343
|
|
|
|
|
15289
|
my $dataPt = $parms{DataPt}; |
8066
|
9343
|
|
|
|
|
12676
|
my ($subdir, $format, $noTagInfo, $rational); |
8067
|
|
|
|
|
|
|
|
8068
|
9343
|
100
|
|
|
|
13819
|
if ($tagInfo) { |
8069
|
7236
|
|
|
|
|
10474
|
$subdir = $$tagInfo{SubDirectory}; |
8070
|
|
|
|
|
|
|
} else { |
8071
|
2107
|
50
|
|
|
|
6049
|
return undef unless $verbose; |
8072
|
0
|
|
|
|
|
0
|
$tagInfo = { Name => "tag $tag" }; # create temporary tagInfo hash |
8073
|
0
|
|
|
|
|
0
|
$noTagInfo = 1; |
8074
|
|
|
|
|
|
|
} |
8075
|
|
|
|
|
|
|
# read value if not done already (not necessary for subdir) |
8076
|
7236
|
50
|
66
|
|
|
16030
|
unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) { |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8077
|
873
|
|
100
|
|
|
1861
|
my $start = $parms{Start} || 0; |
8078
|
873
|
50
|
|
|
|
1652
|
my $dLen = $dataPt ? length($$dataPt) : -1; |
8079
|
873
|
|
|
|
|
1192
|
my $size = $parms{Size}; |
8080
|
873
|
100
|
|
|
|
1560
|
$size = $dLen unless defined $size; |
8081
|
|
|
|
|
|
|
# read from data in memory if possible |
8082
|
873
|
50
|
33
|
|
|
2480
|
if ($start >= 0 and $start + $size <= $dLen) { |
8083
|
873
|
|
100
|
|
|
2307
|
$format = $$tagInfo{Format} || $$tagTablePtr{FORMAT}; |
8084
|
873
|
50
|
100
|
|
|
3350
|
$format = $pfmt if not $format and $pfmt and $formatSize{$pfmt}; |
|
|
|
66
|
|
|
|
|
8085
|
873
|
100
|
|
|
|
1607
|
if ($format) { |
8086
|
421
|
|
|
|
|
1238
|
$val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational); |
8087
|
|
|
|
|
|
|
} else { |
8088
|
452
|
|
|
|
|
1033
|
$val = substr($$dataPt, $start, $size); |
8089
|
|
|
|
|
|
|
} |
8090
|
|
|
|
|
|
|
} else { |
8091
|
0
|
|
|
|
|
0
|
$self->Warn("Error extracting value for $$tagInfo{Name}"); |
8092
|
0
|
|
|
|
|
0
|
return undef; |
8093
|
|
|
|
|
|
|
} |
8094
|
|
|
|
|
|
|
} |
8095
|
|
|
|
|
|
|
# do verbose print if necessary |
8096
|
7236
|
100
|
|
|
|
12137
|
if ($verbose) { |
8097
|
51
|
50
|
|
|
|
86
|
undef $tagInfo if $noTagInfo; |
8098
|
51
|
|
|
|
|
74
|
$parms{Value} = $val; |
8099
|
51
|
50
|
|
|
|
80
|
$parms{Value} .= " ($rational)" if defined $rational; |
8100
|
51
|
|
|
|
|
67
|
$parms{Table} = $tagTablePtr; |
8101
|
51
|
50
|
|
|
|
78
|
if ($format) { |
8102
|
0
|
|
0
|
|
|
0
|
my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1)); |
|
|
|
0
|
|
|
|
|
8103
|
0
|
|
|
|
|
0
|
$parms{Format} = $format . "[$count]"; |
8104
|
|
|
|
|
|
|
} |
8105
|
51
|
|
|
|
|
169
|
$self->VerboseInfo($tag, $tagInfo, %parms); |
8106
|
|
|
|
|
|
|
} |
8107
|
7236
|
50
|
|
|
|
11806
|
if ($tagInfo) { |
8108
|
7236
|
100
|
|
|
|
11735
|
if ($subdir) { |
8109
|
729
|
|
|
|
|
1177
|
my $subdirStart = $parms{Start}; |
8110
|
729
|
|
|
|
|
1119
|
my $subdirLen = $parms{Size}; |
8111
|
729
|
100
|
66
|
|
|
2105
|
if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) { |
8112
|
1
|
|
|
|
|
2
|
my $conv = $$tagInfo{RawConv}; |
8113
|
1
|
|
|
|
|
5
|
local $SIG{'__WARN__'} = \&SetWarning; |
8114
|
1
|
|
|
|
|
2
|
undef $evalWarning; |
8115
|
1
|
50
|
|
|
|
4
|
if (ref $conv eq 'CODE') { |
8116
|
0
|
|
|
|
|
0
|
$val = &$conv($val, $self); |
8117
|
|
|
|
|
|
|
} else { |
8118
|
1
|
|
|
|
|
1
|
my ($priority, @grps); |
8119
|
|
|
|
|
|
|
# NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm |
8120
|
|
|
|
|
|
|
#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) |
8121
|
1
|
|
|
|
|
69
|
$val = eval $conv; |
8122
|
1
|
50
|
|
|
|
4
|
$@ and $evalWarning = $@; |
8123
|
|
|
|
|
|
|
} |
8124
|
1
|
50
|
|
|
|
3
|
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; |
8125
|
1
|
50
|
|
|
|
3
|
return undef unless defined $val; |
8126
|
1
|
50
|
|
|
|
4
|
$val = $$val if ref $val eq 'SCALAR'; |
8127
|
1
|
|
|
|
|
2
|
$dataPt = \$val; |
8128
|
1
|
|
|
|
|
2
|
$subdirStart = 0; |
8129
|
1
|
|
|
|
|
3
|
$subdirLen = length $val; |
8130
|
|
|
|
|
|
|
} |
8131
|
729
|
100
|
|
|
|
1589
|
if ($$subdir{Start}) { |
8132
|
8
|
|
|
|
|
17
|
my $valuePtr = 0; |
8133
|
|
|
|
|
|
|
#### eval Start ($valuePtr) |
8134
|
8
|
|
|
|
|
329
|
my $off = eval $$subdir{Start}; |
8135
|
8
|
|
|
|
|
24
|
$subdirStart += $off; |
8136
|
8
|
|
|
|
|
18
|
$subdirLen -= $off; |
8137
|
|
|
|
|
|
|
} |
8138
|
729
|
100
|
|
|
|
1433
|
$dataPt or $dataPt = \$val; |
8139
|
|
|
|
|
|
|
# process subdirectory information |
8140
|
|
|
|
|
|
|
my %dirInfo = ( |
8141
|
|
|
|
|
|
|
DirName => $$subdir{DirName} || $$tagInfo{Name}, |
8142
|
|
|
|
|
|
|
DataPt => $dataPt, |
8143
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
8144
|
|
|
|
|
|
|
DataPos => $parms{DataPos}, |
8145
|
|
|
|
|
|
|
DirStart => $subdirStart, |
8146
|
|
|
|
|
|
|
DirLen => $subdirLen, |
8147
|
|
|
|
|
|
|
Parent => $parms{Parent}, |
8148
|
|
|
|
|
|
|
Base => $parms{Base}, |
8149
|
|
|
|
|
|
|
Multi => $$subdir{Multi}, |
8150
|
|
|
|
|
|
|
TagInfo => $tagInfo, |
8151
|
|
|
|
|
|
|
RAF => $parms{RAF}, |
8152
|
729
|
|
66
|
|
|
5628
|
); |
8153
|
729
|
|
|
|
|
1678
|
my $oldOrder = GetByteOrder(); |
8154
|
729
|
100
|
|
|
|
1634
|
if ($$subdir{ByteOrder}) { |
8155
|
3
|
100
|
|
|
|
11
|
if ($$subdir{ByteOrder} eq 'Unknown') { |
8156
|
1
|
50
|
|
|
|
4
|
if ($subdirStart + 2 <= $subdirLen) { |
8157
|
|
|
|
|
|
|
# attempt to determine the byte ordering of an IFD-style subdirectory |
8158
|
1
|
|
|
|
|
4
|
my $num = Get16u($dataPt, $subdirStart); |
8159
|
1
|
50
|
33
|
|
|
9
|
ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff); |
8160
|
|
|
|
|
|
|
} |
8161
|
|
|
|
|
|
|
} else { |
8162
|
2
|
|
|
|
|
6
|
SetByteOrder($$subdir{ByteOrder}); |
8163
|
|
|
|
|
|
|
} |
8164
|
|
|
|
|
|
|
} |
8165
|
729
|
|
33
|
|
|
1740
|
my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr; |
8166
|
729
|
|
100
|
|
|
3874
|
$self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc}); |
8167
|
729
|
|
|
|
|
1703
|
SetByteOrder($oldOrder); |
8168
|
|
|
|
|
|
|
# return now unless directory is writable as a block |
8169
|
729
|
50
|
|
|
|
4655
|
return undef unless $$tagInfo{Writable}; |
8170
|
|
|
|
|
|
|
} |
8171
|
6507
|
|
|
|
|
12104
|
my $key = $self->FoundTag($tagInfo, $val); |
8172
|
|
|
|
|
|
|
# save original components of rational numbers |
8173
|
6507
|
100
|
66
|
|
|
13985
|
$$self{RATIONAL}{$key} = $rational if defined $rational and defined $key; |
8174
|
6507
|
|
|
|
|
17734
|
return $key; |
8175
|
|
|
|
|
|
|
} |
8176
|
0
|
|
|
|
|
0
|
return undef; |
8177
|
|
|
|
|
|
|
} |
8178
|
|
|
|
|
|
|
|
8179
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8180
|
|
|
|
|
|
|
# Add tag to hash of extracted information |
8181
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8182
|
|
|
|
|
|
|
# 1) reference to tagInfo hash or tag name |
8183
|
|
|
|
|
|
|
# 2) data value (or reference to require hash if Composite) |
8184
|
|
|
|
|
|
|
# 3) optional family 0 group, 4) optional family 1 group |
8185
|
|
|
|
|
|
|
# Returns: tag key or undef if no value |
8186
|
|
|
|
|
|
|
sub FoundTag($$$;@) |
8187
|
|
|
|
|
|
|
{ |
8188
|
58021
|
|
|
58021
|
0
|
74492
|
local $_; |
8189
|
58021
|
|
|
|
|
92060
|
my ($self, $tagInfo, $value, @grps) = @_; |
8190
|
58021
|
|
|
|
|
69098
|
my ($tag, $noListDel); |
8191
|
58021
|
|
|
|
|
81453
|
my $options = $$self{OPTIONS}; |
8192
|
|
|
|
|
|
|
|
8193
|
58021
|
100
|
|
|
|
99181
|
if (ref $tagInfo eq 'HASH') { |
8194
|
50765
|
50
|
|
|
|
108972
|
$tag = $$tagInfo{Name} or warn("No tag name\n"), return undef; |
8195
|
|
|
|
|
|
|
} else { |
8196
|
7256
|
|
|
|
|
8850
|
$tag = $tagInfo; |
8197
|
|
|
|
|
|
|
# look for tag in Extra |
8198
|
7256
|
|
|
|
|
12112
|
$tagInfo = $self->GetTagInfo(GetTagTable('Image::ExifTool::Extra'), $tag); |
8199
|
|
|
|
|
|
|
# make temporary hash if tag doesn't exist in Extra |
8200
|
|
|
|
|
|
|
# (not advised to do this since the tag won't show in list) |
8201
|
7256
|
100
|
|
|
|
12874
|
$tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool }; |
8202
|
7256
|
100
|
|
|
|
13290
|
$$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value); |
8203
|
|
|
|
|
|
|
} |
8204
|
|
|
|
|
|
|
# get tag priority |
8205
|
58021
|
|
|
|
|
73340
|
my $priority = $$tagInfo{Priority}; |
8206
|
58021
|
100
|
|
|
|
93476
|
unless (defined $priority) { |
8207
|
53687
|
|
|
|
|
79357
|
$priority = $$tagInfo{Table}{PRIORITY}; |
8208
|
53687
|
100
|
100
|
|
|
151443
|
$priority = 0 if not defined $priority and $$tagInfo{Avoid}; |
8209
|
|
|
|
|
|
|
} |
8210
|
58021
|
100
|
|
|
|
106247
|
$grps[0] or $grps[0] = $$self{SET_GROUP0}; |
8211
|
58021
|
100
|
|
|
|
96366
|
$grps[1] or $grps[1] = $$self{SET_GROUP1}; |
8212
|
58021
|
|
|
|
|
74478
|
my $valueHash = $$self{VALUE}; |
8213
|
|
|
|
|
|
|
|
8214
|
58021
|
100
|
|
|
|
91768
|
if ($$tagInfo{RawConv}) { |
8215
|
|
|
|
|
|
|
# initialize @val for use in Composite RawConv expressions |
8216
|
8944
|
|
|
|
|
11123
|
my @val; |
8217
|
8944
|
50
|
66
|
|
|
19868
|
if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) { |
8218
|
1729
|
|
|
|
|
3876
|
foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; } |
|
5810
|
|
|
|
|
11915
|
|
8219
|
|
|
|
|
|
|
} |
8220
|
8944
|
|
|
|
|
13610
|
my $conv = $$tagInfo{RawConv}; |
8221
|
8944
|
|
|
|
|
36611
|
local $SIG{'__WARN__'} = \&SetWarning; |
8222
|
8944
|
|
|
|
|
14552
|
undef $evalWarning; |
8223
|
8944
|
100
|
|
|
|
15807
|
if (ref $conv eq 'CODE') { |
8224
|
217
|
|
|
|
|
832
|
$value = &$conv($value, $self); |
8225
|
217
|
50
|
|
|
|
893
|
$$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps}; |
|
0
|
|
|
|
|
0
|
|
8226
|
|
|
|
|
|
|
} else { |
8227
|
8727
|
|
|
|
|
11855
|
my $val = $value; # do this so eval can use $val |
8228
|
|
|
|
|
|
|
# NOTE: RawConv is also evaluated in Writer.pl |
8229
|
|
|
|
|
|
|
#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) |
8230
|
8727
|
|
|
|
|
655474
|
$value = eval $conv; |
8231
|
8727
|
50
|
|
|
|
32371
|
$@ and $evalWarning = $@; |
8232
|
|
|
|
|
|
|
} |
8233
|
8944
|
50
|
|
|
|
17227
|
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; |
8234
|
8944
|
100
|
|
|
|
32451
|
return undef unless defined $value; |
8235
|
|
|
|
|
|
|
} |
8236
|
|
|
|
|
|
|
# handle duplicate tag names |
8237
|
55511
|
100
|
|
|
|
120019
|
if (defined $$valueHash{$tag}) { |
|
|
100
|
|
|
|
|
|
8238
|
|
|
|
|
|
|
# add to list if there is an active list for this tag |
8239
|
6588
|
100
|
|
|
|
15667
|
if ($$self{LIST_TAGS}{$tagInfo}) { |
8240
|
642
|
|
|
|
|
1198
|
$tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag |
8241
|
642
|
100
|
|
|
|
1318
|
if (defined $$self{NO_LIST}) { |
8242
|
|
|
|
|
|
|
# accumulate list in TAG_EXTRA "NoList" element |
8243
|
65
|
100
|
|
|
|
178
|
if (defined $$self{TAG_EXTRA}{$tag}{NoList}) { |
8244
|
31
|
|
|
|
|
66
|
push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value; |
|
31
|
|
|
|
|
112
|
|
8245
|
|
|
|
|
|
|
} else { |
8246
|
34
|
|
|
|
|
122
|
$$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ]; |
8247
|
|
|
|
|
|
|
} |
8248
|
65
|
|
|
|
|
120
|
$noListDel = 1; # set flag to delete this tag if re-listed |
8249
|
|
|
|
|
|
|
} else { |
8250
|
577
|
100
|
|
|
|
1385
|
if (ref $$valueHash{$tag} ne 'ARRAY') { |
8251
|
298
|
|
|
|
|
828
|
$$valueHash{$tag} = [ $$valueHash{$tag} ]; |
8252
|
|
|
|
|
|
|
} |
8253
|
577
|
|
|
|
|
773
|
push @{$$valueHash{$tag}}, $value; |
|
577
|
|
|
|
|
1518
|
|
8254
|
577
|
|
|
|
|
1741
|
return $tag; # return without creating a new entry |
8255
|
|
|
|
|
|
|
} |
8256
|
|
|
|
|
|
|
} |
8257
|
|
|
|
|
|
|
# get next available tag key |
8258
|
6011
|
|
100
|
|
|
22315
|
my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1; |
8259
|
6011
|
|
|
|
|
13130
|
my $nextTag = "$tag ($nextInd)"; |
8260
|
|
|
|
|
|
|
# |
8261
|
|
|
|
|
|
|
# take tag with highest priority |
8262
|
|
|
|
|
|
|
# |
8263
|
|
|
|
|
|
|
# promote existing 0-priority tag so it takes precedence over a new 0-tag |
8264
|
|
|
|
|
|
|
# (unless old tag was a sub-document and new tag isn't. Also, never override |
8265
|
|
|
|
|
|
|
# a Warning tag because they may be added by ValueConv, which could be confusing) |
8266
|
6011
|
|
|
|
|
9837
|
my $oldPriority = $$self{PRIORITY}{$tag}; |
8267
|
6011
|
100
|
|
|
|
10265
|
unless ($oldPriority) { |
8268
|
5103
|
100
|
100
|
|
|
25067
|
if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8269
|
|
|
|
|
|
|
not $$self{TAG_EXTRA}{$tag}{G3}) |
8270
|
|
|
|
|
|
|
{ |
8271
|
5068
|
|
|
|
|
7094
|
$oldPriority = 1; |
8272
|
|
|
|
|
|
|
} else { |
8273
|
35
|
|
|
|
|
57
|
$oldPriority = 0; # don't promote sub-document tag over main document |
8274
|
|
|
|
|
|
|
} |
8275
|
|
|
|
|
|
|
} |
8276
|
|
|
|
|
|
|
# set priority for this tag |
8277
|
6011
|
100
|
100
|
|
|
22726
|
if (defined $priority) { |
|
|
100
|
33
|
|
|
|
|
8278
|
|
|
|
|
|
|
# increase 0-priority tags if this is the priority directory |
8279
|
|
|
|
|
|
|
$priority = 1 if not $priority and $$self{DIR_NAME} and |
8280
|
1978
|
100
|
100
|
|
|
9274
|
$$self{DIR_NAME} eq $$self{PRIORITY_DIR}; |
|
|
|
100
|
|
|
|
|
8281
|
|
|
|
|
|
|
} elsif ($$self{LOW_PRIORITY_DIR}{'*'} or |
8282
|
|
|
|
|
|
|
($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}})) |
8283
|
|
|
|
|
|
|
{ |
8284
|
411
|
|
|
|
|
555
|
$priority = 0; # default is 0 for a LOW_PRIORITY_DIR |
8285
|
|
|
|
|
|
|
} else { |
8286
|
3622
|
|
|
|
|
4632
|
$priority = 1; # the normal default |
8287
|
|
|
|
|
|
|
} |
8288
|
6011
|
100
|
100
|
|
|
23825
|
if ($priority >= $oldPriority and (not $$self{DOC_NUM} or |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8289
|
|
|
|
|
|
|
($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and |
8290
|
|
|
|
|
|
|
$$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel) |
8291
|
|
|
|
|
|
|
{ |
8292
|
|
|
|
|
|
|
# move existing tag out of the way since this tag is higher priority |
8293
|
|
|
|
|
|
|
# (NOTE: any new members added here must also be added to DeleteTag()) |
8294
|
2728
|
|
|
|
|
7100
|
$$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag}; |
8295
|
2728
|
|
|
|
|
5856
|
$$valueHash{$nextTag} = $$valueHash{$tag}; |
8296
|
2728
|
|
|
|
|
5219
|
$$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag}; |
8297
|
2728
|
|
|
|
|
5820
|
my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag}; |
8298
|
2728
|
|
|
|
|
4691
|
foreach ('TAG_EXTRA','RATIONAL') { |
8299
|
5456
|
100
|
|
|
|
11787
|
if ($$self{$_}{$tag}) { |
8300
|
1880
|
|
|
|
|
3740
|
$$self{$_}{$nextTag} = $$self{$_}{$tag}; |
8301
|
1880
|
|
|
|
|
3697
|
delete $$self{$_}{$tag}; |
8302
|
|
|
|
|
|
|
} |
8303
|
|
|
|
|
|
|
} |
8304
|
2728
|
|
|
|
|
4066
|
delete $$self{BOTH}{$tag}; |
8305
|
|
|
|
|
|
|
# update tag key for list if necessary |
8306
|
2728
|
100
|
|
|
|
5838
|
$$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo}; |
8307
|
|
|
|
|
|
|
# update this key if used in a Composite tag |
8308
|
2728
|
100
|
|
|
|
6461
|
if ($$self{COMP_KEYS}{$tag}) { |
8309
|
86
|
|
|
|
|
128
|
$$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}}; |
|
86
|
|
|
|
|
367
|
|
8310
|
86
|
|
|
|
|
225
|
$$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag}; |
8311
|
86
|
|
|
|
|
178
|
delete $$self{COMP_KEYS}{$tag}; |
8312
|
|
|
|
|
|
|
} |
8313
|
|
|
|
|
|
|
} else { |
8314
|
3283
|
|
|
|
|
4647
|
$tag = $nextTag; # don't override the existing tag |
8315
|
|
|
|
|
|
|
} |
8316
|
6011
|
|
|
|
|
12382
|
$$self{PRIORITY}{$tag} = $priority; |
8317
|
6011
|
100
|
|
|
|
11454
|
$$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel; |
8318
|
|
|
|
|
|
|
} elsif ($priority) { |
8319
|
|
|
|
|
|
|
# set tag priority (only if exists and is non-zero) |
8320
|
209
|
|
|
|
|
637
|
$$self{PRIORITY}{$tag} = $priority; |
8321
|
|
|
|
|
|
|
} |
8322
|
|
|
|
|
|
|
|
8323
|
|
|
|
|
|
|
# save the raw value, file order, tagInfo ref, group1 name, |
8324
|
|
|
|
|
|
|
# and tag key for lists if necessary |
8325
|
54934
|
|
|
|
|
118614
|
$$valueHash{$tag} = $value; |
8326
|
54934
|
|
|
|
|
101046
|
$$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND}; |
8327
|
54934
|
|
|
|
|
88529
|
$$self{TAG_INFO}{$tag} = $tagInfo; |
8328
|
|
|
|
|
|
|
# set dynamic groups 0, 1 and 3 if necessary |
8329
|
54934
|
100
|
|
|
|
83958
|
$$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0]; |
8330
|
54934
|
100
|
|
|
|
89550
|
$$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1]; |
8331
|
54934
|
100
|
|
|
|
89185
|
if ($$self{DOC_NUM}) { |
8332
|
1749
|
|
|
|
|
3888
|
$$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM}; |
8333
|
1749
|
50
|
|
|
|
5746
|
if ($$self{DOC_NUM} =~ /^(\d+)/) { |
8334
|
|
|
|
|
|
|
# keep track of maximum 1st-level sub-document number |
8335
|
1749
|
100
|
|
|
|
4597
|
$$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1; |
8336
|
|
|
|
|
|
|
} |
8337
|
|
|
|
|
|
|
} |
8338
|
|
|
|
|
|
|
# save path if requested |
8339
|
54934
|
100
|
|
|
|
90889
|
$$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath}; |
8340
|
|
|
|
|
|
|
|
8341
|
|
|
|
|
|
|
# remember this tagInfo if we will be accumulating values in a list |
8342
|
|
|
|
|
|
|
# (but don't override earlier list if this may be deleted by NoListDel flag) |
8343
|
54934
|
100
|
100
|
|
|
101056
|
if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) { |
|
|
|
100
|
|
|
|
|
8344
|
1106
|
|
|
|
|
3355
|
$$self{LIST_TAGS}{$tagInfo} = $tag; |
8345
|
|
|
|
|
|
|
} |
8346
|
|
|
|
|
|
|
|
8347
|
|
|
|
|
|
|
# validate tag if requested (but only for simple values -- could result |
8348
|
|
|
|
|
|
|
# in infinite recursion if called for a Composite tag (HASH ref value) |
8349
|
|
|
|
|
|
|
# because FoundTag is called in the middle of building Composite tags |
8350
|
54934
|
100
|
100
|
|
|
95727
|
if ($$options{Validate} and not ref $value) { |
8351
|
213
|
|
|
|
|
526
|
Image::ExifTool::Validate::ValidateRaw($self, $tag, $value); |
8352
|
|
|
|
|
|
|
} |
8353
|
|
|
|
|
|
|
|
8354
|
54934
|
|
|
|
|
120615
|
return $tag; |
8355
|
|
|
|
|
|
|
} |
8356
|
|
|
|
|
|
|
|
8357
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8358
|
|
|
|
|
|
|
# Make current directory the priority directory if not set already |
8359
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8360
|
|
|
|
|
|
|
sub SetPriorityDir($) |
8361
|
|
|
|
|
|
|
{ |
8362
|
22
|
|
|
22
|
0
|
55
|
my $self = shift; |
8363
|
22
|
50
|
|
|
|
424
|
$$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR}; |
8364
|
|
|
|
|
|
|
} |
8365
|
|
|
|
|
|
|
|
8366
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8367
|
|
|
|
|
|
|
# Set family 0 or 1 group name specific to this tag instance |
8368
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag key, 2) group name, 3) family (default 1) |
8369
|
|
|
|
|
|
|
sub SetGroup($$$;$) |
8370
|
|
|
|
|
|
|
{ |
8371
|
13200
|
|
|
13200
|
0
|
23182
|
my ($self, $tagKey, $extra, $fam) = @_; |
8372
|
13200
|
50
|
|
|
|
46151
|
$$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra; |
8373
|
|
|
|
|
|
|
} |
8374
|
|
|
|
|
|
|
|
8375
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8376
|
|
|
|
|
|
|
# Delete specified tag |
8377
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag key |
8378
|
|
|
|
|
|
|
sub DeleteTag($$) |
8379
|
|
|
|
|
|
|
{ |
8380
|
224
|
|
|
224
|
0
|
356
|
my ($self, $tag) = @_; |
8381
|
224
|
|
|
|
|
352
|
delete $$self{VALUE}{$tag}; |
8382
|
224
|
|
|
|
|
293
|
delete $$self{FILE_ORDER}{$tag}; |
8383
|
224
|
|
|
|
|
315
|
delete $$self{TAG_INFO}{$tag}; |
8384
|
224
|
|
|
|
|
381
|
delete $$self{TAG_EXTRA}{$tag}; |
8385
|
224
|
|
|
|
|
292
|
delete $$self{PRIORITY}{$tag}; |
8386
|
224
|
|
|
|
|
285
|
delete $$self{RATIONAL}{$tag}; |
8387
|
224
|
|
|
|
|
620
|
delete $$self{BOTH}{$tag}; |
8388
|
|
|
|
|
|
|
} |
8389
|
|
|
|
|
|
|
|
8390
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8391
|
|
|
|
|
|
|
# Escape all elements of a value |
8392
|
|
|
|
|
|
|
# Inputs: 0) value, 1) escape proc |
8393
|
|
|
|
|
|
|
sub DoEscape($$) |
8394
|
|
|
|
|
|
|
{ |
8395
|
173
|
|
|
173
|
0
|
208
|
my ($val, $key); |
8396
|
173
|
100
|
|
|
|
259
|
if (not ref $_[0]) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
8397
|
167
|
|
|
|
|
203
|
$_[0] = &{$_[1]}($_[0]); |
|
167
|
|
|
|
|
312
|
|
8398
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'ARRAY') { |
8399
|
4
|
|
|
|
|
7
|
foreach $val (@{$_[0]}) { |
|
4
|
|
|
|
|
11
|
|
8400
|
10
|
|
|
|
|
24
|
DoEscape($val, $_[1]); |
8401
|
|
|
|
|
|
|
} |
8402
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'HASH') { |
8403
|
0
|
|
|
|
|
0
|
foreach $key (keys %{$_[0]}) { |
|
0
|
|
|
|
|
0
|
|
8404
|
0
|
|
|
|
|
0
|
DoEscape($_[0]{$key}, $_[1]); |
8405
|
|
|
|
|
|
|
} |
8406
|
|
|
|
|
|
|
} |
8407
|
|
|
|
|
|
|
} |
8408
|
|
|
|
|
|
|
|
8409
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8410
|
|
|
|
|
|
|
# Set the FileType and MIMEType tags |
8411
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8412
|
|
|
|
|
|
|
# 1) Optional file type (uses FILE_TYPE if not specified) |
8413
|
|
|
|
|
|
|
# 2) Optional MIME type (uses our lookup if not specified) |
8414
|
|
|
|
|
|
|
# 3) Optional recommended extension (converted to lower case; uses FileType if undef) |
8415
|
|
|
|
|
|
|
# Notes: Will NOT set file type twice (subsequent calls ignored) |
8416
|
|
|
|
|
|
|
sub SetFileType($;$$$) |
8417
|
|
|
|
|
|
|
{ |
8418
|
634
|
|
|
634
|
0
|
1824
|
my ($self, $fileType, $mimeType, $normExt) = @_; |
8419
|
634
|
100
|
66
|
|
|
2993
|
unless ($$self{VALUE}{FileType} and not $$self{DOC_NUM}) { |
8420
|
586
|
|
|
|
|
1261
|
my $baseType = $$self{FILE_TYPE}; |
8421
|
586
|
|
|
|
|
1176
|
my $ext = $$self{FILE_EXT}; |
8422
|
586
|
100
|
|
|
|
1630
|
$fileType or $fileType = $baseType; |
8423
|
|
|
|
|
|
|
# handle sub-types which are identified by extension |
8424
|
586
|
100
|
100
|
|
|
4436
|
if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) { |
|
|
|
66
|
|
|
|
|
8425
|
257
|
|
|
|
|
907
|
my ($f,$e) = @fileTypeLookup{$fileType,$ext}; |
8426
|
257
|
100
|
100
|
|
|
1639
|
if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) { |
|
|
|
100
|
|
|
|
|
8427
|
|
|
|
|
|
|
# make sure $fileType was a root type and not another sub-type |
8428
|
10
|
100
|
66
|
|
|
68
|
$fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]}; |
8429
|
|
|
|
|
|
|
} |
8430
|
|
|
|
|
|
|
} |
8431
|
586
|
100
|
|
|
|
2289
|
$mimeType or $mimeType = $mimeType{$fileType}; |
8432
|
|
|
|
|
|
|
# use base file type if necessary (except if 'TIFF', which is a special case) |
8433
|
586
|
100
|
66
|
|
|
1871
|
$mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF'; |
8434
|
586
|
100
|
|
|
|
1585
|
unless (defined $normExt) { |
8435
|
576
|
|
|
|
|
1412
|
$normExt = $fileTypeExt{$fileType}; |
8436
|
576
|
100
|
|
|
|
1474
|
$normExt = $fileType unless defined $normExt; |
8437
|
|
|
|
|
|
|
} |
8438
|
586
|
|
|
|
|
1303
|
$$self{FileType} = $fileType; |
8439
|
586
|
|
|
|
|
1894
|
$self->FoundTag('FileType', $fileType); |
8440
|
586
|
|
|
|
|
3022
|
$self->FoundTag('FileTypeExtension', uc $normExt); |
8441
|
586
|
|
100
|
|
|
2470
|
$self->FoundTag('MIMEType', $mimeType || 'application/unknown'); |
8442
|
|
|
|
|
|
|
} |
8443
|
|
|
|
|
|
|
} |
8444
|
|
|
|
|
|
|
|
8445
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8446
|
|
|
|
|
|
|
# Override the FileType and MIMEType tags |
8447
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension |
8448
|
|
|
|
|
|
|
# Notes: does nothing if FileType was not previously defined (ie. when writing) |
8449
|
|
|
|
|
|
|
sub OverrideFileType($$;$$) |
8450
|
|
|
|
|
|
|
{ |
8451
|
14
|
|
|
14
|
0
|
50
|
my ($self, $fileType, $mimeType, $normExt) = @_; |
8452
|
14
|
100
|
66
|
|
|
100
|
if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) { |
8453
|
8
|
|
|
|
|
21
|
$$self{FileType} = $fileType; |
8454
|
8
|
|
|
|
|
14
|
$$self{VALUE}{FileType} = $fileType; |
8455
|
8
|
100
|
|
|
|
24
|
unless (defined $normExt) { |
8456
|
5
|
|
|
|
|
13
|
$normExt = $fileTypeExt{$fileType}; |
8457
|
5
|
50
|
|
|
|
18
|
$normExt = $fileType unless defined $normExt; |
8458
|
|
|
|
|
|
|
} |
8459
|
8
|
|
|
|
|
21
|
$$self{VALUE}{FileTypeExtension} = uc $normExt; |
8460
|
8
|
50
|
|
|
|
32
|
$mimeType or $mimeType = $mimeType{$fileType}; |
8461
|
8
|
100
|
|
|
|
23
|
$$self{VALUE}{MIMEType} = $mimeType if $mimeType; |
8462
|
8
|
50
|
|
|
|
90
|
if ($$self{OPTIONS}{Verbose}) { |
8463
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n"); |
8464
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n"); |
8465
|
0
|
0
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType; |
8466
|
|
|
|
|
|
|
} |
8467
|
|
|
|
|
|
|
} |
8468
|
|
|
|
|
|
|
} |
8469
|
|
|
|
|
|
|
|
8470
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8471
|
|
|
|
|
|
|
# Modify the value of the MIMEType tag |
8472
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) file or MIME type |
8473
|
|
|
|
|
|
|
# Notes: combines existing type with new type: ie) a/b + c/d => c/b-d |
8474
|
|
|
|
|
|
|
sub ModifyMimeType($;$) |
8475
|
|
|
|
|
|
|
{ |
8476
|
8
|
|
|
8
|
0
|
31
|
my ($self, $mime) = @_; |
8477
|
8
|
50
|
33
|
|
|
49
|
$mime =~ m{/} or $mime = $mimeType{$mime} or return; |
8478
|
8
|
|
|
|
|
29
|
my $old = $$self{VALUE}{MIMEType}; |
8479
|
8
|
50
|
|
|
|
34
|
if (defined $old) { |
8480
|
8
|
|
|
|
|
47
|
my ($a, $b) = split '/', $old; |
8481
|
8
|
|
|
|
|
34
|
my ($c, $d) = split '/', $mime; |
8482
|
8
|
|
|
|
|
23
|
$d =~ s/^x-//; |
8483
|
8
|
|
|
|
|
33
|
$$self{VALUE}{MIMEType} = "$c/$b-$d"; |
8484
|
8
|
|
|
|
|
65
|
$self->VPrint(0, " Modified MIMEType = $c/$b-$d\n"); |
8485
|
|
|
|
|
|
|
} else { |
8486
|
0
|
|
|
|
|
0
|
$self->FoundTag('MIMEType', $mime); |
8487
|
|
|
|
|
|
|
} |
8488
|
|
|
|
|
|
|
} |
8489
|
|
|
|
|
|
|
|
8490
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8491
|
|
|
|
|
|
|
# Print verbose output |
8492
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args |
8493
|
|
|
|
|
|
|
sub VPrint($$@) |
8494
|
|
|
|
|
|
|
{ |
8495
|
9115
|
|
|
9115
|
0
|
13266
|
my $self = shift; |
8496
|
9115
|
|
|
|
|
10806
|
my $level = shift; |
8497
|
9115
|
100
|
66
|
|
|
26443
|
if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) { |
8498
|
4
|
|
|
|
|
9
|
my $out = $$self{OPTIONS}{TextOut}; |
8499
|
4
|
|
|
|
|
19
|
print $out @_; |
8500
|
4
|
50
|
|
|
|
22
|
print $out "\n" unless $_[-1] =~ /\n$/; |
8501
|
|
|
|
|
|
|
} |
8502
|
|
|
|
|
|
|
} |
8503
|
|
|
|
|
|
|
|
8504
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8505
|
|
|
|
|
|
|
# Print verbose directory information |
8506
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref |
8507
|
|
|
|
|
|
|
# 2) number of entries in directory (or 0 if unknown) |
8508
|
|
|
|
|
|
|
# 3) optional size of directory in bytes |
8509
|
|
|
|
|
|
|
sub VerboseDir($$;$$) |
8510
|
|
|
|
|
|
|
{ |
8511
|
449
|
|
|
449
|
0
|
987
|
my ($self, $name, $entries, $size) = @_; |
8512
|
449
|
100
|
|
|
|
1309
|
return unless $$self{OPTIONS}{Verbose}; |
8513
|
44
|
50
|
|
|
|
92
|
if (ref $name eq 'HASH') { |
8514
|
0
|
0
|
|
|
|
0
|
$size = $$name{DirLen} unless $size; |
8515
|
0
|
|
0
|
|
|
0
|
$name = $$name{Name} || $$name{DirName}; |
8516
|
|
|
|
|
|
|
} |
8517
|
44
|
|
|
|
|
102
|
my $indent = substr($$self{INDENT}, 0, -2); |
8518
|
44
|
|
|
|
|
71
|
my $out = $$self{OPTIONS}{TextOut}; |
8519
|
44
|
100
|
66
|
|
|
177
|
my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : ''; |
8520
|
44
|
100
|
|
|
|
103
|
$str .= ", $size bytes" if $size; |
8521
|
44
|
|
|
|
|
152
|
print $out "$indent+ [$name directory$str]\n"; |
8522
|
|
|
|
|
|
|
} |
8523
|
|
|
|
|
|
|
|
8524
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8525
|
|
|
|
|
|
|
# Verbose dump |
8526
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options |
8527
|
|
|
|
|
|
|
sub VerboseDump($$;%) |
8528
|
|
|
|
|
|
|
{ |
8529
|
128
|
|
|
128
|
0
|
188
|
my $self = shift; |
8530
|
128
|
|
|
|
|
153
|
my $dataPt = shift; |
8531
|
128
|
|
|
|
|
195
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8532
|
128
|
50
|
33
|
|
|
394
|
if ($verbose and $verbose > 2) { |
8533
|
|
|
|
|
|
|
my %parms = ( |
8534
|
|
|
|
|
|
|
Prefix => $$self{INDENT}, |
8535
|
|
|
|
|
|
|
Out => $$self{OPTIONS}{TextOut}, |
8536
|
0
|
0
|
|
|
|
0
|
MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef, |
|
|
0
|
|
|
|
|
|
8537
|
|
|
|
|
|
|
); |
8538
|
0
|
|
|
|
|
0
|
HexDump($dataPt, undef, %parms, @_); |
8539
|
|
|
|
|
|
|
} |
8540
|
|
|
|
|
|
|
} |
8541
|
|
|
|
|
|
|
|
8542
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8543
|
|
|
|
|
|
|
# Print data in hex |
8544
|
|
|
|
|
|
|
# Inputs: 0) data |
8545
|
|
|
|
|
|
|
# Returns: hex string |
8546
|
|
|
|
|
|
|
# (this is a convenience function for use in debugging PrintConv statements) |
8547
|
|
|
|
|
|
|
sub PrintHex($) |
8548
|
|
|
|
|
|
|
{ |
8549
|
0
|
|
|
0
|
0
|
0
|
my $val = shift; |
8550
|
0
|
|
|
|
|
0
|
return join(' ', unpack('H2' x length($val), $val)); |
8551
|
|
|
|
|
|
|
} |
8552
|
|
|
|
|
|
|
|
8553
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8554
|
|
|
|
|
|
|
# Extract binary data from file |
8555
|
|
|
|
|
|
|
# 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional |
8556
|
|
|
|
|
|
|
# Returns: binary data, or undef on error |
8557
|
|
|
|
|
|
|
# Notes: Returns "Binary data #### bytes" instead of data unless tag is |
8558
|
|
|
|
|
|
|
# specifically requested or the Binary option is set |
8559
|
|
|
|
|
|
|
sub ExtractBinary($$$;$) |
8560
|
|
|
|
|
|
|
{ |
8561
|
47
|
|
|
47
|
0
|
142
|
my ($self, $offset, $length, $tag) = @_; |
8562
|
47
|
|
|
|
|
84
|
my ($isPreview, $buff); |
8563
|
|
|
|
|
|
|
|
8564
|
47
|
100
|
|
|
|
123
|
if ($tag) { |
8565
|
43
|
100
|
|
|
|
121
|
if ($tag eq 'PreviewImage') { |
8566
|
|
|
|
|
|
|
# save PreviewImage start/length in case we want to dump trailer |
8567
|
29
|
|
|
|
|
89
|
$$self{PreviewImageStart} = $offset; |
8568
|
29
|
|
|
|
|
67
|
$$self{PreviewImageLength} = $length; |
8569
|
29
|
|
|
|
|
67
|
$isPreview = 1; |
8570
|
|
|
|
|
|
|
} |
8571
|
43
|
|
|
|
|
108
|
my $lcTag = lc $tag; |
8572
|
43
|
50
|
66
|
|
|
416
|
if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
8573
|
|
|
|
|
|
|
not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag}) |
8574
|
|
|
|
|
|
|
{ |
8575
|
34
|
|
|
|
|
159
|
return "Binary data $length bytes"; |
8576
|
|
|
|
|
|
|
} |
8577
|
|
|
|
|
|
|
} |
8578
|
13
|
100
|
66
|
|
|
83
|
unless ($$self{RAF}->Seek($offset,0) |
8579
|
|
|
|
|
|
|
and $$self{RAF}->Read($buff, $length) == $length) |
8580
|
|
|
|
|
|
|
{ |
8581
|
5
|
50
|
|
|
|
17
|
$tag or $tag = 'binary data'; |
8582
|
5
|
50
|
33
|
|
|
37
|
if ($isPreview and not $$self{BuildingComposite}) { |
8583
|
0
|
|
|
|
|
0
|
$$self{PreviewError} = 1; |
8584
|
|
|
|
|
|
|
} else { |
8585
|
5
|
|
|
|
|
26
|
$self->Warn("Error reading $tag from file", $isPreview); |
8586
|
|
|
|
|
|
|
} |
8587
|
5
|
|
|
|
|
21
|
return undef; |
8588
|
|
|
|
|
|
|
} |
8589
|
8
|
|
|
|
|
30
|
return $buff; |
8590
|
|
|
|
|
|
|
} |
8591
|
|
|
|
|
|
|
|
8592
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8593
|
|
|
|
|
|
|
# Process binary data |
8594
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref |
8595
|
|
|
|
|
|
|
# Returns: 1 on success |
8596
|
|
|
|
|
|
|
# Notes: dirInfo may contain VarFormatData (reference to empty list) to return |
8597
|
|
|
|
|
|
|
# details about any variable-length-format tags in the table (used when writing) |
8598
|
|
|
|
|
|
|
sub ProcessBinaryData($$$) |
8599
|
|
|
|
|
|
|
{ |
8600
|
2055
|
|
|
2055
|
0
|
3860
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
8601
|
2055
|
|
|
|
|
3444
|
my $dataPt = $$dirInfo{DataPt}; |
8602
|
2055
|
|
100
|
|
|
5127
|
my $offset = $$dirInfo{DirStart} || 0; |
8603
|
2055
|
|
66
|
|
|
4385
|
my $size = $$dirInfo{DirLen} || (length($$dataPt) - $offset); |
8604
|
2055
|
|
100
|
|
|
5099
|
my $base = $$dirInfo{Base} || 0; |
8605
|
2055
|
|
|
|
|
3785
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8606
|
2055
|
|
|
|
|
3210
|
my $unknown = $$self{OPTIONS}{Unknown}; |
8607
|
2055
|
|
100
|
|
|
5175
|
my $dataPos = $$dirInfo{DataPos} || 0; |
8608
|
|
|
|
|
|
|
|
8609
|
|
|
|
|
|
|
# get default format ('int8u' unless specified) |
8610
|
2055
|
|
100
|
|
|
6655
|
my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u'; |
8611
|
2055
|
|
|
|
|
3689
|
my $increment = $formatSize{$defaultFormat}; |
8612
|
2055
|
50
|
|
|
|
4033
|
unless ($increment) { |
8613
|
0
|
|
|
|
|
0
|
warn "Unknown format $defaultFormat\n"; |
8614
|
0
|
|
|
|
|
0
|
$defaultFormat = 'int8u'; |
8615
|
0
|
|
|
|
|
0
|
$increment = $formatSize{$defaultFormat}; |
8616
|
|
|
|
|
|
|
} |
8617
|
|
|
|
|
|
|
# prepare list of tag numbers to extract |
8618
|
2055
|
|
|
|
|
3379
|
my (@tags, $topIndex); |
8619
|
2055
|
50
|
33
|
|
|
7752
|
if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8620
|
|
|
|
|
|
|
# don't create a stupid number of tags if data is huge |
8621
|
0
|
0
|
|
|
|
0
|
my $sizeLimit = $size < 65536 ? $size : 65536; |
8622
|
|
|
|
|
|
|
# scan through entire binary table |
8623
|
0
|
|
|
|
|
0
|
$topIndex = int($sizeLimit/$increment); |
8624
|
0
|
|
|
|
|
0
|
@tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1)); |
8625
|
|
|
|
|
|
|
# add in floating point tag ID's if they exist |
8626
|
0
|
|
|
|
|
0
|
my @ftags = grep /\./, TagTableKeys($tagTablePtr); |
8627
|
0
|
0
|
|
|
|
0
|
@tags = sort { $a <=> $b } @tags, @ftags if @ftags; |
|
0
|
|
|
|
|
0
|
|
8628
|
|
|
|
|
|
|
} elsif ($$dirInfo{DataMember}) { |
8629
|
189
|
|
|
|
|
289
|
@tags = @{$$dirInfo{DataMember}}; |
|
189
|
|
|
|
|
527
|
|
8630
|
189
|
|
|
|
|
371
|
$verbose = 0; # no verbose output of extracted values when writing |
8631
|
|
|
|
|
|
|
} elsif ($$dirInfo{MixedTags}) { |
8632
|
|
|
|
|
|
|
# process sorted integer-ID tags only |
8633
|
38
|
|
|
|
|
105
|
@tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr); |
|
407
|
|
|
|
|
595
|
|
8634
|
|
|
|
|
|
|
} else { |
8635
|
|
|
|
|
|
|
# extract known tags in numerical order |
8636
|
1828
|
50
|
|
|
|
4074
|
@tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr); |
|
54108
|
50
|
|
|
|
85237
|
|
8637
|
|
|
|
|
|
|
} |
8638
|
2055
|
100
|
|
|
|
5789
|
$self->VerboseDir('BinaryData', undef, $size) if $verbose; |
8639
|
|
|
|
|
|
|
# avoid creating unknown tags for tags that fail condition if Unknown is 1 |
8640
|
2055
|
50
|
|
|
|
5685
|
$$self{NO_UNKNOWN} = 1 if $unknown < 2; |
8641
|
2055
|
|
|
|
|
2939
|
my ($index, %val); |
8642
|
2055
|
|
|
|
|
2732
|
my $nextIndex = 0; |
8643
|
2055
|
|
|
|
|
2733
|
my $varSize = 0; |
8644
|
2055
|
|
|
|
|
3334
|
foreach $index (@tags) { |
8645
|
17157
|
|
|
|
|
23092
|
my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational); |
8646
|
17157
|
50
|
0
|
|
|
31740
|
if ($$tagTablePtr{$index}) { |
|
|
0
|
|
|
|
|
|
8647
|
17157
|
|
|
|
|
30927
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index); |
8648
|
17157
|
100
|
|
|
|
29251
|
unless ($tagInfo) { |
8649
|
687
|
100
|
|
|
|
1454
|
next unless defined $tagInfo; |
8650
|
44
|
|
|
|
|
102
|
my $entry = int($index) * $increment + $varSize; |
8651
|
44
|
50
|
|
|
|
156
|
if ($entry < 0) { |
8652
|
0
|
|
|
|
|
0
|
$entry += $size; |
8653
|
0
|
0
|
|
|
|
0
|
next if $entry < 0; |
8654
|
|
|
|
|
|
|
} |
8655
|
44
|
100
|
|
|
|
165
|
next if $entry >= $size; |
8656
|
4
|
|
|
|
|
10
|
my $more = $size - $entry; |
8657
|
4
|
50
|
|
|
|
13
|
$more = 128 if $more > 128; |
8658
|
4
|
|
|
|
|
14
|
my $v = substr($$dataPt, $entry+$offset, $more); |
8659
|
4
|
|
|
|
|
11
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index, \$v); |
8660
|
4
|
50
|
|
|
|
16
|
next unless $tagInfo; |
8661
|
|
|
|
|
|
|
} |
8662
|
|
|
|
|
|
|
next if $$tagInfo{Unknown} and |
8663
|
16474
|
100
|
66
|
|
|
29417
|
($$tagInfo{Unknown} > $unknown or $index < $nextIndex); |
|
|
|
66
|
|
|
|
|
8664
|
|
|
|
|
|
|
} elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) { |
8665
|
0
|
0
|
|
|
|
0
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next; |
8666
|
|
|
|
|
|
|
} else { |
8667
|
|
|
|
|
|
|
# don't generate unknown tags in binary tables unless Unknown > 1 |
8668
|
0
|
0
|
|
|
|
0
|
next unless $unknown > 1; |
8669
|
0
|
0
|
|
|
|
0
|
next if $index < $nextIndex; # skip if data already used |
8670
|
0
|
0
|
|
|
|
0
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next; |
8671
|
0
|
|
|
|
|
0
|
$$tagInfo{Unknown} = 2; # set unknown to 2 for binary unknowns |
8672
|
|
|
|
|
|
|
} |
8673
|
|
|
|
|
|
|
# get relative offset of this entry |
8674
|
16473
|
|
|
|
|
24373
|
my $entry = int($index) * $increment + $varSize; |
8675
|
|
|
|
|
|
|
# allow negative indices to represent bytes from end |
8676
|
16473
|
50
|
|
|
|
25711
|
if ($entry < 0) { |
8677
|
0
|
|
|
|
|
0
|
$entry += $size; |
8678
|
0
|
0
|
|
|
|
0
|
next if $entry < 0; |
8679
|
|
|
|
|
|
|
} |
8680
|
16473
|
|
|
|
|
20065
|
my $more = $size - $entry; |
8681
|
16473
|
100
|
|
|
|
25814
|
last if $more <= 0; # all done if we have reached the end of data |
8682
|
16214
|
|
|
|
|
19128
|
my $count = 1; |
8683
|
16214
|
|
|
|
|
23982
|
my $format = $$tagInfo{Format}; |
8684
|
16214
|
100
|
|
|
|
34878
|
if (not $format) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8685
|
9366
|
|
|
|
|
12729
|
$format = $defaultFormat; |
8686
|
|
|
|
|
|
|
} elsif ($format eq 'string') { |
8687
|
|
|
|
|
|
|
# string with no specified count runs to end of block |
8688
|
104
|
|
|
|
|
185
|
$count = $more; |
8689
|
|
|
|
|
|
|
} elsif ($format eq 'pstring') { |
8690
|
0
|
|
|
|
|
0
|
$format = 'string'; |
8691
|
0
|
|
|
|
|
0
|
$count = Get8u($dataPt, ($entry++)+$offset); |
8692
|
0
|
|
|
|
|
0
|
--$more; |
8693
|
|
|
|
|
|
|
} elsif (not $formatSize{$format}) { |
8694
|
3120
|
100
|
|
|
|
13439
|
if ($format =~ /(.*)\[(.*)\]/) { |
|
|
50
|
|
|
|
|
|
8695
|
|
|
|
|
|
|
# handle format count field |
8696
|
2935
|
|
|
|
|
6525
|
$format = $1; |
8697
|
2935
|
|
|
|
|
4538
|
$count = $2; |
8698
|
|
|
|
|
|
|
# evaluate count to allow count to be based on previous values |
8699
|
|
|
|
|
|
|
#### eval Format size (%val, $size, $self) |
8700
|
2935
|
|
|
|
|
106918
|
$count = eval $count; |
8701
|
2935
|
50
|
|
|
|
9576
|
$@ and warn("Format $$tagInfo{Name}: $@"), next; |
8702
|
2935
|
50
|
|
|
|
5921
|
next if $count < 0; |
8703
|
|
|
|
|
|
|
# allow a variable-length value of any format |
8704
|
|
|
|
|
|
|
# (note: the next incremental index points to data immediately after |
8705
|
|
|
|
|
|
|
# this value, regardless of the size of this value, even if it is zero) |
8706
|
2935
|
50
|
|
|
|
6016
|
if ($format =~ s/^var_//) { |
8707
|
0
|
|
0
|
|
|
0
|
$varSize += $count * ($formatSize{$format} || 1) - $increment; |
8708
|
0
|
|
|
|
|
0
|
$wasVar = 1; |
8709
|
|
|
|
|
|
|
# save variable size data if required for writing |
8710
|
0
|
0
|
|
|
|
0
|
if ($$dirInfo{VarFormatData}) { |
8711
|
0
|
|
|
|
|
0
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
0
|
|
|
|
|
0
|
|
8712
|
|
|
|
|
|
|
} |
8713
|
|
|
|
|
|
|
# don't extract value if large and we wanted it just to get |
8714
|
|
|
|
|
|
|
# the variable-format information when writing |
8715
|
0
|
0
|
0
|
|
|
0
|
next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData}; |
8716
|
|
|
|
|
|
|
} |
8717
|
|
|
|
|
|
|
} elsif ($format =~ /^var_/) { |
8718
|
|
|
|
|
|
|
# handle variable-length string formats |
8719
|
185
|
|
|
|
|
400
|
$format = substr($format, 4); |
8720
|
185
|
|
|
|
|
511
|
pos($$dataPt) = $entry + $offset; |
8721
|
185
|
|
|
|
|
356
|
undef $count; |
8722
|
185
|
50
|
100
|
|
|
911
|
if ($format eq 'ustring') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
8723
|
0
|
0
|
|
|
|
0
|
$count = pos($$dataPt) - ($entry+$offset) if $$dataPt =~ /\G(..)*?\0\0/sg; |
8724
|
0
|
|
|
|
|
0
|
$varSize -= 2; # ($count includes base size of 2 bytes) |
8725
|
|
|
|
|
|
|
} elsif ($format eq 'pstring') { |
8726
|
0
|
|
|
|
|
0
|
$count = Get8u($dataPt, ($entry++)+$offset); |
8727
|
0
|
|
|
|
|
0
|
--$more; |
8728
|
|
|
|
|
|
|
} elsif ($format eq 'pstr32' or $format eq 'ustr32') { |
8729
|
170
|
50
|
|
|
|
335
|
last if $more < 4; |
8730
|
170
|
|
|
|
|
356
|
$count = Get32u($dataPt, $entry + $offset); |
8731
|
170
|
100
|
|
|
|
451
|
$count *= 2 if $format eq 'ustr32'; |
8732
|
170
|
|
|
|
|
253
|
$entry += 4; |
8733
|
170
|
|
|
|
|
232
|
$more -= 4; |
8734
|
170
|
|
|
|
|
345
|
$nextIndex += 4 / $increment; # (increment next index for int32u) |
8735
|
|
|
|
|
|
|
} elsif ($format eq 'int16u') { |
8736
|
|
|
|
|
|
|
# int16u size of binary data to follow |
8737
|
10
|
50
|
|
|
|
25
|
last if $more < 2; |
8738
|
10
|
|
|
|
|
23
|
$count = Get16u($dataPt, $entry + $offset) + 2; |
8739
|
10
|
|
|
|
|
15
|
$varSize -= 2; # ($count includes size word) |
8740
|
10
|
|
|
|
|
20
|
$format = 'undef'; |
8741
|
|
|
|
|
|
|
} elsif ($format eq 'ue7') { |
8742
|
3
|
|
|
|
|
14
|
require Image::ExifTool::BPG; |
8743
|
3
|
|
|
|
|
10
|
($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $offset); |
8744
|
3
|
50
|
|
|
|
7
|
last unless defined $val; |
8745
|
3
|
|
|
|
|
4
|
--$varSize; # ($count includes base size of 1 byte) |
8746
|
|
|
|
|
|
|
} elsif ($$dataPt =~ /\0/g) { |
8747
|
2
|
|
|
|
|
5
|
$count = pos($$dataPt) - ($entry+$offset); |
8748
|
2
|
|
|
|
|
2
|
--$varSize; # ($count includes base size of 1 byte) |
8749
|
|
|
|
|
|
|
} |
8750
|
185
|
50
|
33
|
|
|
647
|
$count = $more if not defined $count or $count > $more; |
8751
|
185
|
|
|
|
|
252
|
$varSize += $count; # shift subsequent indices |
8752
|
185
|
100
|
|
|
|
360
|
unless (defined $val) { |
8753
|
182
|
|
|
|
|
395
|
$val = substr($$dataPt, $entry+$offset, $count); |
8754
|
182
|
100
|
66
|
|
|
789
|
$val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32'; |
8755
|
182
|
100
|
|
|
|
491
|
$val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null |
8756
|
|
|
|
|
|
|
} |
8757
|
185
|
|
|
|
|
258
|
$wasVar = 1; |
8758
|
|
|
|
|
|
|
# save variable size data if required for writing |
8759
|
185
|
100
|
|
|
|
420
|
if ($$dirInfo{VarFormatData}) { |
8760
|
5
|
|
|
|
|
8
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
5
|
|
|
|
|
18
|
|
8761
|
|
|
|
|
|
|
} |
8762
|
|
|
|
|
|
|
} |
8763
|
|
|
|
|
|
|
} |
8764
|
|
|
|
|
|
|
# hook to allow format, etc to be set dynamically |
8765
|
16214
|
100
|
|
|
|
27432
|
if (defined $$tagInfo{Hook}) { |
8766
|
540
|
|
|
|
|
725
|
my $oldVarSize = $varSize; |
8767
|
540
|
|
|
|
|
685
|
my $pos = $entry + $offset; |
8768
|
|
|
|
|
|
|
#### eval Hook ($format, $varSize, $size, $dataPt, $pos) |
8769
|
540
|
|
|
|
|
28011
|
eval $$tagInfo{Hook}; |
8770
|
|
|
|
|
|
|
# save variable size data if required for writing (in case changed by Hook) |
8771
|
540
|
100
|
66
|
|
|
2391
|
if ($$dirInfo{VarFormatData}) { |
|
|
50
|
|
|
|
|
|
8772
|
247
|
50
|
|
|
|
481
|
$#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag |
|
0
|
|
|
|
|
0
|
|
8773
|
247
|
|
|
|
|
315
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
247
|
|
|
|
|
845
|
|
8774
|
|
|
|
|
|
|
} elsif ($varSize != $oldVarSize and $verbose > 2) { |
8775
|
0
|
|
|
|
|
0
|
my ($tmp, $sign) = ($varSize, '+'); |
8776
|
0
|
0
|
|
|
|
0
|
$tmp < 0 and $tmp = -$tmp, $sign = '-'; |
8777
|
0
|
|
|
|
|
0
|
$self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index)); |
8778
|
|
|
|
|
|
|
} |
8779
|
|
|
|
|
|
|
} |
8780
|
16214
|
50
|
|
|
|
25524
|
if ($unknown > 1) { |
8781
|
|
|
|
|
|
|
# calculate next valid index for unknown tag |
8782
|
0
|
|
|
|
|
0
|
my $ni = int $index; |
8783
|
0
|
0
|
0
|
|
|
0
|
$ni += (($formatSize{$format} || 1) * $count) / $increment unless $wasVar; |
8784
|
0
|
|
|
|
|
0
|
$saveNextIndex = $nextIndex; |
8785
|
0
|
0
|
|
|
|
0
|
$nextIndex = $ni unless $nextIndex > $ni; |
8786
|
|
|
|
|
|
|
} |
8787
|
|
|
|
|
|
|
# allow large tags to be excluded from extraction |
8788
|
|
|
|
|
|
|
# (provides a work-around for some tight memory situations) |
8789
|
16214
|
50
|
33
|
|
|
29238
|
next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}}; |
8790
|
|
|
|
|
|
|
# read value now if necessary |
8791
|
16214
|
100
|
66
|
|
|
28748
|
unless (defined $val and not $$tagInfo{SubDirectory}) { |
8792
|
16029
|
|
|
|
|
31276
|
$val = ReadValue($dataPt, $entry+$offset, $format, $count, $more, \$rational); |
8793
|
16029
|
50
|
|
|
|
26692
|
next unless defined $val; |
8794
|
16029
|
|
|
|
|
22172
|
$mask = $$tagInfo{Mask}; |
8795
|
16029
|
100
|
|
|
|
25609
|
$val = ($val & $mask) >> $$tagInfo{BitShift} if $mask; |
8796
|
|
|
|
|
|
|
} |
8797
|
16214
|
100
|
66
|
|
|
27356
|
if ($verbose and not $$tagInfo{Hidden}) { |
8798
|
198
|
50
|
33
|
|
|
1589
|
if (not $$tagInfo{SubDirectory} or $$tagInfo{Format}) { |
8799
|
198
|
|
50
|
|
|
385
|
$len = $count * ($formatSize{$format} || 1); |
8800
|
198
|
50
|
|
|
|
326
|
$len = $more if $len > $more; |
8801
|
|
|
|
|
|
|
} else { |
8802
|
0
|
|
|
|
|
0
|
$len = $more; |
8803
|
|
|
|
|
|
|
} |
8804
|
198
|
50
|
|
|
|
704
|
$self->VerboseInfo($index, $tagInfo, |
8805
|
|
|
|
|
|
|
Table => $tagTablePtr, |
8806
|
|
|
|
|
|
|
Value => $val, |
8807
|
|
|
|
|
|
|
DataPt => $dataPt, |
8808
|
|
|
|
|
|
|
Size => $len, |
8809
|
|
|
|
|
|
|
Start => $entry+$offset, |
8810
|
|
|
|
|
|
|
Addr => $entry+$offset+$base+$dataPos, |
8811
|
|
|
|
|
|
|
Format => $format, |
8812
|
|
|
|
|
|
|
Count => $count, |
8813
|
|
|
|
|
|
|
Extra => $mask ? sprintf(', mask 0x%.2x',$mask) : undef, |
8814
|
|
|
|
|
|
|
); |
8815
|
|
|
|
|
|
|
} |
8816
|
|
|
|
|
|
|
# parse nested BinaryData directories |
8817
|
16214
|
100
|
|
|
|
27070
|
if ($$tagInfo{SubDirectory}) { |
8818
|
14
|
|
|
|
|
38
|
my $subdir = $$tagInfo{SubDirectory}; |
8819
|
14
|
|
|
|
|
47
|
my $subTablePtr = GetTagTable($$subdir{TagTable}); |
8820
|
|
|
|
|
|
|
# use specified subdirectory length if given |
8821
|
14
|
100
|
66
|
|
|
124
|
if ($$tagInfo{Format} and $formatSize{$format}) { |
8822
|
12
|
|
|
|
|
30
|
$len = $count * $formatSize{$format}; |
8823
|
12
|
50
|
|
|
|
40
|
$len = $more if $len > $more; |
8824
|
|
|
|
|
|
|
} else { |
8825
|
2
|
|
|
|
|
4
|
$len = $more; # directory size is all of remaining data |
8826
|
2
|
50
|
33
|
|
|
14
|
if ($$subTablePtr{PROCESS_PROC} and |
8827
|
|
|
|
|
|
|
$$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData) |
8828
|
|
|
|
|
|
|
{ |
8829
|
|
|
|
|
|
|
# the rest of the data will be printed in the subdirectory |
8830
|
2
|
|
|
|
|
7
|
$nextIndex = $size / $increment; |
8831
|
|
|
|
|
|
|
} |
8832
|
|
|
|
|
|
|
} |
8833
|
14
|
|
|
|
|
26
|
my $subdirBase = $base; |
8834
|
14
|
50
|
|
|
|
43
|
if (defined $$subdir{Base}) { |
8835
|
|
|
|
|
|
|
#### eval Base ($start,$base) |
8836
|
0
|
|
|
|
|
0
|
my $start = $entry + $offset + $dataPos; |
8837
|
0
|
|
|
|
|
0
|
$subdirBase = eval($$subdir{Base}) + $base; |
8838
|
|
|
|
|
|
|
} |
8839
|
14
|
|
50
|
|
|
72
|
my $start = $$subdir{Start} || 0; |
8840
|
14
|
|
|
|
|
96
|
my %subdirInfo = ( |
8841
|
|
|
|
|
|
|
DataPt => $dataPt, |
8842
|
|
|
|
|
|
|
DataPos => $dataPos, |
8843
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
8844
|
|
|
|
|
|
|
DirStart => $entry + $offset + $start, |
8845
|
|
|
|
|
|
|
DirLen => $len - $start, |
8846
|
|
|
|
|
|
|
Base => $subdirBase, |
8847
|
|
|
|
|
|
|
); |
8848
|
14
|
|
|
|
|
36
|
delete $$self{NO_UNKNOWN}; |
8849
|
14
|
|
|
|
|
117
|
$self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc}); |
8850
|
14
|
50
|
|
|
|
75
|
$$self{NO_UNKNOWN} = 1 if $unknown < 2; |
8851
|
14
|
|
|
|
|
54
|
next; |
8852
|
|
|
|
|
|
|
} |
8853
|
16200
|
100
|
66
|
|
|
28860
|
if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') { |
8854
|
38
|
|
|
|
|
62
|
my $et = $self; |
8855
|
|
|
|
|
|
|
#### eval IsOffset ($val, $et) |
8856
|
38
|
100
|
|
|
|
2165
|
$val += $base + $$self{BASE} if eval $$tagInfo{IsOffset}; |
8857
|
|
|
|
|
|
|
} |
8858
|
16200
|
|
|
|
|
28013
|
$val{$index} = $val; |
8859
|
16200
|
|
|
|
|
17520
|
my $oldBase; |
8860
|
16200
|
50
|
|
|
|
25901
|
if ($$tagInfo{SetBase}) { |
8861
|
0
|
|
|
|
|
0
|
$oldBase = $$self{BASE}; |
8862
|
0
|
|
|
|
|
0
|
$$self{BASE} += $base; |
8863
|
|
|
|
|
|
|
} |
8864
|
16200
|
|
|
|
|
31197
|
my $key = $self->FoundTag($tagInfo,$val); |
8865
|
16200
|
50
|
|
|
|
28096
|
$$self{BASE} = $oldBase if defined $oldBase; |
8866
|
16200
|
100
|
|
|
|
23390
|
if ($key) { |
8867
|
14861
|
100
|
|
|
|
31130
|
$$self{RATIONAL}{$key} = $rational if defined $rational; |
8868
|
|
|
|
|
|
|
} else { |
8869
|
|
|
|
|
|
|
# don't increment nextIndex if we didn't extract a tag |
8870
|
1339
|
50
|
|
|
|
3444
|
$nextIndex = $saveNextIndex if defined $saveNextIndex; |
8871
|
|
|
|
|
|
|
} |
8872
|
|
|
|
|
|
|
} |
8873
|
2055
|
|
|
|
|
4501
|
delete $$self{NO_UNKNOWN}; |
8874
|
2055
|
|
|
|
|
8679
|
return 1; |
8875
|
|
|
|
|
|
|
} |
8876
|
|
|
|
|
|
|
|
8877
|
|
|
|
|
|
|
#.............................................................................. |
8878
|
|
|
|
|
|
|
# Load .ExifTool_config file from user's home directory |
8879
|
|
|
|
|
|
|
# (use of noConfig is now deprecated, use configFile = '' instead) |
8880
|
|
|
|
|
|
|
until ($Image::ExifTool::noConfig) { |
8881
|
|
|
|
|
|
|
my $config = $Image::ExifTool::configFile; |
8882
|
|
|
|
|
|
|
my $file; |
8883
|
|
|
|
|
|
|
if (not defined $config) { |
8884
|
|
|
|
|
|
|
$config = '.ExifTool_config'; |
8885
|
|
|
|
|
|
|
# get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell) |
8886
|
|
|
|
|
|
|
my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} || |
8887
|
|
|
|
|
|
|
($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.'; |
8888
|
|
|
|
|
|
|
# look for the config file in 1) the home directory, 2) the program dir |
8889
|
|
|
|
|
|
|
$file = "$home/$config"; |
8890
|
|
|
|
|
|
|
} else { |
8891
|
|
|
|
|
|
|
length $config or last; # filename of "" disables configuration |
8892
|
|
|
|
|
|
|
$file = $config; |
8893
|
|
|
|
|
|
|
} |
8894
|
|
|
|
|
|
|
# also check executable directory unless path is absolute |
8895
|
|
|
|
|
|
|
$exeDir = ($0 =~ /(.*)[\\\/]/) ? $1 : '.' unless defined $exeDir; |
8896
|
|
|
|
|
|
|
-r $file or $config =~ /^\// or $file = "$exeDir/$config"; |
8897
|
|
|
|
|
|
|
unless (-r $file) { |
8898
|
|
|
|
|
|
|
warn("Config file not found\n") if defined $Image::ExifTool::configFile; |
8899
|
|
|
|
|
|
|
last; |
8900
|
|
|
|
|
|
|
} |
8901
|
|
|
|
|
|
|
unshift @INC, '.'; # look in current directory first |
8902
|
|
|
|
|
|
|
eval { require $file }; # load the config file |
8903
|
|
|
|
|
|
|
shift @INC; |
8904
|
|
|
|
|
|
|
# print warning (minus "Compilation failed" part) |
8905
|
|
|
|
|
|
|
$@ and $_=$@, s/Compilation failed.*//s, warn $_; |
8906
|
|
|
|
|
|
|
last; |
8907
|
|
|
|
|
|
|
} |
8908
|
|
|
|
|
|
|
# read user-defined lenses (may have been defined by script instead of config file) |
8909
|
|
|
|
|
|
|
if (@Image::ExifTool::UserDefined::Lenses) { |
8910
|
|
|
|
|
|
|
foreach (@Image::ExifTool::UserDefined::Lenses) { |
8911
|
|
|
|
|
|
|
$Image::ExifTool::userLens{$_} = 1; |
8912
|
|
|
|
|
|
|
} |
8913
|
|
|
|
|
|
|
} |
8914
|
|
|
|
|
|
|
# add user-defined file types |
8915
|
|
|
|
|
|
|
if (%Image::ExifTool::UserDefined::FileTypes) { |
8916
|
|
|
|
|
|
|
foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) { |
8917
|
|
|
|
|
|
|
my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_}; |
8918
|
|
|
|
|
|
|
my $type = uc $_; |
8919
|
|
|
|
|
|
|
ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next; |
8920
|
|
|
|
|
|
|
my $baseType = $$fileInfo{BaseType}; |
8921
|
|
|
|
|
|
|
if ($baseType) { |
8922
|
|
|
|
|
|
|
if ($$fileInfo{Description}) { |
8923
|
|
|
|
|
|
|
$fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ]; |
8924
|
|
|
|
|
|
|
} else { |
8925
|
|
|
|
|
|
|
$fileTypeLookup{$type} = $baseType; |
8926
|
|
|
|
|
|
|
} |
8927
|
|
|
|
|
|
|
if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) { |
8928
|
|
|
|
|
|
|
# first make sure we are using an actual base type and not a derived type |
8929
|
|
|
|
|
|
|
$baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType}; |
8930
|
|
|
|
|
|
|
# mark this type as not writable |
8931
|
|
|
|
|
|
|
$noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ]; |
8932
|
|
|
|
|
|
|
push @{$noWriteFile{$baseType}}, $type; |
8933
|
|
|
|
|
|
|
} |
8934
|
|
|
|
|
|
|
} else { |
8935
|
|
|
|
|
|
|
$fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ]; |
8936
|
|
|
|
|
|
|
$moduleName{$type} = 0; # not supported |
8937
|
|
|
|
|
|
|
if ($$fileInfo{Magic}) { |
8938
|
|
|
|
|
|
|
$magicNumber{$type} = $$fileInfo{Magic}; |
8939
|
|
|
|
|
|
|
push @fileTypes, $type unless grep /^$type$/, @fileTypes; |
8940
|
|
|
|
|
|
|
} |
8941
|
|
|
|
|
|
|
} |
8942
|
|
|
|
|
|
|
$mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType}; |
8943
|
|
|
|
|
|
|
} |
8944
|
|
|
|
|
|
|
} |
8945
|
|
|
|
|
|
|
|
8946
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8947
|
|
|
|
|
|
|
1; # end |