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-2023, 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
|
106
|
|
|
106
|
|
255747
|
use strict; |
|
106
|
|
|
|
|
1254
|
|
|
106
|
|
|
|
|
4262
|
|
19
|
|
|
|
|
|
|
require 5.004; # require 5.004 for UNIVERSAL::isa (otherwise 5.002 would do) |
20
|
|
|
|
|
|
|
require Exporter; |
21
|
106
|
|
|
106
|
|
51474
|
use File::RandomAccess; |
|
106
|
|
|
|
|
267
|
|
|
106
|
|
|
|
|
6085
|
|
22
|
106
|
|
|
106
|
|
131842
|
use overload; |
|
106
|
|
|
|
|
185327
|
|
|
106
|
|
|
|
|
4294
|
|
23
|
|
|
|
|
|
|
|
24
|
106
|
|
|
|
|
738677
|
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
|
106
|
|
|
106
|
|
9959
|
%static_vars); |
|
106
|
|
|
|
|
254
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$VERSION = '12.60'; |
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
|
|
|
|
|
|
|
sub SetAlternateFile($$$); |
79
|
|
|
|
|
|
|
# non-public routines below |
80
|
|
|
|
|
|
|
sub InsertTagValues($$$;$$$); |
81
|
|
|
|
|
|
|
sub IsWritable($); |
82
|
|
|
|
|
|
|
sub IsSameFile($$$); |
83
|
|
|
|
|
|
|
sub IsRawType($); |
84
|
|
|
|
|
|
|
sub GetNewFileName($$); |
85
|
|
|
|
|
|
|
sub LoadAllTables(); |
86
|
|
|
|
|
|
|
sub GetNewTagInfoList($;$); |
87
|
|
|
|
|
|
|
sub GetNewTagInfoHash($@); |
88
|
|
|
|
|
|
|
sub GetLangInfo($$); |
89
|
|
|
|
|
|
|
sub Get64s($$); |
90
|
|
|
|
|
|
|
sub Get64u($$); |
91
|
|
|
|
|
|
|
sub GetFixed64s($$); |
92
|
|
|
|
|
|
|
sub GetExtended($$); |
93
|
|
|
|
|
|
|
sub Set64u(@); |
94
|
|
|
|
|
|
|
sub Set64s(@); |
95
|
|
|
|
|
|
|
sub DecodeBits($$;$); |
96
|
|
|
|
|
|
|
sub EncodeBits($$;$$); |
97
|
|
|
|
|
|
|
sub Filter($$$); |
98
|
|
|
|
|
|
|
sub HexDump($;$%); |
99
|
|
|
|
|
|
|
sub DumpTrailer($$); |
100
|
|
|
|
|
|
|
sub DumpUnknownTrailer($$); |
101
|
|
|
|
|
|
|
sub VerboseInfo($$$%); |
102
|
|
|
|
|
|
|
sub VerboseValue($$$;$); |
103
|
|
|
|
|
|
|
sub VPrint($$@); |
104
|
|
|
|
|
|
|
sub Rationalize($;$); |
105
|
|
|
|
|
|
|
sub Write($@); |
106
|
|
|
|
|
|
|
sub WriteTrailerBuffer($$$); |
107
|
|
|
|
|
|
|
sub AddNewTrailers($;@); |
108
|
|
|
|
|
|
|
sub Tell($); |
109
|
|
|
|
|
|
|
sub WriteValue($$;$$$$); |
110
|
|
|
|
|
|
|
sub WriteDirectory($$$;$); |
111
|
|
|
|
|
|
|
sub WriteBinaryData($$$); |
112
|
|
|
|
|
|
|
sub CheckBinaryData($$$); |
113
|
|
|
|
|
|
|
sub WriteTIFF($$$); |
114
|
|
|
|
|
|
|
sub PackUTF8(@); |
115
|
|
|
|
|
|
|
sub UnpackUTF8($); |
116
|
|
|
|
|
|
|
sub SetPreferredByteOrder($;$); |
117
|
|
|
|
|
|
|
sub ImageDataMD5($$$;$$); |
118
|
|
|
|
|
|
|
sub CopyBlock($$$); |
119
|
|
|
|
|
|
|
sub CopyFileAttrs($$$); |
120
|
|
|
|
|
|
|
sub TimeNow(;$$); |
121
|
|
|
|
|
|
|
sub InverseDateTime($$;$$); |
122
|
|
|
|
|
|
|
sub NewGUID(); |
123
|
|
|
|
|
|
|
sub MakeTiffHeader($$$$;$$); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
# other subroutine definitions |
126
|
|
|
|
|
|
|
sub SplitFileName($); |
127
|
|
|
|
|
|
|
sub EncodeFileName($$;$); |
128
|
|
|
|
|
|
|
sub Open($*$;$); |
129
|
|
|
|
|
|
|
sub Exists($$); |
130
|
|
|
|
|
|
|
sub IsDirectory($$); |
131
|
|
|
|
|
|
|
sub Rename($$$); |
132
|
|
|
|
|
|
|
sub Unlink($@); |
133
|
|
|
|
|
|
|
sub SetFileTime($$;$$$$); |
134
|
|
|
|
|
|
|
sub DoEscape($$); |
135
|
|
|
|
|
|
|
sub ConvertFileSize($); |
136
|
|
|
|
|
|
|
sub ParseArguments($;@); #(defined in attempt to avoid mod_perl problem) |
137
|
|
|
|
|
|
|
sub ReadValue($$$;$$$); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# list of main tag tables to load in LoadAllTables() (sub-tables are recursed |
140
|
|
|
|
|
|
|
# automatically). Note: They will appear in this order in the documentation |
141
|
|
|
|
|
|
|
# unless tweaked in BuildTagLookup::GetTableOrder(). |
142
|
|
|
|
|
|
|
@loadAllTables = qw( |
143
|
|
|
|
|
|
|
PhotoMechanic Exif GeoTiff CanonRaw KyoceraRaw Lytro MinoltaRaw PanasonicRaw |
144
|
|
|
|
|
|
|
SigmaRaw JPEG GIMP Jpeg2000 GIF BMP BMP::OS2 BMP::Extra BPG BPG::Extensions |
145
|
|
|
|
|
|
|
ICO PICT PNG MNG FLIF DjVu DPX OpenEXR ZISRAW MRC LIF MRC::FEI12 MIFF PCX |
146
|
|
|
|
|
|
|
PGF PSP PhotoCD Radiance Other::PFM PDF PostScript Photoshop::Header |
147
|
|
|
|
|
|
|
Photoshop::Layers Photoshop::ImageData FujiFilm::RAF FujiFilm::IFD |
148
|
|
|
|
|
|
|
Samsung::Trailer Sony::SRF2 Sony::SR2SubIFD Sony::PMP ITC ID3 ID3::Lyrics3 |
149
|
|
|
|
|
|
|
FLAC Ogg Vorbis APE APE::NewHeader APE::OldHeader Audible MPC MPEG::Audio |
150
|
|
|
|
|
|
|
MPEG::Video MPEG::Xing M2TS QuickTime QuickTime::ImageFile QuickTime::Stream |
151
|
|
|
|
|
|
|
QuickTime::Tags360Fly Matroska Matroska::StdTag MOI MXF DV Flash Flash::FLV |
152
|
|
|
|
|
|
|
Real::Media Real::Audio Real::Metafile Red RIFF AIFF ASF WTV DICOM FITS MIE |
153
|
|
|
|
|
|
|
JSON HTML XMP::SVG Palm Palm::MOBI Palm::EXTH Torrent EXE EXE::PEVersion |
154
|
|
|
|
|
|
|
EXE::PEString EXE::MachO EXE::PEF EXE::ELF EXE::AR EXE::CHM LNK Font VCard |
155
|
|
|
|
|
|
|
Text VCard::VCalendar VCard::VNote RSRC Rawzor ZIP ZIP::GZIP ZIP::RAR RTF |
156
|
|
|
|
|
|
|
OOXML iWork ISO FLIR::AFF FLIR::FPF MacOS MacOS::MDItem FlashPix::DocTable |
157
|
|
|
|
|
|
|
); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# alphabetical list of current Lang modules |
160
|
|
|
|
|
|
|
@langs = qw(cs de en en_ca en_gb es fi fr it ja ko nl pl ru sk sv tr zh_cn zh_tw); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
$defaultLang = 'en'; # default language |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# language names |
165
|
|
|
|
|
|
|
%langName = ( |
166
|
|
|
|
|
|
|
cs => 'Czech (Čeština)', |
167
|
|
|
|
|
|
|
de => 'German (Deutsch)', |
168
|
|
|
|
|
|
|
en => 'English', |
169
|
|
|
|
|
|
|
en_ca => 'Canadian English', |
170
|
|
|
|
|
|
|
en_gb => 'British English', |
171
|
|
|
|
|
|
|
es => 'Spanish (Español)', |
172
|
|
|
|
|
|
|
fi => 'Finnish (Suomi)', |
173
|
|
|
|
|
|
|
fr => 'French (Français)', |
174
|
|
|
|
|
|
|
it => 'Italian (Italiano)', |
175
|
|
|
|
|
|
|
ja => 'Japanese (日本語)', |
176
|
|
|
|
|
|
|
ko => 'Korean (한국어)', |
177
|
|
|
|
|
|
|
nl => 'Dutch (Nederlands)', |
178
|
|
|
|
|
|
|
pl => 'Polish (Polski)', |
179
|
|
|
|
|
|
|
ru => 'Russian (Русский)', |
180
|
|
|
|
|
|
|
sk => 'Slovak (Slovenčina)', |
181
|
|
|
|
|
|
|
sv => 'Swedish (Svenska)', |
182
|
|
|
|
|
|
|
'tr'=> 'Turkish (Türkçe)', |
183
|
|
|
|
|
|
|
zh_cn => 'Simplified Chinese (简体中文)', |
184
|
|
|
|
|
|
|
zh_tw => 'Traditional Chinese (繁體中文)', |
185
|
|
|
|
|
|
|
); |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
# recognized file types, in the order we test unknown files |
188
|
|
|
|
|
|
|
# Notes: 1) There is no need to test for like types separately here |
189
|
|
|
|
|
|
|
# 2) Put types with weak file signatures at end of list to avoid false matches |
190
|
|
|
|
|
|
|
# 3) PLIST must be in this list for the binary PLIST format, although it may |
191
|
|
|
|
|
|
|
# cause a file to be checked twice for XML |
192
|
|
|
|
|
|
|
@fileTypes = qw(JPEG EXV CRW DR4 TIFF GIF MRW RAF X3F JP2 PNG MIE MIFF PS PDF |
193
|
|
|
|
|
|
|
PSD XMP BMP BPG PPM RIFF AIFF ASF MOV MPEG Real SWF PSP FLV OGG |
194
|
|
|
|
|
|
|
FLAC APE MPC MKV MXF DV PMP IND PGF ICC ITC FLIR FLIF FPF LFP |
195
|
|
|
|
|
|
|
HTML VRD RTF FITS XCF DSS QTIF FPX PICT ZIP GZIP PLIST RAR BZ2 |
196
|
|
|
|
|
|
|
CZI TAR EXE EXR HDR CHM LNK WMF AVC DEX DPX RAW Font RSRC M2TS |
197
|
|
|
|
|
|
|
MacOS PHP PCX DCX DWF DWG DXF WTV Torrent VCard LRI R3D AA PDB |
198
|
|
|
|
|
|
|
PFM2 MRC LIF JXL MOI ISO ALIAS JSON MP3 DICOM PCD ICO TXT); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# file types that we can write (edit) |
201
|
|
|
|
|
|
|
my @writeTypes = qw(JPEG TIFF GIF CRW MRW ORF RAF RAW PNG MIE PSD XMP PPM EPS |
202
|
|
|
|
|
|
|
X3F PS PDF ICC VRD DR4 JP2 JXL EXIF AI AIT IND MOV EXV FLIF |
203
|
|
|
|
|
|
|
RIFF); |
204
|
|
|
|
|
|
|
my %writeTypes; # lookup for writable file types (hash filled if required) |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
# file extensions that we can't write for various base types |
207
|
|
|
|
|
|
|
%noWriteFile = ( |
208
|
|
|
|
|
|
|
TIFF => [ qw(3FR DCR K25 KDC SRF) ], |
209
|
|
|
|
|
|
|
XMP => [ qw(SVG INX) ], |
210
|
|
|
|
|
|
|
JP2 => [ qw(J2C JPC) ], |
211
|
|
|
|
|
|
|
MOV => [ qw(INSV) ], |
212
|
|
|
|
|
|
|
); |
213
|
|
|
|
|
|
|
# file extensions that we can only write for various base types |
214
|
|
|
|
|
|
|
my %onlyWriteFile = ( RIFF => [ qw(WEBP) ] ); |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# file types that we can create from scratch |
217
|
|
|
|
|
|
|
# - must update CanCreate() documentation if this list is changed! |
218
|
|
|
|
|
|
|
my %createTypes = map { $_ => 1 } qw(XMP ICC MIE VRD DR4 EXIF EXV); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# file type lookup for all recognized file extensions (upper case) |
221
|
|
|
|
|
|
|
# (if extension may be more than one type, the type is a list where |
222
|
|
|
|
|
|
|
# the writable type should come first if it exists) |
223
|
|
|
|
|
|
|
%fileTypeLookup = ( |
224
|
|
|
|
|
|
|
'360' => ['MOV', 'GoPro 360 video'], |
225
|
|
|
|
|
|
|
'3FR' => ['TIFF', 'Hasselblad RAW format'], |
226
|
|
|
|
|
|
|
'3G2' => ['MOV', '3rd Gen. Partnership Project 2 audio/video'], |
227
|
|
|
|
|
|
|
'3GP' => ['MOV', '3rd Gen. Partnership Project audio/video'], |
228
|
|
|
|
|
|
|
'3GP2'=> '3G2', |
229
|
|
|
|
|
|
|
'3GPP'=> '3GP', |
230
|
|
|
|
|
|
|
A => ['EXE', 'Static library'], |
231
|
|
|
|
|
|
|
AA => ['AA', 'Audible Audiobook'], |
232
|
|
|
|
|
|
|
AAE => ['PLIST','Apple edit information'], |
233
|
|
|
|
|
|
|
AAX => ['MOV', 'Audible Enhanced Audiobook'], |
234
|
|
|
|
|
|
|
ACR => ['DICOM','American College of Radiology ACR-NEMA'], |
235
|
|
|
|
|
|
|
ACFM => ['Font', 'Adobe Composite Font Metrics'], |
236
|
|
|
|
|
|
|
AFM => ['Font', 'Adobe Font Metrics'], |
237
|
|
|
|
|
|
|
AMFM => ['Font', 'Adobe Multiple Master Font Metrics'], |
238
|
|
|
|
|
|
|
AI => [['PDF','PS'], 'Adobe Illustrator'], |
239
|
|
|
|
|
|
|
AIF => 'AIFF', |
240
|
|
|
|
|
|
|
AIFC => ['AIFF', 'Audio Interchange File Format Compressed'], |
241
|
|
|
|
|
|
|
AIFF => ['AIFF', 'Audio Interchange File Format'], |
242
|
|
|
|
|
|
|
AIT => 'AI', |
243
|
|
|
|
|
|
|
ALIAS=> ['ALIAS','MacOS file alias'], |
244
|
|
|
|
|
|
|
APE => ['APE', "Monkey's Audio format"], |
245
|
|
|
|
|
|
|
APNG => ['PNG', 'Animated Portable Network Graphics'], |
246
|
|
|
|
|
|
|
ARW => ['TIFF', 'Sony Alpha RAW format'], |
247
|
|
|
|
|
|
|
ARQ => ['TIFF', 'Sony Alpha Pixel-Shift RAW format'], |
248
|
|
|
|
|
|
|
ASF => ['ASF', 'Microsoft Advanced Systems Format'], |
249
|
|
|
|
|
|
|
AVC => ['AVC', 'Advanced Video Connection'], # (extensions are actually _AU,_AD,_IM,_ID) |
250
|
|
|
|
|
|
|
AVI => ['RIFF', 'Audio Video Interleaved'], |
251
|
|
|
|
|
|
|
AVIF => ['MOV', 'AV1 Image File Format'], |
252
|
|
|
|
|
|
|
AZW => 'MOBI', # (see http://wiki.mobileread.com/wiki/AZW) |
253
|
|
|
|
|
|
|
AZW3 => 'MOBI', |
254
|
|
|
|
|
|
|
BMP => ['BMP', 'Windows Bitmap'], |
255
|
|
|
|
|
|
|
BPG => ['BPG', 'Better Portable Graphics'], |
256
|
|
|
|
|
|
|
BTF => ['BTF', 'Big Tagged Image File Format'], #(unofficial) |
257
|
|
|
|
|
|
|
BZ2 => ['BZ2', 'BZIP2 archive'], |
258
|
|
|
|
|
|
|
CHM => ['CHM', 'Microsoft Compiled HTML format'], |
259
|
|
|
|
|
|
|
CIFF => ['CRW', 'Camera Image File Format'], |
260
|
|
|
|
|
|
|
COS => ['COS', 'Capture One Settings'], |
261
|
|
|
|
|
|
|
CR2 => ['TIFF', 'Canon RAW 2 format'], |
262
|
|
|
|
|
|
|
CR3 => ['MOV', 'Canon RAW 3 format'], |
263
|
|
|
|
|
|
|
CRM => ['MOV', 'Canon RAW Movie'], |
264
|
|
|
|
|
|
|
CRW => ['CRW', 'Canon RAW format'], |
265
|
|
|
|
|
|
|
CS1 => ['PSD', 'Sinar CaptureShop 1-Shot RAW'], |
266
|
|
|
|
|
|
|
CSV => ['TXT', 'Comma-Separated Values'], |
267
|
|
|
|
|
|
|
CUR => ['ICO', 'Windows Cursor'], |
268
|
|
|
|
|
|
|
CZI => ['CZI', 'Zeiss Integrated Software RAW'], |
269
|
|
|
|
|
|
|
DC3 => 'DICM', |
270
|
|
|
|
|
|
|
DCM => 'DICM', |
271
|
|
|
|
|
|
|
DCP => ['TIFF', 'DNG Camera Profile'], |
272
|
|
|
|
|
|
|
DCR => ['TIFF', 'Kodak Digital Camera RAW'], |
273
|
|
|
|
|
|
|
DCX => ['DCX', 'Multi-page PC Paintbrush'], |
274
|
|
|
|
|
|
|
DEX => ['DEX', 'Dalvik Executable format'], |
275
|
|
|
|
|
|
|
DFONT=> ['Font', 'Macintosh Data fork Font'], |
276
|
|
|
|
|
|
|
DIB => ['BMP', 'Device Independent Bitmap'], |
277
|
|
|
|
|
|
|
DIC => 'DICM', |
278
|
|
|
|
|
|
|
DICM => ['DICOM','Digital Imaging and Communications in Medicine'], |
279
|
|
|
|
|
|
|
DIR => ['DIR', 'Directory'], |
280
|
|
|
|
|
|
|
DIVX => ['ASF', 'DivX media format'], |
281
|
|
|
|
|
|
|
DJV => 'DJVU', |
282
|
|
|
|
|
|
|
DJVU => ['AIFF', 'DjVu image'], |
283
|
|
|
|
|
|
|
DLL => ['EXE', 'Windows Dynamic Link Library'], |
284
|
|
|
|
|
|
|
DNG => ['TIFF', 'Digital Negative'], |
285
|
|
|
|
|
|
|
DOC => ['FPX', 'Microsoft Word Document'], |
286
|
|
|
|
|
|
|
DOCM => [['ZIP','FPX'], 'Office Open XML Document Macro-enabled'], |
287
|
|
|
|
|
|
|
# Note: I have seen a password-protected DOCX file which was FPX-like, so I assume |
288
|
|
|
|
|
|
|
# that any other MS Office file could be like this too. The only difference is |
289
|
|
|
|
|
|
|
# that the ZIP and FPX formats are checked first, so if this is wrong, no biggie. |
290
|
|
|
|
|
|
|
DOCX => [['ZIP','FPX'], 'Office Open XML Document'], |
291
|
|
|
|
|
|
|
DOT => ['FPX', 'Microsoft Word Template'], |
292
|
|
|
|
|
|
|
DOTM => [['ZIP','FPX'], 'Office Open XML Document Template Macro-enabled'], |
293
|
|
|
|
|
|
|
DOTX => [['ZIP','FPX'], 'Office Open XML Document Template'], |
294
|
|
|
|
|
|
|
DPX => ['DPX', 'Digital Picture Exchange' ], |
295
|
|
|
|
|
|
|
DR4 => ['DR4', 'Canon VRD version 4 Recipe'], |
296
|
|
|
|
|
|
|
DS2 => ['DSS', 'Digital Speech Standard 2'], |
297
|
|
|
|
|
|
|
DSS => ['DSS', 'Digital Speech Standard'], |
298
|
|
|
|
|
|
|
DV => ['DV', 'Digital Video'], |
299
|
|
|
|
|
|
|
DVB => ['MOV', 'Digital Video Broadcasting'], |
300
|
|
|
|
|
|
|
'DVR-MS'=>['ASF', 'Microsoft Digital Video recording'], |
301
|
|
|
|
|
|
|
DWF => ['DWF', 'Autodesk drawing (Design Web Format)'], |
302
|
|
|
|
|
|
|
DWG => ['DWG', 'AutoCAD Drawing'], |
303
|
|
|
|
|
|
|
DYLIB=> ['EXE', 'Mach-O Dynamic Link Library'], |
304
|
|
|
|
|
|
|
DXF => ['DXF', 'AutoCAD Drawing Exchange Format'], |
305
|
|
|
|
|
|
|
EIP => ['ZIP', 'Capture One Enhanced Image Package'], |
306
|
|
|
|
|
|
|
EPS => ['EPS', 'Encapsulated PostScript Format'], |
307
|
|
|
|
|
|
|
EPS2 => 'EPS', |
308
|
|
|
|
|
|
|
EPS3 => 'EPS', |
309
|
|
|
|
|
|
|
EPSF => 'EPS', |
310
|
|
|
|
|
|
|
EPUB => ['ZIP', 'Electronic Publication'], |
311
|
|
|
|
|
|
|
ERF => ['TIFF', 'Epson Raw Format'], |
312
|
|
|
|
|
|
|
EXE => ['EXE', 'Windows executable file'], |
313
|
|
|
|
|
|
|
EXR => ['EXR', 'Open EXR'], |
314
|
|
|
|
|
|
|
EXIF => ['EXIF', 'Exchangable Image File Metadata'], |
315
|
|
|
|
|
|
|
EXV => ['EXV', 'Exiv2 metadata'], |
316
|
|
|
|
|
|
|
F4A => ['MOV', 'Adobe Flash Player 9+ Audio'], |
317
|
|
|
|
|
|
|
F4B => ['MOV', 'Adobe Flash Player 9+ audio Book'], |
318
|
|
|
|
|
|
|
F4P => ['MOV', 'Adobe Flash Player 9+ Protected'], |
319
|
|
|
|
|
|
|
F4V => ['MOV', 'Adobe Flash Player 9+ Video'], |
320
|
|
|
|
|
|
|
FFF => [['TIFF','FLIR'], 'Hasselblad Flexible File Format'], |
321
|
|
|
|
|
|
|
FIT => 'FITS', |
322
|
|
|
|
|
|
|
FITS => ['FITS', 'Flexible Image Transport System'], |
323
|
|
|
|
|
|
|
FLAC => ['FLAC', 'Free Lossless Audio Codec'], |
324
|
|
|
|
|
|
|
FLA => ['FPX', 'Macromedia/Adobe Flash project'], |
325
|
|
|
|
|
|
|
FLIF => ['FLIF', 'Free Lossless Image Format'], |
326
|
|
|
|
|
|
|
FLIR => ['FLIR', 'FLIR File Format'], # (not an actual extension) |
327
|
|
|
|
|
|
|
FLV => ['FLV', 'Flash Video'], |
328
|
|
|
|
|
|
|
FPF => ['FPF', 'FLIR Public image Format'], |
329
|
|
|
|
|
|
|
FPX => ['FPX', 'FlashPix'], |
330
|
|
|
|
|
|
|
GIF => ['GIF', 'Compuserve Graphics Interchange Format'], |
331
|
|
|
|
|
|
|
GPR => ['TIFF', 'General Purpose RAW'], # https://gopro.github.io/gpr/ |
332
|
|
|
|
|
|
|
GZ => 'GZIP', |
333
|
|
|
|
|
|
|
GZIP => ['GZIP', 'GNU ZIP compressed archive'], |
334
|
|
|
|
|
|
|
HDP => ['TIFF', 'Windows HD Photo'], |
335
|
|
|
|
|
|
|
HDR => ['HDR', 'Radiance RGBE High Dynamic Range'], |
336
|
|
|
|
|
|
|
HEIC => ['MOV', 'High Efficiency Image Format still image'], |
337
|
|
|
|
|
|
|
HEIF => ['MOV', 'High Efficiency Image Format'], |
338
|
|
|
|
|
|
|
HIF => 'HEIF', |
339
|
|
|
|
|
|
|
HTM => 'HTML', |
340
|
|
|
|
|
|
|
HTML => ['HTML', 'HyperText Markup Language'], |
341
|
|
|
|
|
|
|
ICAL => 'ICS', |
342
|
|
|
|
|
|
|
ICC => ['ICC', 'International Color Consortium'], |
343
|
|
|
|
|
|
|
ICM => 'ICC', |
344
|
|
|
|
|
|
|
ICO => ['ICO', 'Windows Icon'], |
345
|
|
|
|
|
|
|
ICS => ['VCard','iCalendar Schedule'], |
346
|
|
|
|
|
|
|
IDML => ['ZIP', 'Adobe InDesign Markup Language'], |
347
|
|
|
|
|
|
|
IIQ => ['TIFF', 'Phase One Intelligent Image Quality RAW'], |
348
|
|
|
|
|
|
|
IND => ['IND', 'Adobe InDesign'], |
349
|
|
|
|
|
|
|
INDD => ['IND', 'Adobe InDesign Document'], |
350
|
|
|
|
|
|
|
INDT => ['IND', 'Adobe InDesign Template'], |
351
|
|
|
|
|
|
|
INSV => ['MOV', 'Insta360 Video'], |
352
|
|
|
|
|
|
|
INSP => ['JPEG', 'Insta360 Picture'], |
353
|
|
|
|
|
|
|
INX => ['XMP', 'Adobe InDesign Interchange'], |
354
|
|
|
|
|
|
|
ISO => ['ISO', 'ISO 9660 disk image'], |
355
|
|
|
|
|
|
|
ITC => ['ITC', 'iTunes Cover Flow'], |
356
|
|
|
|
|
|
|
J2C => ['JP2', 'JPEG 2000 codestream'], |
357
|
|
|
|
|
|
|
J2K => 'J2C', |
358
|
|
|
|
|
|
|
JNG => ['PNG', 'JPG Network Graphics'], |
359
|
|
|
|
|
|
|
JP2 => ['JP2', 'JPEG 2000 file'], |
360
|
|
|
|
|
|
|
# JP4? - looks like a JPEG but the image data is different |
361
|
|
|
|
|
|
|
JPC => 'J2C', |
362
|
|
|
|
|
|
|
JPE => 'JPEG', |
363
|
|
|
|
|
|
|
JPEG => ['JPEG', 'Joint Photographic Experts Group'], |
364
|
|
|
|
|
|
|
JPF => 'JP2', |
365
|
|
|
|
|
|
|
JPG => 'JPEG', |
366
|
|
|
|
|
|
|
JPM => ['JP2', 'JPEG 2000 compound image'], |
367
|
|
|
|
|
|
|
JPS => ['JPEG', 'JPEG Stereo image'], |
368
|
|
|
|
|
|
|
JPX => ['JP2', 'JPEG 2000 with extensions'], |
369
|
|
|
|
|
|
|
JSON => ['JSON', 'JavaScript Object Notation'], |
370
|
|
|
|
|
|
|
JXL => ['JXL', 'JPEG XL'], |
371
|
|
|
|
|
|
|
JXR => ['TIFF', 'JPEG XR'], |
372
|
|
|
|
|
|
|
K25 => ['TIFF', 'Kodak DC25 RAW'], |
373
|
|
|
|
|
|
|
KDC => ['TIFF', 'Kodak Digital Camera RAW'], |
374
|
|
|
|
|
|
|
KEY => ['ZIP', 'Apple Keynote presentation'], |
375
|
|
|
|
|
|
|
KTH => ['ZIP', 'Apple Keynote Theme'], |
376
|
|
|
|
|
|
|
LA => ['RIFF', 'Lossless Audio'], |
377
|
|
|
|
|
|
|
LFP => ['LFP', 'Lytro Light Field Picture'], |
378
|
|
|
|
|
|
|
LFR => 'LFP', # (Light Field RAW) |
379
|
|
|
|
|
|
|
LIF => ['LIF', 'Leica Image File'], |
380
|
|
|
|
|
|
|
LNK => ['LNK', 'Windows shortcut'], |
381
|
|
|
|
|
|
|
LRI => ['LRI', 'Light RAW'], |
382
|
|
|
|
|
|
|
LRV => ['MOV', 'Low-Resolution Video'], |
383
|
|
|
|
|
|
|
M2T => 'M2TS', |
384
|
|
|
|
|
|
|
M2TS => ['M2TS', 'MPEG-2 Transport Stream'], |
385
|
|
|
|
|
|
|
M2V => ['MPEG', 'MPEG-2 Video'], |
386
|
|
|
|
|
|
|
M4A => ['MOV', 'MPEG-4 Audio'], |
387
|
|
|
|
|
|
|
M4B => ['MOV', 'MPEG-4 audio Book'], |
388
|
|
|
|
|
|
|
M4P => ['MOV', 'MPEG-4 Protected'], |
389
|
|
|
|
|
|
|
M4V => ['MOV', 'MPEG-4 Video'], |
390
|
|
|
|
|
|
|
MACOS=> ['MacOS','MacOS ._ sidecar file'], |
391
|
|
|
|
|
|
|
MAX => ['FPX', '3D Studio MAX'], |
392
|
|
|
|
|
|
|
MEF => ['TIFF', 'Mamiya (RAW) Electronic Format'], |
393
|
|
|
|
|
|
|
MIE => ['MIE', 'Meta Information Encapsulation format'], |
394
|
|
|
|
|
|
|
MIF => 'MIFF', |
395
|
|
|
|
|
|
|
MIFF => ['MIFF', 'Magick Image File Format'], |
396
|
|
|
|
|
|
|
MKA => ['MKV', 'Matroska Audio'], |
397
|
|
|
|
|
|
|
MKS => ['MKV', 'Matroska Subtitle'], |
398
|
|
|
|
|
|
|
MKV => ['MKV', 'Matroska Video'], |
399
|
|
|
|
|
|
|
MNG => ['PNG', 'Multiple-image Network Graphics'], |
400
|
|
|
|
|
|
|
MOBI => ['PDB', 'Mobipocket electronic book'], |
401
|
|
|
|
|
|
|
MODD => ['PLIST','Sony Picture Motion metadata'], |
402
|
|
|
|
|
|
|
MOI => ['MOI', 'MOD Information file'], |
403
|
|
|
|
|
|
|
MOS => ['TIFF', 'Creo Leaf Mosaic'], |
404
|
|
|
|
|
|
|
MOV => ['MOV', 'Apple QuickTime movie'], |
405
|
|
|
|
|
|
|
MP3 => ['MP3', 'MPEG-1 Layer 3 audio'], |
406
|
|
|
|
|
|
|
MP4 => ['MOV', 'MPEG-4 video'], |
407
|
|
|
|
|
|
|
MPC => ['MPC', 'Musepack Audio'], |
408
|
|
|
|
|
|
|
MPEG => ['MPEG', 'MPEG-1 or MPEG-2 audio/video'], |
409
|
|
|
|
|
|
|
MPG => 'MPEG', |
410
|
|
|
|
|
|
|
MPO => ['JPEG', 'Extended Multi-Picture format'], |
411
|
|
|
|
|
|
|
MQV => ['MOV', 'Sony Mobile Quicktime Video'], |
412
|
|
|
|
|
|
|
MRC => ['MRC', 'Medical Research Council image'], |
413
|
|
|
|
|
|
|
MRW => ['MRW', 'Minolta RAW format'], |
414
|
|
|
|
|
|
|
MTS => 'M2TS', |
415
|
|
|
|
|
|
|
MXF => ['MXF', 'Material Exchange Format'], |
416
|
|
|
|
|
|
|
# NDPI => ['TIFF', 'Hamamatsu NanoZoomer Digital Pathology Image'], |
417
|
|
|
|
|
|
|
NEF => ['TIFF', 'Nikon (RAW) Electronic Format'], |
418
|
|
|
|
|
|
|
NEWER => 'COS', |
419
|
|
|
|
|
|
|
NKSC => ['XMP', 'Nikon Sidecar'], |
420
|
|
|
|
|
|
|
NMBTEMPLATE => ['ZIP','Apple Numbers Template'], |
421
|
|
|
|
|
|
|
NRW => ['TIFF', 'Nikon RAW (2)'], |
422
|
|
|
|
|
|
|
NUMBERS => ['ZIP','Apple Numbers spreadsheet'], |
423
|
|
|
|
|
|
|
O => ['EXE', 'Relocatable Object'], |
424
|
|
|
|
|
|
|
ODB => ['ZIP', 'Open Document Database'], |
425
|
|
|
|
|
|
|
ODC => ['ZIP', 'Open Document Chart'], |
426
|
|
|
|
|
|
|
ODF => ['ZIP', 'Open Document Formula'], |
427
|
|
|
|
|
|
|
ODG => ['ZIP', 'Open Document Graphics'], |
428
|
|
|
|
|
|
|
ODI => ['ZIP', 'Open Document Image'], |
429
|
|
|
|
|
|
|
ODP => ['ZIP', 'Open Document Presentation'], |
430
|
|
|
|
|
|
|
ODS => ['ZIP', 'Open Document Spreadsheet'], |
431
|
|
|
|
|
|
|
ODT => ['ZIP', 'Open Document Text file'], |
432
|
|
|
|
|
|
|
OFR => ['RIFF', 'OptimFROG audio'], |
433
|
|
|
|
|
|
|
OGG => ['OGG', 'Ogg Vorbis audio file'], |
434
|
|
|
|
|
|
|
OGV => ['OGG', 'Ogg Video file'], |
435
|
|
|
|
|
|
|
ONP => ['JSON', 'ON1 Presets'], |
436
|
|
|
|
|
|
|
OPUS => ['OGG', 'Ogg Opus audio file'], |
437
|
|
|
|
|
|
|
ORF => ['ORF', 'Olympus RAW format'], |
438
|
|
|
|
|
|
|
ORI => 'ORF', |
439
|
|
|
|
|
|
|
OTF => ['Font', 'Open Type Font'], |
440
|
|
|
|
|
|
|
PAC => ['RIFF', 'Lossless Predictive Audio Compression'], |
441
|
|
|
|
|
|
|
PAGES => ['ZIP', 'Apple Pages document'], |
442
|
|
|
|
|
|
|
PBM => ['PPM', 'Portable BitMap'], |
443
|
|
|
|
|
|
|
PCD => ['PCD', 'Kodak Photo CD Image Pac'], |
444
|
|
|
|
|
|
|
PCT => 'PICT', |
445
|
|
|
|
|
|
|
PCX => ['PCX', 'PC Paintbrush'], |
446
|
|
|
|
|
|
|
PDB => ['PDB', 'Palm Database'], |
447
|
|
|
|
|
|
|
PDF => ['PDF', 'Adobe Portable Document Format'], |
448
|
|
|
|
|
|
|
PEF => ['TIFF', 'Pentax (RAW) Electronic Format'], |
449
|
|
|
|
|
|
|
PFA => ['Font', 'PostScript Font ASCII'], |
450
|
|
|
|
|
|
|
PFB => ['Font', 'PostScript Font Binary'], |
451
|
|
|
|
|
|
|
PFM => [['Font','PFM2'], 'Printer Font Metrics'], # (description is overridden for Portable FloatMap images) |
452
|
|
|
|
|
|
|
PGF => ['PGF', 'Progressive Graphics File'], |
453
|
|
|
|
|
|
|
PGM => ['PPM', 'Portable Gray Map'], |
454
|
|
|
|
|
|
|
PHP => ['PHP', 'PHP Hypertext Preprocessor'], |
455
|
|
|
|
|
|
|
PHP3 => 'PHP', |
456
|
|
|
|
|
|
|
PHP4 => 'PHP', |
457
|
|
|
|
|
|
|
PHP5 => 'PHP', |
458
|
|
|
|
|
|
|
PHPS => 'PHP', |
459
|
|
|
|
|
|
|
PHTML=> 'PHP', |
460
|
|
|
|
|
|
|
PICT => ['PICT', 'Apple PICTure'], |
461
|
|
|
|
|
|
|
PLIST=> ['PLIST','Apple Property List'], |
462
|
|
|
|
|
|
|
PMP => ['PMP', 'Sony DSC-F1 Cyber-Shot PMP'], # should stand for Proprietery Metadata Package ;) |
463
|
|
|
|
|
|
|
PNG => ['PNG', 'Portable Network Graphics'], |
464
|
|
|
|
|
|
|
POT => ['FPX', 'Microsoft PowerPoint Template'], |
465
|
|
|
|
|
|
|
POTM => [['ZIP','FPX'], 'Office Open XML Presentation Template Macro-enabled'], |
466
|
|
|
|
|
|
|
POTX => [['ZIP','FPX'], 'Office Open XML Presentation Template'], |
467
|
|
|
|
|
|
|
PPAM => [['ZIP','FPX'], 'Office Open XML Presentation Addin Macro-enabled'], |
468
|
|
|
|
|
|
|
PPAX => [['ZIP','FPX'], 'Office Open XML Presentation Addin'], |
469
|
|
|
|
|
|
|
PPM => ['PPM', 'Portable Pixel Map'], |
470
|
|
|
|
|
|
|
PPS => ['FPX', 'Microsoft PowerPoint Slideshow'], |
471
|
|
|
|
|
|
|
PPSM => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow Macro-enabled'], |
472
|
|
|
|
|
|
|
PPSX => [['ZIP','FPX'], 'Office Open XML Presentation Slideshow'], |
473
|
|
|
|
|
|
|
PPT => ['FPX', 'Microsoft PowerPoint Presentation'], |
474
|
|
|
|
|
|
|
PPTM => [['ZIP','FPX'], 'Office Open XML Presentation Macro-enabled'], |
475
|
|
|
|
|
|
|
PPTX => [['ZIP','FPX'], 'Office Open XML Presentation'], |
476
|
|
|
|
|
|
|
PRC => ['PDB', 'Palm Database'], |
477
|
|
|
|
|
|
|
PS => ['PS', 'PostScript'], |
478
|
|
|
|
|
|
|
PS2 => 'PS', |
479
|
|
|
|
|
|
|
PS3 => 'PS', |
480
|
|
|
|
|
|
|
PSB => ['PSD', 'Photoshop Large Document'], |
481
|
|
|
|
|
|
|
PSD => ['PSD', 'Photoshop Document'], |
482
|
|
|
|
|
|
|
PSDT => ['PSD', 'Photoshop Document Template'], |
483
|
|
|
|
|
|
|
PSP => ['PSP', 'Paint Shop Pro'], |
484
|
|
|
|
|
|
|
PSPFRAME => 'PSP', |
485
|
|
|
|
|
|
|
PSPIMAGE => 'PSP', |
486
|
|
|
|
|
|
|
PSPSHAPE => 'PSP', |
487
|
|
|
|
|
|
|
PSPTUBE => 'PSP', |
488
|
|
|
|
|
|
|
QIF => 'QTIF', |
489
|
|
|
|
|
|
|
QT => 'MOV', |
490
|
|
|
|
|
|
|
QTI => 'QTIF', |
491
|
|
|
|
|
|
|
QTIF => ['QTIF', 'QuickTime Image File'], |
492
|
|
|
|
|
|
|
R3D => ['R3D', 'Redcode RAW Video'], |
493
|
|
|
|
|
|
|
RA => ['Real', 'Real Audio'], |
494
|
|
|
|
|
|
|
RAF => ['RAF', 'FujiFilm RAW Format'], |
495
|
|
|
|
|
|
|
RAM => ['Real', 'Real Audio Metafile'], |
496
|
|
|
|
|
|
|
RAR => ['RAR', 'RAR Archive'], |
497
|
|
|
|
|
|
|
RAW => [['RAW','TIFF'], 'Kyocera Contax N Digital RAW or Panasonic RAW'], |
498
|
|
|
|
|
|
|
RIF => 'RIFF', |
499
|
|
|
|
|
|
|
RIFF => ['RIFF', 'Resource Interchange File Format'], |
500
|
|
|
|
|
|
|
RM => ['Real', 'Real Media'], |
501
|
|
|
|
|
|
|
RMVB => ['Real', 'Real Media Variable Bitrate'], |
502
|
|
|
|
|
|
|
RPM => ['Real', 'Real Media Plug-in Metafile'], |
503
|
|
|
|
|
|
|
RSRC => ['RSRC', 'Mac OS Resource'], |
504
|
|
|
|
|
|
|
RTF => ['RTF', 'Rich Text Format'], |
505
|
|
|
|
|
|
|
RV => ['Real', 'Real Video'], |
506
|
|
|
|
|
|
|
RW2 => ['TIFF', 'Panasonic RAW 2'], |
507
|
|
|
|
|
|
|
RWL => ['TIFF', 'Leica RAW'], |
508
|
|
|
|
|
|
|
RWZ => ['RWZ', 'Rawzor compressed image'], |
509
|
|
|
|
|
|
|
SEQ => ['FLIR', 'FLIR image Sequence'], |
510
|
|
|
|
|
|
|
SKETCH => ['ZIP', 'Sketch design file'], |
511
|
|
|
|
|
|
|
SO => ['EXE', 'Shared Object file'], |
512
|
|
|
|
|
|
|
SR2 => ['TIFF', 'Sony RAW Format 2'], |
513
|
|
|
|
|
|
|
SRF => ['TIFF', 'Sony RAW Format'], |
514
|
|
|
|
|
|
|
SRW => ['TIFF', 'Samsung RAW format'], |
515
|
|
|
|
|
|
|
SVG => ['XMP', 'Scalable Vector Graphics'], |
516
|
|
|
|
|
|
|
SWF => ['SWF', 'Shockwave Flash'], |
517
|
|
|
|
|
|
|
TAR => ['TAR', 'TAR archive'], |
518
|
|
|
|
|
|
|
THM => ['JPEG', 'Thumbnail'], |
519
|
|
|
|
|
|
|
THMX => [['ZIP','FPX'], 'Office Open XML Theme'], |
520
|
|
|
|
|
|
|
TIF => 'TIFF', |
521
|
|
|
|
|
|
|
TIFF => ['TIFF', 'Tagged Image File Format'], |
522
|
|
|
|
|
|
|
TORRENT => ['Torrent', 'BitTorrent description file'], |
523
|
|
|
|
|
|
|
TS => 'M2TS', |
524
|
|
|
|
|
|
|
TTC => ['Font', 'True Type Font Collection'], |
525
|
|
|
|
|
|
|
TTF => ['Font', 'True Type Font'], |
526
|
|
|
|
|
|
|
TUB => 'PSP', |
527
|
|
|
|
|
|
|
TXT => ['TXT', 'Text file'], |
528
|
|
|
|
|
|
|
VCARD=> ['VCard','Virtual Card'], |
529
|
|
|
|
|
|
|
VCF => 'VCARD', |
530
|
|
|
|
|
|
|
VOB => ['MPEG', 'Video Object'], |
531
|
|
|
|
|
|
|
VNT => [['FPX','VCard'], 'Scene7 Vignette or V-Note text file'], |
532
|
|
|
|
|
|
|
VRD => ['VRD', 'Canon VRD Recipe Data'], |
533
|
|
|
|
|
|
|
VSD => ['FPX', 'Microsoft Visio Drawing'], |
534
|
|
|
|
|
|
|
WAV => ['RIFF', 'WAVeform (Windows digital audio)'], |
535
|
|
|
|
|
|
|
WDP => ['TIFF', 'Windows Media Photo'], |
536
|
|
|
|
|
|
|
WEBM => ['MKV', 'Google Web Movie'], |
537
|
|
|
|
|
|
|
WEBP => ['RIFF', 'Google Web Picture'], |
538
|
|
|
|
|
|
|
WMA => ['ASF', 'Windows Media Audio'], |
539
|
|
|
|
|
|
|
WMF => ['WMF', 'Windows Metafile Format'], |
540
|
|
|
|
|
|
|
WMV => ['ASF', 'Windows Media Video'], |
541
|
|
|
|
|
|
|
WV => ['RIFF', 'WavePack lossless audio'], |
542
|
|
|
|
|
|
|
X3F => ['X3F', 'Sigma RAW format'], |
543
|
|
|
|
|
|
|
XCF => ['XCF', 'GIMP native image format'], |
544
|
|
|
|
|
|
|
XHTML=> ['HTML', 'Extensible HyperText Markup Language'], |
545
|
|
|
|
|
|
|
XLA => ['FPX', 'Microsoft Excel Add-in'], |
546
|
|
|
|
|
|
|
XLAM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Add-in Macro-enabled'], |
547
|
|
|
|
|
|
|
XLS => ['FPX', 'Microsoft Excel Spreadsheet'], |
548
|
|
|
|
|
|
|
XLSB => [['ZIP','FPX'], 'Office Open XML Spreadsheet Binary'], |
549
|
|
|
|
|
|
|
XLSM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Macro-enabled'], |
550
|
|
|
|
|
|
|
XLSX => [['ZIP','FPX'], 'Office Open XML Spreadsheet'], |
551
|
|
|
|
|
|
|
XLT => ['FPX', 'Microsoft Excel Template'], |
552
|
|
|
|
|
|
|
XLTM => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template Macro-enabled'], |
553
|
|
|
|
|
|
|
XLTX => [['ZIP','FPX'], 'Office Open XML Spreadsheet Template'], |
554
|
|
|
|
|
|
|
XMP => ['XMP', 'Extensible Metadata Platform'], |
555
|
|
|
|
|
|
|
WOFF => ['Font', 'Web Open Font Format'], |
556
|
|
|
|
|
|
|
WOFF2=> ['Font', 'Web Open Font Format2'], |
557
|
|
|
|
|
|
|
WTV => ['WTV', 'Windows recorded TV show'], |
558
|
|
|
|
|
|
|
ZIP => ['ZIP', 'ZIP archive'], |
559
|
|
|
|
|
|
|
); |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
# typical extension for each file type (if different than FileType) |
562
|
|
|
|
|
|
|
# - case is not significant |
563
|
|
|
|
|
|
|
my %fileTypeExt = ( |
564
|
|
|
|
|
|
|
'Canon 1D RAW' => 'tif', |
565
|
|
|
|
|
|
|
DICOM => 'dcm', |
566
|
|
|
|
|
|
|
FLIR => 'fff', |
567
|
|
|
|
|
|
|
GZIP => 'gz', |
568
|
|
|
|
|
|
|
JPEG => 'jpg', |
569
|
|
|
|
|
|
|
M2TS => 'mts', |
570
|
|
|
|
|
|
|
MPEG => 'mpg', |
571
|
|
|
|
|
|
|
TIFF => 'tif', |
572
|
|
|
|
|
|
|
VCard => 'vcf', |
573
|
|
|
|
|
|
|
); |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# descriptions for file types not found in above file extension lookup |
576
|
|
|
|
|
|
|
my %fileDescription = ( |
577
|
|
|
|
|
|
|
DICOM => 'Digital Imaging and Communications in Medicine', |
578
|
|
|
|
|
|
|
XML => 'Extensible Markup Language', |
579
|
|
|
|
|
|
|
'Win32 EXE' => 'Windows 32-bit Executable', |
580
|
|
|
|
|
|
|
'Win32 DLL' => 'Windows 32-bit Dynamic Link Library', |
581
|
|
|
|
|
|
|
'Win64 EXE' => 'Windows 64-bit Executable', |
582
|
|
|
|
|
|
|
'Win64 DLL' => 'Windows 64-bit Dynamic Link Library', |
583
|
|
|
|
|
|
|
VNote => 'V-Note document', |
584
|
|
|
|
|
|
|
); |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
# MIME types for applicable file types above |
587
|
|
|
|
|
|
|
# (missing entries default to 'application/unknown', but note that other MIME |
588
|
|
|
|
|
|
|
# types may be specified by some modules, eg. QuickTime.pm and RIFF.pm) |
589
|
|
|
|
|
|
|
%mimeType = ( |
590
|
|
|
|
|
|
|
'3FR' => 'image/x-hasselblad-3fr', |
591
|
|
|
|
|
|
|
AA => 'audio/audible', |
592
|
|
|
|
|
|
|
AAE => 'application/vnd.apple.photos', |
593
|
|
|
|
|
|
|
AI => 'application/vnd.adobe.illustrator', |
594
|
|
|
|
|
|
|
AIFF => 'audio/x-aiff', |
595
|
|
|
|
|
|
|
ALIAS=> 'application/x-macos', |
596
|
|
|
|
|
|
|
APE => 'audio/x-monkeys-audio', |
597
|
|
|
|
|
|
|
APNG => 'image/apng', |
598
|
|
|
|
|
|
|
ASF => 'video/x-ms-asf', |
599
|
|
|
|
|
|
|
ARW => 'image/x-sony-arw', |
600
|
|
|
|
|
|
|
BMP => 'image/bmp', |
601
|
|
|
|
|
|
|
BPG => 'image/bpg', |
602
|
|
|
|
|
|
|
BTF => 'image/x-tiff-big', #(NC) (ref http://www.asmail.be/msg0055371937.html) |
603
|
|
|
|
|
|
|
BZ2 => 'application/bzip2', |
604
|
|
|
|
|
|
|
'Canon 1D RAW' => 'image/x-raw', # (uses .TIF file extension) |
605
|
|
|
|
|
|
|
CHM => 'application/x-chm', |
606
|
|
|
|
|
|
|
COS => 'application/octet-stream', #PH (NC) |
607
|
|
|
|
|
|
|
CR2 => 'image/x-canon-cr2', |
608
|
|
|
|
|
|
|
CR3 => 'image/x-canon-cr3', |
609
|
|
|
|
|
|
|
CRM => 'video/x-canon-crm', |
610
|
|
|
|
|
|
|
CRW => 'image/x-canon-crw', |
611
|
|
|
|
|
|
|
CSV => 'text/csv', |
612
|
|
|
|
|
|
|
CUR => 'image/x-cursor', #PH (NC) |
613
|
|
|
|
|
|
|
CZI => 'image/x-zeiss-czi', #PH (NC) |
614
|
|
|
|
|
|
|
DCP => 'application/octet-stream', #PH (NC) |
615
|
|
|
|
|
|
|
DCR => 'image/x-kodak-dcr', |
616
|
|
|
|
|
|
|
DCX => 'image/dcx', |
617
|
|
|
|
|
|
|
DEX => 'application/octet-stream', |
618
|
|
|
|
|
|
|
DFONT=> 'application/x-dfont', |
619
|
|
|
|
|
|
|
DICOM=> 'application/dicom', |
620
|
|
|
|
|
|
|
DIVX => 'video/divx', |
621
|
|
|
|
|
|
|
DJVU => 'image/vnd.djvu', |
622
|
|
|
|
|
|
|
DNG => 'image/x-adobe-dng', |
623
|
|
|
|
|
|
|
DOC => 'application/msword', |
624
|
|
|
|
|
|
|
DOCM => 'application/vnd.ms-word.document.macroEnabled.12', |
625
|
|
|
|
|
|
|
DOCX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.document', |
626
|
|
|
|
|
|
|
DOT => 'application/msword', |
627
|
|
|
|
|
|
|
DOTM => 'application/vnd.ms-word.template.macroEnabledTemplate', |
628
|
|
|
|
|
|
|
DOTX => 'application/vnd.openxmlformats-officedocument.wordprocessingml.template', |
629
|
|
|
|
|
|
|
DPX => 'image/x-dpx', |
630
|
|
|
|
|
|
|
DR4 => 'application/octet-stream', #PH (NC) |
631
|
|
|
|
|
|
|
DS2 => 'audio/x-ds2', |
632
|
|
|
|
|
|
|
DSS => 'audio/x-dss', |
633
|
|
|
|
|
|
|
DV => 'video/x-dv', |
634
|
|
|
|
|
|
|
'DVR-MS' => 'video/x-ms-dvr', |
635
|
|
|
|
|
|
|
DWF => 'model/vnd.dwf', |
636
|
|
|
|
|
|
|
DWG => 'image/vnd.dwg', |
637
|
|
|
|
|
|
|
DXF => 'application/dxf', |
638
|
|
|
|
|
|
|
EIP => 'application/x-captureone', #(NC) |
639
|
|
|
|
|
|
|
EPS => 'application/postscript', |
640
|
|
|
|
|
|
|
ERF => 'image/x-epson-erf', |
641
|
|
|
|
|
|
|
EXE => 'application/octet-stream', |
642
|
|
|
|
|
|
|
EXR => 'image/x-exr', |
643
|
|
|
|
|
|
|
EXV => 'image/x-exv', |
644
|
|
|
|
|
|
|
FFF => 'image/x-hasselblad-fff', |
645
|
|
|
|
|
|
|
FITS => 'image/fits', |
646
|
|
|
|
|
|
|
FLA => 'application/vnd.adobe.fla', |
647
|
|
|
|
|
|
|
FLAC => 'audio/flac', |
648
|
|
|
|
|
|
|
FLIF => 'image/flif', |
649
|
|
|
|
|
|
|
FLIR => 'image/x-flir-fff', #PH (NC) |
650
|
|
|
|
|
|
|
FLV => 'video/x-flv', |
651
|
|
|
|
|
|
|
Font => 'application/x-font-type1', # covers PFA, PFB and PFM (not sure about PFM) |
652
|
|
|
|
|
|
|
FPF => 'image/x-flir-fpf', #PH (NC) |
653
|
|
|
|
|
|
|
FPX => 'image/vnd.fpx', |
654
|
|
|
|
|
|
|
GIF => 'image/gif', |
655
|
|
|
|
|
|
|
GPR => 'image/x-gopro-gpr', |
656
|
|
|
|
|
|
|
GZIP => 'application/x-gzip', |
657
|
|
|
|
|
|
|
HDP => 'image/vnd.ms-photo', |
658
|
|
|
|
|
|
|
HDR => 'image/vnd.radiance', |
659
|
|
|
|
|
|
|
HTML => 'text/html', |
660
|
|
|
|
|
|
|
ICC => 'application/vnd.iccprofile', |
661
|
|
|
|
|
|
|
ICO => 'image/x-icon', #PH (NC) |
662
|
|
|
|
|
|
|
ICS => 'text/calendar', |
663
|
|
|
|
|
|
|
IDML => 'application/vnd.adobe.indesign-idml-package', |
664
|
|
|
|
|
|
|
IIQ => 'image/x-raw', |
665
|
|
|
|
|
|
|
IND => 'application/x-indesign', |
666
|
|
|
|
|
|
|
INX => 'application/x-indesign-interchange', #PH (NC) |
667
|
|
|
|
|
|
|
ISO => 'application/x-iso9660-image', |
668
|
|
|
|
|
|
|
ITC => 'application/itunes', |
669
|
|
|
|
|
|
|
J2C => 'image/x-j2c', #PH (NC) |
670
|
|
|
|
|
|
|
JNG => 'image/jng', |
671
|
|
|
|
|
|
|
JP2 => 'image/jp2', |
672
|
|
|
|
|
|
|
JPEG => 'image/jpeg', |
673
|
|
|
|
|
|
|
JPM => 'image/jpm', |
674
|
|
|
|
|
|
|
JPS => 'image/x-jps', |
675
|
|
|
|
|
|
|
JPX => 'image/jpx', |
676
|
|
|
|
|
|
|
JSON => 'application/json', |
677
|
|
|
|
|
|
|
JXL => 'image/jxl', #PH (NC) |
678
|
|
|
|
|
|
|
JXR => 'image/jxr', |
679
|
|
|
|
|
|
|
K25 => 'image/x-kodak-k25', |
680
|
|
|
|
|
|
|
KDC => 'image/x-kodak-kdc', |
681
|
|
|
|
|
|
|
KEY => 'application/x-iwork-keynote-sffkey', |
682
|
|
|
|
|
|
|
LFP => 'image/x-lytro-lfp', #PH (NC) |
683
|
|
|
|
|
|
|
LIF => 'image/x-lif', |
684
|
|
|
|
|
|
|
LNK => 'application/octet-stream', |
685
|
|
|
|
|
|
|
LRI => 'image/x-light-lri', |
686
|
|
|
|
|
|
|
M2T => 'video/mpeg', |
687
|
|
|
|
|
|
|
M2TS => 'video/m2ts', |
688
|
|
|
|
|
|
|
MAX => 'application/x-3ds', |
689
|
|
|
|
|
|
|
MEF => 'image/x-mamiya-mef', |
690
|
|
|
|
|
|
|
MIE => 'application/x-mie', |
691
|
|
|
|
|
|
|
MIFF => 'application/x-magick-image', |
692
|
|
|
|
|
|
|
MKA => 'audio/x-matroska', |
693
|
|
|
|
|
|
|
MKS => 'application/x-matroska', |
694
|
|
|
|
|
|
|
MKV => 'video/x-matroska', |
695
|
|
|
|
|
|
|
MNG => 'video/mng', |
696
|
|
|
|
|
|
|
MOBI => 'application/x-mobipocket-ebook', |
697
|
|
|
|
|
|
|
MOI => 'application/octet-stream', #PH (NC) |
698
|
|
|
|
|
|
|
MOS => 'image/x-raw', |
699
|
|
|
|
|
|
|
MOV => 'video/quicktime', |
700
|
|
|
|
|
|
|
MP3 => 'audio/mpeg', |
701
|
|
|
|
|
|
|
MP4 => 'video/mp4', |
702
|
|
|
|
|
|
|
MPC => 'audio/x-musepack', |
703
|
|
|
|
|
|
|
MPEG => 'video/mpeg', |
704
|
|
|
|
|
|
|
MRC => 'image/x-mrc', |
705
|
|
|
|
|
|
|
MRW => 'image/x-minolta-mrw', |
706
|
|
|
|
|
|
|
MXF => 'application/mxf', |
707
|
|
|
|
|
|
|
NEF => 'image/x-nikon-nef', |
708
|
|
|
|
|
|
|
NKSC => 'application/x-nikon-nxstudio', |
709
|
|
|
|
|
|
|
NRW => 'image/x-nikon-nrw', |
710
|
|
|
|
|
|
|
NUMBERS => 'application/x-iwork-numbers-sffnumbers', |
711
|
|
|
|
|
|
|
ODB => 'application/vnd.oasis.opendocument.database', |
712
|
|
|
|
|
|
|
ODC => 'application/vnd.oasis.opendocument.chart', |
713
|
|
|
|
|
|
|
ODF => 'application/vnd.oasis.opendocument.formula', |
714
|
|
|
|
|
|
|
ODG => 'application/vnd.oasis.opendocument.graphics', |
715
|
|
|
|
|
|
|
ODI => 'application/vnd.oasis.opendocument.image', |
716
|
|
|
|
|
|
|
ODP => 'application/vnd.oasis.opendocument.presentation', |
717
|
|
|
|
|
|
|
ODS => 'application/vnd.oasis.opendocument.spreadsheet', |
718
|
|
|
|
|
|
|
ODT => 'application/vnd.oasis.opendocument.text', |
719
|
|
|
|
|
|
|
OGG => 'audio/ogg', |
720
|
|
|
|
|
|
|
OGV => 'video/ogg', |
721
|
|
|
|
|
|
|
ONP => 'application/on1', |
722
|
|
|
|
|
|
|
ORF => 'image/x-olympus-orf', |
723
|
|
|
|
|
|
|
OTF => 'application/x-font-otf', |
724
|
|
|
|
|
|
|
PAGES=> 'application/x-iwork-pages-sffpages', |
725
|
|
|
|
|
|
|
PBM => 'image/x-portable-bitmap', |
726
|
|
|
|
|
|
|
PCD => 'image/x-photo-cd', |
727
|
|
|
|
|
|
|
PCX => 'image/pcx', |
728
|
|
|
|
|
|
|
PDB => 'application/vnd.palm', |
729
|
|
|
|
|
|
|
PDF => 'application/pdf', |
730
|
|
|
|
|
|
|
PEF => 'image/x-pentax-pef', |
731
|
|
|
|
|
|
|
PFA => 'application/x-font-type1', # (needed if handled by PostScript module) |
732
|
|
|
|
|
|
|
PGF => 'image/pgf', |
733
|
|
|
|
|
|
|
PGM => 'image/x-portable-graymap', |
734
|
|
|
|
|
|
|
PHP => 'application/x-httpd-php', |
735
|
|
|
|
|
|
|
PICT => 'image/pict', |
736
|
|
|
|
|
|
|
PLIST=> 'application/xml', # (binary PLIST format is 'application/x-plist', recognized at run time) |
737
|
|
|
|
|
|
|
PMP => 'image/x-sony-pmp', #PH (NC) |
738
|
|
|
|
|
|
|
PNG => 'image/png', |
739
|
|
|
|
|
|
|
POT => 'application/vnd.ms-powerpoint', |
740
|
|
|
|
|
|
|
POTM => 'application/vnd.ms-powerpoint.template.macroEnabled.12', |
741
|
|
|
|
|
|
|
POTX => 'application/vnd.openxmlformats-officedocument.presentationml.template', |
742
|
|
|
|
|
|
|
PPAM => 'application/vnd.ms-powerpoint.addin.macroEnabled.12', |
743
|
|
|
|
|
|
|
PPAX => 'application/vnd.openxmlformats-officedocument.presentationml.addin', # (NC, PH invented) |
744
|
|
|
|
|
|
|
PPM => 'image/x-portable-pixmap', |
745
|
|
|
|
|
|
|
PPS => 'application/vnd.ms-powerpoint', |
746
|
|
|
|
|
|
|
PPSM => 'application/vnd.ms-powerpoint.slideshow.macroEnabled.12', |
747
|
|
|
|
|
|
|
PPSX => 'application/vnd.openxmlformats-officedocument.presentationml.slideshow', |
748
|
|
|
|
|
|
|
PPT => 'application/vnd.ms-powerpoint', |
749
|
|
|
|
|
|
|
PPTM => 'application/vnd.ms-powerpoint.presentation.macroEnabled.12', |
750
|
|
|
|
|
|
|
PPTX => 'application/vnd.openxmlformats-officedocument.presentationml.presentation', |
751
|
|
|
|
|
|
|
PS => 'application/postscript', |
752
|
|
|
|
|
|
|
PSD => 'application/vnd.adobe.photoshop', |
753
|
|
|
|
|
|
|
PSP => 'image/x-paintshoppro', #(NC) |
754
|
|
|
|
|
|
|
QTIF => 'image/x-quicktime', |
755
|
|
|
|
|
|
|
R3D => 'video/x-red-r3d', #PH (invented) |
756
|
|
|
|
|
|
|
RA => 'audio/x-pn-realaudio', |
757
|
|
|
|
|
|
|
RAF => 'image/x-fujifilm-raf', |
758
|
|
|
|
|
|
|
RAM => 'audio/x-pn-realaudio', |
759
|
|
|
|
|
|
|
RAR => 'application/x-rar-compressed', |
760
|
|
|
|
|
|
|
RAW => 'image/x-raw', |
761
|
|
|
|
|
|
|
RM => 'application/vnd.rn-realmedia', |
762
|
|
|
|
|
|
|
RMVB => 'application/vnd.rn-realmedia-vbr', |
763
|
|
|
|
|
|
|
RPM => 'audio/x-pn-realaudio-plugin', |
764
|
|
|
|
|
|
|
RSRC => 'application/ResEdit', |
765
|
|
|
|
|
|
|
RTF => 'text/rtf', |
766
|
|
|
|
|
|
|
RV => 'video/vnd.rn-realvideo', |
767
|
|
|
|
|
|
|
RW2 => 'image/x-panasonic-rw2', |
768
|
|
|
|
|
|
|
RWL => 'image/x-leica-rwl', |
769
|
|
|
|
|
|
|
RWZ => 'image/x-rawzor', #(duplicated in Rawzor.pm) |
770
|
|
|
|
|
|
|
SEQ => 'image/x-flir-seq', #PH (NC) |
771
|
|
|
|
|
|
|
SKETCH => 'application/sketch', |
772
|
|
|
|
|
|
|
SR2 => 'image/x-sony-sr2', |
773
|
|
|
|
|
|
|
SRF => 'image/x-sony-srf', |
774
|
|
|
|
|
|
|
SRW => 'image/x-samsung-srw', |
775
|
|
|
|
|
|
|
SVG => 'image/svg+xml', |
776
|
|
|
|
|
|
|
SWF => 'application/x-shockwave-flash', |
777
|
|
|
|
|
|
|
TAR => 'application/x-tar', |
778
|
|
|
|
|
|
|
THMX => 'application/vnd.ms-officetheme', |
779
|
|
|
|
|
|
|
TIFF => 'image/tiff', |
780
|
|
|
|
|
|
|
Torrent => 'application/x-bittorrent', |
781
|
|
|
|
|
|
|
TTC => 'application/x-font-ttf', |
782
|
|
|
|
|
|
|
TTF => 'application/x-font-ttf', |
783
|
|
|
|
|
|
|
TXT => 'text/plain', |
784
|
|
|
|
|
|
|
VCard=> 'text/vcard', |
785
|
|
|
|
|
|
|
VRD => 'application/octet-stream', #PH (NC) |
786
|
|
|
|
|
|
|
VSD => 'application/x-visio', |
787
|
|
|
|
|
|
|
WDP => 'image/vnd.ms-photo', |
788
|
|
|
|
|
|
|
WEBM => 'video/webm', |
789
|
|
|
|
|
|
|
WMA => 'audio/x-ms-wma', |
790
|
|
|
|
|
|
|
WMF => 'application/x-wmf', |
791
|
|
|
|
|
|
|
WMV => 'video/x-ms-wmv', |
792
|
|
|
|
|
|
|
WTV => 'video/x-ms-wtv', |
793
|
|
|
|
|
|
|
X3F => 'image/x-sigma-x3f', |
794
|
|
|
|
|
|
|
XCF => 'image/x-xcf', |
795
|
|
|
|
|
|
|
XLA => 'application/vnd.ms-excel', |
796
|
|
|
|
|
|
|
XLAM => 'application/vnd.ms-excel.addin.macroEnabled.12', |
797
|
|
|
|
|
|
|
XLS => 'application/vnd.ms-excel', |
798
|
|
|
|
|
|
|
XLSB => 'application/vnd.ms-excel.sheet.binary.macroEnabled.12', |
799
|
|
|
|
|
|
|
XLSM => 'application/vnd.ms-excel.sheet.macroEnabled.12', |
800
|
|
|
|
|
|
|
XLSX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet', |
801
|
|
|
|
|
|
|
XLT => 'application/vnd.ms-excel', |
802
|
|
|
|
|
|
|
XLTM => 'application/vnd.ms-excel.template.macroEnabled.12', |
803
|
|
|
|
|
|
|
XLTX => 'application/vnd.openxmlformats-officedocument.spreadsheetml.template', |
804
|
|
|
|
|
|
|
XML => 'application/xml', |
805
|
|
|
|
|
|
|
XMP => 'application/rdf+xml', |
806
|
|
|
|
|
|
|
ZIP => 'application/zip', |
807
|
|
|
|
|
|
|
); |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
# module names for processing routines of each file type |
810
|
|
|
|
|
|
|
# - undefined entries default to same module name as file type |
811
|
|
|
|
|
|
|
# - module name '' defaults to Image::ExifTool |
812
|
|
|
|
|
|
|
# - module name '0' indicates a recognized but unsupported file |
813
|
|
|
|
|
|
|
my %moduleName = ( |
814
|
|
|
|
|
|
|
AA => 'Audible', |
815
|
|
|
|
|
|
|
ALIAS=> 0, |
816
|
|
|
|
|
|
|
AVC => 0, |
817
|
|
|
|
|
|
|
BTF => 'BigTIFF', |
818
|
|
|
|
|
|
|
BZ2 => 0, |
819
|
|
|
|
|
|
|
CRW => 'CanonRaw', |
820
|
|
|
|
|
|
|
CHM => 'EXE', |
821
|
|
|
|
|
|
|
COS => 'CaptureOne', |
822
|
|
|
|
|
|
|
CZI => 'ZISRAW', |
823
|
|
|
|
|
|
|
DEX => 0, |
824
|
|
|
|
|
|
|
DOCX => 'OOXML', |
825
|
|
|
|
|
|
|
DCX => 0, |
826
|
|
|
|
|
|
|
DIR => 0, |
827
|
|
|
|
|
|
|
DR4 => 'CanonVRD', |
828
|
|
|
|
|
|
|
DSS => 'Olympus', |
829
|
|
|
|
|
|
|
DWF => 0, |
830
|
|
|
|
|
|
|
DWG => 0, |
831
|
|
|
|
|
|
|
DXF => 0, |
832
|
|
|
|
|
|
|
EPS => 'PostScript', |
833
|
|
|
|
|
|
|
EXIF => '', |
834
|
|
|
|
|
|
|
EXR => 'OpenEXR', |
835
|
|
|
|
|
|
|
EXV => '', |
836
|
|
|
|
|
|
|
ICC => 'ICC_Profile', |
837
|
|
|
|
|
|
|
IND => 'InDesign', |
838
|
|
|
|
|
|
|
FLV => 'Flash', |
839
|
|
|
|
|
|
|
FPF => 'FLIR', |
840
|
|
|
|
|
|
|
FPX => 'FlashPix', |
841
|
|
|
|
|
|
|
GZIP => 'ZIP', |
842
|
|
|
|
|
|
|
HDR => 'Radiance', |
843
|
|
|
|
|
|
|
JP2 => 'Jpeg2000', |
844
|
|
|
|
|
|
|
JPEG => '', |
845
|
|
|
|
|
|
|
JXL => 'Jpeg2000', |
846
|
|
|
|
|
|
|
LFP => 'Lytro', |
847
|
|
|
|
|
|
|
LRI => 0, |
848
|
|
|
|
|
|
|
MOV => 'QuickTime', |
849
|
|
|
|
|
|
|
MKV => 'Matroska', |
850
|
|
|
|
|
|
|
MP3 => 'ID3', |
851
|
|
|
|
|
|
|
MRW => 'MinoltaRaw', |
852
|
|
|
|
|
|
|
OGG => 'Ogg', |
853
|
|
|
|
|
|
|
ORF => 'Olympus', |
854
|
|
|
|
|
|
|
PDB => 'Palm', |
855
|
|
|
|
|
|
|
PCD => 'PhotoCD', |
856
|
|
|
|
|
|
|
PFM2 => 'Other', |
857
|
|
|
|
|
|
|
PHP => 0, |
858
|
|
|
|
|
|
|
PMP => 'Sony', |
859
|
|
|
|
|
|
|
PS => 'PostScript', |
860
|
|
|
|
|
|
|
PSD => 'Photoshop', |
861
|
|
|
|
|
|
|
QTIF => 'QuickTime', |
862
|
|
|
|
|
|
|
R3D => 'Red', |
863
|
|
|
|
|
|
|
RAF => 'FujiFilm', |
864
|
|
|
|
|
|
|
RAR => 'ZIP', |
865
|
|
|
|
|
|
|
RAW => 'KyoceraRaw', |
866
|
|
|
|
|
|
|
RWZ => 'Rawzor', |
867
|
|
|
|
|
|
|
SWF => 'Flash', |
868
|
|
|
|
|
|
|
TAR => 0, |
869
|
|
|
|
|
|
|
TIFF => '', |
870
|
|
|
|
|
|
|
TXT => 'Text', |
871
|
|
|
|
|
|
|
VRD => 'CanonVRD', |
872
|
|
|
|
|
|
|
WMF => 0, |
873
|
|
|
|
|
|
|
X3F => 'SigmaRaw', |
874
|
|
|
|
|
|
|
XCF => 'GIMP', |
875
|
|
|
|
|
|
|
); |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
$testLen = 1024; # number of bytes to read when testing for magic number |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
# quick "magic number" file test used to avoid loading module unnecessarily: |
880
|
|
|
|
|
|
|
# - regular expression evaluated on first $testLen bytes of file |
881
|
|
|
|
|
|
|
# - must match beginning at first byte in file |
882
|
|
|
|
|
|
|
# - this test must not be more stringent than module logic |
883
|
|
|
|
|
|
|
%magicNumber = ( |
884
|
|
|
|
|
|
|
AA => '.{4}\x57\x90\x75\x36', |
885
|
|
|
|
|
|
|
AIFF => '(FORM....AIF[FC]|AT&TFORM)', |
886
|
|
|
|
|
|
|
ALIAS=> "book\0\0\0\0mark\0\0\0\0", |
887
|
|
|
|
|
|
|
APE => '(MAC |APETAGEX|ID3)', |
888
|
|
|
|
|
|
|
ASF => '\x30\x26\xb2\x75\x8e\x66\xcf\x11\xa6\xd9\x00\xaa\x00\x62\xce\x6c', |
889
|
|
|
|
|
|
|
AVC => '\+A\+V\+C\+', |
890
|
|
|
|
|
|
|
Torrent => 'd\d+:\w+', |
891
|
|
|
|
|
|
|
BMP => 'BM', |
892
|
|
|
|
|
|
|
BPG => "BPG\xfb", |
893
|
|
|
|
|
|
|
BTF => '(II\x2b\0|MM\0\x2b)', |
894
|
|
|
|
|
|
|
BZ2 => 'BZh[1-9]\x31\x41\x59\x26\x53\x59', |
895
|
|
|
|
|
|
|
CHM => 'ITSF.{20}\x10\xfd\x01\x7c\xaa\x7b\xd0\x11\x9e\x0c\0\xa0\xc9\x22\xe6\xec', |
896
|
|
|
|
|
|
|
CRW => '(II|MM).{4}HEAP(CCDR|JPGM)', |
897
|
|
|
|
|
|
|
CZI => 'ZISRAWFILE\0{6}', |
898
|
|
|
|
|
|
|
DCX => '\xb1\x68\xde\x3a', |
899
|
|
|
|
|
|
|
DEX => "dex\n035\0", |
900
|
|
|
|
|
|
|
DICOM=> '(.{128}DICM|\0[\x02\x04\x06\x08]\0[\0-\x20]|[\x02\x04\x06\x08]\0[\0-\x20]\0)', |
901
|
|
|
|
|
|
|
DOCX => 'PK\x03\x04', |
902
|
|
|
|
|
|
|
DPX => '(SDPX|XPDS)', |
903
|
|
|
|
|
|
|
DR4 => 'IIII\x04\0\x04\0', |
904
|
|
|
|
|
|
|
DSS => '(\x02dss|\x03ds2)', |
905
|
|
|
|
|
|
|
DV => '\x1f\x07\0[\x3f\xbf]', # (not tested if extension recognized) |
906
|
|
|
|
|
|
|
DWF => '\(DWF V\d', |
907
|
|
|
|
|
|
|
DWG => 'AC10\d{2}\0', |
908
|
|
|
|
|
|
|
DXF => '\s*0\s+\0?\s*SECTION\s+2\s+HEADER', |
909
|
|
|
|
|
|
|
EPS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', |
910
|
|
|
|
|
|
|
EXE => '(MZ|\xca\xfe\xba\xbe|\xfe\xed\xfa[\xce\xcf]|[\xce\xcf]\xfa\xed\xfe|Joy!peff|\x7fELF|#!\s*/\S*bin/|!\x0a)', |
911
|
|
|
|
|
|
|
EXIF => '(II\x2a\0|MM\0\x2a)', |
912
|
|
|
|
|
|
|
EXR => '\x76\x2f\x31\x01', |
913
|
|
|
|
|
|
|
EXV => '\xff\x01Exiv2', |
914
|
|
|
|
|
|
|
FITS => 'SIMPLE = {20}T', |
915
|
|
|
|
|
|
|
FLAC => '(fLaC|ID3)', |
916
|
|
|
|
|
|
|
FLIF => 'FLIF[0-\x6f][0-2]', |
917
|
|
|
|
|
|
|
FLIR => '[AF]FF\0', |
918
|
|
|
|
|
|
|
FLV => 'FLV\x01', |
919
|
|
|
|
|
|
|
Font => '((\0\x01\0\0|OTTO|true|typ1)[\0\x01]|ttcf\0[\x01\x02]\0\0|\0[\x01\x02]|' . |
920
|
|
|
|
|
|
|
'(.{6})?%!(PS-(AdobeFont-|Bitstream )|FontType1-)|Start(Comp|Master)?FontMetrics|wOF[F2])', |
921
|
|
|
|
|
|
|
FPF => 'FPF Public Image Format\0', |
922
|
|
|
|
|
|
|
FPX => '\xd0\xcf\x11\xe0\xa1\xb1\x1a\xe1', |
923
|
|
|
|
|
|
|
GIF => 'GIF8[79]a', |
924
|
|
|
|
|
|
|
GZIP => '\x1f\x8b\x08', |
925
|
|
|
|
|
|
|
HDR => '#\?(RADIANCE|RGBE)\x0a', |
926
|
|
|
|
|
|
|
HTML => '(\xef\xbb\xbf)?\s*(?i)<(!DOCTYPE\s+HTML|HTML|\?xml)', # (case insensitive) |
927
|
|
|
|
|
|
|
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}', |
928
|
|
|
|
|
|
|
ICO => '\0\0[\x01\x02]\0[^0]\0', # (reasonably assume that the file contains less than 256 images) |
929
|
|
|
|
|
|
|
IND => '\x06\x06\xed\xf5\xd8\x1d\x46\xe5\xbd\x31\xef\xe7\xfe\x74\xb7\x1d', |
930
|
|
|
|
|
|
|
# ISO => signature is at byte 32768 |
931
|
|
|
|
|
|
|
ITC => '.{4}itch', |
932
|
|
|
|
|
|
|
JP2 => '(\0\0\0\x0cjP( |\x1a\x1a)\x0d\x0a\x87\x0a|\xff\x4f\xff\x51\0)', |
933
|
|
|
|
|
|
|
JPEG => '\xff\xd8\xff', |
934
|
|
|
|
|
|
|
JSON => '(\xef\xbb\xbf)?\s*(\[\s*)?\{\s*"[^"]*"\s*:', |
935
|
|
|
|
|
|
|
JXL => '\xff\x0a|\0\0\0\x0cJXL \x0d\x0a......ftypjxl ', |
936
|
|
|
|
|
|
|
LFP => '\x89LFP\x0d\x0a\x1a\x0a', |
937
|
|
|
|
|
|
|
LIF => '\x70\0{3}.{4}\x2a.{4}<\0', |
938
|
|
|
|
|
|
|
LNK => '.{4}\x01\x14\x02\0{5}\xc0\0{6}\x46', |
939
|
|
|
|
|
|
|
LRI => 'LELR \0', |
940
|
|
|
|
|
|
|
M2TS => '(....)?\x47', |
941
|
|
|
|
|
|
|
MacOS=> '\0\x05\x16\x07\0.\0\0Mac OS X ', |
942
|
|
|
|
|
|
|
MIE => '~[\x10\x18]\x04.0MIE', |
943
|
|
|
|
|
|
|
MIFF => 'id=ImageMagick', |
944
|
|
|
|
|
|
|
MKV => '\x1a\x45\xdf\xa3', |
945
|
|
|
|
|
|
|
MOV => '.{4}(free|skip|wide|ftyp|pnot|PICT|pict|moov|mdat|junk|uuid)', # (duplicated in WriteQuickTime.pl !!) |
946
|
|
|
|
|
|
|
# MP3 => difficult to rule out |
947
|
|
|
|
|
|
|
MPC => '(MP\+|ID3)', |
948
|
|
|
|
|
|
|
MOI => 'V6', |
949
|
|
|
|
|
|
|
MPEG => '\0\0\x01[\xb0-\xbf]', |
950
|
|
|
|
|
|
|
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', |
951
|
|
|
|
|
|
|
MRW => '\0MR[MI]', |
952
|
|
|
|
|
|
|
MXF => '\x06\x0e\x2b\x34\x02\x05\x01\x01\x0d\x01\x02', # (not tested if extension recognized) |
953
|
|
|
|
|
|
|
OGG => '(OggS|ID3)', |
954
|
|
|
|
|
|
|
ORF => '(II|MM)', |
955
|
|
|
|
|
|
|
# PCD => signature is at byte 2048 |
956
|
|
|
|
|
|
|
PCX => '\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]', |
957
|
|
|
|
|
|
|
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)', |
958
|
|
|
|
|
|
|
PDF => '\s*%PDF-\d+\.\d+', |
959
|
|
|
|
|
|
|
PFM => 'P[Ff]\x0a\d+ \d+\x0a[-+0-9.]+\x0a', |
960
|
|
|
|
|
|
|
PGF => 'PGF', |
961
|
|
|
|
|
|
|
PHP => '<\?php\s', |
962
|
|
|
|
|
|
|
PICT => '(.{10}|.{522})(\x11\x01|\x00\x11)', |
963
|
|
|
|
|
|
|
PLIST=> '(bplist0|\s*<|\xfe\xff\x00)', |
964
|
|
|
|
|
|
|
PMP => '.{8}\0{3}\x7c.{112}\xff\xd8\xff\xdb', |
965
|
|
|
|
|
|
|
PNG => '(\x89P|\x8aM|\x8bJ)NG\r\n\x1a\n', |
966
|
|
|
|
|
|
|
PPM => 'P[1-6]\s+', |
967
|
|
|
|
|
|
|
PS => '(%!PS|%!Ad|\xc5\xd0\xd3\xc6)', |
968
|
|
|
|
|
|
|
PSD => '8BPS\0[\x01\x02]', |
969
|
|
|
|
|
|
|
PSP => 'Paint Shop Pro Image File\x0a\x1a\0{5}', |
970
|
|
|
|
|
|
|
QTIF => '.{4}(idsc|idat|iicc)', |
971
|
|
|
|
|
|
|
R3D => '\0\0..RED(1|2)', |
972
|
|
|
|
|
|
|
RAF => 'FUJIFILM', |
973
|
|
|
|
|
|
|
RAR => 'Rar!\x1a\x07\0', |
974
|
|
|
|
|
|
|
RAW => '(.{25}ARECOYK|II|MM)', |
975
|
|
|
|
|
|
|
Real => '(\.RMF|\.ra\xfd|pnm://|rtsp://|http://)', |
976
|
|
|
|
|
|
|
RIFF => '(RIFF|LA0[234]|OFR |LPAC|wvpk|RF64)', # RIFF plus other variants |
977
|
|
|
|
|
|
|
RSRC => '(....)?\0\0\x01\0', |
978
|
|
|
|
|
|
|
RTF => '[\n\r]*\\{[\n\r]*\\\\rtf', |
979
|
|
|
|
|
|
|
RWZ => 'rawzor', |
980
|
|
|
|
|
|
|
SWF => '[FC]WS[^\0]', |
981
|
|
|
|
|
|
|
TAR => '.{257}ustar( )?\0', # (this doesn't catch old-style tar files) |
982
|
|
|
|
|
|
|
TXT => '(\xff\xfe|(\0\0)?\xfe\xff|(\xef\xbb\xbf)?[\x07-\x0d\x20-\x7e\x80-\xfe]*$)', |
983
|
|
|
|
|
|
|
TIFF => '(II|MM)', # don't test magic number (some raw formats are different) |
984
|
|
|
|
|
|
|
VCard=> '(?i)BEGIN:(VCARD|VCALENDAR|VNOTE)\r\n', |
985
|
|
|
|
|
|
|
VRD => 'CANON OPTIONAL DATA\0', |
986
|
|
|
|
|
|
|
WMF => '(\xd7\xcd\xc6\x9a\0\0|\x01\0\x09\0\0\x03)', |
987
|
|
|
|
|
|
|
WTV => '\xb7\xd8\x00\x20\x37\x49\xda\x11\xa6\x4e\x00\x07\xe9\x5e\xad\x8d', |
988
|
|
|
|
|
|
|
X3F => 'FOVb', |
989
|
|
|
|
|
|
|
XCF => 'gimp xcf ', |
990
|
|
|
|
|
|
|
XMP => '\0{0,3}(\xfe\xff|\xff\xfe|\xef\xbb\xbf)?\0{0,3}\s*<', |
991
|
|
|
|
|
|
|
ZIP => 'PK\x03\x04', |
992
|
|
|
|
|
|
|
); |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
# file types with weak magic number recognition |
995
|
|
|
|
|
|
|
my %weakMagic = ( MP3 => 1 ); |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# file types that are determined by the process proc when FastScan == 3 |
998
|
|
|
|
|
|
|
# (when done, the process proc must exit after SetFileType if FastScan is 3) |
999
|
|
|
|
|
|
|
my %processType = map { $_ => 1 } qw(JPEG TIFF XMP AIFF EXE Font PS Real VCard TXT); |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# Compact/XMPShorthand option settings |
1002
|
|
|
|
|
|
|
my %compactOpt = ( |
1003
|
|
|
|
|
|
|
nopadding => 'NoPadding', noindent => 'NoIndent', nonewline => 'NoNewline', |
1004
|
|
|
|
|
|
|
shorthand => 'Shorthand', onedesc => 'OneDesc', |
1005
|
|
|
|
|
|
|
all => ['NoPadding','NoIndent','NoNewline','Shorthand','OneDesc'], |
1006
|
|
|
|
|
|
|
allspace => ['NoPadding','NoIndent','NoNewline'], allformat => ['Shorthand','OneDesc'], |
1007
|
|
|
|
|
|
|
# aliases to cover anticipated user typos |
1008
|
|
|
|
|
|
|
nonewlines => 'NoNewline', nospace => 'NoIndent', nospaces => 'NoIndent', |
1009
|
|
|
|
|
|
|
nopad => 'NoPadding', onedescr => 'OneDesc', |
1010
|
|
|
|
|
|
|
# allow numerical settings for backward compatibility |
1011
|
|
|
|
|
|
|
0 => 'None', |
1012
|
|
|
|
|
|
|
1 => 'NoPadding', |
1013
|
|
|
|
|
|
|
2 => ['NoPadding','NoIndent'], |
1014
|
|
|
|
|
|
|
3 => ['NoPadding','NoIndent','OneDesc'], |
1015
|
|
|
|
|
|
|
4 => ['NoPadding','NoIndent','OneDesc','NoNewline'], |
1016
|
|
|
|
|
|
|
5 => ['NoPadding','NoIndent','OneDesc','NoNewline','Shorthand'], |
1017
|
|
|
|
|
|
|
); |
1018
|
|
|
|
|
|
|
my %xmpShorthandOpt = ( 0 => 'None', 1 => 'Shorthand', 2 => ['Shorthand','OneDesc'] ); |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
# lookup for valid character set names (keys are all lower case) |
1021
|
|
|
|
|
|
|
%charsetName = ( |
1022
|
|
|
|
|
|
|
# Charset setting alias(es) |
1023
|
|
|
|
|
|
|
# ------------------------- -------------------------------------------- |
1024
|
|
|
|
|
|
|
utf8 => 'UTF8', cp65001 => 'UTF8', 'utf-8' => 'UTF8', |
1025
|
|
|
|
|
|
|
latin => 'Latin', cp1252 => 'Latin', latin1 => 'Latin', |
1026
|
|
|
|
|
|
|
latin2 => 'Latin2', cp1250 => 'Latin2', |
1027
|
|
|
|
|
|
|
cyrillic => 'Cyrillic', cp1251 => 'Cyrillic', russian => 'Cyrillic', |
1028
|
|
|
|
|
|
|
greek => 'Greek', cp1253 => 'Greek', |
1029
|
|
|
|
|
|
|
turkish => 'Turkish', cp1254 => 'Turkish', |
1030
|
|
|
|
|
|
|
hebrew => 'Hebrew', cp1255 => 'Hebrew', |
1031
|
|
|
|
|
|
|
arabic => 'Arabic', cp1256 => 'Arabic', |
1032
|
|
|
|
|
|
|
baltic => 'Baltic', cp1257 => 'Baltic', |
1033
|
|
|
|
|
|
|
vietnam => 'Vietnam', cp1258 => 'Vietnam', |
1034
|
|
|
|
|
|
|
thai => 'Thai', cp874 => 'Thai', |
1035
|
|
|
|
|
|
|
doslatinus => 'DOSLatinUS', cp437 => 'DOSLatinUS', |
1036
|
|
|
|
|
|
|
doslatin1 => 'DOSLatin1', cp850 => 'DOSLatin1', |
1037
|
|
|
|
|
|
|
doscyrillic => 'DOSCyrillic', cp866 => 'DOSCyrillic', |
1038
|
|
|
|
|
|
|
macroman => 'MacRoman', cp10000 => 'MacRoman', mac => 'MacRoman', roman => 'MacRoman', |
1039
|
|
|
|
|
|
|
maclatin2 => 'MacLatin2', cp10029 => 'MacLatin2', |
1040
|
|
|
|
|
|
|
maccyrillic => 'MacCyrillic', cp10007 => 'MacCyrillic', |
1041
|
|
|
|
|
|
|
macgreek => 'MacGreek', cp10006 => 'MacGreek', |
1042
|
|
|
|
|
|
|
macturkish => 'MacTurkish', cp10081 => 'MacTurkish', |
1043
|
|
|
|
|
|
|
macromanian => 'MacRomanian', cp10010 => 'MacRomanian', |
1044
|
|
|
|
|
|
|
maciceland => 'MacIceland', cp10079 => 'MacIceland', |
1045
|
|
|
|
|
|
|
maccroatian => 'MacCroatian', cp10082 => 'MacCroatian', |
1046
|
|
|
|
|
|
|
); |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
# default family 0 group priority for writing |
1049
|
|
|
|
|
|
|
# (NOTE: tags in groups not specified here will not be written unless |
1050
|
|
|
|
|
|
|
# overridden by the module or specified when writing) |
1051
|
|
|
|
|
|
|
my @defaultWriteGroups = qw( |
1052
|
|
|
|
|
|
|
EXIF IPTC XMP MakerNotes QuickTime Photoshop ICC_Profile CanonVRD Adobe |
1053
|
|
|
|
|
|
|
); |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
# group hash for ExifTool-generated tags |
1056
|
|
|
|
|
|
|
my %allGroupsExifTool = ( 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'ExifTool' ); |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
# special tag names (not used for tag info) |
1059
|
|
|
|
|
|
|
%specialTags = map { $_ => 1 } qw( |
1060
|
|
|
|
|
|
|
TABLE_NAME SHORT_NAME PROCESS_PROC WRITE_PROC CHECK_PROC |
1061
|
|
|
|
|
|
|
GROUPS FORMAT FIRST_ENTRY TAG_PREFIX PRINT_CONV |
1062
|
|
|
|
|
|
|
WRITABLE TABLE_DESC NOTES IS_OFFSET IS_SUBDIR |
1063
|
|
|
|
|
|
|
EXTRACT_UNKNOWN NAMESPACE PREFERRED SRC_TABLE PRIORITY |
1064
|
|
|
|
|
|
|
AVOID WRITE_GROUP LANG_INFO VARS DATAMEMBER |
1065
|
|
|
|
|
|
|
SET_GROUP1 PERMANENT INIT_TABLE |
1066
|
|
|
|
|
|
|
); |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
# headers for various segment types |
1069
|
|
|
|
|
|
|
$exifAPP1hdr = "Exif\0\0"; |
1070
|
|
|
|
|
|
|
$xmpAPP1hdr = "http://ns.adobe.com/xap/1.0/\0"; |
1071
|
|
|
|
|
|
|
$xmpExtAPP1hdr = "http://ns.adobe.com/xmp/extension/\0"; |
1072
|
|
|
|
|
|
|
$psAPP13hdr = "Photoshop 3.0\0"; |
1073
|
|
|
|
|
|
|
$psAPP13old = 'Adobe_Photoshop2.5:'; |
1074
|
|
|
|
|
|
|
|
1075
|
761
|
|
|
761
|
0
|
2971
|
sub DummyWriteProc { return 1; } |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
# lookup for user lenses defined in @Image::ExifTool::UserDefined::Lenses |
1078
|
|
|
|
|
|
|
%Image::ExifTool::userLens = ( ); |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
# queued plug-in tags to add to lookup |
1081
|
|
|
|
|
|
|
@Image::ExifTool::pluginTags = ( ); |
1082
|
|
|
|
|
|
|
%Image::ExifTool::pluginTags = ( ); |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
my %systemTagsNotes = ( |
1085
|
|
|
|
|
|
|
Notes => q{ |
1086
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1087
|
|
|
|
|
|
|
option is set |
1088
|
|
|
|
|
|
|
}, |
1089
|
|
|
|
|
|
|
); |
1090
|
|
|
|
|
|
|
|
1091
|
|
|
|
|
|
|
# tag information for preview image -- this should be used for all |
1092
|
|
|
|
|
|
|
# PreviewImage tags so they are handled properly when reading/writing |
1093
|
|
|
|
|
|
|
%Image::ExifTool::previewImageTagInfo = ( |
1094
|
|
|
|
|
|
|
Name => 'PreviewImage', |
1095
|
|
|
|
|
|
|
Writable => 'undef', |
1096
|
|
|
|
|
|
|
# a value of 'none' is ok... |
1097
|
|
|
|
|
|
|
WriteCheck => '$val eq "none" ? undef : $self->CheckImage(\$val)', |
1098
|
|
|
|
|
|
|
DataTag => 'PreviewImage', |
1099
|
|
|
|
|
|
|
# accept either scalar or scalar reference |
1100
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1101
|
|
|
|
|
|
|
# we allow preview image to be set to '', but we don't want a zero-length value |
1102
|
|
|
|
|
|
|
# in the IFD, so set it temporarily to 'none'. Note that the length is <= 4, |
1103
|
|
|
|
|
|
|
# so this value will fit in the IFD so the preview fixup won't be generated. |
1104
|
|
|
|
|
|
|
ValueConvInv => '$val eq "" and $val="none"; $val', |
1105
|
|
|
|
|
|
|
); |
1106
|
|
|
|
|
|
|
|
1107
|
|
|
|
|
|
|
# extra tags that aren't truly EXIF tags, but are generated by the script |
1108
|
|
|
|
|
|
|
# Note: any tag in this list with a name corresponding to a Group0 name is |
1109
|
|
|
|
|
|
|
# used to write the entire corresponding directory as a block. |
1110
|
|
|
|
|
|
|
%Image::ExifTool::Extra = ( |
1111
|
|
|
|
|
|
|
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, |
1112
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags |
1113
|
|
|
|
|
|
|
WRITE_PROC => \&DummyWriteProc, |
1114
|
|
|
|
|
|
|
Error => { |
1115
|
|
|
|
|
|
|
Priority => 0, |
1116
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1117
|
|
|
|
|
|
|
Notes => q{ |
1118
|
|
|
|
|
|
|
returns errors that may have occurred while reading or writing a file. Any |
1119
|
|
|
|
|
|
|
Error will prevent the file from being processed. Minor errors may be |
1120
|
|
|
|
|
|
|
downgraded to warnings with the -m or L option |
1121
|
|
|
|
|
|
|
}, |
1122
|
|
|
|
|
|
|
}, |
1123
|
|
|
|
|
|
|
Warning => { |
1124
|
|
|
|
|
|
|
Priority => 0, |
1125
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1126
|
|
|
|
|
|
|
Notes => q{ |
1127
|
|
|
|
|
|
|
returns warnings that may have occurred while reading or writing a file. |
1128
|
|
|
|
|
|
|
Use the -a or L option to see all warnings if more than one |
1129
|
|
|
|
|
|
|
occurred. Minor warnings may be ignored with the -m or L |
1130
|
|
|
|
|
|
|
option. Minor warnings with a capital "M" in the "[Minor]" designation |
1131
|
|
|
|
|
|
|
indicate that the processing is affected by ignoring the warning |
1132
|
|
|
|
|
|
|
}, |
1133
|
|
|
|
|
|
|
}, |
1134
|
|
|
|
|
|
|
Comment => { |
1135
|
|
|
|
|
|
|
Notes => 'comment embedded in JPEG, GIF89a or PPM/PGM/PBM image', |
1136
|
|
|
|
|
|
|
Writable => 1, |
1137
|
|
|
|
|
|
|
WriteGroup => 'Comment', |
1138
|
|
|
|
|
|
|
Priority => 0, # to preserve order of JPEG COM segments |
1139
|
|
|
|
|
|
|
}, |
1140
|
|
|
|
|
|
|
Directory => { |
1141
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1142
|
|
|
|
|
|
|
Notes => q{ |
1143
|
|
|
|
|
|
|
the directory of the file as specified in the call to ExifTool, or "." if no |
1144
|
|
|
|
|
|
|
directory was specified. May be written to move the file to another |
1145
|
|
|
|
|
|
|
directory that will be created if doesn't already exist |
1146
|
|
|
|
|
|
|
}, |
1147
|
|
|
|
|
|
|
Writable => 1, |
1148
|
|
|
|
|
|
|
WritePseudo => 1, |
1149
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1150
|
|
|
|
|
|
|
Protected => 1, |
1151
|
|
|
|
|
|
|
RawConv => '$self->ConvertFileName($val)', |
1152
|
|
|
|
|
|
|
# translate backslashes in directory names and add trailing '/' |
1153
|
|
|
|
|
|
|
ValueConvInv => '$_ = $self->InverseFileName($val); m{[^/]$} and $_ .= "/"; $_', |
1154
|
|
|
|
|
|
|
}, |
1155
|
|
|
|
|
|
|
FileName => { |
1156
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1157
|
|
|
|
|
|
|
Writable => 1, |
1158
|
|
|
|
|
|
|
WritePseudo => 1, |
1159
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1160
|
|
|
|
|
|
|
Protected => 1, |
1161
|
|
|
|
|
|
|
Notes => q{ |
1162
|
|
|
|
|
|
|
may be written with a full path name to set FileName and Directory in one |
1163
|
|
|
|
|
|
|
operation. This is such a powerful feature that a TestName tag is provided |
1164
|
|
|
|
|
|
|
to allow dry-run tests before actually writing the file name. See |
1165
|
|
|
|
|
|
|
L for more information on writing the |
1166
|
|
|
|
|
|
|
FileName, Directory and TestName tags |
1167
|
|
|
|
|
|
|
}, |
1168
|
|
|
|
|
|
|
RawConv => '$self->ConvertFileName($val)', |
1169
|
|
|
|
|
|
|
ValueConvInv => '$self->InverseFileName($val)', |
1170
|
|
|
|
|
|
|
}, |
1171
|
|
|
|
|
|
|
BaseName => { |
1172
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1173
|
|
|
|
|
|
|
Notes => q{ |
1174
|
|
|
|
|
|
|
file name without extension. Not generated unless specifically requested or |
1175
|
|
|
|
|
|
|
the API L option is set |
1176
|
|
|
|
|
|
|
}, |
1177
|
|
|
|
|
|
|
}, |
1178
|
|
|
|
|
|
|
FilePath => { |
1179
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1180
|
|
|
|
|
|
|
Notes => q{ |
1181
|
|
|
|
|
|
|
absolute path of source file. Not generated unless specifically requested or |
1182
|
|
|
|
|
|
|
the API L option is set. Does not support Windows Unicode file |
1183
|
|
|
|
|
|
|
names |
1184
|
|
|
|
|
|
|
}, |
1185
|
|
|
|
|
|
|
}, |
1186
|
|
|
|
|
|
|
TestName => { |
1187
|
|
|
|
|
|
|
Writable => 1, |
1188
|
|
|
|
|
|
|
WritePseudo => 1, |
1189
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1190
|
|
|
|
|
|
|
Protected => 1, |
1191
|
|
|
|
|
|
|
WriteOnly => 1, |
1192
|
|
|
|
|
|
|
Notes => q{ |
1193
|
|
|
|
|
|
|
this write-only tag may be used instead of FileName for dry-run tests of the |
1194
|
|
|
|
|
|
|
file renaming feature. Writing this tag prints the old and new file names |
1195
|
|
|
|
|
|
|
to the console, but does not affect the file itself |
1196
|
|
|
|
|
|
|
}, |
1197
|
|
|
|
|
|
|
ValueConvInv => '$self->InverseFileName($val)', |
1198
|
|
|
|
|
|
|
}, |
1199
|
|
|
|
|
|
|
FileSequence => { |
1200
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1201
|
|
|
|
|
|
|
Notes => q{ |
1202
|
|
|
|
|
|
|
sequence number for each source file when extracting or copying information, |
1203
|
|
|
|
|
|
|
including files that fail the -if condition of the command-line application, |
1204
|
|
|
|
|
|
|
beginning at 0 for the first file. Not generated unless specifically |
1205
|
|
|
|
|
|
|
requested or the API L option is set |
1206
|
|
|
|
|
|
|
}, |
1207
|
|
|
|
|
|
|
}, |
1208
|
|
|
|
|
|
|
FileSize => { |
1209
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1210
|
|
|
|
|
|
|
Notes => q{ |
1211
|
|
|
|
|
|
|
note that the print conversion for this tag uses historic prefixes: 1 kB = |
1212
|
|
|
|
|
|
|
1024 bytes, etc. |
1213
|
|
|
|
|
|
|
}, |
1214
|
|
|
|
|
|
|
PrintConv => \&ConvertFileSize, |
1215
|
|
|
|
|
|
|
}, |
1216
|
|
|
|
|
|
|
ResourceForkSize => { |
1217
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1218
|
|
|
|
|
|
|
Notes => q{ |
1219
|
|
|
|
|
|
|
size of the file's resource fork if it contains data. Mac OS only. If this |
1220
|
|
|
|
|
|
|
tag is generated the L option may be used to extract |
1221
|
|
|
|
|
|
|
resource-fork information as a sub-document. When writing, the resource |
1222
|
|
|
|
|
|
|
fork is preserved by default, but it may be deleted with C<-rsrc:all=> on |
1223
|
|
|
|
|
|
|
the command line |
1224
|
|
|
|
|
|
|
}, |
1225
|
|
|
|
|
|
|
PrintConv => \&ConvertFileSize, |
1226
|
|
|
|
|
|
|
}, |
1227
|
|
|
|
|
|
|
ZoneIdentifier => { |
1228
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1229
|
|
|
|
|
|
|
Notes => q{ |
1230
|
|
|
|
|
|
|
Windows only. Existence indicates that the file has a Zone.Identifier |
1231
|
|
|
|
|
|
|
alternate data stream, which is used by some Windows browsers to mark |
1232
|
|
|
|
|
|
|
downloaded files as possibly unsafe to run. May be deleted to remove this |
1233
|
|
|
|
|
|
|
stream. Requires Win32API::File |
1234
|
|
|
|
|
|
|
}, |
1235
|
|
|
|
|
|
|
Writable => 1, |
1236
|
|
|
|
|
|
|
WritePseudo => 1, |
1237
|
|
|
|
|
|
|
Protected => 1, |
1238
|
|
|
|
|
|
|
}, |
1239
|
|
|
|
|
|
|
FileType => { |
1240
|
|
|
|
|
|
|
Groups => { 2 => 'Other' }, |
1241
|
|
|
|
|
|
|
Notes => q{ |
1242
|
|
|
|
|
|
|
a short description of the file type. For many file types this is the just |
1243
|
|
|
|
|
|
|
the uppercase file extension |
1244
|
|
|
|
|
|
|
}, |
1245
|
|
|
|
|
|
|
}, |
1246
|
|
|
|
|
|
|
FileTypeExtension => { |
1247
|
|
|
|
|
|
|
Groups => { 2 => 'Other' }, |
1248
|
|
|
|
|
|
|
Notes => q{ |
1249
|
|
|
|
|
|
|
a common lowercase extension for this file type, or uppercase with the -n |
1250
|
|
|
|
|
|
|
option |
1251
|
|
|
|
|
|
|
}, |
1252
|
|
|
|
|
|
|
PrintConv => 'lc $val', |
1253
|
|
|
|
|
|
|
}, |
1254
|
|
|
|
|
|
|
FileModifyDate => { |
1255
|
|
|
|
|
|
|
Description => 'File Modification Date/Time', |
1256
|
|
|
|
|
|
|
Notes => q{ |
1257
|
|
|
|
|
|
|
the filesystem modification date/time. Note that ExifTool may not be able |
1258
|
|
|
|
|
|
|
to handle filesystem dates before 1970 depending on the limitations of the |
1259
|
|
|
|
|
|
|
system's standard libraries |
1260
|
|
|
|
|
|
|
}, |
1261
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1262
|
|
|
|
|
|
|
Writable => 1, |
1263
|
|
|
|
|
|
|
WritePseudo => 1, |
1264
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1265
|
|
|
|
|
|
|
# all writable pseudo-tags must be protected so -tagsfromfile fails with |
1266
|
|
|
|
|
|
|
# unrecognized files unless a pseudo tag is specified explicitly |
1267
|
|
|
|
|
|
|
Protected => 1, |
1268
|
|
|
|
|
|
|
Shift => 'Time', |
1269
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1270
|
|
|
|
|
|
|
ValueConvInv => 'GetUnixTime($val,1)', |
1271
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1272
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
1273
|
|
|
|
|
|
|
}, |
1274
|
|
|
|
|
|
|
FileAccessDate => { |
1275
|
|
|
|
|
|
|
Description => 'File Access Date/Time', |
1276
|
|
|
|
|
|
|
Notes => q{ |
1277
|
|
|
|
|
|
|
the date/time of last access of the file. Note that this access time is |
1278
|
|
|
|
|
|
|
updated whenever any software, including ExifTool, reads the file |
1279
|
|
|
|
|
|
|
}, |
1280
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1281
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1282
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1283
|
|
|
|
|
|
|
}, |
1284
|
|
|
|
|
|
|
FileCreateDate => { |
1285
|
|
|
|
|
|
|
Description => 'File Creation Date/Time', |
1286
|
|
|
|
|
|
|
Notes => q{ |
1287
|
|
|
|
|
|
|
the filesystem creation date/time. Windows/Mac only. In Windows, the file |
1288
|
|
|
|
|
|
|
creation date/time is preserved by default when writing if Win32API::File |
1289
|
|
|
|
|
|
|
and Win32::API are available. On Mac, this tag is extracted only if it or |
1290
|
|
|
|
|
|
|
the MacOS group is specifically requested or the API L option is |
1291
|
|
|
|
|
|
|
set to 2 or higher. Requires "setfile" for writing on Mac, which may be |
1292
|
|
|
|
|
|
|
installed by typing C in the Terminal |
1293
|
|
|
|
|
|
|
}, |
1294
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1295
|
|
|
|
|
|
|
Writable => 1, |
1296
|
|
|
|
|
|
|
WritePseudo => 1, |
1297
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1298
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1299
|
|
|
|
|
|
|
Shift => 'Time', |
1300
|
|
|
|
|
|
|
ValueConv => '$^O eq "darwin" ? $val : ConvertUnixTime($val,1)', |
1301
|
|
|
|
|
|
|
ValueConvInv => q{ |
1302
|
|
|
|
|
|
|
return GetUnixTime($val,1) if $^O eq 'MSWin32'; |
1303
|
|
|
|
|
|
|
return $val if $^O eq 'darwin'; |
1304
|
|
|
|
|
|
|
warn "This tag is Windows/Mac only\n"; |
1305
|
|
|
|
|
|
|
return undef; |
1306
|
|
|
|
|
|
|
}, |
1307
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1308
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
1309
|
|
|
|
|
|
|
}, |
1310
|
|
|
|
|
|
|
FileInodeChangeDate => { |
1311
|
|
|
|
|
|
|
Description => 'File Inode Change Date/Time', |
1312
|
|
|
|
|
|
|
Notes => q{ |
1313
|
|
|
|
|
|
|
the date/time when the file's directory information was last changed. |
1314
|
|
|
|
|
|
|
Non-Windows systems only |
1315
|
|
|
|
|
|
|
}, |
1316
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Time' }, |
1317
|
|
|
|
|
|
|
ValueConv => 'ConvertUnixTime($val,1)', |
1318
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1319
|
|
|
|
|
|
|
}, |
1320
|
|
|
|
|
|
|
FilePermissions => { |
1321
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1322
|
|
|
|
|
|
|
Notes => q{ |
1323
|
|
|
|
|
|
|
r=read, w=write and x=execute permissions for the file owner, group and |
1324
|
|
|
|
|
|
|
others. The ValueConv value is an octal number so bit test operations on |
1325
|
|
|
|
|
|
|
this value should be done in octal, eg. 'oct($filePermissions#) & 0200' |
1326
|
|
|
|
|
|
|
}, |
1327
|
|
|
|
|
|
|
Writable => 1, |
1328
|
|
|
|
|
|
|
WritePseudo => 1, |
1329
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1330
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1331
|
|
|
|
|
|
|
ValueConv => 'sprintf("%.3o", $val)', |
1332
|
|
|
|
|
|
|
ValueConvInv => 'oct($val & 07777)', |
1333
|
|
|
|
|
|
|
PrintConv => sub { |
1334
|
|
|
|
|
|
|
my ($mask, $val) = (0400, oct(shift)); |
1335
|
|
|
|
|
|
|
my %types = ( |
1336
|
|
|
|
|
|
|
0010000 => 'p', |
1337
|
|
|
|
|
|
|
0020000 => 'c', |
1338
|
|
|
|
|
|
|
0040000 => 'd', |
1339
|
|
|
|
|
|
|
0060000 => 'b', |
1340
|
|
|
|
|
|
|
0120000 => 'l', |
1341
|
|
|
|
|
|
|
0140000 => 's', |
1342
|
|
|
|
|
|
|
); |
1343
|
|
|
|
|
|
|
my $str = $types{$val & 0170000} || '-'; |
1344
|
|
|
|
|
|
|
while ($mask) { |
1345
|
|
|
|
|
|
|
foreach (qw(r w x)) { |
1346
|
|
|
|
|
|
|
$str .= $val & $mask ? $_ : '-'; |
1347
|
|
|
|
|
|
|
$mask >>= 1; |
1348
|
|
|
|
|
|
|
} |
1349
|
|
|
|
|
|
|
} |
1350
|
|
|
|
|
|
|
return $str; |
1351
|
|
|
|
|
|
|
}, |
1352
|
|
|
|
|
|
|
PrintConvInv => sub { |
1353
|
|
|
|
|
|
|
my ($bit, $val, $str) = (8, 0, shift); |
1354
|
|
|
|
|
|
|
$str = substr($str, 1) if length($str) == 10; |
1355
|
|
|
|
|
|
|
return undef if length($str) != 9; |
1356
|
|
|
|
|
|
|
while ($bit >= 0) { |
1357
|
|
|
|
|
|
|
foreach (qw(r w x)) { |
1358
|
|
|
|
|
|
|
$val |= (1 << $bit) if substr($str, 8-$bit, 1) eq $_; |
1359
|
|
|
|
|
|
|
--$bit; |
1360
|
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
return sprintf('%.3o', $val); |
1363
|
|
|
|
|
|
|
}, |
1364
|
|
|
|
|
|
|
}, |
1365
|
|
|
|
|
|
|
FileAttributes => { |
1366
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1367
|
|
|
|
|
|
|
Notes => q{ |
1368
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1369
|
|
|
|
|
|
|
option is set. 2 or 3 values: 0. File type, 1. Attribute bits, 2. Windows |
1370
|
|
|
|
|
|
|
attribute bits if Win32API::File is available |
1371
|
|
|
|
|
|
|
}, |
1372
|
|
|
|
|
|
|
PrintHex => 1, |
1373
|
|
|
|
|
|
|
PrintConvColumns => 2, |
1374
|
|
|
|
|
|
|
PrintConv => [{ # stat device types (bitmask 0xf000) |
1375
|
|
|
|
|
|
|
0x0000 => 'Unknown', |
1376
|
|
|
|
|
|
|
0x1000 => 'FIFO', |
1377
|
|
|
|
|
|
|
0x2000 => 'Character', |
1378
|
|
|
|
|
|
|
0x3000 => 'Mux Character', |
1379
|
|
|
|
|
|
|
0x4000 => 'Directory', |
1380
|
|
|
|
|
|
|
0x5000 => 'XENIX Named', |
1381
|
|
|
|
|
|
|
0x6000 => 'Block', |
1382
|
|
|
|
|
|
|
0x7000 => 'Mux Block', |
1383
|
|
|
|
|
|
|
0x8000 => 'Regular', |
1384
|
|
|
|
|
|
|
0x9000 => 'VxFS Compressed', |
1385
|
|
|
|
|
|
|
0xa000 => 'Symbolic Link', |
1386
|
|
|
|
|
|
|
0xb000 => 'Solaris Shadow Inode', |
1387
|
|
|
|
|
|
|
0xc000 => 'Socket', |
1388
|
|
|
|
|
|
|
0xd000 => 'Solaris Door', |
1389
|
|
|
|
|
|
|
0xe000 => 'BSD Whiteout', |
1390
|
|
|
|
|
|
|
},{ BITMASK => { # stat attribute bits (bitmask 0x0e00) |
1391
|
|
|
|
|
|
|
9 => 'Sticky', |
1392
|
|
|
|
|
|
|
10 => 'Set Group ID', |
1393
|
|
|
|
|
|
|
11 => 'Set User ID', |
1394
|
|
|
|
|
|
|
}},{ BITMASK => { # Windows attribute bits |
1395
|
|
|
|
|
|
|
0 => 'Read Only', |
1396
|
|
|
|
|
|
|
1 => 'Hidden', |
1397
|
|
|
|
|
|
|
2 => 'System', |
1398
|
|
|
|
|
|
|
3 => 'Volume Label', |
1399
|
|
|
|
|
|
|
4 => 'Directory', |
1400
|
|
|
|
|
|
|
5 => 'Archive', |
1401
|
|
|
|
|
|
|
6 => 'Device', |
1402
|
|
|
|
|
|
|
7 => 'Normal', |
1403
|
|
|
|
|
|
|
8 => 'Temporary', |
1404
|
|
|
|
|
|
|
9 => 'Sparse File', |
1405
|
|
|
|
|
|
|
10 => 'Reparse Point', |
1406
|
|
|
|
|
|
|
11 => 'Compressed', |
1407
|
|
|
|
|
|
|
12 => 'Offline', |
1408
|
|
|
|
|
|
|
13 => 'Not Content Indexed', |
1409
|
|
|
|
|
|
|
14 => 'Encrypted', |
1410
|
|
|
|
|
|
|
}}], |
1411
|
|
|
|
|
|
|
}, |
1412
|
|
|
|
|
|
|
FileDeviceID => { |
1413
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1414
|
|
|
|
|
|
|
%systemTagsNotes, |
1415
|
|
|
|
|
|
|
PrintConv => '(($val >> 24) & 0xff) . "." . ($val & 0xffffff)', # (major.minor) |
1416
|
|
|
|
|
|
|
}, |
1417
|
|
|
|
|
|
|
FileDeviceNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1418
|
|
|
|
|
|
|
FileInodeNumber => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1419
|
|
|
|
|
|
|
FileHardLinks => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1420
|
|
|
|
|
|
|
FileUserID => { |
1421
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1422
|
|
|
|
|
|
|
Notes => q{ |
1423
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1424
|
|
|
|
|
|
|
option is set. Returns user ID number with the -n option, or name |
1425
|
|
|
|
|
|
|
otherwise. May be written with either user name or number |
1426
|
|
|
|
|
|
|
}, |
1427
|
|
|
|
|
|
|
Writable => 1, |
1428
|
|
|
|
|
|
|
WritePseudo => 1, |
1429
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1430
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1431
|
|
|
|
|
|
|
PrintConv => 'eval { getpwuid($val) } || $val', |
1432
|
|
|
|
|
|
|
PrintConvInv => 'eval { getpwnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', |
1433
|
|
|
|
|
|
|
}, |
1434
|
|
|
|
|
|
|
FileGroupID => { |
1435
|
|
|
|
|
|
|
Groups => { 1 => 'System', 2 => 'Other' }, |
1436
|
|
|
|
|
|
|
Notes => q{ |
1437
|
|
|
|
|
|
|
extracted only if specifically requested or the L or L API |
1438
|
|
|
|
|
|
|
option is set. Returns group ID number with the -n option, or name |
1439
|
|
|
|
|
|
|
otherwise. May be written with either group name or number |
1440
|
|
|
|
|
|
|
}, |
1441
|
|
|
|
|
|
|
Writable => 1, |
1442
|
|
|
|
|
|
|
WritePseudo => 1, |
1443
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1444
|
|
|
|
|
|
|
Protected => 1, # all writable pseudo-tags must be protected! |
1445
|
|
|
|
|
|
|
PrintConv => 'eval { getgrgid($val) } || $val', |
1446
|
|
|
|
|
|
|
PrintConvInv => 'eval { getgrnam($val) } || ($val=~/[^0-9]/ ? undef : $val)', |
1447
|
|
|
|
|
|
|
}, |
1448
|
|
|
|
|
|
|
FileBlockSize => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1449
|
|
|
|
|
|
|
FileBlockCount => { Groups => { 1 => 'System', 2 => 'Other' }, %systemTagsNotes }, |
1450
|
|
|
|
|
|
|
HardLink => { |
1451
|
|
|
|
|
|
|
Writable => 1, |
1452
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1453
|
|
|
|
|
|
|
WriteOnly => 1, |
1454
|
|
|
|
|
|
|
WritePseudo => 1, |
1455
|
|
|
|
|
|
|
Protected => 1, |
1456
|
|
|
|
|
|
|
Notes => q{ |
1457
|
|
|
|
|
|
|
this write-only tag is used to create a hard link with the specified name to |
1458
|
|
|
|
|
|
|
the source file. If the source file is edited, copied, renamed or moved in |
1459
|
|
|
|
|
|
|
the same operation as writing HardLink, then the link is made to the updated |
1460
|
|
|
|
|
|
|
file. Note that subsequent editing of either hard-linked file by exiftool |
1461
|
|
|
|
|
|
|
will break the link unless the -overwrite_original_in_place option is used |
1462
|
|
|
|
|
|
|
}, |
1463
|
|
|
|
|
|
|
ValueConvInv => '$val=~tr/\\\\/\//; $val', |
1464
|
|
|
|
|
|
|
}, |
1465
|
|
|
|
|
|
|
SymLink => { |
1466
|
|
|
|
|
|
|
Writable => 1, |
1467
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1468
|
|
|
|
|
|
|
WriteOnly => 1, |
1469
|
|
|
|
|
|
|
WritePseudo => 1, |
1470
|
|
|
|
|
|
|
Protected => 1, |
1471
|
|
|
|
|
|
|
Notes => q{ |
1472
|
|
|
|
|
|
|
this write-only tag is used to create a symbolic link with the specified |
1473
|
|
|
|
|
|
|
name to the source file. If the source file is edited, copied, renamed or |
1474
|
|
|
|
|
|
|
moved in the same operation as writing SymLink, then the link is made to the |
1475
|
|
|
|
|
|
|
updated file. The link uses an absolute path unless it is created in the |
1476
|
|
|
|
|
|
|
current working directory. Valid only for file systems that support |
1477
|
|
|
|
|
|
|
symbolic links. Note that subsequent editing of the file via the symbolic |
1478
|
|
|
|
|
|
|
link by exiftool will cause the link to be replaced by the edited file |
1479
|
|
|
|
|
|
|
without changing the original unless the -overwrite_original_in_place option |
1480
|
|
|
|
|
|
|
is used |
1481
|
|
|
|
|
|
|
}, |
1482
|
|
|
|
|
|
|
ValueConvInv => '$val=~tr/\\\\/\//; $val', |
1483
|
|
|
|
|
|
|
}, |
1484
|
|
|
|
|
|
|
MIMEType => { Notes => 'the MIME type of the source file', Groups => { 2 => 'Other' } }, |
1485
|
|
|
|
|
|
|
ImageWidth => { Notes => 'the width of the image in number of pixels' }, |
1486
|
|
|
|
|
|
|
ImageHeight => { Notes => 'the height of the image in number of pixels' }, |
1487
|
|
|
|
|
|
|
XResolution => { Notes => 'the horizontal pixel resolution' }, |
1488
|
|
|
|
|
|
|
YResolution => { Notes => 'the vertical pixel resolution' }, |
1489
|
|
|
|
|
|
|
MaxVal => { Notes => 'maximum pixel value in PPM or PGM image' }, |
1490
|
|
|
|
|
|
|
EXIF => { |
1491
|
|
|
|
|
|
|
Notes => q{ |
1492
|
|
|
|
|
|
|
the full EXIF data block from JPEG, PNG, JP2, MIE and MIFF images. This tag |
1493
|
|
|
|
|
|
|
is generated only if specifically requested |
1494
|
|
|
|
|
|
|
}, |
1495
|
|
|
|
|
|
|
Groups => { 0 => 'EXIF', 1 => 'EXIF' }, |
1496
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1497
|
|
|
|
|
|
|
WriteCheck => q{ |
1498
|
|
|
|
|
|
|
return undef if $val =~ /^(II\x2a\0|MM\0\x2a)/; |
1499
|
|
|
|
|
|
|
return 'Invalid EXIF data'; |
1500
|
|
|
|
|
|
|
}, |
1501
|
|
|
|
|
|
|
}, |
1502
|
|
|
|
|
|
|
IPTC => { |
1503
|
|
|
|
|
|
|
Notes => q{ |
1504
|
|
|
|
|
|
|
the full IPTC data block. This tag is generated only if specifically |
1505
|
|
|
|
|
|
|
requested |
1506
|
|
|
|
|
|
|
}, |
1507
|
|
|
|
|
|
|
Groups => { 0 => 'IPTC', 1 => 'IPTC' }, |
1508
|
|
|
|
|
|
|
Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], |
1509
|
|
|
|
|
|
|
Priority => 0, # so main IPTC (which hopefully comes first) takes priority |
1510
|
|
|
|
|
|
|
WriteCheck => q{ |
1511
|
|
|
|
|
|
|
return undef if $val =~ /^(\x1c|\0+$)/; |
1512
|
|
|
|
|
|
|
return 'Invalid IPTC data'; |
1513
|
|
|
|
|
|
|
}, |
1514
|
|
|
|
|
|
|
}, |
1515
|
|
|
|
|
|
|
XMP => { |
1516
|
|
|
|
|
|
|
Notes => q{ |
1517
|
|
|
|
|
|
|
the XMP data block, but note that extended XMP in JPEG images may be split |
1518
|
|
|
|
|
|
|
into multiple blocks. This tag is generated only if specifically requested |
1519
|
|
|
|
|
|
|
}, |
1520
|
|
|
|
|
|
|
Groups => { 0 => 'XMP', 1 => 'XMP' }, |
1521
|
|
|
|
|
|
|
Flags => ['Writable', 'Protected', 'Binary', 'DelGroup'], |
1522
|
|
|
|
|
|
|
Priority => 0, # so main xmp (which usually comes first) takes priority |
1523
|
|
|
|
|
|
|
WriteCheck => q{ |
1524
|
|
|
|
|
|
|
require Image::ExifTool::XMP; |
1525
|
|
|
|
|
|
|
return Image::ExifTool::XMP::CheckXMP($self, $tagInfo, \$val); |
1526
|
|
|
|
|
|
|
}, |
1527
|
|
|
|
|
|
|
}, |
1528
|
|
|
|
|
|
|
XML => { |
1529
|
|
|
|
|
|
|
Notes => 'the XML data block, extracted for some file types', |
1530
|
|
|
|
|
|
|
Groups => { 0 => 'XML', 1 => 'XML' }, |
1531
|
|
|
|
|
|
|
Binary => 1, |
1532
|
|
|
|
|
|
|
}, |
1533
|
|
|
|
|
|
|
ICC_Profile => { |
1534
|
|
|
|
|
|
|
Notes => q{ |
1535
|
|
|
|
|
|
|
the full ICC_Profile data block. This tag is generated only if specifically |
1536
|
|
|
|
|
|
|
requested |
1537
|
|
|
|
|
|
|
}, |
1538
|
|
|
|
|
|
|
Groups => { 0 => 'ICC_Profile', 1 => 'ICC_Profile' }, |
1539
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1540
|
|
|
|
|
|
|
WriteCheck => q{ |
1541
|
|
|
|
|
|
|
require Image::ExifTool::ICC_Profile; |
1542
|
|
|
|
|
|
|
return Image::ExifTool::ICC_Profile::ValidateICC(\$val); |
1543
|
|
|
|
|
|
|
}, |
1544
|
|
|
|
|
|
|
}, |
1545
|
|
|
|
|
|
|
CanonVRD => { |
1546
|
|
|
|
|
|
|
Notes => q{ |
1547
|
|
|
|
|
|
|
the full Canon DPP VRD trailer block. This tag is generated only if |
1548
|
|
|
|
|
|
|
specifically requested |
1549
|
|
|
|
|
|
|
}, |
1550
|
|
|
|
|
|
|
Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, |
1551
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary', 'DelGroup'], |
1552
|
|
|
|
|
|
|
Permanent => 0, # (this is 1 by default for MakerNotes tags) |
1553
|
|
|
|
|
|
|
WriteCheck => q{ |
1554
|
|
|
|
|
|
|
return undef if $val =~ /^CANON OPTIONAL DATA\0/; |
1555
|
|
|
|
|
|
|
return 'Invalid CanonVRD data'; |
1556
|
|
|
|
|
|
|
}, |
1557
|
|
|
|
|
|
|
}, |
1558
|
|
|
|
|
|
|
CanonDR4 => { |
1559
|
|
|
|
|
|
|
Notes => q{ |
1560
|
|
|
|
|
|
|
the full Canon DPP version 4 DR4 block. This tag is generated only if |
1561
|
|
|
|
|
|
|
specifically requested |
1562
|
|
|
|
|
|
|
}, |
1563
|
|
|
|
|
|
|
Groups => { 0 => 'CanonVRD', 1 => 'CanonVRD' }, |
1564
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary'], |
1565
|
|
|
|
|
|
|
Permanent => 0, # (this is 1 by default for MakerNotes tags) |
1566
|
|
|
|
|
|
|
WriteCheck => q{ |
1567
|
|
|
|
|
|
|
return undef if $val =~ /^IIII\x04\0\x04\0/; |
1568
|
|
|
|
|
|
|
return 'Invalid CanonDR4 data'; |
1569
|
|
|
|
|
|
|
}, |
1570
|
|
|
|
|
|
|
}, |
1571
|
|
|
|
|
|
|
Adobe => { |
1572
|
|
|
|
|
|
|
Notes => q{ |
1573
|
|
|
|
|
|
|
the JPEG APP14 Adobe segment. Extracted only if specified. See the |
1574
|
|
|
|
|
|
|
L for more information |
1575
|
|
|
|
|
|
|
}, |
1576
|
|
|
|
|
|
|
Groups => { 0 => 'APP14', 1 => 'Adobe' }, |
1577
|
|
|
|
|
|
|
WriteGroup => 'Adobe', |
1578
|
|
|
|
|
|
|
Flags => ['Writable' ,'Protected', 'Binary'], |
1579
|
|
|
|
|
|
|
}, |
1580
|
|
|
|
|
|
|
CurrentIPTCDigest => { |
1581
|
|
|
|
|
|
|
Notes => q{ |
1582
|
|
|
|
|
|
|
MD5 digest of existing IPTC data. All zeros if IPTC exists but Digest::MD5 |
1583
|
|
|
|
|
|
|
is not installed. Only calculated for IPTC in the standard location as |
1584
|
|
|
|
|
|
|
specified by the L. ExifTool |
1585
|
|
|
|
|
|
|
automates the handling of this tag in the MWG module -- see the |
1586
|
|
|
|
|
|
|
L for details |
1587
|
|
|
|
|
|
|
}, |
1588
|
|
|
|
|
|
|
ValueConv => 'unpack("H*", $val)', |
1589
|
|
|
|
|
|
|
}, |
1590
|
|
|
|
|
|
|
PreviewImage => { |
1591
|
|
|
|
|
|
|
Notes => 'JPEG-format embedded preview image', |
1592
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1593
|
|
|
|
|
|
|
Writable => 1, |
1594
|
|
|
|
|
|
|
WriteCheck => '$self->CheckImage(\$val)', |
1595
|
|
|
|
|
|
|
WriteGroup => 'All', |
1596
|
|
|
|
|
|
|
# can't delete, so set to empty string and return no error |
1597
|
|
|
|
|
|
|
DelCheck => '$val = ""; return undef', |
1598
|
|
|
|
|
|
|
# accept either scalar or scalar reference |
1599
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1600
|
|
|
|
|
|
|
}, |
1601
|
|
|
|
|
|
|
ThumbnailImage => { |
1602
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1603
|
|
|
|
|
|
|
Notes => 'JPEG-format embedded thumbnail image', |
1604
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1605
|
|
|
|
|
|
|
}, |
1606
|
|
|
|
|
|
|
OtherImage => { |
1607
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1608
|
|
|
|
|
|
|
Notes => 'other JPEG-format embedded image', |
1609
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(ref $val ? $val : \$val, $tag)', |
1610
|
|
|
|
|
|
|
}, |
1611
|
|
|
|
|
|
|
PreviewPNG => { |
1612
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1613
|
|
|
|
|
|
|
Notes => 'PNG-format embedded preview image', |
1614
|
|
|
|
|
|
|
Binary => 1, |
1615
|
|
|
|
|
|
|
}, |
1616
|
|
|
|
|
|
|
PreviewWMF => { |
1617
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1618
|
|
|
|
|
|
|
Notes => 'WMF-format embedded preview image', |
1619
|
|
|
|
|
|
|
Binary => 1, |
1620
|
|
|
|
|
|
|
}, |
1621
|
|
|
|
|
|
|
PreviewTIFF => { |
1622
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1623
|
|
|
|
|
|
|
Notes => 'TIFF-format embedded preview image', |
1624
|
|
|
|
|
|
|
Binary => 1, |
1625
|
|
|
|
|
|
|
}, |
1626
|
|
|
|
|
|
|
PreviewPDF => { |
1627
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1628
|
|
|
|
|
|
|
Notes => 'PDF-format embedded preview image', |
1629
|
|
|
|
|
|
|
Binary => 1, |
1630
|
|
|
|
|
|
|
}, |
1631
|
|
|
|
|
|
|
ExifByteOrder => { |
1632
|
|
|
|
|
|
|
Writable => 1, |
1633
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1634
|
|
|
|
|
|
|
Notes => q{ |
1635
|
|
|
|
|
|
|
represents the byte order of EXIF information. May be written to set the |
1636
|
|
|
|
|
|
|
byte order only for newly created EXIF segments |
1637
|
|
|
|
|
|
|
}, |
1638
|
|
|
|
|
|
|
PrintConv => { |
1639
|
|
|
|
|
|
|
II => 'Little-endian (Intel, II)', |
1640
|
|
|
|
|
|
|
MM => 'Big-endian (Motorola, MM)', |
1641
|
|
|
|
|
|
|
}, |
1642
|
|
|
|
|
|
|
}, |
1643
|
|
|
|
|
|
|
ExifUnicodeByteOrder => { |
1644
|
|
|
|
|
|
|
Writable => 1, |
1645
|
|
|
|
|
|
|
WriteOnly => 1, |
1646
|
|
|
|
|
|
|
DelCheck => q{"Can't delete"}, |
1647
|
|
|
|
|
|
|
Notes => q{ |
1648
|
|
|
|
|
|
|
specifies the byte order to use when writing EXIF Unicode text. The EXIF |
1649
|
|
|
|
|
|
|
specification is particularly vague about this byte ordering, and different |
1650
|
|
|
|
|
|
|
applications use different conventions. By default ExifTool writes Unicode |
1651
|
|
|
|
|
|
|
text in EXIF byte order, but this write-only tag may be used to force a |
1652
|
|
|
|
|
|
|
specific order. Applies to the EXIF UserComment tag when writing special |
1653
|
|
|
|
|
|
|
characters |
1654
|
|
|
|
|
|
|
}, |
1655
|
|
|
|
|
|
|
PrintConv => { |
1656
|
|
|
|
|
|
|
II => 'Little-endian (Intel, II)', |
1657
|
|
|
|
|
|
|
MM => 'Big-endian (Motorola, MM)', |
1658
|
|
|
|
|
|
|
}, |
1659
|
|
|
|
|
|
|
}, |
1660
|
|
|
|
|
|
|
ExifToolVersion => { |
1661
|
|
|
|
|
|
|
Description => 'ExifTool Version Number', |
1662
|
|
|
|
|
|
|
Groups => \%allGroupsExifTool, |
1663
|
|
|
|
|
|
|
Notes => 'the version of ExifTool currently running', |
1664
|
|
|
|
|
|
|
}, |
1665
|
|
|
|
|
|
|
ProcessingTime => { |
1666
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1667
|
|
|
|
|
|
|
Notes => q{ |
1668
|
|
|
|
|
|
|
the clock time in seconds taken by ExifTool to extract information from this |
1669
|
|
|
|
|
|
|
file. Not generated unless specifically requested or the L API |
1670
|
|
|
|
|
|
|
option is set. Requires Time::HiRes |
1671
|
|
|
|
|
|
|
}, |
1672
|
|
|
|
|
|
|
PrintConv => 'sprintf("%.3g s", $val)', |
1673
|
|
|
|
|
|
|
}, |
1674
|
|
|
|
|
|
|
RAFVersion => { Notes => 'RAF file version number' }, |
1675
|
|
|
|
|
|
|
JPEGDigest => { |
1676
|
|
|
|
|
|
|
Notes => q{ |
1677
|
|
|
|
|
|
|
an MD5 digest of the JPEG quantization tables is combined with the component |
1678
|
|
|
|
|
|
|
sub-sampling values to generate the value of this tag. The result is |
1679
|
|
|
|
|
|
|
compared to known values in an attempt to deduce the originating software |
1680
|
|
|
|
|
|
|
based only on the JPEG image data. For performance reasons, this tag is |
1681
|
|
|
|
|
|
|
generated only if specifically requested or the API L option is set |
1682
|
|
|
|
|
|
|
to 3 or higher |
1683
|
|
|
|
|
|
|
}, |
1684
|
|
|
|
|
|
|
}, |
1685
|
|
|
|
|
|
|
JPEGQualityEstimate => { |
1686
|
|
|
|
|
|
|
Notes => q{ |
1687
|
|
|
|
|
|
|
an estimate of the IJG JPEG quality setting for the image, calculated from |
1688
|
|
|
|
|
|
|
the quantization tables. For performance reasons, this tag is generated |
1689
|
|
|
|
|
|
|
only if specifically requested or the API L option is set to 3 or |
1690
|
|
|
|
|
|
|
higher |
1691
|
|
|
|
|
|
|
}, |
1692
|
|
|
|
|
|
|
}, |
1693
|
|
|
|
|
|
|
JPEGImageLength => { |
1694
|
|
|
|
|
|
|
Notes => q{ |
1695
|
|
|
|
|
|
|
byte length of JPEG image without metadata. For performance reasons, this |
1696
|
|
|
|
|
|
|
tag is generated only if specifically requested or the API L option |
1697
|
|
|
|
|
|
|
is set to 3 or higher |
1698
|
|
|
|
|
|
|
}, |
1699
|
|
|
|
|
|
|
}, |
1700
|
|
|
|
|
|
|
# Validate (added from Validate.pm) |
1701
|
|
|
|
|
|
|
Now => { |
1702
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Time' }, |
1703
|
|
|
|
|
|
|
Notes => q{ |
1704
|
|
|
|
|
|
|
the current date/time. Useful when setting the tag values, eg. |
1705
|
|
|
|
|
|
|
C<"-modifydate. Not generated unless specifically requested or the |
1706
|
|
|
|
|
|
|
API L option is set |
1707
|
|
|
|
|
|
|
}, |
1708
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
1709
|
|
|
|
|
|
|
}, |
1710
|
|
|
|
|
|
|
NewGUID => { |
1711
|
|
|
|
|
|
|
Groups => { 0 => 'ExifTool', 1 => 'ExifTool', 2 => 'Other' }, |
1712
|
|
|
|
|
|
|
Notes => q{ |
1713
|
|
|
|
|
|
|
generates a new, random GUID with format |
1714
|
|
|
|
|
|
|
YYYYmmdd-HHMM-SSNN-PPPP-RRRRRRRRRRRR, where Y=year, m=month, d=day, H=hour, |
1715
|
|
|
|
|
|
|
M=minute, S=second, N=file sequence number in hex, P=process ID in hex, and |
1716
|
|
|
|
|
|
|
R=random hex number; without dashes with the -n option. Not generated |
1717
|
|
|
|
|
|
|
unless specifically requested or the API L option is set |
1718
|
|
|
|
|
|
|
}, |
1719
|
|
|
|
|
|
|
PrintConv => '$val =~ s/(.{8})(.{4})(.{4})(.{4})/$1-$2-$3-$4-/; $val', |
1720
|
|
|
|
|
|
|
}, |
1721
|
|
|
|
|
|
|
ID3Size => { Notes => 'size of the ID3 data block' }, |
1722
|
|
|
|
|
|
|
Geotag => { |
1723
|
|
|
|
|
|
|
Writable => 1, |
1724
|
|
|
|
|
|
|
WriteOnly => 1, |
1725
|
|
|
|
|
|
|
WriteNothing => 1, |
1726
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1727
|
|
|
|
|
|
|
Notes => q{ |
1728
|
|
|
|
|
|
|
this write-only tag is used to define the GPS track log data or track log |
1729
|
|
|
|
|
|
|
file name. Currently supported track log formats are GPX, NMEA RMC/GGA/GLL, |
1730
|
|
|
|
|
|
|
KML, IGC, Garmin XML and TCX, Magellan PMGNTRK, Honeywell PTNTHPR, Winplus |
1731
|
|
|
|
|
|
|
Beacon text, and Bramor gEO log files. May be set to the special value of |
1732
|
|
|
|
|
|
|
"DATETIMEONLY" (all caps) to set GPS date/time tags if no input track points |
1733
|
|
|
|
|
|
|
are available. See L for details |
1734
|
|
|
|
|
|
|
}, |
1735
|
|
|
|
|
|
|
DelCheck => q{ |
1736
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1737
|
|
|
|
|
|
|
# delete associated tags |
1738
|
|
|
|
|
|
|
Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); |
1739
|
|
|
|
|
|
|
}, |
1740
|
|
|
|
|
|
|
ValueConvInv => q{ |
1741
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1742
|
|
|
|
|
|
|
# always warn because this tag is never set (warning is "\n" on success) |
1743
|
|
|
|
|
|
|
my $result = Image::ExifTool::Geotag::LoadTrackLog($self, $val); |
1744
|
|
|
|
|
|
|
return '' if not defined $result; # deleting geo tags |
1745
|
|
|
|
|
|
|
return $result if ref $result; # geotag data hash reference |
1746
|
|
|
|
|
|
|
warn "$result\n"; # error string |
1747
|
|
|
|
|
|
|
}, |
1748
|
|
|
|
|
|
|
}, |
1749
|
|
|
|
|
|
|
Geotime => { |
1750
|
|
|
|
|
|
|
Writable => 1, |
1751
|
|
|
|
|
|
|
WriteOnly => 1, |
1752
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1753
|
|
|
|
|
|
|
Notes => q{ |
1754
|
|
|
|
|
|
|
this write-only tag is used to define a date/time for interpolating a |
1755
|
|
|
|
|
|
|
position in the GPS track specified by the Geotag tag. Writing this tag |
1756
|
|
|
|
|
|
|
causes GPS information to be written into the EXIF or XMP of the target |
1757
|
|
|
|
|
|
|
files. The local system timezone is assumed if the date/time value does not |
1758
|
|
|
|
|
|
|
contain a timezone. May be deleted to delete associated GPS tags. A group |
1759
|
|
|
|
|
|
|
name of "EXIF" or "XMP" may be specified to write or delete only EXIF or XMP |
1760
|
|
|
|
|
|
|
GPS tags |
1761
|
|
|
|
|
|
|
}, |
1762
|
|
|
|
|
|
|
DelCheck => q{ |
1763
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1764
|
|
|
|
|
|
|
# delete associated tags |
1765
|
|
|
|
|
|
|
Image::ExifTool::Geotag::SetGeoValues($self, undef, $wantGroup); |
1766
|
|
|
|
|
|
|
}, |
1767
|
|
|
|
|
|
|
ValueConvInv => q{ |
1768
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1769
|
|
|
|
|
|
|
warn Image::ExifTool::Geotag::SetGeoValues($self, $val, $wantGroup) . "\n"; |
1770
|
|
|
|
|
|
|
return undef; |
1771
|
|
|
|
|
|
|
}, |
1772
|
|
|
|
|
|
|
}, |
1773
|
|
|
|
|
|
|
Geosync => { |
1774
|
|
|
|
|
|
|
Writable => 1, |
1775
|
|
|
|
|
|
|
WriteOnly => 1, |
1776
|
|
|
|
|
|
|
WriteNothing => 1, |
1777
|
|
|
|
|
|
|
AllowGroup => '(exif|gps|xmp|xmp-exif)', |
1778
|
|
|
|
|
|
|
Shift => 'Time', # enables "+=" syntax as well as "=+" |
1779
|
|
|
|
|
|
|
Notes => q{ |
1780
|
|
|
|
|
|
|
this write-only tag specifies a time difference to add to Geotime for |
1781
|
|
|
|
|
|
|
synchronization with the GPS clock. For example, set this to "-12" if the |
1782
|
|
|
|
|
|
|
camera clock is 12 seconds faster than GPS time. Input format is |
1783
|
|
|
|
|
|
|
"[+-][[[DD ]HH:]MM:]SS[.ss]". Additional features allow calculation of time |
1784
|
|
|
|
|
|
|
differences and time drifts, and extraction of synchronization times from |
1785
|
|
|
|
|
|
|
image files. See the L for details |
1786
|
|
|
|
|
|
|
}, |
1787
|
|
|
|
|
|
|
ValueConvInv => q{ |
1788
|
|
|
|
|
|
|
require Image::ExifTool::Geotag; |
1789
|
|
|
|
|
|
|
return Image::ExifTool::Geotag::ConvertGeosync($self, $val); |
1790
|
|
|
|
|
|
|
}, |
1791
|
|
|
|
|
|
|
}, |
1792
|
|
|
|
|
|
|
ForceWrite => { |
1793
|
|
|
|
|
|
|
Groups => { 0 => '*', 1 => '*', 2 => '*' }, |
1794
|
|
|
|
|
|
|
Writable => 1, |
1795
|
|
|
|
|
|
|
WriteOnly => 1, |
1796
|
|
|
|
|
|
|
Notes => q{ |
1797
|
|
|
|
|
|
|
write-only tag used to force metadata in a file to be rewritten even if no |
1798
|
|
|
|
|
|
|
tag values are changed. May be set to "EXIF", "IPTC", "XMP" or "PNG" to |
1799
|
|
|
|
|
|
|
force the corresponding metadata type to be rewritten, "FixBase" to cause |
1800
|
|
|
|
|
|
|
EXIF to be rewritten only if the MakerNotes offset base was fixed, or "All" |
1801
|
|
|
|
|
|
|
to rewrite all of these metadata types. Values are case insensitive, and |
1802
|
|
|
|
|
|
|
multiple values may be separated with commas, eg. C<-ForceWrite=exif,xmp> |
1803
|
|
|
|
|
|
|
}, |
1804
|
|
|
|
|
|
|
}, |
1805
|
|
|
|
|
|
|
EmbeddedVideo => { Groups => { 0 => 'Trailer', 2 => 'Video' } }, |
1806
|
|
|
|
|
|
|
Trailer => { |
1807
|
|
|
|
|
|
|
Groups => { 0 => 'Trailer' }, |
1808
|
|
|
|
|
|
|
Notes => q{ |
1809
|
|
|
|
|
|
|
the full JPEG trailer data block. Extracted only if specifically requested |
1810
|
|
|
|
|
|
|
or the API RequestAll option is set to 3 or higher |
1811
|
|
|
|
|
|
|
}, |
1812
|
|
|
|
|
|
|
Writable => 1, |
1813
|
|
|
|
|
|
|
Protected => 1, |
1814
|
|
|
|
|
|
|
}, |
1815
|
|
|
|
|
|
|
PageCount => { Notes => 'the number of pages in a multi-page TIFF document' }, |
1816
|
|
|
|
|
|
|
SphericalVideoXML => { |
1817
|
|
|
|
|
|
|
Groups => { 0 => 'QuickTime', 1 => 'GSpherical', 2 => 'Video' }, |
1818
|
|
|
|
|
|
|
# (group 1 is 'GSpherical' to trigger creation of this tag when writing, |
1819
|
|
|
|
|
|
|
# but when reading the family 1 group is the track number) |
1820
|
|
|
|
|
|
|
Flags => [ 'Writable', 'Binary', 'Protected' ], |
1821
|
|
|
|
|
|
|
Notes => q{ |
1822
|
|
|
|
|
|
|
the SphericalVideoXML block from MP4/MOV videos. This tag is generated only |
1823
|
|
|
|
|
|
|
if specifically requested |
1824
|
|
|
|
|
|
|
}, |
1825
|
|
|
|
|
|
|
}, |
1826
|
|
|
|
|
|
|
ImageDataMD5 => { |
1827
|
|
|
|
|
|
|
Notes => q{ |
1828
|
|
|
|
|
|
|
MD5 of image data. Generated only if specifically requested for JPEG and |
1829
|
|
|
|
|
|
|
TIFF-based images, PNG, CRW, CR3, MRW, RAF, X3F and AVIF images, MOV/MP4 |
1830
|
|
|
|
|
|
|
videos, and some RIFF-based files. The MD5 includes the main image data, |
1831
|
|
|
|
|
|
|
plus JpgFromRaw/OtherImage for some formats, but does not include |
1832
|
|
|
|
|
|
|
ThumbnailImage or PreviewImage. Includes video and audio data for MOV/MP4. |
1833
|
|
|
|
|
|
|
The L provides a place to |
1834
|
|
|
|
|
|
|
store these values in the file. |
1835
|
|
|
|
|
|
|
}, |
1836
|
|
|
|
|
|
|
}, |
1837
|
|
|
|
|
|
|
); |
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
# tags defined by UserParam option (added at runtime) |
1840
|
|
|
|
|
|
|
%Image::ExifTool::UserParam = ( |
1841
|
|
|
|
|
|
|
GROUPS => { 0 => 'UserParam', 1 => 'UserParam', 2 => 'Other' }, |
1842
|
|
|
|
|
|
|
PRIORITY => 0, |
1843
|
|
|
|
|
|
|
); |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
# YCbCrSubSampling values (used by JPEG SOF, EXIF and XMP) |
1846
|
|
|
|
|
|
|
%Image::ExifTool::JPEG::yCbCrSubSampling = ( |
1847
|
|
|
|
|
|
|
'1 1' => 'YCbCr4:4:4 (1 1)', #PH |
1848
|
|
|
|
|
|
|
'2 1' => 'YCbCr4:2:2 (2 1)', #14 in Exif.pm |
1849
|
|
|
|
|
|
|
'2 2' => 'YCbCr4:2:0 (2 2)', #14 in Exif.pm |
1850
|
|
|
|
|
|
|
'4 1' => 'YCbCr4:1:1 (4 1)', #14 in Exif.pm |
1851
|
|
|
|
|
|
|
'4 2' => 'YCbCr4:1:0 (4 2)', #PH |
1852
|
|
|
|
|
|
|
'1 2' => 'YCbCr4:4:0 (1 2)', #PH |
1853
|
|
|
|
|
|
|
'1 4' => 'YCbCr4:4:1 (1 4)', #JD |
1854
|
|
|
|
|
|
|
'2 4' => 'YCbCr4:2:1 (2 4)', #JD |
1855
|
|
|
|
|
|
|
); |
1856
|
|
|
|
|
|
|
|
1857
|
|
|
|
|
|
|
# define common JPEG segments here to avoid overhead of loading JPEG module |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
# JPEG SOF (start of frame) tags |
1860
|
|
|
|
|
|
|
# (ref http://www.w3.org/Graphics/JPEG/itu-t81.pdf) |
1861
|
|
|
|
|
|
|
%Image::ExifTool::JPEG::SOF = ( |
1862
|
|
|
|
|
|
|
GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' }, |
1863
|
|
|
|
|
|
|
NOTES => 'This information is extracted from the JPEG Start Of Frame segment.', |
1864
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # tag ID's aren't meaningful for these tags |
1865
|
|
|
|
|
|
|
EncodingProcess => { |
1866
|
|
|
|
|
|
|
PrintHex => 1, |
1867
|
|
|
|
|
|
|
PrintConv => { |
1868
|
|
|
|
|
|
|
0x0 => 'Baseline DCT, Huffman coding', |
1869
|
|
|
|
|
|
|
0x1 => 'Extended sequential DCT, Huffman coding', |
1870
|
|
|
|
|
|
|
0x2 => 'Progressive DCT, Huffman coding', |
1871
|
|
|
|
|
|
|
0x3 => 'Lossless, Huffman coding', |
1872
|
|
|
|
|
|
|
0x5 => 'Sequential DCT, differential Huffman coding', |
1873
|
|
|
|
|
|
|
0x6 => 'Progressive DCT, differential Huffman coding', |
1874
|
|
|
|
|
|
|
0x7 => 'Lossless, Differential Huffman coding', |
1875
|
|
|
|
|
|
|
0x9 => 'Extended sequential DCT, arithmetic coding', |
1876
|
|
|
|
|
|
|
0xa => 'Progressive DCT, arithmetic coding', |
1877
|
|
|
|
|
|
|
0xb => 'Lossless, arithmetic coding', |
1878
|
|
|
|
|
|
|
0xd => 'Sequential DCT, differential arithmetic coding', |
1879
|
|
|
|
|
|
|
0xe => 'Progressive DCT, differential arithmetic coding', |
1880
|
|
|
|
|
|
|
0xf => 'Lossless, differential arithmetic coding', |
1881
|
|
|
|
|
|
|
} |
1882
|
|
|
|
|
|
|
}, |
1883
|
|
|
|
|
|
|
BitsPerSample => { }, |
1884
|
|
|
|
|
|
|
ImageHeight => { }, |
1885
|
|
|
|
|
|
|
ImageWidth => { }, |
1886
|
|
|
|
|
|
|
ColorComponents => { }, |
1887
|
|
|
|
|
|
|
YCbCrSubSampling => { |
1888
|
|
|
|
|
|
|
Notes => 'calculated from components table', |
1889
|
|
|
|
|
|
|
PrintConv => \%Image::ExifTool::JPEG::yCbCrSubSampling, |
1890
|
|
|
|
|
|
|
}, |
1891
|
|
|
|
|
|
|
); |
1892
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
# JPEG JFIF APP0 definitions |
1894
|
|
|
|
|
|
|
%Image::ExifTool::JFIF::Main = ( |
1895
|
|
|
|
|
|
|
PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData, |
1896
|
|
|
|
|
|
|
WRITE_PROC => \&Image::ExifTool::WriteBinaryData, |
1897
|
|
|
|
|
|
|
CHECK_PROC => \&Image::ExifTool::CheckBinaryData, |
1898
|
|
|
|
|
|
|
GROUPS => { 0 => 'JFIF', 1 => 'JFIF', 2 => 'Image' }, |
1899
|
|
|
|
|
|
|
DATAMEMBER => [ 2, 3, 5 ], |
1900
|
|
|
|
|
|
|
0 => { |
1901
|
|
|
|
|
|
|
Name => 'JFIFVersion', |
1902
|
|
|
|
|
|
|
Format => 'int8u[2]', |
1903
|
|
|
|
|
|
|
PrintConv => 'sprintf("%d.%.2d", split(" ",$val))', |
1904
|
|
|
|
|
|
|
Mandatory => 1, |
1905
|
|
|
|
|
|
|
}, |
1906
|
|
|
|
|
|
|
2 => { |
1907
|
|
|
|
|
|
|
Name => 'ResolutionUnit', |
1908
|
|
|
|
|
|
|
Writable => 1, |
1909
|
|
|
|
|
|
|
RawConv => '$$self{JFIFResolutionUnit} = $val', |
1910
|
|
|
|
|
|
|
PrintConv => { |
1911
|
|
|
|
|
|
|
0 => 'None', |
1912
|
|
|
|
|
|
|
1 => 'inches', |
1913
|
|
|
|
|
|
|
2 => 'cm', |
1914
|
|
|
|
|
|
|
}, |
1915
|
|
|
|
|
|
|
Priority => -1, |
1916
|
|
|
|
|
|
|
Mandatory => 1, |
1917
|
|
|
|
|
|
|
}, |
1918
|
|
|
|
|
|
|
3 => { |
1919
|
|
|
|
|
|
|
Name => 'XResolution', |
1920
|
|
|
|
|
|
|
Format => 'int16u', |
1921
|
|
|
|
|
|
|
Writable => 1, |
1922
|
|
|
|
|
|
|
Priority => -1, |
1923
|
|
|
|
|
|
|
RawConv => '$$self{JFIFXResolution} = $val', |
1924
|
|
|
|
|
|
|
Mandatory => 1, |
1925
|
|
|
|
|
|
|
}, |
1926
|
|
|
|
|
|
|
5 => { |
1927
|
|
|
|
|
|
|
Name => 'YResolution', |
1928
|
|
|
|
|
|
|
Format => 'int16u', |
1929
|
|
|
|
|
|
|
Writable => 1, |
1930
|
|
|
|
|
|
|
Priority => -1, |
1931
|
|
|
|
|
|
|
RawConv => '$$self{JFIFYResolution} = $val', |
1932
|
|
|
|
|
|
|
Mandatory => 1, |
1933
|
|
|
|
|
|
|
}, |
1934
|
|
|
|
|
|
|
7 => { |
1935
|
|
|
|
|
|
|
Name => 'ThumbnailWidth', |
1936
|
|
|
|
|
|
|
RawConv => '$val ? $$self{JFIFThumbnailWidth} = $val : undef', |
1937
|
|
|
|
|
|
|
}, |
1938
|
|
|
|
|
|
|
8 => { |
1939
|
|
|
|
|
|
|
Name => 'ThumbnailHeight', |
1940
|
|
|
|
|
|
|
RawConv => '$val ? $$self{JFIFThumbnailHeight} = $val : undef', |
1941
|
|
|
|
|
|
|
}, |
1942
|
|
|
|
|
|
|
9 => { |
1943
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1944
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1945
|
|
|
|
|
|
|
Format => 'undef[3*($val{7}||0)*($val{8}||0)]', |
1946
|
|
|
|
|
|
|
Notes => 'raw RGB thumbnail data, extracted as a TIFF image', |
1947
|
|
|
|
|
|
|
RawConv => 'length($val) ? $val : undef', |
1948
|
|
|
|
|
|
|
ValueConv => sub { |
1949
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1950
|
|
|
|
|
|
|
my $len = length $val; |
1951
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1952
|
|
|
|
|
|
|
my $img = MakeTiffHeader($$et{JFIFThumbnailWidth},$$et{JFIFThumbnailHeight},3,8) . $val; |
1953
|
|
|
|
|
|
|
return \$img; |
1954
|
|
|
|
|
|
|
}, |
1955
|
|
|
|
|
|
|
}, |
1956
|
|
|
|
|
|
|
); |
1957
|
|
|
|
|
|
|
%Image::ExifTool::JFIF::Extension = ( |
1958
|
|
|
|
|
|
|
GROUPS => { 0 => 'JFIF', 1 => 'JFXX', 2 => 'Image' }, |
1959
|
|
|
|
|
|
|
NOTES => 'Thumbnail images extracted from the JFXX segment.', |
1960
|
|
|
|
|
|
|
0x10 => { |
1961
|
|
|
|
|
|
|
Name => 'ThumbnailImage', |
1962
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1963
|
|
|
|
|
|
|
Notes => 'JPEG-format thumbnail image', |
1964
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(\$val,$tag)', |
1965
|
|
|
|
|
|
|
}, |
1966
|
|
|
|
|
|
|
0x11 => { # (untested) |
1967
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1968
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1969
|
|
|
|
|
|
|
Notes => 'raw palette-color thumbnail data, extracted as a TIFF image', |
1970
|
|
|
|
|
|
|
RawConv => '(length $val > 770 and $val !~ /^\0\0/) ? $val : undef', |
1971
|
|
|
|
|
|
|
ValueConv => sub { |
1972
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1973
|
|
|
|
|
|
|
my $len = length $val; |
1974
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1975
|
|
|
|
|
|
|
my ($w, $h) = unpack('CC', $val); |
1976
|
|
|
|
|
|
|
my $img = MakeTiffHeader($w,$h,1,8,undef,substr($val,2,768)) . substr($val,770); |
1977
|
|
|
|
|
|
|
return \$img; |
1978
|
|
|
|
|
|
|
}, |
1979
|
|
|
|
|
|
|
}, |
1980
|
|
|
|
|
|
|
0x13 => { |
1981
|
|
|
|
|
|
|
Name => 'ThumbnailTIFF', |
1982
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
1983
|
|
|
|
|
|
|
Notes => 'raw RGB thumbnail data, extracted as a TIFF image', |
1984
|
|
|
|
|
|
|
RawConv => '(length $val > 2 and $val !~ /^\0\0/) ? $val : undef', |
1985
|
|
|
|
|
|
|
ValueConv => sub { |
1986
|
|
|
|
|
|
|
my ($val, $et) = @_; |
1987
|
|
|
|
|
|
|
my $len = length $val; |
1988
|
|
|
|
|
|
|
return \ "Binary data $len bytes" unless $et->Options('Binary'); |
1989
|
|
|
|
|
|
|
my ($w, $h) = unpack('CC', $val); |
1990
|
|
|
|
|
|
|
my $img = MakeTiffHeader($w,$h,3,8) . substr($val,2); |
1991
|
|
|
|
|
|
|
return \$img; |
1992
|
|
|
|
|
|
|
}, |
1993
|
|
|
|
|
|
|
}, |
1994
|
|
|
|
|
|
|
# Apple may add "AMPF" to the end of the JFIF record, |
1995
|
|
|
|
|
|
|
# possibly indicating the existence of MPF images (ref forum12677) |
1996
|
|
|
|
|
|
|
); |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
# Composite tags (accumulation of all Composite tag tables) |
1999
|
|
|
|
|
|
|
%Image::ExifTool::Composite = ( |
2000
|
|
|
|
|
|
|
GROUPS => { 0 => 'Composite', 1 => 'Composite' }, |
2001
|
|
|
|
|
|
|
TABLE_NAME => 'Image::ExifTool::Composite', |
2002
|
|
|
|
|
|
|
SHORT_NAME => 'Composite', |
2003
|
|
|
|
|
|
|
VARS => { NO_ID => 1 }, # want empty tagID's for Composite tags |
2004
|
|
|
|
|
|
|
WRITE_PROC => \&DummyWriteProc, |
2005
|
|
|
|
|
|
|
); |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
my %compositeID; # lookup for new ID's of Composite tags based on original ID |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
# static private ExifTool variables |
2010
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
%allTables = ( ); # list of all tables loaded (except Composite tags) |
2012
|
|
|
|
|
|
|
@tableOrder = ( ); # order the tables were loaded |
2013
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2015
|
|
|
|
|
|
|
# Warning handler routines (warning string stored in $evalWarning) |
2016
|
|
|
|
|
|
|
# |
2017
|
|
|
|
|
|
|
# Set warning message |
2018
|
|
|
|
|
|
|
# Inputs: 0) warning string (undef to reset warning) |
2019
|
38
|
|
|
38
|
0
|
594
|
sub SetWarning($) { $evalWarning = $_[0]; } |
2020
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
# Get warning message |
2022
|
17
|
|
|
17
|
0
|
65
|
sub GetWarning() { return $evalWarning; } |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
# Clean unnecessary information (line number, LF) from warning |
2025
|
|
|
|
|
|
|
# Inputs: 0) warning string or undef to use $evalWarning |
2026
|
|
|
|
|
|
|
# Returns: cleaned warning |
2027
|
|
|
|
|
|
|
sub CleanWarning(;$) |
2028
|
|
|
|
|
|
|
{ |
2029
|
223
|
|
|
223
|
0
|
462
|
my $str = shift; |
2030
|
223
|
50
|
|
|
|
600
|
unless (defined $str) { |
2031
|
223
|
50
|
|
|
|
615
|
return undef unless defined $evalWarning; |
2032
|
223
|
|
|
|
|
389
|
$str = $evalWarning; |
2033
|
|
|
|
|
|
|
} |
2034
|
223
|
100
|
|
|
|
1538
|
$str = $1 if $str =~ /(.*) at /s; |
2035
|
223
|
|
|
|
|
934
|
$str =~ s/\s+$//s; |
2036
|
223
|
|
|
|
|
1082
|
return $str; |
2037
|
|
|
|
|
|
|
} |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
#============================================================================== |
2040
|
|
|
|
|
|
|
# New - create new ExifTool object |
2041
|
|
|
|
|
|
|
# Inputs: 0) reference to exiftool object or ExifTool class name |
2042
|
|
|
|
|
|
|
# Returns: blessed ExifTool object ref |
2043
|
|
|
|
|
|
|
sub new |
2044
|
|
|
|
|
|
|
{ |
2045
|
490
|
|
|
490
|
1
|
129472
|
local $_; |
2046
|
490
|
|
|
|
|
1529
|
my $that = shift; |
2047
|
490
|
|
50
|
|
|
3992
|
my $class = ref($that) || $that || 'Image::ExifTool'; |
2048
|
490
|
|
|
|
|
1788
|
my $self = bless {}, $class; |
2049
|
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
|
# make sure our main Exif tag table has been loaded |
2051
|
490
|
|
|
|
|
2239
|
GetTagTable("Image::ExifTool::Exif::Main"); |
2052
|
|
|
|
|
|
|
|
2053
|
490
|
|
|
|
|
3443
|
$self->ClearOptions(); # create default options hash |
2054
|
490
|
|
|
|
|
1485
|
$$self{VALUE} = { }; # must initialize this for warning messages |
2055
|
490
|
|
|
|
|
1710
|
$$self{PATH} = [ ]; # (this too) |
2056
|
490
|
|
|
|
|
1588
|
$$self{DEL_GROUP} = { }; # lookup for groups to delete when writing |
2057
|
490
|
|
|
|
|
1347
|
$$self{SAVE_COUNT} = 0; # count calls to SaveNewValues() |
2058
|
490
|
|
|
|
|
1241
|
$$self{FILE_SEQUENCE} = 0; # sequence number for files when reading |
2059
|
490
|
|
|
|
|
1300
|
$$self{FILES_WRITTEN} = 0; # count of files successfully written |
2060
|
490
|
|
|
|
|
1656
|
$$self{INDENT2} = ''; # indentation of verbose messages from SetNewValue |
2061
|
490
|
|
|
|
|
1424
|
$$self{ALT_EXIFTOOL} = { }; # alternate exiftool objects |
2062
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
# initialize our new groups for writing |
2064
|
490
|
|
|
|
|
2787
|
$self->SetNewGroups(@defaultWriteGroups); |
2065
|
|
|
|
|
|
|
|
2066
|
490
|
|
|
|
|
2286
|
return $self; |
2067
|
|
|
|
|
|
|
} |
2068
|
|
|
|
|
|
|
|
2069
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2070
|
|
|
|
|
|
|
# ImageInfo - return specified information from image file |
2071
|
|
|
|
|
|
|
# Inputs: 0) [optional] ExifTool object reference |
2072
|
|
|
|
|
|
|
# 1) filename, file reference, or scalar data reference |
2073
|
|
|
|
|
|
|
# 2-N) list of tag names to find (or tag list reference or options reference) |
2074
|
|
|
|
|
|
|
# Returns: reference to hash of tag/value pairs (with "Error" entry on error) |
2075
|
|
|
|
|
|
|
# Notes: |
2076
|
|
|
|
|
|
|
# - if no tags names are specified, the values of all tags are returned |
2077
|
|
|
|
|
|
|
# - tags may be specified with leading '-' to exclude, or trailing '#' for ValueConv |
2078
|
|
|
|
|
|
|
# - can pass a reference to list of tags to find, in which case the list will |
2079
|
|
|
|
|
|
|
# be updated with the tags found in the proper case and in the specified order. |
2080
|
|
|
|
|
|
|
# - can pass reference to hash specifying options |
2081
|
|
|
|
|
|
|
# - returned tag values may be scalar references indicating binary data |
2082
|
|
|
|
|
|
|
# - see ClearOptions() below for a list of options and their default values |
2083
|
|
|
|
|
|
|
# Examples: |
2084
|
|
|
|
|
|
|
# use Image::ExifTool 'ImageInfo'; |
2085
|
|
|
|
|
|
|
# my $info = ImageInfo($file, 'DateTimeOriginal', 'ImageSize'); |
2086
|
|
|
|
|
|
|
# - or - |
2087
|
|
|
|
|
|
|
# my $et = new Image::ExifTool; |
2088
|
|
|
|
|
|
|
# my $info = $et->ImageInfo($file, \@tagList, {Sort=>'Group0'} ); |
2089
|
|
|
|
|
|
|
sub ImageInfo($;@) |
2090
|
|
|
|
|
|
|
{ |
2091
|
517
|
|
|
517
|
1
|
28118
|
local $_; |
2092
|
|
|
|
|
|
|
# get our ExifTool object ($self) or create one if necessary |
2093
|
517
|
|
|
|
|
1278
|
my $self; |
2094
|
517
|
100
|
100
|
|
|
5777
|
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool')) { |
2095
|
508
|
|
|
|
|
1625
|
$self = shift; |
2096
|
|
|
|
|
|
|
} else { |
2097
|
9
|
|
|
|
|
68
|
$self = new Image::ExifTool; |
2098
|
|
|
|
|
|
|
} |
2099
|
517
|
|
|
|
|
1109
|
my %saveOptions = %{$$self{OPTIONS}}; # save original options |
|
517
|
|
|
|
|
24244
|
|
2100
|
|
|
|
|
|
|
|
2101
|
|
|
|
|
|
|
# initialize file information |
2102
|
517
|
|
|
|
|
4501
|
$$self{FILENAME} = $$self{RAF} = undef; |
2103
|
|
|
|
|
|
|
|
2104
|
517
|
|
|
|
|
3268
|
$self->ParseArguments(@_); # parse our function arguments |
2105
|
517
|
|
|
|
|
2915
|
$self->ExtractInfo(undef); # extract meta information from image |
2106
|
517
|
|
|
|
|
2948
|
my $info = $self->GetInfo(undef); # get requested information |
2107
|
|
|
|
|
|
|
|
2108
|
517
|
|
|
|
|
8107
|
$$self{OPTIONS} = \%saveOptions; # restore original options |
2109
|
|
|
|
|
|
|
|
2110
|
517
|
|
|
|
|
3751
|
return $info; # return requested information |
2111
|
|
|
|
|
|
|
} |
2112
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2114
|
|
|
|
|
|
|
# Get/set ExifTool options |
2115
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, |
2116
|
|
|
|
|
|
|
# 1) Parameter name (case insensitive), 2) Value to set the option |
2117
|
|
|
|
|
|
|
# 3-N) More parameter/value pairs |
2118
|
|
|
|
|
|
|
# Returns: original value of last option specified |
2119
|
|
|
|
|
|
|
sub Options($$;@) |
2120
|
|
|
|
|
|
|
{ |
2121
|
14652
|
|
|
14652
|
1
|
45436
|
local $_; |
2122
|
14652
|
|
|
|
|
22652
|
my $self = shift; |
2123
|
14652
|
|
|
|
|
25318
|
my $options = $$self{OPTIONS}; |
2124
|
14652
|
|
|
|
|
20938
|
my $oldVal; |
2125
|
|
|
|
|
|
|
|
2126
|
14652
|
|
|
|
|
33498
|
while (@_) { |
2127
|
17407
|
|
|
|
|
29980
|
my $param = shift; |
2128
|
|
|
|
|
|
|
# fix parameter case if necessary |
2129
|
17407
|
100
|
|
|
|
40332
|
unless (exists $$options{$param}) { |
2130
|
377
|
|
|
|
|
23702
|
my ($fixed) = grep /^$param$/i, keys %$options; |
2131
|
377
|
50
|
|
|
|
2811
|
if ($fixed) { |
2132
|
0
|
|
|
|
|
0
|
$param = $fixed; |
2133
|
|
|
|
|
|
|
} else { |
2134
|
377
|
|
|
|
|
1847
|
$param =~ s/^Group(\d*)$/Group$1/i; |
2135
|
|
|
|
|
|
|
} |
2136
|
|
|
|
|
|
|
} |
2137
|
17407
|
|
|
|
|
29032
|
$oldVal = $$options{$param}; |
2138
|
17407
|
50
|
33
|
|
|
38541
|
if (ref $oldVal eq 'HASH' and ($param eq 'Compact' or $param eq 'XMPShorthand')) { |
|
|
|
66
|
|
|
|
|
2139
|
|
|
|
|
|
|
# get previous Compact/XMPShorthand setting |
2140
|
0
|
|
|
|
|
0
|
$oldVal = $$oldVal{$param}; |
2141
|
|
|
|
|
|
|
} |
2142
|
17407
|
100
|
|
|
|
37357
|
last unless @_; |
2143
|
4920
|
|
|
|
|
7729
|
my $newVal = shift; |
2144
|
4920
|
100
|
66
|
|
|
40991
|
if ($param eq 'Lang') { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
# allow this to be set to undef to select the default language |
2146
|
78
|
50
|
|
|
|
407
|
$newVal = $defaultLang unless defined $newVal; |
2147
|
78
|
100
|
|
|
|
342
|
if ($newVal eq $defaultLang) { |
2148
|
59
|
|
|
|
|
200
|
$$options{$param} = $newVal; |
2149
|
59
|
|
|
|
|
241
|
delete $$self{CUR_LANG}; |
2150
|
|
|
|
|
|
|
# make sure the language is available |
2151
|
|
|
|
|
|
|
} else { |
2152
|
19
|
|
|
|
|
55
|
my %langs = map { $_ => 1 } @langs; |
|
361
|
|
|
|
|
860
|
|
2153
|
19
|
50
|
33
|
|
|
1535
|
if ($langs{$newVal} and eval "require Image::ExifTool::Lang::$newVal") { |
2154
|
19
|
|
|
|
|
121
|
my $xlat = "Image::ExifTool::Lang::${newVal}::Translate"; |
2155
|
106
|
|
|
106
|
|
1077
|
no strict 'refs'; |
|
106
|
|
|
|
|
2144
|
|
|
106
|
|
|
|
|
461559
|
|
2156
|
19
|
50
|
|
|
|
133
|
if (%$xlat) { |
2157
|
19
|
|
|
|
|
101
|
$$self{CUR_LANG} = \%$xlat; |
2158
|
19
|
|
|
|
|
235
|
$$options{$param} = $newVal; |
2159
|
|
|
|
|
|
|
} |
2160
|
|
|
|
|
|
|
} |
2161
|
|
|
|
|
|
|
} # else don't change Lang |
2162
|
|
|
|
|
|
|
} elsif ($param eq 'Exclude' and defined $newVal) { |
2163
|
|
|
|
|
|
|
# clone Exclude list and expand shortcuts |
2164
|
7
|
|
|
|
|
33
|
my @exclude; |
2165
|
7
|
100
|
|
|
|
48
|
if (ref $newVal eq 'ARRAY') { |
2166
|
6
|
|
|
|
|
30
|
@exclude = @$newVal; |
2167
|
|
|
|
|
|
|
} else { |
2168
|
1
|
|
|
|
|
3
|
@exclude = ($newVal); |
2169
|
|
|
|
|
|
|
} |
2170
|
7
|
|
|
|
|
32
|
ExpandShortcuts(\@exclude, 1); # (also remove '#' suffix) |
2171
|
7
|
|
|
|
|
74
|
$$options{$param} = \@exclude; |
2172
|
|
|
|
|
|
|
} elsif ($param =~ /^Charset/ or $param eq 'IPTCCharset') { |
2173
|
|
|
|
|
|
|
# only allow valid character sets to be set |
2174
|
364
|
100
|
66
|
|
|
1745
|
if ($newVal) { |
|
|
50
|
33
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2175
|
245
|
|
|
|
|
787
|
my $charset = $charsetName{lc $newVal}; |
2176
|
245
|
50
|
|
|
|
587
|
if ($charset) { |
2177
|
245
|
|
|
|
|
498
|
$$options{$param} = $charset; |
2178
|
|
|
|
|
|
|
# maintain backward-compatibility with old IPTCCharset option |
2179
|
245
|
100
|
|
|
|
781
|
$$options{CharsetIPTC} = $charset if $param eq 'IPTCCharset'; |
2180
|
|
|
|
|
|
|
} else { |
2181
|
0
|
|
|
|
|
0
|
warn "Invalid Charset $newVal\n"; |
2182
|
|
|
|
|
|
|
} |
2183
|
|
|
|
|
|
|
} elsif ($param eq 'CharsetEXIF' or $param eq 'CharsetFileName' or $param eq 'CharsetRIFF') { |
2184
|
119
|
|
|
|
|
374
|
$$options{$param} = $newVal; # only these may be set to a false value |
2185
|
|
|
|
|
|
|
} elsif ($param eq 'CharsetQuickTime') { |
2186
|
0
|
|
|
|
|
0
|
$$options{$param} = 'MacRoman'; # QuickTime defaults to MacRoman |
2187
|
|
|
|
|
|
|
} else { |
2188
|
0
|
|
|
|
|
0
|
$$options{$param} = 'Latin'; # all others default to Latin |
2189
|
|
|
|
|
|
|
} |
2190
|
|
|
|
|
|
|
} elsif ($param eq 'UserParam') { |
2191
|
|
|
|
|
|
|
# clear options if $newVal is undef |
2192
|
59
|
50
|
|
|
|
387
|
defined $newVal or $$options{$param} = {}, next; |
2193
|
59
|
|
|
|
|
245
|
my $table = GetTagTable('Image::ExifTool::UserParam'); |
2194
|
|
|
|
|
|
|
# allow initialization of entire UserParam hash |
2195
|
59
|
50
|
|
|
|
455
|
if (ref $newVal eq 'HASH') { |
2196
|
59
|
|
|
|
|
150
|
my %newParams; |
2197
|
59
|
|
|
|
|
341
|
foreach (sort keys %$newVal) { |
2198
|
0
|
|
|
|
|
0
|
my $lcTag = lc $_; |
2199
|
0
|
|
|
|
|
0
|
$newParams{$lcTag} = $$newVal{$_}; |
2200
|
0
|
|
|
|
|
0
|
delete $$table{$lcTag}; |
2201
|
0
|
|
|
|
|
0
|
AddTagToTable($table, $lcTag, $_); |
2202
|
|
|
|
|
|
|
} |
2203
|
59
|
|
|
|
|
224
|
$$options{$param} = \%newParams; |
2204
|
59
|
|
|
|
|
218
|
next; |
2205
|
|
|
|
|
|
|
} |
2206
|
0
|
|
|
|
|
0
|
my ($force, $paramName); |
2207
|
|
|
|
|
|
|
# set/reset single UserParam parameter |
2208
|
0
|
0
|
|
|
|
0
|
if ($newVal =~ /(.*?)=(.*)/s) { |
2209
|
0
|
|
|
|
|
0
|
$paramName = $1; |
2210
|
0
|
|
|
|
|
0
|
$newVal = $2; |
2211
|
0
|
0
|
|
|
|
0
|
$force = 1 if $paramName =~ s/\^$//; |
2212
|
0
|
|
|
|
|
0
|
$paramName =~ tr/-_a-zA-Z0-9#//dc; |
2213
|
0
|
|
|
|
|
0
|
$param = lc $paramName; |
2214
|
|
|
|
|
|
|
} else { |
2215
|
0
|
|
|
|
|
0
|
($param = lc $newVal) =~ tr/-_a-zA-Z0-9#//dc; |
2216
|
0
|
|
|
|
|
0
|
undef $newVal; |
2217
|
|
|
|
|
|
|
} |
2218
|
0
|
|
|
|
|
0
|
delete $$table{$param}; |
2219
|
0
|
|
|
|
|
0
|
$oldVal = $$options{UserParam}{$param}; |
2220
|
0
|
0
|
|
|
|
0
|
if (defined $newVal) { |
2221
|
0
|
0
|
0
|
|
|
0
|
if (length $newVal or $force) { |
2222
|
0
|
|
|
|
|
0
|
$$options{UserParam}{$param} = $newVal; |
2223
|
0
|
|
|
|
|
0
|
AddTagToTable($table, $param, $paramName); |
2224
|
|
|
|
|
|
|
} else { |
2225
|
0
|
|
|
|
|
0
|
delete $$options{UserParam}{$param}; |
2226
|
|
|
|
|
|
|
} |
2227
|
|
|
|
|
|
|
} |
2228
|
|
|
|
|
|
|
# remove alternate version of tag |
2229
|
0
|
0
|
|
|
|
0
|
$param .= '#' unless $param =~ s/#$//; |
2230
|
0
|
|
|
|
|
0
|
delete $$table{$param}; |
2231
|
0
|
|
|
|
|
0
|
delete $$options{UserParam}{$param}; |
2232
|
|
|
|
|
|
|
} elsif ($param eq 'RequestTags') { |
2233
|
102
|
100
|
|
|
|
512
|
if (defined $newVal) { |
2234
|
|
|
|
|
|
|
# parse list from delimited string if necessary |
2235
|
43
|
50
|
|
|
|
662
|
my @reqList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); |
2236
|
43
|
|
|
|
|
259
|
ExpandShortcuts(\@reqList); |
2237
|
|
|
|
|
|
|
# add to existing list |
2238
|
43
|
50
|
|
|
|
531
|
$$options{$param} or $$options{$param} = [ ]; |
2239
|
43
|
|
|
|
|
198
|
foreach (@reqList) { |
2240
|
63
|
50
|
|
|
|
485
|
/^(.*:)?([-\w?*]*)#?$/ or next; |
2241
|
63
|
50
|
|
|
|
266
|
push @{$$options{$param}}, lc($2) if $2; |
|
63
|
|
|
|
|
302
|
|
2242
|
63
|
50
|
|
|
|
361
|
next unless $1; |
2243
|
|
|
|
|
|
|
# add requested groups with trailing colon |
2244
|
0
|
|
|
|
|
0
|
push @{$$options{$param}}, lc($_).':' foreach split /:/, $1; |
|
0
|
|
|
|
|
0
|
|
2245
|
|
|
|
|
|
|
} |
2246
|
|
|
|
|
|
|
} else { |
2247
|
59
|
|
|
|
|
216
|
$$options{$param} = undef; # clear the list |
2248
|
|
|
|
|
|
|
} |
2249
|
|
|
|
|
|
|
} elsif ($param eq 'IgnoreTags') { |
2250
|
59
|
50
|
|
|
|
343
|
if (defined $newVal) { |
2251
|
|
|
|
|
|
|
# parse list from delimited string if necessary |
2252
|
0
|
0
|
|
|
|
0
|
my @ignoreList = (ref $newVal eq 'ARRAY') ? @$newVal : ($newVal =~ /[-\w?*:]+/g); |
2253
|
0
|
|
|
|
|
0
|
ExpandShortcuts(\@ignoreList); |
2254
|
|
|
|
|
|
|
# add to existing tags to ignore |
2255
|
0
|
0
|
|
|
|
0
|
$$options{$param} or $$options{$param} = { }; |
2256
|
0
|
|
|
|
|
0
|
foreach (@ignoreList) { |
2257
|
0
|
0
|
|
|
|
0
|
/^(.*:)?([-\w?*]+)#?$/ or next; |
2258
|
0
|
|
|
|
|
0
|
$$options{$param}{lc $2} = 1; |
2259
|
|
|
|
|
|
|
} |
2260
|
|
|
|
|
|
|
} else { |
2261
|
59
|
|
|
|
|
298
|
$$options{$param} = undef; # clear the option |
2262
|
|
|
|
|
|
|
} |
2263
|
|
|
|
|
|
|
} elsif ($param eq 'ListJoin') { |
2264
|
10
|
|
|
|
|
33
|
$$options{$param} = $newVal; |
2265
|
|
|
|
|
|
|
# set the old List and ListSep options for backward compatibility |
2266
|
10
|
100
|
|
|
|
42
|
if (defined $newVal) { |
2267
|
4
|
|
|
|
|
12
|
$$options{List} = 0; |
2268
|
4
|
|
|
|
|
18
|
$$options{ListSep} = $newVal; |
2269
|
|
|
|
|
|
|
} else { |
2270
|
6
|
|
|
|
|
28
|
$$options{List} = 1; |
2271
|
|
|
|
|
|
|
# (ListSep must be defined) |
2272
|
|
|
|
|
|
|
} |
2273
|
|
|
|
|
|
|
} elsif ($param eq 'List') { |
2274
|
78
|
|
|
|
|
374
|
$$options{$param} = $newVal; |
2275
|
|
|
|
|
|
|
# set the new ListJoin option for forward compatibility |
2276
|
78
|
50
|
|
|
|
433
|
$$options{ListJoin} = $newVal ? undef : $$options{ListSep}; |
2277
|
|
|
|
|
|
|
} elsif ($param eq 'Compact' or $param eq 'XMPShorthand') { |
2278
|
|
|
|
|
|
|
# set Compact and XMPShorthand options, preserving backward compatibility |
2279
|
1
|
|
|
|
|
7
|
my ($p, %compact); |
2280
|
1
|
|
|
|
|
7
|
foreach $p ('Compact','XMPShorthand') { |
2281
|
2
|
100
|
|
|
|
8
|
my $val = $param eq $p ? $newVal : $$options{Compact}{$p}; |
2282
|
2
|
100
|
|
|
|
7
|
if (defined $val) { |
2283
|
1
|
|
|
|
|
8
|
my @v = ($val =~ /\w+/g); |
2284
|
1
|
50
|
|
|
|
7
|
my $opt = ($p eq 'Compact') ? \%compactOpt : \%xmpShorthandOpt; |
2285
|
1
|
|
|
|
|
4
|
foreach (@v) { |
2286
|
1
|
50
|
|
|
|
7
|
my $set = $$opt{lc $_} or warn("Invalid $p setting '${_}'\n"), return $oldVal; |
2287
|
1
|
50
|
|
|
|
7
|
ref $set or $compact{$set} = 1, next; |
2288
|
0
|
|
|
|
|
0
|
$compact{$_} = 1 foreach @$set; |
2289
|
|
|
|
|
|
|
} |
2290
|
|
|
|
|
|
|
} |
2291
|
2
|
|
|
|
|
7
|
$compact{$p} = $val; # preserve most recent setting |
2292
|
|
|
|
|
|
|
} |
2293
|
1
|
|
|
|
|
6
|
$$options{Compact} = $$options{XMPShorthand} = \%compact; |
2294
|
|
|
|
|
|
|
} else { |
2295
|
4162
|
100
|
66
|
|
|
17402
|
if ($param eq 'Escape') { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
2296
|
|
|
|
|
|
|
# set ESCAPE_PROC |
2297
|
65
|
50
|
66
|
|
|
833
|
if (defined $newVal and $newVal eq 'XML') { |
|
|
100
|
66
|
|
|
|
|
2298
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
2299
|
0
|
|
|
|
|
0
|
$$self{ESCAPE_PROC} = \&Image::ExifTool::XMP::EscapeXML; |
2300
|
|
|
|
|
|
|
} elsif (defined $newVal and $newVal eq 'HTML') { |
2301
|
5
|
|
|
|
|
1511
|
require Image::ExifTool::HTML; |
2302
|
5
|
|
|
|
|
31
|
$$self{ESCAPE_PROC} = \&Image::ExifTool::HTML::EscapeHTML; |
2303
|
|
|
|
|
|
|
} else { |
2304
|
60
|
|
|
|
|
195
|
delete $$self{ESCAPE_PROC}; |
2305
|
|
|
|
|
|
|
} |
2306
|
|
|
|
|
|
|
# must forget saved values since they depend on Escape method |
2307
|
65
|
|
|
|
|
251
|
$$self{BOTH} = { }; |
2308
|
|
|
|
|
|
|
} elsif ($param eq 'GlobalTimeShift') { |
2309
|
60
|
|
|
|
|
292
|
delete $$self{GLOBAL_TIME_OFFSET}; # reset our calculated offset |
2310
|
|
|
|
|
|
|
} elsif ($param eq 'TimeZone' and defined $newVal and length $newVal) { |
2311
|
0
|
|
|
|
|
0
|
$ENV{TZ} = $newVal; |
2312
|
0
|
|
|
|
|
0
|
eval { require POSIX; POSIX::tzset() }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
2313
|
|
|
|
|
|
|
} elsif ($param eq 'Validate') { |
2314
|
|
|
|
|
|
|
# load Validate module if Validate option enabled |
2315
|
60
|
100
|
|
|
|
1067
|
$newVal and require Image::ExifTool::Validate; |
2316
|
|
|
|
|
|
|
} |
2317
|
4162
|
|
|
|
|
10746
|
$$options{$param} = $newVal; |
2318
|
|
|
|
|
|
|
} |
2319
|
|
|
|
|
|
|
} |
2320
|
14652
|
|
|
|
|
49616
|
return $oldVal; |
2321
|
|
|
|
|
|
|
} |
2322
|
|
|
|
|
|
|
|
2323
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2324
|
|
|
|
|
|
|
# ClearOptions - set options to default values |
2325
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2326
|
|
|
|
|
|
|
sub ClearOptions($) |
2327
|
|
|
|
|
|
|
{ |
2328
|
490
|
|
|
490
|
1
|
1202
|
local $_; |
2329
|
490
|
|
|
|
|
1177
|
my $self = shift; |
2330
|
|
|
|
|
|
|
|
2331
|
|
|
|
|
|
|
# create options hash with default values |
2332
|
|
|
|
|
|
|
# +-----------------------------------------------------+ |
2333
|
|
|
|
|
|
|
# ! DON'T FORGET!! When adding any new option, must ! |
2334
|
|
|
|
|
|
|
# ! decide how it is handled in SetNewValuesFromFile() ! |
2335
|
|
|
|
|
|
|
# +-----------------------------------------------------+ |
2336
|
|
|
|
|
|
|
# (Note: All options must exist in this lookup, even if undefined, |
2337
|
|
|
|
|
|
|
# to facilitate case-insensitive options. 'Group#' is handled specially) |
2338
|
|
|
|
|
|
|
$$self{OPTIONS} = { |
2339
|
490
|
|
|
|
|
43199
|
Binary => undef, # flag to extract binary values even if tag not specified |
2340
|
|
|
|
|
|
|
ByteOrder => undef, # default byte order when creating EXIF information |
2341
|
|
|
|
|
|
|
Charset => 'UTF8', # character set for converting Unicode characters |
2342
|
|
|
|
|
|
|
CharsetEXIF => undef, # internal EXIF "ASCII" string encoding |
2343
|
|
|
|
|
|
|
CharsetFileName => undef, # external encoding for file names |
2344
|
|
|
|
|
|
|
CharsetID3 => 'Latin', # internal ID3v1 character set |
2345
|
|
|
|
|
|
|
CharsetIPTC => 'Latin', # fallback IPTC character set if no CodedCharacterSet |
2346
|
|
|
|
|
|
|
CharsetPhotoshop => 'Latin', # internal encoding for Photoshop resource names |
2347
|
|
|
|
|
|
|
CharsetQuickTime => 'MacRoman', # internal QuickTime string encoding |
2348
|
|
|
|
|
|
|
CharsetRIFF => 0, # internal RIFF string encoding (0=default to Latin) |
2349
|
|
|
|
|
|
|
Compact => { }, # write compact XMP |
2350
|
|
|
|
|
|
|
Composite => 1, # flag to calculate Composite tags |
2351
|
|
|
|
|
|
|
Compress => undef, # flag to write new values as compressed if possible |
2352
|
|
|
|
|
|
|
CoordFormat => undef, # GPS lat/long coordinate format |
2353
|
|
|
|
|
|
|
DateFormat => undef, # format for date/time |
2354
|
|
|
|
|
|
|
Duplicates => 1, # flag to save duplicate tag values |
2355
|
|
|
|
|
|
|
Escape => undef, # escape special characters |
2356
|
|
|
|
|
|
|
Exclude => undef, # tags to exclude |
2357
|
|
|
|
|
|
|
ExtendedXMP => 1, # strategy for reading extended XMP |
2358
|
|
|
|
|
|
|
ExtractEmbedded =>undef,# flag to extract information from embedded documents |
2359
|
|
|
|
|
|
|
FastScan => undef, # flag to avoid scanning for trailer |
2360
|
|
|
|
|
|
|
Filter => undef, # output filter for all tag values |
2361
|
|
|
|
|
|
|
FilterW => undef, # input filter when writing tag values |
2362
|
|
|
|
|
|
|
FixBase => undef, # fix maker notes base offsets |
2363
|
|
|
|
|
|
|
GeoMaxIntSecs => 1800, # geotag maximum interpolation time (secs) |
2364
|
|
|
|
|
|
|
GeoMaxExtSecs => 1800, # geotag maximum extrapolation time (secs) |
2365
|
|
|
|
|
|
|
GeoMaxHDOP => undef, # geotag maximum HDOP |
2366
|
|
|
|
|
|
|
GeoMaxPDOP => undef, # geotag maximum PDOP |
2367
|
|
|
|
|
|
|
GeoMinSats => undef, # geotag minimum satellites |
2368
|
|
|
|
|
|
|
GeoSpeedRef => undef, # geotag GPSSpeedRef |
2369
|
|
|
|
|
|
|
GlobalTimeShift => undef, # apply time shift to all extracted date/time values |
2370
|
|
|
|
|
|
|
# Group# => undef, # return tags for specified groups in family # |
2371
|
|
|
|
|
|
|
HexTagIDs => 0, # use hex tag ID's in family 7 group names |
2372
|
|
|
|
|
|
|
HtmlDump => 0, # HTML dump (0-3, higher # = bigger limit) |
2373
|
|
|
|
|
|
|
HtmlDumpBase => undef, # base address for HTML dump |
2374
|
|
|
|
|
|
|
IgnoreMinorErrors => undef, # ignore minor errors when reading/writing |
2375
|
|
|
|
|
|
|
IgnoreTags => undef, # list of tags to ignore when extracting |
2376
|
|
|
|
|
|
|
Lang => $defaultLang,# localized language for descriptions etc |
2377
|
|
|
|
|
|
|
LargeFileSupport => undef, # flag indicating support of 64-bit file offsets |
2378
|
|
|
|
|
|
|
List => undef, # extract lists of PrintConv values into arrays [no longer documented] |
2379
|
|
|
|
|
|
|
ListItem => undef, # used to return a specific item from lists |
2380
|
|
|
|
|
|
|
ListJoin => ', ', # join lists together with this separator |
2381
|
|
|
|
|
|
|
ListSep => ', ', # list item separator [no longer documented] |
2382
|
|
|
|
|
|
|
ListSplit => undef, # regex for splitting list-type tag values when writing |
2383
|
|
|
|
|
|
|
MakerNotes => undef, # extract maker notes as a block |
2384
|
|
|
|
|
|
|
MDItemTags => undef, # extract MacOS metadata item tags |
2385
|
|
|
|
|
|
|
MissingTagValue =>undef,# value for missing tags when expanded in expressions |
2386
|
|
|
|
|
|
|
NoMultiExif => undef, # raise error when writing multi-segment EXIF |
2387
|
|
|
|
|
|
|
NoPDFList => undef, # flag to avoid splitting PDF List-type tag values |
2388
|
|
|
|
|
|
|
Password => undef, # password for password-protected PDF documents |
2389
|
|
|
|
|
|
|
PrintConv => 1, # flag to enable print conversion |
2390
|
|
|
|
|
|
|
QuickTimeHandler => 1, # flag to add mdir Handler to newly created Meta box |
2391
|
|
|
|
|
|
|
QuickTimePad=> undef, # flag to preserve padding of QuickTime CR3 tags |
2392
|
|
|
|
|
|
|
QuickTimeUTC=> undef, # assume that QuickTime date/time tags are stored as UTC |
2393
|
|
|
|
|
|
|
RequestAll => undef, # extract all tags that must be specifically requested |
2394
|
|
|
|
|
|
|
RequestTags => undef, # extra tags to request (on top of those in the tag list) |
2395
|
|
|
|
|
|
|
SaveFormat => undef, # save family 6 tag TIFF format |
2396
|
|
|
|
|
|
|
SavePath => undef, # save family 5 location path |
2397
|
|
|
|
|
|
|
ScanForXMP => undef, # flag to scan for XMP information in all files |
2398
|
|
|
|
|
|
|
Sort => 'Input', # order to sort found tags (Input, File, Tag, Descr, Group#) |
2399
|
|
|
|
|
|
|
Sort2 => 'File', # secondary sort order for tags in a group (File, Tag, Descr) |
2400
|
|
|
|
|
|
|
StrictDate => undef, # flag to return undef for invalid date conversions |
2401
|
|
|
|
|
|
|
Struct => undef, # return structures as hash references |
2402
|
|
|
|
|
|
|
SystemTags => undef, # extract additional File System tags |
2403
|
|
|
|
|
|
|
TextOut => \*STDOUT,# file for Verbose/HtmlDump output |
2404
|
|
|
|
|
|
|
TimeZone => undef, # local time zone |
2405
|
|
|
|
|
|
|
Unknown => 0, # flag to get values of unknown tags (0-2) |
2406
|
|
|
|
|
|
|
UserParam => { }, # user parameters for additional user-defined tag values |
2407
|
|
|
|
|
|
|
Validate => undef, # perform additional validation |
2408
|
|
|
|
|
|
|
Verbose => 0, # print verbose messages (0-5, higher # = more verbose) |
2409
|
|
|
|
|
|
|
WriteMode => 'wcg', # enable all write modes by default |
2410
|
|
|
|
|
|
|
XAttrTags => undef, # extract MacOS extended attribute tags |
2411
|
|
|
|
|
|
|
XMPAutoConv => 1, # automatic conversion of unknown XMP tag values |
2412
|
|
|
|
|
|
|
XMPShorthand=> 0, # (unused, but needed for backward compatibility) |
2413
|
|
|
|
|
|
|
}; |
2414
|
|
|
|
|
|
|
# keep necessary member variables in sync with options |
2415
|
490
|
|
|
|
|
1922
|
delete $$self{CUR_LANG}; |
2416
|
490
|
|
|
|
|
1149
|
delete $$self{ESCAPE_PROC}; |
2417
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
# load user-defined default options |
2419
|
490
|
50
|
|
|
|
2412
|
if (%Image::ExifTool::UserDefined::Options) { |
2420
|
0
|
|
|
|
|
0
|
foreach (keys %Image::ExifTool::UserDefined::Options) { |
2421
|
0
|
|
|
|
|
0
|
$self->Options($_, $Image::ExifTool::UserDefined::Options{$_}); |
2422
|
|
|
|
|
|
|
} |
2423
|
|
|
|
|
|
|
} |
2424
|
|
|
|
|
|
|
} |
2425
|
|
|
|
|
|
|
|
2426
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2427
|
|
|
|
|
|
|
# Extract meta information from image |
2428
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2429
|
|
|
|
|
|
|
# 1-N) Same as ImageInfo() |
2430
|
|
|
|
|
|
|
# Returns: 1 if this was a valid image, 0 otherwise |
2431
|
|
|
|
|
|
|
# Notes: pass an undefined value to avoid parsing arguments |
2432
|
|
|
|
|
|
|
# Internal 'ReEntry' option allows this routine to be called recursively |
2433
|
|
|
|
|
|
|
sub ExtractInfo($;@) |
2434
|
|
|
|
|
|
|
{ |
2435
|
530
|
|
|
530
|
1
|
1501
|
local $_; |
2436
|
530
|
|
|
|
|
1165
|
my $self = shift; |
2437
|
530
|
|
|
|
|
1424
|
my $options = $$self{OPTIONS}; # pointer to current options |
2438
|
530
|
|
100
|
|
|
3036
|
my $fast = $$options{FastScan} || 0; |
2439
|
530
|
|
|
|
|
1629
|
my $req = $$self{REQ_TAG_LOOKUP}; |
2440
|
530
|
|
100
|
|
|
2765
|
my $reqAll = $$options{RequestAll} || 0; |
2441
|
530
|
|
|
|
|
1902
|
my (%saveOptions, $reEntry, $rsize, $zid, $type, @startTime, $saveOrder, $isDir); |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
# check for internal ReEntry option to allow recursive calls to ExtractInfo |
2444
|
530
|
100
|
100
|
|
|
2988
|
if (ref $_[1] eq 'HASH' and $_[1]{ReEntry} and |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2445
|
|
|
|
|
|
|
(ref $_[0] eq 'SCALAR' or ref $_[0] eq 'GLOB')) |
2446
|
|
|
|
|
|
|
{ |
2447
|
|
|
|
|
|
|
# save necessary members for restoring later |
2448
|
|
|
|
|
|
|
$reEntry = { |
2449
|
|
|
|
|
|
|
RAF => $$self{RAF}, |
2450
|
|
|
|
|
|
|
PROCESSED => $$self{PROCESSED}, |
2451
|
|
|
|
|
|
|
EXIF_DATA => $$self{EXIF_DATA}, |
2452
|
|
|
|
|
|
|
EXIF_POS => $$self{EXIF_POS}, |
2453
|
|
|
|
|
|
|
FILE_TYPE => $$self{FILE_TYPE}, |
2454
|
2
|
|
|
|
|
21
|
}; |
2455
|
|
|
|
|
|
|
$saveOrder = GetByteOrder(), |
2456
|
2
|
|
|
|
|
925
|
$$self{RAF} = new File::RandomAccess($_[0]); |
2457
|
2
|
|
|
|
|
146
|
$$self{PROCESSED} = { }; |
2458
|
2
|
|
|
|
|
7
|
delete $$self{EXIF_DATA}; |
2459
|
2
|
|
|
|
|
5
|
delete $$self{EXIF_POS}; |
2460
|
|
|
|
|
|
|
} else { |
2461
|
528
|
100
|
66
|
|
|
5117
|
if (defined $_[0] or $$options{HtmlDump} or $$req{validate}) { |
|
|
|
66
|
|
|
|
|
2462
|
12
|
|
|
|
|
770
|
%saveOptions = %$options; # save original options |
2463
|
|
|
|
|
|
|
|
2464
|
|
|
|
|
|
|
# require duplicates for html dump |
2465
|
12
|
50
|
|
|
|
123
|
$self->Options(Duplicates => 1) if $$options{HtmlDump}; |
2466
|
|
|
|
|
|
|
# enable Validate option if Validate tag is requested |
2467
|
12
|
100
|
|
|
|
63
|
$self->Options(Validate => 1) if $$req{validate}; |
2468
|
|
|
|
|
|
|
|
2469
|
12
|
100
|
|
|
|
52
|
if (defined $_[0]) { |
2470
|
|
|
|
|
|
|
# only initialize filename if called with arguments |
2471
|
11
|
|
|
|
|
41
|
$$self{FILENAME} = undef; # name of file (or '' if we didn't open it) |
2472
|
11
|
|
|
|
|
33
|
$$self{RAF} = undef; # RandomAccess object reference |
2473
|
|
|
|
|
|
|
|
2474
|
11
|
|
|
|
|
61
|
$self->ParseArguments(@_); # initialize from our arguments |
2475
|
|
|
|
|
|
|
} |
2476
|
|
|
|
|
|
|
} |
2477
|
|
|
|
|
|
|
# initialize ExifTool object members |
2478
|
528
|
|
|
|
|
2917
|
$self->Init(); |
2479
|
|
|
|
|
|
|
|
2480
|
528
|
|
|
|
|
1662
|
delete $$self{MAKER_NOTE_FIXUP}; # fixup information for extracted maker notes |
2481
|
528
|
|
|
|
|
1272
|
delete $$self{MAKER_NOTE_BYTE_ORDER}; |
2482
|
|
|
|
|
|
|
|
2483
|
|
|
|
|
|
|
# return our version number |
2484
|
528
|
|
|
|
|
3764
|
$self->FoundTag('ExifToolVersion', "$VERSION$RELEASE"); |
2485
|
528
|
100
|
66
|
|
|
4288
|
$self->FoundTag('Now', $self->TimeNow()) if $$req{now} or $reqAll; |
2486
|
528
|
100
|
66
|
|
|
3858
|
$self->FoundTag('NewGUID', NewGUID()) if $$req{newguid} or $reqAll; |
2487
|
|
|
|
|
|
|
# generate sequence number if necessary |
2488
|
528
|
100
|
66
|
|
|
3390
|
$self->FoundTag('FileSequence', $$self{FILE_SEQUENCE}) if $$req{filesequence} or $reqAll; |
2489
|
|
|
|
|
|
|
|
2490
|
528
|
100
|
66
|
|
|
3309
|
if ($$req{processingtime} or $reqAll) { |
2491
|
61
|
|
|
|
|
191
|
eval { require Time::HiRes; @startTime = Time::HiRes::gettimeofday() }; |
|
61
|
|
|
|
|
9971
|
|
|
61
|
|
|
|
|
24013
|
|
2492
|
61
|
0
|
33
|
|
|
343
|
if (not @startTime and $$req{processingtime}) { |
2493
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Time::HiRes to generate ProcessingTime'); |
2494
|
|
|
|
|
|
|
} |
2495
|
|
|
|
|
|
|
} |
2496
|
|
|
|
|
|
|
|
2497
|
|
|
|
|
|
|
# create MD5 object if ImageDataMD5 is requested |
2498
|
528
|
50
|
33
|
|
|
2451
|
if ($$req{imagedatamd5} and not $$self{ImageDataMD5}) { |
2499
|
0
|
0
|
|
|
|
0
|
if (require Digest::MD5) { |
2500
|
0
|
|
|
|
|
0
|
$$self{ImageDataMD5} = Digest::MD5->new; |
2501
|
|
|
|
|
|
|
} else { |
2502
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Digest::MD5 to calculate image data MD5'); |
2503
|
|
|
|
|
|
|
} |
2504
|
|
|
|
|
|
|
} |
2505
|
528
|
|
|
|
|
1287
|
++$$self{FILE_SEQUENCE}; # count files read |
2506
|
|
|
|
|
|
|
# extract information from alternate files if necessary |
2507
|
528
|
|
|
|
|
1314
|
my ($g8, $altExifTool); |
2508
|
528
|
|
|
|
|
1161
|
foreach $g8 (keys %{$$self{ALT_EXIFTOOL}}) { |
|
528
|
|
|
|
|
2587
|
|
2509
|
8
|
|
|
|
|
31
|
$altExifTool = $$self{ALT_EXIFTOOL}{$g8}; |
2510
|
8
|
100
|
|
|
|
37
|
next if $$altExifTool{DID_EXTRACT}; # avoid extracting twice |
2511
|
6
|
|
|
|
|
90
|
$$altExifTool{OPTIONS} = $$self{OPTIONS}; |
2512
|
6
|
|
|
|
|
19
|
$$altExifTool{GLOBAL_TIME_OFFSET} = $$self{GLOBAL_TIME_OFFSET}; |
2513
|
6
|
|
|
|
|
16
|
$$altExifTool{REQ_TAG_LOOKUP} = $$self{REQ_TAG_LOOKUP}; |
2514
|
6
|
|
|
|
|
62
|
$altExifTool->ExtractInfo($$altExifTool{ALT_FILE}); |
2515
|
|
|
|
|
|
|
# set family 8 group name for all tags |
2516
|
6
|
|
|
|
|
19
|
foreach (keys %{$$altExifTool{VALUE}}) { |
|
6
|
|
|
|
|
148
|
|
2517
|
570
|
|
|
|
|
867
|
my $ex = $$altExifTool{TAG_EXTRA}{$_}; |
2518
|
570
|
100
|
|
|
|
1199
|
$ex or $ex = $$altExifTool{TAG_EXTRA}{$_} = { }; |
2519
|
570
|
|
|
|
|
1169
|
$$ex{G8} = $g8; |
2520
|
|
|
|
|
|
|
} |
2521
|
6
|
|
|
|
|
60
|
$$altExifTool{DID_EXTRACT} = 1; |
2522
|
|
|
|
|
|
|
} |
2523
|
|
|
|
|
|
|
} |
2524
|
|
|
|
|
|
|
|
2525
|
530
|
|
|
|
|
1802
|
my $filename = $$self{FILENAME}; # image file name ('' if already open) |
2526
|
530
|
|
|
|
|
1340
|
my $raf = $$self{RAF}; # RandomAccess object |
2527
|
|
|
|
|
|
|
|
2528
|
530
|
|
|
|
|
1938
|
local *EXIFTOOL_FILE; # avoid clashes with global namespace |
2529
|
|
|
|
|
|
|
|
2530
|
530
|
|
|
|
|
1298
|
my $realname = $filename; |
2531
|
530
|
100
|
|
|
|
1822
|
unless ($raf) { |
2532
|
|
|
|
|
|
|
# save file name |
2533
|
486
|
50
|
33
|
|
|
3200
|
if (defined $filename and $filename ne '') { |
2534
|
486
|
50
|
|
|
|
1929
|
unless ($filename eq '-') { |
2535
|
|
|
|
|
|
|
# extract file name from pipe if necessary |
2536
|
486
|
50
|
|
|
|
2268
|
$realname =~ /\|$/ and $realname =~ s/^.*?"(.*?)".*/$1/s; |
2537
|
486
|
|
|
|
|
2321
|
my ($dir, $name) = SplitFileName($realname); |
2538
|
486
|
|
|
|
|
2230
|
$self->FoundTag('FileName', $name); |
2539
|
486
|
100
|
66
|
|
|
5425
|
if ($$req{basename} or |
|
|
|
66
|
|
|
|
|
2540
|
|
|
|
|
|
|
($reqAll and not $$self{EXCL_TAG_LOOKUP}{basename})) |
2541
|
|
|
|
|
|
|
{ |
2542
|
61
|
50
|
|
|
|
707
|
$self->FoundTag('BaseName', $name =~ /(.*)\./ ? $1 : $name); |
2543
|
|
|
|
|
|
|
} |
2544
|
486
|
50
|
33
|
|
|
4726
|
$self->FoundTag('Directory', $dir) if defined $dir and length $dir; |
2545
|
486
|
100
|
66
|
|
|
5479
|
if ($$req{filepath} or |
|
|
|
66
|
|
|
|
|
2546
|
|
|
|
|
|
|
($reqAll and not $$self{EXCL_TAG_LOOKUP}{filepath})) |
2547
|
|
|
|
|
|
|
{ |
2548
|
61
|
|
|
|
|
428
|
local $SIG{'__WARN__'} = \&SetWarning; |
2549
|
61
|
50
|
|
|
|
223
|
if (eval { require Cwd }) { |
|
61
|
0
|
|
|
|
529
|
|
2550
|
61
|
|
|
|
|
211
|
my $path = eval { Cwd::abs_path($filename) }; |
|
61
|
|
|
|
|
3226
|
|
2551
|
61
|
50
|
|
|
|
552
|
$self->FoundTag('FilePath', $path) if defined $path; |
2552
|
|
|
|
|
|
|
} elsif ($$req{filepath}) { |
2553
|
0
|
|
|
|
|
0
|
$self->WarnOnce('The Perl Cwd module must be installed to use FilePath'); |
2554
|
|
|
|
|
|
|
} |
2555
|
|
|
|
|
|
|
} |
2556
|
|
|
|
|
|
|
# get size of resource fork on Mac OS |
2557
|
486
|
50
|
33
|
|
|
3208
|
$rsize = -s "$filename/..namedfork/rsrc" if $^O eq 'darwin' and not $$self{IN_RESOURCE}; |
2558
|
|
|
|
|
|
|
# check to see if Zone.Identifier file exists in Windows |
2559
|
486
|
50
|
33
|
|
|
2554
|
if ($^O eq 'MSWin32' and eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
2560
|
0
|
|
|
|
|
0
|
my $wattr; |
2561
|
0
|
|
|
|
|
0
|
my $zfile = "${filename}:Zone.Identifier"; |
2562
|
0
|
0
|
|
|
|
0
|
if ($self->EncodeFileName($zfile)) { |
2563
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributesW($zfile) }; |
|
0
|
|
|
|
|
0
|
|
2564
|
|
|
|
|
|
|
} else { |
2565
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributes($zfile) }; |
|
0
|
|
|
|
|
0
|
|
2566
|
|
|
|
|
|
|
} |
2567
|
0
|
0
|
|
|
|
0
|
$zid = 1 unless $wattr == Win32API::File::INVALID_FILE_ATTRIBUTES(); |
2568
|
|
|
|
|
|
|
} |
2569
|
|
|
|
|
|
|
} |
2570
|
|
|
|
|
|
|
# open the file |
2571
|
486
|
50
|
|
|
|
2747
|
if ($self->Open(\*EXIFTOOL_FILE, $filename)) { |
|
|
0
|
|
|
|
|
|
2572
|
|
|
|
|
|
|
# create random access file object |
2573
|
486
|
|
|
|
|
6415
|
$raf = new File::RandomAccess(\*EXIFTOOL_FILE); |
2574
|
|
|
|
|
|
|
# patch to force pipe to be buffered because seek returns success |
2575
|
|
|
|
|
|
|
# in Windows cmd shell pipe even though it really failed |
2576
|
486
|
50
|
33
|
|
|
4415
|
$$raf{TESTED} = -1 if $filename eq '-' or $filename =~ /\|$/; |
2577
|
486
|
|
|
|
|
1657
|
$$self{RAF} = $raf; |
2578
|
|
|
|
|
|
|
} elsif ($self->IsDirectory($filename)) { |
2579
|
0
|
|
|
|
|
0
|
$isDir = 1; |
2580
|
|
|
|
|
|
|
} else { |
2581
|
0
|
|
|
|
|
0
|
$self->Error('Error opening file'); |
2582
|
|
|
|
|
|
|
} |
2583
|
|
|
|
|
|
|
} else { |
2584
|
0
|
|
|
|
|
0
|
$self->Error('No file specified'); |
2585
|
|
|
|
|
|
|
} |
2586
|
|
|
|
|
|
|
} |
2587
|
|
|
|
|
|
|
|
2588
|
530
|
|
33
|
|
|
2967
|
while ($raf or $isDir) { |
2589
|
530
|
|
|
|
|
1489
|
my (@stat, $plainFile); |
2590
|
530
|
100
|
|
|
|
9198
|
if ($reEntry) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2591
|
|
|
|
|
|
|
# we already set these tags |
2592
|
|
|
|
|
|
|
} elsif (not $raf) { |
2593
|
0
|
|
|
|
|
0
|
@stat = stat $filename; |
2594
|
|
|
|
|
|
|
} elsif (not $$raf{FILE_PT}) { |
2595
|
|
|
|
|
|
|
# get file size from image in memory |
2596
|
22
|
|
|
|
|
79
|
$self->FoundTag('FileSize', length ${$$raf{BUFF_PT}}); |
|
22
|
|
|
|
|
110
|
|
2597
|
|
|
|
|
|
|
} elsif (-f $$raf{FILE_PT}) { |
2598
|
|
|
|
|
|
|
# get file tags if this is a plain file |
2599
|
506
|
|
|
|
|
3113
|
@stat = stat _; |
2600
|
506
|
|
|
|
|
1391
|
$plainFile = 1; |
2601
|
|
|
|
|
|
|
# hack to patch Windows daylight savings time bug |
2602
|
506
|
50
|
|
|
|
2592
|
@stat[8,9,10] = $self->GetFileTime($$raf{FILE_PT}) if $^O eq 'MSWin32'; |
2603
|
|
|
|
|
|
|
} else { |
2604
|
|
|
|
|
|
|
# (note that Windows directories will still show the |
2605
|
|
|
|
|
|
|
# daylight savings time bug -- should fix this sometime) |
2606
|
0
|
|
|
|
|
0
|
@stat = stat $$raf{FILE_PT}; |
2607
|
|
|
|
|
|
|
} |
2608
|
530
|
|
|
|
|
1434
|
my $fileSize = $stat[7]; |
2609
|
530
|
100
|
|
|
|
3523
|
$self->FoundTag('FileSize', $stat[7]) if defined $stat[7]; |
2610
|
530
|
50
|
|
|
|
2786
|
$self->FoundTag('ResourceForkSize', $rsize) if $rsize; |
2611
|
530
|
50
|
|
|
|
2825
|
$self->FoundTag('ZoneIdentifier', 'Exists') if $zid; |
2612
|
530
|
100
|
|
|
|
2936
|
$self->FoundTag('FileModifyDate', $stat[9]) if defined $stat[9]; |
2613
|
530
|
100
|
|
|
|
3874
|
$self->FoundTag('FileAccessDate', $stat[8]) if defined $stat[8]; |
2614
|
530
|
50
|
|
|
|
3601
|
my $cTag = $^O eq 'MSWin32' ? 'FileCreateDate' : 'FileInodeChangeDate'; |
2615
|
530
|
100
|
|
|
|
4046
|
$self->FoundTag($cTag, $stat[10]) if defined $stat[10]; |
2616
|
530
|
100
|
|
|
|
4107
|
$self->FoundTag('FilePermissions', $stat[2]) if defined $stat[2]; |
2617
|
|
|
|
|
|
|
# extract more system info if SystemTags option is set |
2618
|
530
|
100
|
|
|
|
3771
|
if (@stat) { |
2619
|
506
|
|
66
|
|
|
4111
|
my $sys = $$options{SystemTags} || ($reqAll and not defined $$options{SystemTags}); |
2620
|
506
|
100
|
66
|
|
|
3499
|
if ($sys or $$req{fileattributes}) { |
2621
|
61
|
|
|
|
|
294
|
my @attr = ($stat[2] & 0xf000, $stat[2] & 0x0e00); |
2622
|
|
|
|
|
|
|
# add Windows file attributes if available |
2623
|
61
|
0
|
33
|
|
|
412
|
if ($^O eq 'MSWin32' and defined $filename and $filename ne '' and $filename ne '-') { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2624
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
2625
|
0
|
0
|
|
|
|
0
|
if (eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
2626
|
0
|
|
|
|
|
0
|
my $wattr; |
2627
|
0
|
|
|
|
|
0
|
my $file = $filename; |
2628
|
0
|
0
|
|
|
|
0
|
if ($self->EncodeFileName($file)) { |
2629
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributesW($file) }; |
|
0
|
|
|
|
|
0
|
|
2630
|
|
|
|
|
|
|
} else { |
2631
|
0
|
|
|
|
|
0
|
$wattr = eval { Win32API::File::GetFileAttributes($file) }; |
|
0
|
|
|
|
|
0
|
|
2632
|
|
|
|
|
|
|
} |
2633
|
0
|
0
|
0
|
|
|
0
|
push @attr, $wattr if defined $wattr and $wattr != 0xffffffff; |
2634
|
|
|
|
|
|
|
} |
2635
|
|
|
|
|
|
|
} |
2636
|
61
|
|
|
|
|
443
|
$self->FoundTag('FileAttributes', "@attr"); |
2637
|
|
|
|
|
|
|
} |
2638
|
506
|
100
|
66
|
|
|
3277
|
$self->FoundTag('FileDeviceNumber', $stat[0]) if $sys or $$req{filedevicenumber}; |
2639
|
506
|
100
|
66
|
|
|
3300
|
$self->FoundTag('FileInodeNumber', $stat[1]) if $sys or $$req{fileinodenumber}; |
2640
|
506
|
100
|
66
|
|
|
3482
|
$self->FoundTag('FileHardLinks', $stat[3]) if $sys or $$req{filehardlinks}; |
2641
|
506
|
100
|
66
|
|
|
4137
|
$self->FoundTag('FileUserID', $stat[4]) if $sys or $$req{fileuserid}; |
2642
|
506
|
100
|
66
|
|
|
3514
|
$self->FoundTag('FileGroupID', $stat[5]) if $sys or $$req{filegroupid}; |
2643
|
506
|
100
|
66
|
|
|
3108
|
$self->FoundTag('FileDeviceID', $stat[6]) if $sys or $$req{filedeviceid}; |
2644
|
506
|
100
|
66
|
|
|
3093
|
$self->FoundTag('FileBlockSize', $stat[11]) if $sys or $$req{fileblocksize}; |
2645
|
506
|
100
|
66
|
|
|
3111
|
$self->FoundTag('FileBlockCount', $stat[12]) if $sys or $$req{fileblockcount}; |
2646
|
|
|
|
|
|
|
} |
2647
|
|
|
|
|
|
|
# extract MDItem tags if requested (only on plain files) |
2648
|
530
|
0
|
33
|
|
|
2766
|
if ($^O eq 'darwin' and defined $filename and $filename ne '' and defined $fileSize) { |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
2649
|
0
|
|
0
|
|
|
0
|
my $reqMacOS = ($reqAll > 1 or $$req{'macos:'}); |
2650
|
0
|
|
0
|
|
|
0
|
my $crDate = ($reqMacOS || $$req{filecreatedate}); |
2651
|
0
|
|
0
|
|
|
0
|
my $mdItem = ($reqMacOS || $$options{MDItemTags} || grep /^mditem/, keys %$req); |
2652
|
0
|
|
0
|
|
|
0
|
my $xattr = ($reqMacOS || $$options{XAttrTags} || grep /^xattr/, keys %$req); |
2653
|
0
|
0
|
0
|
|
|
0
|
if ($crDate or $mdItem or $xattr) { |
|
|
|
0
|
|
|
|
|
2654
|
0
|
|
|
|
|
0
|
require Image::ExifTool::MacOS; |
2655
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::MacOS::GetFileCreateDate($self, $filename) if $crDate; |
2656
|
0
|
0
|
0
|
|
|
0
|
Image::ExifTool::MacOS::ExtractMDItemTags($self, $filename) if $mdItem and $plainFile; |
2657
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::MacOS::ExtractXAttrTags($self, $filename) if $xattr; |
2658
|
|
|
|
|
|
|
} |
2659
|
|
|
|
|
|
|
} |
2660
|
|
|
|
|
|
|
# do whatever else we can with directories, then return |
2661
|
530
|
50
|
66
|
|
|
5374
|
if ($isDir or (defined $stat[2] and ($stat[2] & 0170000) == 0040000)) { |
|
|
|
33
|
|
|
|
|
2662
|
0
|
|
|
|
|
0
|
$self->FoundTag('FileType', 'DIR'); |
2663
|
0
|
|
|
|
|
0
|
$self->FoundTag('FileTypeExtension', ''); |
2664
|
0
|
0
|
|
|
|
0
|
$self->BuildCompositeTags() if $$options{Composite}; |
2665
|
0
|
0
|
|
|
|
0
|
$raf->Close() if $raf; |
2666
|
0
|
|
|
|
|
0
|
return 1; |
2667
|
|
|
|
|
|
|
} |
2668
|
|
|
|
|
|
|
# get list of file types to check |
2669
|
530
|
|
|
|
|
1413
|
my ($tiffType, %noMagic, $recognizedExt); |
2670
|
530
|
|
|
|
|
2059
|
my $ext = $$self{FILE_EXT} = GetFileExtension($realname); |
2671
|
|
|
|
|
|
|
# set $recognizedExt if this file type is recognized by extension only |
2672
|
|
|
|
|
|
|
$recognizedExt = $ext if defined $ext and not defined $magicNumber{$ext} and |
2673
|
530
|
50
|
100
|
|
|
6227
|
defined $moduleName{$ext} and not $moduleName{$ext}; |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
2674
|
530
|
|
|
|
|
3381
|
my @fileTypeList = GetFileType($realname); |
2675
|
530
|
50
|
|
|
|
2260
|
if ($fast >= 4) { |
2676
|
0
|
0
|
|
|
|
0
|
if (@fileTypeList) { |
2677
|
0
|
|
|
|
|
0
|
$type = shift @fileTypeList; |
2678
|
0
|
|
|
|
|
0
|
$self->SetFileType($$self{FILE_TYPE} = $type); |
2679
|
|
|
|
|
|
|
} else { |
2680
|
0
|
|
|
|
|
0
|
$self->Error('Unknown file type'); |
2681
|
|
|
|
|
|
|
} |
2682
|
0
|
0
|
0
|
|
|
0
|
$self->BuildCompositeTags() if $fast == 4 and $$options{Composite}; |
2683
|
0
|
|
|
|
|
0
|
last; # don't read the file |
2684
|
|
|
|
|
|
|
} |
2685
|
530
|
100
|
|
|
|
1888
|
if (@fileTypeList) { |
2686
|
|
|
|
|
|
|
# add remaining types to end of list so we test them all |
2687
|
483
|
|
|
|
|
1916
|
my $pat = join '|', @fileTypeList; |
2688
|
483
|
|
|
|
|
43410
|
push @fileTypeList, grep(!/^($pat)$/, @fileTypes); |
2689
|
483
|
|
|
|
|
2113
|
$tiffType = $$self{FILE_EXT}; |
2690
|
483
|
100
|
|
|
|
2083
|
unless ($fast == 3) { |
2691
|
482
|
|
|
|
|
1679
|
$noMagic{MXF} = 1; # don't do magic number test on MXF or DV files |
2692
|
482
|
|
|
|
|
1693
|
$noMagic{DV} = 1; |
2693
|
|
|
|
|
|
|
} |
2694
|
|
|
|
|
|
|
} else { |
2695
|
|
|
|
|
|
|
# scan through all recognized file types |
2696
|
47
|
|
|
|
|
938
|
@fileTypeList = @fileTypes; |
2697
|
47
|
|
|
|
|
152
|
$tiffType = 'TIFF'; |
2698
|
|
|
|
|
|
|
} |
2699
|
530
|
|
|
|
|
1690
|
push @fileTypeList, ''; # end of list marker |
2700
|
|
|
|
|
|
|
# initialize the input file for seeking in binary data |
2701
|
530
|
|
|
|
|
3462
|
$raf->BinMode(); # set binary mode before we start reading |
2702
|
530
|
|
|
|
|
2216
|
my $pos = $raf->Tell(); # get file position so we can rewind |
2703
|
|
|
|
|
|
|
# loop through list of file types to test |
2704
|
530
|
|
|
|
|
1548
|
my ($buff, $seekErr); |
2705
|
530
|
|
|
|
|
3224
|
my %dirInfo = ( RAF => $raf, Base => $pos, TestBuff => \$buff ); |
2706
|
|
|
|
|
|
|
# read start of file for testing |
2707
|
530
|
50
|
|
|
|
2713
|
$raf->Read($buff, $testLen) or $buff = ''; |
2708
|
530
|
50
|
|
|
|
3326
|
$raf->Seek($pos, 0) or $seekErr = 1; |
2709
|
530
|
|
|
|
|
2968
|
until ($seekErr) { |
2710
|
1925
|
|
|
|
|
3620
|
my $unkHeader; |
2711
|
1925
|
|
|
|
|
3604
|
$type = shift @fileTypeList; |
2712
|
1925
|
50
|
|
|
|
4191
|
if ($type) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2713
|
1925
|
100
|
|
|
|
5747
|
if ($magicNumber{$type}) { |
2714
|
|
|
|
|
|
|
# do quick test for this file type to avoid loading module unnecessarily |
2715
|
1889
|
100
|
100
|
|
|
39532
|
next if $buff !~ /^$magicNumber{$type}/s and not $noMagic{$type}; |
2716
|
|
|
|
|
|
|
} else { |
2717
|
|
|
|
|
|
|
# keep checking for other types if we recognize this file only by extension |
2718
|
36
|
50
|
66
|
|
|
301
|
next if defined $moduleName{$type} and not $moduleName{$type}; |
2719
|
36
|
50
|
|
|
|
136
|
next if $fast > 2; # keep checking if we aren't processing the file |
2720
|
|
|
|
|
|
|
} |
2721
|
570
|
50
|
66
|
|
|
3306
|
next if $weakMagic{$type} and defined $recognizedExt; |
2722
|
|
|
|
|
|
|
} elsif (not defined $type) { |
2723
|
0
|
|
|
|
|
0
|
last; |
2724
|
|
|
|
|
|
|
} elsif ($recognizedExt) { |
2725
|
0
|
|
|
|
|
0
|
$type = $recognizedExt; # set type from recognized file extension only |
2726
|
|
|
|
|
|
|
} else { |
2727
|
|
|
|
|
|
|
# last ditch effort to scan past unknown header for JPEG/TIFF |
2728
|
0
|
0
|
|
|
|
0
|
next unless $buff =~ /(\xff\xd8\xff|MM\0\x2a|II\x2a\0)/g; |
2729
|
0
|
0
|
|
|
|
0
|
$type = ($1 eq "\xff\xd8\xff") ? 'JPEG' : 'TIFF'; |
2730
|
0
|
|
|
|
|
0
|
my $skip = pos($buff) - length($1); |
2731
|
0
|
|
|
|
|
0
|
$dirInfo{Base} = $pos + $skip; |
2732
|
0
|
0
|
|
|
|
0
|
$raf->Seek($pos + $skip, 0) or $seekErr = 1, last; |
2733
|
0
|
|
|
|
|
0
|
$self->Warn("Processing $type-like data after unknown $skip-byte header"); |
2734
|
0
|
0
|
|
|
|
0
|
$unkHeader = 1 unless $$self{DOC_NUM}; |
2735
|
|
|
|
|
|
|
} |
2736
|
|
|
|
|
|
|
# save file type in member variable |
2737
|
570
|
|
|
|
|
2839
|
$$self{FILE_TYPE} = $type; |
2738
|
570
|
100
|
|
|
|
2746
|
$dirInfo{Parent} = ($type eq 'TIFF') ? $tiffType : $type; |
2739
|
|
|
|
|
|
|
# don't process the file when FastScan == 3 |
2740
|
570
|
50
|
66
|
|
|
2614
|
if ($fast == 3 and not $processType{$type}) { |
2741
|
0
|
0
|
0
|
|
|
0
|
unless ($weakMagic{$type} and (not $ext or $ext ne $type)) { |
|
|
|
0
|
|
|
|
|
2742
|
0
|
|
|
|
|
0
|
$self->SetFileType($dirInfo{Parent}); |
2743
|
|
|
|
|
|
|
} |
2744
|
0
|
|
|
|
|
0
|
last; |
2745
|
|
|
|
|
|
|
} |
2746
|
570
|
|
|
|
|
1492
|
my $module = $moduleName{$type}; |
2747
|
570
|
100
|
|
|
|
1836
|
$module = $type unless defined $module; |
2748
|
570
|
|
|
|
|
1756
|
my $func = "Process$type"; |
2749
|
|
|
|
|
|
|
|
2750
|
|
|
|
|
|
|
# load module if necessary |
2751
|
570
|
100
|
|
|
|
2189
|
if ($module) { |
|
|
50
|
|
|
|
|
|
2752
|
305
|
|
|
|
|
24530
|
require "Image/ExifTool/$module.pm"; |
2753
|
305
|
|
|
|
|
1277
|
$func = "Image::ExifTool::${module}::$func"; |
2754
|
|
|
|
|
|
|
} elsif ($module eq '0') { |
2755
|
0
|
|
|
|
|
0
|
$self->SetFileType(); |
2756
|
0
|
|
|
|
|
0
|
$self->Warn('Unsupported file type'); |
2757
|
0
|
|
|
|
|
0
|
last; |
2758
|
|
|
|
|
|
|
} |
2759
|
570
|
|
|
|
|
1168
|
push @{$$self{PATH}}, $type; # save file type in metadata PATH |
|
570
|
|
|
|
|
2244
|
|
2760
|
|
|
|
|
|
|
|
2761
|
|
|
|
|
|
|
# process the file |
2762
|
106
|
|
|
106
|
|
1007
|
no strict 'refs'; |
|
106
|
|
|
|
|
1993
|
|
|
106
|
|
|
|
|
5554
|
|
2763
|
570
|
|
|
|
|
5540
|
my $result = &$func($self, \%dirInfo); |
2764
|
106
|
|
|
106
|
|
705
|
use strict 'refs'; |
|
106
|
|
|
|
|
261
|
|
|
106
|
|
|
|
|
1613268
|
|
2765
|
|
|
|
|
|
|
|
2766
|
570
|
|
|
|
|
1522
|
pop @{$$self{PATH}}; |
|
570
|
|
|
|
|
1964
|
|
2767
|
|
|
|
|
|
|
|
2768
|
570
|
100
|
|
|
|
2051
|
if ($result) { # all done if successful |
2769
|
530
|
50
|
|
|
|
1935
|
if ($unkHeader) { |
2770
|
0
|
|
|
|
|
0
|
$self->DeleteTag('FileType'); |
2771
|
0
|
|
|
|
|
0
|
$self->DeleteTag('FileTypeExtension'); |
2772
|
0
|
|
|
|
|
0
|
$self->DeleteTag('MIMEType'); |
2773
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"Reset file type due to unknown header\n"); |
2774
|
|
|
|
|
|
|
} |
2775
|
530
|
|
|
|
|
1746
|
last; |
2776
|
|
|
|
|
|
|
} |
2777
|
|
|
|
|
|
|
# seek back to try again from the same position in the file |
2778
|
40
|
50
|
|
|
|
140
|
$raf->Seek($pos, 0) or $seekErr = 1, last; |
2779
|
|
|
|
|
|
|
} |
2780
|
530
|
0
|
33
|
|
|
2024
|
if (not defined $type and not $$self{DOC_NUM}) { |
2781
|
|
|
|
|
|
|
# if we were given a single image with a known type there |
2782
|
|
|
|
|
|
|
# must be a format error since we couldn't read it, otherwise |
2783
|
|
|
|
|
|
|
# it is likely we don't support images of this type |
2784
|
0
|
|
0
|
|
|
0
|
my $fileType = GetFileType($realname) || ''; |
2785
|
0
|
|
|
|
|
0
|
my $err; |
2786
|
0
|
0
|
|
|
|
0
|
if (not length $buff) { |
2787
|
0
|
|
|
|
|
0
|
$err = 'File is empty'; |
2788
|
|
|
|
|
|
|
} else { |
2789
|
0
|
|
|
|
|
0
|
my $ch = substr($buff, 0, 1); |
2790
|
0
|
0
|
0
|
|
|
0
|
if (length $buff < 16 or $buff =~ /[^\Q$ch\E]/) { |
2791
|
0
|
0
|
|
|
|
0
|
if ($fileType eq 'RAW') { |
|
|
0
|
|
|
|
|
|
2792
|
0
|
|
|
|
|
0
|
$err = 'Unsupported RAW file type'; |
2793
|
|
|
|
|
|
|
} elsif ($fileType) { |
2794
|
0
|
|
|
|
|
0
|
$err = 'File format error'; |
2795
|
|
|
|
|
|
|
} else { |
2796
|
0
|
|
|
|
|
0
|
$err = 'Unknown file type'; |
2797
|
|
|
|
|
|
|
} |
2798
|
|
|
|
|
|
|
} else { |
2799
|
|
|
|
|
|
|
# provide some insight into the content of some corrupted files |
2800
|
0
|
0
|
|
|
|
0
|
if ($$self{OPTIONS}{FastScan}) { |
2801
|
0
|
|
|
|
|
0
|
$err = 'File header is all'; |
2802
|
|
|
|
|
|
|
} else { |
2803
|
0
|
|
|
|
|
0
|
my $num = 0; |
2804
|
0
|
|
|
|
|
0
|
for (;;) { |
2805
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, 65536) or undef($num), last; |
2806
|
0
|
0
|
|
|
|
0
|
$buff =~ /[^\Q$ch\E]/g and $num += pos($buff) - 1, last; |
2807
|
0
|
|
|
|
|
0
|
$num += length($buff); |
2808
|
|
|
|
|
|
|
} |
2809
|
0
|
0
|
|
|
|
0
|
if ($num) { |
2810
|
0
|
|
|
|
|
0
|
$err = 'First ' . ConvertFileSize($num) . ' of file is'; |
2811
|
|
|
|
|
|
|
} else { |
2812
|
0
|
|
|
|
|
0
|
$err = 'Entire file is'; |
2813
|
|
|
|
|
|
|
} |
2814
|
|
|
|
|
|
|
} |
2815
|
0
|
0
|
|
|
|
0
|
if ($ch eq "\0") { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
2816
|
0
|
|
|
|
|
0
|
$err .= ' binary zeros'; |
2817
|
|
|
|
|
|
|
} elsif ($ch eq ' ') { |
2818
|
0
|
|
|
|
|
0
|
$err .= ' ASCII spaces'; |
2819
|
|
|
|
|
|
|
} elsif ($ch =~ /[a-zA-Z0-9]/) { |
2820
|
0
|
|
|
|
|
0
|
$err .= " ASCII '${ch}' characters"; |
2821
|
|
|
|
|
|
|
} else { |
2822
|
0
|
|
|
|
|
0
|
$err .= sprintf(" binary 0x%.2x's", ord $ch); |
2823
|
|
|
|
|
|
|
} |
2824
|
|
|
|
|
|
|
} |
2825
|
|
|
|
|
|
|
} |
2826
|
0
|
|
|
|
|
0
|
$self->Error($err); |
2827
|
|
|
|
|
|
|
} |
2828
|
530
|
50
|
0
|
|
|
2823
|
if ($seekErr) { |
|
|
50
|
33
|
|
|
|
|
2829
|
0
|
|
|
|
|
0
|
$self->Error('Error seeking in file'); |
2830
|
|
|
|
|
|
|
} elsif ($self->Options('ScanForXMP') and (not defined $type or |
2831
|
|
|
|
|
|
|
(not $fast and not $$self{FoundXMP}))) |
2832
|
|
|
|
|
|
|
{ |
2833
|
|
|
|
|
|
|
# scan for XMP |
2834
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
2835
|
0
|
|
|
|
|
0
|
require Image::ExifTool::XMP; |
2836
|
0
|
0
|
|
|
|
0
|
Image::ExifTool::XMP::ScanForXMP($self, $raf) and $type = ''; |
2837
|
|
|
|
|
|
|
} |
2838
|
|
|
|
|
|
|
# extract binary EXIF data block only if requested |
2839
|
530
|
100
|
100
|
|
|
6805
|
if (defined $$self{EXIF_DATA} and length $$self{EXIF_DATA} > 16 and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
2840
|
|
|
|
|
|
|
($$req{exif} or |
2841
|
|
|
|
|
|
|
# (not extracted normally, so check TAGS_FROM_FILE) |
2842
|
|
|
|
|
|
|
($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{exif}))) |
2843
|
|
|
|
|
|
|
{ |
2844
|
37
|
|
|
|
|
166
|
$self->FoundTag('EXIF', $$self{EXIF_DATA}); |
2845
|
|
|
|
|
|
|
} |
2846
|
530
|
100
|
|
|
|
2080
|
unless ($reEntry) { |
2847
|
528
|
|
|
|
|
2194
|
$$self{PATH} = [ ]; # reset PATH |
2848
|
|
|
|
|
|
|
# calculate Composite tags |
2849
|
528
|
100
|
|
|
|
3877
|
$self->BuildCompositeTags() if $$options{Composite}; |
2850
|
|
|
|
|
|
|
# do our HTML dump if requested |
2851
|
528
|
50
|
|
|
|
2723
|
if ($$self{HTML_DUMP}) { |
2852
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); # seek to end of file |
2853
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->FinishTiffDump($self, $raf->Tell()); |
2854
|
0
|
|
|
|
|
0
|
my $pos = $$options{HtmlDumpBase}; |
2855
|
0
|
0
|
0
|
|
|
0
|
$pos = ($$self{FIRST_EXIF_POS} || 0) unless defined $pos; |
2856
|
0
|
0
|
|
|
|
0
|
my $dataPt = defined $$self{EXIF_DATA} ? \$$self{EXIF_DATA} : undef; |
2857
|
0
|
0
|
0
|
|
|
0
|
undef $dataPt if defined $$self{EXIF_POS} and $pos != $$self{EXIF_POS}; |
2858
|
0
|
0
|
|
|
|
0
|
undef $dataPt if $$self{ExtendedEXIF}; # can't use EXIF block if not contiguous |
2859
|
|
|
|
|
|
|
my $success = $$self{HTML_DUMP}->Print($raf, $dataPt, $pos, |
2860
|
|
|
|
|
|
|
$$options{TextOut}, $$options{HtmlDump}, |
2861
|
0
|
0
|
|
|
|
0
|
$$self{FILENAME} ? "HTML Dump ($$self{FILENAME})" : 'HTML Dump'); |
2862
|
0
|
0
|
|
|
|
0
|
$self->Warn("Error reading $$self{HTML_DUMP}{ERROR}") if $success < 0; |
2863
|
|
|
|
|
|
|
} |
2864
|
|
|
|
|
|
|
} |
2865
|
530
|
100
|
|
|
|
2185
|
if ($filename) { |
2866
|
488
|
|
|
|
|
3409
|
$raf->Close(); # close the file if we opened it |
2867
|
|
|
|
|
|
|
# process the resource fork as an embedded file on Mac filesystems |
2868
|
488
|
0
|
33
|
|
|
2024
|
if ($rsize and $$options{ExtractEmbedded}) { |
2869
|
0
|
|
|
|
|
0
|
local *RESOURCE_FILE; |
2870
|
0
|
0
|
|
|
|
0
|
if ($self->Open(\*RESOURCE_FILE, "$filename/..namedfork/rsrc")) { |
2871
|
0
|
|
|
|
|
0
|
$$self{DOC_NUM} = $$self{DOC_COUNT} + 1; |
2872
|
0
|
|
|
|
|
0
|
$$self{IN_RESOURCE} = 1; |
2873
|
0
|
|
|
|
|
0
|
$self->ExtractInfo(\*RESOURCE_FILE, { ReEntry => 1 }); |
2874
|
0
|
|
|
|
|
0
|
close RESOURCE_FILE; |
2875
|
0
|
|
|
|
|
0
|
delete $$self{IN_RESOURCE}; |
2876
|
|
|
|
|
|
|
} else { |
2877
|
0
|
|
|
|
|
0
|
$self->Warn('Error opening resource fork'); |
2878
|
|
|
|
|
|
|
} |
2879
|
|
|
|
|
|
|
} |
2880
|
|
|
|
|
|
|
} |
2881
|
530
|
|
|
|
|
9079
|
last; # (loop was a cheap "goto") |
2882
|
|
|
|
|
|
|
} |
2883
|
|
|
|
|
|
|
|
2884
|
|
|
|
|
|
|
# generate Validate tag if requested |
2885
|
530
|
100
|
66
|
|
|
2466
|
if ($$options{Validate} and not $reEntry) { |
2886
|
1
|
|
|
|
|
7
|
Image::ExifTool::Validate::FinishValidate($self, $$req{validate}); |
2887
|
|
|
|
|
|
|
} |
2888
|
|
|
|
|
|
|
|
2889
|
530
|
100
|
|
|
|
2327
|
@startTime and $self->FoundTag('ProcessingTime', Time::HiRes::tv_interval(\@startTime)); |
2890
|
|
|
|
|
|
|
|
2891
|
|
|
|
|
|
|
# add user-defined parameters that ended with '!' |
2892
|
530
|
50
|
|
|
|
1233
|
if (%{$$options{UserParam}}) { |
|
530
|
|
|
|
|
2320
|
|
2893
|
0
|
|
|
|
|
0
|
my $doMsg = $$options{Verbose}; |
2894
|
0
|
|
|
|
|
0
|
my $table = GetTagTable('Image::ExifTool::UserParam'); |
2895
|
0
|
|
|
|
|
0
|
foreach (sort keys %{$$options{UserParam}}) { |
|
0
|
|
|
|
|
0
|
|
2896
|
0
|
0
|
|
|
|
0
|
next unless /#$/; |
2897
|
0
|
0
|
|
|
|
0
|
if ($doMsg) { |
2898
|
0
|
|
|
|
|
0
|
$self->VPrint(0, "UserParam tags:\n"); |
2899
|
0
|
|
|
|
|
0
|
undef $doMsg; |
2900
|
|
|
|
|
|
|
} |
2901
|
0
|
|
|
|
|
0
|
$self->HandleTag($table, $_, $$options{UserParam}{$_}); |
2902
|
|
|
|
|
|
|
} |
2903
|
|
|
|
|
|
|
} |
2904
|
|
|
|
|
|
|
|
2905
|
|
|
|
|
|
|
# restore original options |
2906
|
530
|
100
|
|
|
|
1883
|
%saveOptions and $$self{OPTIONS} = \%saveOptions; |
2907
|
|
|
|
|
|
|
|
2908
|
530
|
100
|
|
|
|
2734
|
if ($reEntry) { |
|
|
50
|
|
|
|
|
|
2909
|
|
|
|
|
|
|
# restore necessary members when exiting re-entrant code |
2910
|
2
|
|
|
|
|
17
|
$$self{$_} = $$reEntry{$_} foreach keys %$reEntry; |
2911
|
2
|
|
|
|
|
8
|
SetByteOrder($saveOrder); |
2912
|
|
|
|
|
|
|
} elsif ($$self{ImageDataMD5}) { |
2913
|
0
|
|
|
|
|
0
|
my $digest = $$self{ImageDataMD5}->hexdigest; |
2914
|
|
|
|
|
|
|
# (don't store empty digest) |
2915
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(ImageDataMD5 => $digest) unless $digest eq 'd41d8cd98f00b204e9800998ecf8427e'; |
2916
|
|
|
|
|
|
|
} |
2917
|
|
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
# ($type may be undef without an Error when processing sub-documents) |
2919
|
530
|
50
|
33
|
|
|
4174
|
return 0 if not defined $type or exists $$self{VALUE}{Error}; |
2920
|
530
|
|
|
|
|
3210
|
return 1; |
2921
|
|
|
|
|
|
|
} |
2922
|
|
|
|
|
|
|
|
2923
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2924
|
|
|
|
|
|
|
# Get hash of extracted meta information |
2925
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
2926
|
|
|
|
|
|
|
# 1-N) options hash reference, tag list reference or tag names |
2927
|
|
|
|
|
|
|
# Returns: Reference to information hash |
2928
|
|
|
|
|
|
|
# Notes: - pass an undefined value to avoid parsing arguments |
2929
|
|
|
|
|
|
|
# - If groups are specified, first groups take precedence if duplicate |
2930
|
|
|
|
|
|
|
# tags found but Duplicates option not set. |
2931
|
|
|
|
|
|
|
# - tag names may end in '#' to extract ValueConv value |
2932
|
|
|
|
|
|
|
sub GetInfo($;@) |
2933
|
|
|
|
|
|
|
{ |
2934
|
699
|
|
|
699
|
1
|
4140
|
local $_; |
2935
|
699
|
|
|
|
|
1496
|
my $self = shift; |
2936
|
699
|
|
|
|
|
1528
|
my %saveOptions; |
2937
|
|
|
|
|
|
|
|
2938
|
699
|
100
|
66
|
|
|
4473
|
unless (@_ and not defined $_[0]) { |
2939
|
182
|
|
|
|
|
431
|
%saveOptions = %{$$self{OPTIONS}}; # save original options |
|
182
|
|
|
|
|
12275
|
|
2940
|
|
|
|
|
|
|
# must set FILENAME so it isn't parsed from the arguments |
2941
|
182
|
100
|
|
|
|
1925
|
$$self{FILENAME} = '' unless defined $$self{FILENAME}; |
2942
|
182
|
|
|
|
|
1116
|
$self->ParseArguments(@_); |
2943
|
|
|
|
|
|
|
} |
2944
|
|
|
|
|
|
|
|
2945
|
|
|
|
|
|
|
# get reference to list of tags for which we will return info |
2946
|
699
|
|
|
|
|
3548
|
my ($rtnTags, $byValue, $wildTags) = $self->SetFoundTags(); |
2947
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
# build hash of tag information |
2949
|
699
|
|
|
|
|
1712
|
my (%info, %ignored); |
2950
|
699
|
100
|
|
|
|
2865
|
my $conv = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; |
2951
|
699
|
|
|
|
|
2280
|
foreach (@$rtnTags) { |
2952
|
35699
|
|
|
|
|
71692
|
my $val = $self->GetValue($_, $conv); |
2953
|
35699
|
100
|
|
|
|
70658
|
defined $val or $ignored{$_} = 1, next; |
2954
|
34733
|
|
|
|
|
85453
|
$info{$_} = $val; |
2955
|
|
|
|
|
|
|
} |
2956
|
|
|
|
|
|
|
|
2957
|
|
|
|
|
|
|
# override specified tags with ValueConv value if necessary |
2958
|
699
|
100
|
|
|
|
3845
|
if (@$byValue) { |
2959
|
|
|
|
|
|
|
# first determine the number of times each non-ValueConv value is used |
2960
|
4
|
|
|
|
|
14
|
my %nonVal; |
2961
|
4
|
|
100
|
|
|
85
|
$nonVal{$_} = ($nonVal{$_} || 0) + 1 foreach @$rtnTags; |
2962
|
4
|
|
|
|
|
22
|
--$nonVal{$$rtnTags[$_]} foreach @$byValue; |
2963
|
|
|
|
|
|
|
# loop through ValueConv tags, updating tag keys and returned values |
2964
|
4
|
|
|
|
|
14
|
foreach (@$byValue) { |
2965
|
25
|
|
|
|
|
41
|
my $tag = $$rtnTags[$_]; |
2966
|
25
|
|
|
|
|
59
|
my $val = $self->GetValue($tag, 'ValueConv'); |
2967
|
25
|
100
|
|
|
|
54
|
next unless defined $val; |
2968
|
16
|
|
|
|
|
40
|
my $vtag = $tag; |
2969
|
|
|
|
|
|
|
# generate a new tag key like "Tag #" or "Tag #(1)" |
2970
|
16
|
|
|
|
|
93
|
$vtag =~ s/( |$)/ #/; |
2971
|
16
|
50
|
|
|
|
54
|
unless (defined $$self{VALUE}{$vtag}) { |
2972
|
16
|
|
|
|
|
43
|
$$self{VALUE}{$vtag} = $$self{VALUE}{$tag}; |
2973
|
16
|
|
|
|
|
43
|
$$self{TAG_INFO}{$vtag} = $$self{TAG_INFO}{$tag}; |
2974
|
16
|
|
|
|
|
32
|
$$self{TAG_EXTRA}{$vtag} = $$self{TAG_EXTRA}{$tag}; |
2975
|
16
|
|
|
|
|
37
|
$$self{FILE_ORDER}{$vtag} = $$self{FILE_ORDER}{$tag}; |
2976
|
|
|
|
|
|
|
# remove existing PrintConv entry unless we are using it too |
2977
|
16
|
100
|
|
|
|
42
|
delete $info{$tag} unless $nonVal{$tag}; |
2978
|
|
|
|
|
|
|
} |
2979
|
16
|
|
|
|
|
31
|
$$rtnTags[$_] = $vtag; # store ValueConv value with new tag key |
2980
|
16
|
|
|
|
|
46
|
$info{$vtag} = $val; # return ValueConv value |
2981
|
|
|
|
|
|
|
} |
2982
|
|
|
|
|
|
|
} |
2983
|
|
|
|
|
|
|
|
2984
|
|
|
|
|
|
|
# remove ignored tags from the list |
2985
|
699
|
|
50
|
|
|
3391
|
my $reqTags = $$self{REQUESTED_TAGS} || [ ]; |
2986
|
699
|
100
|
|
|
|
2421
|
if (%ignored) { |
2987
|
411
|
100
|
|
|
|
2010
|
if (not @$reqTags) { |
|
|
100
|
|
|
|
|
|
2988
|
194
|
|
|
|
|
419
|
my @goodTags; |
2989
|
194
|
|
|
|
|
684
|
foreach (@$rtnTags) { |
2990
|
22881
|
100
|
|
|
|
46601
|
push @goodTags, $_ unless $ignored{$_}; |
2991
|
|
|
|
|
|
|
} |
2992
|
194
|
|
|
|
|
2043
|
$rtnTags = $$self{FOUND_TAGS} = \@goodTags; |
2993
|
|
|
|
|
|
|
} elsif (@$wildTags) { |
2994
|
|
|
|
|
|
|
# only remove tags specified by wildcard |
2995
|
41
|
|
|
|
|
73
|
my @goodTags; |
2996
|
41
|
|
|
|
|
101
|
my $i = 0; |
2997
|
41
|
|
|
|
|
103
|
foreach (@$rtnTags) { |
2998
|
356
|
100
|
100
|
|
|
963
|
if (@$wildTags and $i == $$wildTags[0]) { |
2999
|
197
|
|
|
|
|
302
|
shift @$wildTags; |
3000
|
197
|
50
|
|
|
|
500
|
push @goodTags, $_ unless $ignored{$_}; |
3001
|
|
|
|
|
|
|
} else { |
3002
|
159
|
|
|
|
|
284
|
push @goodTags, $_; |
3003
|
|
|
|
|
|
|
} |
3004
|
356
|
|
|
|
|
517
|
++$i; |
3005
|
|
|
|
|
|
|
} |
3006
|
41
|
|
|
|
|
264
|
$rtnTags = $$self{FOUND_TAGS} = \@goodTags; |
3007
|
|
|
|
|
|
|
} |
3008
|
|
|
|
|
|
|
} |
3009
|
|
|
|
|
|
|
|
3010
|
|
|
|
|
|
|
# return sorted tag list if provided with a list reference |
3011
|
699
|
100
|
|
|
|
2781
|
if ($$self{IO_TAG_LIST}) { |
3012
|
|
|
|
|
|
|
# use file order by default if no tags specified |
3013
|
|
|
|
|
|
|
# (no such thing as 'Input' order in this case) |
3014
|
6
|
|
|
|
|
21
|
my $sort = $$self{OPTIONS}{Sort}; |
3015
|
6
|
50
|
33
|
|
|
44
|
$sort = 'File' unless @$reqTags or ($sort and $sort ne 'Input'); |
|
|
|
66
|
|
|
|
|
3016
|
|
|
|
|
|
|
# return tags in specified sort order |
3017
|
6
|
|
|
|
|
35
|
@{$$self{IO_TAG_LIST}} = $self->GetTagList($rtnTags, $sort, $$self{OPTIONS}{Sort2}); |
|
6
|
|
|
|
|
42
|
|
3018
|
|
|
|
|
|
|
} |
3019
|
|
|
|
|
|
|
|
3020
|
|
|
|
|
|
|
# restore original options |
3021
|
699
|
100
|
|
|
|
4012
|
%saveOptions and $$self{OPTIONS} = \%saveOptions; |
3022
|
|
|
|
|
|
|
|
3023
|
699
|
|
|
|
|
3584
|
return \%info; |
3024
|
|
|
|
|
|
|
} |
3025
|
|
|
|
|
|
|
|
3026
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3027
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3028
|
|
|
|
|
|
|
# 1) [optional] reference to info hash or tag list ref (default is found tags) |
3029
|
|
|
|
|
|
|
# 2) [optional] sort order ('File', 'Input', ...) |
3030
|
|
|
|
|
|
|
# 3) [optional] secondary sort order |
3031
|
|
|
|
|
|
|
# Returns: List of tags in specified order |
3032
|
|
|
|
|
|
|
sub GetTagList($;$$$) |
3033
|
|
|
|
|
|
|
{ |
3034
|
436
|
|
|
436
|
1
|
83544
|
local $_; |
3035
|
436
|
|
|
|
|
1846
|
my ($self, $info, $sort, $sort2) = @_; |
3036
|
|
|
|
|
|
|
|
3037
|
436
|
|
|
|
|
1014
|
my $foundTags; |
3038
|
436
|
100
|
|
|
|
2307
|
if (ref $info eq 'HASH') { |
|
|
50
|
|
|
|
|
|
3039
|
429
|
|
|
|
|
6193
|
my @tags = keys %$info; |
3040
|
429
|
|
|
|
|
1668
|
$foundTags = \@tags; |
3041
|
|
|
|
|
|
|
} elsif (ref $info eq 'ARRAY') { |
3042
|
7
|
|
|
|
|
19
|
$foundTags = $info; |
3043
|
|
|
|
|
|
|
} |
3044
|
436
|
|
|
|
|
1413
|
my $fileOrder = $$self{FILE_ORDER}; |
3045
|
|
|
|
|
|
|
|
3046
|
436
|
50
|
|
|
|
1528
|
if ($foundTags) { |
3047
|
|
|
|
|
|
|
# make sure a FILE_ORDER entry exists for all tags |
3048
|
|
|
|
|
|
|
# (note: already generated bogus entries for FOUND_TAGS case below) |
3049
|
436
|
|
|
|
|
1536
|
foreach (@$foundTags) { |
3050
|
24342
|
50
|
|
|
|
46028
|
next if defined $$fileOrder{$_}; |
3051
|
0
|
|
|
|
|
0
|
$$fileOrder{$_} = 999; |
3052
|
|
|
|
|
|
|
} |
3053
|
|
|
|
|
|
|
} else { |
3054
|
0
|
0
|
0
|
|
|
0
|
$sort = $info if $info and not $sort; |
3055
|
0
|
0
|
0
|
|
|
0
|
$foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; |
3056
|
|
|
|
|
|
|
} |
3057
|
436
|
100
|
|
|
|
2127
|
$sort or $sort = $$self{OPTIONS}{Sort}; |
3058
|
|
|
|
|
|
|
|
3059
|
|
|
|
|
|
|
# return original list if no sort order specified |
3060
|
436
|
100
|
66
|
|
|
3323
|
return @$foundTags unless $sort and $sort ne 'Input'; |
3061
|
|
|
|
|
|
|
|
3062
|
417
|
50
|
33
|
|
|
5346
|
if ($sort eq 'Tag' or $sort eq 'Alpha') { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
3063
|
0
|
|
|
|
|
0
|
return sort @$foundTags; |
3064
|
|
|
|
|
|
|
} elsif ($sort =~ /^Group(\d*(:\d+)*)/) { |
3065
|
414
|
|
50
|
|
|
2599
|
my $family = $1 || 0; |
3066
|
|
|
|
|
|
|
# want to maintain a basic file order with the groups |
3067
|
|
|
|
|
|
|
# ordered in the way they appear in the file |
3068
|
414
|
|
|
|
|
1063
|
my (%groupCount, %groupOrder); |
3069
|
414
|
|
|
|
|
903
|
my $numGroups = 0; |
3070
|
414
|
|
|
|
|
877
|
my $tag; |
3071
|
414
|
|
|
|
|
2528
|
foreach $tag (sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags) { |
|
131061
|
|
|
|
|
176859
|
|
3072
|
23459
|
|
|
|
|
41075
|
my $group = $self->GetGroup($tag, $family); |
3073
|
23459
|
|
|
|
|
38770
|
my $num = $groupCount{$group}; |
3074
|
23459
|
100
|
|
|
|
40791
|
$num or $num = $groupCount{$group} = ++$numGroups; |
3075
|
23459
|
|
|
|
|
46297
|
$groupOrder{$tag} = $num; |
3076
|
|
|
|
|
|
|
} |
3077
|
414
|
50
|
|
|
|
3001
|
$sort2 or $sort2 = $$self{OPTIONS}{Sort2}; |
3078
|
414
|
50
|
|
|
|
1630
|
if ($sort2) { |
3079
|
414
|
50
|
33
|
|
|
3574
|
if ($sort2 eq 'Tag' or $sort2 eq 'Alpha') { |
|
|
50
|
|
|
|
|
|
3080
|
0
|
0
|
|
|
|
0
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or $a cmp $b } @$foundTags; |
|
0
|
|
|
|
|
0
|
|
3081
|
|
|
|
|
|
|
} elsif ($sort2 eq 'Descr') { |
3082
|
0
|
|
|
|
|
0
|
my $desc = $self->GetDescriptions($foundTags); |
3083
|
0
|
|
|
|
|
0
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or |
3084
|
0
|
0
|
|
|
|
0
|
$$desc{$a} cmp $$desc{$b} } @$foundTags; |
3085
|
|
|
|
|
|
|
} |
3086
|
|
|
|
|
|
|
} |
3087
|
414
|
|
|
|
|
2269
|
return sort { $groupOrder{$a} <=> $groupOrder{$b} or |
3088
|
131111
|
50
|
|
|
|
235873
|
$$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; |
3089
|
|
|
|
|
|
|
} elsif ($sort eq 'Descr') { |
3090
|
0
|
|
|
|
|
0
|
my $desc = $self->GetDescriptions($foundTags); |
3091
|
0
|
|
|
|
|
0
|
return sort { $$desc{$a} cmp $$desc{$b} } @$foundTags; |
|
0
|
|
|
|
|
0
|
|
3092
|
|
|
|
|
|
|
} else { |
3093
|
3
|
|
|
|
|
23
|
return sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @$foundTags; |
|
4723
|
|
|
|
|
6285
|
|
3094
|
|
|
|
|
|
|
} |
3095
|
|
|
|
|
|
|
} |
3096
|
|
|
|
|
|
|
|
3097
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3098
|
|
|
|
|
|
|
# Get list of found tags in specified sort order |
3099
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) sort order ('File', 'Input', ...) |
3100
|
|
|
|
|
|
|
# 2) secondary sort order |
3101
|
|
|
|
|
|
|
# Returns: List of tag keys in specified order |
3102
|
|
|
|
|
|
|
# Notes: If not specified, sort order is taken from OPTIONS |
3103
|
|
|
|
|
|
|
sub GetFoundTags($;$$) |
3104
|
|
|
|
|
|
|
{ |
3105
|
1
|
|
|
1
|
1
|
173
|
local $_; |
3106
|
1
|
|
|
|
|
4
|
my ($self, $sort, $sort2) = @_; |
3107
|
1
|
50
|
33
|
|
|
7
|
my $foundTags = $$self{FOUND_TAGS} || $self->SetFoundTags() or return undef; |
3108
|
1
|
|
|
|
|
7
|
return $self->GetTagList($foundTags, $sort, $sort2); |
3109
|
|
|
|
|
|
|
} |
3110
|
|
|
|
|
|
|
|
3111
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3112
|
|
|
|
|
|
|
# Get list of requested tags |
3113
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3114
|
|
|
|
|
|
|
# Returns: List of requested tag keys |
3115
|
|
|
|
|
|
|
sub GetRequestedTags($) |
3116
|
|
|
|
|
|
|
{ |
3117
|
2
|
|
|
2
|
1
|
4
|
local $_; |
3118
|
2
|
|
|
|
|
5
|
return @{$_[0]{REQUESTED_TAGS}}; |
|
2
|
|
|
|
|
12
|
|
3119
|
|
|
|
|
|
|
} |
3120
|
|
|
|
|
|
|
|
3121
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3122
|
|
|
|
|
|
|
# Get tag value |
3123
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3124
|
|
|
|
|
|
|
# 1) tag key or tag name with optional group names (case sensitive) |
3125
|
|
|
|
|
|
|
# (or flattened tagInfo for getting field values, not part of public API) |
3126
|
|
|
|
|
|
|
# 2) [optional] Value type: PrintConv, ValueConv, Both, Raw or Rational, the default |
3127
|
|
|
|
|
|
|
# is PrintConv or ValueConv, depending on the PrintConv option setting |
3128
|
|
|
|
|
|
|
# 3) raw field value (not part of public API) |
3129
|
|
|
|
|
|
|
# Returns: Scalar context: tag value or undefined |
3130
|
|
|
|
|
|
|
# List context: list of values or empty list |
3131
|
|
|
|
|
|
|
sub GetValue($$;$) |
3132
|
|
|
|
|
|
|
{ |
3133
|
53826
|
|
|
53826
|
1
|
72652
|
local $_; |
3134
|
53826
|
|
|
|
|
95017
|
my ($self, $tag, $type) = @_; # plus: ($fieldValue) |
3135
|
53826
|
|
|
|
|
73429
|
my (@convTypes, $tagInfo, $valueConv, $both); |
3136
|
53826
|
|
|
|
|
77364
|
my $rawValue = $$self{VALUE}; |
3137
|
|
|
|
|
|
|
|
3138
|
|
|
|
|
|
|
# get specific tag key if tag has a group name |
3139
|
53826
|
50
|
|
|
|
117105
|
if ($tag =~ /^(.*):(.+)/) { |
3140
|
0
|
|
|
|
|
0
|
my ($gp, $tg) = ($1, $2); |
3141
|
0
|
|
|
|
|
0
|
my ($i, $key, @keys); |
3142
|
|
|
|
|
|
|
# build list of tag keys in the order of priority (no index |
3143
|
|
|
|
|
|
|
# is top priority, otherwise higher index is higher priority) |
3144
|
0
|
|
0
|
|
|
0
|
for ($key=$tg, $i=$$self{DUPL_TAG}{$tg} || 0; ; --$i) { |
3145
|
0
|
0
|
|
|
|
0
|
push @keys, $key if defined $$rawValue{$key}; |
3146
|
0
|
0
|
|
|
|
0
|
last if $i <= 0; |
3147
|
0
|
|
|
|
|
0
|
$key = "$tg ($i)"; |
3148
|
|
|
|
|
|
|
} |
3149
|
0
|
0
|
|
|
|
0
|
if (@keys) { |
3150
|
0
|
|
|
|
|
0
|
$key = $self->GroupMatches($gp, \@keys); |
3151
|
0
|
0
|
|
|
|
0
|
$tag = $key if $key; |
3152
|
|
|
|
|
|
|
} |
3153
|
|
|
|
|
|
|
} |
3154
|
|
|
|
|
|
|
# figure out what conversions to do |
3155
|
53826
|
100
|
|
|
|
88252
|
if ($type) { |
3156
|
53803
|
50
|
|
|
|
95462
|
return $$self{RATIONAL}{$tag} if $type eq 'Rational'; |
3157
|
|
|
|
|
|
|
} else { |
3158
|
23
|
50
|
|
|
|
110
|
$type = $$self{OPTIONS}{PrintConv} ? 'PrintConv' : 'ValueConv'; |
3159
|
|
|
|
|
|
|
} |
3160
|
|
|
|
|
|
|
|
3161
|
|
|
|
|
|
|
# start with the raw value |
3162
|
53826
|
|
|
|
|
102421
|
my $value = $$rawValue{$tag}; |
3163
|
53826
|
100
|
|
|
|
89464
|
if (not defined $value) { |
3164
|
10274
|
100
|
|
|
|
30178
|
return () unless ref $tag; |
3165
|
|
|
|
|
|
|
# get the value of a structure field |
3166
|
194
|
|
|
|
|
336
|
$tagInfo = $tag; |
3167
|
194
|
|
|
|
|
331
|
$tag = $$tagInfo{Name}; |
3168
|
194
|
|
|
|
|
307
|
$value = $_[3]; |
3169
|
|
|
|
|
|
|
# (note: type "Both" is not allowed for structure fields) |
3170
|
194
|
50
|
|
|
|
411
|
if ($type ne 'Raw') { |
3171
|
194
|
|
|
|
|
348
|
push @convTypes, 'ValueConv'; |
3172
|
194
|
100
|
|
|
|
428
|
push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; |
3173
|
|
|
|
|
|
|
} |
3174
|
|
|
|
|
|
|
} else { |
3175
|
43552
|
|
|
|
|
84048
|
$tagInfo = $$self{TAG_INFO}{$tag}; |
3176
|
43552
|
100
|
66
|
|
|
109459
|
if ($$tagInfo{Struct} and ref $value) { |
3177
|
|
|
|
|
|
|
# must load XMPStruct.pl just in case (should already be loaded if |
3178
|
|
|
|
|
|
|
# a structure was extracted, but we could also arrive here if a simple |
3179
|
|
|
|
|
|
|
# list of values was stored incorrectly in a Struct tag) |
3180
|
53
|
|
|
|
|
1112
|
require 'Image/ExifTool/XMPStruct.pl'; |
3181
|
|
|
|
|
|
|
# convert strucure field values |
3182
|
53
|
100
|
|
|
|
192
|
unless ($type eq 'Both') { |
3183
|
|
|
|
|
|
|
# (note: ConvertStruct handles the filtering and escaping too if necessary) |
3184
|
48
|
|
|
|
|
223
|
return Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,$type); |
3185
|
|
|
|
|
|
|
} |
3186
|
5
|
|
|
|
|
52
|
$valueConv = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'ValueConv'); |
3187
|
5
|
|
|
|
|
37
|
$value = Image::ExifTool::XMP::ConvertStruct($self,$tagInfo,$value,'PrintConv'); |
3188
|
|
|
|
|
|
|
# (must not save these in $$self{BOTH} because the values may have been escaped) |
3189
|
5
|
|
|
|
|
24
|
return ($valueConv, $value); |
3190
|
|
|
|
|
|
|
} |
3191
|
43499
|
50
|
|
|
|
78912
|
if ($type ne 'Raw') { |
3192
|
|
|
|
|
|
|
# use values we calculated already if we stored them |
3193
|
43499
|
|
|
|
|
67056
|
$both = $$self{BOTH}{$tag}; |
3194
|
43499
|
100
|
|
|
|
68170
|
if ($both) { |
3195
|
6643
|
100
|
|
|
|
14560
|
if ($type eq 'PrintConv') { |
|
|
100
|
|
|
|
|
|
3196
|
2272
|
|
|
|
|
4757
|
$value = $$both[1]; |
3197
|
|
|
|
|
|
|
} elsif ($type eq 'ValueConv') { |
3198
|
96
|
|
|
|
|
170
|
$value = $$both[0]; |
3199
|
96
|
100
|
|
|
|
234
|
$value = $$both[1] unless defined $value; |
3200
|
|
|
|
|
|
|
} else { |
3201
|
4275
|
|
|
|
|
8651
|
($valueConv, $value) = @$both; |
3202
|
|
|
|
|
|
|
} |
3203
|
|
|
|
|
|
|
} else { |
3204
|
36856
|
|
|
|
|
59663
|
push @convTypes, 'ValueConv'; |
3205
|
36856
|
100
|
|
|
|
77286
|
push @convTypes, 'PrintConv' unless $type eq 'ValueConv'; |
3206
|
|
|
|
|
|
|
} |
3207
|
|
|
|
|
|
|
} |
3208
|
|
|
|
|
|
|
} |
3209
|
|
|
|
|
|
|
|
3210
|
|
|
|
|
|
|
# do the conversions |
3211
|
43693
|
|
|
|
|
62121
|
my (@val, @prt, @raw, $convType); |
3212
|
43693
|
|
|
|
|
70173
|
foreach $convType (@convTypes) { |
3213
|
|
|
|
|
|
|
# don't convert a scalar reference or structure |
3214
|
71328
|
100
|
66
|
|
|
140247
|
last if ref $value eq 'SCALAR' and not $$tagInfo{ConvertBinary}; |
3215
|
70678
|
|
|
|
|
138786
|
my $conv = $$tagInfo{$convType}; |
3216
|
70678
|
100
|
|
|
|
122534
|
unless (defined $conv) { |
3217
|
46097
|
100
|
|
|
|
73234
|
if ($convType eq 'ValueConv') { |
3218
|
29305
|
100
|
|
|
|
66785
|
next unless $$tagInfo{Binary}; |
3219
|
402
|
|
|
|
|
972
|
$conv = '\$val'; # return scalar reference for binary values |
3220
|
|
|
|
|
|
|
} else { |
3221
|
|
|
|
|
|
|
# use PRINT_CONV from tag table if PrintConv doesn't exist |
3222
|
16792
|
100
|
|
|
|
51185
|
next unless defined($conv = $$tagInfo{Table}{PRINT_CONV}); |
3223
|
201
|
100
|
|
|
|
644
|
next if exists $$tagInfo{$convType}; |
3224
|
|
|
|
|
|
|
} |
3225
|
|
|
|
|
|
|
} |
3226
|
|
|
|
|
|
|
# save old ValueConv value if we want Both |
3227
|
25135
|
100
|
100
|
|
|
59230
|
$valueConv = $value if $type eq 'Both' and $convType eq 'PrintConv'; |
3228
|
25135
|
|
|
|
|
38138
|
my ($i, $val, $vals, @values, $convList); |
3229
|
|
|
|
|
|
|
# split into list if conversion is an array |
3230
|
25135
|
100
|
|
|
|
47969
|
if (ref $conv eq 'ARRAY') { |
3231
|
125
|
|
|
|
|
349
|
$convList = $conv; |
3232
|
125
|
|
|
|
|
449
|
$conv = $$convList[0]; |
3233
|
125
|
50
|
|
|
|
755
|
my @valList = (ref $value eq 'ARRAY') ? @$value : split ' ', $value; |
3234
|
|
|
|
|
|
|
# reorganize list if specified (Note: The writer currently doesn't |
3235
|
|
|
|
|
|
|
# relist values, so they may be grouped but the order must not change) |
3236
|
125
|
|
|
|
|
340
|
my $relist = $$tagInfo{Relist}; |
3237
|
125
|
100
|
|
|
|
365
|
if ($relist) { |
3238
|
7
|
|
|
|
|
24
|
my (@newList, $oldIndex); |
3239
|
7
|
|
|
|
|
25
|
foreach $oldIndex (@$relist) { |
3240
|
14
|
|
|
|
|
32
|
my ($newVal, @join); |
3241
|
14
|
100
|
|
|
|
57
|
if (ref $oldIndex) { |
3242
|
7
|
|
|
|
|
32
|
foreach (@$oldIndex) { |
3243
|
16
|
50
|
|
|
|
59
|
push @join, $valList[$_] if defined $valList[$_]; |
3244
|
|
|
|
|
|
|
} |
3245
|
7
|
50
|
|
|
|
55
|
$newVal = join(' ', @join) if @join; |
3246
|
|
|
|
|
|
|
} else { |
3247
|
7
|
|
|
|
|
17
|
$newVal = $valList[$oldIndex]; |
3248
|
|
|
|
|
|
|
} |
3249
|
14
|
100
|
|
|
|
69
|
push @newList, $newVal if defined $newVal; |
3250
|
|
|
|
|
|
|
} |
3251
|
7
|
|
|
|
|
26
|
$value = \@newList; |
3252
|
|
|
|
|
|
|
} else { |
3253
|
118
|
|
|
|
|
304
|
$value = \@valList; |
3254
|
|
|
|
|
|
|
} |
3255
|
125
|
50
|
|
|
|
511
|
return () unless @$value; |
3256
|
|
|
|
|
|
|
} |
3257
|
|
|
|
|
|
|
# initialize array so we can iterate over values in list |
3258
|
25135
|
100
|
|
|
|
43698
|
if (ref $value eq 'ARRAY') { |
3259
|
156
|
100
|
|
|
|
575
|
if (defined $$tagInfo{RawJoin}) { |
3260
|
7
|
|
|
|
|
53
|
$val = join ' ', @$value; |
3261
|
|
|
|
|
|
|
} else { |
3262
|
149
|
|
|
|
|
307
|
$i = 0; |
3263
|
149
|
|
|
|
|
278
|
$vals = $value; |
3264
|
149
|
|
|
|
|
323
|
$val = $$vals[0]; |
3265
|
|
|
|
|
|
|
} |
3266
|
|
|
|
|
|
|
} else { |
3267
|
24979
|
|
|
|
|
38427
|
$val = $value; |
3268
|
|
|
|
|
|
|
} |
3269
|
|
|
|
|
|
|
# loop through all values in list |
3270
|
25135
|
|
|
|
|
33270
|
for (;;) { |
3271
|
25349
|
100
|
|
|
|
41641
|
if (defined $conv) { |
3272
|
|
|
|
|
|
|
# get values of required tags if this is a Composite tag |
3273
|
25330
|
100
|
66
|
|
|
56284
|
if (ref $val eq 'HASH' and not @val) { |
3274
|
|
|
|
|
|
|
# disable escape of source values so we don't double escape them |
3275
|
2959
|
|
|
|
|
5289
|
my $oldEscape = $$self{ESCAPE_PROC}; |
3276
|
2959
|
|
|
|
|
5333
|
delete $$self{ESCAPE_PROC}; |
3277
|
|
|
|
|
|
|
# temporarily delete filter so it isn't applied to the Require'd values |
3278
|
2959
|
|
|
|
|
4844
|
my $oldFilter = $$self{OPTIONS}{Filter}; |
3279
|
2959
|
|
|
|
|
4749
|
delete $$self{OPTIONS}{Filter}; |
3280
|
2959
|
|
|
|
|
10550
|
foreach (keys %$val) { |
3281
|
17346
|
50
|
|
|
|
34282
|
next unless defined $$val{$_}; |
3282
|
17346
|
|
|
|
|
41702
|
$raw[$_] = $$rawValue{$$val{$_}}; |
3283
|
17346
|
|
|
|
|
35640
|
($val[$_], $prt[$_]) = $self->GetValue($$val{$_}, 'Both'); |
3284
|
17346
|
100
|
100
|
|
|
54858
|
next if defined $val[$_] or not $$tagInfo{Require}{$_}; |
3285
|
383
|
50
|
|
|
|
1250
|
$$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; |
3286
|
383
|
|
|
|
|
821
|
$$self{ESCAPE_PROC} = $oldEscape; |
3287
|
383
|
|
|
|
|
1734
|
return (); |
3288
|
|
|
|
|
|
|
} |
3289
|
2576
|
100
|
|
|
|
7133
|
$$self{OPTIONS}{Filter} = $oldFilter if defined $oldFilter; |
3290
|
2576
|
|
|
|
|
5119
|
$$self{ESCAPE_PROC} = $oldEscape; |
3291
|
|
|
|
|
|
|
# set $val to $val[0], or \@val for a CODE ref conversion |
3292
|
2576
|
50
|
|
|
|
7086
|
$val = ref $conv eq 'CODE' ? \@val : $val[0]; |
3293
|
|
|
|
|
|
|
} |
3294
|
24947
|
100
|
|
|
|
45188
|
if (ref $conv eq 'HASH') { |
3295
|
|
|
|
|
|
|
# look up converted value in hash |
3296
|
7668
|
100
|
|
|
|
33921
|
if (not defined($value = $$conv{$val})) { |
3297
|
455
|
100
|
|
|
|
2028
|
if ($$conv{BITMASK}) { |
3298
|
126
|
|
|
|
|
912
|
$value = DecodeBits($val, $$conv{BITMASK}, $$tagInfo{BitsPerWord}); |
3299
|
|
|
|
|
|
|
} else { |
3300
|
|
|
|
|
|
|
# use alternate conversion routine if available |
3301
|
329
|
100
|
|
|
|
1175
|
if ($$conv{OTHER}) { |
3302
|
254
|
|
|
|
|
1305
|
local $SIG{'__WARN__'} = \&SetWarning; |
3303
|
254
|
|
|
|
|
681
|
undef $evalWarning; |
3304
|
254
|
|
|
|
|
604
|
$value = &{$$conv{OTHER}}($val, undef, $conv); |
|
254
|
|
|
|
|
1348
|
|
3305
|
254
|
50
|
|
|
|
1162
|
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; |
3306
|
|
|
|
|
|
|
} |
3307
|
329
|
100
|
|
|
|
1097
|
if (not defined $value) { |
3308
|
77
|
50
|
66
|
|
|
437
|
if ($$tagInfo{PrintHex} and $val and IsInt($val) and |
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
3309
|
|
|
|
|
|
|
$convType eq 'PrintConv') |
3310
|
|
|
|
|
|
|
{ |
3311
|
0
|
|
|
|
|
0
|
$value = sprintf('Unknown (0x%x)',$val); |
3312
|
|
|
|
|
|
|
} else { |
3313
|
77
|
|
|
|
|
300
|
$value = "Unknown ($val)"; |
3314
|
|
|
|
|
|
|
} |
3315
|
|
|
|
|
|
|
} |
3316
|
|
|
|
|
|
|
} |
3317
|
|
|
|
|
|
|
} |
3318
|
|
|
|
|
|
|
# override with our localized language PrintConv if available |
3319
|
7668
|
|
|
|
|
10667
|
my $tmp; |
3320
|
7668
|
100
|
66
|
|
|
19122
|
if ($$self{CUR_LANG} and $convType eq 'PrintConv' and |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
3321
|
|
|
|
|
|
|
# (no need to check for lang-alt tag names -- they won't have a PrintConv) |
3322
|
|
|
|
|
|
|
ref($tmp = $$self{CUR_LANG}{$$tagInfo{Name}}) eq 'HASH' and |
3323
|
|
|
|
|
|
|
($tmp = $$tmp{PrintConv})) |
3324
|
|
|
|
|
|
|
{ |
3325
|
261
|
50
|
33
|
|
|
1018
|
if ($$conv{BITMASK} and not defined $$conv{$val}) { |
|
|
100
|
|
|
|
|
|
3326
|
0
|
|
|
|
|
0
|
my @vals = split ', ', $value; |
3327
|
0
|
|
|
|
|
0
|
foreach (@vals) { |
3328
|
0
|
0
|
|
|
|
0
|
$_ = $$tmp{$_} if defined $$tmp{$_}; |
3329
|
|
|
|
|
|
|
} |
3330
|
0
|
|
|
|
|
0
|
$value = join ', ', @vals; |
3331
|
|
|
|
|
|
|
} elsif (defined($tmp = $$tmp{$value})) { |
3332
|
213
|
|
|
|
|
435
|
$value = $self->Decode($tmp, 'UTF8'); |
3333
|
|
|
|
|
|
|
} |
3334
|
|
|
|
|
|
|
} |
3335
|
|
|
|
|
|
|
} else { |
3336
|
|
|
|
|
|
|
# call subroutine or do eval to convert value |
3337
|
17279
|
|
|
|
|
68914
|
local $SIG{'__WARN__'} = \&SetWarning; |
3338
|
17279
|
|
|
|
|
30837
|
undef $evalWarning; |
3339
|
17279
|
100
|
|
|
|
31178
|
if (ref $conv eq 'CODE') { |
3340
|
847
|
|
|
|
|
4928
|
$value = &$conv($val, $self); |
3341
|
|
|
|
|
|
|
} else { |
3342
|
|
|
|
|
|
|
#### eval ValueConv/PrintConv ($val, $self, @val, @prt, @raw) |
3343
|
16432
|
|
|
|
|
1072558
|
$value = eval $conv; |
3344
|
16432
|
50
|
|
|
|
65229
|
$@ and $evalWarning = $@; |
3345
|
|
|
|
|
|
|
} |
3346
|
17279
|
50
|
|
|
|
58800
|
$self->Warn("$convType $tag: " . CleanWarning()) if $evalWarning; |
3347
|
|
|
|
|
|
|
} |
3348
|
|
|
|
|
|
|
} else { |
3349
|
19
|
|
|
|
|
43
|
$value = $val; |
3350
|
|
|
|
|
|
|
} |
3351
|
24966
|
100
|
|
|
|
54172
|
last unless $vals; |
3352
|
|
|
|
|
|
|
# must store a separate copy of each binary data value in the list |
3353
|
363
|
100
|
|
|
|
1067
|
if (ref $value eq 'SCALAR') { |
3354
|
3
|
|
|
|
|
6
|
my $tval = $$value; |
3355
|
3
|
|
|
|
|
5
|
$value = \$tval; |
3356
|
|
|
|
|
|
|
} |
3357
|
|
|
|
|
|
|
# save this converted value and step to next value in list |
3358
|
363
|
50
|
|
|
|
1054
|
push @values, $value if defined $value; |
3359
|
363
|
100
|
|
|
|
955
|
if (++$i >= scalar(@$vals)) { |
3360
|
149
|
50
|
|
|
|
695
|
$value = \@values if @values; |
3361
|
149
|
|
|
|
|
344
|
last; |
3362
|
|
|
|
|
|
|
} |
3363
|
214
|
|
|
|
|
418
|
$val = $$vals[$i]; |
3364
|
214
|
100
|
|
|
|
540
|
if ($convList) { |
3365
|
133
|
|
|
|
|
316
|
my $nextConv = $$convList[$i]; |
3366
|
133
|
50
|
66
|
|
|
717
|
if ($nextConv and $nextConv eq 'REPEAT') { |
3367
|
0
|
|
|
|
|
0
|
undef $convList; |
3368
|
|
|
|
|
|
|
} else { |
3369
|
133
|
|
|
|
|
318
|
$conv = $nextConv; |
3370
|
|
|
|
|
|
|
} |
3371
|
|
|
|
|
|
|
} |
3372
|
|
|
|
|
|
|
} |
3373
|
|
|
|
|
|
|
# return undefined now if no value |
3374
|
24752
|
100
|
|
|
|
51183
|
return () unless defined $value; |
3375
|
|
|
|
|
|
|
# join back into single value if split for conversion list |
3376
|
24181
|
100
|
66
|
|
|
65243
|
if ($convList and ref $value eq 'ARRAY') { |
3377
|
125
|
100
|
|
|
|
781
|
$value = join($convType eq 'PrintConv' ? '; ' : ' ', @$value); |
3378
|
|
|
|
|
|
|
} |
3379
|
|
|
|
|
|
|
} |
3380
|
42739
|
100
|
|
|
|
81242
|
if ($type eq 'Both') { |
3381
|
|
|
|
|
|
|
# save both (unescaped) values because we often need them again |
3382
|
|
|
|
|
|
|
# (Composite tags need "Both" and often Require one tag for various Composite tags) |
3383
|
7661
|
100
|
|
|
|
22707
|
$$self{BOTH}{$tag} = [ $valueConv, $value ] unless $both; |
3384
|
|
|
|
|
|
|
# escape values if necessary |
3385
|
7661
|
50
|
|
|
|
21324
|
if ($$self{ESCAPE_PROC}) { |
|
|
100
|
|
|
|
|
|
3386
|
0
|
|
|
|
|
0
|
DoEscape($value, $$self{ESCAPE_PROC}); |
3387
|
0
|
0
|
|
|
|
0
|
if (defined $valueConv) { |
3388
|
0
|
|
|
|
|
0
|
DoEscape($valueConv, $$self{ESCAPE_PROC}); |
3389
|
|
|
|
|
|
|
} else { |
3390
|
0
|
|
|
|
|
0
|
$valueConv = $value; |
3391
|
|
|
|
|
|
|
} |
3392
|
|
|
|
|
|
|
} elsif (not defined $valueConv) { |
3393
|
|
|
|
|
|
|
# $valueConv is undefined if there was no print conversion done |
3394
|
3822
|
|
|
|
|
5658
|
$valueConv = $value; |
3395
|
|
|
|
|
|
|
} |
3396
|
7661
|
|
|
|
|
29384
|
$self->Filter($$self{OPTIONS}{Filter}, \$value); |
3397
|
|
|
|
|
|
|
# return Both values as a list (ValueConv, PrintConv) |
3398
|
7661
|
|
|
|
|
33632
|
return ($valueConv, $value); |
3399
|
|
|
|
|
|
|
} |
3400
|
|
|
|
|
|
|
# escape value if necessary |
3401
|
35078
|
100
|
|
|
|
66311
|
DoEscape($value, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; |
3402
|
|
|
|
|
|
|
|
3403
|
|
|
|
|
|
|
# filter if necessary |
3404
|
35078
|
100
|
100
|
|
|
75718
|
$self->Filter($$self{OPTIONS}{Filter}, \$value) if $$self{OPTIONS}{Filter} and $type eq 'PrintConv'; |
3405
|
|
|
|
|
|
|
|
3406
|
35078
|
100
|
|
|
|
64343
|
if (ref $value eq 'ARRAY') { |
3407
|
291
|
100
|
100
|
|
|
3130
|
if (defined $$self{OPTIONS}{ListItem}) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3408
|
3
|
|
|
|
|
8
|
$value = $$value[$$self{OPTIONS}{ListItem}]; |
3409
|
|
|
|
|
|
|
} elsif (wantarray) { |
3410
|
|
|
|
|
|
|
# return array if requested |
3411
|
1
|
|
|
|
|
6
|
return @$value; |
3412
|
|
|
|
|
|
|
} elsif ($type eq 'PrintConv' and not $$self{OPTIONS}{List} and not ref $$value[0]) { |
3413
|
|
|
|
|
|
|
# join PrintConv values in comma-separated string if List option not used |
3414
|
|
|
|
|
|
|
# and list contains simple scalars (otherwise return ARRAY ref) |
3415
|
164
|
|
|
|
|
844
|
$value = join $$self{OPTIONS}{ListSep}, @$value; |
3416
|
|
|
|
|
|
|
} |
3417
|
|
|
|
|
|
|
} |
3418
|
35077
|
|
|
|
|
89617
|
return $value; |
3419
|
|
|
|
|
|
|
} |
3420
|
|
|
|
|
|
|
|
3421
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3422
|
|
|
|
|
|
|
# Get tag identification number |
3423
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3424
|
|
|
|
|
|
|
# Returns: Scalar context: tag ID if available, otherwise '' |
3425
|
|
|
|
|
|
|
# List context: 0) tag ID (or ''), 1) language code (or undef) |
3426
|
|
|
|
|
|
|
sub GetTagID($$) |
3427
|
|
|
|
|
|
|
{ |
3428
|
23472
|
|
|
23472
|
1
|
142525
|
my ($self, $tag) = @_; |
3429
|
23472
|
|
|
|
|
40430
|
my $tagInfo = $$self{TAG_INFO}{$tag}; |
3430
|
23472
|
100
|
66
|
|
|
76841
|
return '' unless $tagInfo and defined $$tagInfo{TagID}; |
3431
|
23470
|
|
100
|
|
|
61887
|
my $id = $$tagInfo{KeysID} || $$tagInfo{TagID}; |
3432
|
23470
|
50
|
|
|
|
43267
|
return ($id, $$tagInfo{LangCode}) if wantarray; |
3433
|
23470
|
|
|
|
|
49315
|
return $id; |
3434
|
|
|
|
|
|
|
} |
3435
|
|
|
|
|
|
|
|
3436
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3437
|
|
|
|
|
|
|
# Get description for specified tag |
3438
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
3439
|
|
|
|
|
|
|
# Returns: Tag description |
3440
|
|
|
|
|
|
|
# Notes: Will always return a defined value, even if description isn't available |
3441
|
|
|
|
|
|
|
sub GetDescription($$) |
3442
|
|
|
|
|
|
|
{ |
3443
|
23472
|
|
|
23472
|
1
|
66728
|
local $_; |
3444
|
23472
|
|
|
|
|
37968
|
my ($self, $tag) = @_; |
3445
|
23472
|
|
|
|
|
33458
|
my ($desc, $name); |
3446
|
23472
|
|
|
|
|
37607
|
my $tagInfo = $$self{TAG_INFO}{$tag}; |
3447
|
|
|
|
|
|
|
# ($tagInfo won't be defined for missing tags extracted with -f) |
3448
|
23472
|
50
|
|
|
|
44224
|
if ($tagInfo) { |
3449
|
|
|
|
|
|
|
# use alternate language description if available |
3450
|
23472
|
|
|
|
|
47106
|
while ($$self{CUR_LANG}) { |
3451
|
847
|
|
|
|
|
2567
|
$desc = $$self{CUR_LANG}{$$tagInfo{Name}}; |
3452
|
847
|
100
|
|
|
|
1384
|
if ($desc) { |
3453
|
|
|
|
|
|
|
# must look up Description if this tag also has a PrintConv |
3454
|
718
|
100
|
100
|
|
|
2091
|
$desc = $$desc{Description} or last if ref $desc; |
3455
|
|
|
|
|
|
|
} else { |
3456
|
|
|
|
|
|
|
# look up default language of lang-alt tag |
3457
|
|
|
|
|
|
|
last unless $$tagInfo{LangCode} and |
3458
|
|
|
|
|
|
|
($name = $$tagInfo{Name}) =~ s/-$$tagInfo{LangCode}$// and |
3459
|
129
|
50
|
66
|
|
|
415
|
$desc = $$self{CUR_LANG}{$name}; |
|
|
|
66
|
|
|
|
|
3460
|
1
|
50
|
0
|
|
|
6
|
$desc = $$desc{Description} or last if ref $desc; |
3461
|
1
|
|
|
|
|
6
|
$desc .= " ($$tagInfo{LangCode})"; |
3462
|
|
|
|
|
|
|
} |
3463
|
|
|
|
|
|
|
# escape description if necessary |
3464
|
710
|
50
|
|
|
|
1384
|
DoEscape($desc, $$self{ESCAPE_PROC}) if $$self{ESCAPE_PROC}; |
3465
|
|
|
|
|
|
|
# return description in proper Charset |
3466
|
710
|
|
|
|
|
1486
|
return $self->Decode($desc, 'UTF8'); |
3467
|
|
|
|
|
|
|
} |
3468
|
22762
|
|
|
|
|
46063
|
$desc = $$tagInfo{Description}; |
3469
|
|
|
|
|
|
|
} |
3470
|
|
|
|
|
|
|
# just make the tag more readable if description doesn't exist |
3471
|
22762
|
100
|
|
|
|
40716
|
unless ($desc) { |
3472
|
9546
|
|
|
|
|
17782
|
$desc = MakeDescription(GetTagName($tag)); |
3473
|
|
|
|
|
|
|
# save description in tag information |
3474
|
9546
|
50
|
|
|
|
28801
|
$$tagInfo{Description} = $desc if $tagInfo; |
3475
|
|
|
|
|
|
|
} |
3476
|
22762
|
|
|
|
|
48616
|
return $desc; |
3477
|
|
|
|
|
|
|
} |
3478
|
|
|
|
|
|
|
|
3479
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3480
|
|
|
|
|
|
|
# Get group name for specified tag |
3481
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3482
|
|
|
|
|
|
|
# 1) tag key (or reference to tagInfo hash, not part of the public API) |
3483
|
|
|
|
|
|
|
# 2) [optional] group family (-1 to get extended group list, or multiple |
3484
|
|
|
|
|
|
|
# families separated by colons to return multiple groups as a string) |
3485
|
|
|
|
|
|
|
# Returns: Scalar context: group name (for family 0 if not otherwise specified) |
3486
|
|
|
|
|
|
|
# List context: group name if family specified, otherwise list of |
3487
|
|
|
|
|
|
|
# group names for each family. Returns '' for undefined tag. |
3488
|
|
|
|
|
|
|
# Notes: Multiple families may be specified with ':' in family argument (eg. '1:2') |
3489
|
|
|
|
|
|
|
sub GetGroup($$;$) |
3490
|
|
|
|
|
|
|
{ |
3491
|
192169
|
|
|
192169
|
1
|
697787
|
local $_; |
3492
|
192169
|
|
|
|
|
327440
|
my ($self, $tag, $family) = @_; |
3493
|
192169
|
|
|
|
|
274497
|
my ($tagInfo, @groups, @families, $simplify, $byTagInfo, $ex, $noID); |
3494
|
192169
|
100
|
|
|
|
360657
|
if (ref $tag eq 'HASH') { |
3495
|
121527
|
|
|
|
|
174706
|
$tagInfo = $tag; |
3496
|
121527
|
|
|
|
|
239873
|
$tag = $$tagInfo{Name}; |
3497
|
|
|
|
|
|
|
# set flag so we don't get extra information for an extracted tag |
3498
|
121527
|
|
|
|
|
162993
|
$byTagInfo = 1; |
3499
|
|
|
|
|
|
|
} else { |
3500
|
70642
|
|
50
|
|
|
166693
|
$tagInfo = $$self{TAG_INFO}{$tag} || { }; |
3501
|
70642
|
|
|
|
|
115896
|
$ex = $$self{TAG_EXTRA}{$tag}; |
3502
|
|
|
|
|
|
|
} |
3503
|
192169
|
|
|
|
|
397932
|
my $groups = $$tagInfo{Groups}; |
3504
|
|
|
|
|
|
|
# fill in default groups unless already done |
3505
|
|
|
|
|
|
|
# (after this, Groups 0-2 in tagInfo are guaranteed to be defined) |
3506
|
192169
|
100
|
|
|
|
396471
|
unless ($$tagInfo{GotGroups}) { |
3507
|
36088
|
|
50
|
|
|
74634
|
my $tagTablePtr = $$tagInfo{Table} || { GROUPS => { } }; |
3508
|
|
|
|
|
|
|
# construct our group list |
3509
|
36088
|
100
|
|
|
|
93863
|
$groups or $groups = $$tagInfo{Groups} = { }; |
3510
|
|
|
|
|
|
|
# fill in default groups |
3511
|
36088
|
|
|
|
|
69683
|
foreach (0..2) { |
3512
|
108264
|
100
|
50
|
|
|
422431
|
$$groups{$_} = $$tagTablePtr{GROUPS}{$_} || '' unless $$groups{$_}; |
3513
|
|
|
|
|
|
|
} |
3514
|
|
|
|
|
|
|
# set flag indicating group list was built |
3515
|
36088
|
|
|
|
|
77854
|
$$tagInfo{GotGroups} = 1; |
3516
|
|
|
|
|
|
|
} |
3517
|
192169
|
100
|
100
|
|
|
518982
|
if (defined $family and $family ne '-1') { |
3518
|
99575
|
100
|
|
|
|
223476
|
if ($family =~ /[^\d]/) { |
3519
|
2736
|
|
|
|
|
8361
|
@families = ($family =~ /\d+/g); |
3520
|
2736
|
50
|
0
|
|
|
5217
|
return(($ex && $$ex{G0}) || $$groups{0}) unless @families; |
3521
|
2736
|
50
|
|
|
|
5849
|
$simplify = 1 unless $family =~ /^:/; |
3522
|
2736
|
|
|
|
|
3806
|
undef $family; |
3523
|
2736
|
|
|
|
|
4402
|
foreach (0..2) { $groups[$_] = $$groups{$_}; } |
|
8208
|
|
|
|
|
15703
|
|
3524
|
2736
|
50
|
33
|
|
|
5744
|
$noID = 1 if @families == 1 and $families[0] != 7; |
3525
|
|
|
|
|
|
|
} else { |
3526
|
96839
|
100
|
66
|
|
|
531302
|
return(($ex && $$ex{"G$family"}) || $$groups{$family}) if $family == 0 or $family == 2; |
|
|
|
100
|
|
|
|
|
3527
|
28855
|
|
|
|
|
99736
|
$groups[1] = $$groups{1}; |
3528
|
|
|
|
|
|
|
} |
3529
|
|
|
|
|
|
|
} else { |
3530
|
92594
|
100
|
33
|
|
|
165831
|
return(($ex && $$ex{G0}) || $$groups{0}) unless wantarray; |
3531
|
92214
|
|
|
|
|
160108
|
foreach (0..2) { $groups[$_] = $$groups{$_}; } |
|
276642
|
|
|
|
|
657679
|
|
3532
|
|
|
|
|
|
|
} |
3533
|
123805
|
|
|
|
|
198064
|
$groups[3] = 'Main'; |
3534
|
123805
|
100
|
|
|
|
309120
|
$groups[4] = ($tag =~ /\((\d+)\)$/) ? "Copy$1" : ''; |
3535
|
|
|
|
|
|
|
# handle dynamic group names if necessary |
3536
|
123805
|
100
|
|
|
|
235140
|
unless ($byTagInfo) { |
3537
|
44888
|
100
|
|
|
|
80516
|
if ($ex) { |
3538
|
17455
|
100
|
|
|
|
37585
|
$groups[0] = $$ex{G0} if $$ex{G0}; |
3539
|
17455
|
100
|
|
|
|
52657
|
$groups[1] = $$ex{G1} =~ /^\+(.*)/ ? "$groups[1]$1" : $$ex{G1} if $$ex{G1}; |
|
|
100
|
|
|
|
|
|
3540
|
17455
|
100
|
|
|
|
33060
|
$groups[3] = 'Doc' . $$ex{G3} if $$ex{G3}; |
3541
|
17455
|
100
|
66
|
|
|
32775
|
$groups[5] = $$ex{G5} || $groups[1] if defined $$ex{G5}; |
3542
|
17455
|
50
|
|
|
|
32047
|
if (defined $$ex{G6}) { |
3543
|
0
|
0
|
|
|
|
0
|
$groups[5] = '' unless defined $groups[5]; # (can't leave a hole in the array) |
3544
|
0
|
|
|
|
|
0
|
$groups[6] = $$ex{G6}; |
3545
|
|
|
|
|
|
|
} |
3546
|
|
|
|
|
|
|
} |
3547
|
44888
|
100
|
|
|
|
83968
|
if ($$ex{G8}) { |
3548
|
16
|
|
|
|
|
27
|
$groups[7] = ''; |
3549
|
16
|
|
|
|
|
43
|
$groups[8] = $$ex{G8}; |
3550
|
|
|
|
|
|
|
} |
3551
|
|
|
|
|
|
|
# generate tag ID group names unless obviously not needed |
3552
|
44888
|
50
|
|
|
|
77193
|
unless ($noID) { |
3553
|
44888
|
|
100
|
|
|
154955
|
my $id = $$tagInfo{KeysID} || $$tagInfo{TagID}; |
3554
|
44888
|
100
|
|
|
|
138932
|
if (not defined $id) { |
|
|
100
|
|
|
|
|
|
3555
|
2
|
|
|
|
|
5
|
$id = ''; # (just to be safe) |
3556
|
|
|
|
|
|
|
} elsif ($id =~ /^\d+$/) { |
3557
|
28376
|
50
|
|
|
|
65154
|
$id = sprintf('0x%x', $id) if $$self{OPTIONS}{HexTagIDs}; |
3558
|
|
|
|
|
|
|
} else { |
3559
|
16510
|
|
|
|
|
36479
|
$id =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge; |
|
1282
|
|
|
|
|
5983
|
|
3560
|
|
|
|
|
|
|
} |
3561
|
44888
|
|
|
|
|
91995
|
$groups[7] = 'ID-' . $id; |
3562
|
44888
|
|
100
|
|
|
159583
|
defined $groups[$_] or $groups[$_] = '' foreach (5,6); |
3563
|
|
|
|
|
|
|
} |
3564
|
|
|
|
|
|
|
} |
3565
|
123805
|
100
|
|
|
|
229614
|
if ($family) { |
3566
|
44262
|
100
|
50
|
|
|
183280
|
return $groups[$family] || '' if $family > 0; |
3567
|
|
|
|
|
|
|
# add additional matching group names to list |
3568
|
|
|
|
|
|
|
# eg) for MIE-Doc, also add MIE1, MIE1-Doc, MIE-Doc1 and MIE1-Doc1 |
3569
|
|
|
|
|
|
|
# and for MIE2-Doc3, also add MIE2, MIE-Doc3, MIE2-Doc and MIE-Doc |
3570
|
15407
|
100
|
|
|
|
30670
|
if ($groups[1] =~ /^MIE(\d*)-(.+?)(\d*)$/) { |
3571
|
34
|
|
50
|
|
|
192
|
push @groups, 'MIE' . ($1 || '1'); |
3572
|
34
|
50
|
|
|
|
173
|
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2$3"; |
3573
|
34
|
50
|
|
|
|
137
|
push @groups, "MIE$1-$2" . ($3 ? '' : '1'); |
3574
|
34
|
50
|
|
|
|
169
|
push @groups, 'MIE' . ($1 ? '' : '1') . "-$2" . ($3 ? '' : '1'); |
|
|
50
|
|
|
|
|
|
3575
|
|
|
|
|
|
|
} |
3576
|
|
|
|
|
|
|
} |
3577
|
94950
|
100
|
|
|
|
185937
|
if (@families) { |
3578
|
2736
|
|
|
|
|
3347
|
my @grps; |
3579
|
|
|
|
|
|
|
# create list of group names (without identical adjacent groups if simplifying) |
3580
|
2736
|
|
|
|
|
4032
|
foreach (@families) { |
3581
|
5472
|
|
|
|
|
8904
|
my $grp = $groups[$_]; |
3582
|
5472
|
50
|
|
|
|
8786
|
unless ($grp) { |
3583
|
0
|
0
|
|
|
|
0
|
next if $simplify; |
3584
|
0
|
|
|
|
|
0
|
$grp = ''; |
3585
|
|
|
|
|
|
|
} |
3586
|
5472
|
100
|
66
|
|
|
22754
|
push @grps, $grp unless $simplify and @grps and $grp eq $grps[-1]; |
|
|
|
100
|
|
|
|
|
3587
|
|
|
|
|
|
|
} |
3588
|
|
|
|
|
|
|
# remove leading "Main:" if simplifying |
3589
|
2736
|
50
|
66
|
|
|
10940
|
shift @grps if $simplify and @grps > 1 and $grps[0] eq 'Main'; |
|
|
|
66
|
|
|
|
|
3590
|
|
|
|
|
|
|
# return colon-separated string of group names |
3591
|
2736
|
|
|
|
|
10622
|
return join ':', @grps; |
3592
|
|
|
|
|
|
|
} |
3593
|
92214
|
|
|
|
|
375602
|
return @groups; |
3594
|
|
|
|
|
|
|
} |
3595
|
|
|
|
|
|
|
|
3596
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3597
|
|
|
|
|
|
|
# Get group names for specified tags |
3598
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3599
|
|
|
|
|
|
|
# 1) [optional] information hash reference (default all extracted info) |
3600
|
|
|
|
|
|
|
# 2) [optional] group family (default 0) |
3601
|
|
|
|
|
|
|
# Returns: List of group names in alphabetical order |
3602
|
|
|
|
|
|
|
sub GetGroups($;$$) |
3603
|
|
|
|
|
|
|
{ |
3604
|
3
|
|
|
3
|
1
|
26
|
local $_; |
3605
|
3
|
|
|
|
|
7
|
my $self = shift; |
3606
|
3
|
|
|
|
|
7
|
my $info = shift; |
3607
|
3
|
|
|
|
|
5
|
my $family; |
3608
|
|
|
|
|
|
|
|
3609
|
|
|
|
|
|
|
# figure out our arguments |
3610
|
3
|
100
|
|
|
|
13
|
if (ref $info ne 'HASH') { |
3611
|
2
|
|
|
|
|
6
|
$family = $info; |
3612
|
2
|
|
|
|
|
8
|
$info = $$self{VALUE}; |
3613
|
|
|
|
|
|
|
} else { |
3614
|
1
|
|
|
|
|
3
|
$family = shift; |
3615
|
|
|
|
|
|
|
} |
3616
|
3
|
50
|
|
|
|
10
|
$family = 0 unless defined $family; |
3617
|
|
|
|
|
|
|
|
3618
|
|
|
|
|
|
|
# get a list of all groups in specified information |
3619
|
3
|
|
|
|
|
10
|
my ($tag, %groups); |
3620
|
3
|
|
|
|
|
69
|
foreach $tag (keys %$info) { |
3621
|
383
|
|
|
|
|
741
|
$groups{ $self->GetGroup($tag, $family) } = 1; |
3622
|
|
|
|
|
|
|
} |
3623
|
3
|
|
|
|
|
63
|
return sort keys %groups; |
3624
|
|
|
|
|
|
|
} |
3625
|
|
|
|
|
|
|
|
3626
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3627
|
|
|
|
|
|
|
# Set priority for group where new values are written |
3628
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, |
3629
|
|
|
|
|
|
|
# 1-N) group names (reset to default if no groups specified) |
3630
|
|
|
|
|
|
|
# - used when new tag values are set (ie. before files are written) |
3631
|
|
|
|
|
|
|
sub SetNewGroups($;@) |
3632
|
|
|
|
|
|
|
{ |
3633
|
490
|
|
|
490
|
1
|
1161
|
local $_; |
3634
|
490
|
|
|
|
|
2422
|
my ($self, @groups) = @_; |
3635
|
490
|
50
|
|
|
|
1884
|
@groups or @groups = @defaultWriteGroups; |
3636
|
490
|
|
|
|
|
1472
|
my $count = @groups * 10; |
3637
|
490
|
|
|
|
|
1060
|
my %priority; |
3638
|
490
|
|
|
|
|
1464
|
foreach (@groups) { |
3639
|
4410
|
|
|
|
|
9686
|
$priority{lc($_)} = $count; |
3640
|
4410
|
|
|
|
|
6647
|
$count -= 10; |
3641
|
|
|
|
|
|
|
} |
3642
|
490
|
|
|
|
|
2028
|
$priority{file} = 500; # 'File' group is always written (Comment) |
3643
|
490
|
|
|
|
|
1409
|
$priority{composite} = 500; # 'Composite' group is always written |
3644
|
|
|
|
|
|
|
# set write priority (higher # is higher priority) |
3645
|
490
|
|
|
|
|
1463
|
$$self{WRITE_PRIORITY} = \%priority; |
3646
|
490
|
|
|
|
|
1639
|
$$self{WRITE_GROUPS} = \@groups; |
3647
|
|
|
|
|
|
|
} |
3648
|
|
|
|
|
|
|
|
3649
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3650
|
|
|
|
|
|
|
# Build Composite tags from Require'd/Desire'd tags |
3651
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3652
|
|
|
|
|
|
|
# Note: Tag values are calculated in alphabetical order unless a tag Require's |
3653
|
|
|
|
|
|
|
# or Desire's another Composite tag, in which case the calculation is |
3654
|
|
|
|
|
|
|
# deferred until after the other tag is calculated. |
3655
|
|
|
|
|
|
|
sub BuildCompositeTags($) |
3656
|
|
|
|
|
|
|
{ |
3657
|
519
|
|
|
519
|
1
|
1060
|
local $_; |
3658
|
519
|
|
|
|
|
1132
|
my $self = shift; |
3659
|
|
|
|
|
|
|
|
3660
|
519
|
|
|
|
|
2672
|
$$self{BuildingComposite} = 1; |
3661
|
|
|
|
|
|
|
|
3662
|
519
|
|
|
|
|
1797
|
my $compTable = GetTagTable('Image::ExifTool::Composite'); |
3663
|
519
|
|
|
|
|
34800
|
my @tagList = sort keys %$compTable; |
3664
|
519
|
|
|
|
|
3071
|
my $rawValue = $$self{VALUE}; |
3665
|
519
|
|
|
|
|
1313
|
my $compKeys = $$self{COMP_KEYS}; |
3666
|
519
|
|
|
|
|
1463
|
my (%cache, $allBuilt); |
3667
|
|
|
|
|
|
|
|
3668
|
519
|
|
|
|
|
1008
|
for (;;) { |
3669
|
2266
|
|
|
|
|
5381
|
my (%notBuilt, $tag, @deferredTags); |
3670
|
2266
|
|
|
|
|
4733
|
foreach (@tagList) { |
3671
|
44252
|
100
|
|
|
|
142071
|
$notBuilt{$$compTable{$_}{Name}} = 1 unless $specialTags{$_}; |
3672
|
|
|
|
|
|
|
} |
3673
|
|
|
|
|
|
|
COMPOSITE_TAG: |
3674
|
2266
|
|
|
|
|
4622
|
foreach $tag (@tagList) { |
3675
|
44252
|
100
|
|
|
|
90338
|
next if $specialTags{$tag}; |
3676
|
41138
|
|
|
|
|
86526
|
my $tagInfo = $self->GetTagInfo($compTable, $tag); |
3677
|
41138
|
100
|
|
|
|
80360
|
next unless $tagInfo; |
3678
|
40878
|
|
|
|
|
67402
|
my $tagName = $$compTable{$tag}{Name}; |
3679
|
|
|
|
|
|
|
# put required tags into array and make sure they all exist |
3680
|
40878
|
|
100
|
|
|
89508
|
my $subDoc = ($$tagInfo{SubDoc} and $$self{DOC_COUNT}); |
3681
|
40878
|
|
100
|
|
|
106206
|
my $require = $$tagInfo{Require} || { }; |
3682
|
40878
|
|
100
|
|
|
107834
|
my $desire = $$tagInfo{Desire} || { }; |
3683
|
40878
|
|
100
|
|
|
107484
|
my $inhibit = $$tagInfo{Inhibit} || { }; |
3684
|
|
|
|
|
|
|
# loop through sub-documents if necessary |
3685
|
40878
|
|
|
|
|
57170
|
my $docNum = 0; |
3686
|
40878
|
|
|
|
|
53292
|
for (;;) { |
3687
|
40878
|
|
|
|
|
58131
|
my (%tagKey, $found, $index); |
3688
|
|
|
|
|
|
|
# save Require'd and Desire'd tag values in list |
3689
|
40878
|
|
|
|
|
58393
|
for ($index=0; ; ++$index) { |
3690
|
97636
|
|
100
|
|
|
342804
|
my $reqTag = $$require{$index} || $$desire{$index} || $$inhibit{$index}; |
3691
|
97636
|
100
|
|
|
|
167241
|
unless ($reqTag) { |
3692
|
|
|
|
|
|
|
# allow Composite with no Require'd or Desire'd tags |
3693
|
9154
|
50
|
|
|
|
18318
|
$found = 1 if $index == 0; |
3694
|
9154
|
|
|
|
|
14797
|
last; |
3695
|
|
|
|
|
|
|
} |
3696
|
88482
|
100
|
66
|
|
|
311512
|
if ($subDoc) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3697
|
|
|
|
|
|
|
# handle SubDoc tags specially to cache tag keys for faster |
3698
|
|
|
|
|
|
|
# processing when there are a large number of sub-documents |
3699
|
|
|
|
|
|
|
# - get document number from the tag groups if specified, |
3700
|
|
|
|
|
|
|
# otherwise we are looping through all documents for this tag |
3701
|
285
|
50
|
0
|
|
|
865
|
my $doc = $reqTag =~ s/\b(Main|Doc(\d+)):// ? ($2 || 0) : $docNum; |
3702
|
|
|
|
|
|
|
# make fast lookup for keys of this tag with specified groups other than doc group |
3703
|
|
|
|
|
|
|
# (similar to code in InsertTagValues(), but this is case-sensitive) |
3704
|
285
|
|
|
|
|
498
|
my $cacheTag = $cache{$reqTag}; |
3705
|
285
|
50
|
|
|
|
578
|
unless ($cacheTag) { |
3706
|
285
|
|
|
|
|
944
|
$cacheTag = $cache{$reqTag} = [ ]; |
3707
|
285
|
|
|
|
|
452
|
my $reqGroup; |
3708
|
285
|
50
|
|
|
|
1534
|
$reqTag =~ s/^(.*):// and $reqGroup = $1; |
3709
|
285
|
|
|
|
|
556
|
my ($i, $key, @keys); |
3710
|
|
|
|
|
|
|
# build list of tag keys in order of precedence |
3711
|
285
|
|
50
|
|
|
1076
|
for ($key=$reqTag, $i=$$self{DUPL_TAG}{$reqTag} || 0; ; --$i) { |
3712
|
285
|
50
|
|
|
|
694
|
push @keys, $key if defined $$rawValue{$key}; |
3713
|
285
|
50
|
|
|
|
673
|
last if $i <= 0; |
3714
|
0
|
|
|
|
|
0
|
$key = "$reqTag ($i)"; |
3715
|
|
|
|
|
|
|
} |
3716
|
285
|
50
|
|
|
|
877
|
@keys = $self->GroupMatches($reqGroup, \@keys) if defined $reqGroup; |
3717
|
285
|
50
|
|
|
|
739
|
if (@keys) { |
3718
|
0
|
|
|
|
|
0
|
my $ex = $$self{TAG_EXTRA}; |
3719
|
|
|
|
|
|
|
# loop through tags in reverse order of precedence so the higher |
3720
|
|
|
|
|
|
|
# priority tag will win in the case of duplicates within a doc |
3721
|
0
|
0
|
0
|
|
|
0
|
$$cacheTag[$$ex{$_} ? $$ex{$_}{G3} || 0 : 0] = $_ foreach reverse @keys; |
3722
|
|
|
|
|
|
|
} |
3723
|
|
|
|
|
|
|
} |
3724
|
|
|
|
|
|
|
# (set $reqTag to a bogus key if not found) |
3725
|
285
|
|
33
|
|
|
1073
|
$reqTag = $$cacheTag[$doc] || "$reqTag (0)"; |
3726
|
|
|
|
|
|
|
} elsif ($reqTag =~ /^(.*):(.+)/) { |
3727
|
27352
|
|
|
|
|
75512
|
my ($reqGroup, $name) = ($1, $2); |
3728
|
27352
|
100
|
100
|
|
|
61048
|
if ($reqGroup eq 'Composite' and $notBuilt{$name}) { |
3729
|
|
|
|
|
|
|
# defer only until all other tags are built if |
3730
|
|
|
|
|
|
|
# we are inhibiting based on another Composite tag |
3731
|
2142
|
100
|
100
|
|
|
9269
|
unless ($$inhibit{$index} and $allBuilt) { |
3732
|
1693
|
|
|
|
|
3652
|
push @deferredTags, $tag; |
3733
|
1693
|
|
|
|
|
7405
|
next COMPOSITE_TAG; |
3734
|
|
|
|
|
|
|
} |
3735
|
|
|
|
|
|
|
} |
3736
|
25659
|
|
|
|
|
37440
|
my ($i, $key, @keys, $altFile); |
3737
|
25659
|
|
|
|
|
35466
|
my $et = $self; |
3738
|
|
|
|
|
|
|
# get tags from alternate file if a family 8 group was specified |
3739
|
25659
|
100
|
100
|
|
|
77685
|
if ($reqTag =~ /\b(File\d+):/i and $$self{ALT_EXIFTOOL}{$1}) { |
3740
|
1
|
|
|
|
|
11
|
$et = $$self{ALT_EXIFTOOL}{$1}; |
3741
|
1
|
|
|
|
|
2
|
$altFile = $1; |
3742
|
|
|
|
|
|
|
} |
3743
|
|
|
|
|
|
|
# (CAREFUL! keys may not be sequential if one was deleted) |
3744
|
25659
|
|
100
|
|
|
88776
|
for ($key=$name, $i=$$et{DUPL_TAG}{$name} || 0; ; --$i) { |
3745
|
26310
|
100
|
|
|
|
63293
|
push @keys, $key if defined $$et{VALUE}{$key}; |
3746
|
26310
|
100
|
|
|
|
53440
|
last if $i <= 0; |
3747
|
651
|
|
|
|
|
2297
|
$key = "$name ($i)"; |
3748
|
|
|
|
|
|
|
} |
3749
|
|
|
|
|
|
|
# make sure the necessary information is available from the alternate file |
3750
|
25659
|
100
|
|
|
|
45021
|
$self->CopyAltInfo($altFile, \@keys) if $altFile; |
3751
|
|
|
|
|
|
|
# find first matching tag |
3752
|
25659
|
|
|
|
|
59128
|
$key = $self->GroupMatches($reqGroup, \@keys); |
3753
|
25659
|
|
66
|
|
|
92585
|
$reqTag = $key || "$name (0)"; |
3754
|
|
|
|
|
|
|
} elsif ($notBuilt{$reqTag} and not $$inhibit{$index}) { |
3755
|
|
|
|
|
|
|
# calculate this tag later if it relies on another |
3756
|
|
|
|
|
|
|
# Composite tag which hasn't been calculated yet |
3757
|
5063
|
|
|
|
|
9881
|
push @deferredTags, $tag; |
3758
|
5063
|
|
|
|
|
13404
|
next COMPOSITE_TAG; |
3759
|
|
|
|
|
|
|
} |
3760
|
81726
|
100
|
|
|
|
193729
|
if (defined $$rawValue{$reqTag}) { |
|
|
100
|
|
|
|
|
|
3761
|
16571
|
100
|
|
|
|
28112
|
if ($$inhibit{$index}) { |
3762
|
70
|
|
|
|
|
265
|
$found = 0; |
3763
|
70
|
|
|
|
|
229
|
last; |
3764
|
|
|
|
|
|
|
} else { |
3765
|
16501
|
|
|
|
|
23453
|
$found = 1; |
3766
|
|
|
|
|
|
|
} |
3767
|
|
|
|
|
|
|
} elsif ($$require{$index}) { |
3768
|
24898
|
|
|
|
|
34704
|
$found = 0; |
3769
|
24898
|
|
|
|
|
37142
|
last; # don't continue since we require this tag |
3770
|
|
|
|
|
|
|
} |
3771
|
56758
|
|
|
|
|
118760
|
$tagKey{$index} = $reqTag; |
3772
|
|
|
|
|
|
|
} |
3773
|
34122
|
50
|
|
|
|
84961
|
if ($docNum) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
3774
|
0
|
0
|
|
|
|
0
|
if ($found) { |
3775
|
0
|
|
|
|
|
0
|
$$self{DOC_NUM} = $docNum; |
3776
|
|
|
|
|
|
|
# save pointers to all used tag keys |
3777
|
0
|
|
|
|
|
0
|
foreach (keys %tagKey) { |
3778
|
0
|
0
|
|
|
|
0
|
$$compKeys{$_} or $$compKeys{$_} = [ ]; |
3779
|
0
|
|
|
|
|
0
|
push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; |
|
0
|
|
|
|
|
0
|
|
3780
|
|
|
|
|
|
|
} |
3781
|
0
|
|
|
|
|
0
|
$self->FoundTag($tagInfo, \%tagKey); |
3782
|
0
|
|
|
|
|
0
|
delete $$self{DOC_NUM}; |
3783
|
|
|
|
|
|
|
} |
3784
|
0
|
0
|
|
|
|
0
|
next if ++$docNum <= $$self{DOC_COUNT}; |
3785
|
0
|
|
|
|
|
0
|
last; |
3786
|
|
|
|
|
|
|
} elsif ($found) { |
3787
|
5379
|
|
|
|
|
11190
|
delete $notBuilt{$tagName}; # this tag is OK to build now |
3788
|
|
|
|
|
|
|
# keep track of all Require'd tag keys |
3789
|
5379
|
|
|
|
|
20386
|
foreach (keys %tagKey) { |
3790
|
|
|
|
|
|
|
# only tag keys with same name as a Composite tag |
3791
|
|
|
|
|
|
|
# can be replaced (also eliminates keys with |
3792
|
|
|
|
|
|
|
# instance numbers which can't be replaced either) |
3793
|
23851
|
100
|
|
|
|
55692
|
next unless $compositeID{$tagKey{$_}}; |
3794
|
|
|
|
|
|
|
} |
3795
|
|
|
|
|
|
|
# save pointers to all used tag keys |
3796
|
5379
|
|
|
|
|
13360
|
foreach (keys %tagKey) { |
3797
|
23851
|
100
|
|
|
|
51658
|
$$compKeys{$_} or $$compKeys{$_} = [ ]; |
3798
|
23851
|
|
|
|
|
30290
|
push @{$$compKeys{$tagKey{$_}}}, [ \%tagKey, $_ ]; |
|
23851
|
|
|
|
|
92920
|
|
3799
|
|
|
|
|
|
|
} |
3800
|
|
|
|
|
|
|
# save reference to tag key lookup as value for Composite tag |
3801
|
5379
|
|
|
|
|
17369
|
my $key = $self->FoundTag($tagInfo, \%tagKey); |
3802
|
|
|
|
|
|
|
} elsif (not defined $found) { |
3803
|
3775
|
|
|
|
|
8347
|
delete $notBuilt{$tagName}; # tag can't be built anyway |
3804
|
|
|
|
|
|
|
} |
3805
|
34122
|
100
|
|
|
|
98560
|
last unless $subDoc; |
3806
|
|
|
|
|
|
|
# don't process sub-documents if there is no chance to build this tag |
3807
|
|
|
|
|
|
|
# (can be very time-consuming if there are many docs) |
3808
|
195
|
100
|
|
|
|
535
|
if (%$require) { |
3809
|
165
|
|
|
|
|
695
|
foreach (keys %$require) { |
3810
|
165
|
|
|
|
|
399
|
my $reqTag = $$require{$_}; |
3811
|
165
|
|
|
|
|
645
|
$reqTag =~ s/.*://; |
3812
|
165
|
50
|
|
|
|
772
|
next COMPOSITE_TAG unless defined $$rawValue{$reqTag}; |
3813
|
|
|
|
|
|
|
} |
3814
|
0
|
|
|
|
|
0
|
$docNum = 1; # go ahead and process the 1st sub-document |
3815
|
|
|
|
|
|
|
} else { |
3816
|
30
|
50
|
|
|
|
157
|
my @try = ref $$tagInfo{SubDoc} ? @{$$tagInfo{SubDoc}} : keys %$desire; |
|
30
|
|
|
|
|
128
|
|
3817
|
|
|
|
|
|
|
# at least one of the specified desire tags must exist |
3818
|
30
|
|
|
|
|
102
|
foreach (@try) { |
3819
|
60
|
50
|
|
|
|
236
|
my $desTag = $$desire{$_} or next; |
3820
|
60
|
|
|
|
|
300
|
$desTag =~ s/.*://; |
3821
|
60
|
50
|
|
|
|
224
|
defined $$rawValue{$desTag} and $docNum = 1, last; |
3822
|
|
|
|
|
|
|
} |
3823
|
30
|
50
|
|
|
|
203
|
last unless $docNum; |
3824
|
|
|
|
|
|
|
} |
3825
|
|
|
|
|
|
|
} |
3826
|
|
|
|
|
|
|
} |
3827
|
2266
|
100
|
|
|
|
7311
|
last unless @deferredTags; |
3828
|
1747
|
100
|
|
|
|
5136
|
if (@deferredTags == @tagList) { |
3829
|
449
|
50
|
|
|
|
2204
|
if ($allBuilt) { |
3830
|
|
|
|
|
|
|
# everything was deferred in the last pass, |
3831
|
|
|
|
|
|
|
# must be a circular dependency |
3832
|
0
|
|
|
|
|
0
|
warn "Circular dependency in Composite tags\n"; |
3833
|
0
|
|
|
|
|
0
|
last; |
3834
|
|
|
|
|
|
|
} |
3835
|
449
|
|
|
|
|
1085
|
$allBuilt = 1; # try once more, ignoring Composite Inhibit tags |
3836
|
|
|
|
|
|
|
} |
3837
|
1747
|
|
|
|
|
10696
|
@tagList = @deferredTags; # calculate deferred tags now |
3838
|
|
|
|
|
|
|
} |
3839
|
519
|
|
|
|
|
2605
|
delete $$self{BuildingComposite}; |
3840
|
|
|
|
|
|
|
} |
3841
|
|
|
|
|
|
|
|
3842
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3843
|
|
|
|
|
|
|
# Get reference to Composite tag info hash |
3844
|
|
|
|
|
|
|
# Inputs: 0) case-sensitive Composite tag name |
3845
|
|
|
|
|
|
|
# Returns: tagInfo hash or undef |
3846
|
|
|
|
|
|
|
sub GetCompositeTagInfo($) |
3847
|
|
|
|
|
|
|
{ |
3848
|
11
|
|
|
11
|
0
|
46
|
my $tag = shift; |
3849
|
11
|
50
|
|
|
|
74
|
return undef unless $compositeID{$tag}; |
3850
|
11
|
|
|
|
|
82
|
return $Image::ExifTool::Composite{$compositeID{$tag}[0]}; |
3851
|
|
|
|
|
|
|
} |
3852
|
|
|
|
|
|
|
|
3853
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3854
|
|
|
|
|
|
|
# Get tag name (removes copy index) |
3855
|
|
|
|
|
|
|
# Inputs: 0) Tag key |
3856
|
|
|
|
|
|
|
# Returns: Tag name |
3857
|
|
|
|
|
|
|
sub GetTagName($) |
3858
|
|
|
|
|
|
|
{ |
3859
|
17070
|
|
|
17070
|
1
|
23120
|
local $_; |
3860
|
17070
|
|
|
|
|
40977
|
$_[0] =~ /^(\S+)/; |
3861
|
17070
|
|
|
|
|
50947
|
return $1; |
3862
|
|
|
|
|
|
|
} |
3863
|
|
|
|
|
|
|
|
3864
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3865
|
|
|
|
|
|
|
# Get list of shortcuts |
3866
|
|
|
|
|
|
|
# Returns: Shortcut list (sorted alphabetically) |
3867
|
|
|
|
|
|
|
sub GetShortcuts() |
3868
|
|
|
|
|
|
|
{ |
3869
|
0
|
|
|
0
|
1
|
0
|
local $_; |
3870
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Shortcuts; |
3871
|
0
|
|
|
|
|
0
|
return sort keys %Image::ExifTool::Shortcuts::Main; |
3872
|
|
|
|
|
|
|
} |
3873
|
|
|
|
|
|
|
|
3874
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3875
|
|
|
|
|
|
|
# Get file type for specified extension |
3876
|
|
|
|
|
|
|
# Inputs: 0) file name or extension (case is not significant), |
3877
|
|
|
|
|
|
|
# or FileType value if a description is requested |
3878
|
|
|
|
|
|
|
# 1) flag to return long description instead of type ('0' to return any recognized type) |
3879
|
|
|
|
|
|
|
# Returns: File type (or desc) or undef if extension not supported or if |
3880
|
|
|
|
|
|
|
# description is the same as the input FileType. In list context, |
3881
|
|
|
|
|
|
|
# may return more than one file type if the file may be different formats. |
3882
|
|
|
|
|
|
|
# Returns list of all supported extensions if no file specified |
3883
|
|
|
|
|
|
|
sub GetFileType(;$$) |
3884
|
|
|
|
|
|
|
{ |
3885
|
968
|
|
|
968
|
1
|
2811
|
local $_; |
3886
|
968
|
|
|
|
|
2622
|
my ($file, $desc) = @_; |
3887
|
968
|
50
|
|
|
|
3065
|
unless (defined $file) { |
3888
|
0
|
|
|
|
|
0
|
my @types; |
3889
|
0
|
0
|
0
|
|
|
0
|
if (defined $desc and $desc eq '0') { |
3890
|
|
|
|
|
|
|
# return all recognized types |
3891
|
0
|
|
|
|
|
0
|
@types = sort keys %fileTypeLookup; |
3892
|
|
|
|
|
|
|
} else { |
3893
|
|
|
|
|
|
|
# return all supported types |
3894
|
0
|
|
|
|
|
0
|
foreach (sort keys %fileTypeLookup) { |
3895
|
0
|
|
|
|
|
0
|
my $module = $moduleName{$_}; |
3896
|
0
|
0
|
|
|
|
0
|
$module = $moduleName{$fileTypeLookup{$_}} unless defined $module; |
3897
|
0
|
0
|
0
|
|
|
0
|
push @types, $_ unless defined $module and $module eq '0'; |
3898
|
|
|
|
|
|
|
} |
3899
|
|
|
|
|
|
|
} |
3900
|
0
|
|
|
|
|
0
|
return @types; |
3901
|
|
|
|
|
|
|
} |
3902
|
968
|
|
|
|
|
2215
|
my ($fileType, $subType); |
3903
|
968
|
|
|
|
|
2359
|
my $fileExt = GetFileExtension($file); |
3904
|
968
|
100
|
|
|
|
3621
|
unless ($fileExt) { |
3905
|
66
|
50
|
|
|
|
392
|
if ($file =~ s/ \((.*)\)$//) { |
3906
|
0
|
|
|
|
|
0
|
$subType = $1; |
3907
|
0
|
|
|
|
|
0
|
$fileExt = GetFileExtension($file); |
3908
|
|
|
|
|
|
|
} |
3909
|
66
|
50
|
|
|
|
309
|
$fileExt = uc($file) unless $fileExt; |
3910
|
|
|
|
|
|
|
} |
3911
|
968
|
100
|
|
|
|
4605
|
$fileExt and $fileType = $fileTypeLookup{$fileExt}; # look up the file type |
3912
|
968
|
|
100
|
|
|
6598
|
$fileType = $fileTypeLookup{$fileType} while $fileType and not ref $fileType; |
3913
|
|
|
|
|
|
|
# return description if specified |
3914
|
|
|
|
|
|
|
# (allow input $file to be a FileType for this purpose) |
3915
|
968
|
50
|
33
|
|
|
6952
|
if ($desc) { |
|
|
100
|
66
|
|
|
|
|
3916
|
0
|
0
|
|
|
|
0
|
if ($fileType) { |
3917
|
0
|
0
|
0
|
|
|
0
|
if ($static_vars{OverrideFileDescription} and $static_vars{OverrideFileDescription}{$fileExt}) { |
3918
|
0
|
|
|
|
|
0
|
$desc = $static_vars{OverrideFileDescription}{$fileExt}; |
3919
|
|
|
|
|
|
|
} else { |
3920
|
0
|
|
|
|
|
0
|
$desc = $$fileType[1]; |
3921
|
|
|
|
|
|
|
} |
3922
|
|
|
|
|
|
|
} else { |
3923
|
0
|
|
|
|
|
0
|
$desc = $fileDescription{$file}; |
3924
|
|
|
|
|
|
|
} |
3925
|
0
|
0
|
|
|
|
0
|
$desc .= ", $subType" if $subType; |
3926
|
0
|
|
|
|
|
0
|
return $desc; |
3927
|
|
|
|
|
|
|
} elsif ($fileType and (not defined $desc or $desc ne '0')) { |
3928
|
|
|
|
|
|
|
# return only supported file types |
3929
|
919
|
|
|
|
|
3346
|
my $mod = $moduleName{$$fileType[0]}; |
3930
|
919
|
50
|
66
|
|
|
4445
|
undef $fileType if defined $mod and $mod eq '0'; |
3931
|
|
|
|
|
|
|
} |
3932
|
968
|
100
|
|
|
|
2906
|
$fileType or return (); |
3933
|
919
|
|
|
|
|
2045
|
$fileType = $$fileType[0]; # get file type (or list of types) |
3934
|
919
|
100
|
|
|
|
2941
|
if (wantarray) { |
|
|
50
|
|
|
|
|
|
3935
|
689
|
100
|
|
|
|
2464
|
return @$fileType if ref $fileType eq 'ARRAY'; |
3936
|
|
|
|
|
|
|
} elsif ($fileType) { |
3937
|
230
|
50
|
|
|
|
1012
|
$fileType = $fileExt if ref $fileType eq 'ARRAY'; |
3938
|
|
|
|
|
|
|
} |
3939
|
915
|
|
|
|
|
3175
|
return $fileType; |
3940
|
|
|
|
|
|
|
} |
3941
|
|
|
|
|
|
|
|
3942
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3943
|
|
|
|
|
|
|
# Return true if we can write the specified file type |
3944
|
|
|
|
|
|
|
# Inputs: 0) file name or ext |
3945
|
|
|
|
|
|
|
# Returns: true if writable, 0 if not writable, undef if unrecognized |
3946
|
|
|
|
|
|
|
sub CanWrite($) |
3947
|
|
|
|
|
|
|
{ |
3948
|
0
|
|
|
0
|
1
|
0
|
local $_; |
3949
|
0
|
0
|
|
|
|
0
|
my $file = shift or return undef; |
3950
|
0
|
0
|
|
|
|
0
|
my ($type) = GetFileType($file) or return undef; |
3951
|
0
|
0
|
|
|
|
0
|
if ($noWriteFile{$type}) { |
3952
|
|
|
|
|
|
|
# can't write TIFF files with certain extensions (various RAW formats) |
3953
|
0
|
|
0
|
|
|
0
|
my $ext = GetFileExtension($file) || uc($file); |
3954
|
0
|
0
|
|
|
|
0
|
return grep(/^$ext$/, @{$noWriteFile{$type}}) ? 0 : 1 if $ext; |
|
0
|
0
|
|
|
|
0
|
|
3955
|
|
|
|
|
|
|
} |
3956
|
0
|
0
|
|
|
|
0
|
if ($onlyWriteFile{$type}) { |
3957
|
0
|
|
0
|
|
|
0
|
my $ext = GetFileExtension($file) || uc($file); |
3958
|
0
|
0
|
|
|
|
0
|
return grep(/^$ext$/, @{$onlyWriteFile{$type}}) ? 1 : 0 if $ext; |
|
0
|
0
|
|
|
|
0
|
|
3959
|
|
|
|
|
|
|
} |
3960
|
0
|
0
|
|
|
|
0
|
unless (%writeTypes) { |
3961
|
0
|
|
|
|
|
0
|
$writeTypes{$_} = 1 foreach @writeTypes; |
3962
|
|
|
|
|
|
|
} |
3963
|
0
|
|
|
|
|
0
|
return $writeTypes{$type}; |
3964
|
|
|
|
|
|
|
} |
3965
|
|
|
|
|
|
|
|
3966
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
3967
|
|
|
|
|
|
|
# Return true if we can create the specified file type |
3968
|
|
|
|
|
|
|
# Inputs: 0) file name or ext |
3969
|
|
|
|
|
|
|
# Returns: true if creatable, 0 if not writable, undef if unrecognized |
3970
|
|
|
|
|
|
|
sub CanCreate($) |
3971
|
|
|
|
|
|
|
{ |
3972
|
23
|
|
|
23
|
1
|
70
|
local $_; |
3973
|
23
|
50
|
|
|
|
120
|
my $file = shift or return undef; |
3974
|
23
|
|
33
|
|
|
96
|
my $ext = GetFileExtension($file) || uc($file); |
3975
|
23
|
50
|
|
|
|
120
|
my $type = GetFileType($file) or return undef; |
3976
|
23
|
50
|
33
|
|
|
231
|
return 1 if $createTypes{$ext} or $createTypes{$type}; |
3977
|
0
|
|
|
|
|
0
|
return 0; |
3978
|
|
|
|
|
|
|
} |
3979
|
|
|
|
|
|
|
|
3980
|
|
|
|
|
|
|
#============================================================================== |
3981
|
|
|
|
|
|
|
# Functions below this are not part of the public API |
3982
|
|
|
|
|
|
|
|
3983
|
|
|
|
|
|
|
# Initialize member variables before reading or writing a new file |
3984
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
3985
|
|
|
|
|
|
|
sub Init($) |
3986
|
|
|
|
|
|
|
{ |
3987
|
787
|
|
|
787
|
0
|
1871
|
local $_; |
3988
|
787
|
|
|
|
|
1810
|
my $self = shift; |
3989
|
|
|
|
|
|
|
# delete all DataMember variables (lower-case names) |
3990
|
787
|
|
|
|
|
8007
|
foreach (keys %$self) { |
3991
|
25851
|
100
|
|
|
|
57786
|
/[a-z]/ and delete $$self{$_}; |
3992
|
|
|
|
|
|
|
} |
3993
|
787
|
|
|
|
|
4505
|
undef %static_vars; # clear all static variables |
3994
|
787
|
|
|
|
|
2894
|
delete $$self{FOUND_TAGS}; # list of found tags |
3995
|
787
|
|
|
|
|
2060
|
delete $$self{EXIF_DATA}; # the EXIF data block |
3996
|
787
|
|
|
|
|
1941
|
delete $$self{EXIF_POS}; # EXIF position in file |
3997
|
787
|
|
|
|
|
1754
|
delete $$self{FIRST_EXIF_POS}; # position of first EXIF in file |
3998
|
787
|
|
|
|
|
1708
|
delete $$self{HTML_DUMP}; # html dump information |
3999
|
787
|
|
|
|
|
1563
|
delete $$self{SET_GROUP0}; # group0 name override |
4000
|
787
|
|
|
|
|
1953
|
delete $$self{SET_GROUP1}; # group1 name override |
4001
|
787
|
|
|
|
|
2080
|
delete $$self{DOC_NUM}; # current embedded document number |
4002
|
787
|
|
|
|
|
2716
|
$$self{DOC_COUNT} = 0; # count of embedded documents processed |
4003
|
787
|
|
|
|
|
2119
|
$$self{BASE} = 0; # base for offsets from start of file |
4004
|
787
|
|
|
|
|
4073
|
$$self{FILE_ORDER} = { }; # * hash of tag order in file ('*' = based on tag key) |
4005
|
787
|
|
|
|
|
5213
|
$$self{VALUE} = { }; # * hash of raw tag values |
4006
|
787
|
|
|
|
|
3087
|
$$self{BOTH} = { }; # * hash for Value/PrintConv values of Require'd tags |
4007
|
787
|
|
|
|
|
2571
|
$$self{RATIONAL} = { }; # * hash of original rational components |
4008
|
787
|
|
|
|
|
4320
|
$$self{TAG_INFO} = { }; # * hash of tag information |
4009
|
787
|
|
|
|
|
3539
|
$$self{TAG_EXTRA} = { }; # * hash of extra tag information (dynamic group names) |
4010
|
787
|
|
|
|
|
2180
|
$$self{PRIORITY} = { }; # * priority of current tags |
4011
|
787
|
|
|
|
|
2154
|
$$self{LIST_TAGS} = { }; # hash of tagInfo refs for active List-type tags |
4012
|
787
|
|
|
|
|
2603
|
$$self{PROCESSED} = { }; # hash of processed directory start positions |
4013
|
787
|
|
|
|
|
2006
|
$$self{DIR_COUNT} = { }; # count various types of directories |
4014
|
787
|
|
|
|
|
2096
|
$$self{DUPL_TAG} = { }; # last-used index for duplicate-tag keys |
4015
|
787
|
|
|
|
|
2178
|
$$self{WARNED_ONCE}= { }; # WarnOnce() warnings already issued |
4016
|
787
|
|
|
|
|
2110
|
$$self{WRITTEN} = { }; # list of tags written (selected tags only) |
4017
|
787
|
|
|
|
|
2451
|
$$self{FORCE_WRITE}= { }; # ForceWrite lookup (set from ForceWrite tag) |
4018
|
787
|
|
|
|
|
2285
|
$$self{FOUND_DIR} = { }; # hash of directory names found in file |
4019
|
787
|
|
|
|
|
5648
|
$$self{COMP_KEYS} = { }; # lookup for tag keys used in Composite tags |
4020
|
787
|
|
|
|
|
2382
|
$$self{PATH} = [ ]; # current subdirectory path in file when reading |
4021
|
787
|
|
|
|
|
2017
|
$$self{NUM_FOUND} = 0; # total number of tags found (incl. duplicates) |
4022
|
787
|
|
|
|
|
1904
|
$$self{CHANGED} = 0; # number of tags changed (writer only) |
4023
|
787
|
|
|
|
|
2358
|
$$self{INDENT} = ' '; # initial indent for verbose messages |
4024
|
787
|
|
|
|
|
2072
|
$$self{PRIORITY_DIR} = ''; # the priority directory name |
4025
|
787
|
|
|
|
|
3026
|
$$self{LOW_PRIORITY_DIR} = { PreviewIFD => 1 }; # names of priority 0 directories |
4026
|
787
|
|
|
|
|
2008
|
$$self{TIFF_TYPE} = ''; # type of TIFF data (APP1, TIFF, NEF, etc...) |
4027
|
787
|
|
|
|
|
1884
|
$$self{FMT_EXPR} = undef; # current advanced formatting expression |
4028
|
787
|
|
|
|
|
1974
|
$$self{Make} = ''; # camera make |
4029
|
787
|
|
|
|
|
1769
|
$$self{Model} = ''; # camera model |
4030
|
787
|
|
|
|
|
2005
|
$$self{CameraType} = ''; # Olympus camera type |
4031
|
787
|
|
|
|
|
1876
|
$$self{FileType} = ''; # identified file type |
4032
|
787
|
50
|
|
|
|
3056
|
if ($self->Options('HtmlDump')) { |
4033
|
0
|
|
|
|
|
0
|
require Image::ExifTool::HtmlDump; |
4034
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP} = new Image::ExifTool::HtmlDump; |
4035
|
|
|
|
|
|
|
} |
4036
|
|
|
|
|
|
|
# make sure our TextOut is a file reference |
4037
|
787
|
50
|
|
|
|
4364
|
$$self{OPTIONS}{TextOut} = \*STDOUT unless ref $$self{OPTIONS}{TextOut}; |
4038
|
|
|
|
|
|
|
} |
4039
|
|
|
|
|
|
|
|
4040
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4041
|
|
|
|
|
|
|
# Combine information from a list of info hashes |
4042
|
|
|
|
|
|
|
# Unless Duplicates is enabled, first entry found takes priority |
4043
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1-N) list of info hash references |
4044
|
|
|
|
|
|
|
# Returns: Combined information hash reference |
4045
|
|
|
|
|
|
|
sub CombineInfo($;@) |
4046
|
|
|
|
|
|
|
{ |
4047
|
2
|
|
|
2
|
0
|
1473
|
local $_; |
4048
|
2
|
|
|
|
|
5
|
my $self = shift; |
4049
|
2
|
|
|
|
|
5
|
my (%combinedInfo, $info, $tag, %haveInfo); |
4050
|
|
|
|
|
|
|
|
4051
|
2
|
50
|
|
|
|
9
|
if ($$self{OPTIONS}{Duplicates}) { |
4052
|
0
|
|
|
|
|
0
|
while ($info = shift) { |
4053
|
0
|
|
|
|
|
0
|
foreach $tag (keys %$info) { |
4054
|
0
|
|
|
|
|
0
|
$combinedInfo{$tag} = $$info{$tag}; |
4055
|
|
|
|
|
|
|
} |
4056
|
|
|
|
|
|
|
} |
4057
|
|
|
|
|
|
|
} else { |
4058
|
2
|
|
|
|
|
9
|
while ($info = shift) { |
4059
|
4
|
|
|
|
|
60
|
foreach $tag (keys %$info) { |
4060
|
266
|
|
|
|
|
389
|
my $tagName = GetTagName($tag); |
4061
|
266
|
100
|
|
|
|
530
|
next if $haveInfo{$tagName}; |
4062
|
252
|
|
|
|
|
391
|
$haveInfo{$tagName} = 1; |
4063
|
252
|
|
|
|
|
442
|
$combinedInfo{$tag} = $$info{$tag}; |
4064
|
|
|
|
|
|
|
} |
4065
|
|
|
|
|
|
|
} |
4066
|
|
|
|
|
|
|
} |
4067
|
2
|
|
|
|
|
34
|
return \%combinedInfo; |
4068
|
|
|
|
|
|
|
} |
4069
|
|
|
|
|
|
|
|
4070
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4071
|
|
|
|
|
|
|
# Get tag table name |
4072
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
4073
|
|
|
|
|
|
|
# Returns: Table name if available, otherwise '' |
4074
|
|
|
|
|
|
|
sub GetTableName($$) |
4075
|
|
|
|
|
|
|
{ |
4076
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag) = @_; |
4077
|
0
|
0
|
|
|
|
0
|
my $tagInfo = $$self{TAG_INFO}{$tag} or return ''; |
4078
|
0
|
|
|
|
|
0
|
return $$tagInfo{Table}{SHORT_NAME}; |
4079
|
|
|
|
|
|
|
} |
4080
|
|
|
|
|
|
|
|
4081
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4082
|
|
|
|
|
|
|
# Get tag index number |
4083
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tag key |
4084
|
|
|
|
|
|
|
# Returns: Table index number, or undefined if this tag isn't indexed |
4085
|
|
|
|
|
|
|
sub GetTagIndex($$) |
4086
|
|
|
|
|
|
|
{ |
4087
|
0
|
|
|
0
|
0
|
0
|
my ($self, $tag) = @_; |
4088
|
0
|
0
|
|
|
|
0
|
my $tagInfo = $$self{TAG_INFO}{$tag} or return undef; |
4089
|
0
|
|
|
|
|
0
|
return $$tagInfo{Index}; |
4090
|
|
|
|
|
|
|
} |
4091
|
|
|
|
|
|
|
|
4092
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4093
|
|
|
|
|
|
|
# Find value for specified tag |
4094
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag name, 2) tag group (family 1) |
4095
|
|
|
|
|
|
|
# Returns: value or undef |
4096
|
|
|
|
|
|
|
sub FindValue($$$) |
4097
|
|
|
|
|
|
|
{ |
4098
|
72
|
|
|
72
|
0
|
157
|
my ($et, $tag, $grp) = @_; |
4099
|
72
|
|
|
|
|
98
|
my ($i, $val); |
4100
|
72
|
|
|
|
|
117
|
my $value = $$et{VALUE}; |
4101
|
72
|
|
|
|
|
120
|
for ($i=0; ; ++$i) { |
4102
|
144
|
100
|
|
|
|
424
|
my $key = $tag . ($i ? " ($i)" : ''); |
4103
|
144
|
100
|
|
|
|
323
|
last unless defined $$value{$key}; |
4104
|
142
|
100
|
|
|
|
272
|
if ($et->GetGroup($key, 1) eq $grp) { |
4105
|
70
|
|
|
|
|
200
|
$val = $$value{$key}; |
4106
|
70
|
|
|
|
|
126
|
last; |
4107
|
|
|
|
|
|
|
} |
4108
|
|
|
|
|
|
|
} |
4109
|
72
|
|
|
|
|
189
|
return $val; |
4110
|
|
|
|
|
|
|
} |
4111
|
|
|
|
|
|
|
|
4112
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4113
|
|
|
|
|
|
|
# Get tag key for next existing tag |
4114
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag key or case-sensitive tag name |
4115
|
|
|
|
|
|
|
# Returns: Key of next existing tag, or undef if no more |
4116
|
|
|
|
|
|
|
# Notes: This routine is provided for iterating through duplicate tags in the |
4117
|
|
|
|
|
|
|
# ValueConv of Composite tags. |
4118
|
|
|
|
|
|
|
sub NextTagKey($$) |
4119
|
|
|
|
|
|
|
{ |
4120
|
18
|
|
|
18
|
0
|
82
|
my ($self, $tag) = @_; |
4121
|
18
|
50
|
|
|
|
157
|
my $i = ($tag =~ s/ \((\d+)\)$//) ? $1 + 1 : 1; |
4122
|
18
|
|
|
|
|
90
|
$tag = "$tag ($i)"; |
4123
|
18
|
50
|
|
|
|
84
|
return $tag if defined $$self{VALUE}{$tag}; |
4124
|
18
|
|
|
|
|
437
|
return undef; |
4125
|
|
|
|
|
|
|
} |
4126
|
|
|
|
|
|
|
|
4127
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4128
|
|
|
|
|
|
|
# Does a string contain valid UTF-8 characters? |
4129
|
|
|
|
|
|
|
# Inputs: 0) string reference, 1) true to allow last character to be truncated |
4130
|
|
|
|
|
|
|
# Returns: 0=regular ASCII, -1=invalid UTF-8, 1=valid UTF-8 with maximum 16-bit |
4131
|
|
|
|
|
|
|
# wide characters, 2=valid UTF-8 requiring 32-bit wide characters |
4132
|
|
|
|
|
|
|
# Notes: Changes current string position |
4133
|
|
|
|
|
|
|
# (see http://www.fileformat.info/info/unicode/utf8.htm for help understanding this) |
4134
|
|
|
|
|
|
|
sub IsUTF8($;$) |
4135
|
|
|
|
|
|
|
{ |
4136
|
103
|
|
|
103
|
0
|
218
|
my ($strPt, $trunc) = @_; |
4137
|
103
|
|
|
|
|
307
|
pos($$strPt) = 0; # start at beginning of string |
4138
|
103
|
100
|
|
|
|
535
|
return 0 unless $$strPt =~ /([\x80-\xff])/g; |
4139
|
41
|
|
|
|
|
90
|
my $rtnVal = 1; |
4140
|
41
|
|
|
|
|
64
|
for (;;) { |
4141
|
183
|
|
|
|
|
312
|
my $ch = ord($1); |
4142
|
|
|
|
|
|
|
# minimum lead byte for 2-byte sequence is 0xc2 (overlong sequences |
4143
|
|
|
|
|
|
|
# not allowed), 0xf8-0xfd are restricted by RFC 3629 (no 5 or 6 byte |
4144
|
|
|
|
|
|
|
# sequences), and 0xfe and 0xff are not valid in UTF-8 strings |
4145
|
183
|
100
|
100
|
|
|
619
|
return -1 if $ch < 0xc2 or $ch >= 0xf8; |
4146
|
|
|
|
|
|
|
# determine number of bytes remaining in sequence |
4147
|
153
|
|
|
|
|
194
|
my $n; |
4148
|
153
|
100
|
|
|
|
259
|
if ($ch < 0xe0) { |
|
|
50
|
|
|
|
|
|
4149
|
75
|
|
|
|
|
102
|
$n = 1; |
4150
|
|
|
|
|
|
|
} elsif ($ch < 0xf0) { |
4151
|
78
|
|
|
|
|
107
|
$n = 2; |
4152
|
|
|
|
|
|
|
} else { |
4153
|
0
|
|
|
|
|
0
|
$n = 3; |
4154
|
|
|
|
|
|
|
# character code is greater than 0xffff if more than 2 extra bytes |
4155
|
|
|
|
|
|
|
# were required in the UTF-8 character |
4156
|
0
|
|
|
|
|
0
|
$rtnVal = 2; |
4157
|
|
|
|
|
|
|
} |
4158
|
153
|
|
|
|
|
197
|
my $pos = pos $$strPt; |
4159
|
153
|
100
|
|
|
|
657
|
unless ($$strPt =~ /\G([\x80-\xbf]{$n})/g) { |
4160
|
1
|
50
|
33
|
|
|
9
|
return $rtnVal if $trunc and $pos + $n > length $$strPt; |
4161
|
1
|
|
|
|
|
4
|
return -1; |
4162
|
|
|
|
|
|
|
} |
4163
|
|
|
|
|
|
|
# the following is ref https://www.cl.cam.ac.uk/%7Emgk25/ucs/utf8_check.c |
4164
|
152
|
100
|
|
|
|
273
|
if ($n == 2) { |
4165
|
77
|
50
|
66
|
|
|
396
|
return -1 if ($ch == 0xe0 and (ord($1) & 0xe0) == 0x80) or |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4166
|
|
|
|
|
|
|
($ch == 0xed and (ord($1) & 0xe0) == 0xa0) or |
4167
|
|
|
|
|
|
|
($ch == 0xef and ord($1) == 0xbf and |
4168
|
|
|
|
|
|
|
(ord(substr $1, 1) & 0xfe) == 0xbe); |
4169
|
|
|
|
|
|
|
} else { |
4170
|
75
|
50
|
33
|
|
|
363
|
return -1 if ($ch == 0xf0 and (ord($1) & 0xf0) == 0x80) or |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
4171
|
|
|
|
|
|
|
($ch == 0xf4 and ord($1) > 0x8f) or $ch > 0xf4; |
4172
|
|
|
|
|
|
|
} |
4173
|
152
|
100
|
|
|
|
398
|
last unless $$strPt =~ /([\x80-\xff])/g; |
4174
|
|
|
|
|
|
|
} |
4175
|
10
|
|
|
|
|
26
|
return $rtnVal; |
4176
|
|
|
|
|
|
|
} |
4177
|
|
|
|
|
|
|
|
4178
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4179
|
|
|
|
|
|
|
# Split file name into directory and name parts |
4180
|
|
|
|
|
|
|
# Inptus: 0) file name |
4181
|
|
|
|
|
|
|
# Returns: 0) directory, 1) filename |
4182
|
|
|
|
|
|
|
sub SplitFileName($) |
4183
|
|
|
|
|
|
|
{ |
4184
|
486
|
|
|
486
|
0
|
1310
|
my $file = shift; |
4185
|
486
|
|
|
|
|
1130
|
my ($dir, $name); |
4186
|
486
|
50
|
|
|
|
1107
|
if (eval { require File::Basename }) { |
|
486
|
|
|
|
|
5134
|
|
4187
|
486
|
|
|
|
|
29152
|
$dir = File::Basename::dirname($file); |
4188
|
486
|
|
|
|
|
13414
|
$name = File::Basename::basename($file); |
4189
|
|
|
|
|
|
|
} else { |
4190
|
0
|
|
|
|
|
0
|
($name = $file) =~ tr/\\/\//; |
4191
|
|
|
|
|
|
|
# remove path |
4192
|
0
|
0
|
|
|
|
0
|
if ($name =~ s/(.*)\///) { |
4193
|
0
|
0
|
|
|
|
0
|
$dir = length($1) ? $1 : '/'; |
4194
|
|
|
|
|
|
|
} else { |
4195
|
0
|
|
|
|
|
0
|
$dir = '.'; |
4196
|
|
|
|
|
|
|
} |
4197
|
|
|
|
|
|
|
} |
4198
|
486
|
|
|
|
|
2237
|
return ($dir, $name); |
4199
|
|
|
|
|
|
|
} |
4200
|
|
|
|
|
|
|
|
4201
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4202
|
|
|
|
|
|
|
# Encode file name for calls to system i/o routines |
4203
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in CharSetFileName, 2) flag to force conversion |
4204
|
|
|
|
|
|
|
# Returns: true if Windows Unicode routines should be used (in which case |
4205
|
|
|
|
|
|
|
# the file name will be encoded as a null-terminated UTF-16LE string) |
4206
|
|
|
|
|
|
|
sub EncodeFileName($$;$) |
4207
|
|
|
|
|
|
|
{ |
4208
|
1152
|
|
|
1152
|
0
|
3056
|
my ($self, $file, $force) = @_; |
4209
|
1152
|
|
|
|
|
2763
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
4210
|
1152
|
50
|
33
|
|
|
6745
|
if ($enc) { |
|
|
50
|
33
|
|
|
|
|
4211
|
0
|
0
|
0
|
|
|
0
|
if ($file =~ /[\x80-\xff]/ or $force) { |
4212
|
|
|
|
|
|
|
# encode for use in Windows Unicode functions if necessary |
4213
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MSWin32') { |
4214
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4215
|
0
|
0
|
|
|
|
0
|
if (eval { require Win32API::File }) { |
|
0
|
|
|
|
|
0
|
|
4216
|
|
|
|
|
|
|
# recode as UTF-16LE and add null terminator |
4217
|
0
|
|
|
|
|
0
|
$_[1] = $self->Decode($file, $enc, undef, 'UTF16', 'II') . "\0\0"; |
4218
|
0
|
|
|
|
|
0
|
return 1; |
4219
|
|
|
|
|
|
|
} |
4220
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32API::File for Windows Unicode file support'); |
4221
|
|
|
|
|
|
|
} else { |
4222
|
|
|
|
|
|
|
# recode as UTF-8 for other platforms if necessary |
4223
|
0
|
0
|
|
|
|
0
|
$_[1] = $self->Decode($file, $enc, undef, 'UTF8') unless $enc eq 'UTF8'; |
4224
|
|
|
|
|
|
|
} |
4225
|
|
|
|
|
|
|
} |
4226
|
|
|
|
|
|
|
} elsif ($^O eq 'MSWin32' and $file =~ /[\x80-\xff]/ and not defined $enc) { |
4227
|
0
|
0
|
|
|
|
0
|
$self->WarnOnce('FileName encoding not specified') if IsUTF8(\$file) < 0; |
4228
|
|
|
|
|
|
|
} |
4229
|
1152
|
|
|
|
|
3687
|
return 0; |
4230
|
|
|
|
|
|
|
} |
4231
|
|
|
|
|
|
|
|
4232
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4233
|
|
|
|
|
|
|
# Modified perl open() routine to properly handle special characters in file names |
4234
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) filehandle, 2) filename, |
4235
|
|
|
|
|
|
|
# 3) mode: '<' or undef = read, '>' = write, '+<' = update |
4236
|
|
|
|
|
|
|
# Returns: true on success |
4237
|
|
|
|
|
|
|
# Note: Must call like "$et->Open(\*FH,$file)", not "$et->Open(FH,$file)" to avoid |
4238
|
|
|
|
|
|
|
# "unopened filehandle" errors due to a change in scope of the filehandle |
4239
|
|
|
|
|
|
|
sub Open($*$;$) |
4240
|
|
|
|
|
|
|
{ |
4241
|
923
|
|
|
923
|
0
|
3553
|
my ($self, $fh, $file, $mode) = @_; |
4242
|
|
|
|
|
|
|
|
4243
|
923
|
|
|
|
|
3513
|
$file =~ s/^([\s&])/.\/$1/; # protect leading whitespace or ampersand |
4244
|
|
|
|
|
|
|
# default to read mode ('<') unless input is a trusted pipe |
4245
|
923
|
50
|
33
|
|
|
5032
|
$mode = (($file =~ /\|$/ and $$self{TRUST_PIPE}) ? '' : '<') unless $mode; |
|
|
100
|
|
|
|
|
|
4246
|
923
|
|
|
|
|
2202
|
delete $$self{TRUST_PIPE}; |
4247
|
923
|
50
|
|
|
|
2731
|
if ($mode) { |
4248
|
923
|
50
|
|
|
|
3318
|
if ($self->EncodeFileName($file)) { |
4249
|
|
|
|
|
|
|
# handle Windows Unicode file name |
4250
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4251
|
0
|
|
|
|
|
0
|
my ($access, $create); |
4252
|
0
|
0
|
0
|
|
|
0
|
if ($mode eq '>' or $mode eq '>>') { |
4253
|
0
|
|
|
|
|
0
|
eval { |
4254
|
0
|
|
|
|
|
0
|
$access = Win32API::File::GENERIC_WRITE(); |
4255
|
0
|
0
|
|
|
|
0
|
if ($mode eq '>>') { |
4256
|
0
|
|
|
|
|
0
|
$access |= Win32API::File::FILE_APPEND_DATA(); |
4257
|
0
|
|
|
|
|
0
|
$create = Win32API::File::OPEN_ALWAYS(); |
4258
|
|
|
|
|
|
|
} else { |
4259
|
0
|
|
|
|
|
0
|
$create = Win32API::File::CREATE_ALWAYS(); |
4260
|
|
|
|
|
|
|
} |
4261
|
|
|
|
|
|
|
} |
4262
|
|
|
|
|
|
|
} else { |
4263
|
0
|
|
|
|
|
0
|
eval { |
4264
|
0
|
|
|
|
|
0
|
$access = Win32API::File::GENERIC_READ(); |
4265
|
0
|
0
|
|
|
|
0
|
$access |= Win32API::File::GENERIC_WRITE() if $mode eq '+<'; # update |
4266
|
0
|
|
|
|
|
0
|
$create = Win32API::File::OPEN_EXISTING(); |
4267
|
|
|
|
|
|
|
} |
4268
|
|
|
|
|
|
|
} |
4269
|
0
|
|
|
|
|
0
|
my $share = 0; |
4270
|
0
|
|
|
|
|
0
|
eval { |
4271
|
0
|
0
|
|
|
|
0
|
unless ($access & Win32API::File::GENERIC_WRITE()) { |
4272
|
0
|
|
|
|
|
0
|
$share = Win32API::File::FILE_SHARE_READ() | Win32API::File::FILE_SHARE_WRITE(); |
4273
|
|
|
|
|
|
|
} |
4274
|
|
|
|
|
|
|
}; |
4275
|
0
|
|
|
|
|
0
|
my $wh = eval { Win32API::File::CreateFileW($file, $access, $share, [], $create, 0, []) }; |
|
0
|
|
|
|
|
0
|
|
4276
|
0
|
0
|
|
|
|
0
|
return undef unless $wh; |
4277
|
0
|
|
|
|
|
0
|
my $fd = eval { Win32API::File::OsFHandleOpenFd($wh, 0) }; |
|
0
|
|
|
|
|
0
|
|
4278
|
0
|
0
|
0
|
|
|
0
|
if (not defined $fd or $fd < 0) { |
4279
|
0
|
|
|
|
|
0
|
eval { Win32API::File::CloseHandle($wh) }; |
|
0
|
|
|
|
|
0
|
|
4280
|
0
|
|
|
|
|
0
|
return undef; |
4281
|
|
|
|
|
|
|
} |
4282
|
0
|
|
|
|
|
0
|
$file = "&=$fd"; # specify file by descriptor |
4283
|
|
|
|
|
|
|
} else { |
4284
|
|
|
|
|
|
|
# add leading space to protect against leading characters like '>' |
4285
|
|
|
|
|
|
|
# in file name, and trailing "\0" to protect trailing spaces |
4286
|
923
|
|
|
|
|
3195
|
$file = " $file\0"; |
4287
|
|
|
|
|
|
|
} |
4288
|
|
|
|
|
|
|
} |
4289
|
923
|
|
|
|
|
64818
|
return open $fh, "$mode$file"; |
4290
|
|
|
|
|
|
|
} |
4291
|
|
|
|
|
|
|
|
4292
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4293
|
|
|
|
|
|
|
# Check to see if a file exists (with Windows Unicode support) |
4294
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name |
4295
|
|
|
|
|
|
|
# Returns: true if file exists |
4296
|
|
|
|
|
|
|
sub Exists($$) |
4297
|
|
|
|
|
|
|
{ |
4298
|
222
|
|
|
222
|
0
|
792
|
my ($self, $file) = @_; |
4299
|
|
|
|
|
|
|
|
4300
|
222
|
50
|
|
|
|
854
|
if ($self->EncodeFileName($file)) { |
4301
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4302
|
0
|
|
|
|
|
0
|
my $wh = eval { Win32API::File::CreateFileW($file, |
|
0
|
|
|
|
|
0
|
|
4303
|
|
|
|
|
|
|
Win32API::File::GENERIC_READ(), |
4304
|
|
|
|
|
|
|
Win32API::File::FILE_SHARE_READ(), [], |
4305
|
|
|
|
|
|
|
Win32API::File::OPEN_EXISTING(), 0, []) }; |
4306
|
0
|
0
|
|
|
|
0
|
return 0 unless $wh; |
4307
|
0
|
|
|
|
|
0
|
eval { Win32API::File::CloseHandle($wh) }; |
|
0
|
|
|
|
|
0
|
|
4308
|
|
|
|
|
|
|
} else { |
4309
|
|
|
|
|
|
|
# (named pipes already exist, but we pretend that they don't |
4310
|
|
|
|
|
|
|
# so we will be able to write them, so test with for pipe -p) |
4311
|
222
|
|
33
|
|
|
5635
|
return(-e $file and not -p $file); |
4312
|
|
|
|
|
|
|
} |
4313
|
0
|
|
|
|
|
0
|
return 1; |
4314
|
|
|
|
|
|
|
} |
4315
|
|
|
|
|
|
|
|
4316
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4317
|
|
|
|
|
|
|
# Return true if file is a directory (with Windows Unicode support) |
4318
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name |
4319
|
|
|
|
|
|
|
# Returns: true if file is a directory (false if file isn't, or doesn't exist) |
4320
|
|
|
|
|
|
|
sub IsDirectory($$) |
4321
|
|
|
|
|
|
|
{ |
4322
|
1
|
|
|
1
|
0
|
4
|
my ($et, $file) = @_; |
4323
|
1
|
50
|
|
|
|
5
|
if ($et->EncodeFileName($file)) { |
4324
|
0
|
|
|
|
|
0
|
local $SIG{'__WARN__'} = \&SetWarning; |
4325
|
0
|
|
|
|
|
0
|
my $attrs = eval { Win32API::File::GetFileAttributesW($file) }; |
|
0
|
|
|
|
|
0
|
|
4326
|
0
|
|
0
|
|
|
0
|
my $dirBit = eval { Win32API::File::FILE_ATTRIBUTE_DIRECTORY() } || 0; |
4327
|
0
|
0
|
0
|
|
|
0
|
return 1 if $attrs and $attrs != 0xffffffff and $attrs & $dirBit; |
|
|
|
0
|
|
|
|
|
4328
|
|
|
|
|
|
|
} else { |
4329
|
1
|
|
|
|
|
21
|
return -d $file; |
4330
|
|
|
|
|
|
|
} |
4331
|
0
|
|
|
|
|
0
|
return 0; |
4332
|
|
|
|
|
|
|
} |
4333
|
|
|
|
|
|
|
|
4334
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4335
|
|
|
|
|
|
|
# Get file times (Unix seconds since the epoch) |
4336
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name or ref |
4337
|
|
|
|
|
|
|
# Returns: 0) access time, 1) modification time, 2) creation time (or undefs on error) |
4338
|
|
|
|
|
|
|
my $k32GetFileTime; |
4339
|
|
|
|
|
|
|
sub GetFileTime($$) |
4340
|
|
|
|
|
|
|
{ |
4341
|
0
|
|
|
0
|
0
|
0
|
my ($self, $file) = @_; |
4342
|
|
|
|
|
|
|
|
4343
|
|
|
|
|
|
|
# open file by name if necessary |
4344
|
0
|
0
|
|
|
|
0
|
unless (ref $file) { |
4345
|
0
|
|
|
|
|
0
|
local *FH; |
4346
|
0
|
0
|
|
|
|
0
|
unless ($self->Open(\*FH, $file)) { |
4347
|
0
|
0
|
|
|
|
0
|
if ($self->IsDirectory($file)) { |
4348
|
0
|
|
|
|
|
0
|
my @rtn = (stat $file)[8, 9, 10]; |
4349
|
0
|
0
|
|
|
|
0
|
return @rtn if defined $rtn[0]; |
4350
|
|
|
|
|
|
|
} |
4351
|
0
|
|
|
|
|
0
|
$self->Warn("GetFileTime error for '${file}'"); |
4352
|
0
|
|
|
|
|
0
|
return (); |
4353
|
|
|
|
|
|
|
} |
4354
|
0
|
|
|
|
|
0
|
$file = *FH; # (not \*FH, so *FH will be kept open until $file goes out of scope) |
4355
|
|
|
|
|
|
|
} |
4356
|
|
|
|
|
|
|
# on Windows, try to work around incorrect file times when daylight saving time is in effect |
4357
|
0
|
0
|
|
|
|
0
|
if ($^O eq 'MSWin32') { |
4358
|
0
|
0
|
|
|
|
0
|
if (not eval { require Win32::API }) { |
|
0
|
0
|
|
|
|
0
|
|
4359
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32::API for proper handling of Windows file times', 1); |
4360
|
0
|
|
|
|
|
0
|
} elsif (not eval { require Win32API::File }) { |
4361
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Install Win32API::File for proper handling of Windows file times', 1); |
4362
|
|
|
|
|
|
|
} else { |
4363
|
|
|
|
|
|
|
# get Win32 handle, needed for GetFileTime |
4364
|
0
|
|
|
|
|
0
|
my $win32Handle = eval { Win32API::File::GetOsFHandle($file) }; |
|
0
|
|
|
|
|
0
|
|
4365
|
0
|
0
|
|
|
|
0
|
unless ($win32Handle) { |
4366
|
0
|
|
|
|
|
0
|
$self->Warn("Win32API::File::GetOsFHandle returned invalid handle"); |
4367
|
0
|
|
|
|
|
0
|
return (); |
4368
|
|
|
|
|
|
|
} |
4369
|
|
|
|
|
|
|
# get FILETIME structs |
4370
|
0
|
|
|
|
|
0
|
my ($atime, $mtime, $ctime, $time); |
4371
|
0
|
|
|
|
|
0
|
$atime = $mtime = $ctime = pack 'LL', 0, 0; |
4372
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime) { |
4373
|
0
|
0
|
|
|
|
0
|
return () if defined $k32GetFileTime; |
4374
|
0
|
|
|
|
|
0
|
$k32GetFileTime = new Win32::API('KERNEL32', 'GetFileTime', 'NPPP', 'I'); |
4375
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime) { |
4376
|
0
|
|
|
|
|
0
|
$self->Warn('Error calling Win32::API::GetFileTime'); |
4377
|
0
|
|
|
|
|
0
|
$k32GetFileTime = 0; |
4378
|
0
|
|
|
|
|
0
|
return (); |
4379
|
|
|
|
|
|
|
} |
4380
|
|
|
|
|
|
|
} |
4381
|
0
|
0
|
|
|
|
0
|
unless ($k32GetFileTime->Call($win32Handle, $ctime, $atime, $mtime)) { |
4382
|
0
|
|
|
|
|
0
|
$self->Warn("Win32::API::GetFileTime returned " . Win32::GetLastError()); |
4383
|
0
|
|
|
|
|
0
|
return (); |
4384
|
|
|
|
|
|
|
} |
4385
|
|
|
|
|
|
|
# convert FILETIME structs to Unix seconds |
4386
|
0
|
|
|
|
|
0
|
foreach $time ($atime, $mtime, $ctime) { |
4387
|
0
|
|
|
|
|
0
|
my ($lo, $hi) = unpack 'LL', $time; # unpack FILETIME struct |
4388
|
|
|
|
|
|
|
# FILETIME is in 100 ns intervals since 0:00 UTC Jan 1, 1601 |
4389
|
|
|
|
|
|
|
# (89 leap years between 1601 and 1970) |
4390
|
0
|
|
|
|
|
0
|
$time = ($hi * 4294967296 + $lo) * 1e-7 - (((1970-1601)*365+89)*24*3600); |
4391
|
|
|
|
|
|
|
} |
4392
|
0
|
|
|
|
|
0
|
return ($atime, $mtime, $ctime); |
4393
|
|
|
|
|
|
|
} |
4394
|
|
|
|
|
|
|
} |
4395
|
|
|
|
|
|
|
# other os (or Windows fallback) |
4396
|
0
|
|
|
|
|
0
|
return (stat $file)[8, 9, 10]; |
4397
|
|
|
|
|
|
|
} |
4398
|
|
|
|
|
|
|
|
4399
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4400
|
|
|
|
|
|
|
# Parse function arguments and set member variables accordingly |
4401
|
|
|
|
|
|
|
# Inputs: Same as ImageInfo() |
4402
|
|
|
|
|
|
|
# - sets REQUESTED_TAGS, REQ_TAG_LOOKUP, IO_TAG_LIST, FILENAME, RAF, OPTIONS |
4403
|
|
|
|
|
|
|
sub ParseArguments($;@) |
4404
|
|
|
|
|
|
|
{ |
4405
|
710
|
|
|
710
|
0
|
1611
|
my $self = shift; |
4406
|
710
|
|
|
|
|
1741
|
my $options = $$self{OPTIONS}; |
4407
|
710
|
|
|
|
|
1639
|
my @oldGroupOpts = grep /^Group/, keys %{$$self{OPTIONS}}; |
|
710
|
|
|
|
|
14559
|
|
4408
|
710
|
|
|
|
|
3801
|
my (@exclude, $wasExcludeOpt); |
4409
|
|
|
|
|
|
|
|
4410
|
710
|
|
|
|
|
2615
|
$$self{REQUESTED_TAGS} = [ ]; |
4411
|
710
|
|
|
|
|
2336
|
$$self{REQ_TAG_LOOKUP} = { }; |
4412
|
710
|
|
|
|
|
2419
|
$$self{EXCL_TAG_LOOKUP} = { }; |
4413
|
710
|
|
|
|
|
2026
|
$$self{IO_TAG_LIST} = undef; |
4414
|
710
|
|
|
|
|
1635
|
delete $$self{EXCL_XMP_LOOKUP}; |
4415
|
|
|
|
|
|
|
|
4416
|
|
|
|
|
|
|
# handle our input arguments |
4417
|
710
|
|
|
|
|
2666
|
while (@_) { |
4418
|
1522
|
|
|
|
|
2995
|
my $arg = shift; |
4419
|
1522
|
100
|
66
|
|
|
7190
|
if (ref $arg and not overload::Method($arg, q[""])) { |
|
|
100
|
|
|
|
|
|
4420
|
155
|
100
|
100
|
|
|
7746
|
if (ref $arg eq 'ARRAY') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4421
|
6
|
|
|
|
|
18
|
$$self{IO_TAG_LIST} = $arg; |
4422
|
6
|
|
|
|
|
28
|
foreach (@$arg) { |
4423
|
15
|
100
|
|
|
|
42
|
if (/^-(.*)/) { |
4424
|
2
|
|
|
|
|
9
|
push @exclude, $1; |
4425
|
|
|
|
|
|
|
} else { |
4426
|
13
|
|
|
|
|
22
|
push @{$$self{REQUESTED_TAGS}}, $_; |
|
13
|
|
|
|
|
36
|
|
4427
|
|
|
|
|
|
|
} |
4428
|
|
|
|
|
|
|
} |
4429
|
|
|
|
|
|
|
} elsif (ref $arg eq 'HASH') { |
4430
|
107
|
|
|
|
|
261
|
my $opt; |
4431
|
107
|
|
|
|
|
477
|
foreach $opt (keys %$arg) { |
4432
|
|
|
|
|
|
|
# a single new group option overrides all old group options |
4433
|
171
|
50
|
33
|
|
|
733
|
if (@oldGroupOpts and $opt =~ /^Group/) { |
4434
|
0
|
|
|
|
|
0
|
foreach (@oldGroupOpts) { |
4435
|
0
|
|
|
|
|
0
|
delete $$options{$_}; |
4436
|
|
|
|
|
|
|
} |
4437
|
0
|
|
|
|
|
0
|
undef @oldGroupOpts; |
4438
|
|
|
|
|
|
|
} |
4439
|
171
|
|
|
|
|
750
|
$self->Options($opt, $$arg{$opt}); |
4440
|
171
|
50
|
|
|
|
855
|
$opt eq 'Exclude' and $wasExcludeOpt = 1; |
4441
|
|
|
|
|
|
|
} |
4442
|
|
|
|
|
|
|
} elsif (ref $arg eq 'SCALAR' or UNIVERSAL::isa($arg,'GLOB')) { |
4443
|
23
|
50
|
|
|
|
110
|
next if defined $$self{RAF}; |
4444
|
|
|
|
|
|
|
# convert image data from UTF-8 to character stream if necessary |
4445
|
|
|
|
|
|
|
# (patches RHEL 3 UTF8 LANG problem) |
4446
|
23
|
50
|
66
|
|
|
210
|
if (ref $arg eq 'SCALAR' and $] >= 5.006 and |
|
|
|
33
|
|
|
|
|
|
|
|
66
|
|
|
|
|
4447
|
|
|
|
|
|
|
(eval { require Encode; Encode::is_utf8($$arg) } or $@)) |
4448
|
|
|
|
|
|
|
{ |
4449
|
|
|
|
|
|
|
# repack by hand if Encode isn't available |
4450
|
0
|
0
|
|
|
|
0
|
my $buff = $@ ? pack('C*',unpack($] < 5.010000 ? 'U0C*' : 'C0C*',$$arg)) : Encode::encode('utf8',$$arg); |
|
|
0
|
|
|
|
|
|
4451
|
0
|
|
|
|
|
0
|
$arg = \$buff; |
4452
|
|
|
|
|
|
|
} |
4453
|
23
|
|
|
|
|
208
|
$$self{RAF} = new File::RandomAccess($arg); |
4454
|
|
|
|
|
|
|
# set filename to empty string to indicate that |
4455
|
|
|
|
|
|
|
# we have a file but we didn't open it |
4456
|
23
|
|
|
|
|
111
|
$$self{FILENAME} = ''; |
4457
|
|
|
|
|
|
|
} elsif (UNIVERSAL::isa($arg, 'File::RandomAccess')) { |
4458
|
19
|
|
|
|
|
54
|
$$self{RAF} = $arg; |
4459
|
19
|
|
|
|
|
79
|
$$self{FILENAME} = ''; |
4460
|
|
|
|
|
|
|
} else { |
4461
|
0
|
|
|
|
|
0
|
warn "Don't understand ImageInfo argument $arg\n"; |
4462
|
|
|
|
|
|
|
} |
4463
|
|
|
|
|
|
|
} elsif (defined $$self{FILENAME}) { |
4464
|
881
|
100
|
|
|
|
2446
|
if ($arg =~ /^-(.*)/) { |
4465
|
54
|
|
|
|
|
335
|
push @exclude, $1; |
4466
|
|
|
|
|
|
|
} else { |
4467
|
827
|
|
|
|
|
1279
|
push @{$$self{REQUESTED_TAGS}}, $arg; |
|
827
|
|
|
|
|
2814
|
|
4468
|
|
|
|
|
|
|
} |
4469
|
|
|
|
|
|
|
} else { |
4470
|
486
|
|
|
|
|
1940
|
$$self{FILENAME} = $arg; |
4471
|
|
|
|
|
|
|
} |
4472
|
|
|
|
|
|
|
} |
4473
|
|
|
|
|
|
|
# add additional requested tags to lookup |
4474
|
710
|
100
|
|
|
|
3183
|
if ($$options{RequestTags}) { |
4475
|
46
|
|
|
|
|
197
|
$$self{REQ_TAG_LOOKUP}{$_} = 1 foreach @{$$options{RequestTags}}; |
|
46
|
|
|
|
|
327
|
|
4476
|
|
|
|
|
|
|
} |
4477
|
|
|
|
|
|
|
# expand shortcuts in tag arguments if provided |
4478
|
710
|
100
|
|
|
|
1550
|
if (@{$$self{REQUESTED_TAGS}}) { |
|
710
|
|
|
|
|
2723
|
|
4479
|
362
|
|
|
|
|
1925
|
ExpandShortcuts($$self{REQUESTED_TAGS}); |
4480
|
|
|
|
|
|
|
# initialize lookup for requested tags |
4481
|
362
|
|
|
|
|
913
|
foreach (@{$$self{REQUESTED_TAGS}}) { |
|
362
|
|
|
|
|
1297
|
|
4482
|
883
|
50
|
|
|
|
4675
|
/^(.*:)?([-\w?*]*)#?$/ or next; |
4483
|
883
|
50
|
|
|
|
5046
|
$$self{REQ_TAG_LOOKUP}{lc($2)} = 1 if $2; |
4484
|
883
|
100
|
|
|
|
2553
|
next unless $1; |
4485
|
241
|
|
|
|
|
1674
|
$$self{REQ_TAG_LOOKUP}{lc($_).':'} = 1 foreach split /:/, $1; |
4486
|
|
|
|
|
|
|
} |
4487
|
|
|
|
|
|
|
} |
4488
|
710
|
100
|
66
|
|
|
4600
|
if (@exclude or $wasExcludeOpt) { |
4489
|
|
|
|
|
|
|
# must add existing excluded tags |
4490
|
41
|
100
|
|
|
|
171
|
push @exclude, @{$$options{Exclude}} if $$options{Exclude}; |
|
1
|
|
|
|
|
4
|
|
4491
|
41
|
|
|
|
|
135
|
$$options{Exclude} = \@exclude; |
4492
|
|
|
|
|
|
|
# expand shortcuts in new exclude list |
4493
|
41
|
|
|
|
|
195
|
ExpandShortcuts($$options{Exclude}, 1); # (also remove '#' suffix) |
4494
|
|
|
|
|
|
|
} |
4495
|
|
|
|
|
|
|
# generate lookup for excluded tags |
4496
|
710
|
100
|
|
|
|
3032
|
if ($$options{Exclude}) { |
4497
|
47
|
|
|
|
|
137
|
foreach (@{$$options{Exclude}}) { |
|
47
|
|
|
|
|
230
|
|
4498
|
64
|
100
|
|
|
|
633
|
/([-\w]+)#?$/ and $$self{EXCL_TAG_LOOKUP}{lc $1} = 1; |
4499
|
64
|
50
|
|
|
|
353
|
if (/(xmp-.*:[-\w]+)#?/i) { |
4500
|
0
|
0
|
|
|
|
0
|
$$self{EXCL_XMP_LOOKUP} or $$self{EXCL_XMP_LOOKUP} = { }; |
4501
|
0
|
|
|
|
|
0
|
$$self{EXCL_XMP_LOOKUP}{lc $1} = 1; |
4502
|
|
|
|
|
|
|
} |
4503
|
|
|
|
|
|
|
} |
4504
|
|
|
|
|
|
|
# exclude list is used only for EXCL_TAG_LOOKUP when TAGS_FROM_FILE is set |
4505
|
47
|
100
|
|
|
|
264
|
undef $$options{Exclude} if $$self{TAGS_FROM_FILE}; |
4506
|
|
|
|
|
|
|
} |
4507
|
|
|
|
|
|
|
} |
4508
|
|
|
|
|
|
|
|
4509
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4510
|
|
|
|
|
|
|
# Does group name match the tag ID? |
4511
|
|
|
|
|
|
|
# Inputs: 0) tag ID, 1) group name (with "ID-" removed) |
4512
|
|
|
|
|
|
|
# Returns: true on success |
4513
|
|
|
|
|
|
|
sub IsSameID($$) |
4514
|
|
|
|
|
|
|
{ |
4515
|
2
|
|
|
2
|
0
|
10
|
my ($id, $grp) = @_; |
4516
|
2
|
|
|
|
|
5
|
for (;;) { |
4517
|
2
|
100
|
|
|
|
12
|
return 1 if $grp eq $id; # decimal ID's or raw ID's |
4518
|
1
|
50
|
|
|
|
6
|
if ($id =~ /^\d+$/) { # numerical numerical ID's may be in hex |
4519
|
0
|
0
|
0
|
|
|
0
|
return 1 if $grp =~ s/^0x0*// and $grp eq sprintf('%x', $id); |
4520
|
|
|
|
|
|
|
} else { # other ID's may conform to ExifTool group name conventions |
4521
|
1
|
|
|
|
|
3
|
my $tmp = $id; |
4522
|
1
|
50
|
33
|
|
|
9
|
return 1 if $tmp =~ s/([^-_A-Za-z0-9])/sprintf('%.2x',ord $1)/ge and $grp eq $tmp; |
|
1
|
|
|
|
|
17
|
|
4523
|
|
|
|
|
|
|
} |
4524
|
1
|
50
|
|
|
|
5
|
last unless $id =~ s/-.*//; # remove language code if it exists |
4525
|
|
|
|
|
|
|
} |
4526
|
1
|
|
|
|
|
4
|
return 0; |
4527
|
|
|
|
|
|
|
} |
4528
|
|
|
|
|
|
|
|
4529
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4530
|
|
|
|
|
|
|
# Get list of tags in specified group |
4531
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) group spec, 2) tag key or reference to list of tag keys |
4532
|
|
|
|
|
|
|
# Returns: list of matching tags in list context, or first match in scalar context |
4533
|
|
|
|
|
|
|
# Notes: Group spec may contain multiple groups separated by colons, each |
4534
|
|
|
|
|
|
|
# possibly with a leading family number |
4535
|
|
|
|
|
|
|
sub GroupMatches($$$) |
4536
|
|
|
|
|
|
|
{ |
4537
|
26218
|
|
|
26218
|
0
|
49853
|
my ($self, $group, $tagList) = @_; |
4538
|
26218
|
50
|
|
|
|
52271
|
$tagList = [ $tagList ] unless ref $tagList; |
4539
|
26218
|
|
|
|
|
36111
|
my ($tag, @matches); |
4540
|
|
|
|
|
|
|
# check each group name individually (eg. "Author:1IPTC") |
4541
|
26218
|
|
|
|
|
63408
|
my @grps = split ':', $group; |
4542
|
26218
|
|
|
|
|
37751
|
my (@fmys, $g); |
4543
|
26218
|
|
|
|
|
57220
|
for ($g=0; $g<@grps; ++$g) { |
4544
|
26795
|
50
|
|
|
|
115340
|
if ($grps[$g] =~ s/^(\d*)(id-)?//i) { |
4545
|
26795
|
100
|
|
|
|
62291
|
$fmys[$g] = $1 if length $1; |
4546
|
26795
|
50
|
|
|
|
53340
|
if ($2) { |
4547
|
0
|
|
|
|
|
0
|
$fmys[$g] = 7; |
4548
|
0
|
|
|
|
|
0
|
next; # (don't convert tag ID's to lower case) |
4549
|
|
|
|
|
|
|
} |
4550
|
|
|
|
|
|
|
} |
4551
|
26795
|
|
|
|
|
52525
|
$grps[$g] = lc $grps[$g]; |
4552
|
26795
|
50
|
|
|
|
72855
|
$grps[$g] = '' if $grps[$g] eq 'copy0'; # accept 'Copy0' for primary tag |
4553
|
|
|
|
|
|
|
} |
4554
|
26218
|
|
|
|
|
50660
|
foreach $tag (@$tagList) { |
4555
|
15407
|
|
|
|
|
35386
|
my @groups = $self->GetGroup($tag, -1); |
4556
|
15407
|
|
|
|
|
36824
|
for ($g=0; $g<@grps; ++$g) { |
4557
|
15871
|
|
|
|
|
25677
|
my $grp = $grps[$g]; |
4558
|
15871
|
50
|
33
|
|
|
49924
|
next if $grp eq '*' or $grp eq 'all'; |
4559
|
15871
|
|
|
|
|
20976
|
my $f; |
4560
|
15871
|
100
|
|
|
|
28672
|
if (defined($f = $fmys[$g])) { |
4561
|
3
|
50
|
|
|
|
11
|
last unless defined $groups[$f]; |
4562
|
3
|
50
|
|
|
|
14
|
if ($f == 7) { |
4563
|
0
|
0
|
|
|
|
0
|
next if IsSameID($self->GetTagID($tag), $grp); |
4564
|
|
|
|
|
|
|
} else { |
4565
|
3
|
100
|
|
|
|
17
|
next if $grp eq lc $groups[$f]; |
4566
|
|
|
|
|
|
|
} |
4567
|
1
|
|
|
|
|
2
|
last; |
4568
|
|
|
|
|
|
|
} else { |
4569
|
15868
|
100
|
|
|
|
156135
|
last unless grep /^$grp$/i, @groups; |
4570
|
|
|
|
|
|
|
} |
4571
|
|
|
|
|
|
|
} |
4572
|
15407
|
100
|
|
|
|
42548
|
if ($g == @grps) { |
4573
|
4524
|
100
|
|
|
|
13331
|
return $tag unless wantarray; |
4574
|
2462
|
|
|
|
|
6022
|
push @matches, $tag; |
4575
|
|
|
|
|
|
|
} |
4576
|
|
|
|
|
|
|
} |
4577
|
24156
|
100
|
|
|
|
64350
|
return wantarray ? @matches : $matches[0]; |
4578
|
|
|
|
|
|
|
} |
4579
|
|
|
|
|
|
|
|
4580
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4581
|
|
|
|
|
|
|
# Remove specified tags from returned tag list, updating indices in other lists |
4582
|
|
|
|
|
|
|
# Inputs: 0) tag list ref, 1) index list ref, 2) index list ref, 3) hash ref, |
4583
|
|
|
|
|
|
|
# 4) true to include tags from hash instead of excluding |
4584
|
|
|
|
|
|
|
# Returns: nothing, but updates input lists |
4585
|
|
|
|
|
|
|
sub RemoveTagsFromList($$$$;$) |
4586
|
|
|
|
|
|
|
{ |
4587
|
69
|
|
|
69
|
0
|
160
|
local $_; |
4588
|
69
|
|
|
|
|
214
|
my ($tags, $list1, $list2, $exclude, $inv) = @_; |
4589
|
69
|
|
|
|
|
130
|
my @filteredTags; |
4590
|
|
|
|
|
|
|
|
4591
|
69
|
100
|
100
|
|
|
454
|
if (@$list1 or @$list2) { |
4592
|
6
|
|
|
|
|
37
|
while (@$tags) { |
4593
|
233
|
|
|
|
|
348
|
my $tag = pop @$tags; |
4594
|
233
|
|
|
|
|
321
|
my $i = @$tags; |
4595
|
233
|
100
|
50
|
|
|
647
|
if ($$exclude{$tag} xor $inv) { |
4596
|
|
|
|
|
|
|
# remove index of excluded tag from each list |
4597
|
154
|
100
|
|
|
|
263
|
@$list1 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list1; |
|
12
|
100
|
|
|
|
31
|
|
4598
|
154
|
100
|
|
|
|
224
|
@$list2 = map { $_ < $i ? $_ : $_ == $i ? () : $_ - 1 } @$list2; |
|
8245
|
100
|
|
|
|
12674
|
|
4599
|
|
|
|
|
|
|
} else { |
4600
|
79
|
|
|
|
|
220
|
unshift @filteredTags, $tag; |
4601
|
|
|
|
|
|
|
} |
4602
|
|
|
|
|
|
|
} |
4603
|
|
|
|
|
|
|
} else { |
4604
|
63
|
|
|
|
|
189
|
foreach (@$tags) { |
4605
|
6864
|
100
|
100
|
|
|
20245
|
push @filteredTags, $_ unless $$exclude{$_} xor $inv; |
4606
|
|
|
|
|
|
|
} |
4607
|
|
|
|
|
|
|
} |
4608
|
69
|
|
|
|
|
610
|
$_[0] = \@filteredTags; # update tag list |
4609
|
|
|
|
|
|
|
} |
4610
|
|
|
|
|
|
|
|
4611
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4612
|
|
|
|
|
|
|
# Copy tags from alternate input file |
4613
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) family 8 group, 2) list ref for tag keys to copy |
4614
|
|
|
|
|
|
|
# - updates tag key list to match keys newly added to $self |
4615
|
|
|
|
|
|
|
sub CopyAltInfo($$$) |
4616
|
|
|
|
|
|
|
{ |
4617
|
7
|
|
|
7
|
0
|
20
|
my ($self, $g8, $tags) = @_; |
4618
|
7
|
|
|
|
|
16
|
my ($tag, $vtag); |
4619
|
7
|
50
|
|
|
|
38
|
return unless $g8 =~ /(\d+)/; |
4620
|
7
|
50
|
|
|
|
31
|
my $et = $$self{ALT_EXIFTOOL}{$g8} or return; |
4621
|
7
|
|
|
|
|
28
|
my $altOrder = ($1 + 1) * 100000; # increment file order |
4622
|
7
|
|
|
|
|
28
|
foreach $tag (@$tags) { |
4623
|
9
|
|
|
|
|
70
|
($vtag = $tag) =~ s/( |$)/ #[$g8]/; |
4624
|
9
|
100
|
|
|
|
50
|
unless (defined $$self{VALUE}{$vtag}) { |
4625
|
8
|
|
|
|
|
37
|
$$self{VALUE}{$vtag} = $$et{VALUE}{$tag}; |
4626
|
8
|
|
|
|
|
27
|
$$self{TAG_INFO}{$vtag} = $$et{TAG_INFO}{$tag}; |
4627
|
8
|
|
50
|
|
|
32
|
$$self{TAG_EXTRA}{$vtag} = $$et{TAG_EXTRA}{$tag} || { }; |
4628
|
8
|
|
50
|
|
|
34
|
$$self{FILE_ORDER}{$vtag} = ($$et{FILE_ORDER}{$tag} || 0) + $altOrder; |
4629
|
|
|
|
|
|
|
} |
4630
|
9
|
|
|
|
|
28
|
$tag = $vtag; |
4631
|
|
|
|
|
|
|
} |
4632
|
|
|
|
|
|
|
} |
4633
|
|
|
|
|
|
|
|
4634
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4635
|
|
|
|
|
|
|
# Set list of found tags from previously requested tags |
4636
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
4637
|
|
|
|
|
|
|
# Returns: 0) Reference to list of found tag keys (in order of requested tags) |
4638
|
|
|
|
|
|
|
# 1) Reference to list of indices for tags requested by value |
4639
|
|
|
|
|
|
|
# 2) Reference to list of indices for tags specified by wildcard or "all" |
4640
|
|
|
|
|
|
|
# Notes: index lists are returned in increasing order |
4641
|
|
|
|
|
|
|
sub SetFoundTags($) |
4642
|
|
|
|
|
|
|
{ |
4643
|
699
|
|
|
699
|
0
|
1470
|
my $self = shift; |
4644
|
699
|
|
|
|
|
1860
|
my $options = $$self{OPTIONS}; |
4645
|
699
|
|
50
|
|
|
2706
|
my $reqTags = $$self{REQUESTED_TAGS} || [ ]; |
4646
|
699
|
|
|
|
|
1718
|
my $duplicates = $$options{Duplicates}; |
4647
|
699
|
|
|
|
|
1640
|
my $exclude = $$options{Exclude}; |
4648
|
699
|
|
|
|
|
1716
|
my $fileOrder = $$self{FILE_ORDER}; |
4649
|
699
|
|
|
|
|
20118
|
my @groupOptions = sort grep /^Group/, keys %$options; |
4650
|
699
|
|
100
|
|
|
5642
|
my $doDups = $duplicates || $exclude || @groupOptions; |
4651
|
699
|
|
|
|
|
1927
|
my ($tag, $rtnTags, @byValue, @wildTags); |
4652
|
|
|
|
|
|
|
|
4653
|
|
|
|
|
|
|
# only return requested tags if specified |
4654
|
699
|
100
|
|
|
|
2500
|
if (@$reqTags) { |
4655
|
362
|
50
|
|
|
|
1361
|
$rtnTags or $rtnTags = [ ]; |
4656
|
|
|
|
|
|
|
# scan through the requested tags and generate a list of tags we found |
4657
|
362
|
|
|
|
|
941
|
my $tagHash = $$self{VALUE}; |
4658
|
362
|
|
|
|
|
771
|
my $reqTag; |
4659
|
362
|
|
|
|
|
1130
|
foreach $reqTag (@$reqTags) { |
4660
|
883
|
|
|
|
|
1811
|
my (@matches, $group, $allGrp, $allTag, $byValue, $g8); |
4661
|
883
|
|
|
|
|
1608
|
my $et = $self; |
4662
|
883
|
100
|
|
|
|
3104
|
if ($reqTag =~ /^(.*):(.+)/) { |
4663
|
241
|
|
|
|
|
1109
|
($group, $tag) = ($1, $2); |
4664
|
241
|
50
|
|
|
|
2131
|
if ($group =~ /^(\*|all)$/i) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4665
|
0
|
|
|
|
|
0
|
$allGrp = 1; |
4666
|
|
|
|
|
|
|
} elsif ($reqTag =~ /\bfile(\d+):/i) { |
4667
|
6
|
|
|
|
|
18
|
$g8 = "File$1"; |
4668
|
6
|
|
33
|
|
|
28
|
$et = $$self{ALT_EXIFTOOL}{$g8} || $self; |
4669
|
6
|
|
|
|
|
17
|
$fileOrder = $$et{FILE_ORDER}; |
4670
|
6
|
|
|
|
|
14
|
$tagHash = $$et{VALUE}; |
4671
|
|
|
|
|
|
|
} elsif ($group !~ /^[-\w:]*$/) { |
4672
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid group name '${group}'"); |
4673
|
0
|
|
|
|
|
0
|
$group = 'invalid'; |
4674
|
|
|
|
|
|
|
} |
4675
|
|
|
|
|
|
|
} else { |
4676
|
642
|
|
|
|
|
1219
|
$tag = $reqTag; |
4677
|
|
|
|
|
|
|
} |
4678
|
883
|
50
|
66
|
|
|
2851
|
$byValue = 1 if $tag =~ s/#$// and $$options{PrintConv}; |
4679
|
883
|
50
|
66
|
|
|
7430
|
if (defined $$tagHash{$reqTag} and not $doDups) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
4680
|
0
|
|
|
|
|
0
|
$matches[0] = $tag; |
4681
|
|
|
|
|
|
|
} elsif ($tag =~ /^(\*|all)$/i) { |
4682
|
|
|
|
|
|
|
# tag name of '*' or 'all' matches all tags |
4683
|
139
|
100
|
66
|
|
|
675
|
if ($doDups or $allGrp) { |
4684
|
138
|
|
|
|
|
4848
|
@matches = grep(!/#/, keys %$tagHash); |
4685
|
|
|
|
|
|
|
} else { |
4686
|
1
|
|
|
|
|
47
|
@matches = grep(!/ /, keys %$tagHash); |
4687
|
|
|
|
|
|
|
} |
4688
|
139
|
50
|
|
|
|
869
|
next unless @matches; # don't want entry in list for '*' tag |
4689
|
139
|
|
|
|
|
366
|
$allTag = 1; |
4690
|
|
|
|
|
|
|
} elsif ($tag =~ /[*?]/) { |
4691
|
|
|
|
|
|
|
# allow wildcards in tag names |
4692
|
5
|
|
|
|
|
30
|
$tag =~ s/\*/[-\\w]*/g; |
4693
|
5
|
|
|
|
|
19
|
$tag =~ s/\?/[-\\w]/g; |
4694
|
5
|
50
|
33
|
|
|
29
|
$tag .= '( \\(.*)?' if $doDups or $allGrp; |
4695
|
5
|
|
|
|
|
1102
|
@matches = grep(/^$tag$/i, keys %$tagHash); |
4696
|
5
|
50
|
|
|
|
64
|
next unless @matches; # don't want entry in list for wildcard tags |
4697
|
5
|
|
|
|
|
22
|
$allTag = 1; |
4698
|
|
|
|
|
|
|
} elsif ($doDups or defined $group) { |
4699
|
|
|
|
|
|
|
# must also look for tags like "Tag (1)" |
4700
|
|
|
|
|
|
|
# (but be sure not to match temporary ValueConv entries like "Tag #") |
4701
|
739
|
|
|
|
|
53242
|
@matches = grep(/^$tag( \(|$)/i, keys %$tagHash); |
4702
|
|
|
|
|
|
|
} elsif ($tag =~ /^[-\w]+$/) { |
4703
|
|
|
|
|
|
|
# find first matching value |
4704
|
|
|
|
|
|
|
# (use in list context to return value instead of count) |
4705
|
0
|
|
|
|
|
0
|
($matches[0]) = grep /^$tag$/i, keys %$tagHash; |
4706
|
0
|
0
|
|
|
|
0
|
defined $matches[0] or undef @matches; |
4707
|
|
|
|
|
|
|
} else { |
4708
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid tag name '${tag}'"); |
4709
|
|
|
|
|
|
|
} |
4710
|
883
|
100
|
66
|
|
|
5833
|
if (defined $group and not $allGrp) { |
4711
|
|
|
|
|
|
|
# keep only specified group |
4712
|
241
|
|
|
|
|
938
|
@matches = $et->GroupMatches($group, \@matches); |
4713
|
241
|
100
|
100
|
|
|
1226
|
next unless @matches or not $allTag; |
4714
|
|
|
|
|
|
|
} |
4715
|
868
|
100
|
|
|
|
3288
|
if (@matches > 1) { |
|
|
100
|
|
|
|
|
|
4716
|
|
|
|
|
|
|
# maintain original file order for multiple tags |
4717
|
146
|
|
|
|
|
979
|
@matches = sort { $$fileOrder{$a} <=> $$fileOrder{$b} } @matches; |
|
7915
|
|
|
|
|
11214
|
|
4718
|
|
|
|
|
|
|
# return only the highest priority tag unless duplicates wanted |
4719
|
146
|
50
|
66
|
|
|
859
|
unless ($doDups or $allTag or $allGrp) { |
|
|
|
33
|
|
|
|
|
4720
|
0
|
|
|
|
|
0
|
$tag = shift @matches; |
4721
|
0
|
|
0
|
|
|
0
|
my $oldPriority = $$et{PRIORITY}{$tag} || 1; |
4722
|
0
|
|
|
|
|
0
|
foreach (@matches) { |
4723
|
0
|
|
|
|
|
0
|
my $priority = $$et{PRIORITY}{$_}; |
4724
|
0
|
0
|
|
|
|
0
|
$priority = 1 unless defined $priority; |
4725
|
0
|
0
|
|
|
|
0
|
next unless $priority >= $oldPriority; |
4726
|
0
|
|
|
|
|
0
|
$tag = $_; |
4727
|
0
|
|
0
|
|
|
0
|
$oldPriority = $priority || 1; |
4728
|
|
|
|
|
|
|
} |
4729
|
0
|
|
|
|
|
0
|
@matches = ( $tag ); |
4730
|
|
|
|
|
|
|
} |
4731
|
|
|
|
|
|
|
} elsif (not @matches) { |
4732
|
|
|
|
|
|
|
# put entry in return list even without value (value is undef) |
4733
|
445
|
100
|
|
|
|
2020
|
$matches[0] = $byValue ? "$tag #(0)" : "$tag (0)"; |
4734
|
|
|
|
|
|
|
# bogus file order entry to avoid warning if sorting in file order |
4735
|
445
|
|
|
|
|
1662
|
$$self{FILE_ORDER}{$matches[0]} = 9999; |
4736
|
|
|
|
|
|
|
} |
4737
|
|
|
|
|
|
|
# copy over necessary information for tags from alternate files |
4738
|
868
|
100
|
|
|
|
2300
|
if ($g8) { |
4739
|
6
|
|
|
|
|
34
|
$self->CopyAltInfo($g8, \@matches); |
4740
|
|
|
|
|
|
|
# restore variables to original values for main file |
4741
|
6
|
|
|
|
|
14
|
$fileOrder = $$self{FILE_ORDER}; |
4742
|
6
|
|
|
|
|
11
|
$tagHash = $$self{VALUE}; |
4743
|
|
|
|
|
|
|
} |
4744
|
|
|
|
|
|
|
# save indices of tags extracted by value |
4745
|
868
|
100
|
|
|
|
1994
|
push @byValue, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $byValue; |
4746
|
|
|
|
|
|
|
# save indices of wildcard tags |
4747
|
868
|
100
|
|
|
|
2662
|
push @wildTags, scalar(@$rtnTags) .. (scalar(@$rtnTags)+scalar(@matches)-1) if $allTag; |
4748
|
868
|
|
|
|
|
3319
|
push @$rtnTags, @matches; |
4749
|
|
|
|
|
|
|
} |
4750
|
|
|
|
|
|
|
} else { |
4751
|
|
|
|
|
|
|
# no requested tags, so we want all tags |
4752
|
337
|
|
|
|
|
767
|
my @allTags; |
4753
|
337
|
50
|
|
|
|
1045
|
if ($doDups) { |
4754
|
337
|
|
|
|
|
720
|
@allTags = keys %{$$self{VALUE}}; |
|
337
|
|
|
|
|
8431
|
|
4755
|
|
|
|
|
|
|
} else { |
4756
|
|
|
|
|
|
|
# only include tag if it doesn't end in a copy number |
4757
|
0
|
|
|
|
|
0
|
@allTags = grep(!/ /, keys %{$$self{VALUE}}); |
|
0
|
|
|
|
|
0
|
|
4758
|
|
|
|
|
|
|
} |
4759
|
337
|
|
|
|
|
1352
|
$rtnTags = \@allTags; |
4760
|
|
|
|
|
|
|
} |
4761
|
|
|
|
|
|
|
|
4762
|
|
|
|
|
|
|
# filter excluded tags and group options |
4763
|
699
|
|
100
|
|
|
5718
|
while (($exclude or @groupOptions) and @$rtnTags) { |
|
|
|
66
|
|
|
|
|
4764
|
68
|
100
|
|
|
|
257
|
if ($exclude) { |
4765
|
41
|
|
|
|
|
99
|
my ($pat, %exclude); |
4766
|
41
|
|
|
|
|
146
|
foreach $pat (@$exclude) { |
4767
|
57
|
|
|
|
|
117
|
my $group; |
4768
|
57
|
100
|
|
|
|
323
|
if ($pat =~ /^(.*):(.+)/) { |
4769
|
30
|
|
|
|
|
149
|
($group, $tag) = ($1, $2); |
4770
|
30
|
50
|
|
|
|
327
|
if ($group =~ /^(\*|all)$/i) { |
|
|
50
|
|
|
|
|
|
4771
|
0
|
|
|
|
|
0
|
undef $group; |
4772
|
|
|
|
|
|
|
} elsif ($group !~ /^[-\w:]*$/) { |
4773
|
0
|
|
|
|
|
0
|
$self->Warn("Invalid group name '${group}'"); |
4774
|
0
|
|
|
|
|
0
|
$group = 'invalid'; |
4775
|
|
|
|
|
|
|
} |
4776
|
|
|
|
|
|
|
} else { |
4777
|
27
|
|
|
|
|
52
|
$tag = $pat; |
4778
|
|
|
|
|
|
|
} |
4779
|
57
|
|
|
|
|
125
|
my @matches; |
4780
|
57
|
100
|
|
|
|
291
|
if ($tag =~ /^(\*|all)$/i) { |
4781
|
30
|
|
|
|
|
219
|
@matches = @$rtnTags; |
4782
|
|
|
|
|
|
|
} else { |
4783
|
|
|
|
|
|
|
# allow wildcards in tag names |
4784
|
27
|
|
|
|
|
79
|
$tag =~ s/\*/[-\\w]*/g; |
4785
|
27
|
|
|
|
|
58
|
$tag =~ s/\?/[-\\w]/g; |
4786
|
27
|
|
|
|
|
2629
|
@matches = grep(/^$tag( |$)/i, @$rtnTags); |
4787
|
|
|
|
|
|
|
} |
4788
|
57
|
100
|
66
|
|
|
400
|
@matches = $self->GroupMatches($group, \@matches) if $group and @matches; |
4789
|
57
|
|
|
|
|
496
|
$exclude{$_} = 1 foreach @matches; |
4790
|
|
|
|
|
|
|
} |
4791
|
41
|
50
|
|
|
|
160
|
if (%exclude) { |
4792
|
|
|
|
|
|
|
# remove excluded tags from return list(s) |
4793
|
41
|
|
|
|
|
267
|
RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%exclude); |
4794
|
41
|
50
|
|
|
|
185
|
last unless @$rtnTags; # all done if nothing left |
4795
|
|
|
|
|
|
|
} |
4796
|
41
|
100
|
66
|
|
|
345
|
last if $duplicates and not @groupOptions; |
4797
|
|
|
|
|
|
|
} |
4798
|
|
|
|
|
|
|
# filter groups if requested, or to remove duplicates |
4799
|
28
|
|
|
|
|
63
|
my (%keepTags, %wantGroup, $family, $groupOpt); |
4800
|
28
|
|
|
|
|
88
|
my $allGroups = 1; |
4801
|
|
|
|
|
|
|
# build hash of requested/excluded group names for each group family |
4802
|
28
|
|
|
|
|
56
|
my $wantOrder = 0; |
4803
|
28
|
|
|
|
|
73
|
foreach $groupOpt (@groupOptions) { |
4804
|
29
|
50
|
|
|
|
167
|
$groupOpt =~ /^Group(\d*(:\d+)*)/ or next; |
4805
|
29
|
|
100
|
|
|
128
|
$family = $1 || 0; |
4806
|
29
|
50
|
|
|
|
131
|
$wantGroup{$family} or $wantGroup{$family} = { }; |
4807
|
29
|
|
|
|
|
58
|
my $groupList; |
4808
|
29
|
100
|
|
|
|
101
|
if (ref $$options{$groupOpt} eq 'ARRAY') { |
4809
|
4
|
|
|
|
|
12
|
$groupList = $$options{$groupOpt}; |
4810
|
|
|
|
|
|
|
} else { |
4811
|
25
|
|
|
|
|
70
|
$groupList = [ $$options{$groupOpt} ]; |
4812
|
|
|
|
|
|
|
} |
4813
|
29
|
|
|
|
|
76
|
foreach (@$groupList) { |
4814
|
|
|
|
|
|
|
# groups have priority in order they were specified |
4815
|
33
|
|
|
|
|
54
|
++$wantOrder; |
4816
|
33
|
|
|
|
|
53
|
my ($groupName, $want); |
4817
|
33
|
100
|
|
|
|
95
|
if (/^-(.*)/) { |
4818
|
|
|
|
|
|
|
# excluded group begins with '-' |
4819
|
2
|
|
|
|
|
6
|
$groupName = $1; |
4820
|
2
|
|
|
|
|
5
|
$want = 0; # we don't want tags in this group |
4821
|
|
|
|
|
|
|
} else { |
4822
|
31
|
|
|
|
|
50
|
$groupName = $_; |
4823
|
31
|
|
|
|
|
48
|
$want = $wantOrder; # we want tags in this group |
4824
|
31
|
|
|
|
|
47
|
$allGroups = 0; # don't want all groups if we requested one |
4825
|
|
|
|
|
|
|
} |
4826
|
33
|
|
|
|
|
139
|
$wantGroup{$family}{$groupName} = $want; |
4827
|
|
|
|
|
|
|
} |
4828
|
|
|
|
|
|
|
} |
4829
|
|
|
|
|
|
|
# loop through all tags and decide which ones we want |
4830
|
28
|
|
|
|
|
72
|
my (@tags, %bestTag); |
4831
|
28
|
|
|
|
|
75
|
GR_TAG: foreach $tag (@$rtnTags) { |
4832
|
4505
|
|
|
|
|
5759
|
my $wantTag = $allGroups; # want tag by default if want all groups |
4833
|
4505
|
|
|
|
|
7757
|
foreach $family (keys %wantGroup) { |
4834
|
4676
|
|
|
|
|
8128
|
my $group = $self->GetGroup($tag, $family); |
4835
|
4676
|
|
|
|
|
8121
|
my $wanted = $wantGroup{$family}{$group}; |
4836
|
4676
|
100
|
|
|
|
9352
|
next unless defined $wanted; |
4837
|
1212
|
100
|
|
|
|
2050
|
next GR_TAG unless $wanted; # skip tag if group excluded |
4838
|
|
|
|
|
|
|
# take lowest non-zero want flag |
4839
|
1035
|
50
|
33
|
|
|
2193
|
next if $wantTag and $wantTag < $wanted; |
4840
|
1035
|
|
|
|
|
1623
|
$wantTag = $wanted; |
4841
|
|
|
|
|
|
|
} |
4842
|
4328
|
100
|
|
|
|
8276
|
next unless $wantTag; |
4843
|
1047
|
100
|
|
|
|
2179
|
$duplicates and $keepTags{$tag} = 1, next; |
4844
|
|
|
|
|
|
|
# determine which tag we want to keep |
4845
|
665
|
|
|
|
|
968
|
my $tagName = GetTagName($tag); |
4846
|
665
|
|
|
|
|
1133
|
my $bestTag = $bestTag{$tagName}; |
4847
|
665
|
100
|
|
|
|
1143
|
if (defined $bestTag) { |
4848
|
28
|
100
|
|
|
|
105
|
next if $wantTag > $keepTags{$bestTag}; |
4849
|
14
|
50
|
|
|
|
34
|
if ($wantTag == $keepTags{$bestTag}) { |
4850
|
|
|
|
|
|
|
# want two tags with the same name -- keep the latest one |
4851
|
0
|
0
|
|
|
|
0
|
if ($tag =~ / \((\d+)\)$/) { |
4852
|
0
|
|
|
|
|
0
|
my $tagNum = $1; |
4853
|
0
|
0
|
0
|
|
|
0
|
next if $bestTag !~ / \((\d+)\)$/ or $1 > $tagNum; |
4854
|
|
|
|
|
|
|
} |
4855
|
|
|
|
|
|
|
} |
4856
|
|
|
|
|
|
|
# this tag is better, so delete old best tag |
4857
|
14
|
|
|
|
|
26
|
delete $keepTags{$bestTag}; |
4858
|
|
|
|
|
|
|
} |
4859
|
651
|
|
|
|
|
1132
|
$keepTags{$tag} = $wantTag; # keep this tag (for now...) |
4860
|
651
|
|
|
|
|
1347
|
$bestTag{$tagName} = $tag; # this is our current best tag |
4861
|
|
|
|
|
|
|
} |
4862
|
|
|
|
|
|
|
# include only tags we want to keep in return lists |
4863
|
28
|
|
|
|
|
208
|
RemoveTagsFromList($rtnTags, \@byValue, \@wildTags, \%keepTags, 1); |
4864
|
28
|
|
|
|
|
214
|
last; |
4865
|
|
|
|
|
|
|
} |
4866
|
699
|
|
|
|
|
2615
|
$$self{FOUND_TAGS} = $rtnTags; # save found tags |
4867
|
|
|
|
|
|
|
|
4868
|
|
|
|
|
|
|
# return reference to found tag keys (and list of indices of tags to extract by value) |
4869
|
699
|
50
|
|
|
|
4751
|
return wantarray ? ($rtnTags, \@byValue, \@wildTags) : $rtnTags; |
4870
|
|
|
|
|
|
|
} |
4871
|
|
|
|
|
|
|
|
4872
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4873
|
|
|
|
|
|
|
# Utility to load our write routines if required (called via AUTOLOAD) |
4874
|
|
|
|
|
|
|
# Inputs: 0) autoload function, 1-N) function arguments |
4875
|
|
|
|
|
|
|
# Returns: result of function or dies if function not available |
4876
|
|
|
|
|
|
|
sub DoAutoLoad(@) |
4877
|
|
|
|
|
|
|
{ |
4878
|
737
|
|
|
737
|
0
|
2161
|
my $autoload = shift; |
4879
|
737
|
|
|
|
|
4308
|
my @callInfo = split(/::/, $autoload); |
4880
|
737
|
|
|
|
|
2125
|
my $file = 'Image/ExifTool/Write'; |
4881
|
|
|
|
|
|
|
|
4882
|
737
|
100
|
|
|
|
136225
|
return if $callInfo[$#callInfo] eq 'DESTROY'; |
4883
|
247
|
100
|
|
|
|
1187
|
if (@callInfo == 4) { |
|
|
100
|
|
|
|
|
|
4884
|
|
|
|
|
|
|
# load Image/ExifTool/WriteMODULE.pl |
4885
|
187
|
|
|
|
|
654
|
$file .= "$callInfo[2].pl"; |
4886
|
|
|
|
|
|
|
} elsif ($callInfo[-1] eq 'ShiftTime') { |
4887
|
1
|
|
|
|
|
4
|
$file = 'Image/ExifTool/Shift.pl'; # load Shift.pl |
4888
|
|
|
|
|
|
|
} else { |
4889
|
|
|
|
|
|
|
# load Image/ExifTool/Writer.pl |
4890
|
59
|
|
|
|
|
218
|
$file .= 'r.pl'; |
4891
|
|
|
|
|
|
|
} |
4892
|
|
|
|
|
|
|
# attempt to load the package |
4893
|
247
|
50
|
|
|
|
632
|
eval { require $file } or die "Error while attempting to call $autoload\n$@\n"; |
|
247
|
|
|
|
|
254162
|
|
4894
|
247
|
50
|
|
|
|
2270
|
unless (defined &$autoload) { |
4895
|
0
|
|
|
|
|
0
|
my @caller = caller(0); |
4896
|
|
|
|
|
|
|
# reproduce Perl's standard 'undefined subroutine' message: |
4897
|
0
|
|
|
|
|
0
|
die "Undefined subroutine $autoload called at $caller[1] line $caller[2]\n"; |
4898
|
|
|
|
|
|
|
} |
4899
|
106
|
|
|
106
|
|
1230
|
no strict 'refs'; |
|
106
|
|
|
|
|
295
|
|
|
106
|
|
|
|
|
135700
|
|
4900
|
247
|
|
|
|
|
1861
|
return &$autoload(@_); # call the function |
4901
|
|
|
|
|
|
|
} |
4902
|
|
|
|
|
|
|
|
4903
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4904
|
|
|
|
|
|
|
# AutoLoad our writer routines when necessary |
4905
|
|
|
|
|
|
|
# |
4906
|
|
|
|
|
|
|
sub AUTOLOAD |
4907
|
|
|
|
|
|
|
{ |
4908
|
550
|
|
|
550
|
|
362069
|
return DoAutoLoad($AUTOLOAD, @_); |
4909
|
|
|
|
|
|
|
} |
4910
|
|
|
|
|
|
|
|
4911
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4912
|
|
|
|
|
|
|
# Add warning tag |
4913
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) warning message |
4914
|
|
|
|
|
|
|
# 2) true if minor (2 if behaviour changes when warning is ignored, |
4915
|
|
|
|
|
|
|
# or 3 if warning shouldn't be issued when Validate option is used) |
4916
|
|
|
|
|
|
|
# Returns: true if warning tag was added |
4917
|
|
|
|
|
|
|
sub Warn($$;$) |
4918
|
|
|
|
|
|
|
{ |
4919
|
87
|
|
|
87
|
0
|
300
|
my ($self, $str, $ignorable) = @_; |
4920
|
87
|
100
|
|
|
|
344
|
if ($ignorable) { |
4921
|
32
|
100
|
|
|
|
138
|
return 0 if $$self{OPTIONS}{IgnoreMinorErrors}; |
4922
|
31
|
50
|
66
|
|
|
136
|
return 0 if $ignorable eq '3' and $$self{OPTIONS}{Validate}; |
4923
|
31
|
100
|
|
|
|
143
|
$str = $ignorable eq '2' ? "[Minor] $str" : "[minor] $str"; |
4924
|
|
|
|
|
|
|
} |
4925
|
86
|
|
|
|
|
391
|
$self->FoundTag('Warning', $str); |
4926
|
86
|
|
|
|
|
336
|
return 1; |
4927
|
|
|
|
|
|
|
} |
4928
|
|
|
|
|
|
|
|
4929
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4930
|
|
|
|
|
|
|
# Add warning tag only once per processed file |
4931
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) warning message, 2) true if minor |
4932
|
|
|
|
|
|
|
# Returns: true if warning tag was added |
4933
|
|
|
|
|
|
|
sub WarnOnce($$;$) |
4934
|
|
|
|
|
|
|
{ |
4935
|
48
|
|
|
48
|
0
|
173
|
my ($self, $str, $ignorable) = @_; |
4936
|
48
|
50
|
66
|
|
|
217
|
return 0 if $ignorable and $$self{OPTIONS}{IgnoreMinorErrors}; |
4937
|
48
|
100
|
|
|
|
222
|
unless ($$self{WARNED_ONCE}{$str}) { |
4938
|
41
|
|
|
|
|
215
|
$self->Warn($str, $ignorable); |
4939
|
41
|
|
|
|
|
236
|
$$self{WARNED_ONCE}{$str} = 1; |
4940
|
|
|
|
|
|
|
} |
4941
|
48
|
|
|
|
|
153
|
return 1; |
4942
|
|
|
|
|
|
|
} |
4943
|
|
|
|
|
|
|
|
4944
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4945
|
|
|
|
|
|
|
# Add error tag |
4946
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) error message, 2) true if minor |
4947
|
|
|
|
|
|
|
# Returns: true if error tag was added, otherwise warning was added |
4948
|
|
|
|
|
|
|
sub Error($$;$) |
4949
|
|
|
|
|
|
|
{ |
4950
|
1
|
|
|
1
|
0
|
5
|
my ($self, $str, $ignorable) = @_; |
4951
|
1
|
50
|
|
|
|
19
|
if ($$self{DemoteErrors}) { |
|
|
50
|
|
|
|
|
|
4952
|
0
|
0
|
|
|
|
0
|
$self->Warn($str) and ++$$self{DemoteErrors}; |
4953
|
0
|
|
|
|
|
0
|
return 1; |
4954
|
|
|
|
|
|
|
} elsif ($ignorable) { |
4955
|
1
|
50
|
|
|
|
11
|
$$self{OPTIONS}{IgnoreMinorErrors} and $self->Warn($str), return 0; |
4956
|
0
|
|
|
|
|
0
|
$str = "[minor] $str"; |
4957
|
|
|
|
|
|
|
} |
4958
|
0
|
|
|
|
|
0
|
$self->FoundTag('Error', $str); |
4959
|
0
|
|
|
|
|
0
|
return 1; |
4960
|
|
|
|
|
|
|
} |
4961
|
|
|
|
|
|
|
|
4962
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
4963
|
|
|
|
|
|
|
# Expand shortcuts |
4964
|
|
|
|
|
|
|
# Inputs: 0) reference to list of tags, 1) set to remove trailing '#' |
4965
|
|
|
|
|
|
|
# Notes: Handles leading '-' for excluded tags, trailing '#' for ValueConv, |
4966
|
|
|
|
|
|
|
# multiple group names, and redirected tags |
4967
|
|
|
|
|
|
|
sub ExpandShortcuts($;$) |
4968
|
|
|
|
|
|
|
{ |
4969
|
516
|
|
|
516
|
0
|
1485
|
my ($tagList, $removeSuffix) = @_; |
4970
|
516
|
50
|
33
|
|
|
2760
|
return unless $tagList and @$tagList; |
4971
|
|
|
|
|
|
|
|
4972
|
516
|
|
|
|
|
29445
|
require Image::ExifTool::Shortcuts; |
4973
|
|
|
|
|
|
|
|
4974
|
|
|
|
|
|
|
# expand shortcuts |
4975
|
516
|
100
|
|
|
|
2032
|
my $suffix = $removeSuffix ? '' : '#'; |
4976
|
516
|
|
|
|
|
965
|
my @expandedTags; |
4977
|
516
|
|
|
|
|
1332
|
my ($entry, $tag, $excl); |
4978
|
516
|
|
|
|
|
1465
|
foreach $entry (@$tagList) { |
4979
|
|
|
|
|
|
|
# skip things like options hash references in list |
4980
|
1057
|
100
|
|
|
|
2637
|
if (ref $entry) { |
4981
|
1
|
|
|
|
|
8
|
push @expandedTags, $entry; |
4982
|
1
|
|
|
|
|
4
|
next; |
4983
|
|
|
|
|
|
|
} |
4984
|
|
|
|
|
|
|
# remove leading '-' |
4985
|
1056
|
|
|
|
|
5666
|
($excl, $tag) = $entry =~ /^(-?)(.*)/s; |
4986
|
1056
|
|
|
|
|
2286
|
my ($post, @post, $pre, $v); |
4987
|
|
|
|
|
|
|
# handle redirection |
4988
|
1056
|
100
|
100
|
|
|
11260
|
if (not $excl and $tag =~ /(.+?)([-+]?[<>].+)/s) { |
4989
|
30
|
|
|
|
|
136
|
($tag, $post) = ($1, $2); |
4990
|
30
|
100
|
100
|
|
|
245
|
if ($post =~ /^[-+]?>/ or $post !~ /\$/) { |
4991
|
|
|
|
|
|
|
# expand shortcuts in postfix (rhs of redirection) |
4992
|
23
|
|
|
|
|
157
|
my ($op, $p2, $t2) = ($post =~ /([-+]?[<>])(.+:)?(.+)/); |
4993
|
23
|
100
|
|
|
|
85
|
$p2 = '' unless defined $p2; |
4994
|
23
|
50
|
|
|
|
102
|
$v = ($t2 =~ s/#$//) ? $suffix : ''; # ValueConv suffix |
4995
|
23
|
|
|
|
|
462
|
my ($match) = grep /^\Q$t2\E$/i, keys %Image::ExifTool::Shortcuts::Main; |
4996
|
23
|
50
|
|
|
|
117
|
if ($match) { |
4997
|
0
|
|
|
|
|
0
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
0
|
|
|
|
|
0
|
|
4998
|
0
|
0
|
|
|
|
0
|
/^-/ and next; # ignore excluded tags |
4999
|
0
|
0
|
0
|
|
|
0
|
if ($p2 and /(.+:)(.+)/) { |
5000
|
0
|
|
|
|
|
0
|
push @post, "$op$_$v"; |
5001
|
|
|
|
|
|
|
} else { |
5002
|
0
|
|
|
|
|
0
|
push @post, "$op$p2$_$v"; |
5003
|
|
|
|
|
|
|
} |
5004
|
|
|
|
|
|
|
} |
5005
|
0
|
0
|
|
|
|
0
|
next unless @post; |
5006
|
0
|
|
|
|
|
0
|
$post = shift @post; |
5007
|
|
|
|
|
|
|
} |
5008
|
|
|
|
|
|
|
} |
5009
|
|
|
|
|
|
|
} else { |
5010
|
1026
|
|
|
|
|
2255
|
$post = ''; |
5011
|
|
|
|
|
|
|
} |
5012
|
|
|
|
|
|
|
# handle group names |
5013
|
1056
|
100
|
|
|
|
3567
|
if ($tag =~ /(.+:)(.+)/) { |
5014
|
309
|
|
|
|
|
1296
|
($pre, $tag) = ($1, $2); |
5015
|
|
|
|
|
|
|
} else { |
5016
|
747
|
|
|
|
|
1304
|
$pre = ''; |
5017
|
|
|
|
|
|
|
} |
5018
|
1056
|
100
|
|
|
|
2946
|
$v = ($tag =~ s/#$//) ? $suffix : ''; # ValueConv suffix |
5019
|
|
|
|
|
|
|
# loop over all postfixes |
5020
|
1056
|
|
|
|
|
1762
|
for (;;) { |
5021
|
|
|
|
|
|
|
# expand the tag name |
5022
|
1056
|
|
|
|
|
21778
|
my ($match) = grep /^\Q$tag\E$/i, keys %Image::ExifTool::Shortcuts::Main; |
5023
|
1056
|
100
|
|
|
|
3713
|
if ($match) { |
5024
|
17
|
50
|
66
|
|
|
321
|
if ($excl) { |
|
|
100
|
66
|
|
|
|
|
5025
|
|
|
|
|
|
|
# entry starts with '-', so exclude all tags in this shortcut |
5026
|
0
|
|
|
|
|
0
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
0
|
|
|
|
|
0
|
|
5027
|
0
|
0
|
|
|
|
0
|
/^-/ and next; # ignore excluded exclude tags |
5028
|
|
|
|
|
|
|
# group of expanded tag takes precedence |
5029
|
0
|
0
|
0
|
|
|
0
|
if ($pre and /(.+:)(.+)/) { |
5030
|
0
|
|
|
|
|
0
|
push @expandedTags, "$excl$_"; |
5031
|
|
|
|
|
|
|
} else { |
5032
|
0
|
|
|
|
|
0
|
push @expandedTags, "$excl$pre$_"; |
5033
|
|
|
|
|
|
|
} |
5034
|
|
|
|
|
|
|
} |
5035
|
|
|
|
|
|
|
} elsif (length $pre or length $post or $v) { |
5036
|
1
|
|
|
|
|
3
|
foreach (@{$Image::ExifTool::Shortcuts::Main{$match}}) { |
|
1
|
|
|
|
|
5
|
|
5037
|
12
|
|
|
|
|
41
|
/(-?)(.+:)?(.+)/; |
5038
|
12
|
50
|
|
|
|
24
|
if ($2) { |
5039
|
|
|
|
|
|
|
# group from expanded tag takes precedence |
5040
|
0
|
|
|
|
|
0
|
push @expandedTags, "$_$v$post"; |
5041
|
|
|
|
|
|
|
} else { |
5042
|
12
|
|
|
|
|
36
|
push @expandedTags, "$1$pre$3$v$post"; |
5043
|
|
|
|
|
|
|
} |
5044
|
|
|
|
|
|
|
} |
5045
|
|
|
|
|
|
|
} else { |
5046
|
16
|
|
|
|
|
62
|
push @expandedTags, @{$Image::ExifTool::Shortcuts::Main{$match}}; |
|
16
|
|
|
|
|
80
|
|
5047
|
|
|
|
|
|
|
} |
5048
|
|
|
|
|
|
|
} else { |
5049
|
1039
|
|
|
|
|
3548
|
push @expandedTags, "$excl$pre$tag$v$post"; |
5050
|
|
|
|
|
|
|
} |
5051
|
1056
|
50
|
|
|
|
3887
|
last unless @post; |
5052
|
0
|
|
|
|
|
0
|
$post = shift @post; |
5053
|
|
|
|
|
|
|
} |
5054
|
|
|
|
|
|
|
} |
5055
|
516
|
|
|
|
|
2531
|
@$tagList = @expandedTags; |
5056
|
|
|
|
|
|
|
} |
5057
|
|
|
|
|
|
|
|
5058
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5059
|
|
|
|
|
|
|
# Add hash of Composite tags to our composites |
5060
|
|
|
|
|
|
|
# Inputs: 0) hash reference to table of Composite tags to add or module name, |
5061
|
|
|
|
|
|
|
# 1) override existing tag definition |
5062
|
|
|
|
|
|
|
sub AddCompositeTags($;$) |
5063
|
|
|
|
|
|
|
{ |
5064
|
592
|
|
|
592
|
0
|
2006
|
local $_; |
5065
|
592
|
|
|
|
|
2365
|
my ($add, $override) = @_; |
5066
|
592
|
|
|
|
|
1605
|
my ($module, $prefix, $tagID); |
5067
|
592
|
50
|
|
|
|
2586
|
unless (ref $add) { |
5068
|
592
|
|
|
|
|
6705
|
($prefix = $add) =~ s/.*:://; |
5069
|
592
|
|
|
|
|
1676
|
$module = $add; |
5070
|
592
|
|
|
|
|
2082
|
$add .= '::Composite'; |
5071
|
106
|
|
|
106
|
|
928
|
no strict 'refs'; |
|
106
|
|
|
|
|
257
|
|
|
106
|
|
|
|
|
969327
|
|
5072
|
592
|
|
|
|
|
3225
|
$add = \%$add; |
5073
|
592
|
|
|
|
|
1839
|
$prefix .= '-'; |
5074
|
|
|
|
|
|
|
} else { |
5075
|
0
|
|
|
|
|
0
|
$prefix = 'UserDefined-'; |
5076
|
|
|
|
|
|
|
} |
5077
|
592
|
|
|
|
|
1888
|
my $defaultGroups = $$add{GROUPS}; |
5078
|
592
|
|
|
|
|
2761
|
my $compTable = GetTagTable('Image::ExifTool::Composite'); |
5079
|
|
|
|
|
|
|
|
5080
|
|
|
|
|
|
|
# make sure default groups are defined in families 0 and 1 |
5081
|
592
|
100
|
|
|
|
1955
|
if ($defaultGroups) { |
5082
|
495
|
100
|
|
|
|
2554
|
$$defaultGroups{0} or $$defaultGroups{0} = 'Composite'; |
5083
|
495
|
100
|
|
|
|
2068
|
$$defaultGroups{1} or $$defaultGroups{1} = 'Composite'; |
5084
|
495
|
50
|
|
|
|
1845
|
$$defaultGroups{2} or $$defaultGroups{2} = 'Other'; |
5085
|
|
|
|
|
|
|
} else { |
5086
|
97
|
|
|
|
|
778
|
$defaultGroups = $$add{GROUPS} = { 0 => 'Composite', 1 => 'Composite', 2 => 'Other' }; |
5087
|
|
|
|
|
|
|
} |
5088
|
592
|
|
|
|
|
2402
|
SetupTagTable($add); # generate Name, TagID, etc |
5089
|
592
|
|
|
|
|
6336
|
foreach $tagID (sort keys %$add) { |
5090
|
5730
|
100
|
|
|
|
12367
|
next if $specialTags{$tagID}; # must skip special tags |
5091
|
5135
|
|
|
|
|
8159
|
my $tagInfo = $$add{$tagID}; |
5092
|
5135
|
|
|
|
|
11764
|
my $new = $prefix . $tagID; # new tag ID for Composite table |
5093
|
5135
|
100
|
|
|
|
10673
|
$$tagInfo{Module} = $module if $$tagInfo{Writable}; |
5094
|
5135
|
50
|
33
|
|
|
10248
|
$$tagInfo{Override} = 1 if $override and not defined $$tagInfo{Override}; |
5095
|
5135
|
|
|
|
|
9430
|
$$tagInfo{IsComposite} = 1; |
5096
|
|
|
|
|
|
|
# handle Composite tags with the same name |
5097
|
5135
|
100
|
|
|
|
11149
|
if ($compositeID{$tagID}) { |
5098
|
|
|
|
|
|
|
# determine if we want to override this tag |
5099
|
|
|
|
|
|
|
# (=0 keep both, >0 override, <0 keep existing) |
5100
|
344
|
|
50
|
|
|
5018
|
my $over = ($$tagInfo{Override} || 0) - ($$compTable{$compositeID{$tagID}[0]}{Override} || 0); |
|
|
|
50
|
|
|
|
|
5101
|
344
|
50
|
|
|
|
1061
|
next if $over < 0; |
5102
|
344
|
50
|
|
|
|
1181
|
if ($over) { |
5103
|
|
|
|
|
|
|
# remove existing tags with this ID |
5104
|
0
|
|
|
|
|
0
|
delete $$compTable{$_} foreach @{$compositeID{$tagID}}; |
|
0
|
|
|
|
|
0
|
|
5105
|
0
|
|
|
|
|
0
|
delete $compositeID{$tagID}; |
5106
|
|
|
|
|
|
|
} |
5107
|
|
|
|
|
|
|
} |
5108
|
|
|
|
|
|
|
# make sure new TagID is unique by adding index if necessary |
5109
|
|
|
|
|
|
|
# (could only happen for UserDefined tags now that module name is added to tag ID) |
5110
|
5135
|
|
|
|
|
7034
|
my $n = 0; |
5111
|
5135
|
|
|
|
|
11335
|
while ($$compTable{$new}) { |
5112
|
0
|
0
|
|
|
|
0
|
$new =~ s/-\d+$// if $n++; |
5113
|
0
|
|
|
|
|
0
|
$new .= "-$n"; |
5114
|
|
|
|
|
|
|
} |
5115
|
|
|
|
|
|
|
# use new ID and save it so we can use it in TagLookup |
5116
|
5135
|
50
|
|
|
|
13486
|
$$tagInfo{NewTagID} = $new unless $tagID eq $new; |
5117
|
|
|
|
|
|
|
|
5118
|
|
|
|
|
|
|
# add new ID to lookup of Composite tag ID's |
5119
|
5135
|
100
|
|
|
|
14182
|
$compositeID{$tagID} = [ ] unless $compositeID{$tagID}; |
5120
|
5135
|
|
|
|
|
7444
|
unshift @{$compositeID{$tagID}}, $new; # (most recent one first) |
|
5135
|
|
|
|
|
13056
|
|
5121
|
|
|
|
|
|
|
|
5122
|
|
|
|
|
|
|
# convert scalar Require/Desire/Inhibit entries |
5123
|
5135
|
|
|
|
|
8408
|
my ($type, @hashes, @scalars, %used); |
5124
|
5135
|
|
|
|
|
8089
|
foreach $type ('Require','Desire','Inhibit') { |
5125
|
15405
|
100
|
|
|
|
32233
|
my $req = $$tagInfo{$type} or next; |
5126
|
6729
|
100
|
|
|
|
9358
|
push @{ref($req) eq 'HASH' ? \@hashes : \@scalars}, $type; |
|
6729
|
|
|
|
|
18154
|
|
5127
|
|
|
|
|
|
|
} |
5128
|
5135
|
100
|
|
|
|
10363
|
if (@scalars) { |
5129
|
|
|
|
|
|
|
# make lookup for indices that are used |
5130
|
952
|
|
|
|
|
2172
|
foreach $type (@hashes) { |
5131
|
106
|
|
|
|
|
448
|
$used{$_} = 1 foreach keys %{$$tagInfo{$type}}; |
|
106
|
|
|
|
|
1566
|
|
5132
|
|
|
|
|
|
|
} |
5133
|
952
|
|
|
|
|
1678
|
my $next = 0; |
5134
|
952
|
|
|
|
|
1720
|
foreach $type (@scalars) { |
5135
|
952
|
|
|
|
|
2429
|
++$next while $used{$next}; |
5136
|
952
|
|
|
|
|
3691
|
$$tagInfo{$type} = { $next++ => $$tagInfo{$type} }; |
5137
|
|
|
|
|
|
|
} |
5138
|
|
|
|
|
|
|
} |
5139
|
|
|
|
|
|
|
# add this Composite tag to our main Composite table |
5140
|
5135
|
|
|
|
|
8335
|
$$tagInfo{Table} = $compTable; |
5141
|
|
|
|
|
|
|
# (use the original TagID, even if we changed it, so don't do this:) |
5142
|
5135
|
|
|
|
|
7610
|
$$tagInfo{TagID} = $new; |
5143
|
|
|
|
|
|
|
# save tag under new ID in Composite table |
5144
|
5135
|
|
|
|
|
13516
|
$$compTable{$new} = $tagInfo; |
5145
|
|
|
|
|
|
|
# set all default groups in tag |
5146
|
5135
|
|
|
|
|
7551
|
my $groups = $$tagInfo{Groups}; |
5147
|
5135
|
100
|
|
|
|
11661
|
$groups or $groups = $$tagInfo{Groups} = { }; |
5148
|
|
|
|
|
|
|
# fill in default groups |
5149
|
5135
|
|
|
|
|
12939
|
foreach (keys %$defaultGroups) { |
5150
|
15405
|
100
|
|
|
|
34602
|
$$groups{$_} or $$groups{$_} = $$defaultGroups{$_}; |
5151
|
|
|
|
|
|
|
} |
5152
|
|
|
|
|
|
|
# set flag indicating group list was built |
5153
|
5135
|
|
|
|
|
14196
|
$$tagInfo{GotGroups} = 1; |
5154
|
|
|
|
|
|
|
} |
5155
|
|
|
|
|
|
|
} |
5156
|
|
|
|
|
|
|
|
5157
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5158
|
|
|
|
|
|
|
# Add tags to TagLookup (used for writing) |
5159
|
|
|
|
|
|
|
# Inputs: 0) source hash of tag definitions, 1) name of destination tag table |
5160
|
|
|
|
|
|
|
sub AddTagsToLookup($$) |
5161
|
|
|
|
|
|
|
{ |
5162
|
1
|
|
|
1
|
0
|
3
|
my ($tagHash, $table) = @_; |
5163
|
1
|
50
|
|
|
|
7
|
if (defined &Image::ExifTool::TagLookup::AddTags) { |
|
|
50
|
|
|
|
|
|
5164
|
0
|
|
|
|
|
0
|
Image::ExifTool::TagLookup::AddTags($tagHash, $table); |
5165
|
|
|
|
|
|
|
} elsif (not $Image::ExifTool::pluginTags{$tagHash}) { |
5166
|
|
|
|
|
|
|
# queue these tags until TagLookup is loaded |
5167
|
1
|
|
|
|
|
5
|
push @Image::ExifTool::pluginTags, [ $tagHash, $table ]; |
5168
|
|
|
|
|
|
|
# set flag so we don't load same tags twice |
5169
|
1
|
|
|
|
|
4
|
$Image::ExifTool::pluginTags{$tagHash} = 1; |
5170
|
|
|
|
|
|
|
} |
5171
|
|
|
|
|
|
|
} |
5172
|
|
|
|
|
|
|
|
5173
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5174
|
|
|
|
|
|
|
# Expand tagInfo Flags |
5175
|
|
|
|
|
|
|
# Inputs: 0) tagInfo hash ref |
5176
|
|
|
|
|
|
|
# Notes: $$tagInfo{Flags} must be defined to call this routine |
5177
|
|
|
|
|
|
|
sub ExpandFlags($) |
5178
|
|
|
|
|
|
|
{ |
5179
|
4855
|
|
|
4855
|
0
|
7455
|
my $tagInfo = shift; |
5180
|
4855
|
|
|
|
|
7769
|
my $flags = $$tagInfo{Flags}; |
5181
|
4855
|
100
|
|
|
|
11417
|
if (ref $flags eq 'ARRAY') { |
|
|
50
|
|
|
|
|
|
5182
|
2518
|
|
|
|
|
5448
|
foreach (@$flags) { |
5183
|
6706
|
|
|
|
|
15502
|
$$tagInfo{$_} = 1; |
5184
|
|
|
|
|
|
|
} |
5185
|
|
|
|
|
|
|
} elsif (ref $flags eq 'HASH') { |
5186
|
0
|
|
|
|
|
0
|
my $key; |
5187
|
0
|
|
|
|
|
0
|
foreach $key (keys %$flags) { |
5188
|
0
|
|
|
|
|
0
|
$$tagInfo{$key} = $$flags{$key}; |
5189
|
|
|
|
|
|
|
} |
5190
|
|
|
|
|
|
|
} else { |
5191
|
2337
|
|
|
|
|
5603
|
$$tagInfo{$flags} = 1; |
5192
|
|
|
|
|
|
|
} |
5193
|
|
|
|
|
|
|
} |
5194
|
|
|
|
|
|
|
|
5195
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5196
|
|
|
|
|
|
|
# Set up tag table (must be done once for each tag table used) |
5197
|
|
|
|
|
|
|
# Inputs: 0) Reference to tag table |
5198
|
|
|
|
|
|
|
# Notes: - generates 'Name' field from key if it doesn't exist |
5199
|
|
|
|
|
|
|
# - stores 'Table' pointer and 'TagID' value |
5200
|
|
|
|
|
|
|
# - expands 'Flags' for quick lookup |
5201
|
|
|
|
|
|
|
sub SetupTagTable($) |
5202
|
|
|
|
|
|
|
{ |
5203
|
5164
|
|
|
5164
|
0
|
8801
|
my $tagTablePtr = shift; |
5204
|
5164
|
|
|
|
|
9619
|
my $avoid = $$tagTablePtr{AVOID}; |
5205
|
5164
|
|
|
|
|
8742
|
my ($tagID, $tagInfo); |
5206
|
5164
|
|
|
|
|
11892
|
foreach $tagID (TagTableKeys($tagTablePtr)) { |
5207
|
206255
|
|
|
|
|
320861
|
my @infoArray = GetTagInfoList($tagTablePtr,$tagID); |
5208
|
|
|
|
|
|
|
# process conditional tagInfo arrays |
5209
|
206255
|
|
|
|
|
297948
|
foreach $tagInfo (@infoArray) { |
5210
|
227118
|
|
|
|
|
415135
|
$$tagInfo{Table} = $tagTablePtr; |
5211
|
227118
|
|
|
|
|
356152
|
$$tagInfo{TagID} = $tagID; |
5212
|
227118
|
100
|
|
|
|
442731
|
$$tagInfo{Name} or $$tagInfo{Name} = MakeTagName($tagID); |
5213
|
227118
|
100
|
|
|
|
387220
|
$$tagInfo{Flags} and ExpandFlags($tagInfo); |
5214
|
227118
|
100
|
|
|
|
367942
|
$$tagInfo{Avoid} = $avoid if defined $avoid; |
5215
|
|
|
|
|
|
|
# calculate BitShift from Mask if necessary |
5216
|
227118
|
100
|
100
|
|
|
447431
|
if ($$tagInfo{Mask} and not defined $$tagInfo{BitShift}) { |
5217
|
2987
|
|
|
|
|
5238
|
my ($mask, $bitShift) = ($$tagInfo{Mask}, 0); |
5218
|
2987
|
|
|
|
|
9802
|
++$bitShift until $mask & (1 << $bitShift); |
5219
|
2987
|
|
|
|
|
6003
|
$$tagInfo{BitShift} = $bitShift; |
5220
|
|
|
|
|
|
|
} |
5221
|
|
|
|
|
|
|
} |
5222
|
206255
|
100
|
|
|
|
417138
|
next unless @infoArray > 1; |
5223
|
|
|
|
|
|
|
# add an "Index" member to each tagInfo in a list |
5224
|
3733
|
|
|
|
|
6415
|
my $index = 0; |
5225
|
3733
|
|
|
|
|
6188
|
foreach $tagInfo (@infoArray) { |
5226
|
24596
|
|
|
|
|
40000
|
$$tagInfo{Index} = $index++; |
5227
|
|
|
|
|
|
|
} |
5228
|
|
|
|
|
|
|
} |
5229
|
|
|
|
|
|
|
} |
5230
|
|
|
|
|
|
|
|
5231
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5232
|
|
|
|
|
|
|
# Utilities to check for numerical types |
5233
|
|
|
|
|
|
|
# Inputs: 0) value; Returns: true if value is a numerical type |
5234
|
|
|
|
|
|
|
# Notes: May change commas to decimals in floats for use in other locales |
5235
|
|
|
|
|
|
|
sub IsFloat($) { |
5236
|
7836
|
100
|
|
7836
|
0
|
85054
|
return 1 if $_[0] =~ /^[+-]?(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/; |
5237
|
|
|
|
|
|
|
# allow comma separators (for other locales) |
5238
|
2212
|
50
|
|
|
|
17963
|
return 0 unless $_[0] =~ /^[+-]?(?=\d|,\d)\d*(,\d*)?([Ee]([+-]?\d+))?$/; |
5239
|
0
|
|
|
|
|
0
|
$_[0] =~ tr/,/./; # but translate ',' to '.' |
5240
|
0
|
|
|
|
|
0
|
return 1; |
5241
|
|
|
|
|
|
|
} |
5242
|
19845
|
|
|
19845
|
0
|
99213
|
sub IsInt($) { return scalar($_[0] =~ /^[+-]?\d+$/); } |
5243
|
3070
|
|
|
3070
|
0
|
12941
|
sub IsHex($) { return scalar($_[0] =~ /^(0x)?[0-9a-f]{1,8}$/i); } |
5244
|
16
|
|
|
16
|
0
|
156
|
sub IsRational($) { return scalar($_[0] =~ m{^[-+]?\d+/\d+$}); } |
5245
|
|
|
|
|
|
|
|
5246
|
|
|
|
|
|
|
# round floating point value to specified number of significant digits |
5247
|
|
|
|
|
|
|
# Inputs: 0) value, 1) number of sig digits; Returns: rounded number |
5248
|
|
|
|
|
|
|
sub RoundFloat($$) |
5249
|
|
|
|
|
|
|
{ |
5250
|
3504
|
|
|
3504
|
0
|
6964
|
my ($val, $sig) = @_; |
5251
|
3504
|
|
|
|
|
25109
|
return sprintf("%.${sig}g", $val); |
5252
|
|
|
|
|
|
|
} |
5253
|
|
|
|
|
|
|
|
5254
|
|
|
|
|
|
|
# Convert strings to floating point numbers (or undef) |
5255
|
|
|
|
|
|
|
# Inputs: 0-N) list of strings (may be undef) |
5256
|
|
|
|
|
|
|
# Returns: last value converted |
5257
|
|
|
|
|
|
|
sub ToFloat(@) |
5258
|
|
|
|
|
|
|
{ |
5259
|
992
|
|
|
992
|
0
|
2111
|
local $_; |
5260
|
992
|
|
|
|
|
2618
|
foreach (@_) { |
5261
|
10701
|
100
|
|
|
|
19681
|
next unless defined $_; |
5262
|
|
|
|
|
|
|
# (add 0 to convert "0.0" to "0" for tests) |
5263
|
4048
|
100
|
|
|
|
23814
|
$_ = /((?:[+-]?)(?=\d|\.\d)\d*(?:\.\d*)?(?:[Ee](?:[+-]?\d+))?)/ ? $1 + 0 : undef; |
5264
|
|
|
|
|
|
|
} |
5265
|
992
|
|
|
|
|
10261
|
return $_[-1]; |
5266
|
|
|
|
|
|
|
} |
5267
|
|
|
|
|
|
|
|
5268
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5269
|
|
|
|
|
|
|
# Utility routines to for reading binary data values from file |
5270
|
|
|
|
|
|
|
|
5271
|
|
|
|
|
|
|
my %unpackMotorola = ( S => 'n', L => 'N', C => 'C', c => 'c' ); |
5272
|
|
|
|
|
|
|
my %unpackIntel = ( S => 'v', L => 'V', C => 'C', c => 'c' ); |
5273
|
|
|
|
|
|
|
my %unpackRev = ( N => 'V', V => 'N', C => 'C', n => 'v', v => 'n', c => 'c' ); |
5274
|
|
|
|
|
|
|
|
5275
|
|
|
|
|
|
|
# the following 4 variables are defined in 'use vars' instead of using 'my' |
5276
|
|
|
|
|
|
|
# because mod_perl 5.6.1 apparently has a problem with setting file-scope 'my' |
5277
|
|
|
|
|
|
|
# variables from within subroutines (ref communication with Pavel Merdin): |
5278
|
|
|
|
|
|
|
# $swapBytes - set if EXIF header is not native byte ordering |
5279
|
|
|
|
|
|
|
# $swapWords - swap 32-bit words in doubles (ARM quirk) |
5280
|
|
|
|
|
|
|
$currentByteOrder = 'MM'; # current byte ordering ('II' or 'MM') |
5281
|
|
|
|
|
|
|
%unpackStd = %unpackMotorola; |
5282
|
|
|
|
|
|
|
|
5283
|
|
|
|
|
|
|
# Swap bytes in data if necessary |
5284
|
|
|
|
|
|
|
# Inputs: 0) data, 1) number of bytes |
5285
|
|
|
|
|
|
|
# Returns: swapped data |
5286
|
|
|
|
|
|
|
sub SwapBytes($$) |
5287
|
|
|
|
|
|
|
{ |
5288
|
1362
|
100
|
|
1362
|
0
|
3893
|
return $_[0] unless $swapBytes; |
5289
|
208
|
|
|
|
|
510
|
my ($val, $bytes) = @_; |
5290
|
208
|
|
|
|
|
451
|
my $newVal = ''; |
5291
|
208
|
|
|
|
|
1555
|
$newVal .= substr($val, $bytes, 1) while $bytes--; |
5292
|
208
|
|
|
|
|
613
|
return $newVal; |
5293
|
|
|
|
|
|
|
} |
5294
|
|
|
|
|
|
|
# Swap words. Inputs: 8 bytes of data, Returns: swapped data |
5295
|
|
|
|
|
|
|
sub SwapWords($) |
5296
|
|
|
|
|
|
|
{ |
5297
|
1300
|
50
|
33
|
1300
|
0
|
5007
|
return $_[0] unless $swapWords and length($_[0]) == 8; |
5298
|
0
|
|
|
|
|
0
|
return substr($_[0],4,4) . substr($_[0],0,4) |
5299
|
|
|
|
|
|
|
} |
5300
|
|
|
|
|
|
|
|
5301
|
|
|
|
|
|
|
# Unpack value, letting unpack() handle byte swapping |
5302
|
|
|
|
|
|
|
# Inputs: 0) unpack template, 1) data reference, 2) offset |
5303
|
|
|
|
|
|
|
# Returns: unpacked number |
5304
|
|
|
|
|
|
|
# - uses value of %unpackStd to determine the unpack template |
5305
|
|
|
|
|
|
|
# - can only be called for 'S' or 'L' templates since these are the only |
5306
|
|
|
|
|
|
|
# templates for which you can specify the byte ordering. |
5307
|
|
|
|
|
|
|
sub DoUnpackStd(@) |
5308
|
|
|
|
|
|
|
{ |
5309
|
161690
|
100
|
|
161690
|
0
|
409325
|
$_[2] and return unpack("x$_[2] $unpackStd{$_[0]}", ${$_[1]}); |
|
157296
|
|
|
|
|
408611
|
|
5310
|
4394
|
|
|
|
|
8807
|
return unpack($unpackStd{$_[0]}, ${$_[1]}); |
|
4394
|
|
|
|
|
17601
|
|
5311
|
|
|
|
|
|
|
} |
5312
|
|
|
|
|
|
|
# same, but with reversed byte order |
5313
|
|
|
|
|
|
|
sub DoUnpackRev(@) |
5314
|
|
|
|
|
|
|
{ |
5315
|
12
|
|
|
12
|
0
|
26
|
my $fmt = $unpackRev{$unpackStd{$_[0]}}; |
5316
|
12
|
50
|
|
|
|
35
|
$_[2] and return unpack("x$_[2] $fmt", ${$_[1]}); |
|
12
|
|
|
|
|
36
|
|
5317
|
0
|
|
|
|
|
0
|
return unpack($fmt, ${$_[1]}); |
|
0
|
|
|
|
|
0
|
|
5318
|
|
|
|
|
|
|
} |
5319
|
|
|
|
|
|
|
# Pack value |
5320
|
|
|
|
|
|
|
# Inputs: 0) template, 1) value, 2) data ref (or undef), 3) offset (if data ref) |
5321
|
|
|
|
|
|
|
# Returns: packed value |
5322
|
|
|
|
|
|
|
sub DoPackStd(@) |
5323
|
|
|
|
|
|
|
{ |
5324
|
32327
|
|
|
32327
|
0
|
65554
|
my $val = pack($unpackStd{$_[0]}, $_[1]); |
5325
|
32327
|
100
|
|
|
|
57829
|
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; |
|
7812
|
|
|
|
|
13810
|
|
5326
|
32327
|
|
|
|
|
80677
|
return $val; |
5327
|
|
|
|
|
|
|
} |
5328
|
|
|
|
|
|
|
# same, but with reversed byte order |
5329
|
|
|
|
|
|
|
sub DoPackRev(@) |
5330
|
|
|
|
|
|
|
{ |
5331
|
0
|
|
|
0
|
0
|
0
|
my $val = pack($unpackRev{$unpackStd{$_[0]}}, $_[1]); |
5332
|
0
|
0
|
|
|
|
0
|
$_[2] and substr(${$_[2]}, $_[3], length($val)) = $val; |
|
0
|
|
|
|
|
0
|
|
5333
|
0
|
|
|
|
|
0
|
return $val; |
5334
|
|
|
|
|
|
|
} |
5335
|
|
|
|
|
|
|
|
5336
|
|
|
|
|
|
|
# Unpack value, handling the byte swapping manually |
5337
|
|
|
|
|
|
|
# Inputs: 0) # bytes, 1) unpack template, 2) data reference, 3) offset |
5338
|
|
|
|
|
|
|
# Returns: unpacked number |
5339
|
|
|
|
|
|
|
# - uses value of $swapBytes to determine byte ordering |
5340
|
|
|
|
|
|
|
sub DoUnpack(@) |
5341
|
|
|
|
|
|
|
{ |
5342
|
27825
|
|
|
27825
|
0
|
47255
|
my ($bytes, $template, $dataPt, $pos) = @_; |
5343
|
27825
|
|
|
|
|
35006
|
my $val; |
5344
|
27825
|
100
|
|
|
|
44518
|
if ($swapBytes) { |
5345
|
5390
|
|
|
|
|
7643
|
$val = ''; |
5346
|
5390
|
|
|
|
|
25144
|
$val .= substr($$dataPt,$pos+$bytes,1) while $bytes--; |
5347
|
|
|
|
|
|
|
} else { |
5348
|
22435
|
|
|
|
|
38187
|
$val = substr($$dataPt,$pos,$bytes); |
5349
|
|
|
|
|
|
|
} |
5350
|
27825
|
50
|
|
|
|
49338
|
defined($val) or return undef; |
5351
|
27825
|
|
|
|
|
64937
|
return unpack($template,$val); |
5352
|
|
|
|
|
|
|
} |
5353
|
|
|
|
|
|
|
|
5354
|
|
|
|
|
|
|
# Unpack double value |
5355
|
|
|
|
|
|
|
# Inputs: 0) unpack template, 1) data reference, 2) offset |
5356
|
|
|
|
|
|
|
# Returns: unpacked number |
5357
|
|
|
|
|
|
|
sub DoUnpackDbl(@) |
5358
|
|
|
|
|
|
|
{ |
5359
|
1236
|
|
|
1236
|
0
|
2272
|
my ($template, $dataPt, $pos) = @_; |
5360
|
1236
|
|
|
|
|
2402
|
my $val = substr($$dataPt,$pos,8); |
5361
|
1236
|
50
|
|
|
|
2415
|
defined($val) or return undef; |
5362
|
|
|
|
|
|
|
# swap bytes and 32-bit words (ARM quirk) if necessary, then unpack value |
5363
|
1236
|
|
|
|
|
2406
|
return unpack($template, SwapWords(SwapBytes($val, 8))); |
5364
|
|
|
|
|
|
|
} |
5365
|
|
|
|
|
|
|
|
5366
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) offset into data |
5367
|
135
|
|
|
135
|
0
|
523
|
sub Get8s($$) { return DoUnpackStd('c', @_); } |
5368
|
7847
|
|
|
7847
|
0
|
15656
|
sub Get8u($$) { return DoUnpackStd('C', @_); } |
5369
|
14954
|
|
|
14954
|
0
|
28075
|
sub Get16s($$) { return DoUnpack(2, 's', @_); } |
5370
|
78543
|
|
|
78543
|
0
|
140493
|
sub Get16u($$) { return DoUnpackStd('S', @_); } |
5371
|
12182
|
|
|
12182
|
0
|
22167
|
sub Get32s($$) { return DoUnpack(4, 'l', @_); } |
5372
|
75165
|
|
|
75165
|
0
|
133573
|
sub Get32u($$) { return DoUnpackStd('L', @_); } |
5373
|
689
|
|
|
689
|
0
|
2053
|
sub GetFloat($$) { return DoUnpack(4, 'f', @_); } |
5374
|
1236
|
|
|
1236
|
0
|
2466
|
sub GetDouble($$) { return DoUnpackDbl('d', @_); } |
5375
|
12
|
|
|
12
|
0
|
44
|
sub Get16uRev($$) { return DoUnpackRev('S', @_); } |
5376
|
0
|
|
|
0
|
0
|
0
|
sub Get32uRev($$) { return DoUnpackRev('L', @_); } |
5377
|
|
|
|
|
|
|
|
5378
|
|
|
|
|
|
|
# rationals may be a floating point number, 'inf' or 'undef' |
5379
|
|
|
|
|
|
|
my ($ratNumer, $ratDenom); |
5380
|
|
|
|
|
|
|
sub GetRational32s($$) |
5381
|
|
|
|
|
|
|
{ |
5382
|
12
|
|
|
12
|
0
|
33
|
my ($dataPt, $pos) = @_; |
5383
|
12
|
|
|
|
|
31
|
$ratNumer = Get16s($dataPt,$pos); |
5384
|
12
|
0
|
|
|
|
31
|
$ratDenom = Get16s($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5385
|
|
|
|
|
|
|
# round off to a reasonable number of significant figures |
5386
|
12
|
|
|
|
|
35
|
return RoundFloat($ratNumer / $ratDenom, 7); |
5387
|
|
|
|
|
|
|
} |
5388
|
|
|
|
|
|
|
sub GetRational32u($$) |
5389
|
|
|
|
|
|
|
{ |
5390
|
12
|
|
|
12
|
0
|
29
|
my ($dataPt, $pos) = @_; |
5391
|
12
|
|
|
|
|
31
|
$ratNumer = Get16u($dataPt,$pos); |
5392
|
12
|
0
|
|
|
|
41
|
$ratDenom = Get16u($dataPt, $pos + 2) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5393
|
12
|
|
|
|
|
49
|
return RoundFloat($ratNumer / $ratDenom, 7); |
5394
|
|
|
|
|
|
|
} |
5395
|
|
|
|
|
|
|
sub GetRational64s($$) |
5396
|
|
|
|
|
|
|
{ |
5397
|
681
|
|
|
681
|
0
|
1997
|
my ($dataPt, $pos) = @_; |
5398
|
681
|
|
|
|
|
1637
|
$ratNumer = Get32s($dataPt,$pos); |
5399
|
681
|
0
|
|
|
|
1875
|
$ratDenom = Get32s($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; |
|
|
50
|
|
|
|
|
|
5400
|
681
|
|
|
|
|
2257
|
return RoundFloat($ratNumer / $ratDenom, 10); |
5401
|
|
|
|
|
|
|
} |
5402
|
|
|
|
|
|
|
sub GetRational64u($$) |
5403
|
|
|
|
|
|
|
{ |
5404
|
2831
|
|
|
2831
|
0
|
5432
|
my ($dataPt, $pos) = @_; |
5405
|
2831
|
|
|
|
|
5475
|
$ratNumer = Get32u($dataPt,$pos); |
5406
|
2831
|
50
|
|
|
|
6697
|
$ratDenom = Get32u($dataPt, $pos + 4) or return $ratNumer ? 'inf' : 'undef'; |
|
|
100
|
|
|
|
|
|
5407
|
2799
|
|
|
|
|
8823
|
return RoundFloat($ratNumer / $ratDenom, 10); |
5408
|
|
|
|
|
|
|
} |
5409
|
|
|
|
|
|
|
sub GetFixed16s($$) |
5410
|
|
|
|
|
|
|
{ |
5411
|
13
|
|
|
13
|
0
|
48
|
my ($dataPt, $pos) = @_; |
5412
|
13
|
|
|
|
|
54
|
my $val = Get16s($dataPt, $pos) / 0x100; |
5413
|
13
|
50
|
|
|
|
76
|
return int($val * 1000 + ($val<0 ? -0.5 : 0.5)) / 1000; |
5414
|
|
|
|
|
|
|
} |
5415
|
|
|
|
|
|
|
sub GetFixed16u($$) |
5416
|
|
|
|
|
|
|
{ |
5417
|
0
|
|
|
0
|
0
|
0
|
my ($dataPt, $pos) = @_; |
5418
|
0
|
|
|
|
|
0
|
return int((Get16u($dataPt, $pos) / 0x100) * 1000 + 0.5) / 1000; |
5419
|
|
|
|
|
|
|
} |
5420
|
|
|
|
|
|
|
sub GetFixed32s($$) |
5421
|
|
|
|
|
|
|
{ |
5422
|
1754
|
|
|
1754
|
0
|
3018
|
my ($dataPt, $pos) = @_; |
5423
|
1754
|
|
|
|
|
2886
|
my $val = Get32s($dataPt, $pos) / 0x10000; |
5424
|
|
|
|
|
|
|
# remove insignificant digits |
5425
|
1754
|
100
|
|
|
|
5396
|
return int($val * 1e5 + ($val>0 ? 0.5 : -0.5)) / 1e5; |
5426
|
|
|
|
|
|
|
} |
5427
|
|
|
|
|
|
|
sub GetFixed32u($$) |
5428
|
|
|
|
|
|
|
{ |
5429
|
156
|
|
|
156
|
0
|
375
|
my ($dataPt, $pos) = @_; |
5430
|
|
|
|
|
|
|
# remove insignificant digits |
5431
|
156
|
|
|
|
|
342
|
return int((Get32u($dataPt, $pos) / 0x10000) * 1e5 + 0.5) / 1e5; |
5432
|
|
|
|
|
|
|
} |
5433
|
|
|
|
|
|
|
# Inputs: 0) value, 1) data ref, 2) offset |
5434
|
5
|
|
|
5
|
0
|
17
|
sub Set8s(@) { return DoPackStd('c', @_); } |
5435
|
291
|
|
|
291
|
0
|
726
|
sub Set8u(@) { return DoPackStd('C', @_); } |
5436
|
13009
|
|
|
13009
|
0
|
22991
|
sub Set16u(@) { return DoPackStd('S', @_); } |
5437
|
19022
|
|
|
19022
|
0
|
34506
|
sub Set32u(@) { return DoPackStd('L', @_); } |
5438
|
0
|
|
|
0
|
0
|
0
|
sub Set16uRev(@) { return DoPackRev('S', @_); } |
5439
|
|
|
|
|
|
|
|
5440
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5441
|
|
|
|
|
|
|
# Get current byte order ('II' or 'MM') |
5442
|
14264
|
|
|
14264
|
0
|
39048
|
sub GetByteOrder() { return $currentByteOrder; } |
5443
|
|
|
|
|
|
|
|
5444
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5445
|
|
|
|
|
|
|
# Set byte ordering |
5446
|
|
|
|
|
|
|
# Inputs: 0) 'MM'=motorola, 'II'=intel (will translate 'BigEndian', 'LittleEndian') |
5447
|
|
|
|
|
|
|
# Returns: 1 on success |
5448
|
|
|
|
|
|
|
sub SetByteOrder($) |
5449
|
|
|
|
|
|
|
{ |
5450
|
15484
|
|
|
15484
|
0
|
28384
|
my $order = shift; |
5451
|
|
|
|
|
|
|
|
5452
|
15484
|
100
|
|
|
|
40375
|
if ($order eq 'MM') { # big endian (Motorola) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
5453
|
7870
|
|
|
|
|
35794
|
%unpackStd = %unpackMotorola; |
5454
|
|
|
|
|
|
|
} elsif ($order eq 'II') { # little endian (Intel) |
5455
|
7419
|
|
|
|
|
34676
|
%unpackStd = %unpackIntel; |
5456
|
|
|
|
|
|
|
} elsif ($order =~ /^Big/i) { |
5457
|
15
|
|
|
|
|
50
|
$order = 'MM'; |
5458
|
15
|
|
|
|
|
98
|
%unpackStd = %unpackMotorola; |
5459
|
|
|
|
|
|
|
} elsif ($order =~ /^Little/i) { |
5460
|
12
|
|
|
|
|
37
|
$order = 'II'; |
5461
|
12
|
|
|
|
|
107
|
%unpackStd = %unpackIntel; |
5462
|
|
|
|
|
|
|
} else { |
5463
|
168
|
|
|
|
|
664
|
return 0; |
5464
|
|
|
|
|
|
|
} |
5465
|
15316
|
|
|
|
|
39499
|
my $val = unpack('S','A '); |
5466
|
15316
|
|
|
|
|
22765
|
my $nativeOrder; |
5467
|
15316
|
50
|
|
|
|
35512
|
if ($val == 0x4120) { # big endian |
|
|
50
|
|
|
|
|
|
5468
|
0
|
|
|
|
|
0
|
$nativeOrder = 'MM'; |
5469
|
|
|
|
|
|
|
} elsif ($val == 0x2041) { # little endian |
5470
|
15316
|
|
|
|
|
23832
|
$nativeOrder = 'II'; |
5471
|
|
|
|
|
|
|
} else { |
5472
|
0
|
|
|
|
|
0
|
warn sprintf("Unknown native byte order! (pattern %x)\n",$val); |
5473
|
0
|
|
|
|
|
0
|
return 0; |
5474
|
|
|
|
|
|
|
} |
5475
|
15316
|
|
|
|
|
24233
|
$currentByteOrder = $order; # save current byte order |
5476
|
|
|
|
|
|
|
|
5477
|
|
|
|
|
|
|
# swap bytes if our native CPU byte ordering is not the same as the EXIF |
5478
|
15316
|
|
|
|
|
24405
|
$swapBytes = ($order ne $nativeOrder); |
5479
|
|
|
|
|
|
|
|
5480
|
|
|
|
|
|
|
# little-endian ARM has big-endian words for doubles (thanks Riku Voipio) |
5481
|
|
|
|
|
|
|
# (Note: Riku's patch checked for '0ff3', but I think it should be 'f03f' since |
5482
|
|
|
|
|
|
|
# 1 is '000000000000f03f' on an x86 -- so check for both, but which is correct?) |
5483
|
15316
|
|
|
|
|
23089
|
my $pack1d = pack('d', 1); |
5484
|
15316
|
|
33
|
|
|
49375
|
$swapWords = ($pack1d eq "\0\0\x0f\xf3\0\0\0\0" or |
5485
|
|
|
|
|
|
|
$pack1d eq "\0\0\xf0\x3f\0\0\0\0"); |
5486
|
15316
|
|
|
|
|
32915
|
return 1; |
5487
|
|
|
|
|
|
|
} |
5488
|
|
|
|
|
|
|
|
5489
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5490
|
|
|
|
|
|
|
# Change byte order |
5491
|
|
|
|
|
|
|
sub ToggleByteOrder() |
5492
|
|
|
|
|
|
|
{ |
5493
|
39
|
100
|
|
39
|
0
|
137
|
SetByteOrder(GetByteOrder() eq 'II' ? 'MM' : 'II'); |
5494
|
|
|
|
|
|
|
} |
5495
|
|
|
|
|
|
|
|
5496
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5497
|
|
|
|
|
|
|
# hash lookups for reading values from data |
5498
|
|
|
|
|
|
|
my %formatSize = ( |
5499
|
|
|
|
|
|
|
int8s => 1, |
5500
|
|
|
|
|
|
|
int8u => 1, |
5501
|
|
|
|
|
|
|
int16s => 2, |
5502
|
|
|
|
|
|
|
int16u => 2, |
5503
|
|
|
|
|
|
|
int16uRev => 2, |
5504
|
|
|
|
|
|
|
int32s => 4, |
5505
|
|
|
|
|
|
|
int32u => 4, |
5506
|
|
|
|
|
|
|
int32uRev => 4, |
5507
|
|
|
|
|
|
|
int64s => 8, |
5508
|
|
|
|
|
|
|
int64u => 8, |
5509
|
|
|
|
|
|
|
rational32s => 4, |
5510
|
|
|
|
|
|
|
rational32u => 4, |
5511
|
|
|
|
|
|
|
rational64s => 8, |
5512
|
|
|
|
|
|
|
rational64u => 8, |
5513
|
|
|
|
|
|
|
fixed16s => 2, |
5514
|
|
|
|
|
|
|
fixed16u => 2, |
5515
|
|
|
|
|
|
|
fixed32s => 4, |
5516
|
|
|
|
|
|
|
fixed32u => 4, |
5517
|
|
|
|
|
|
|
fixed64s => 8, |
5518
|
|
|
|
|
|
|
float => 4, |
5519
|
|
|
|
|
|
|
double => 8, |
5520
|
|
|
|
|
|
|
extended => 10, |
5521
|
|
|
|
|
|
|
unicode => 2, |
5522
|
|
|
|
|
|
|
complex => 8, |
5523
|
|
|
|
|
|
|
string => 1, |
5524
|
|
|
|
|
|
|
binary => 1, |
5525
|
|
|
|
|
|
|
'undef' => 1, |
5526
|
|
|
|
|
|
|
ifd => 4, |
5527
|
|
|
|
|
|
|
ifd64 => 8, |
5528
|
|
|
|
|
|
|
ue7 => 1, |
5529
|
|
|
|
|
|
|
); |
5530
|
|
|
|
|
|
|
my %readValueProc = ( |
5531
|
|
|
|
|
|
|
int8s => \&Get8s, |
5532
|
|
|
|
|
|
|
int8u => \&Get8u, |
5533
|
|
|
|
|
|
|
int16s => \&Get16s, |
5534
|
|
|
|
|
|
|
int16u => \&Get16u, |
5535
|
|
|
|
|
|
|
int16uRev => \&Get16uRev, |
5536
|
|
|
|
|
|
|
int32s => \&Get32s, |
5537
|
|
|
|
|
|
|
int32u => \&Get32u, |
5538
|
|
|
|
|
|
|
int32uRev => \&Get32uRev, |
5539
|
|
|
|
|
|
|
int64s => \&Get64s, |
5540
|
|
|
|
|
|
|
int64u => \&Get64u, |
5541
|
|
|
|
|
|
|
rational32s => \&GetRational32s, |
5542
|
|
|
|
|
|
|
rational32u => \&GetRational32u, |
5543
|
|
|
|
|
|
|
rational64s => \&GetRational64s, |
5544
|
|
|
|
|
|
|
rational64u => \&GetRational64u, |
5545
|
|
|
|
|
|
|
fixed16s => \&GetFixed16s, |
5546
|
|
|
|
|
|
|
fixed16u => \&GetFixed16u, |
5547
|
|
|
|
|
|
|
fixed32s => \&GetFixed32s, |
5548
|
|
|
|
|
|
|
fixed32u => \&GetFixed32u, |
5549
|
|
|
|
|
|
|
fixed64s => \&GetFixed64s, |
5550
|
|
|
|
|
|
|
float => \&GetFloat, |
5551
|
|
|
|
|
|
|
double => \&GetDouble, |
5552
|
|
|
|
|
|
|
extended => \&GetExtended, |
5553
|
|
|
|
|
|
|
ifd => \&Get32u, |
5554
|
|
|
|
|
|
|
ifd64 => \&Get64u, |
5555
|
|
|
|
|
|
|
); |
5556
|
|
|
|
|
|
|
# lookup for all rational types |
5557
|
|
|
|
|
|
|
my %isRational = ( |
5558
|
|
|
|
|
|
|
rational32u => 1, |
5559
|
|
|
|
|
|
|
rational32s => 1, |
5560
|
|
|
|
|
|
|
rational64u => 1, |
5561
|
|
|
|
|
|
|
rational64s => 1, |
5562
|
|
|
|
|
|
|
); |
5563
|
1570
|
|
|
1570
|
0
|
4563
|
sub FormatSize($) { return $formatSize{$_[0]}; } |
5564
|
|
|
|
|
|
|
|
5565
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5566
|
|
|
|
|
|
|
# Read value from binary data (with current byte ordering) |
5567
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) value offset, 2) format string, |
5568
|
|
|
|
|
|
|
# 3) number of values (or undef to use all data), |
5569
|
|
|
|
|
|
|
# 4) valid data length relative to offset (or undef to use all data), |
5570
|
|
|
|
|
|
|
# 5) optional pointer to returned rational |
5571
|
|
|
|
|
|
|
# Returns: converted value, or undefined if data isn't there |
5572
|
|
|
|
|
|
|
# or list of values in list context |
5573
|
|
|
|
|
|
|
sub ReadValue($$$;$$$) |
5574
|
|
|
|
|
|
|
{ |
5575
|
36561
|
|
|
36561
|
0
|
80475
|
my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_; |
5576
|
|
|
|
|
|
|
|
5577
|
36561
|
|
|
|
|
66450
|
my $len = $formatSize{$format}; |
5578
|
36561
|
50
|
|
|
|
69550
|
unless ($len) { |
5579
|
0
|
|
|
|
|
0
|
warn "Unknown format $format"; |
5580
|
0
|
|
|
|
|
0
|
$len = 1; |
5581
|
|
|
|
|
|
|
} |
5582
|
36561
|
50
|
|
|
|
68734
|
$size = length($$dataPt) - $offset unless defined $size; |
5583
|
36561
|
100
|
|
|
|
66557
|
unless ($count) { |
5584
|
1360
|
100
|
100
|
|
|
5133
|
return '' if defined $count or $size < $len; |
5585
|
1331
|
|
|
|
|
2864
|
$count = int($size / $len); |
5586
|
|
|
|
|
|
|
} |
5587
|
|
|
|
|
|
|
# make sure entry is inside data |
5588
|
36532
|
100
|
|
|
|
75146
|
if ($len * $count > $size) { |
5589
|
3
|
|
|
|
|
25
|
$count = int($size / $len); # shorten count if necessary |
5590
|
3
|
50
|
|
|
|
27
|
$count < 1 and return undef; # return undefined if no data |
5591
|
|
|
|
|
|
|
} |
5592
|
36529
|
|
|
|
|
50431
|
my @vals; |
5593
|
36529
|
|
|
|
|
60804
|
my $proc = $readValueProc{$format}; |
5594
|
36529
|
100
|
100
|
|
|
105977
|
if (not $proc) { |
|
|
100
|
|
|
|
|
|
5595
|
|
|
|
|
|
|
# handle undef/binary/string (also unsupported unicode/complex) |
5596
|
6411
|
|
|
|
|
20203
|
$vals[0] = substr($$dataPt, $offset, $count * $len); |
5597
|
|
|
|
|
|
|
# truncate string at null terminator if necessary |
5598
|
6411
|
100
|
|
|
|
29805
|
$vals[0] =~ s/\0.*//s if $format eq 'string'; |
5599
|
|
|
|
|
|
|
} elsif ($isRational{$format} and $ratPt) { |
5600
|
|
|
|
|
|
|
# store rationals separately as string fractions |
5601
|
3141
|
|
|
|
|
4842
|
my @rat; |
5602
|
3141
|
|
|
|
|
4841
|
for (;;) { |
5603
|
3448
|
|
|
|
|
8942
|
push @vals, &$proc($dataPt, $offset); |
5604
|
3448
|
|
|
|
|
9822
|
push @rat, "$ratNumer/$ratDenom"; |
5605
|
3448
|
100
|
|
|
|
8827
|
last if --$count <= 0; |
5606
|
307
|
|
|
|
|
511
|
$offset += $len; |
5607
|
|
|
|
|
|
|
} |
5608
|
3141
|
|
|
|
|
8740
|
$$ratPt = join(' ',@rat); |
5609
|
|
|
|
|
|
|
} else { |
5610
|
26977
|
|
|
|
|
38436
|
for (;;) { |
5611
|
49437
|
|
|
|
|
91993
|
push @vals, &$proc($dataPt, $offset); |
5612
|
49437
|
100
|
|
|
|
107701
|
last if --$count <= 0; |
5613
|
22460
|
|
|
|
|
29273
|
$offset += $len; |
5614
|
|
|
|
|
|
|
} |
5615
|
|
|
|
|
|
|
} |
5616
|
36529
|
100
|
|
|
|
75818
|
return @vals if wantarray; |
5617
|
36117
|
100
|
|
|
|
94687
|
return join(' ', @vals) if @vals > 1; |
5618
|
32480
|
|
|
|
|
77918
|
return $vals[0]; |
5619
|
|
|
|
|
|
|
} |
5620
|
|
|
|
|
|
|
|
5621
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5622
|
|
|
|
|
|
|
# Decode string with specified encoding |
5623
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) string to decode |
5624
|
|
|
|
|
|
|
# 2) source character set name (undef for current Charset) |
5625
|
|
|
|
|
|
|
# 3) optional source byte order (2-byte and 4-byte fixed-width sets only) |
5626
|
|
|
|
|
|
|
# 4) optional destination character set (defaults to Charset setting) |
5627
|
|
|
|
|
|
|
# 5) optional destination byte order (2-byte and 4-byte fixed-width only) |
5628
|
|
|
|
|
|
|
# Returns: string in destination encoding |
5629
|
|
|
|
|
|
|
# Note: ExifTool ref may be undef if character both character sets are provided |
5630
|
|
|
|
|
|
|
# (but in this case no warnings will be issued) |
5631
|
|
|
|
|
|
|
sub Decode($$$;$$$) |
5632
|
|
|
|
|
|
|
{ |
5633
|
6237
|
|
|
6237
|
0
|
14401
|
my ($self, $val, $from, $fromOrder, $to, $toOrder) = @_; |
5634
|
6237
|
100
|
|
|
|
12689
|
$from or $from = $$self{OPTIONS}{Charset}; |
5635
|
6237
|
100
|
|
|
|
16636
|
$to or $to = $$self{OPTIONS}{Charset}; |
5636
|
6237
|
100
|
100
|
|
|
17319
|
if ($from ne $to and length $val) { |
5637
|
1089
|
|
|
|
|
28945
|
require Image::ExifTool::Charset; |
5638
|
1089
|
|
|
|
|
2607
|
my $cs1 = $Image::ExifTool::Charset::csType{$from}; |
5639
|
1089
|
|
|
|
|
1911
|
my $cs2 = $Image::ExifTool::Charset::csType{$to}; |
5640
|
1089
|
50
|
33
|
|
|
5445
|
if ($cs1 and $cs2 and not $cs2 & 0x002) { |
|
|
0
|
33
|
|
|
|
|
5641
|
|
|
|
|
|
|
# treat as straight ASCII if no character will need remapping |
5642
|
1089
|
100
|
100
|
|
|
3960
|
if (($cs1 | $cs2) & 0x680 or $val =~ /[\x80-\xff]/) { |
5643
|
776
|
|
|
|
|
2466
|
my $uni = Image::ExifTool::Charset::Decompose($self, $val, $from, $fromOrder); |
5644
|
776
|
|
|
|
|
2107
|
$val = Image::ExifTool::Charset::Recompose($self, $uni, $to, $toOrder); |
5645
|
|
|
|
|
|
|
} |
5646
|
|
|
|
|
|
|
} elsif ($self) { |
5647
|
0
|
0
|
|
|
|
0
|
my $set = $cs1 ? $to : $from; |
5648
|
0
|
0
|
|
|
|
0
|
unless ($$self{"DecodeWarn$set"}) { |
5649
|
0
|
|
|
|
|
0
|
$self->Warn("Unsupported character set ($set)"); |
5650
|
0
|
|
|
|
|
0
|
$$self{"DecodeWarn$set"} = 1; |
5651
|
|
|
|
|
|
|
} |
5652
|
|
|
|
|
|
|
} |
5653
|
|
|
|
|
|
|
} |
5654
|
6237
|
|
|
|
|
16579
|
return $val; |
5655
|
|
|
|
|
|
|
} |
5656
|
|
|
|
|
|
|
|
5657
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5658
|
|
|
|
|
|
|
# Encode string with specified encoding |
5659
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) string, 2) destination character set name, |
5660
|
|
|
|
|
|
|
# 3) optional destination byte order (2-byte and 4-byte fixed-width sets only) |
5661
|
|
|
|
|
|
|
# Returns: string in specified encoding |
5662
|
|
|
|
|
|
|
sub Encode($$$;$) |
5663
|
|
|
|
|
|
|
{ |
5664
|
59
|
|
|
59
|
0
|
262
|
my ($self, $val, $to, $toOrder) = @_; |
5665
|
59
|
|
|
|
|
250
|
return $self->Decode($val, undef, undef, $to, $toOrder); |
5666
|
|
|
|
|
|
|
} |
5667
|
|
|
|
|
|
|
|
5668
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5669
|
|
|
|
|
|
|
# Decode bit mask |
5670
|
|
|
|
|
|
|
# Inputs: 0) value to decode, 1) Reference to hash for decoding (or undef) |
5671
|
|
|
|
|
|
|
# 2) optional bits per word (defaults to 32) |
5672
|
|
|
|
|
|
|
sub DecodeBits($$;$) |
5673
|
|
|
|
|
|
|
{ |
5674
|
175
|
|
|
175
|
0
|
988
|
my ($vals, $lookup, $bits) = @_; |
5675
|
175
|
100
|
|
|
|
661
|
$bits or $bits = 32; |
5676
|
175
|
|
|
|
|
384
|
my ($val, $i, @bitList); |
5677
|
175
|
|
|
|
|
363
|
my $num = 0; |
5678
|
175
|
|
|
|
|
677
|
foreach $val (split ' ', $vals) { |
5679
|
243
|
|
|
|
|
860
|
for ($i=0; $i<$bits; ++$i) { |
5680
|
6048
|
100
|
|
|
|
12925
|
next unless $val & (1 << $i); |
5681
|
140
|
|
|
|
|
325
|
my $n = $i + $num; |
5682
|
140
|
100
|
|
|
|
586
|
if (not $lookup) { |
|
|
100
|
|
|
|
|
|
5683
|
19
|
|
|
|
|
59
|
push @bitList, $n; |
5684
|
|
|
|
|
|
|
} elsif ($$lookup{$n}) { |
5685
|
115
|
|
|
|
|
359
|
push @bitList, $$lookup{$n}; |
5686
|
|
|
|
|
|
|
} else { |
5687
|
6
|
|
|
|
|
28
|
push @bitList, "[$n]"; |
5688
|
|
|
|
|
|
|
} |
5689
|
|
|
|
|
|
|
} |
5690
|
243
|
|
|
|
|
709
|
$num += $bits; |
5691
|
|
|
|
|
|
|
} |
5692
|
175
|
100
|
|
|
|
992
|
return '(none)' unless @bitList; |
5693
|
95
|
100
|
|
|
|
1714
|
return join($lookup ? ', ' : ',', @bitList); |
5694
|
|
|
|
|
|
|
} |
5695
|
|
|
|
|
|
|
|
5696
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5697
|
|
|
|
|
|
|
# Validate an extracted image and repair if necessary |
5698
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) image reference, 2) tag name or key |
5699
|
|
|
|
|
|
|
# Returns: image reference or undef if it wasn't valid |
5700
|
|
|
|
|
|
|
# Note: should be called from RawConv, not ValueConv |
5701
|
|
|
|
|
|
|
sub ValidateImage($$$) |
5702
|
|
|
|
|
|
|
{ |
5703
|
206
|
|
|
206
|
0
|
810
|
my ($self, $imagePt, $tag) = @_; |
5704
|
206
|
50
|
|
|
|
795
|
return undef if $$imagePt eq 'none'; |
5705
|
206
|
100
|
66
|
|
|
1947
|
unless ($$imagePt =~ /^(Binary data|\xff\xd8\xff)/ or |
|
|
|
100
|
|
|
|
|
5706
|
|
|
|
|
|
|
# the first byte of the preview of some Minolta cameras is wrong, |
5707
|
|
|
|
|
|
|
# so check for this and set it back to 0xff if necessary |
5708
|
|
|
|
|
|
|
$$imagePt =~ s/^.(\xd8\xff\xdb)/\xff$1/s or |
5709
|
|
|
|
|
|
|
$self->Options('IgnoreMinorErrors')) |
5710
|
|
|
|
|
|
|
{ |
5711
|
|
|
|
|
|
|
# issue warning only if the tag was specifically requested |
5712
|
120
|
50
|
|
|
|
816
|
if ($$self{REQ_TAG_LOOKUP}{lc GetTagName($tag)}) { |
5713
|
0
|
|
|
|
|
0
|
$self->Warn("$tag is not a valid JPEG image",1); |
5714
|
0
|
|
|
|
|
0
|
return undef; |
5715
|
|
|
|
|
|
|
} |
5716
|
|
|
|
|
|
|
} |
5717
|
206
|
|
|
|
|
2595
|
return $imagePt; |
5718
|
|
|
|
|
|
|
} |
5719
|
|
|
|
|
|
|
|
5720
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5721
|
|
|
|
|
|
|
# Validate a tag name argument (including group name and wildcards, etc) |
5722
|
|
|
|
|
|
|
# Inputs: 0) tag name |
5723
|
|
|
|
|
|
|
# Returns: true if tag name is valid |
5724
|
|
|
|
|
|
|
# - a tag name may contain [-_A-Za-z0-9], but may not start with [-0-9] |
5725
|
|
|
|
|
|
|
# - tag names may contain wildcards [?*], and end with a hash [#] |
5726
|
|
|
|
|
|
|
# - may have group name prefixes (which may have family number prefix), separated by colons |
5727
|
|
|
|
|
|
|
# - a group name may be zero or more characters |
5728
|
|
|
|
|
|
|
sub ValidTagName($) |
5729
|
|
|
|
|
|
|
{ |
5730
|
53
|
|
|
53
|
0
|
149
|
my $tag = shift; |
5731
|
53
|
|
|
|
|
445
|
return $tag =~ /^(([-\w]*|\d*\*):)*[_a-zA-Z?*][-\w?*]*#?$/; |
5732
|
|
|
|
|
|
|
} |
5733
|
|
|
|
|
|
|
|
5734
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5735
|
|
|
|
|
|
|
# Generate a valid tag name based on the tag ID or name |
5736
|
|
|
|
|
|
|
# Inputs: 0) tag ID or name |
5737
|
|
|
|
|
|
|
# Returns: valid tag name |
5738
|
|
|
|
|
|
|
sub MakeTagName($) |
5739
|
|
|
|
|
|
|
{ |
5740
|
34815
|
|
|
34815
|
0
|
47731
|
my $name = shift; |
5741
|
34815
|
|
|
|
|
64066
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
5742
|
34815
|
|
|
|
|
57304
|
$name = ucfirst $name; # capitalize first letter |
5743
|
34815
|
50
|
|
|
|
62969
|
$name = "Tag$name" if length($name) < 2; # must at least 2 characters long |
5744
|
34815
|
|
|
|
|
65668
|
return $name; |
5745
|
|
|
|
|
|
|
} |
5746
|
|
|
|
|
|
|
|
5747
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5748
|
|
|
|
|
|
|
# Make description from a tag name |
5749
|
|
|
|
|
|
|
# Inputs: 0) tag name 1) optional tagID to add at end of description |
5750
|
|
|
|
|
|
|
# Returns: description |
5751
|
|
|
|
|
|
|
sub MakeDescription($;$) |
5752
|
|
|
|
|
|
|
{ |
5753
|
10340
|
|
|
10340
|
0
|
19586
|
my ($tag, $tagID) = @_; |
5754
|
|
|
|
|
|
|
# start with the tag name and force first letter to be upper case |
5755
|
10340
|
|
|
|
|
19707
|
my $desc = ucfirst($tag); |
5756
|
|
|
|
|
|
|
# translate underlines to spaces |
5757
|
10340
|
|
|
|
|
17843
|
$desc =~ tr/_/ /; |
5758
|
|
|
|
|
|
|
# remove hex TagID from name (to avoid inserting spaces in the number) |
5759
|
10340
|
100
|
66
|
|
|
31690
|
$desc =~ s/ (0x[\da-f]+)$//i and $tagID = $1 unless defined $tagID; |
5760
|
|
|
|
|
|
|
# put a space between lower/UPPER case and lower/number combinations |
5761
|
10340
|
|
|
|
|
63698
|
$desc =~ s/([a-z])([A-Z\d])/$1 $2/g; |
5762
|
|
|
|
|
|
|
# put a space between acronyms and words |
5763
|
10340
|
|
|
|
|
28009
|
$desc =~ s/([A-Z])([A-Z][a-z])/$1 $2/g; |
5764
|
|
|
|
|
|
|
# put spaces after numbers (if more than one character follows the number) |
5765
|
10340
|
|
|
|
|
17811
|
$desc =~ s/(\d)([A-Z]\S)/$1 $2/g; |
5766
|
|
|
|
|
|
|
# add TagID to description |
5767
|
10340
|
100
|
|
|
|
20202
|
$desc .= ' ' . $tagID if defined $tagID; |
5768
|
10340
|
|
|
|
|
28158
|
return $desc; |
5769
|
|
|
|
|
|
|
} |
5770
|
|
|
|
|
|
|
|
5771
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5772
|
|
|
|
|
|
|
# Get descriptions for all tags in an array |
5773
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) reference to list of tag keys |
5774
|
|
|
|
|
|
|
# Returns: reference to hash lookup for descriptions |
5775
|
|
|
|
|
|
|
# Note: Returned descriptions are NOT escaped by ESCAPE_PROC |
5776
|
|
|
|
|
|
|
sub GetDescriptions($$) |
5777
|
|
|
|
|
|
|
{ |
5778
|
0
|
|
|
0
|
0
|
0
|
local $_; |
5779
|
0
|
|
|
|
|
0
|
my ($self, $tags) = @_; |
5780
|
0
|
|
|
|
|
0
|
my %desc; |
5781
|
0
|
|
|
|
|
0
|
my $oldEscape = $$self{ESCAPE_PROC}; |
5782
|
0
|
|
|
|
|
0
|
delete $$self{ESCAPE_PROC}; |
5783
|
0
|
|
|
|
|
0
|
$desc{$_} = $self->GetDescription($_) foreach @$tags; |
5784
|
0
|
|
|
|
|
0
|
$$self{ESCAPE_PROC} = $oldEscape; |
5785
|
0
|
|
|
|
|
0
|
return \%desc; |
5786
|
|
|
|
|
|
|
} |
5787
|
|
|
|
|
|
|
|
5788
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5789
|
|
|
|
|
|
|
# Apply filter to value(s) if necessary |
5790
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) filter expression, 2) reference to value to filter |
5791
|
|
|
|
|
|
|
# Returns: true unless a filter returned undef; changes value if necessary |
5792
|
|
|
|
|
|
|
sub Filter($$$) |
5793
|
|
|
|
|
|
|
{ |
5794
|
13258
|
|
|
13258
|
1
|
20660
|
local $_; |
5795
|
13258
|
|
|
|
|
31135
|
my ($self, $filter, $valPt) = @_; |
5796
|
13258
|
100
|
66
|
|
|
44021
|
return 1 unless defined $filter and defined $$valPt; |
5797
|
462
|
|
|
|
|
651
|
my $rtnVal; |
5798
|
462
|
100
|
|
|
|
915
|
if (not ref $$valPt) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5799
|
446
|
|
|
|
|
778
|
$_ = $$valPt; |
5800
|
|
|
|
|
|
|
#### eval Filter ($_, $self) |
5801
|
446
|
|
|
|
|
23907
|
eval $filter; |
5802
|
446
|
50
|
|
|
|
1663
|
if (defined $_) { |
5803
|
446
|
|
|
|
|
858
|
$$valPt = $_; |
5804
|
446
|
|
|
|
|
636
|
$rtnVal = 1; |
5805
|
|
|
|
|
|
|
} |
5806
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'SCALAR') { |
5807
|
12
|
|
|
|
|
24
|
my $val = $$$valPt; # make a copy to avoid filtering twice |
5808
|
12
|
|
|
|
|
31
|
$rtnVal = $self->Filter($filter, \$val); |
5809
|
12
|
|
|
|
|
25
|
$$valPt = \$val; |
5810
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'ARRAY') { |
5811
|
4
|
|
|
|
|
6
|
my @val = @{$$valPt}; # make a copy to avoid filtering twice |
|
4
|
|
|
|
|
23
|
|
5812
|
4
|
|
50
|
|
|
15
|
$self->Filter($filter, \$_) and $rtnVal = 1 foreach @val; |
5813
|
4
|
|
|
|
|
9
|
$$valPt = \@val; |
5814
|
|
|
|
|
|
|
} elsif (ref $$valPt eq 'HASH') { |
5815
|
0
|
|
|
|
|
0
|
my %val = %{$$valPt}; # make a copy to avoid filtering twice |
|
0
|
|
|
|
|
0
|
|
5816
|
0
|
|
0
|
|
|
0
|
$self->Filter($filter, \$val{$_}) and $rtnVal = 1 foreach keys %val; |
5817
|
0
|
|
|
|
|
0
|
$$valPt = \%val; |
5818
|
|
|
|
|
|
|
} else { |
5819
|
0
|
|
|
|
|
0
|
$rtnVal = 1; |
5820
|
|
|
|
|
|
|
} |
5821
|
462
|
|
|
|
|
853
|
return $rtnVal; |
5822
|
|
|
|
|
|
|
} |
5823
|
|
|
|
|
|
|
|
5824
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5825
|
|
|
|
|
|
|
# Return printable value |
5826
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
5827
|
|
|
|
|
|
|
# 1) value to print, 2) line length limit (undef defaults to 60, 0=unlimited) |
5828
|
|
|
|
|
|
|
sub Printable($;$) |
5829
|
|
|
|
|
|
|
{ |
5830
|
593
|
|
|
593
|
0
|
1218
|
my ($self, $outStr, $maxLen) = @_; |
5831
|
593
|
50
|
|
|
|
1242
|
return '(undef)' unless defined $outStr; |
5832
|
593
|
|
|
|
|
1263
|
$outStr =~ tr/\x01-\x1f\x7f-\xff/./; |
5833
|
593
|
|
|
|
|
1711
|
$outStr =~ s/\x00//g; |
5834
|
593
|
|
|
|
|
1023
|
my $verbose = $$self{OPTIONS}{Verbose}; |
5835
|
593
|
50
|
|
|
|
1150
|
if ($verbose < 4) { |
5836
|
593
|
100
|
|
|
|
1113
|
if ($maxLen) { |
|
|
50
|
|
|
|
|
|
5837
|
592
|
50
|
|
|
|
1219
|
$maxLen = 20 if $maxLen < 20; # minimum length is 20 |
5838
|
|
|
|
|
|
|
} elsif (defined $maxLen) { |
5839
|
1
|
|
|
|
|
3
|
$maxLen = length $outStr; # 0 is unlimited |
5840
|
|
|
|
|
|
|
} else { |
5841
|
0
|
|
|
|
|
0
|
$maxLen = 60; # default maximum is 60 |
5842
|
|
|
|
|
|
|
} |
5843
|
|
|
|
|
|
|
} else { |
5844
|
0
|
|
|
|
|
0
|
$maxLen = length $outStr; |
5845
|
|
|
|
|
|
|
# limit to 2048 characters if verbose < 5 |
5846
|
0
|
0
|
0
|
|
|
0
|
$maxLen = 2048 if $maxLen > 2048 and $verbose < 5; |
5847
|
|
|
|
|
|
|
} |
5848
|
|
|
|
|
|
|
|
5849
|
|
|
|
|
|
|
# limit length if necessary |
5850
|
593
|
100
|
|
|
|
1193
|
$outStr = substr($outStr,0,$maxLen-6) . '[snip]' if length($outStr) > $maxLen; |
5851
|
593
|
|
|
|
|
2012
|
return $outStr; |
5852
|
|
|
|
|
|
|
} |
5853
|
|
|
|
|
|
|
|
5854
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5855
|
|
|
|
|
|
|
# Convert date/time from Exif format |
5856
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) Date/time in EXIF format |
5857
|
|
|
|
|
|
|
# Returns: Formatted date/time string |
5858
|
|
|
|
|
|
|
sub ConvertDateTime($$) |
5859
|
|
|
|
|
|
|
{ |
5860
|
1801
|
|
|
1801
|
0
|
4974
|
my ($self, $date) = @_; |
5861
|
1801
|
|
|
|
|
4539
|
my $fmt = $$self{OPTIONS}{DateFormat}; |
5862
|
1801
|
|
|
|
|
3434
|
my $shift = $$self{OPTIONS}{GlobalTimeShift}; |
5863
|
1801
|
100
|
|
|
|
4714
|
if ($shift) { |
5864
|
8
|
50
|
33
|
|
|
56
|
my $dir = ($shift =~ s/^([-+])// and $1 eq '-') ? -1 : 1; |
5865
|
8
|
|
|
|
|
18
|
my $offset = $$self{GLOBAL_TIME_OFFSET}; |
5866
|
8
|
100
|
|
|
|
20
|
$offset or $offset = $$self{GLOBAL_TIME_OFFSET} = { }; |
5867
|
8
|
|
|
|
|
30
|
ShiftTime($date, $shift, $dir, $offset); |
5868
|
|
|
|
|
|
|
} |
5869
|
|
|
|
|
|
|
# only convert date if a format was specified and the date is recognizable |
5870
|
1801
|
100
|
|
|
|
4170
|
if ($fmt) { |
5871
|
|
|
|
|
|
|
# separate time zone if it exists |
5872
|
5
|
|
|
|
|
8
|
my $tz; |
5873
|
5
|
100
|
|
|
|
40
|
$date =~ s/([-+]\d{2}:\d{2}|Z)$// and $tz = $1; |
5874
|
|
|
|
|
|
|
# a few cameras use incorrect date/time formatting: |
5875
|
|
|
|
|
|
|
# - slashes instead of colons in date (RolleiD330, ImpressCam) |
5876
|
|
|
|
|
|
|
# - date/time values separated by colon instead of space (Polariod, Sanyo, Sharp, Vivitar) |
5877
|
|
|
|
|
|
|
# - single-digit seconds with leading space (HP scanners) |
5878
|
5
|
|
|
|
|
41
|
my @a = reverse ($date =~ /\d+/g); # be very flexible about date/time format |
5879
|
5
|
50
|
33
|
|
|
46
|
if (@a and $a[-1] >= 1000 and $a[-1] < 3000 and eval { require POSIX }) { |
|
5
|
0
|
33
|
|
|
36
|
|
|
|
|
33
|
|
|
|
|
5880
|
5
|
|
|
|
|
19
|
shift @a while @a > 6; # remove superfluous entries |
5881
|
5
|
|
|
|
|
13
|
unshift @a, 1 while @a < 3; # add month and day if necessary |
5882
|
5
|
|
|
|
|
13
|
unshift @a, 0 while @a < 6; # add h,m,s if necessary |
5883
|
5
|
|
|
|
|
14
|
$a[4] -= 1; # base month is 1 |
5884
|
|
|
|
|
|
|
# parse our %f fractional seconds first (and round up seconds if necessary) |
5885
|
|
|
|
|
|
|
# - if there are multiple %f codes, they all get the same number of digits as the first |
5886
|
5
|
50
|
|
|
|
31
|
if ($fmt =~ /%(-?)\.?(\d*)f/) { |
5887
|
0
|
|
|
|
|
0
|
my ($neg, $dig) = ($1, $2); |
5888
|
0
|
0
|
|
|
|
0
|
my $frac = $date =~ /(\.\d+)/ ? $1 : ''; |
5889
|
0
|
0
|
|
|
|
0
|
if (not $frac) { |
|
|
0
|
|
|
|
|
|
5890
|
0
|
0
|
|
|
|
0
|
$frac = '.' . ('0' x $dig) if $dig; |
5891
|
|
|
|
|
|
|
} elsif (length $dig) { |
5892
|
0
|
0
|
|
|
|
0
|
if ($dig+1 > length($frac)) { |
|
|
0
|
|
|
|
|
|
5893
|
0
|
|
|
|
|
0
|
$frac .= '0' x ($dig+1-length($frac)); |
5894
|
|
|
|
|
|
|
} elsif ($dig+1 < length($frac)) { |
5895
|
0
|
|
|
|
|
0
|
$frac = sprintf("%.${dig}f", $frac); |
5896
|
0
|
|
0
|
|
|
0
|
while ($frac =~ s/^(\d)// and $1 ne '0') { |
5897
|
|
|
|
|
|
|
# this is a pain, but we must round up to the next second |
5898
|
0
|
0
|
|
|
|
0
|
++$a[0] < 60 and last; |
5899
|
0
|
|
|
|
|
0
|
$a[0] = 0; |
5900
|
0
|
0
|
|
|
|
0
|
++$a[1] < 60 and last; |
5901
|
0
|
|
|
|
|
0
|
$a[1] = 0; |
5902
|
0
|
0
|
|
|
|
0
|
++$a[2] < 24 and last; |
5903
|
0
|
|
|
|
|
0
|
$a[2] = 0; |
5904
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/Shift.pl'; |
5905
|
0
|
0
|
|
|
|
0
|
++$a[3] <= DaysInMonth($a[4]+1, $a[5]) and last; |
5906
|
0
|
|
|
|
|
0
|
$a[3] = 1; |
5907
|
0
|
0
|
|
|
|
0
|
++$a[4] < 12 and last; |
5908
|
0
|
|
|
|
|
0
|
$a[4] = 0; |
5909
|
0
|
|
|
|
|
0
|
++$a[5]; |
5910
|
0
|
|
|
|
|
0
|
last; # (this was a goto) |
5911
|
|
|
|
|
|
|
} |
5912
|
|
|
|
|
|
|
} |
5913
|
|
|
|
|
|
|
} |
5914
|
0
|
0
|
|
|
|
0
|
$neg and $frac =~ s/^\.//; |
5915
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%-?\.?\d*f/$1$2$frac/g; |
5916
|
|
|
|
|
|
|
} |
5917
|
|
|
|
|
|
|
# parse %z and %s ourself (to handle time zones properly) |
5918
|
5
|
50
|
|
|
|
17
|
if ($fmt =~ /%[sz]/) { |
5919
|
|
|
|
|
|
|
# use system time zone unless otherwise specified |
5920
|
0
|
0
|
0
|
|
|
0
|
$tz = TimeZoneString(\@a, TimeLocal(@a)) if not $tz and eval { require Time::Local }; |
|
0
|
|
|
|
|
0
|
|
5921
|
|
|
|
|
|
|
# remove colon, setting to UTC if time zone is not numeric |
5922
|
0
|
0
|
0
|
|
|
0
|
$tz = ($tz and $tz=~/^([-+]\d{2}):(\d{2})$/) ? "$1$2" : '+0000'; |
5923
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%z/$1$2$tz/g; # convert '%z' format codes |
5924
|
0
|
0
|
0
|
|
|
0
|
if ($fmt =~ /%s/ and eval { require Time::Local }) { |
|
0
|
|
|
|
|
0
|
|
5925
|
|
|
|
|
|
|
# calculate seconds since the Epoch, UTC |
5926
|
0
|
|
|
|
|
0
|
my $s = Time::Local::timegm(@a) - 60 * ($tz - int($tz/100) * 40); |
5927
|
0
|
|
|
|
|
0
|
$fmt =~ s/(^|[^%])((%%)*)%s/$1$2$s/g; # convert '%s' format codes |
5928
|
|
|
|
|
|
|
} |
5929
|
|
|
|
|
|
|
} |
5930
|
5
|
|
|
|
|
13
|
$a[5] -= 1900; # strftime year starts from 1900 |
5931
|
5
|
|
|
|
|
239
|
$date = POSIX::strftime($fmt, @a); # generate the formatted date/time |
5932
|
|
|
|
|
|
|
} elsif ($$self{OPTIONS}{StrictDate}) { |
5933
|
0
|
|
|
|
|
0
|
undef $date; |
5934
|
|
|
|
|
|
|
} |
5935
|
|
|
|
|
|
|
} |
5936
|
1801
|
|
|
|
|
11914
|
return $date; |
5937
|
|
|
|
|
|
|
} |
5938
|
|
|
|
|
|
|
|
5939
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5940
|
|
|
|
|
|
|
# Print conversion for time span value |
5941
|
|
|
|
|
|
|
# Inputs: 0) time ticks, 1) number of seconds per tick (default 1) |
5942
|
|
|
|
|
|
|
# Returns: readable time |
5943
|
|
|
|
|
|
|
sub ConvertTimeSpan($;$) |
5944
|
|
|
|
|
|
|
{ |
5945
|
3
|
|
|
3
|
0
|
16
|
my ($val, $mult) = @_; |
5946
|
3
|
50
|
33
|
|
|
20
|
if (Image::ExifTool::IsFloat($val) and $val != 0) { |
5947
|
3
|
100
|
|
|
|
17
|
$val *= $mult if $mult; |
5948
|
3
|
50
|
|
|
|
19
|
if ($val < 60) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
5949
|
0
|
|
|
|
|
0
|
$val = "$val seconds"; |
5950
|
|
|
|
|
|
|
} elsif ($val < 3600) { |
5951
|
3
|
100
|
66
|
|
|
17
|
my $fmt = ($mult and $mult >= 60) ? '%d' : '%.1f'; |
5952
|
3
|
100
|
66
|
|
|
16
|
my $s = ($val == 60 and $mult) ? '' : 's'; |
5953
|
3
|
|
|
|
|
32
|
$val = sprintf("$fmt minute$s", $val / 60); |
5954
|
|
|
|
|
|
|
} elsif ($val < 24 * 3600) { |
5955
|
0
|
|
|
|
|
0
|
$val = sprintf("%.1f hours", $val / 3600); |
5956
|
|
|
|
|
|
|
} else { |
5957
|
0
|
|
|
|
|
0
|
$val = sprintf("%.1f days", $val / (24 * 3600)); |
5958
|
|
|
|
|
|
|
} |
5959
|
|
|
|
|
|
|
} |
5960
|
3
|
|
|
|
|
24
|
return $val; |
5961
|
|
|
|
|
|
|
} |
5962
|
|
|
|
|
|
|
|
5963
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5964
|
|
|
|
|
|
|
# Patched timelocal() that fixes ActivePerl timezone bug |
5965
|
|
|
|
|
|
|
# Inputs/Returns: same as timelocal() |
5966
|
|
|
|
|
|
|
# Notes: must 'require Time::Local' before calling this routine. |
5967
|
|
|
|
|
|
|
# Also note that year should be full year, and not relative to 1900 as with localtime |
5968
|
|
|
|
|
|
|
sub TimeLocal(@) |
5969
|
|
|
|
|
|
|
{ |
5970
|
36
|
|
|
36
|
0
|
1659
|
my $tm = Time::Local::timelocal(@_); |
5971
|
36
|
50
|
|
|
|
3035
|
if ($^O eq 'MSWin32') { |
5972
|
|
|
|
|
|
|
# patch for ActivePerl timezone bug |
5973
|
0
|
|
|
|
|
0
|
my @t2 = localtime($tm); |
5974
|
0
|
|
|
|
|
0
|
my $t2 = Time::Local::timelocal(@t2); |
5975
|
|
|
|
|
|
|
# adjust timelocal() return value to be consistent with localtime() |
5976
|
0
|
|
|
|
|
0
|
$tm += $tm - $t2; |
5977
|
|
|
|
|
|
|
} |
5978
|
36
|
|
|
|
|
139
|
return $tm; |
5979
|
|
|
|
|
|
|
} |
5980
|
|
|
|
|
|
|
|
5981
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
5982
|
|
|
|
|
|
|
# Get time zone in minutes |
5983
|
|
|
|
|
|
|
# Inputs: 0) localtime array ref, 1) gmtime array ref |
5984
|
|
|
|
|
|
|
# Returns: time zone offset in minutes |
5985
|
|
|
|
|
|
|
sub GetTimeZone($$) |
5986
|
|
|
|
|
|
|
{ |
5987
|
942
|
|
|
942
|
0
|
2368
|
my ($tm, $gm) = @_; |
5988
|
|
|
|
|
|
|
# compute the number of minutes between localtime and gmtime |
5989
|
942
|
|
|
|
|
3466
|
my $min = $$tm[2] * 60 + $$tm[1] - ($$gm[2] * 60 + $$gm[1]); |
5990
|
942
|
50
|
|
|
|
2870
|
if ($$tm[3] != $$gm[3]) { |
5991
|
|
|
|
|
|
|
# account for case where one date wraps to the first of the next month |
5992
|
0
|
0
|
|
|
|
0
|
$$gm[3] = $$tm[3] - ($$tm[3]==1 ? 1 : -1) if abs($$tm[3]-$$gm[3]) != 1; |
|
|
0
|
|
|
|
|
|
5993
|
|
|
|
|
|
|
# adjust for the +/- one day difference |
5994
|
0
|
|
|
|
|
0
|
$min += ($$tm[3] - $$gm[3]) * 24 * 60; |
5995
|
|
|
|
|
|
|
} |
5996
|
|
|
|
|
|
|
# MirBSD patch to round to the nearest 30 minutes because |
5997
|
|
|
|
|
|
|
# it includes leap seconds in localtime but not gmtime |
5998
|
942
|
0
|
|
|
|
3809
|
$min = int($min / 30 + ($min > 0 ? 0.5 : -0.5)) * 30 if $^O eq 'mirbsd'; |
|
|
50
|
|
|
|
|
|
5999
|
942
|
|
|
|
|
2721
|
return $min; |
6000
|
|
|
|
|
|
|
} |
6001
|
|
|
|
|
|
|
|
6002
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6003
|
|
|
|
|
|
|
# Get time zone string |
6004
|
|
|
|
|
|
|
# Inputs: 0) time zone offset in minutes |
6005
|
|
|
|
|
|
|
# or 0) localtime array ref, 1) corresponding time value |
6006
|
|
|
|
|
|
|
# Returns: time zone string ("+/-HH:MM") |
6007
|
|
|
|
|
|
|
sub TimeZoneString($;$) |
6008
|
|
|
|
|
|
|
{ |
6009
|
983
|
|
|
983
|
0
|
2506
|
my $min = shift; |
6010
|
983
|
100
|
|
|
|
3524
|
if (ref $min) { |
6011
|
942
|
|
|
|
|
5189
|
my @gm = gmtime(shift); |
6012
|
942
|
|
|
|
|
3277
|
$min = GetTimeZone($min, \@gm); |
6013
|
|
|
|
|
|
|
} |
6014
|
983
|
|
|
|
|
2689
|
my $sign = '+'; |
6015
|
983
|
100
|
|
|
|
2629
|
$min < 0 and $sign = '-', $min = -$min; |
6016
|
983
|
|
|
|
|
2694
|
$min = int($min + 0.5); # round off to nearest minute |
6017
|
983
|
|
|
|
|
2361
|
my $h = int($min / 60); |
6018
|
983
|
|
|
|
|
5891
|
return sprintf('%s%.2d:%.2d', $sign, $h, $min - $h * 60); |
6019
|
|
|
|
|
|
|
} |
6020
|
|
|
|
|
|
|
|
6021
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6022
|
|
|
|
|
|
|
# Convert Unix time to EXIF date/time string |
6023
|
|
|
|
|
|
|
# Inputs: 0) Unix time value, 1) non-zero to convert to local time, |
6024
|
|
|
|
|
|
|
# 2) number of digits after the decimal for fractional seconds |
6025
|
|
|
|
|
|
|
# Returns: EXIF date/time string (with timezone for local times) |
6026
|
|
|
|
|
|
|
sub ConvertUnixTime($;$$) |
6027
|
|
|
|
|
|
|
{ |
6028
|
1045
|
|
|
1045
|
0
|
3446
|
my ($time, $toLocal, $dec) = @_; |
6029
|
1045
|
100
|
|
|
|
3166
|
return '0000:00:00 00:00:00' if $time == 0; |
6030
|
1044
|
|
|
|
|
1985
|
my (@tm, $tz); |
6031
|
1044
|
50
|
|
|
|
2510
|
if ($dec) { |
6032
|
0
|
|
|
|
|
0
|
my $frac = $time - int($time); |
6033
|
0
|
|
|
|
|
0
|
$time = int($time); |
6034
|
0
|
0
|
|
|
|
0
|
$frac < 0 and $frac += 1, $time -= 1; |
6035
|
0
|
|
|
|
|
0
|
$dec = sprintf('%.*f', $dec, $frac); |
6036
|
|
|
|
|
|
|
# remove number before decimal and increment integer time if it was rounded up |
6037
|
0
|
0
|
0
|
|
|
0
|
$dec =~ s/^(\d)// and $1 eq '1' and $time += 1; |
6038
|
|
|
|
|
|
|
} else { |
6039
|
1044
|
100
|
|
|
|
3098
|
$time = int($time + 1e-6) if $time != int($time); # avoid round-off errors |
6040
|
1044
|
|
|
|
|
2013
|
$dec = ''; |
6041
|
|
|
|
|
|
|
} |
6042
|
1044
|
100
|
|
|
|
2383
|
if ($toLocal) { |
6043
|
880
|
|
|
|
|
31070
|
@tm = localtime($time); |
6044
|
880
|
|
|
|
|
4506
|
$tz = TimeZoneString(\@tm, $time); |
6045
|
|
|
|
|
|
|
} else { |
6046
|
164
|
|
|
|
|
1072
|
@tm = gmtime($time); |
6047
|
164
|
|
|
|
|
354
|
$tz = ''; |
6048
|
|
|
|
|
|
|
} |
6049
|
1044
|
|
|
|
|
8066
|
my $str = sprintf("%4d:%.2d:%.2d %.2d:%.2d:%.2d$dec%s", |
6050
|
|
|
|
|
|
|
$tm[5]+1900, $tm[4]+1, $tm[3], $tm[2], $tm[1], $tm[0], $tz); |
6051
|
1044
|
|
|
|
|
9187
|
return $str; |
6052
|
|
|
|
|
|
|
} |
6053
|
|
|
|
|
|
|
|
6054
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6055
|
|
|
|
|
|
|
# Get Unix time from EXIF-formatted date/time string with optional timezone |
6056
|
|
|
|
|
|
|
# Inputs: 0) EXIF date/time string, 1) non-zero if time is local, or 2 to assume UTC |
6057
|
|
|
|
|
|
|
# Returns: Unix time (seconds since 0:00 GMT Jan 1, 1970) or undefined on error |
6058
|
|
|
|
|
|
|
sub GetUnixTime($;$) |
6059
|
|
|
|
|
|
|
{ |
6060
|
162
|
|
|
162
|
0
|
36634
|
my ($timeStr, $isLocal) = @_; |
6061
|
162
|
50
|
|
|
|
478
|
return 0 if $timeStr eq '0000:00:00 00:00:00'; |
6062
|
162
|
|
|
|
|
1150
|
my @tm = ($timeStr =~ /^(\d+)[-:](\d+)[-:](\d+)\s+(\d+):(\d+):(\d+)(.*)/); |
6063
|
162
|
50
|
|
|
|
562
|
return undef unless @tm == 7; |
6064
|
162
|
50
|
|
|
|
319
|
unless (eval { require Time::Local }) { |
|
162
|
|
|
|
|
6048
|
|
6065
|
0
|
|
|
|
|
0
|
warn "Time::Local is not installed\n"; |
6066
|
0
|
|
|
|
|
0
|
return undef; |
6067
|
|
|
|
|
|
|
} |
6068
|
162
|
|
|
|
|
20060
|
my ($tzStr, $tzSec) = (pop(@tm), 0); |
6069
|
|
|
|
|
|
|
# use specified timezone offset (if given) instead of local system time |
6070
|
|
|
|
|
|
|
# if we are converting a local time value |
6071
|
162
|
100
|
|
|
|
443
|
if ($isLocal) { |
6072
|
113
|
50
|
|
|
|
414
|
if ($tzStr =~ /(?:Z|([-+])(\d+):(\d+))/i) { |
|
|
0
|
|
|
|
|
|
6073
|
|
|
|
|
|
|
# use specified timezone if one exists |
6074
|
113
|
100
|
|
|
|
559
|
$tzSec = ($2 * 60 + $3) * ($1 eq '-' ? -60 : 60) if $1; |
|
|
100
|
|
|
|
|
|
6075
|
113
|
|
|
|
|
218
|
undef $isLocal; # convert using GMT corrected for specified timezone |
6076
|
|
|
|
|
|
|
} elsif ($isLocal eq '2') { |
6077
|
0
|
|
|
|
|
0
|
undef $isLocal; |
6078
|
|
|
|
|
|
|
} |
6079
|
|
|
|
|
|
|
} |
6080
|
162
|
|
|
|
|
387
|
$tm[1] -= 1; # convert month |
6081
|
162
|
|
|
|
|
329
|
@tm = reverse @tm; # change to order required by timelocal() |
6082
|
162
|
50
|
|
|
|
697
|
my $val = $isLocal ? TimeLocal(@tm) : Time::Local::timegm(@tm) - $tzSec; |
6083
|
|
|
|
|
|
|
# handle fractional seconds |
6084
|
160
|
100
|
100
|
|
|
5903
|
$val += $1 if $tzStr and $tzStr =~ /^(\.\d+)/; |
6085
|
160
|
|
|
|
|
1389
|
return $val; |
6086
|
|
|
|
|
|
|
} |
6087
|
|
|
|
|
|
|
|
6088
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6089
|
|
|
|
|
|
|
# Print conversion for file size |
6090
|
|
|
|
|
|
|
# Inputs: 0) file size in bytes |
6091
|
|
|
|
|
|
|
# Returns: converted file size |
6092
|
|
|
|
|
|
|
sub ConvertFileSize($) |
6093
|
|
|
|
|
|
|
{ |
6094
|
306
|
|
|
306
|
0
|
979
|
my $val = shift; |
6095
|
306
|
100
|
|
|
|
1440
|
$val < 2000 and return "$val bytes"; |
6096
|
198
|
100
|
|
|
|
2080
|
$val < 10000 and return sprintf('%.1f kB', $val / 1000); |
6097
|
51
|
100
|
|
|
|
513
|
$val < 2000000 and return sprintf('%.0f kB', $val / 1000); |
6098
|
4
|
100
|
|
|
|
47
|
$val < 10000000 and return sprintf('%.1f MB', $val / 1000000); |
6099
|
1
|
50
|
|
|
|
10
|
$val < 2000000000 and return sprintf('%.0f MB', $val / 1000000); |
6100
|
0
|
0
|
|
|
|
0
|
$val < 10000000000 and return sprintf('%.1f GB', $val / 1000000000); |
6101
|
0
|
|
|
|
|
0
|
return sprintf('%.0f GB', $val / 1000000000); |
6102
|
|
|
|
|
|
|
} |
6103
|
|
|
|
|
|
|
|
6104
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6105
|
|
|
|
|
|
|
# Convert seconds to duration string (handles negative durations) |
6106
|
|
|
|
|
|
|
# Inputs: 0) floating point seconds |
6107
|
|
|
|
|
|
|
# Returns: duration string in form "S.SS s", "H:MM:SS" or "DD days HH:MM:SS" |
6108
|
|
|
|
|
|
|
sub ConvertDuration($) |
6109
|
|
|
|
|
|
|
{ |
6110
|
130
|
|
|
130
|
0
|
319
|
my $time = shift; |
6111
|
130
|
50
|
|
|
|
402
|
return $time unless IsFloat($time); |
6112
|
130
|
100
|
|
|
|
777
|
return '0 s' if $time == 0; |
6113
|
61
|
50
|
|
|
|
206
|
my $sign = ($time > 0 ? '' : (($time = -$time), '-')); |
6114
|
61
|
100
|
|
|
|
835
|
return sprintf("$sign%.2f s", $time) if $time < 30; |
6115
|
4
|
|
|
|
|
24
|
$time += 0.5; # to round off to nearest second |
6116
|
4
|
|
|
|
|
14
|
my $h = int($time / 3600); |
6117
|
4
|
|
|
|
|
11
|
$time -= $h * 3600; |
6118
|
4
|
|
|
|
|
8
|
my $m = int($time / 60); |
6119
|
4
|
|
|
|
|
9
|
$time -= $m * 60; |
6120
|
4
|
50
|
|
|
|
13
|
if ($h > 24) { |
6121
|
0
|
|
|
|
|
0
|
my $d = int($h / 24); |
6122
|
0
|
|
|
|
|
0
|
$h -= $d * 24; |
6123
|
0
|
|
|
|
|
0
|
$sign = "$sign$d days "; |
6124
|
|
|
|
|
|
|
} |
6125
|
4
|
|
|
|
|
45
|
return sprintf("$sign%d:%.2d:%.2d", $h, $m, int($time)); |
6126
|
|
|
|
|
|
|
} |
6127
|
|
|
|
|
|
|
|
6128
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6129
|
|
|
|
|
|
|
# Print conversion for bitrate values |
6130
|
|
|
|
|
|
|
# Inputs: 0) bitrate in bits per second |
6131
|
|
|
|
|
|
|
# Returns: human-readable bitrate string |
6132
|
|
|
|
|
|
|
# Notes: returns input value without formatting if it isn't numerical |
6133
|
|
|
|
|
|
|
sub ConvertBitrate($) |
6134
|
|
|
|
|
|
|
{ |
6135
|
20
|
|
|
20
|
0
|
61
|
my $bitrate = shift; |
6136
|
20
|
50
|
|
|
|
62
|
IsFloat($bitrate) or return $bitrate; |
6137
|
20
|
|
|
|
|
87
|
my @units = ('bps', 'kbps', 'Mbps', 'Gbps'); |
6138
|
20
|
|
|
|
|
52
|
for (;;) { |
6139
|
38
|
|
|
|
|
75
|
my $units = shift @units; |
6140
|
38
|
100
|
66
|
|
|
262
|
$bitrate >= 1000 and @units and $bitrate /= 1000, next; |
6141
|
20
|
100
|
|
|
|
92
|
my $fmt = $bitrate < 100 ? '%.3g' : '%.0f'; |
6142
|
20
|
|
|
|
|
284
|
return sprintf("$fmt $units", $bitrate); |
6143
|
|
|
|
|
|
|
} |
6144
|
|
|
|
|
|
|
} |
6145
|
|
|
|
|
|
|
|
6146
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6147
|
|
|
|
|
|
|
# Convert file name for printing |
6148
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in CharsetFileName character set |
6149
|
|
|
|
|
|
|
# Returns: converted file name in external character set |
6150
|
|
|
|
|
|
|
sub ConvertFileName($$) |
6151
|
|
|
|
|
|
|
{ |
6152
|
972
|
|
|
972
|
0
|
3228
|
my ($self, $val) = @_; |
6153
|
972
|
|
|
|
|
2663
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
6154
|
972
|
50
|
|
|
|
2903
|
$val = $self->Decode($val, $enc) if $enc; |
6155
|
972
|
|
|
|
|
7854
|
return $val; |
6156
|
|
|
|
|
|
|
} |
6157
|
|
|
|
|
|
|
|
6158
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6159
|
|
|
|
|
|
|
# Inverse conversion for file name (encode in CharsetFileName) |
6160
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) file name in external character set |
6161
|
|
|
|
|
|
|
# Returns: file name in CharsetFileName character set |
6162
|
|
|
|
|
|
|
sub InverseFileName($$) |
6163
|
|
|
|
|
|
|
{ |
6164
|
1
|
|
|
1
|
0
|
6
|
my ($self, $val) = @_; |
6165
|
1
|
|
|
|
|
4
|
my $enc = $$self{OPTIONS}{CharsetFileName}; |
6166
|
1
|
50
|
|
|
|
7
|
$val = $self->Encode($val, $enc) if $enc; |
6167
|
1
|
|
|
|
|
4
|
$val =~ tr/\\/\//; # make sure we are using forward slashes |
6168
|
1
|
|
|
|
|
9
|
return $val; |
6169
|
|
|
|
|
|
|
} |
6170
|
|
|
|
|
|
|
|
6171
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6172
|
|
|
|
|
|
|
# Save information for HTML dump |
6173
|
|
|
|
|
|
|
# Inputs: 0) ExifTool hash ref, 1) start offset, 2) data size |
6174
|
|
|
|
|
|
|
# 3) comment string, 4) tool tip (or SAME), 5) flags, 6) IFD name |
6175
|
|
|
|
|
|
|
sub HDump($$$$;$$$) |
6176
|
|
|
|
|
|
|
{ |
6177
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
6178
|
0
|
0
|
|
|
|
0
|
$$self{HTML_DUMP} or return; |
6179
|
0
|
|
|
|
|
0
|
my ($pos, $len, $com, $tip, $flg, $ifd) = @_; |
6180
|
0
|
0
|
|
|
|
0
|
$pos += $$self{BASE} if $$self{BASE}; |
6181
|
|
|
|
|
|
|
# skip structural data blocks which have been removed from the middle of this dump |
6182
|
|
|
|
|
|
|
# (SkipData list contains ordered [start,end+1] offsets to skip) |
6183
|
0
|
0
|
|
|
|
0
|
if ($$self{SkipData}) { |
6184
|
0
|
|
|
|
|
0
|
my $end = $pos + $len; |
6185
|
0
|
|
|
|
|
0
|
my $skip; |
6186
|
0
|
|
|
|
|
0
|
foreach $skip (@{$$self{SkipData}}) { |
|
0
|
|
|
|
|
0
|
|
6187
|
0
|
0
|
|
|
|
0
|
$end <= $$skip[0] and last; |
6188
|
0
|
0
|
|
|
|
0
|
$pos >= $$skip[1] and $pos += $$skip[1] - $$skip[0], next; |
6189
|
0
|
0
|
|
|
|
0
|
if ($pos != $$skip[0]) { |
6190
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->Add($pos, $$skip[0]-$pos, $com, $tip, $flg, $ifd); |
6191
|
0
|
|
|
|
|
0
|
$len -= $$skip[0] - $pos; |
6192
|
0
|
|
|
|
|
0
|
$tip = 'SAME'; |
6193
|
|
|
|
|
|
|
} |
6194
|
0
|
|
|
|
|
0
|
$pos = $$skip[1]; |
6195
|
|
|
|
|
|
|
} |
6196
|
|
|
|
|
|
|
} |
6197
|
0
|
|
|
|
|
0
|
$$self{HTML_DUMP}->Add($pos, $len, $com, $tip, $flg, $ifd); |
6198
|
|
|
|
|
|
|
} |
6199
|
|
|
|
|
|
|
|
6200
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6201
|
|
|
|
|
|
|
# Identify trailer ending at specified offset from end of file |
6202
|
|
|
|
|
|
|
# Inputs: 0) RAF reference, 1) offset from end of file (0 by default) |
6203
|
|
|
|
|
|
|
# Returns: Trailer info hash (with RAF and DirName set), |
6204
|
|
|
|
|
|
|
# or undef if no recognized trailer was found |
6205
|
|
|
|
|
|
|
# Notes: leaves file position unchanged |
6206
|
|
|
|
|
|
|
sub IdentifyTrailer($;$) |
6207
|
|
|
|
|
|
|
{ |
6208
|
580
|
|
|
580
|
0
|
1237
|
my $raf = shift; |
6209
|
580
|
|
100
|
|
|
2218
|
my $offset = shift || 0; |
6210
|
580
|
|
|
|
|
2056
|
my $pos = $raf->Tell(); |
6211
|
580
|
|
|
|
|
1747
|
my ($buff, $type, $len); |
6212
|
580
|
|
33
|
|
|
2558
|
while ($raf->Seek(-$offset, 2) and ($len = $raf->Tell()) > 0) { |
6213
|
|
|
|
|
|
|
# read up to 64 bytes before specified offset from end of file |
6214
|
580
|
50
|
|
|
|
2638
|
$len = 64 if $len > 64; |
6215
|
580
|
50
|
33
|
|
|
2024
|
$raf->Seek(-$len, 1) and $raf->Read($buff, $len) == $len or last; |
6216
|
580
|
100
|
66
|
|
|
12658
|
if ($buff =~ /AXS(!|\*).{8}$/s) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6217
|
29
|
|
|
|
|
122
|
$type = 'AFCP'; |
6218
|
|
|
|
|
|
|
} elsif ($buff =~ /\xa1\xb2\xc3\xd4$/) { |
6219
|
29
|
|
|
|
|
138
|
$type = 'FotoStation'; |
6220
|
|
|
|
|
|
|
} elsif ($buff =~ /cbipcbbl$/) { |
6221
|
34
|
|
|
|
|
167
|
$type = 'PhotoMechanic'; |
6222
|
|
|
|
|
|
|
} elsif ($buff =~ /^CANON OPTIONAL DATA\0/) { |
6223
|
41
|
|
|
|
|
160
|
$type = 'CanonVRD'; |
6224
|
|
|
|
|
|
|
} elsif ($buff =~ /~\0\x04\0zmie~\0\0\x06.{4}[\x10\x18]\x04$/s or |
6225
|
|
|
|
|
|
|
$buff =~ /~\0\x04\0zmie~\0\0\x0a.{8}[\x10\x18]\x08$/s) |
6226
|
|
|
|
|
|
|
{ |
6227
|
26
|
|
|
|
|
103
|
$type = 'MIE'; |
6228
|
|
|
|
|
|
|
} elsif ($buff =~ /\0\0(QDIOBS|SEFT)$/) { |
6229
|
26
|
|
|
|
|
109
|
$type = 'Samsung'; |
6230
|
|
|
|
|
|
|
} elsif ($buff =~ /8db42d694ccc418790edff439fe026bf$/s) { |
6231
|
0
|
|
|
|
|
0
|
$type = 'Insta360'; |
6232
|
|
|
|
|
|
|
} elsif ($buff =~ m(\0{6}/NIKON APP$)) { |
6233
|
0
|
|
|
|
|
0
|
$type = 'NikonApp'; |
6234
|
|
|
|
|
|
|
} |
6235
|
580
|
|
|
|
|
1347
|
last; |
6236
|
|
|
|
|
|
|
} |
6237
|
580
|
|
|
|
|
2382
|
$raf->Seek($pos, 0); # restore original file position |
6238
|
580
|
100
|
|
|
|
4059
|
return $type ? { RAF => $raf, DirName => $type } : undef; |
6239
|
|
|
|
|
|
|
} |
6240
|
|
|
|
|
|
|
|
6241
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6242
|
|
|
|
|
|
|
# Read/rewrite trailer information (including multiple trailers) |
6243
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) DirInfo ref: |
6244
|
|
|
|
|
|
|
# - requires RAF and DirName |
6245
|
|
|
|
|
|
|
# - OutFile is a scalar reference for writing |
6246
|
|
|
|
|
|
|
# - scans from current file position if ScanForAFCP is set |
6247
|
|
|
|
|
|
|
# Returns: 1 if trailer was processed or couldn't be processed (or written OK) |
6248
|
|
|
|
|
|
|
# 0 if trailer was recognized but offsets need fixing (or write error) |
6249
|
|
|
|
|
|
|
# - DirName, DirLen, DataPos, Offset, Fixup and OutFile are updated |
6250
|
|
|
|
|
|
|
# - preserves current file position and byte order |
6251
|
|
|
|
|
|
|
sub ProcessTrailers($$) |
6252
|
|
|
|
|
|
|
{ |
6253
|
57
|
|
|
57
|
0
|
200
|
my ($self, $dirInfo) = @_; |
6254
|
57
|
|
|
|
|
178
|
my $dirName = $$dirInfo{DirName}; |
6255
|
57
|
|
|
|
|
150
|
my $outfile = $$dirInfo{OutFile}; |
6256
|
57
|
|
50
|
|
|
346
|
my $offset = $$dirInfo{Offset} || 0; |
6257
|
57
|
|
|
|
|
137
|
my $fixup = $$dirInfo{Fixup}; |
6258
|
57
|
|
|
|
|
892
|
my $raf = $$dirInfo{RAF}; |
6259
|
57
|
|
|
|
|
226
|
my $pos = $raf->Tell(); |
6260
|
57
|
|
|
|
|
258
|
my $byteOrder = GetByteOrder(); |
6261
|
57
|
|
|
|
|
185
|
my $success = 1; |
6262
|
57
|
|
|
|
|
199
|
my $path = $$self{PATH}; |
6263
|
|
|
|
|
|
|
|
6264
|
57
|
|
|
|
|
119
|
for (;;) { # loop through all trailers |
6265
|
185
|
|
|
|
|
413
|
my ($proc, $outBuff); |
6266
|
185
|
50
|
|
|
|
713
|
if ($dirName eq 'Insta360') { |
|
|
50
|
|
|
|
|
|
6267
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/QuickTimeStream.pl'; |
6268
|
0
|
|
|
|
|
0
|
$proc = 'Image::ExifTool::QuickTime::ProcessInsta360'; |
6269
|
|
|
|
|
|
|
} elsif ($dirName eq 'NikonApp') { |
6270
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Nikon; |
6271
|
0
|
|
|
|
|
0
|
$proc = 'Image::ExifTool::Nikon::ProcessNikonApp'; |
6272
|
|
|
|
|
|
|
} else { |
6273
|
185
|
|
|
|
|
16470
|
require "Image/ExifTool/$dirName.pm"; |
6274
|
185
|
|
|
|
|
671
|
$proc = "Image::ExifTool::${dirName}::Process$dirName"; |
6275
|
|
|
|
|
|
|
} |
6276
|
185
|
100
|
|
|
|
573
|
if ($outfile) { |
6277
|
|
|
|
|
|
|
# write to local buffer so we can add trailer in proper order later |
6278
|
50
|
100
|
|
|
|
216
|
$$outfile and $$dirInfo{OutFile} = \$outBuff, $outBuff = ''; |
6279
|
|
|
|
|
|
|
# must generate new fixup if necessary so we can shift |
6280
|
|
|
|
|
|
|
# the old fixup separately after we prepend this trailer |
6281
|
50
|
|
|
|
|
113
|
delete $$dirInfo{Fixup}; |
6282
|
|
|
|
|
|
|
} |
6283
|
185
|
|
|
|
|
363
|
delete $$dirInfo{DirLen}; # reset trailer length |
6284
|
185
|
|
|
|
|
411
|
$$dirInfo{Offset} = $offset; # set offset from end of file |
6285
|
185
|
|
|
|
|
366
|
$$dirInfo{Trailer} = 1; # set Trailer flag in case proc cares |
6286
|
|
|
|
|
|
|
# add trailer and DirName to SubDirectory PATH |
6287
|
185
|
|
|
|
|
453
|
push @$path, 'Trailer', $dirName; |
6288
|
|
|
|
|
|
|
|
6289
|
|
|
|
|
|
|
# read or write this trailer |
6290
|
|
|
|
|
|
|
# (proc takes Offset as positive offset from end of trailer to end of file, |
6291
|
|
|
|
|
|
|
# and returns DataPos and DirLen, and Fixup if applicable, and updates |
6292
|
|
|
|
|
|
|
# OutFile when writing) |
6293
|
106
|
|
|
106
|
|
1149
|
no strict 'refs'; |
|
106
|
|
|
|
|
307
|
|
|
106
|
|
|
|
|
5657
|
|
6294
|
185
|
|
|
|
|
2639
|
my $result = &$proc($self, $dirInfo); |
6295
|
106
|
|
|
106
|
|
791
|
use strict 'refs'; |
|
106
|
|
|
|
|
292
|
|
|
106
|
|
|
|
|
1513292
|
|
6296
|
|
|
|
|
|
|
|
6297
|
|
|
|
|
|
|
# restore PATH (pop last 2 items) |
6298
|
185
|
|
|
|
|
578
|
splice @$path, -2; |
6299
|
|
|
|
|
|
|
|
6300
|
|
|
|
|
|
|
# check result |
6301
|
185
|
100
|
|
|
|
681
|
if ($outfile) { |
|
|
50
|
|
|
|
|
|
6302
|
50
|
50
|
|
|
|
142
|
if ($result > 0) { |
6303
|
50
|
100
|
|
|
|
135
|
if ($outBuff) { |
6304
|
|
|
|
|
|
|
# write trailers to OutFile in original order |
6305
|
33
|
|
|
|
|
285
|
$$outfile = $outBuff . $$outfile; |
6306
|
|
|
|
|
|
|
# must adjust old fixup start if it exists |
6307
|
33
|
50
|
|
|
|
158
|
$$fixup{Start} += length($outBuff) if $fixup; |
6308
|
33
|
|
|
|
|
67
|
$outBuff = ''; # free memory |
6309
|
|
|
|
|
|
|
} |
6310
|
50
|
100
|
|
|
|
166
|
if ($$dirInfo{Fixup}) { |
6311
|
15
|
100
|
|
|
|
59
|
if ($fixup) { |
6312
|
|
|
|
|
|
|
# add fixup for subsequent trailers to the fixup for this trailer |
6313
|
|
|
|
|
|
|
# (but first we must adjust for the new start position) |
6314
|
7
|
|
|
|
|
21
|
$$fixup{Shift} += $$dirInfo{Fixup}{Start}; |
6315
|
7
|
|
|
|
|
21
|
$$fixup{Start} -= $$dirInfo{Fixup}{Start}; |
6316
|
7
|
|
|
|
|
45
|
$$dirInfo{Fixup}->AddFixup($fixup); |
6317
|
|
|
|
|
|
|
} |
6318
|
15
|
|
|
|
|
52
|
$fixup = $$dirInfo{Fixup}; # save fixup |
6319
|
|
|
|
|
|
|
} |
6320
|
|
|
|
|
|
|
} else { |
6321
|
0
|
0
|
|
|
|
0
|
$success = 0 if $self->Error("Error rewriting $dirName trailer", 2); |
6322
|
0
|
|
|
|
|
0
|
last; |
6323
|
|
|
|
|
|
|
} |
6324
|
|
|
|
|
|
|
} elsif ($result < 0) { |
6325
|
|
|
|
|
|
|
# can't continue if we must scan for this trailer |
6326
|
0
|
|
|
|
|
0
|
$success = 0; |
6327
|
0
|
|
|
|
|
0
|
last; |
6328
|
|
|
|
|
|
|
} |
6329
|
185
|
50
|
33
|
|
|
979
|
last unless $result > 0 and $$dirInfo{DirLen}; |
6330
|
|
|
|
|
|
|
# look for next trailer |
6331
|
185
|
|
|
|
|
400
|
$offset += $$dirInfo{DirLen}; |
6332
|
185
|
100
|
|
|
|
612
|
my $nextTrail = IdentifyTrailer($raf, $offset) or last; |
6333
|
128
|
|
|
|
|
356
|
$dirName = $$dirInfo{DirName} = $$nextTrail{DirName}; |
6334
|
128
|
|
|
|
|
408
|
$raf->Seek($pos, 0); |
6335
|
|
|
|
|
|
|
} |
6336
|
57
|
|
|
|
|
323
|
SetByteOrder($byteOrder); # restore original byte order |
6337
|
57
|
|
|
|
|
470
|
$raf->Seek($pos, 0); # restore original file position |
6338
|
57
|
|
|
|
|
291
|
$$dirInfo{OutFile} = $outfile; # restore original outfile |
6339
|
57
|
|
|
|
|
221
|
$$dirInfo{Offset} = $offset; # return offset from EOF to start of first trailer |
6340
|
57
|
|
|
|
|
265
|
$$dirInfo{Fixup} = $fixup; # return fixup information |
6341
|
57
|
|
|
|
|
400
|
return $success; |
6342
|
|
|
|
|
|
|
} |
6343
|
|
|
|
|
|
|
|
6344
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6345
|
|
|
|
|
|
|
# JPEG constants |
6346
|
|
|
|
|
|
|
|
6347
|
|
|
|
|
|
|
# JPEG marker names |
6348
|
|
|
|
|
|
|
%jpegMarker = ( |
6349
|
|
|
|
|
|
|
0x00 => 'NULL', |
6350
|
|
|
|
|
|
|
0x01 => 'TEM', |
6351
|
|
|
|
|
|
|
0xc0 => 'SOF0', # to SOF15, with a few exceptions below |
6352
|
|
|
|
|
|
|
0xc4 => 'DHT', |
6353
|
|
|
|
|
|
|
0xc8 => 'JPGA', |
6354
|
|
|
|
|
|
|
0xcc => 'DAC', |
6355
|
|
|
|
|
|
|
0xd0 => 'RST0', # to RST7 |
6356
|
|
|
|
|
|
|
0xd8 => 'SOI', |
6357
|
|
|
|
|
|
|
0xd9 => 'EOI', |
6358
|
|
|
|
|
|
|
0xda => 'SOS', |
6359
|
|
|
|
|
|
|
0xdb => 'DQT', |
6360
|
|
|
|
|
|
|
0xdc => 'DNL', |
6361
|
|
|
|
|
|
|
0xdd => 'DRI', |
6362
|
|
|
|
|
|
|
0xde => 'DHP', |
6363
|
|
|
|
|
|
|
0xdf => 'EXP', |
6364
|
|
|
|
|
|
|
0xe0 => 'APP0', # to APP15 |
6365
|
|
|
|
|
|
|
0xf0 => 'JPG0', |
6366
|
|
|
|
|
|
|
0xfe => 'COM', |
6367
|
|
|
|
|
|
|
); |
6368
|
|
|
|
|
|
|
|
6369
|
|
|
|
|
|
|
# lookup for size of JPEG marker length word |
6370
|
|
|
|
|
|
|
# (2 bytes assumed unless specified here) |
6371
|
|
|
|
|
|
|
my %markerLenBytes = ( |
6372
|
|
|
|
|
|
|
0x00 => 0, 0x01 => 0, |
6373
|
|
|
|
|
|
|
0xd0 => 0, 0xd1 => 0, 0xd2 => 0, 0xd3 => 0, 0xd4 => 0, 0xd5 => 0, 0xd6 => 0, 0xd7 => 0, |
6374
|
|
|
|
|
|
|
0xd8 => 0, 0xd9 => 0, 0xda => 0, |
6375
|
|
|
|
|
|
|
# J2C |
6376
|
|
|
|
|
|
|
0x30 => 0, 0x31 => 0, 0x32 => 0, 0x33 => 0, 0x34 => 0, 0x35 => 0, 0x36 => 0, 0x37 => 0, |
6377
|
|
|
|
|
|
|
0x38 => 0, 0x39 => 0, 0x3a => 0, 0x3b => 0, 0x3c => 0, 0x3d => 0, 0x3e => 0, 0x3f => 0, |
6378
|
|
|
|
|
|
|
0x4f => 0, |
6379
|
|
|
|
|
|
|
0x92 => 0, 0x93 => 0, |
6380
|
|
|
|
|
|
|
# J2C extensions |
6381
|
|
|
|
|
|
|
0x74 => 4, 0x75 => 4, 0x77 => 4, |
6382
|
|
|
|
|
|
|
); |
6383
|
|
|
|
|
|
|
|
6384
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6385
|
|
|
|
|
|
|
# Get JPEG marker name |
6386
|
|
|
|
|
|
|
# Inputs: 0) Jpeg number |
6387
|
|
|
|
|
|
|
# Returns: marker name |
6388
|
|
|
|
|
|
|
sub JpegMarkerName($) |
6389
|
|
|
|
|
|
|
{ |
6390
|
3136
|
|
|
3136
|
0
|
5862
|
my $marker = shift; |
6391
|
3136
|
|
|
|
|
8306
|
my $markerName = $jpegMarker{$marker}; |
6392
|
3136
|
100
|
|
|
|
6611
|
unless ($markerName) { |
6393
|
1178
|
|
|
|
|
3451
|
$markerName = $jpegMarker{$marker & 0xf0}; |
6394
|
1178
|
50
|
33
|
|
|
8886
|
if ($markerName and $markerName =~ /^([A-Z]+)\d+$/) { |
6395
|
1178
|
|
|
|
|
4447
|
$markerName = $1 . ($marker & 0x0f); |
6396
|
|
|
|
|
|
|
} else { |
6397
|
0
|
|
|
|
|
0
|
$markerName = sprintf("marker 0x%.2x", $marker); |
6398
|
|
|
|
|
|
|
} |
6399
|
|
|
|
|
|
|
} |
6400
|
3136
|
|
|
|
|
7711
|
return $markerName; |
6401
|
|
|
|
|
|
|
} |
6402
|
|
|
|
|
|
|
|
6403
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6404
|
|
|
|
|
|
|
# Adjust directory start position |
6405
|
|
|
|
|
|
|
# Inputs: 0) dirInfo ref, 1) start offset |
6406
|
|
|
|
|
|
|
# 2) Base for offsets (relative to DataPos, defaults to absolute Base of 0) |
6407
|
|
|
|
|
|
|
sub DirStart($$;$) |
6408
|
|
|
|
|
|
|
{ |
6409
|
574
|
|
|
574
|
0
|
1544
|
my ($dirInfo, $start, $base) = @_; |
6410
|
574
|
|
|
|
|
1284
|
$$dirInfo{DirStart} = $start; |
6411
|
574
|
|
|
|
|
1227
|
$$dirInfo{DirLen} -= $start; |
6412
|
574
|
100
|
|
|
|
1810
|
if (defined $base) { |
6413
|
275
|
|
|
|
|
801
|
$$dirInfo{Base} = $$dirInfo{DataPos} + $base; |
6414
|
275
|
|
|
|
|
709
|
$$dirInfo{DataPos} = -$base; # (relative to Base!) |
6415
|
|
|
|
|
|
|
} |
6416
|
|
|
|
|
|
|
} |
6417
|
|
|
|
|
|
|
|
6418
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
6419
|
|
|
|
|
|
|
# Extract metadata from a jpg image |
6420
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set |
6421
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG file |
6422
|
|
|
|
|
|
|
sub ProcessJPEG($$) |
6423
|
|
|
|
|
|
|
{ |
6424
|
246
|
|
|
246
|
0
|
615
|
local $_; |
6425
|
246
|
|
|
|
|
788
|
my ($self, $dirInfo) = @_; |
6426
|
246
|
|
|
|
|
773
|
my $options = $$self{OPTIONS}; |
6427
|
246
|
|
|
|
|
692
|
my $verbose = $$options{Verbose}; |
6428
|
246
|
|
|
|
|
643
|
my $out = $$options{TextOut}; |
6429
|
246
|
|
100
|
|
|
1415
|
my $fast = $$options{FastScan} || 0; |
6430
|
246
|
|
|
|
|
645
|
my $raf = $$dirInfo{RAF}; |
6431
|
246
|
|
|
|
|
624
|
my $req = $$self{REQ_TAG_LOOKUP}; |
6432
|
246
|
|
|
|
|
585
|
my $htmlDump = $$self{HTML_DUMP}; |
6433
|
246
|
|
|
|
|
970
|
my %dumpParms = ( Out => $out ); |
6434
|
246
|
|
|
|
|
1805
|
my ($ch, $s, $length, $md5, $md5size); |
6435
|
246
|
|
|
|
|
0
|
my ($success, $wantTrailer, $trailInfo, $foundSOS, %jumbfChunk); |
6436
|
246
|
|
|
|
|
0
|
my (@iccChunk, $iccChunkCount, $iccChunksTotal, @flirChunk, $flirCount, $flirTotal); |
6437
|
246
|
|
|
|
|
0
|
my ($preview, $scalado, @dqt, $subSampling, $dumpEnd, %extendedXMP); |
6438
|
|
|
|
|
|
|
|
6439
|
|
|
|
|
|
|
# get pointer to MD5 object if it exists and we are the top-level JPEG |
6440
|
246
|
100
|
100
|
|
|
1834
|
if ($$self{FILE_TYPE} eq 'JPEG' and not $$self{DOC_NUM}) { |
6441
|
236
|
|
|
|
|
610
|
$md5 = $$self{ImageDataMD5}; |
6442
|
236
|
|
|
|
|
557
|
$md5size = 0; |
6443
|
|
|
|
|
|
|
} |
6444
|
|
|
|
|
|
|
|
6445
|
|
|
|
|
|
|
# check to be sure this is a valid JPG (or J2C, or EXV) file |
6446
|
246
|
50
|
33
|
|
|
1074
|
return 0 unless $raf->Read($s, 2) == 2 and $s =~ /^\xff[\xd8\x4f\x01]/; |
6447
|
246
|
100
|
|
|
|
2193
|
if ($s eq "\xff\x01") { |
6448
|
2
|
50
|
33
|
|
|
8
|
return 0 unless $raf->Read($s, 5) == 5 and $s eq 'Exiv2'; |
6449
|
2
|
|
|
|
|
7
|
$$self{FILE_TYPE} = 'EXV'; |
6450
|
|
|
|
|
|
|
} |
6451
|
246
|
|
|
|
|
621
|
my $appBytes = 0; |
6452
|
246
|
|
|
|
|
630
|
my $calcImageLen = $$req{jpegimagelength}; |
6453
|
246
|
50
|
66
|
|
|
1564
|
if ($$options{RequestAll} and $$options{RequestAll} > 2) { |
6454
|
0
|
|
|
|
|
0
|
$calcImageLen = 1; |
6455
|
|
|
|
|
|
|
} |
6456
|
246
|
100
|
66
|
|
|
1333
|
if (not $$self{VALUE}{FileType} or ($$self{DOC_NUM} and $$options{ExtractEmbedded})) { |
|
|
|
66
|
|
|
|
|
6457
|
238
|
|
|
|
|
1387
|
$self->SetFileType(); # set FileType tag |
6458
|
238
|
100
|
|
|
|
1595
|
return 1 if $fast == 3; # don't process file when FastScan == 3 |
6459
|
237
|
|
|
|
|
1236
|
$$self{LOW_PRIORITY_DIR}{IFD1} = 1; # lower priority of IFD1 tags |
6460
|
|
|
|
|
|
|
} |
6461
|
245
|
100
|
|
|
|
1262
|
$$raf{NoBuffer} = 1 if $self->Options('FastScan'); # disable buffering in FastScan mode |
6462
|
|
|
|
|
|
|
|
6463
|
245
|
50
|
|
|
|
1812
|
$dumpParms{MaxLen} = 128 if $verbose < 4; |
6464
|
245
|
50
|
|
|
|
883
|
if ($htmlDump) { |
6465
|
0
|
|
|
|
|
0
|
$dumpEnd = $raf->Tell(); |
6466
|
0
|
0
|
|
|
|
0
|
my ($n, $t, $m) = $s eq 'Exiv2' ? (7,'EXV','TEM') : (2,'JPEG','SOI'); |
6467
|
0
|
|
|
|
|
0
|
my $pos = $dumpEnd - $n; |
6468
|
0
|
0
|
|
|
|
0
|
$self->HDump(0, $pos, '[unknown header]') if $pos; |
6469
|
0
|
|
|
|
|
0
|
$self->HDump($pos, $n, "$t header", "$m Marker"); |
6470
|
|
|
|
|
|
|
} |
6471
|
245
|
|
|
|
|
669
|
my $path = $$self{PATH}; |
6472
|
245
|
|
|
|
|
605
|
my $pn = scalar @$path; |
6473
|
|
|
|
|
|
|
|
6474
|
|
|
|
|
|
|
# set input record separator to 0xff (the JPEG marker) to make reading quicker |
6475
|
245
|
|
|
|
|
1535
|
local $/ = "\xff"; |
6476
|
|
|
|
|
|
|
|
6477
|
245
|
|
|
|
|
706
|
my ($nextMarker, $nextSegDataPt, $nextSegPos, $combinedSegData, $firstSegPos, @skipData); |
6478
|
|
|
|
|
|
|
|
6479
|
|
|
|
|
|
|
# read file until we reach an end of image (EOI) or start of scan (SOS) |
6480
|
245
|
|
|
|
|
481
|
Marker: for (;;) { |
6481
|
|
|
|
|
|
|
# set marker and data pointer for current segment |
6482
|
2140
|
|
|
|
|
4024
|
my $marker = $nextMarker; |
6483
|
2140
|
|
|
|
|
3169
|
my $segDataPt = $nextSegDataPt; |
6484
|
2140
|
|
|
|
|
3113
|
my $segPos = $nextSegPos; |
6485
|
2140
|
|
|
|
|
3181
|
my $skipped; |
6486
|
2140
|
|
|
|
|
3381
|
undef $nextMarker; |
6487
|
2140
|
|
|
|
|
3295
|
undef $nextSegDataPt; |
6488
|
|
|
|
|
|
|
# |
6489
|
|
|
|
|
|
|
# read ahead to the next segment unless we have reached EOI, SOS or SOD |
6490
|
|
|
|
|
|
|
# |
6491
|
2140
|
100
|
100
|
|
|
15874
|
unless ($marker and ($marker==0xd9 or ($marker==0xda and not $wantTrailer and not $md5) or |
|
|
|
100
|
|
|
|
|
6492
|
|
|
|
|
|
|
$marker==0x93)) |
6493
|
|
|
|
|
|
|
{ |
6494
|
|
|
|
|
|
|
# read up to next marker (JPEG markers begin with 0xff) |
6495
|
1894
|
|
|
|
|
3084
|
my $buff; |
6496
|
1894
|
50
|
|
|
|
8766
|
$raf->ReadLine($buff) or last; |
6497
|
1894
|
|
|
|
|
3692
|
$skipped = length($buff) - 1; |
6498
|
|
|
|
|
|
|
# JPEG markers can be padded with unlimited 0xff's |
6499
|
1894
|
|
|
|
|
2914
|
for (;;) { |
6500
|
1894
|
50
|
|
|
|
5110
|
$raf->Read($ch, 1) or last Marker; |
6501
|
1894
|
|
|
|
|
3854
|
$nextMarker = ord($ch); |
6502
|
1894
|
50
|
|
|
|
4723
|
last unless $nextMarker == 0xff; |
6503
|
0
|
|
|
|
|
0
|
++$skipped; |
6504
|
|
|
|
|
|
|
} |
6505
|
|
|
|
|
|
|
# read segment data if it exists |
6506
|
1894
|
100
|
33
|
|
|
9059
|
if (not defined $markerLenBytes{$nextMarker}) { |
|
|
50
|
0
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
6507
|
|
|
|
|
|
|
# read record length word |
6508
|
1648
|
50
|
|
|
|
4033
|
last unless $raf->Read($s, 2) == 2; |
6509
|
1648
|
|
|
|
|
5197
|
my $len = unpack('n',$s); # get data length |
6510
|
1648
|
50
|
33
|
|
|
6938
|
last unless defined($len) and $len >= 2; |
6511
|
1648
|
|
|
|
|
4391
|
$nextSegPos = $raf->Tell(); |
6512
|
1648
|
|
|
|
|
3026
|
$len -= 2; # subtract size of length word |
6513
|
1648
|
50
|
|
|
|
3860
|
last unless $raf->Read($buff, $len) == $len; |
6514
|
1648
|
|
|
|
|
3555
|
$nextSegDataPt = \$buff; # set pointer to our next data |
6515
|
|
|
|
|
|
|
} elsif ($markerLenBytes{$nextMarker} == 4) { |
6516
|
|
|
|
|
|
|
# handle J2C extensions with 4-byte length word |
6517
|
0
|
0
|
|
|
|
0
|
last unless $raf->Read($s, 4) == 4; |
6518
|
0
|
|
|
|
|
0
|
my $len = unpack('N',$s); # get data length |
6519
|
0
|
0
|
0
|
|
|
0
|
last unless defined($len) and $len >= 4; |
6520
|
0
|
|
|
|
|
0
|
$nextSegPos = $raf->Tell(); |
6521
|
0
|
|
|
|
|
0
|
$len -= 4; # subtract size of length word |
6522
|
0
|
0
|
|
|
|
0
|
last unless $raf->Seek($len, 1); |
6523
|
|
|
|
|
|
|
} elsif ($md5 and defined $marker and ($marker == 0x00 or $marker == 0xda or |
6524
|
|
|
|
|
|
|
($marker >= 0xd0 and $marker <= 0xd7))) |
6525
|
|
|
|
|
|
|
{ |
6526
|
|
|
|
|
|
|
# calculate MD5 for image data (includes leading ff d9 but not trailing ff da) |
6527
|
0
|
|
|
|
|
0
|
$md5->add("\xff" . chr($marker)); |
6528
|
0
|
|
|
|
|
0
|
my $n = $skipped - (length($buff) - 1); # number of extra 0xff's |
6529
|
0
|
0
|
|
|
|
0
|
if (not $n) { |
|
|
0
|
|
|
|
|
|
6530
|
0
|
|
|
|
|
0
|
$buff = substr($buff, 0, -1); # remove trailing 0xff |
6531
|
|
|
|
|
|
|
} elsif ($n > 1) { |
6532
|
0
|
|
|
|
|
0
|
$buff .= "\xff" x ($n - 1); # add back extra 0xff's |
6533
|
|
|
|
|
|
|
} |
6534
|
0
|
|
|
|
|
0
|
$md5->add($buff); |
6535
|
0
|
|
|
|
|
0
|
$md5size += $skipped + 2; |
6536
|
|
|
|
|
|
|
} |
6537
|
|
|
|
|
|
|
# read second segment too if this was the first |
6538
|
1894
|
100
|
|
|
|
4782
|
next unless defined $marker; |
6539
|
|
|
|
|
|
|
} |
6540
|
|
|
|
|
|
|
# set some useful variables for the current segment |
6541
|
1894
|
|
|
|
|
5311
|
my $markerName = JpegMarkerName($marker); |
6542
|
1894
|
|
|
|
|
4476
|
$$path[$pn] = $markerName; |
6543
|
|
|
|
|
|
|
# issue warning if we skipped some garbage |
6544
|
1894
|
0
|
33
|
|
|
5073
|
if ($skipped and not $foundSOS and $markerName ne 'SOS') { |
|
|
|
33
|
|
|
|
|
6545
|
0
|
|
|
|
|
0
|
$self->Warn("Skipped unknown $skipped bytes after JPEG $markerName segment", 1); |
6546
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
6547
|
0
|
|
|
|
|
0
|
$self->HDump($nextSegPos-4-$skipped, $skipped, "[unknown $skipped bytes]", undef, 0x08); |
6548
|
0
|
|
|
|
|
0
|
$dumpEnd = $nextSegPos - 4; |
6549
|
|
|
|
|
|
|
} |
6550
|
|
|
|
|
|
|
} |
6551
|
|
|
|
|
|
|
# |
6552
|
|
|
|
|
|
|
# parse the current segment |
6553
|
|
|
|
|
|
|
# |
6554
|
|
|
|
|
|
|
# handle SOF markers: SOF0-SOF15, except DHT(0xc4), JPGA(0xc8) and DAC(0xcc) |
6555
|
1894
|
100
|
66
|
|
|
20499
|
if (($marker & 0xf0) == 0xc0 and ($marker == 0xc0 or $marker & 0x03)) { |
|
|
100
|
100
|
|
|
|
|
|
|
100
|
66
|
|
|
|
|
|
|
100
|
33
|
|
|
|
|
|
|
50
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
6556
|
242
|
|
|
|
|
695
|
$length = length $$segDataPt; |
6557
|
242
|
100
|
|
|
|
1232
|
if ($verbose) { |
|
|
50
|
|
|
|
|
|
6558
|
2
|
|
|
|
|
13
|
print $out "JPEG $markerName ($length bytes):\n"; |
6559
|
2
|
100
|
|
|
|
14
|
HexDump($segDataPt, undef, %dumpParms, Addr=>$segPos) if $verbose>2; |
6560
|
|
|
|
|
|
|
} elsif ($htmlDump) { |
6561
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, $length+4, "[JPEG $markerName]", undef, 0x08); |
6562
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6563
|
|
|
|
|
|
|
} |
6564
|
242
|
50
|
|
|
|
818
|
next unless $length >= 6; |
6565
|
|
|
|
|
|
|
# extract some useful information |
6566
|
242
|
|
|
|
|
1258
|
my ($p, $h, $w, $n) = unpack('Cn2C', $$segDataPt); |
6567
|
242
|
|
|
|
|
972
|
my $sof = GetTagTable('Image::ExifTool::JPEG::SOF'); |
6568
|
242
|
|
|
|
|
1600
|
$self->HandleTag($sof, 'ImageWidth', $w); |
6569
|
242
|
|
|
|
|
1331
|
$self->HandleTag($sof, 'ImageHeight', $h); |
6570
|
242
|
|
|
|
|
1742
|
$self->HandleTag($sof, 'EncodingProcess', $marker - 0xc0); |
6571
|
242
|
|
|
|
|
1724
|
$self->HandleTag($sof, 'BitsPerSample', $p); |
6572
|
242
|
|
|
|
|
1679
|
$self->HandleTag($sof, 'ColorComponents', $n); |
6573
|
242
|
50
|
33
|
|
|
2601
|
next unless $n == 3 and $length >= 15; |
6574
|
242
|
|
|
|
|
764
|
my ($i, $hmin, $hmax, $vmin, $vmax); |
6575
|
|
|
|
|
|
|
# loop through all components to determine sampling frequency |
6576
|
242
|
|
|
|
|
718
|
$subSampling = ''; |
6577
|
242
|
|
|
|
|
1208
|
for ($i=0; $i<$n; ++$i) { |
6578
|
726
|
|
|
|
|
1868
|
my $sf = Get8u($segDataPt, 7 + 3 * $i); |
6579
|
726
|
|
|
|
|
2957
|
$subSampling .= sprintf('%.2x', $sf); |
6580
|
|
|
|
|
|
|
# isolate horizontal and vertical components |
6581
|
726
|
|
|
|
|
1857
|
my ($hf, $vf) = ($sf >> 4, $sf & 0x0f); |
6582
|
726
|
100
|
|
|
|
2121
|
unless ($i) { |
6583
|
242
|
|
|
|
|
642
|
$hmin = $hmax = $hf; |
6584
|
242
|
|
|
|
|
686
|
$vmin = $vmax = $vf; |
6585
|
242
|
|
|
|
|
775
|
next; |
6586
|
|
|
|
|
|
|
} |
6587
|
|
|
|
|
|
|
# determine min/max frequencies |
6588
|
484
|
100
|
|
|
|
1888
|
$hmin = $hf if $hf < $hmin; |
6589
|
484
|
50
|
|
|
|
1436
|
$hmax = $hf if $hf > $hmax; |
6590
|
484
|
100
|
|
|
|
1268
|
$vmin = $vf if $vf < $vmin; |
6591
|
484
|
50
|
|
|
|
1738
|
$vmax = $vf if $vf > $vmax; |
6592
|
|
|
|
|
|
|
} |
6593
|
242
|
50
|
33
|
|
|
1814
|
if ($hmin and $vmin) { |
6594
|
242
|
|
|
|
|
887
|
my ($hs, $vs) = ($hmax / $hmin, $vmax / $vmin); |
6595
|
242
|
|
|
|
|
2332
|
$self->HandleTag($sof, 'YCbCrSubSampling', "$hs $vs"); |
6596
|
|
|
|
|
|
|
} |
6597
|
242
|
|
|
|
|
1044
|
next; |
6598
|
|
|
|
|
|
|
} elsif ($marker == 0xd9) { # EOI |
6599
|
3
|
|
|
|
|
13
|
pop @$path; |
6600
|
3
|
100
|
|
|
|
20
|
$verbose and print $out "JPEG EOI\n"; |
6601
|
3
|
|
|
|
|
15
|
my $pos = $raf->Tell(); |
6602
|
3
|
50
|
33
|
|
|
35
|
if ($htmlDump and $dumpEnd) { |
6603
|
0
|
|
|
|
|
0
|
$self->HDump($dumpEnd, $pos-2-$dumpEnd, '[JPEG Image Data]', undef, 0x08); |
6604
|
0
|
|
|
|
|
0
|
$self->HDump($pos-2, 2, 'JPEG EOI', undef); |
6605
|
0
|
|
|
|
|
0
|
$dumpEnd = 0; |
6606
|
|
|
|
|
|
|
} |
6607
|
3
|
50
|
66
|
|
|
22
|
if ($foundSOS or $$self{FILE_TYPE} eq 'EXV') { |
6608
|
3
|
|
|
|
|
8
|
$success = 1; |
6609
|
|
|
|
|
|
|
} else { |
6610
|
0
|
|
|
|
|
0
|
$self->Warn('Missing JPEG SOS'); |
6611
|
|
|
|
|
|
|
} |
6612
|
3
|
50
|
|
|
|
13
|
if ($$req{trailer}) { |
6613
|
|
|
|
|
|
|
# read entire trailer into memory |
6614
|
0
|
0
|
|
|
|
0
|
if ($raf->Seek(0,2)) { |
6615
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $pos; |
6616
|
0
|
0
|
|
|
|
0
|
if ($len) { |
6617
|
0
|
|
|
|
|
0
|
my $buff; |
6618
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6619
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(Trailer => \$buff) if $raf->Read($buff,$len) == $len; |
6620
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6621
|
|
|
|
|
|
|
} |
6622
|
|
|
|
|
|
|
} else { |
6623
|
0
|
|
|
|
|
0
|
$self->Warn('Error seeking in file'); |
6624
|
|
|
|
|
|
|
} |
6625
|
|
|
|
|
|
|
} |
6626
|
|
|
|
|
|
|
# we are here because we are looking for trailer information |
6627
|
3
|
50
|
|
|
|
15
|
if ($wantTrailer) { |
6628
|
0
|
|
|
|
|
0
|
my $start = $$self{PreviewImageStart}; |
6629
|
0
|
0
|
0
|
|
|
0
|
if ($start or $$options{ExtractEmbedded}) { |
6630
|
0
|
|
|
|
|
0
|
my $buff; |
6631
|
|
|
|
|
|
|
# most previews start right after the JPEG EOI, but the Olympus E-20 |
6632
|
|
|
|
|
|
|
# preview is 508 bytes into the trailer, the K-M Maxxum 7D preview is |
6633
|
|
|
|
|
|
|
# 979 bytes in, and Sony previews can start up to 32 kB into the trailer. |
6634
|
|
|
|
|
|
|
# (and Minolta and Sony previews can have a random first byte...) |
6635
|
0
|
0
|
|
|
|
0
|
my $scanLen = $$self{Make} =~ /Sony/i ? 65536 : 1024; |
6636
|
0
|
0
|
|
|
|
0
|
if ($raf->Read($buff, $scanLen)) { |
6637
|
0
|
0
|
0
|
|
|
0
|
if ($buff =~ /^.{4}ftyp/s) { |
|
|
0
|
0
|
|
|
|
|
6638
|
0
|
|
|
|
|
0
|
my $val; |
6639
|
0
|
0
|
|
|
|
0
|
if ($raf->Seek(0,2)) { |
6640
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $pos; |
6641
|
0
|
0
|
|
|
|
0
|
if ($$options{Binary}) { |
6642
|
0
|
0
|
0
|
|
|
0
|
$val = \$buff if $raf->Seek($pos,0) and $raf->Read($buff,$len)==$len; |
6643
|
|
|
|
|
|
|
} else { |
6644
|
0
|
|
|
|
|
0
|
$val = \ "Binary data $len bytes"; |
6645
|
|
|
|
|
|
|
} |
6646
|
0
|
0
|
|
|
|
0
|
if ($val) { |
6647
|
0
|
|
|
|
|
0
|
$self->FoundTag('EmbeddedVideo', $val); |
6648
|
|
|
|
|
|
|
} else { |
6649
|
0
|
|
|
|
|
0
|
$self->Warn('Error reading trailer'); |
6650
|
|
|
|
|
|
|
} |
6651
|
|
|
|
|
|
|
} else { |
6652
|
0
|
|
|
|
|
0
|
$self->Warn('Error seeking to end of file'); |
6653
|
|
|
|
|
|
|
} |
6654
|
|
|
|
|
|
|
} elsif ($buff =~ /\xff\xd8\xff./g or |
6655
|
|
|
|
|
|
|
($$self{Make} =~ /(Minolta|Sony)/i and $buff =~ /.\xd8\xff\xdb/g)) |
6656
|
|
|
|
|
|
|
{ |
6657
|
|
|
|
|
|
|
# adjust PreviewImageStart to this location |
6658
|
0
|
|
|
|
|
0
|
my $actual = $pos + pos($buff) - 4; |
6659
|
0
|
0
|
0
|
|
|
0
|
if ($start and $start ne $actual and $verbose > 1) { |
|
|
|
0
|
|
|
|
|
6660
|
0
|
|
|
|
|
0
|
print $out "(Fixed PreviewImage location: $start -> $actual)\n"; |
6661
|
|
|
|
|
|
|
} |
6662
|
|
|
|
|
|
|
# update preview image offsets |
6663
|
0
|
0
|
|
|
|
0
|
if ($start) { |
6664
|
0
|
0
|
|
|
|
0
|
$$self{VALUE}{PreviewImageStart} = $actual if $$self{VALUE}{PreviewImageStart}; |
6665
|
0
|
|
|
|
|
0
|
$$self{PreviewImageStart} = $actual; |
6666
|
|
|
|
|
|
|
} |
6667
|
|
|
|
|
|
|
# load preview now if we tried and failed earlier |
6668
|
0
|
0
|
0
|
|
|
0
|
if ($$self{PreviewError} and $$self{PreviewImageLength}) { |
6669
|
0
|
0
|
0
|
|
|
0
|
if ($raf->Seek($actual, 0) and $raf->Read($buff, $$self{PreviewImageLength})) { |
6670
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $buff); |
6671
|
0
|
|
|
|
|
0
|
delete $$self{PreviewError}; |
6672
|
|
|
|
|
|
|
} |
6673
|
|
|
|
|
|
|
} |
6674
|
|
|
|
|
|
|
} |
6675
|
|
|
|
|
|
|
} |
6676
|
0
|
|
|
|
|
0
|
$raf->Seek($pos, 0); |
6677
|
|
|
|
|
|
|
} |
6678
|
|
|
|
|
|
|
} |
6679
|
|
|
|
|
|
|
# process trailer now or finish processing trailers |
6680
|
|
|
|
|
|
|
# and scan for AFCP if necessary |
6681
|
3
|
|
|
|
|
7
|
my $fromEnd = 0; |
6682
|
3
|
50
|
|
|
|
17
|
if ($trailInfo) { |
6683
|
0
|
|
|
|
|
0
|
$$trailInfo{ScanForAFCP} = 1; # scan now if necessary |
6684
|
0
|
|
|
|
|
0
|
$self->ProcessTrailers($trailInfo); |
6685
|
|
|
|
|
|
|
# save offset from end of file to start of first trailer |
6686
|
0
|
|
|
|
|
0
|
$fromEnd = $$trailInfo{Offset}; |
6687
|
0
|
|
|
|
|
0
|
undef $trailInfo; |
6688
|
|
|
|
|
|
|
} |
6689
|
3
|
50
|
|
|
|
13
|
if ($$self{LeicaTrailer}) { |
6690
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); |
6691
|
0
|
|
|
|
|
0
|
$$self{LeicaTrailer}{TrailPos} = $pos; |
6692
|
0
|
|
|
|
|
0
|
$$self{LeicaTrailer}{TrailLen} = $raf->Tell() - $pos - $fromEnd; |
6693
|
0
|
|
|
|
|
0
|
Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); |
6694
|
|
|
|
|
|
|
} |
6695
|
|
|
|
|
|
|
# finally, dump remaining information in JPEG trailer |
6696
|
3
|
100
|
66
|
|
|
19
|
if ($verbose or $htmlDump) { |
6697
|
1
|
|
|
|
|
3
|
my $endPos = $$self{LeicaTrailerPos}; |
6698
|
1
|
50
|
|
|
|
5
|
unless ($endPos) { |
6699
|
1
|
|
|
|
|
4
|
$raf->Seek(0, 2); |
6700
|
1
|
|
|
|
|
9
|
$endPos = $raf->Tell() - $fromEnd; |
6701
|
|
|
|
|
|
|
} |
6702
|
|
|
|
|
|
|
$self->DumpUnknownTrailer({ |
6703
|
1
|
50
|
|
|
|
4
|
RAF => $raf, |
6704
|
|
|
|
|
|
|
DataPos => $pos, |
6705
|
|
|
|
|
|
|
DirLen => $endPos - $pos |
6706
|
|
|
|
|
|
|
}) if $endPos > $pos; |
6707
|
|
|
|
|
|
|
} |
6708
|
3
|
50
|
|
|
|
20
|
$self->FoundTag('JPEGImageLength', $pos - $appBytes) if $calcImageLen; |
6709
|
3
|
|
|
|
|
10
|
last; # all done parsing file |
6710
|
|
|
|
|
|
|
} elsif ($marker == 0xda) { # SOS |
6711
|
242
|
|
|
|
|
1054
|
pop @$path; |
6712
|
242
|
|
|
|
|
658
|
$foundSOS = 1; |
6713
|
|
|
|
|
|
|
# all done with meta information unless we have a trailer |
6714
|
242
|
100
|
|
|
|
861
|
$verbose and print $out "JPEG SOS\n"; |
6715
|
242
|
100
|
|
|
|
912
|
unless ($fast) { |
6716
|
241
|
|
|
|
|
1064
|
$trailInfo = IdentifyTrailer($raf); |
6717
|
|
|
|
|
|
|
# process trailer now unless we are doing verbose dump |
6718
|
241
|
50
|
66
|
|
|
1874
|
if ($trailInfo and $verbose < 3 and not $htmlDump) { |
|
|
|
66
|
|
|
|
|
6719
|
|
|
|
|
|
|
# process trailers (keep trailInfo to finish processing later |
6720
|
|
|
|
|
|
|
# only if we can't finish without scanning from end of file) |
6721
|
28
|
50
|
|
|
|
167
|
$self->ProcessTrailers($trailInfo) and undef $trailInfo; |
6722
|
|
|
|
|
|
|
} |
6723
|
241
|
0
|
33
|
|
|
1020
|
if ($wantTrailer and $$self{PreviewImageStart}) { |
6724
|
|
|
|
|
|
|
# seek ahead and validate preview image |
6725
|
0
|
|
|
|
|
0
|
my $buff; |
6726
|
0
|
|
|
|
|
0
|
my $curPos = $raf->Tell(); |
6727
|
0
|
0
|
0
|
|
|
0
|
if ($raf->Seek($$self{PreviewImageStart}, 0) and |
|
|
|
0
|
|
|
|
|
6728
|
|
|
|
|
|
|
$raf->Read($buff, 4) == 4 and |
6729
|
|
|
|
|
|
|
$buff =~ /^.\xd8\xff[\xc4\xdb\xe0-\xef]/) |
6730
|
|
|
|
|
|
|
{ |
6731
|
0
|
|
|
|
|
0
|
undef $wantTrailer; |
6732
|
|
|
|
|
|
|
} |
6733
|
0
|
0
|
|
|
|
0
|
$raf->Seek($curPos, 0) or last; |
6734
|
|
|
|
|
|
|
} |
6735
|
|
|
|
|
|
|
# seek ahead and process Leica trailer |
6736
|
241
|
50
|
|
|
|
1055
|
if ($$self{LeicaTrailer}) { |
6737
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Panasonic; |
6738
|
0
|
|
|
|
|
0
|
Image::ExifTool::Panasonic::ProcessLeicaTrailer($self); |
6739
|
0
|
0
|
|
|
|
0
|
$wantTrailer = 1 if $$self{LeicaTrailer}; |
6740
|
|
|
|
|
|
|
} else { |
6741
|
241
|
50
|
|
|
|
964
|
$wantTrailer = 1 if $$options{ExtractEmbedded}; |
6742
|
|
|
|
|
|
|
} |
6743
|
241
|
100
|
33
|
|
|
2587
|
next if $trailInfo or $wantTrailer or $verbose > 2 or $htmlDump; |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
6744
|
|
|
|
|
|
|
} |
6745
|
|
|
|
|
|
|
# must scan to EOI if Validate or JpegCompressionFactor used |
6746
|
241
|
50
|
33
|
|
|
2680
|
next if $$options{Validate} or $calcImageLen or $$req{trailer} or $md5; |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
6747
|
|
|
|
|
|
|
# nothing interesting to parse after start of scan (SOS) |
6748
|
241
|
|
|
|
|
551
|
$success = 1; |
6749
|
241
|
|
|
|
|
608
|
last; # all done parsing file |
6750
|
|
|
|
|
|
|
} elsif ($marker == 0x93) { |
6751
|
1
|
|
|
|
|
3
|
pop @$path; |
6752
|
1
|
50
|
|
|
|
5
|
$verbose and print $out "JPEG SOD\n"; |
6753
|
1
|
|
|
|
|
3
|
$success = 1; |
6754
|
1
|
50
|
33
|
|
|
8
|
next if $verbose > 2 or $htmlDump; |
6755
|
1
|
|
|
|
|
3
|
last; # all done parsing file |
6756
|
|
|
|
|
|
|
} elsif (defined $markerLenBytes{$marker}) { |
6757
|
|
|
|
|
|
|
# handle other stand-alone markers and segments we skipped over |
6758
|
0
|
0
|
0
|
|
|
0
|
$verbose and $marker and print $out "JPEG $markerName\n"; |
6759
|
0
|
|
|
|
|
0
|
next; |
6760
|
|
|
|
|
|
|
} elsif ($marker == 0xdb and length($$segDataPt) and # DQT |
6761
|
|
|
|
|
|
|
# save the DQT data only if JPEGDigest has been requested |
6762
|
|
|
|
|
|
|
# (Note: since we aren't checking the API RequestAll option here, the application |
6763
|
|
|
|
|
|
|
# must use the RequestTags option to generate these tags if they have not been |
6764
|
|
|
|
|
|
|
# specifically requested. The reason is that there is too much overhead involved |
6765
|
|
|
|
|
|
|
# in the calculation of this tag to make this worth the CPU time.) |
6766
|
|
|
|
|
|
|
($$req{jpegdigest} or $$req{jpegqualityestimate} |
6767
|
|
|
|
|
|
|
or ($$options{RequestAll} and $$options{RequestAll} > 2))) |
6768
|
|
|
|
|
|
|
{ |
6769
|
1
|
|
|
|
|
5
|
my $num = unpack('C',$$segDataPt) & 0x0f; # get table index |
6770
|
1
|
50
|
|
|
|
7
|
$dqt[$num] = $$segDataPt if $num < 4; # save for MD5 calculation |
6771
|
|
|
|
|
|
|
} |
6772
|
|
|
|
|
|
|
# handle all other markers |
6773
|
1406
|
|
|
|
|
2934
|
my $dumpType = ''; |
6774
|
1406
|
|
|
|
|
2571
|
my ($desc, $tip, $xtra); |
6775
|
1406
|
|
|
|
|
2646
|
$length = length $$segDataPt; |
6776
|
1406
|
100
|
|
|
|
4664
|
$appBytes += $length + 4 if ($marker & 0xf0) == 0xe0; # total size of APP segments |
6777
|
1406
|
100
|
|
|
|
3038
|
if ($verbose) { |
6778
|
6
|
|
|
|
|
27
|
print $out "JPEG $markerName ($length bytes):\n"; |
6779
|
6
|
100
|
|
|
|
21
|
if ($verbose > 2) { |
6780
|
3
|
|
|
|
|
10
|
my %extraParms = ( Addr => $segPos ); |
6781
|
3
|
50
|
|
|
|
13
|
$extraParms{MaxLen} = 128 if $verbose == 4; |
6782
|
3
|
|
|
|
|
22
|
HexDump($segDataPt, undef, %dumpParms, %extraParms); |
6783
|
|
|
|
|
|
|
} |
6784
|
|
|
|
|
|
|
} |
6785
|
|
|
|
|
|
|
# prepare dirInfo hash for processing this information |
6786
|
1406
|
|
|
|
|
8439
|
my %dirInfo = ( |
6787
|
|
|
|
|
|
|
Parent => $markerName, |
6788
|
|
|
|
|
|
|
DataPt => $segDataPt, |
6789
|
|
|
|
|
|
|
DataPos => $segPos, |
6790
|
|
|
|
|
|
|
DataLen => $length, |
6791
|
|
|
|
|
|
|
DirStart => 0, |
6792
|
|
|
|
|
|
|
DirLen => $length, |
6793
|
|
|
|
|
|
|
Base => 0, |
6794
|
|
|
|
|
|
|
); |
6795
|
1406
|
100
|
|
|
|
17043
|
if ($marker == 0xe0) { # APP0 (JFIF, JFXX, CIFF, AVI1, Ocad) |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6796
|
107
|
100
|
|
|
|
1286
|
if ($$segDataPt =~ /^JFIF\0/) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6797
|
50
|
|
|
|
|
127
|
$dumpType = 'JFIF'; |
6798
|
50
|
|
|
|
|
255
|
DirStart(\%dirInfo, 5); # start at byte 5 |
6799
|
50
|
|
|
|
|
251
|
SetByteOrder('MM'); |
6800
|
50
|
|
|
|
|
267
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Main'); |
6801
|
50
|
|
|
|
|
355
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6802
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^JFXX\0(\x10|\x11|\x13)/) { |
6803
|
19
|
|
|
|
|
78
|
my $tag = ord $1; |
6804
|
19
|
|
|
|
|
49
|
$dumpType = 'JFXX'; |
6805
|
19
|
|
|
|
|
75
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JFIF::Extension'); |
6806
|
19
|
|
|
|
|
109
|
my $tagInfo = $self->GetTagInfo($tagTablePtr, $tag); |
6807
|
19
|
|
|
|
|
168
|
$self->FoundTag($tagInfo, substr($$segDataPt, 6)); |
6808
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(II|MM).{4}HEAPJPGM/s) { |
6809
|
19
|
50
|
|
|
|
83
|
next if $fast > 1; # skip processing for very fast |
6810
|
19
|
|
|
|
|
60
|
$dumpType = 'CIFF'; |
6811
|
19
|
|
|
|
|
114
|
my %dirInfo = ( RAF => new File::RandomAccess($segDataPt) ); |
6812
|
19
|
|
|
|
|
84
|
$$self{SET_GROUP1} = 'CIFF'; |
6813
|
19
|
|
|
|
|
44
|
push @{$$self{PATH}}, 'CIFF'; |
|
19
|
|
|
|
|
75
|
|
6814
|
19
|
|
|
|
|
1507
|
require Image::ExifTool::CanonRaw; |
6815
|
19
|
|
|
|
|
181
|
Image::ExifTool::CanonRaw::ProcessCRW($self, \%dirInfo); |
6816
|
19
|
|
|
|
|
59
|
pop @{$$self{PATH}}; |
|
19
|
|
|
|
|
55
|
|
6817
|
19
|
|
|
|
|
135
|
delete $$self{SET_GROUP1}; |
6818
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(AVI1|Ocad)/) { |
6819
|
19
|
|
|
|
|
116
|
$dumpType = $1; |
6820
|
19
|
|
|
|
|
78
|
SetByteOrder('MM'); |
6821
|
19
|
|
|
|
|
230
|
my $tagTablePtr = GetTagTable("Image::ExifTool::JPEG::$dumpType"); |
6822
|
19
|
|
|
|
|
118
|
DirStart(\%dirInfo, 4); |
6823
|
19
|
|
|
|
|
110
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6824
|
|
|
|
|
|
|
} |
6825
|
|
|
|
|
|
|
} elsif ($marker == 0xe1) { # APP1 (EXIF, XMP, QVCI, PARROT) |
6826
|
|
|
|
|
|
|
# (some Kodak cameras don't put a second "\0", and I have seen an |
6827
|
|
|
|
|
|
|
# example where there was a second 4-byte APP1 segment header) |
6828
|
272
|
100
|
66
|
|
|
3341
|
if ($$segDataPt =~ /^(.{0,4})Exif\0./is) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
6829
|
199
|
|
|
|
|
539
|
undef $dumpType; # (will be dumped here) |
6830
|
|
|
|
|
|
|
# this is EXIF data -- |
6831
|
|
|
|
|
|
|
# get the data block (into a common variable) |
6832
|
199
|
|
|
|
|
561
|
my $hdrLen = length($exifAPP1hdr); |
6833
|
199
|
50
|
|
|
|
1561
|
if (length $1) { |
|
|
50
|
|
|
|
|
|
6834
|
0
|
|
|
|
|
0
|
$hdrLen += length $1; |
6835
|
0
|
|
|
|
|
0
|
$self->Warn('Unknown garbage at start of EXIF segment',1); |
6836
|
|
|
|
|
|
|
} elsif ($$segDataPt !~ /^Exif\0/) { |
6837
|
0
|
|
|
|
|
0
|
$self->Warn('Incorrect EXIF segment identifier',1); |
6838
|
|
|
|
|
|
|
} |
6839
|
199
|
50
|
|
|
|
770
|
if ($htmlDump) { |
6840
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP1 header', "Data size: $length bytes"); |
6841
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Exif header', 'APP1 data type: Exif'); |
6842
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
6843
|
|
|
|
|
|
|
} |
6844
|
199
|
|
|
|
|
517
|
my $dataPt = $segDataPt; |
6845
|
199
|
50
|
|
|
|
704
|
if (defined $combinedSegData) { |
6846
|
0
|
|
|
|
|
0
|
push @skipData, [ $segPos-4, $segPos+$hdrLen ]; |
6847
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,$hdrLen); |
6848
|
0
|
|
|
|
|
0
|
undef $$segDataPt; |
6849
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
6850
|
0
|
|
|
|
|
0
|
$segPos = $firstSegPos; |
6851
|
|
|
|
|
|
|
} |
6852
|
|
|
|
|
|
|
# peek ahead to see if the next segment is extended EXIF |
6853
|
199
|
50
|
66
|
|
|
1427
|
if ($nextMarker == $marker and |
6854
|
|
|
|
|
|
|
$$nextSegDataPt =~ /^$exifAPP1hdr(?!(MM\0\x2a|II\x2a\0))/) |
6855
|
|
|
|
|
|
|
{ |
6856
|
|
|
|
|
|
|
# initialize combined data if necessary |
6857
|
0
|
0
|
|
|
|
0
|
unless (defined $combinedSegData) { |
6858
|
0
|
|
|
|
|
0
|
$combinedSegData = $$segDataPt; |
6859
|
0
|
|
|
|
|
0
|
undef $$segDataPt; |
6860
|
0
|
|
|
|
|
0
|
$firstSegPos = $segPos; |
6861
|
0
|
|
|
|
|
0
|
$self->Warn('File contains multi-segment EXIF',1); |
6862
|
0
|
|
|
|
|
0
|
$$self{ExtendedEXIF} = 1; |
6863
|
|
|
|
|
|
|
} |
6864
|
0
|
|
|
|
|
0
|
next; |
6865
|
|
|
|
|
|
|
} |
6866
|
199
|
|
|
|
|
608
|
$dirInfo{DataPt} = $dataPt; |
6867
|
199
|
|
|
|
|
485
|
$dirInfo{DataPos} = $segPos; |
6868
|
199
|
|
|
|
|
552
|
$dirInfo{DataLen} = $dirInfo{DirLen} = length $$dataPt; |
6869
|
199
|
|
|
|
|
917
|
DirStart(\%dirInfo, $hdrLen, $hdrLen); |
6870
|
199
|
50
|
|
|
|
718
|
$$self{SkipData} = \@skipData if @skipData; |
6871
|
|
|
|
|
|
|
# extract the EXIF information (it is in standard TIFF format) |
6872
|
199
|
50
|
|
|
|
1158
|
$self->ProcessTIFF(\%dirInfo) or $self->Warn('Malformed APP1 EXIF segment'); |
6873
|
|
|
|
|
|
|
# avoid looking for preview unless necessary because it really slows |
6874
|
|
|
|
|
|
|
# us down -- only look for it if we found pointer, and preview is |
6875
|
|
|
|
|
|
|
# outside EXIF, and PreviewImage is specifically requested |
6876
|
199
|
|
|
|
|
1053
|
my $start = $self->GetValue('PreviewImageStart', 'ValueConv'); |
6877
|
199
|
|
|
|
|
778
|
my $plen = $self->GetValue('PreviewImageLength', 'ValueConv'); |
6878
|
199
|
100
|
66
|
|
|
1344
|
if (not $start or not $plen and $$self{PreviewError}) { |
|
|
|
66
|
|
|
|
|
6879
|
183
|
|
|
|
|
510
|
$start = $$self{PreviewImageStart}; |
6880
|
183
|
|
|
|
|
561
|
$plen = $$self{PreviewImageLength}; |
6881
|
|
|
|
|
|
|
} |
6882
|
199
|
0
|
100
|
|
|
1047
|
if ($start and $plen and IsInt($start) and IsInt($plen) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
6883
|
|
|
|
|
|
|
$start + $plen > $$self{EXIF_POS} + length($$self{EXIF_DATA}) and |
6884
|
|
|
|
|
|
|
($$req{previewimage} or |
6885
|
|
|
|
|
|
|
# (extracted normally, so check Binary option) |
6886
|
|
|
|
|
|
|
($$options{Binary} and not $$self{EXCL_TAG_LOOKUP}{previewimage}))) |
6887
|
|
|
|
|
|
|
{ |
6888
|
0
|
|
|
|
|
0
|
$$self{PreviewImageStart} = $start; |
6889
|
0
|
|
|
|
|
0
|
$$self{PreviewImageLength} = $plen; |
6890
|
0
|
|
|
|
|
0
|
$wantTrailer = 1; |
6891
|
|
|
|
|
|
|
} |
6892
|
199
|
50
|
|
|
|
838
|
if (@skipData) { |
6893
|
0
|
|
|
|
|
0
|
undef @skipData; |
6894
|
0
|
|
|
|
|
0
|
delete $$self{SkipData}; |
6895
|
|
|
|
|
|
|
} |
6896
|
199
|
|
|
|
|
591
|
undef $$dataPt; |
6897
|
199
|
|
|
|
|
1151
|
next; |
6898
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^$xmpExtAPP1hdr/) { |
6899
|
|
|
|
|
|
|
# off len -- extended XMP header (75 bytes total): |
6900
|
|
|
|
|
|
|
# 0 35 bytes - signature |
6901
|
|
|
|
|
|
|
# 35 32 bytes - GUID (MD5 hash of full extended XMP data in ASCII) |
6902
|
|
|
|
|
|
|
# 67 4 bytes - total size of extended XMP data |
6903
|
|
|
|
|
|
|
# 71 4 bytes - offset for this XMP data portion |
6904
|
2
|
|
|
|
|
7
|
$dumpType = 'Extended XMP'; |
6905
|
2
|
50
|
|
|
|
9
|
if ($length > 75) { |
6906
|
2
|
|
|
|
|
11
|
my ($size, $off) = unpack('x67N2', $$segDataPt); |
6907
|
2
|
|
|
|
|
8
|
my $guid = substr($$segDataPt, 35, 32); |
6908
|
2
|
50
|
|
|
|
10
|
if ($guid =~ /[^A-Za-z0-9]/) { # (technically, should be uppercase) |
6909
|
0
|
|
|
|
|
0
|
$self->WarnOnce($tip = 'Invalid extended XMP GUID'); |
6910
|
|
|
|
|
|
|
} else { |
6911
|
2
|
|
|
|
|
6
|
my $extXMP = $extendedXMP{$guid}; |
6912
|
2
|
100
|
|
|
|
11
|
if (not $extXMP) { |
|
|
50
|
|
|
|
|
|
6913
|
1
|
|
|
|
|
5
|
$extXMP = $extendedXMP{$guid} = { }; |
6914
|
|
|
|
|
|
|
} elsif ($size != $$extXMP{Size}) { |
6915
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Inconsistent extended XMP size'); |
6916
|
|
|
|
|
|
|
} |
6917
|
2
|
|
|
|
|
6
|
$$extXMP{Size} = $size; |
6918
|
2
|
|
|
|
|
7
|
$$extXMP{$off} = substr($$segDataPt, 75); |
6919
|
2
|
|
|
|
|
12
|
$tip = "Full length: $size\nChunk offset: $off\nChunk length: " . |
6920
|
|
|
|
|
|
|
($length - 75) . "\nGUID: $guid"; |
6921
|
|
|
|
|
|
|
# (delay processing extended XMP until after reading all segments) |
6922
|
|
|
|
|
|
|
} |
6923
|
|
|
|
|
|
|
} else { |
6924
|
0
|
|
|
|
|
0
|
$self->WarnOnce($tip = 'Invalid extended XMP segment'); |
6925
|
|
|
|
|
|
|
} |
6926
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^QVCI\0/) { |
6927
|
1
|
|
|
|
|
4
|
$dumpType = 'QVCI'; |
6928
|
1
|
|
|
|
|
6
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Casio::QVCI'); |
6929
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6930
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FLIR\0/ and $length >= 8) { |
6931
|
1
|
|
|
|
|
4
|
$dumpType = 'FLIR'; |
6932
|
|
|
|
|
|
|
# must concatenate FLIR chunks (note: handle the case where |
6933
|
|
|
|
|
|
|
# some software erroneously writes zeros for the chunk counts) |
6934
|
1
|
|
|
|
|
5
|
my $chunkNum = Get8u($segDataPt, 6); |
6935
|
1
|
|
|
|
|
3
|
my $chunksTot = Get8u($segDataPt, 7) + 1; # (note the "+ 1"!) |
6936
|
1
|
50
|
|
|
|
5
|
$verbose and printf $out "$$self{INDENT}FLIR chunk %d of %d\n", |
6937
|
|
|
|
|
|
|
$chunkNum + 1, $chunksTot; |
6938
|
1
|
50
|
|
|
|
4
|
if (defined $flirTotal) { |
6939
|
|
|
|
|
|
|
# abort parsing FLIR if the total chunk count is inconsistent |
6940
|
0
|
0
|
|
|
|
0
|
undef $flirCount if $chunksTot != $flirTotal; |
6941
|
|
|
|
|
|
|
} else { |
6942
|
1
|
|
|
|
|
3
|
$flirCount = 0; |
6943
|
1
|
|
|
|
|
2
|
$flirTotal = $chunksTot; |
6944
|
|
|
|
|
|
|
} |
6945
|
1
|
50
|
|
|
|
21
|
if (defined $flirCount) { |
6946
|
1
|
50
|
|
|
|
4
|
if (defined $flirChunk[$chunkNum]) { |
6947
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Duplicate FLIR chunk number(s)'); |
6948
|
0
|
|
|
|
|
0
|
$flirChunk[$chunkNum] .= substr($$segDataPt, 8); |
6949
|
|
|
|
|
|
|
} else { |
6950
|
1
|
|
|
|
|
13
|
$flirChunk[$chunkNum] = substr($$segDataPt, 8); |
6951
|
|
|
|
|
|
|
} |
6952
|
|
|
|
|
|
|
# process the FLIR information if we have all of the chunks |
6953
|
1
|
50
|
|
|
|
5
|
if (++$flirCount >= $flirTotal) { |
6954
|
1
|
|
|
|
|
2
|
my $flir = ''; |
6955
|
1
|
|
33
|
|
|
12
|
defined $_ and $flir .= $_ foreach @flirChunk; |
6956
|
1
|
|
|
|
|
4
|
undef @flirChunk; # free memory |
6957
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FLIR::FFF'); |
6958
|
1
|
|
|
|
|
6
|
my %dirInfo = ( |
6959
|
|
|
|
|
|
|
DataPt => \$flir, |
6960
|
|
|
|
|
|
|
Parent => $markerName, |
6961
|
|
|
|
|
|
|
DirName => 'FLIR', |
6962
|
|
|
|
|
|
|
); |
6963
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6964
|
1
|
|
|
|
|
3
|
undef $flirCount; # prevent reprocessing |
6965
|
|
|
|
|
|
|
} |
6966
|
|
|
|
|
|
|
} else { |
6967
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Invalid or extraneous FLIR chunk(s)'); |
6968
|
|
|
|
|
|
|
} |
6969
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^PARROT\0(II\x2a\0|MM\0\x2a)/) { |
6970
|
|
|
|
|
|
|
# (don't know if this could span multiple segments) |
6971
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
6972
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP1', $$segDataPt); |
6973
|
0
|
|
|
|
|
0
|
$dumpType = 'Parrot'; |
6974
|
|
|
|
|
|
|
} else { |
6975
|
|
|
|
|
|
|
# Hmmm. Could be XMP, let's see |
6976
|
69
|
|
|
|
|
199
|
my $processed; |
6977
|
69
|
50
|
33
|
|
|
556
|
if ($$segDataPt =~ /^(http|XMP\0)/ or $$segDataPt =~ /<(exif:|\?xpacket)/) { |
6978
|
69
|
|
|
|
|
201
|
$dumpType = 'XMP'; |
6979
|
|
|
|
|
|
|
# also try to parse XMP with a non-standard header |
6980
|
|
|
|
|
|
|
# (note: this non-standard XMP is ignored when writing) |
6981
|
69
|
50
|
|
|
|
672
|
my $start = ($$segDataPt =~ /^$xmpAPP1hdr/) ? length($xmpAPP1hdr) : 0; |
6982
|
69
|
|
|
|
|
356
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
6983
|
69
|
|
|
|
|
455
|
DirStart(\%dirInfo, $start); |
6984
|
69
|
50
|
|
|
|
630
|
$dirInfo{DirName} = $start ? 'XMP' : 'XML', |
6985
|
|
|
|
|
|
|
$processed = $self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
6986
|
69
|
50
|
33
|
|
|
697
|
if ($processed and not $start) { |
6987
|
0
|
|
|
|
|
0
|
$self->Warn('Non-standard header for APP1 XMP segment'); |
6988
|
|
|
|
|
|
|
} |
6989
|
|
|
|
|
|
|
} |
6990
|
69
|
50
|
33
|
|
|
392
|
if ($verbose and not $processed) { |
6991
|
0
|
|
|
|
|
0
|
$self->Warn("Ignored APP1 segment length $length (unknown header)"); |
6992
|
|
|
|
|
|
|
} |
6993
|
|
|
|
|
|
|
} |
6994
|
|
|
|
|
|
|
} elsif ($marker == 0xe2) { # APP2 (ICC Profile, FPXR, MPF, InfiRay, PreviewImage) |
6995
|
121
|
100
|
66
|
|
|
1188
|
if ($$segDataPt =~ /^ICC_PROFILE\0/ and $length >= 14) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
6996
|
34
|
|
|
|
|
126
|
$dumpType = 'ICC_Profile'; |
6997
|
|
|
|
|
|
|
# must concatenate profile chunks (note: handle the case where |
6998
|
|
|
|
|
|
|
# some software erroneously writes zeros for the chunk counts) |
6999
|
34
|
|
|
|
|
134
|
my $chunkNum = Get8u($segDataPt, 12); |
7000
|
34
|
|
|
|
|
187
|
my $chunksTot = Get8u($segDataPt, 13); |
7001
|
34
|
50
|
|
|
|
183
|
$verbose and print $out "$$self{INDENT}ICC_Profile chunk $chunkNum of $chunksTot\n"; |
7002
|
34
|
50
|
|
|
|
133
|
if (defined $iccChunksTotal) { |
7003
|
|
|
|
|
|
|
# abort parsing ICC_Profile if the total chunk count is inconsistent |
7004
|
0
|
0
|
|
|
|
0
|
undef $iccChunkCount if $chunksTot != $iccChunksTotal; |
7005
|
|
|
|
|
|
|
} else { |
7006
|
34
|
|
|
|
|
83
|
$iccChunkCount = 0; |
7007
|
34
|
|
|
|
|
81
|
$iccChunksTotal = $chunksTot; |
7008
|
34
|
50
|
|
|
|
142
|
$self->Warn('ICC_Profile chunk count is zero') if !$chunksTot; |
7009
|
|
|
|
|
|
|
} |
7010
|
34
|
50
|
|
|
|
119
|
if (defined $iccChunkCount) { |
7011
|
34
|
50
|
|
|
|
130
|
if (defined $iccChunk[$chunkNum]) { |
7012
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Duplicate ICC_Profile chunk number(s)'); |
7013
|
0
|
|
|
|
|
0
|
$iccChunk[$chunkNum] .= substr($$segDataPt, 14); |
7014
|
|
|
|
|
|
|
} else { |
7015
|
34
|
|
|
|
|
234
|
$iccChunk[$chunkNum] = substr($$segDataPt, 14); |
7016
|
|
|
|
|
|
|
} |
7017
|
|
|
|
|
|
|
# process profile if we have all of the chunks |
7018
|
34
|
50
|
|
|
|
149
|
if (++$iccChunkCount >= $iccChunksTotal) { |
7019
|
34
|
|
|
|
|
99
|
my $icc_profile = ''; |
7020
|
34
|
|
66
|
|
|
298
|
defined $_ and $icc_profile .= $_ foreach @iccChunk; |
7021
|
34
|
|
|
|
|
105
|
undef @iccChunk; # free memory |
7022
|
34
|
|
|
|
|
133
|
my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main'); |
7023
|
34
|
|
|
|
|
345
|
my %dirInfo = ( |
7024
|
|
|
|
|
|
|
DataPt => \$icc_profile, |
7025
|
|
|
|
|
|
|
DataPos => $segPos + 14, |
7026
|
|
|
|
|
|
|
DataLen => length($icc_profile), |
7027
|
|
|
|
|
|
|
DirStart => 0, |
7028
|
|
|
|
|
|
|
DirLen => length($icc_profile), |
7029
|
|
|
|
|
|
|
Parent => $markerName, |
7030
|
|
|
|
|
|
|
); |
7031
|
34
|
|
|
|
|
200
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7032
|
34
|
|
|
|
|
197
|
undef $iccChunkCount; # prevent reprocessing |
7033
|
|
|
|
|
|
|
} |
7034
|
|
|
|
|
|
|
} else { |
7035
|
0
|
|
|
|
|
0
|
$self->WarnOnce('Invalid or extraneous ICC_Profile chunk(s)'); |
7036
|
|
|
|
|
|
|
} |
7037
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FPXR\0/) { |
7038
|
67
|
50
|
|
|
|
225
|
next if $fast > 1; # skip processing for very fast |
7039
|
67
|
|
|
|
|
156
|
$dumpType = 'FPXR'; |
7040
|
67
|
|
|
|
|
217
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); |
7041
|
|
|
|
|
|
|
# set flag if this is the last FPXR segment |
7042
|
67
|
|
100
|
|
|
641
|
$dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), |
7043
|
|
|
|
|
|
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7044
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^MPF\0/) { |
7045
|
19
|
|
|
|
|
56
|
undef $dumpType; # (will be dumped here) |
7046
|
19
|
|
|
|
|
107
|
DirStart(\%dirInfo, 4, 4); |
7047
|
19
|
|
|
|
|
83
|
$dirInfo{Multi} = 1; # the MP Attribute IFD will be MPF1 |
7048
|
19
|
50
|
|
|
|
79
|
if ($htmlDump) { |
7049
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP2 header', "Data size: $length bytes"); |
7050
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, 4, 'MPF header', 'APP2 data type: MPF'); |
7051
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7052
|
|
|
|
|
|
|
} |
7053
|
|
|
|
|
|
|
# extract the MPF information (it is in standard TIFF format) |
7054
|
19
|
|
|
|
|
59
|
my $tagTablePtr = GetTagTable('Image::ExifTool::MPF::Main'); |
7055
|
19
|
|
|
|
|
182
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
7056
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^....IJPEG\0/s) { |
7057
|
1
|
|
|
|
|
3
|
$dumpType = 'InfiRay Version'; |
7058
|
1
|
|
|
|
|
3
|
$$self{HasIJPEG} = 1; |
7059
|
1
|
|
|
|
|
3
|
SetByteOrder('II'); |
7060
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::Version'); |
7061
|
1
|
|
|
|
|
13
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7062
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(|QVGA\0|BGTH)\xff\xd8\xff[\xdb\xe0\xe1]/) { |
7063
|
|
|
|
|
|
|
# Samsung/GE/GoPro="", BenQ DC C1220/Pentacon/Polaroid="QVGA\0", |
7064
|
|
|
|
|
|
|
# Digilife DDC-690/Rollei="BGTH" |
7065
|
0
|
|
|
|
|
0
|
$dumpType = 'Preview Image'; |
7066
|
0
|
|
|
|
|
0
|
$preview = substr($$segDataPt, length($1)); |
7067
|
|
|
|
|
|
|
} elsif ($preview) { |
7068
|
0
|
|
|
|
|
0
|
$dumpType = 'Preview Image'; |
7069
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
7070
|
|
|
|
|
|
|
} |
7071
|
121
|
50
|
33
|
|
|
477
|
if ($preview and $nextMarker ne $marker) { |
7072
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
7073
|
0
|
|
|
|
|
0
|
undef $preview; |
7074
|
|
|
|
|
|
|
} |
7075
|
|
|
|
|
|
|
} elsif ($marker == 0xe3) { # APP3 (Kodak "Meta", Stim) |
7076
|
21
|
100
|
33
|
|
|
266
|
if ($$segDataPt =~ /^(Meta|META|Exif)\0\0/) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
7077
|
19
|
|
|
|
|
59
|
undef $dumpType; # (will be dumped here) |
7078
|
19
|
|
|
|
|
77
|
DirStart(\%dirInfo, 6, 6); |
7079
|
19
|
50
|
|
|
|
146
|
if ($htmlDump) { |
7080
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 10, 'APP3 Meta header'); |
7081
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7082
|
|
|
|
|
|
|
} |
7083
|
19
|
|
|
|
|
87
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Kodak::Meta'); |
7084
|
19
|
|
|
|
|
133
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
7085
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^Stim\0/) { |
7086
|
0
|
|
|
|
|
0
|
undef $dumpType; # (will be dumped here) |
7087
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 6, 6); |
7088
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7089
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP3 header', "Data size: $length bytes"); |
7090
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, 5, 'Stim header', 'APP3 data type: Stim'); |
7091
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7092
|
|
|
|
|
|
|
} |
7093
|
|
|
|
|
|
|
# extract the Stim information (it is in standard TIFF format) |
7094
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Stim::Main'); |
7095
|
0
|
|
|
|
|
0
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
7096
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^_JPSJPS_/) { |
7097
|
1
|
|
|
|
|
3
|
$dumpType = 'JPS'; |
7098
|
1
|
50
|
|
|
|
10
|
$self->OverrideFileType('JPS') if $$self{FILE_TYPE} eq 'JPEG'; |
7099
|
1
|
|
|
|
|
4
|
SetByteOrder('MM'); |
7100
|
1
|
|
|
|
|
8
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::JPS'); |
7101
|
1
|
|
|
|
|
7
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7102
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} or $$self{Make} eq 'DJI') { |
7103
|
1
|
50
|
|
|
|
8
|
$dumpType = $$self{HasIJPEG} ? 'InfiRay ImagingData' : 'DJI ThermalData'; |
7104
|
|
|
|
|
|
|
# add this data to the combined data if it exists |
7105
|
1
|
|
|
|
|
3
|
my $dataPt = $segDataPt; |
7106
|
1
|
50
|
|
|
|
5
|
if (defined $combinedSegData) { |
7107
|
0
|
|
|
|
|
0
|
$combinedSegData .= $$segDataPt; |
7108
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7109
|
|
|
|
|
|
|
} |
7110
|
1
|
50
|
|
|
|
6
|
if ($nextMarker == $marker) { |
7111
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7112
|
|
|
|
|
|
|
} else { |
7113
|
|
|
|
|
|
|
# process InfiRay/DJI thermal data |
7114
|
1
|
|
|
|
|
6
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
7115
|
1
|
|
|
|
|
8
|
$self->HandleTag($tagTablePtr, 'APP3', $$dataPt); |
7116
|
1
|
|
|
|
|
2
|
undef $combinedSegData; |
7117
|
|
|
|
|
|
|
} |
7118
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG}) { |
7119
|
0
|
|
|
|
|
0
|
$dumpType = 'InfiRay Data', |
7120
|
|
|
|
|
|
|
|
7121
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^\xff\xd8\xff\xdb/) { |
7122
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; # (Samsung, HP, BenQ) |
7123
|
0
|
|
|
|
|
0
|
$preview = $$segDataPt; |
7124
|
|
|
|
|
|
|
} |
7125
|
21
|
50
|
33
|
|
|
179
|
if ($preview and $nextMarker ne 0xe4) { # this preview continues in APP4 |
7126
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
7127
|
0
|
|
|
|
|
0
|
undef $preview; |
7128
|
|
|
|
|
|
|
} |
7129
|
|
|
|
|
|
|
} elsif ($marker == 0xe4) { # APP4 (InfiRay, "SCALADO", FPXR, DJI, PreviewImage) |
7130
|
1
|
50
|
33
|
|
|
25
|
if ($$segDataPt =~ /^SCALADO\0/ and $length >= 16) { |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
7131
|
0
|
|
|
|
|
0
|
$dumpType = 'SCALADO'; |
7132
|
0
|
|
|
|
|
0
|
my ($num, $idx, $len) = unpack('x8n2N', $$segDataPt); |
7133
|
|
|
|
|
|
|
# assume that the segments are in order and just concatinate them |
7134
|
0
|
0
|
|
|
|
0
|
$scalado = '' unless defined $scalado; |
7135
|
0
|
|
|
|
|
0
|
$scalado .= substr($$segDataPt, 16); |
7136
|
0
|
0
|
|
|
|
0
|
if ($idx == $num - 1) { |
7137
|
0
|
0
|
|
|
|
0
|
if ($len != length $scalado) { |
7138
|
0
|
|
|
|
|
0
|
$self->Warn('Possibly corrupted APP4 SCALADO data', 1); |
7139
|
|
|
|
|
|
|
} |
7140
|
0
|
|
|
|
|
0
|
my %dirInfo = ( |
7141
|
|
|
|
|
|
|
Parent => $markerName, |
7142
|
|
|
|
|
|
|
DataPt => \$scalado, |
7143
|
|
|
|
|
|
|
); |
7144
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Scalado::Main'); |
7145
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7146
|
0
|
|
|
|
|
0
|
undef $scalado; |
7147
|
|
|
|
|
|
|
} |
7148
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^FPXR\0/) { |
7149
|
0
|
0
|
|
|
|
0
|
next if $fast > 1; # skip processing for very fast |
7150
|
0
|
|
|
|
|
0
|
$dumpType = 'FPXR'; |
7151
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::FlashPix::Main'); |
7152
|
|
|
|
|
|
|
# set flag if this is the last FPXR segment |
7153
|
0
|
|
0
|
|
|
0
|
$dirInfo{LastFPXR} = not ($nextMarker==$marker and $$nextSegDataPt=~/^FPXR\0/), |
7154
|
|
|
|
|
|
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7155
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^\xaa\x55\x12\x06/) { |
7156
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalParams'; |
7157
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 0, 0); |
7158
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams'); |
7159
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7160
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^(.{32})?.{32}\x2c\x01\x20\0/s) { |
7161
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalParams2'; |
7162
|
0
|
0
|
|
|
|
0
|
DirStart(\%dirInfo, $1 ? 32 : 0, 0); |
7163
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams2'); |
7164
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7165
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI' and $$segDataPt =~ /^.{32}\xaa\x55\x38\0/s) { |
7166
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalParams3'; |
7167
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 32, 0); |
7168
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::ThermalParams3'); |
7169
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7170
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} and $length >= 120) { |
7171
|
1
|
|
|
|
|
4
|
$dumpType = 'InfiRay Factory'; |
7172
|
1
|
|
|
|
|
4
|
SetByteOrder('II'); |
7173
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::Factory'); |
7174
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7175
|
|
|
|
|
|
|
} elsif ($preview) { |
7176
|
|
|
|
|
|
|
# continued Samsung S1060 preview from APP3 |
7177
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; |
7178
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
7179
|
|
|
|
|
|
|
} |
7180
|
|
|
|
|
|
|
# (also seen "QTI Debug Metadata\0" segment in some newer Samsung images) |
7181
|
|
|
|
|
|
|
# BenQ DC E1050 continues preview in APP5 |
7182
|
1
|
50
|
33
|
|
|
19
|
if ($preview and $nextMarker ne 0xe5) { |
7183
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
7184
|
0
|
|
|
|
|
0
|
undef $preview; |
7185
|
|
|
|
|
|
|
} |
7186
|
|
|
|
|
|
|
} elsif ($marker == 0xe5) { # APP5 (InfiRay, Ricoh "RMETA") |
7187
|
21
|
100
|
33
|
|
|
196
|
if ($$segDataPt =~ /^RMETA\0/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
7188
|
|
|
|
|
|
|
# (NOTE: apparently these may span multiple segments, but I haven't seen |
7189
|
|
|
|
|
|
|
# a sample like this, so multi-segment support hasn't yet been implemented) |
7190
|
20
|
|
|
|
|
65
|
$dumpType = 'Ricoh RMETA'; |
7191
|
20
|
|
|
|
|
102
|
DirStart(\%dirInfo, 6, 6); |
7192
|
20
|
|
|
|
|
140
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Ricoh::RMETA'); |
7193
|
20
|
|
|
|
|
137
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7194
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^ssuniqueid\0/) { |
7195
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Samsung::APP5'); |
7196
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'ssuniqueid', substr($$segDataPt, 11)); |
7197
|
|
|
|
|
|
|
} elsif ($$self{Make} eq 'DJI') { |
7198
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI ThermalCal'; |
7199
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
7200
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP5', $$segDataPt); |
7201
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} and $length >= 38) { |
7202
|
1
|
|
|
|
|
3
|
$dumpType = 'InfiRay Picture'; |
7203
|
1
|
|
|
|
|
6
|
SetByteOrder('II'); |
7204
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::Picture'); |
7205
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7206
|
|
|
|
|
|
|
} elsif ($preview) { |
7207
|
0
|
|
|
|
|
0
|
$dumpType = 'PreviewImage'; |
7208
|
0
|
|
|
|
|
0
|
$preview .= $$segDataPt; |
7209
|
0
|
|
|
|
|
0
|
$self->FoundTag('PreviewImage', $preview); |
7210
|
0
|
|
|
|
|
0
|
undef $preview; |
7211
|
|
|
|
|
|
|
} |
7212
|
|
|
|
|
|
|
} elsif ($marker == 0xe6) { # APP6 (InfiRay, Toshiba EPPIM, NITF, HP_TDHD) |
7213
|
38
|
100
|
33
|
|
|
432
|
if ($$segDataPt =~ /^EPPIM\0/) { |
|
|
100
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7214
|
18
|
|
|
|
|
52
|
undef $dumpType; # (will be dumped here) |
7215
|
18
|
|
|
|
|
77
|
DirStart(\%dirInfo, 6, 6); |
7216
|
18
|
50
|
|
|
|
88
|
if ($htmlDump) { |
7217
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 10, 'APP6 EPPIM header'); |
7218
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7219
|
|
|
|
|
|
|
} |
7220
|
18
|
|
|
|
|
88
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::EPPIM'); |
7221
|
18
|
|
|
|
|
106
|
$self->ProcessTIFF(\%dirInfo, $tagTablePtr); |
7222
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^NITF\0/) { |
7223
|
18
|
|
|
|
|
59
|
$dumpType = 'NITF'; |
7224
|
18
|
|
|
|
|
73
|
SetByteOrder('MM'); |
7225
|
18
|
|
|
|
|
137
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::NITF'); |
7226
|
18
|
|
|
|
|
107
|
DirStart(\%dirInfo, 5); |
7227
|
18
|
|
|
|
|
112
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7228
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^TDHD\x01\0\0\0/ and $length > 12) { |
7229
|
|
|
|
|
|
|
# HP Photosmart R837 APP6 "TDHD" segment |
7230
|
0
|
|
|
|
|
0
|
$dumpType = 'TDHD'; |
7231
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::HP::TDHD'); |
7232
|
|
|
|
|
|
|
# (ignore first TDHD element because size includes 12-byte tag header) |
7233
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 12); |
7234
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7235
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^GoPro\0/) { |
7236
|
|
|
|
|
|
|
# GoPro segment |
7237
|
1
|
|
|
|
|
2
|
$dumpType = 'GoPro'; |
7238
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::GoPro::GPMF'); |
7239
|
1
|
|
|
|
|
3
|
DirStart(\%dirInfo, 6); |
7240
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7241
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^DTAT\0\0.\{/s) { |
7242
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI_DTAT'; |
7243
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Main'); |
7244
|
0
|
|
|
|
|
0
|
$self->HandleTag($tagTablePtr, 'APP6', $$segDataPt); |
7245
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} and $length >= 129) { |
7246
|
1
|
|
|
|
|
4
|
$dumpType = 'InfiRay MixMode'; |
7247
|
1
|
|
|
|
|
6
|
SetByteOrder('II'); |
7248
|
1
|
|
|
|
|
4
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::MixMode'); |
7249
|
1
|
|
|
|
|
4
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7250
|
|
|
|
|
|
|
} |
7251
|
|
|
|
|
|
|
} elsif ($marker == 0xe7) { # APP7 (InfiRay, Pentax, Huawei, Qualcomm) |
7252
|
20
|
50
|
33
|
|
|
309
|
if ($$segDataPt =~ /^PENTAX \0(II|MM)/) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7253
|
|
|
|
|
|
|
# found in K-3 images (is this multi-segment??) |
7254
|
0
|
|
|
|
|
0
|
SetByteOrder($1); |
7255
|
0
|
|
|
|
|
0
|
undef $dumpType; # (dump this ourself) |
7256
|
0
|
|
|
|
|
0
|
my $hdrLen = 10; |
7257
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Pentax::Main'); |
7258
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, $hdrLen, 0); |
7259
|
0
|
|
|
|
|
0
|
$dirInfo{DirName} = 'Pentax APP7'; |
7260
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7261
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); |
7262
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Pentax header', 'APP7 data type: Pentax'); |
7263
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7264
|
|
|
|
|
|
|
} |
7265
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7266
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^HUAWEI\0\0(II|MM)/) { |
7267
|
0
|
|
|
|
|
0
|
SetByteOrder($1); |
7268
|
0
|
|
|
|
|
0
|
undef $dumpType; # (dump this ourself) |
7269
|
0
|
|
|
|
|
0
|
my $hdrLen = 16; |
7270
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Unknown::Main'); |
7271
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, $hdrLen, 8); |
7272
|
0
|
|
|
|
|
0
|
$dirInfo{DirName} = 'Huawei APP7'; |
7273
|
0
|
0
|
|
|
|
0
|
if ($htmlDump) { |
7274
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, 4, 'APP7 header', "Data size: $length bytes"); |
7275
|
0
|
|
|
|
|
0
|
$self->HDump($segPos, $hdrLen, 'Huawei header', 'APP7 data type: Huawei'); |
7276
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7277
|
|
|
|
|
|
|
} |
7278
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP0} = 'APP7'; |
7279
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP1} = 'Huawei'; |
7280
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7281
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP0}; |
7282
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP1}; |
7283
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^DJI-DBG\0/) { |
7284
|
0
|
|
|
|
|
0
|
$dumpType = 'DJI Info'; |
7285
|
0
|
|
|
|
|
0
|
my $tagTablePtr = GetTagTable('Image::ExifTool::DJI::Info'); |
7286
|
0
|
|
|
|
|
0
|
DirStart(\%dirInfo, 8, 0); |
7287
|
0
|
|
|
|
|
0
|
$$self{SET_GROUP0} = 'APP7'; |
7288
|
0
|
|
|
|
|
0
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7289
|
0
|
|
|
|
|
0
|
delete $$self{SET_GROUP0}; |
7290
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^\x1aQualcomm Camera Attributes/) { |
7291
|
|
|
|
|
|
|
# found in HP iPAQ_VoiceMessenger |
7292
|
19
|
|
|
|
|
55
|
$dumpType = 'Qualcomm'; |
7293
|
19
|
|
|
|
|
73
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Qualcomm::Main'); |
7294
|
19
|
|
|
|
|
120
|
DirStart(\%dirInfo, 27); |
7295
|
19
|
|
|
|
|
88
|
$dirInfo{DirName} = 'Qualcomm'; |
7296
|
19
|
|
|
|
|
101
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7297
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} and $length >= 32) { |
7298
|
1
|
|
|
|
|
5
|
$dumpType = 'InfiRay OpMode'; |
7299
|
1
|
|
|
|
|
3
|
SetByteOrder('II'); |
7300
|
1
|
|
|
|
|
13
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::OpMode'); |
7301
|
1
|
|
|
|
|
6
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7302
|
|
|
|
|
|
|
} |
7303
|
|
|
|
|
|
|
} elsif ($marker == 0xe8) { # APP8 (InfiRay, SPIFF) |
7304
|
|
|
|
|
|
|
# my sample SPIFF has 32 bytes of data, but spec states 30 |
7305
|
20
|
100
|
66
|
|
|
175
|
if ($$segDataPt =~ /^SPIFF\0/ and $length == 32) { |
|
|
50
|
33
|
|
|
|
|
7306
|
19
|
|
|
|
|
50
|
$dumpType = 'SPIFF'; |
7307
|
19
|
|
|
|
|
74
|
DirStart(\%dirInfo, 6); |
7308
|
19
|
|
|
|
|
87
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::SPIFF'); |
7309
|
19
|
|
|
|
|
113
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7310
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} and $length >= 32) { |
7311
|
1
|
|
|
|
|
3
|
$dumpType = 'InfiRay Isothermal'; |
7312
|
1
|
|
|
|
|
5
|
SetByteOrder('II'); |
7313
|
1
|
|
|
|
|
7
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::Isothermal'); |
7314
|
1
|
|
|
|
|
6
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7315
|
|
|
|
|
|
|
} |
7316
|
|
|
|
|
|
|
} elsif ($marker == 0xe9) { # APP9 (InfiRay, Media Jukebox) |
7317
|
20
|
100
|
66
|
|
|
241
|
if ($$segDataPt =~ /^Media Jukebox\0/ and $length > 22) { |
|
|
50
|
33
|
|
|
|
|
7318
|
19
|
|
|
|
|
71
|
$dumpType = 'MediaJukebox'; |
7319
|
|
|
|
|
|
|
# (start parsing after the "") |
7320
|
19
|
|
|
|
|
108
|
DirStart(\%dirInfo, 22); |
7321
|
19
|
|
|
|
|
120
|
$dirInfo{DirName} = 'MediaJukebox'; |
7322
|
19
|
|
|
|
|
204
|
require Image::ExifTool::XMP; |
7323
|
19
|
|
|
|
|
161
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::MediaJukebox'); |
7324
|
19
|
|
|
|
|
149
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr, \&Image::ExifTool::XMP::ProcessXMP); |
7325
|
|
|
|
|
|
|
} elsif ($$self{HasIJPEG} and $length >= 768) { |
7326
|
1
|
|
|
|
|
4
|
$dumpType = 'InfiRay Sensor'; |
7327
|
1
|
|
|
|
|
16
|
SetByteOrder('II'); |
7328
|
1
|
|
|
|
|
3
|
my $tagTablePtr = GetTagTable('Image::ExifTool::InfiRay::Sensor'); |
7329
|
1
|
|
|
|
|
5
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7330
|
|
|
|
|
|
|
} |
7331
|
|
|
|
|
|
|
} elsif ($marker == 0xea) { # APP10 (PhotoStudio Unicode comments) |
7332
|
19
|
50
|
0
|
|
|
144
|
if ($$segDataPt =~ /^UNICODE\0/) { |
|
|
0
|
|
|
|
|
|
7333
|
19
|
|
|
|
|
60
|
$dumpType = 'PhotoStudio'; |
7334
|
19
|
|
|
|
|
109
|
my $comment = $self->Decode(substr($$segDataPt,8), 'UCS2', 'MM'); |
7335
|
19
|
|
|
|
|
143
|
$self->FoundTag('Comment', $comment); |
7336
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^AROT\0/ and $length > 10) { |
7337
|
|
|
|
|
|
|
# iPhone "AROT" segment containing integrated intensity per 16 scan lines |
7338
|
|
|
|
|
|
|
# (with number of elements N = ImageHeight / 16 - 1, ref PH/NealKrawetz) |
7339
|
0
|
|
|
|
|
0
|
$xtra = 'segment (N=' . unpack('x6N', $$segDataPt) . ')'; |
7340
|
|
|
|
|
|
|
} |
7341
|
|
|
|
|
|
|
} elsif ($marker == 0xeb) { # APP11 (JPEG-HDR, JUMBF) |
7342
|
38
|
100
|
33
|
|
|
446
|
if ($$segDataPt =~ /^HDR_RI /) { |
|
|
50
|
|
|
|
|
|
7343
|
19
|
|
|
|
|
53
|
$dumpType = 'JPEG-HDR'; |
7344
|
19
|
|
|
|
|
57
|
my $dataPt = $segDataPt; |
7345
|
19
|
50
|
|
|
|
74
|
if (defined $combinedSegData) { |
7346
|
0
|
0
|
|
|
|
0
|
if ($$segDataPt =~ /~\0/g) { |
7347
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,pos($$segDataPt)); |
7348
|
|
|
|
|
|
|
} else { |
7349
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid format for JPEG-HDR extended segment'); |
7350
|
|
|
|
|
|
|
} |
7351
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7352
|
|
|
|
|
|
|
} |
7353
|
19
|
50
|
33
|
|
|
170
|
if ($nextMarker == $marker and $$nextSegDataPt =~ /^HDR_RI /) { |
7354
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7355
|
|
|
|
|
|
|
} else { |
7356
|
19
|
|
|
|
|
68
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::HDR'); |
7357
|
19
|
|
|
|
|
94
|
my %dirInfo = ( DataPt => $dataPt ); |
7358
|
19
|
|
|
|
|
109
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7359
|
19
|
|
|
|
|
140
|
undef $combinedSegData; |
7360
|
|
|
|
|
|
|
} |
7361
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^(JP..)/s and length($$segDataPt) >= 16) { |
7362
|
|
|
|
|
|
|
# JUMBF extension marker |
7363
|
19
|
|
|
|
|
554
|
my $hdr = $1; |
7364
|
19
|
|
|
|
|
57
|
$dumpType = 'JUMBF'; |
7365
|
19
|
|
|
|
|
79
|
SetByteOrder('MM'); |
7366
|
19
|
|
|
|
|
178
|
my $seq = Get32u($segDataPt, 4) - 1; # (start from 0) |
7367
|
19
|
|
|
|
|
130
|
my $len = Get32u($segDataPt, 8); |
7368
|
19
|
|
|
|
|
93
|
my $type = substr($$segDataPt, 12, 4); |
7369
|
19
|
|
|
|
|
390
|
my $hdrLen; |
7370
|
19
|
50
|
33
|
|
|
114
|
if ($len == 1 and length($$segDataPt) >= 24) { |
7371
|
0
|
|
|
|
|
0
|
$len = Get64u($$segDataPt, 16); |
7372
|
0
|
|
|
|
|
0
|
$hdrLen = 16; |
7373
|
|
|
|
|
|
|
} else { |
7374
|
19
|
|
|
|
|
52
|
$hdrLen = 8; |
7375
|
|
|
|
|
|
|
} |
7376
|
19
|
50
|
|
|
|
124
|
$jumbfChunk{$type} or $jumbfChunk{$type} = [ ]; |
7377
|
19
|
50
|
|
|
|
135
|
if ($len < $hdrLen) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7378
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid JUMBF segment'); |
7379
|
|
|
|
|
|
|
} elsif ($seq < 0) { |
7380
|
0
|
|
|
|
|
0
|
$self->Warn('Invalid JUMBF sequence number'); |
7381
|
|
|
|
|
|
|
} elsif (defined $jumbfChunk{$type}[$seq]) { |
7382
|
0
|
|
|
|
|
0
|
$self->Warn('Duplicate JUMBF sequence number'); |
7383
|
|
|
|
|
|
|
} else { |
7384
|
|
|
|
|
|
|
# add to list of JUMBF chunks |
7385
|
19
|
|
|
|
|
83
|
$jumbfChunk{$type}[$seq] = substr($$segDataPt, 8 + $hdrLen); |
7386
|
|
|
|
|
|
|
# check to see if we have a complete JUMBF box |
7387
|
19
|
|
|
|
|
50
|
my $size = $hdrLen; |
7388
|
19
|
|
|
|
|
43
|
foreach (@{$jumbfChunk{$type}}) { |
|
19
|
|
|
|
|
68
|
|
7389
|
19
|
50
|
|
|
|
71
|
defined $_ or $size = 0, last; |
7390
|
19
|
|
|
|
|
53
|
$size += length $_; |
7391
|
|
|
|
|
|
|
} |
7392
|
19
|
50
|
|
|
|
71
|
if ($size == $len) { |
7393
|
19
|
|
|
|
|
61
|
my $buff = join '', substr($$segDataPt,8,$hdrLen), @{$jumbfChunk{$type}}; |
|
19
|
|
|
|
|
84
|
|
7394
|
19
|
|
|
|
|
68
|
$dirInfo{DataPt} = \$buff; |
7395
|
19
|
|
|
|
|
55
|
$dirInfo{DataPos} = $segPos + 8; # (shows correct offsets for single-segment JUMBF) |
7396
|
19
|
|
|
|
|
63
|
$dirInfo{DataLen} = $dirInfo{DirLen} = $size; |
7397
|
19
|
|
|
|
|
83
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Jpeg2000::Main'); |
7398
|
19
|
|
|
|
|
144
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7399
|
19
|
|
|
|
|
112
|
delete $jumbfChunk{$type}; |
7400
|
|
|
|
|
|
|
} |
7401
|
|
|
|
|
|
|
} |
7402
|
|
|
|
|
|
|
} |
7403
|
|
|
|
|
|
|
} elsif ($marker == 0xec) { # APP12 (Ducky, Picture Info) |
7404
|
40
|
100
|
|
|
|
233
|
if ($$segDataPt =~ /^Ducky/) { |
7405
|
21
|
|
|
|
|
86
|
$dumpType = 'Ducky'; |
7406
|
21
|
|
|
|
|
98
|
DirStart(\%dirInfo, 5); |
7407
|
21
|
|
|
|
|
108
|
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::Ducky'); |
7408
|
21
|
|
|
|
|
115
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7409
|
|
|
|
|
|
|
} else { |
7410
|
19
|
|
|
|
|
93
|
my $tagTablePtr = GetTagTable('Image::ExifTool::APP12::PictureInfo'); |
7411
|
19
|
50
|
|
|
|
105
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr) and $dumpType = 'Picture Info'; |
7412
|
|
|
|
|
|
|
} |
7413
|
|
|
|
|
|
|
} elsif ($marker == 0xed) { # APP13 (Photoshop, Adobe_CM) |
7414
|
82
|
|
|
|
|
215
|
my $isOld; |
7415
|
82
|
100
|
50
|
|
|
1307
|
if ($$segDataPt =~ /^$psAPP13hdr/ or ($$segDataPt =~ /^$psAPP13old/ and $isOld=1)) { |
|
|
50
|
66
|
|
|
|
|
7416
|
63
|
|
|
|
|
228
|
$dumpType = 'Photoshop'; |
7417
|
|
|
|
|
|
|
# add this data to the combined data if it exists |
7418
|
63
|
|
|
|
|
155
|
my $dataPt = $segDataPt; |
7419
|
63
|
50
|
|
|
|
300
|
if (defined $combinedSegData) { |
7420
|
0
|
|
|
|
|
0
|
$combinedSegData .= substr($$segDataPt,length($psAPP13hdr)); |
7421
|
0
|
|
|
|
|
0
|
$dataPt = \$combinedSegData; |
7422
|
|
|
|
|
|
|
} |
7423
|
|
|
|
|
|
|
# peek ahead to see if the next segment is photoshop data too |
7424
|
63
|
50
|
66
|
|
|
420
|
if ($nextMarker == $marker and $$nextSegDataPt =~ /^$psAPP13hdr/) { |
7425
|
|
|
|
|
|
|
# initialize combined data if necessary |
7426
|
0
|
0
|
|
|
|
0
|
$combinedSegData = $$segDataPt unless defined $combinedSegData; |
7427
|
|
|
|
|
|
|
# (will handle the Photoshop data the next time around) |
7428
|
|
|
|
|
|
|
} else { |
7429
|
63
|
50
|
|
|
|
254
|
my $hdrLen = $isOld ? 27 : 14; |
7430
|
|
|
|
|
|
|
# process APP13 Photoshop record |
7431
|
63
|
|
|
|
|
287
|
my $tagTablePtr = GetTagTable('Image::ExifTool::Photoshop::Main'); |
7432
|
63
|
|
|
|
|
594
|
my %dirInfo = ( |
7433
|
|
|
|
|
|
|
DataPt => $dataPt, |
7434
|
|
|
|
|
|
|
DataPos => $segPos, |
7435
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
7436
|
|
|
|
|
|
|
DirStart => $hdrLen, # directory starts after identifier |
7437
|
|
|
|
|
|
|
DirLen => length($$dataPt) - $hdrLen, |
7438
|
|
|
|
|
|
|
Parent => $markerName, |
7439
|
|
|
|
|
|
|
); |
7440
|
63
|
|
|
|
|
340
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7441
|
63
|
|
|
|
|
342
|
undef $combinedSegData; |
7442
|
|
|
|
|
|
|
} |
7443
|
|
|
|
|
|
|
} elsif ($$segDataPt =~ /^Adobe_CM/) { |
7444
|
19
|
|
|
|
|
61
|
$dumpType = 'Adobe_CM'; |
7445
|
19
|
|
|
|
|
71
|
SetByteOrder('MM'); |
7446
|
19
|
|
|
|
|
134
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::AdobeCM'); |
7447
|
19
|
|
|
|
|
145
|
DirStart(\%dirInfo, 8); |
7448
|
19
|
|
|
|
|
105
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7449
|
|
|
|
|
|
|
} |
7450
|
|
|
|
|
|
|
} elsif ($marker == 0xee) { # APP14 (Adobe) |
7451
|
45
|
50
|
|
|
|
496
|
if ($$segDataPt =~ /^Adobe/) { |
7452
|
|
|
|
|
|
|
# extract as a block if requested, or if copying tags from file |
7453
|
45
|
100
|
66
|
|
|
405
|
if ($$req{adobe} or |
|
|
|
66
|
|
|
|
|
7454
|
|
|
|
|
|
|
# (not extracted normally, so check TAGS_FROM_FILE) |
7455
|
|
|
|
|
|
|
($$self{TAGS_FROM_FILE} and not $$self{EXCL_TAG_LOOKUP}{adobe})) |
7456
|
|
|
|
|
|
|
{ |
7457
|
16
|
|
|
|
|
77
|
$self->FoundTag('Adobe', $$segDataPt); |
7458
|
|
|
|
|
|
|
} |
7459
|
45
|
|
|
|
|
174
|
$dumpType = 'Adobe'; |
7460
|
45
|
|
|
|
|
196
|
SetByteOrder('MM'); |
7461
|
45
|
|
|
|
|
252
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::Adobe'); |
7462
|
45
|
|
|
|
|
221
|
DirStart(\%dirInfo, 5); |
7463
|
45
|
|
|
|
|
210
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7464
|
|
|
|
|
|
|
} |
7465
|
|
|
|
|
|
|
} elsif ($marker == 0xef) { # APP15 (GraphicConverter) |
7466
|
19
|
50
|
33
|
|
|
195
|
if ($$segDataPt =~ /^Q\s*(\d+)/ and $length == 4) { |
7467
|
19
|
|
|
|
|
57
|
$dumpType = 'GraphicConverter'; |
7468
|
19
|
|
|
|
|
62
|
my $tagTablePtr = GetTagTable('Image::ExifTool::JPEG::GraphConv'); |
7469
|
19
|
|
|
|
|
115
|
$self->HandleTag($tagTablePtr, 'Q', $1); |
7470
|
|
|
|
|
|
|
} |
7471
|
|
|
|
|
|
|
} elsif ($marker == 0xfe) { # COM (JPEG comment) |
7472
|
27
|
|
|
|
|
99
|
$dumpType = 'Comment'; |
7473
|
27
|
|
|
|
|
105
|
$$segDataPt =~ s/\0+$//; # some dumb softwares add null terminators |
7474
|
27
|
|
|
|
|
105
|
$self->FoundTag('Comment', $$segDataPt); |
7475
|
|
|
|
|
|
|
} elsif ($marker == 0x64) { # CME (J2C comment and extension) |
7476
|
2
|
|
|
|
|
5
|
$dumpType = 'Comment'; |
7477
|
2
|
50
|
|
|
|
8
|
if ($length > 2) { |
7478
|
2
|
|
|
|
|
5
|
my $reg = unpack('n', $$segDataPt); # get registration value |
7479
|
2
|
|
|
|
|
7
|
my $val = substr($$segDataPt, 2); |
7480
|
2
|
50
|
|
|
|
10
|
$val = $self->Decode($val, 'Latin') if $reg == 1; |
7481
|
|
|
|
|
|
|
# (actually an extension for $reg==65535, but store as binary comment) |
7482
|
2
|
50
|
33
|
|
|
13
|
$self->FoundTag('Comment', ($reg==0 or $reg==65535) ? \$val : $val); |
7483
|
|
|
|
|
|
|
} |
7484
|
|
|
|
|
|
|
} elsif ($marker == 0x51) { # SIZ (J2C) |
7485
|
1
|
|
|
|
|
5
|
my ($w, $h) = unpack('x2N2', $$segDataPt); |
7486
|
1
|
|
|
|
|
5
|
$self->FoundTag('ImageWidth', $w); |
7487
|
1
|
|
|
|
|
7
|
$self->FoundTag('ImageHeight', $h); |
7488
|
|
|
|
|
|
|
} elsif (($marker & 0xf0) != 0xe0) { |
7489
|
492
|
|
|
|
|
1306
|
$dumpType = "$markerName segment"; |
7490
|
492
|
|
|
|
|
1393
|
$desc = "[JPEG $markerName]"; # (other known JPEG segments) |
7491
|
|
|
|
|
|
|
} |
7492
|
1207
|
100
|
|
|
|
3443
|
if (defined $dumpType) { |
7493
|
1151
|
50
|
33
|
|
|
2963
|
if (not $dumpType and ($$options{Unknown} or $$options{Validate})) { |
|
|
|
66
|
|
|
|
|
7494
|
0
|
0
|
|
|
|
0
|
my $str = ($$segDataPt =~ /^([\x20-\x7e]{1,20})\0/) ? " '${1}'" : ''; |
7495
|
0
|
0
|
|
|
|
0
|
$xtra = 'segment' unless $xtra; |
7496
|
0
|
|
|
|
|
0
|
$self->Warn("Unknown $markerName$str $xtra", 1); |
7497
|
|
|
|
|
|
|
} |
7498
|
1151
|
50
|
|
|
|
2723
|
if ($htmlDump) { |
7499
|
0
|
0
|
|
|
|
0
|
$desc or $desc = $markerName . ($dumpType ? " $dumpType" : '') . ' segment'; |
|
|
0
|
|
|
|
|
|
7500
|
0
|
|
|
|
|
0
|
$self->HDump($segPos-4, $length+4, $desc, $tip, 0x08); |
7501
|
0
|
|
|
|
|
0
|
$dumpEnd = $segPos + $length; |
7502
|
|
|
|
|
|
|
} |
7503
|
|
|
|
|
|
|
} |
7504
|
1207
|
|
|
|
|
4630
|
undef $$segDataPt; |
7505
|
|
|
|
|
|
|
} |
7506
|
|
|
|
|
|
|
# process extended XMP now if it existed |
7507
|
245
|
100
|
|
|
|
937
|
if (%extendedXMP) { |
7508
|
1
|
|
|
|
|
5
|
my $guid; |
7509
|
|
|
|
|
|
|
# GUID indicated by the last main XMP segment |
7510
|
1
|
|
50
|
|
|
7
|
my $goodGuid = $$self{VALUE}{HasExtendedXMP} || ''; |
7511
|
|
|
|
|
|
|
# GUID of the extended XMP that we will process ('2' for all) |
7512
|
1
|
|
50
|
|
|
6
|
my $readGuid = $$options{ExtendedXMP} || 0; |
7513
|
1
|
50
|
|
|
|
10
|
$readGuid = $goodGuid if $readGuid eq '1'; |
7514
|
1
|
|
|
|
|
8
|
foreach $guid (sort keys %extendedXMP) { |
7515
|
1
|
50
|
|
|
|
6
|
next unless length $guid == 32; # ignore other (internal) keys |
7516
|
1
|
|
|
|
|
3
|
my $extXMP = $extendedXMP{$guid}; |
7517
|
1
|
|
|
|
|
2
|
my ($off, @offsets, $warn); |
7518
|
|
|
|
|
|
|
# make sure we have all chunks, and create a list of sorted offsets |
7519
|
1
|
|
|
|
|
7
|
for ($off=0; $off<$$extXMP{Size}; ) { |
7520
|
2
|
50
|
|
|
|
8
|
last unless defined $$extXMP{$off}; |
7521
|
2
|
|
|
|
|
6
|
push @offsets, $off; |
7522
|
2
|
|
|
|
|
5
|
$off += length $$extXMP{$off}; |
7523
|
|
|
|
|
|
|
} |
7524
|
1
|
50
|
|
|
|
5
|
unless ($off == $$extXMP{Size}) { |
7525
|
0
|
|
|
|
|
0
|
$self->Warn("Incomplete extended XMP (GUID $guid)"); |
7526
|
0
|
|
|
|
|
0
|
next; |
7527
|
|
|
|
|
|
|
} |
7528
|
1
|
50
|
33
|
|
|
10
|
if ($guid eq $readGuid or $readGuid eq '2') { |
7529
|
1
|
50
|
|
|
|
5
|
$warn = 'Reading non-' if $guid ne $goodGuid; |
7530
|
1
|
|
|
|
|
4
|
my $buff = ''; |
7531
|
|
|
|
|
|
|
# assemble XMP all together |
7532
|
1
|
|
|
|
|
8
|
$buff .= $$extXMP{$_} foreach @offsets; |
7533
|
1
|
|
|
|
|
6
|
my $tagTablePtr = GetTagTable('Image::ExifTool::XMP::Main'); |
7534
|
1
|
|
|
|
|
13
|
my %dirInfo = ( |
7535
|
|
|
|
|
|
|
DataPt => \$buff, |
7536
|
|
|
|
|
|
|
Parent => 'APP1', |
7537
|
|
|
|
|
|
|
IsExtended => 1, |
7538
|
|
|
|
|
|
|
); |
7539
|
1
|
|
|
|
|
3
|
$$path[$pn] = 'APP1'; |
7540
|
1
|
|
|
|
|
6
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7541
|
1
|
|
|
|
|
5
|
pop @$path; |
7542
|
|
|
|
|
|
|
} else { |
7543
|
0
|
|
|
|
|
0
|
$warn = 'Ignored '; |
7544
|
0
|
0
|
|
|
|
0
|
$warn .= 'non-' if $guid ne $goodGuid; |
7545
|
|
|
|
|
|
|
} |
7546
|
1
|
50
|
|
|
|
5
|
$self->Warn("${warn}standard extended XMP (GUID $guid)") if $warn; |
7547
|
1
|
|
|
|
|
6
|
delete $extendedXMP{$guid}; |
7548
|
|
|
|
|
|
|
} |
7549
|
|
|
|
|
|
|
} |
7550
|
|
|
|
|
|
|
# print verbose MD5 message if necessary |
7551
|
245
|
50
|
33
|
|
|
1083
|
print $out "$$self{INDENT}(ImageDataMD5: $md5size bytes of JPEG image data)\n" if $md5size and $verbose; |
7552
|
|
|
|
|
|
|
# calculate JPEGDigest if requested |
7553
|
245
|
100
|
|
|
|
964
|
if (@dqt) { |
7554
|
1
|
|
|
|
|
1529
|
require Image::ExifTool::JPEGDigest; |
7555
|
1
|
|
|
|
|
28
|
Image::ExifTool::JPEGDigest::Calculate($self, \@dqt, $subSampling); |
7556
|
|
|
|
|
|
|
} |
7557
|
|
|
|
|
|
|
# issue necessary warnings |
7558
|
245
|
50
|
|
|
|
775
|
$self->Warn('Invalid JUMBF size or missing JUMBF chunk') if %jumbfChunk; |
7559
|
245
|
50
|
|
|
|
800
|
$self->Warn('Incomplete ICC_Profile record', 1) if defined $iccChunkCount; |
7560
|
245
|
50
|
|
|
|
794
|
$self->Warn('Incomplete FLIR record', 1) if defined $flirCount; |
7561
|
245
|
50
|
|
|
|
957
|
$self->Warn('Error reading PreviewImage', 1) if $$self{PreviewError}; |
7562
|
245
|
50
|
|
|
|
892
|
$success or $self->Warn('JPEG format error'); |
7563
|
245
|
50
|
|
|
|
919
|
pop @$path if @$path > $pn; |
7564
|
245
|
|
|
|
|
2229
|
return 1; |
7565
|
|
|
|
|
|
|
} |
7566
|
|
|
|
|
|
|
|
7567
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7568
|
|
|
|
|
|
|
# Extract metadata from an Exiv2 EXV file |
7569
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) dirInfo ref with RAF set |
7570
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid JPEG file |
7571
|
|
|
|
|
|
|
sub ProcessEXV($$) |
7572
|
|
|
|
|
|
|
{ |
7573
|
2
|
|
|
2
|
0
|
9
|
my ($self, $dirInfo) = @_; |
7574
|
2
|
|
|
|
|
10
|
return $self->ProcessJPEG($dirInfo); |
7575
|
|
|
|
|
|
|
} |
7576
|
|
|
|
|
|
|
|
7577
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7578
|
|
|
|
|
|
|
# Process EXIF file |
7579
|
|
|
|
|
|
|
# Inputs/Returns: same as ProcessTIFF |
7580
|
|
|
|
|
|
|
sub ProcessEXIF($$;$) |
7581
|
|
|
|
|
|
|
{ |
7582
|
2
|
|
|
2
|
0
|
10
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7583
|
2
|
|
|
|
|
13
|
return $self->ProcessTIFF($dirInfo, $tagTablePtr); |
7584
|
|
|
|
|
|
|
} |
7585
|
|
|
|
|
|
|
|
7586
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7587
|
|
|
|
|
|
|
# Process TIFF data (wrapper for DoProcessTIFF to allow re-entry) |
7588
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref |
7589
|
|
|
|
|
|
|
# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error |
7590
|
|
|
|
|
|
|
sub ProcessTIFF($$;$) |
7591
|
|
|
|
|
|
|
{ |
7592
|
495
|
|
|
495
|
0
|
1697
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7593
|
495
|
|
|
|
|
1284
|
my $exifData = $$self{EXIF_DATA}; |
7594
|
495
|
|
|
|
|
1361
|
my $exifPos = $$self{EXIF_POS}; |
7595
|
495
|
|
|
|
|
2304
|
my $rtnVal = $self->DoProcessTIFF($dirInfo, $tagTablePtr); |
7596
|
|
|
|
|
|
|
# restore original EXIF information (in case ProcessTIFF is nested) |
7597
|
495
|
100
|
|
|
|
1797
|
if (defined $exifData) { |
7598
|
108
|
|
|
|
|
315
|
$$self{EXIF_DATA} = $exifData; |
7599
|
108
|
|
|
|
|
230
|
$$self{EXIF_POS} = $exifPos; |
7600
|
|
|
|
|
|
|
} |
7601
|
495
|
|
|
|
|
2043
|
return $rtnVal; |
7602
|
|
|
|
|
|
|
} |
7603
|
|
|
|
|
|
|
|
7604
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7605
|
|
|
|
|
|
|
# Process TIFF data |
7606
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref |
7607
|
|
|
|
|
|
|
# Returns: 1 if this looked like a valid EXIF block, 0 otherwise, or -1 on write error |
7608
|
|
|
|
|
|
|
sub DoProcessTIFF($$;$) |
7609
|
|
|
|
|
|
|
{ |
7610
|
495
|
|
|
495
|
0
|
1502
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
7611
|
495
|
|
|
|
|
1157
|
my $dataPt = $$dirInfo{DataPt}; |
7612
|
495
|
|
100
|
|
|
1849
|
my $fileType = $$dirInfo{Parent} || ''; |
7613
|
495
|
|
|
|
|
1075
|
my $raf = $$dirInfo{RAF}; |
7614
|
495
|
|
100
|
|
|
1883
|
my $base = $$dirInfo{Base} || 0; |
7615
|
495
|
|
|
|
|
1136
|
my $outfile = $$dirInfo{OutFile}; |
7616
|
495
|
|
|
|
|
1167
|
my ($err, $sig, $canonSig, $otherSig); |
7617
|
|
|
|
|
|
|
|
7618
|
|
|
|
|
|
|
# attempt to read TIFF header |
7619
|
495
|
|
|
|
|
1435
|
$$self{EXIF_DATA} = ''; |
7620
|
495
|
100
|
100
|
|
|
3369
|
if ($raf) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7621
|
47
|
100
|
|
|
|
177
|
if ($outfile) { |
7622
|
14
|
50
|
|
|
|
71
|
$raf->Seek(0, 0) or return 0; |
7623
|
14
|
50
|
|
|
|
108
|
if ($base) { |
7624
|
0
|
0
|
|
|
|
0
|
$raf->Read($$dataPt, $base) == $base or return 0; |
7625
|
0
|
0
|
|
|
|
0
|
Write($outfile, $$dataPt) or $err = 1; |
7626
|
|
|
|
|
|
|
} |
7627
|
|
|
|
|
|
|
} else { |
7628
|
33
|
50
|
|
|
|
167
|
$raf->Seek($base, 0) or return 0; |
7629
|
|
|
|
|
|
|
} |
7630
|
|
|
|
|
|
|
# extract full EXIF block (for block copy) from EXIF file |
7631
|
47
|
100
|
|
|
|
375
|
my $amount = $fileType eq 'EXIF' ? 65536 * 8 : 8; |
7632
|
47
|
|
|
|
|
330
|
my $n = $raf->Read($$self{EXIF_DATA}, $amount); |
7633
|
47
|
100
|
|
|
|
404
|
if ($n < 8) { |
7634
|
1
|
50
|
33
|
|
|
17
|
return 0 if $n or not $outfile or $fileType ne 'EXIF'; |
|
|
|
33
|
|
|
|
|
7635
|
|
|
|
|
|
|
# create EXIF file from scratch |
7636
|
1
|
|
|
|
|
4
|
delete $$self{EXIF_DATA}; |
7637
|
1
|
|
|
|
|
5
|
undef $raf; |
7638
|
|
|
|
|
|
|
} |
7639
|
47
|
100
|
|
|
|
213
|
if ($n > 8) { |
7640
|
2
|
|
|
|
|
15
|
$raf->Seek(8, 0); |
7641
|
2
|
50
|
|
|
|
14
|
if ($n == $amount) { |
7642
|
0
|
|
|
|
|
0
|
$$self{EXIF_DATA} = substr($$self{EXIF_DATA}, 0, 8); |
7643
|
0
|
|
|
|
|
0
|
$self->Warn('EXIF too large to extract as a block'); #(shouldn't happen) |
7644
|
|
|
|
|
|
|
} |
7645
|
|
|
|
|
|
|
} |
7646
|
|
|
|
|
|
|
} elsif ($dataPt and length $$dataPt) { |
7647
|
|
|
|
|
|
|
# save a copy of the EXIF data |
7648
|
406
|
|
100
|
|
|
2592
|
my $dirStart = $$dirInfo{DirStart} || 0; |
7649
|
406
|
|
66
|
|
|
1534
|
my $dirLen = $$dirInfo{DirLen} || (length($$dataPt) - $dirStart); |
7650
|
406
|
|
|
|
|
2570
|
$$self{EXIF_DATA} = substr($$dataPt, $dirStart, $dirLen); |
7651
|
406
|
50
|
66
|
|
|
2151
|
$self->VerboseDir('TIFF') if $$self{OPTIONS}{Verbose} and length($$self{INDENT}) > 2; |
7652
|
|
|
|
|
|
|
} elsif ($outfile) { |
7653
|
42
|
|
|
|
|
158
|
delete $$self{EXIF_DATA}; # create from scratch |
7654
|
|
|
|
|
|
|
} else { |
7655
|
0
|
|
|
|
|
0
|
$$self{EXIF_DATA} = ''; |
7656
|
|
|
|
|
|
|
} |
7657
|
495
|
100
|
|
|
|
1883
|
unless (defined $$self{EXIF_DATA}) { |
7658
|
|
|
|
|
|
|
# set default byte order for creating new GPS in CR3 images |
7659
|
43
|
|
|
|
|
103
|
my $defaultByteOrder; |
7660
|
43
|
50
|
33
|
|
|
354
|
if ($$dirInfo{DirName} and $$dirInfo{DirName} eq 'GPS') { |
7661
|
0
|
|
|
|
|
0
|
$defaultByteOrder = $$self{SaveExifByteOrder}; |
7662
|
|
|
|
|
|
|
} |
7663
|
|
|
|
|
|
|
# create TIFF information from scratch |
7664
|
43
|
100
|
|
|
|
305
|
if ($self->SetPreferredByteOrder($defaultByteOrder) eq 'MM') { |
7665
|
34
|
|
|
|
|
127
|
$$self{EXIF_DATA} = "MM\0\x2a\0\0\0\x08"; |
7666
|
|
|
|
|
|
|
} else { |
7667
|
9
|
|
|
|
|
57
|
$$self{EXIF_DATA} = "II\x2a\0\x08\0\0\0"; |
7668
|
|
|
|
|
|
|
} |
7669
|
|
|
|
|
|
|
} |
7670
|
495
|
|
|
|
|
1840
|
$$self{EXIF_POS} = $base + $$self{BASE}; |
7671
|
495
|
100
|
|
|
|
2124
|
$$self{FIRST_EXIF_POS} = $$self{EXIF_POS} unless defined $$self{FIRST_EXIF_POS}; |
7672
|
495
|
|
|
|
|
1231
|
$dataPt = \$$self{EXIF_DATA}; |
7673
|
|
|
|
|
|
|
|
7674
|
|
|
|
|
|
|
# set byte ordering |
7675
|
495
|
|
|
|
|
1634
|
my $byteOrder = substr($$dataPt,0,2); |
7676
|
495
|
100
|
|
|
|
1679
|
SetByteOrder($byteOrder) or return 0; |
7677
|
|
|
|
|
|
|
|
7678
|
|
|
|
|
|
|
# verify the byte ordering |
7679
|
489
|
|
|
|
|
2333
|
my $identifier = Get16u($dataPt, 2); |
7680
|
|
|
|
|
|
|
# identifier is 0x2a for TIFF (but 0x4f52, 0x5352 or ?? for ORF) |
7681
|
|
|
|
|
|
|
# no longer do this because various files use different values |
7682
|
|
|
|
|
|
|
# (TIFF=0x2a, RW2/RWL=0x55, HDP=0xbc, BTF=0x2b, ORF=0x4f52/0x5352/0x????) |
7683
|
|
|
|
|
|
|
# return 0 unless $identifier == 0x2a; |
7684
|
489
|
50
|
66
|
|
|
2918
|
$self->Warn('Invalid magic number in EXIF TIFF header') if $fileType eq 'APP1' and $identifier != 0x2a; |
7685
|
|
|
|
|
|
|
|
7686
|
|
|
|
|
|
|
# get offset to IFD0 |
7687
|
489
|
50
|
|
|
|
1823
|
return 0 if length $$dataPt < 8; |
7688
|
489
|
|
|
|
|
1569
|
my $offset = Get32u($dataPt, 4); |
7689
|
489
|
50
|
|
|
|
1888
|
$offset >= 8 or return 0; |
7690
|
|
|
|
|
|
|
|
7691
|
489
|
100
|
|
|
|
1677
|
if ($raf) { |
7692
|
|
|
|
|
|
|
# check for canon or EXIF signature |
7693
|
|
|
|
|
|
|
# (Canon CR2 images should have an offset of 16, but it may be |
7694
|
|
|
|
|
|
|
# greater if edited by PhotoMechanic) |
7695
|
40
|
100
|
100
|
|
|
407
|
if ($identifier == 0x2a and $offset >= 16) { |
|
|
100
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
7696
|
17
|
50
|
|
|
|
90
|
$raf->Read($sig, 8) == 8 or return 0; |
7697
|
17
|
|
|
|
|
72
|
$$dataPt .= $sig; |
7698
|
17
|
100
|
|
|
|
148
|
if ($sig =~ /^(CR\x02\0|\xba\xb0\xac\xbb|ExifMeta)/) { |
7699
|
10
|
100
|
|
|
|
46
|
if ($sig eq 'ExifMeta') { |
7700
|
1
|
|
|
|
|
9
|
$self->SetFileType($fileType = 'EXIF'); |
7701
|
1
|
|
|
|
|
8
|
$otherSig = $sig; |
7702
|
|
|
|
|
|
|
} else { |
7703
|
9
|
50
|
|
|
|
65
|
$fileType = $sig =~ /^CR/ ? 'CR2' : 'Canon 1D RAW'; |
7704
|
9
|
|
|
|
|
24
|
$canonSig = $sig; |
7705
|
|
|
|
|
|
|
} |
7706
|
10
|
50
|
|
|
|
57
|
$self->HDump($base+8, 8, "[$fileType header]") if $$self{HTML_DUMP}; |
7707
|
|
|
|
|
|
|
} |
7708
|
|
|
|
|
|
|
} elsif ($identifier == 0x55 and $fileType =~ /^(RAW|RW2|RWL|TIFF)$/) { |
7709
|
|
|
|
|
|
|
# panasonic RAW, RW2 or RWL file |
7710
|
3
|
|
|
|
|
7
|
my $magic; |
7711
|
|
|
|
|
|
|
# test for RW2/RWL magic number |
7712
|
3
|
50
|
33
|
|
|
25
|
if ($offset >= 0x18 and $raf->Read($magic, 16) and |
|
|
|
33
|
|
|
|
|
7713
|
|
|
|
|
|
|
$magic eq "\x88\xe7\x74\xd8\xf8\x25\x1d\x4d\x94\x7a\x6e\x77\x82\x2b\x5d\x6a") |
7714
|
|
|
|
|
|
|
{ |
7715
|
3
|
50
|
|
|
|
18
|
$fileType = 'RW2' unless $fileType eq 'RWL'; |
7716
|
3
|
50
|
|
|
|
12
|
$self->HDump($base + 8, 16, '[RW2/RWL header]') if $$self{HTML_DUMP}; |
7717
|
3
|
|
|
|
|
12
|
$otherSig = $magic; # save signature for writing |
7718
|
|
|
|
|
|
|
} else { |
7719
|
0
|
|
|
|
|
0
|
$fileType = 'RAW'; |
7720
|
|
|
|
|
|
|
} |
7721
|
3
|
|
|
|
|
10
|
$tagTablePtr = GetTagTable('Image::ExifTool::PanasonicRaw::Main'); |
7722
|
|
|
|
|
|
|
} elsif ($fileType eq 'TIFF') { |
7723
|
13
|
50
|
33
|
|
|
146
|
if ($identifier == 0x2b) { |
|
|
50
|
33
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
7724
|
|
|
|
|
|
|
# this looks like a BigTIFF image |
7725
|
0
|
|
|
|
|
0
|
$raf->Seek(0); |
7726
|
0
|
|
|
|
|
0
|
require Image::ExifTool::BigTIFF; |
7727
|
0
|
|
|
|
|
0
|
my $result = Image::ExifTool::BigTIFF::ProcessBTF($self, $dirInfo); |
7728
|
0
|
0
|
|
|
|
0
|
if ($result) { |
7729
|
0
|
0
|
|
|
|
0
|
$self->FoundTag(PageCount => $$self{PageCount}) if $$self{MultiPage}; |
7730
|
0
|
|
|
|
|
0
|
return 1; |
7731
|
|
|
|
|
|
|
} |
7732
|
|
|
|
|
|
|
} elsif ($identifier == 0x4f52 or $identifier == 0x5352) { |
7733
|
|
|
|
|
|
|
# Olympus ORF image (set FileType now because base type is 'ORF') |
7734
|
0
|
|
|
|
|
0
|
$self->SetFileType($fileType = 'ORF'); |
7735
|
|
|
|
|
|
|
} elsif ($identifier == 0x4352) { |
7736
|
0
|
|
|
|
|
0
|
$fileType = 'DCP'; |
7737
|
|
|
|
|
|
|
} elsif ($byteOrder eq 'II' and ($identifier & 0xff) == 0xbc) { |
7738
|
0
|
|
|
|
|
0
|
$fileType = 'HDP'; # Windows HD Photo file |
7739
|
|
|
|
|
|
|
# check version number |
7740
|
0
|
|
|
|
|
0
|
my $ver = Get8u($dataPt, 3); |
7741
|
0
|
0
|
|
|
|
0
|
if ($ver > 1) { |
7742
|
0
|
|
|
|
|
0
|
$self->Error("Windows HD Photo version $ver files not yet supported"); |
7743
|
0
|
|
|
|
|
0
|
return 1; |
7744
|
|
|
|
|
|
|
} |
7745
|
|
|
|
|
|
|
} |
7746
|
|
|
|
|
|
|
} |
7747
|
|
|
|
|
|
|
# we have a valid TIFF (or whatever) file |
7748
|
40
|
100
|
66
|
|
|
318
|
if ($fileType and not $$self{VALUE}{FileType}) { |
7749
|
38
|
|
|
|
|
108
|
my $lookup = $fileTypeLookup{$fileType}; |
7750
|
38
|
50
|
33
|
|
|
217
|
$lookup = $fileTypeLookup{$lookup} unless ref $lookup or not $lookup; |
7751
|
|
|
|
|
|
|
# use file extension to pre-determine type if extension is TIFF-based or type is RAW |
7752
|
38
|
50
|
|
|
|
198
|
my $baseType = $lookup ? (ref $$lookup[0] ? $$lookup[0][0] : $$lookup[0]) : ''; |
|
|
50
|
|
|
|
|
|
7753
|
38
|
100
|
66
|
|
|
208
|
my $t = ($baseType eq 'TIFF' or $fileType =~ /RAW/) ? $fileType : undef; |
7754
|
38
|
|
|
|
|
201
|
$self->SetFileType($t); |
7755
|
|
|
|
|
|
|
} |
7756
|
|
|
|
|
|
|
# don't process file if FastScan == 3 |
7757
|
40
|
50
|
66
|
|
|
443
|
return 1 if not $outfile and $$self{OPTIONS}{FastScan} and $$self{OPTIONS}{FastScan} == 3; |
|
|
|
33
|
|
|
|
|
7758
|
|
|
|
|
|
|
} |
7759
|
|
|
|
|
|
|
# (accommodate CR3 images which have a TIFF directory with ExifIFD at the top level) |
7760
|
489
|
100
|
100
|
|
|
3661
|
my $ifdName = ($$dirInfo{DirName} and $$dirInfo{DirName} =~ /^(ExifIFD|GPS)$/) ? $1 : 'IFD0'; |
7761
|
489
|
100
|
100
|
|
|
3393
|
if (not $tagTablePtr or $$tagTablePtr{GROUPS}{0} eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
7762
|
413
|
100
|
|
|
|
2733
|
$self->FoundTag('ExifByteOrder', $byteOrder) unless $outfile; |
7763
|
|
|
|
|
|
|
} elsif ($$tagTablePtr{GROUPS}{0} eq 'MakerNotes') { # (for writing CR3 maker notes) |
7764
|
19
|
|
|
|
|
70
|
$ifdName = $$tagTablePtr{GROUPS}{0}; |
7765
|
|
|
|
|
|
|
} else { |
7766
|
57
|
|
|
|
|
185
|
$ifdName = $$tagTablePtr{GROUPS}{1}; |
7767
|
|
|
|
|
|
|
} |
7768
|
489
|
50
|
|
|
|
2522
|
if ($$self{HTML_DUMP}) { |
7769
|
0
|
0
|
|
|
|
0
|
my $tip = sprintf("Byte order: %s endian\nIdentifier: 0x%.4x\n$ifdName offset: 0x%.4x", |
7770
|
|
|
|
|
|
|
($byteOrder eq 'II') ? 'Little' : 'Big', $identifier, $offset); |
7771
|
0
|
|
|
|
|
0
|
$self->HDump($base, 8, 'TIFF header', $tip, 0); |
7772
|
|
|
|
|
|
|
} |
7773
|
|
|
|
|
|
|
# remember where we found the TIFF data (APP1, APP3, TIFF, NEF, etc...) |
7774
|
489
|
|
|
|
|
1509
|
$$self{TIFF_TYPE} = $fileType; |
7775
|
|
|
|
|
|
|
|
7776
|
|
|
|
|
|
|
# get reference to the main EXIF table |
7777
|
489
|
100
|
|
|
|
1890
|
$tagTablePtr or $tagTablePtr = GetTagTable('Image::ExifTool::Exif::Main'); |
7778
|
|
|
|
|
|
|
|
7779
|
|
|
|
|
|
|
# build directory information hash |
7780
|
|
|
|
|
|
|
my %dirInfo = ( |
7781
|
|
|
|
|
|
|
Base => $base, |
7782
|
|
|
|
|
|
|
DataPt => $dataPt, |
7783
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
7784
|
|
|
|
|
|
|
DataPos => 0, |
7785
|
|
|
|
|
|
|
DirStart => $offset, |
7786
|
|
|
|
|
|
|
DirLen => length($$dataPt) - $offset, |
7787
|
|
|
|
|
|
|
RAF => $raf, |
7788
|
|
|
|
|
|
|
DirName => $ifdName, |
7789
|
|
|
|
|
|
|
Parent => $fileType, |
7790
|
|
|
|
|
|
|
ImageData=> 'Main', # set flag to get information to copy main image data later |
7791
|
|
|
|
|
|
|
Multi => $$dirInfo{Multi}, |
7792
|
489
|
|
|
|
|
6039
|
); |
7793
|
|
|
|
|
|
|
|
7794
|
|
|
|
|
|
|
# extract information from the image |
7795
|
489
|
100
|
|
|
|
1798
|
unless ($outfile) { |
7796
|
|
|
|
|
|
|
# process the directory |
7797
|
365
|
|
|
|
|
1822
|
$self->ProcessDirectory(\%dirInfo, $tagTablePtr); |
7798
|
|
|
|
|
|
|
# process GeoTiff information if available |
7799
|
365
|
100
|
|
|
|
2582
|
if ($$self{VALUE}{GeoTiffDirectory}) { |
7800
|
7
|
|
|
|
|
910
|
require Image::ExifTool::GeoTiff; |
7801
|
7
|
|
|
|
|
73
|
Image::ExifTool::GeoTiff::ProcessGeoTiff($self); |
7802
|
|
|
|
|
|
|
} |
7803
|
|
|
|
|
|
|
# process information in recognized trailers |
7804
|
365
|
100
|
|
|
|
1479
|
if ($raf) { |
7805
|
27
|
|
|
|
|
158
|
my $trailInfo = IdentifyTrailer($raf); |
7806
|
27
|
100
|
|
|
|
136
|
if ($trailInfo) { |
7807
|
3
|
|
|
|
|
12
|
$$trailInfo{ScanForAFCP} = 1; # scan to find AFCP if necessary |
7808
|
3
|
|
|
|
|
20
|
$self->ProcessTrailers($trailInfo); |
7809
|
|
|
|
|
|
|
} |
7810
|
|
|
|
|
|
|
# dump any other known trailer (eg. A100 RAW Data) |
7811
|
27
|
0
|
33
|
|
|
154
|
if ($$self{HTML_DUMP} and $$self{KnownTrailer}) { |
7812
|
0
|
|
|
|
|
0
|
my $known = $$self{KnownTrailer}; |
7813
|
0
|
|
|
|
|
0
|
$raf->Seek(0, 2); |
7814
|
0
|
|
|
|
|
0
|
my $len = $raf->Tell() - $$known{Start}; |
7815
|
0
|
0
|
|
|
|
0
|
$len -= $$trailInfo{Offset} if $trailInfo; # account for other trailers |
7816
|
0
|
0
|
|
|
|
0
|
$self->HDump($$known{Start}, $len, "[$$known{Name}]") if $len > 0; |
7817
|
|
|
|
|
|
|
} |
7818
|
|
|
|
|
|
|
} |
7819
|
|
|
|
|
|
|
# update FileType if necessary now that we know more about the file |
7820
|
365
|
50
|
66
|
|
|
1663
|
if ($$self{DNGVersion} and $$self{FileType} !~ /^(DNG|GPR)$/) { |
7821
|
|
|
|
|
|
|
# override whatever FileType we set since we now know it is DNG |
7822
|
0
|
|
|
|
|
0
|
$self->OverrideFileType($$self{TIFF_TYPE} = 'DNG'); |
7823
|
|
|
|
|
|
|
} |
7824
|
365
|
100
|
|
|
|
1533
|
if ($$self{TIFF_TYPE} eq 'TIFF') { |
7825
|
10
|
50
|
|
|
|
39
|
$self->FoundTag(PageCount => $$self{PageCount}) if $$self{MultiPage}; |
7826
|
|
|
|
|
|
|
} |
7827
|
365
|
|
|
|
|
2101
|
return 1; |
7828
|
|
|
|
|
|
|
} |
7829
|
|
|
|
|
|
|
# |
7830
|
|
|
|
|
|
|
# rewrite the image |
7831
|
|
|
|
|
|
|
# |
7832
|
124
|
100
|
|
|
|
570
|
if ($$dirInfo{NoTiffEnd}) { |
7833
|
1
|
|
|
|
|
3
|
delete $$self{TIFF_END}; |
7834
|
|
|
|
|
|
|
} else { |
7835
|
|
|
|
|
|
|
# initialize TIFF_END so it will be updated by WriteExif() |
7836
|
123
|
|
|
|
|
445
|
$$self{TIFF_END} = 0; |
7837
|
|
|
|
|
|
|
} |
7838
|
124
|
100
|
|
|
|
548
|
if ($canonSig) { |
7839
|
|
|
|
|
|
|
# write Canon CR2 specially because it has a header we want to preserve, |
7840
|
|
|
|
|
|
|
# and possibly trailers added by the Canon utilities and/or PhotoMechanic |
7841
|
3
|
|
|
|
|
9
|
$dirInfo{OutFile} = $outfile; |
7842
|
3
|
|
|
|
|
25
|
require Image::ExifTool::CanonRaw; |
7843
|
3
|
50
|
|
|
|
31
|
Image::ExifTool::CanonRaw::WriteCR2($self, \%dirInfo, $tagTablePtr) or $err = 1; |
7844
|
|
|
|
|
|
|
} else { |
7845
|
|
|
|
|
|
|
# write TIFF header (8 bytes [plus optional signature] followed by IFD) |
7846
|
121
|
100
|
|
|
|
892
|
if ($fileType eq 'EXIF') { |
|
|
100
|
|
|
|
|
|
7847
|
3
|
|
|
|
|
9
|
$otherSig = 'ExifMeta'; # force this signature for all EXIF files |
7848
|
|
|
|
|
|
|
} elsif (not defined $otherSig) { |
7849
|
117
|
|
|
|
|
306
|
$otherSig = ''; |
7850
|
|
|
|
|
|
|
} |
7851
|
121
|
|
|
|
|
784
|
my $offset = 8 + length($otherSig); |
7852
|
|
|
|
|
|
|
# construct tiff header |
7853
|
121
|
|
|
|
|
631
|
my $header = substr($$dataPt, 0, 4) . Set32u($offset) . $otherSig; |
7854
|
121
|
|
|
|
|
469
|
$dirInfo{NewDataPos} = $offset; |
7855
|
121
|
|
|
|
|
458
|
$dirInfo{HeaderPtr} = \$header; |
7856
|
|
|
|
|
|
|
# preserve padding between image data blocks in ORF images |
7857
|
|
|
|
|
|
|
# (otherwise dcraw has problems because it assumes fixed block spacing) |
7858
|
121
|
100
|
66
|
|
|
838
|
$dirInfo{PreserveImagePadding} = 1 if $fileType eq 'ORF' or $identifier != 0x2a; |
7859
|
121
|
|
|
|
|
1040
|
my $newData = $self->WriteDirectory(\%dirInfo, $tagTablePtr); |
7860
|
121
|
50
|
|
|
|
833
|
if (not defined $newData) { |
|
|
100
|
|
|
|
|
|
7861
|
0
|
|
|
|
|
0
|
$err = 1; |
7862
|
|
|
|
|
|
|
} elsif (length($newData)) { |
7863
|
|
|
|
|
|
|
# update header length in case more was added |
7864
|
115
|
|
|
|
|
303
|
my $hdrLen = length $header; |
7865
|
115
|
100
|
|
|
|
513
|
if ($hdrLen != 8) { |
7866
|
5
|
|
|
|
|
25
|
Set32u($hdrLen, \$header, 4); |
7867
|
|
|
|
|
|
|
# also update preview fixup if necessary |
7868
|
5
|
|
|
|
|
17
|
my $pi = $$self{PREVIEW_INFO}; |
7869
|
5
|
0
|
33
|
|
|
24
|
$$pi{Fixup}{Start} += $hdrLen - 8 if $pi and $$pi{Fixup}; |
7870
|
|
|
|
|
|
|
} |
7871
|
115
|
50
|
33
|
|
|
693
|
if ($$self{TIFF_TYPE} eq 'ARW' and not $err) { |
7872
|
|
|
|
|
|
|
# write any required ARW trailer and patch other ARW quirks |
7873
|
0
|
|
|
|
|
0
|
require Image::ExifTool::Sony; |
7874
|
|
|
|
|
|
|
my $errStr = Image::ExifTool::Sony::FinishARW($self, $dirInfo, \$newData, |
7875
|
0
|
|
|
|
|
0
|
$dirInfo{ImageData}); |
7876
|
0
|
0
|
|
|
|
0
|
$errStr and $self->Error($errStr); |
7877
|
0
|
|
|
|
|
0
|
delete $dirInfo{ImageData}; # (was copied by FinishARW) |
7878
|
|
|
|
|
|
|
} else { |
7879
|
115
|
50
|
|
|
|
653
|
Write($outfile, $header, $newData) or $err = 1; |
7880
|
|
|
|
|
|
|
} |
7881
|
115
|
|
|
|
|
381
|
undef $newData; # free memory |
7882
|
|
|
|
|
|
|
} |
7883
|
|
|
|
|
|
|
# copy over image data now if necessary |
7884
|
121
|
100
|
66
|
|
|
795
|
if (ref $dirInfo{ImageData} and not $err) { |
7885
|
10
|
50
|
|
|
|
80
|
$self->CopyImageData($dirInfo{ImageData}, $outfile) or $err = 1; |
7886
|
10
|
|
|
|
|
54
|
delete $dirInfo{ImageData}; |
7887
|
|
|
|
|
|
|
} |
7888
|
|
|
|
|
|
|
} |
7889
|
|
|
|
|
|
|
# make local copy of TIFF_END now (it may be reset when processing trailers) |
7890
|
124
|
|
|
|
|
433
|
my $tiffEnd = $$self{TIFF_END}; |
7891
|
124
|
|
|
|
|
339
|
delete $$self{TIFF_END}; |
7892
|
|
|
|
|
|
|
|
7893
|
|
|
|
|
|
|
# rewrite trailers if they exist |
7894
|
124
|
100
|
100
|
|
|
680
|
if ($raf and $tiffEnd and not $err) { |
|
|
|
66
|
|
|
|
|
7895
|
12
|
|
|
|
|
37
|
my ($buf, $trailInfo); |
7896
|
12
|
50
|
|
|
|
55
|
$raf->Seek(0, 2) or $err = 1; |
7897
|
12
|
|
|
|
|
122
|
my $extra = $raf->Tell() - $tiffEnd; |
7898
|
|
|
|
|
|
|
# check for trailer and process if possible |
7899
|
12
|
|
|
|
|
44
|
for (;;) { |
7900
|
12
|
100
|
|
|
|
69
|
last unless $extra > 12; |
7901
|
3
|
|
|
|
|
17
|
$raf->Seek($tiffEnd); # seek back to end of image |
7902
|
3
|
|
|
|
|
45
|
$trailInfo = IdentifyTrailer($raf); |
7903
|
3
|
50
|
|
|
|
17
|
last unless $trailInfo; |
7904
|
0
|
|
|
|
|
0
|
my $tbuf = ''; |
7905
|
0
|
|
|
|
|
0
|
$$trailInfo{OutFile} = \$tbuf; # rewrite trailer(s) |
7906
|
0
|
|
|
|
|
0
|
$$trailInfo{ScanForAFCP} = 1; # scan for AFCP if necessary |
7907
|
|
|
|
|
|
|
# rewrite all trailers to buffer |
7908
|
0
|
0
|
|
|
|
0
|
unless ($self->ProcessTrailers($trailInfo)) { |
7909
|
0
|
|
|
|
|
0
|
undef $trailInfo; |
7910
|
0
|
|
|
|
|
0
|
$err = 1; |
7911
|
0
|
|
|
|
|
0
|
last; |
7912
|
|
|
|
|
|
|
} |
7913
|
|
|
|
|
|
|
# calculate unused bytes before trailer |
7914
|
0
|
|
|
|
|
0
|
$extra = $$trailInfo{DataPos} - $tiffEnd; |
7915
|
0
|
|
|
|
|
0
|
last; # yes, the 'for' loop was just a cheap 'goto' |
7916
|
|
|
|
|
|
|
} |
7917
|
|
|
|
|
|
|
# ignore a single zero byte if used for padding |
7918
|
12
|
100
|
100
|
|
|
98
|
if ($extra > 0 and $tiffEnd & 0x01) { |
7919
|
1
|
50
|
|
|
|
7
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7920
|
1
|
50
|
|
|
|
30
|
$raf->Read($buf, 1) or $err = 1; |
7921
|
1
|
50
|
33
|
|
|
20
|
defined $buf and $buf eq "\0" and --$extra, ++$tiffEnd; |
7922
|
|
|
|
|
|
|
} |
7923
|
12
|
100
|
|
|
|
60
|
if ($extra > 0) { |
7924
|
3
|
|
|
|
|
11
|
my $known = $$self{KnownTrailer}; |
7925
|
3
|
50
|
33
|
|
|
28
|
if ($$self{DEL_GROUP}{Trailer} and not $known) { |
|
|
50
|
|
|
|
|
|
7926
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Deleting unknown trailer ($extra bytes)\n"); |
7927
|
0
|
|
|
|
|
0
|
++$$self{CHANGED}; |
7928
|
|
|
|
|
|
|
} elsif ($known) { |
7929
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Copying $$known{Name} ($extra bytes)\n"); |
7930
|
0
|
0
|
|
|
|
0
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7931
|
0
|
0
|
|
|
|
0
|
CopyBlock($raf, $outfile, $extra) or $err = 1; |
7932
|
|
|
|
|
|
|
} else { |
7933
|
3
|
50
|
|
|
|
13
|
$raf->Seek($tiffEnd, 0) or $err = 1; |
7934
|
|
|
|
|
|
|
# preserve unknown trailer only if it contains non-null data |
7935
|
|
|
|
|
|
|
# (Photoshop CS adds a trailer with 2 null bytes) |
7936
|
3
|
|
|
|
|
16
|
my $size = $extra; |
7937
|
3
|
|
|
|
|
8
|
for (;;) { |
7938
|
3
|
50
|
|
|
|
17
|
my $n = $size > 65536 ? 65536 : $size; |
7939
|
3
|
50
|
|
|
|
14
|
$raf->Read($buf, $n) == $n or $err = 1, last; |
7940
|
3
|
50
|
|
|
|
51
|
if ($buf =~ /[^\0]/) { |
7941
|
3
|
|
|
|
|
27
|
$self->VPrint(0, " Preserving unknown trailer ($extra bytes)\n"); |
7942
|
|
|
|
|
|
|
# copy the trailer since it contains non-null data |
7943
|
3
|
50
|
0
|
|
|
17
|
Write($outfile, "\0"x($extra-$size)) or $err = 1, last if $size != $extra; |
7944
|
3
|
50
|
|
|
|
15
|
Write($outfile, $buf) or $err = 1, last; |
7945
|
3
|
50
|
0
|
|
|
27
|
CopyBlock($raf, $outfile, $size-$n) or $err = 1 if $size > $n; |
7946
|
3
|
|
|
|
|
9
|
last; |
7947
|
|
|
|
|
|
|
} |
7948
|
0
|
|
|
|
|
0
|
$size -= $n; |
7949
|
0
|
0
|
|
|
|
0
|
next if $size > 0; |
7950
|
0
|
|
|
|
|
0
|
$self->VPrint(0, " Deleting blank trailer ($extra bytes)\n"); |
7951
|
0
|
|
|
|
|
0
|
last; |
7952
|
|
|
|
|
|
|
} |
7953
|
|
|
|
|
|
|
} |
7954
|
|
|
|
|
|
|
} |
7955
|
|
|
|
|
|
|
# write trailer buffer if necessary |
7956
|
12
|
50
|
0
|
|
|
46
|
$self->WriteTrailerBuffer($trailInfo, $outfile) or $err = 1 if $trailInfo; |
7957
|
|
|
|
|
|
|
# add any new trailers we are creating |
7958
|
12
|
|
|
|
|
117
|
my $trailPt = $self->AddNewTrailers(); |
7959
|
12
|
100
|
50
|
|
|
59
|
Write($outfile, $$trailPt) or $err = 1 if $trailPt; |
7960
|
|
|
|
|
|
|
} |
7961
|
|
|
|
|
|
|
# check DNG version |
7962
|
124
|
100
|
|
|
|
631
|
if ($$self{DNGVersion}) { |
7963
|
1
|
|
|
|
|
2
|
my $ver = $$self{DNGVersion}; |
7964
|
|
|
|
|
|
|
# currently support up to DNG version 1.6 |
7965
|
1
|
50
|
33
|
|
|
20
|
unless ($ver =~ /^(\d+) (\d+)/ and "$1.$2" <= 1.6) { |
7966
|
0
|
|
|
|
|
0
|
$ver =~ tr/ /./; |
7967
|
0
|
|
|
|
|
0
|
$self->Error("DNG Version $ver not yet tested", 1); |
7968
|
|
|
|
|
|
|
} |
7969
|
|
|
|
|
|
|
} |
7970
|
124
|
50
|
|
|
|
1122
|
return $err ? -1 : 1; |
7971
|
|
|
|
|
|
|
} |
7972
|
|
|
|
|
|
|
|
7973
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7974
|
|
|
|
|
|
|
# Return list of tag table keys (ignoring special keys) |
7975
|
|
|
|
|
|
|
# Inputs: 0) reference to tag table |
7976
|
|
|
|
|
|
|
# Returns: List of table keys (unsorted) |
7977
|
|
|
|
|
|
|
sub TagTableKeys($) |
7978
|
|
|
|
|
|
|
{ |
7979
|
7715
|
|
|
7715
|
0
|
12190
|
local $_; |
7980
|
7715
|
|
|
|
|
12052
|
my $tagTablePtr = shift; |
7981
|
7715
|
|
|
|
|
11740
|
my @keyList; |
7982
|
7715
|
|
|
|
|
124607
|
foreach (keys %$tagTablePtr) { |
7983
|
455635
|
100
|
|
|
|
861897
|
push(@keyList, $_) unless $specialTags{$_}; |
7984
|
|
|
|
|
|
|
} |
7985
|
7715
|
|
|
|
|
77957
|
return @keyList; |
7986
|
|
|
|
|
|
|
} |
7987
|
|
|
|
|
|
|
|
7988
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
7989
|
|
|
|
|
|
|
# GetTagTable |
7990
|
|
|
|
|
|
|
# Inputs: 0) table name |
7991
|
|
|
|
|
|
|
# Returns: tag table reference, or undefined if not found |
7992
|
|
|
|
|
|
|
# Notes: Always use this function instead of requiring module and using table |
7993
|
|
|
|
|
|
|
# directly since this function also does the following the first time the table |
7994
|
|
|
|
|
|
|
# is loaded: |
7995
|
|
|
|
|
|
|
# - requires new module if necessary |
7996
|
|
|
|
|
|
|
# - generates default GROUPS hash and Group 0 name from module name |
7997
|
|
|
|
|
|
|
# - registers Composite tags if Composite table found |
7998
|
|
|
|
|
|
|
# - saves descriptions for tags in specified table |
7999
|
|
|
|
|
|
|
# - generates default TAG_PREFIX to be used for unknown tags |
8000
|
|
|
|
|
|
|
sub GetTagTable($) |
8001
|
|
|
|
|
|
|
{ |
8002
|
90398
|
100
|
|
90398
|
0
|
200053
|
my $tableName = shift or return undef; |
8003
|
90394
|
|
|
|
|
207525
|
my $table = $allTables{$tableName}; |
8004
|
|
|
|
|
|
|
|
8005
|
90394
|
100
|
|
|
|
166660
|
unless ($table) { |
8006
|
106
|
|
|
106
|
|
1171
|
no strict 'refs'; |
|
106
|
|
|
|
|
307
|
|
|
106
|
|
|
|
|
19849
|
|
8007
|
4572
|
100
|
|
|
|
35716
|
unless (%$tableName) { |
8008
|
|
|
|
|
|
|
# try to load module for this table |
8009
|
883
|
50
|
|
|
|
6888
|
if ($tableName =~ /(.*)::/) { |
8010
|
883
|
|
|
|
|
3350
|
my $module = $1; |
8011
|
883
|
50
|
|
|
|
72567
|
if (eval "require $module") { |
8012
|
|
|
|
|
|
|
# load additional modules if required |
8013
|
883
|
100
|
|
|
|
7847
|
if (not %$tableName) { |
8014
|
28
|
50
|
|
|
|
244
|
if ($module eq 'Image::ExifTool::XMP') { |
|
|
0
|
|
|
|
|
|
8015
|
28
|
|
|
|
|
24453
|
require 'Image/ExifTool/XMP2.pl'; |
8016
|
|
|
|
|
|
|
} elsif ($tableName eq 'Image::ExifTool::QuickTime::Stream') { |
8017
|
0
|
|
|
|
|
0
|
require 'Image/ExifTool/QuickTimeStream.pl'; |
8018
|
|
|
|
|
|
|
} |
8019
|
|
|
|
|
|
|
} |
8020
|
|
|
|
|
|
|
} else { |
8021
|
0
|
0
|
|
|
|
0
|
$@ and warn $@; |
8022
|
|
|
|
|
|
|
} |
8023
|
|
|
|
|
|
|
} |
8024
|
883
|
50
|
|
|
|
5838
|
unless (%$tableName) { |
8025
|
0
|
|
|
|
|
0
|
warn "Can't find table $tableName\n"; |
8026
|
0
|
|
|
|
|
0
|
return undef; |
8027
|
|
|
|
|
|
|
} |
8028
|
|
|
|
|
|
|
} |
8029
|
106
|
|
|
106
|
|
927
|
no strict 'refs'; |
|
106
|
|
|
|
|
294
|
|
|
106
|
|
|
|
|
5510
|
|
8030
|
4572
|
|
|
|
|
12159
|
$table = \%$tableName; |
8031
|
106
|
|
|
106
|
|
784
|
use strict 'refs'; |
|
106
|
|
|
|
|
326
|
|
|
106
|
|
|
|
|
96898
|
|
8032
|
4572
|
100
|
|
|
|
14822
|
&{$$table{INIT_TABLE}}($table) if $$table{INIT_TABLE}; |
|
13
|
|
|
|
|
348
|
|
8033
|
4572
|
|
|
|
|
11993
|
$$table{TABLE_NAME} = $tableName; # set table name |
8034
|
4572
|
|
|
|
|
27300
|
($$table{SHORT_NAME} = $tableName) =~ s/^Image::ExifTool:://; |
8035
|
|
|
|
|
|
|
# set default group 0 and 1 from module name unless already specified |
8036
|
4572
|
|
|
|
|
12511
|
my $defaultGroups = $$table{GROUPS}; |
8037
|
4572
|
100
|
|
|
|
11029
|
$defaultGroups or $defaultGroups = $$table{GROUPS} = { }; |
8038
|
4572
|
100
|
100
|
|
|
21460
|
unless ($$defaultGroups{0} and $$defaultGroups{1}) { |
8039
|
3648
|
50
|
|
|
|
20996
|
if ($tableName =~ /Image::.*?::([^:]*)/) { |
8040
|
3648
|
100
|
|
|
|
11897
|
$$defaultGroups{0} = $1 unless $$defaultGroups{0}; |
8041
|
3648
|
100
|
|
|
|
14486
|
$$defaultGroups{1} = $1 unless $$defaultGroups{1}; |
8042
|
|
|
|
|
|
|
} else { |
8043
|
0
|
0
|
|
|
|
0
|
$$defaultGroups{0} = $tableName unless $$defaultGroups{0}; |
8044
|
0
|
0
|
|
|
|
0
|
$$defaultGroups{1} = $tableName unless $$defaultGroups{1}; |
8045
|
|
|
|
|
|
|
} |
8046
|
|
|
|
|
|
|
} |
8047
|
4572
|
100
|
|
|
|
12250
|
$$defaultGroups{2} = 'Other' unless $$defaultGroups{2}; |
8048
|
4572
|
100
|
100
|
|
|
19455
|
if ($$defaultGroups{0} eq 'XMP' or $$table{NAMESPACE}) { |
8049
|
|
|
|
|
|
|
# initialize some XMP table defaults |
8050
|
515
|
|
|
|
|
3672
|
require Image::ExifTool::XMP; |
8051
|
515
|
|
|
|
|
2697
|
Image::ExifTool::XMP::RegisterNamespace($table); # register all table namespaces |
8052
|
|
|
|
|
|
|
# set default write/check procs |
8053
|
515
|
100
|
|
|
|
1910
|
$$table{WRITE_PROC} = \&Image::ExifTool::XMP::WriteXMP unless $$table{WRITE_PROC}; |
8054
|
515
|
100
|
|
|
|
1700
|
$$table{CHECK_PROC} = \&Image::ExifTool::XMP::CheckXMP unless $$table{CHECK_PROC}; |
8055
|
515
|
100
|
|
|
|
1610
|
$$table{LANG_INFO} = \&Image::ExifTool::XMP::GetLangInfo unless $$table{LANG_INFO}; |
8056
|
|
|
|
|
|
|
} |
8057
|
|
|
|
|
|
|
# generate a tag prefix for unknown tags if necessary |
8058
|
4572
|
100
|
|
|
|
11300
|
unless (defined $$table{TAG_PREFIX}) { |
8059
|
4472
|
|
|
|
|
6659
|
my $tagPrefix; |
8060
|
4472
|
50
|
66
|
|
|
27838
|
if ($tableName =~ /Image::.*?::(.*)::Main/ || $tableName =~ /Image::.*?::(.*)/) { |
8061
|
4472
|
|
|
|
|
20280
|
($tagPrefix = $1) =~ s/::/_/g; |
8062
|
|
|
|
|
|
|
} else { |
8063
|
0
|
|
|
|
|
0
|
$tagPrefix = $tableName; |
8064
|
|
|
|
|
|
|
} |
8065
|
4472
|
|
|
|
|
13462
|
$$table{TAG_PREFIX} = $tagPrefix; |
8066
|
|
|
|
|
|
|
} |
8067
|
|
|
|
|
|
|
# set up the new table |
8068
|
4572
|
|
|
|
|
13905
|
SetupTagTable($table); |
8069
|
|
|
|
|
|
|
# add any user-defined tags (except Composite tags, which are handled specially) |
8070
|
4572
|
100
|
100
|
|
|
22214
|
if (%UserDefined and $UserDefined{$tableName} and $table ne \%Image::ExifTool::Composite) { |
|
|
|
66
|
|
|
|
|
8071
|
2
|
|
|
|
|
5
|
my $tagID; |
8072
|
2
|
|
|
|
|
7
|
foreach $tagID (TagTableKeys($UserDefined{$tableName})) { |
8073
|
3
|
50
|
|
|
|
11
|
next if $specialTags{$tagID}; |
8074
|
3
|
|
|
|
|
7
|
delete $$table{$tagID}; # replace any existing entry |
8075
|
3
|
|
|
|
|
15
|
AddTagToTable($table, $tagID, $UserDefined{$tableName}{$tagID}, 1); |
8076
|
|
|
|
|
|
|
} |
8077
|
|
|
|
|
|
|
} |
8078
|
|
|
|
|
|
|
# remember order we loaded the tables in |
8079
|
4572
|
|
|
|
|
11105
|
push @tableOrder, $tableName; |
8080
|
|
|
|
|
|
|
# insert newly loaded table into list |
8081
|
4572
|
|
|
|
|
16387
|
$allTables{$tableName} = $table; |
8082
|
|
|
|
|
|
|
} |
8083
|
|
|
|
|
|
|
# must check each time to add UserDefined Composite tags because the Composite table |
8084
|
|
|
|
|
|
|
# may be loaded before the UserDefined tags are available |
8085
|
90394
|
50
|
66
|
|
|
257394
|
if ($table eq \%Image::ExifTool::Composite and not $$table{VARS}{LOADED_USERDEFINED} and |
|
|
|
100
|
|
|
|
|
|
|
|
66
|
|
|
|
|
8086
|
|
|
|
|
|
|
%UserDefined and $UserDefined{$tableName}) |
8087
|
|
|
|
|
|
|
{ |
8088
|
0
|
|
|
|
|
0
|
my $userComp = $UserDefined{$tableName}; |
8089
|
0
|
|
|
|
|
0
|
delete $UserDefined{$tableName}; # (must delete first to avoid infinite recursion) |
8090
|
0
|
|
|
|
|
0
|
AddCompositeTags($userComp, 1); |
8091
|
0
|
|
|
|
|
0
|
$UserDefined{$tableName} = $userComp; # (add back again for adding writable tags later) |
8092
|
0
|
|
|
|
|
0
|
$$table{VARS}{LOADED_USERDEFINED} = 1; # set flag to avoid doing this again |
8093
|
|
|
|
|
|
|
} |
8094
|
90394
|
|
|
|
|
208549
|
return $table; |
8095
|
|
|
|
|
|
|
} |
8096
|
|
|
|
|
|
|
|
8097
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8098
|
|
|
|
|
|
|
# Process an image directory |
8099
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) directory information reference |
8100
|
|
|
|
|
|
|
# 2) tag table reference, 3) optional reference to processing procedure |
8101
|
|
|
|
|
|
|
# Returns: Result from processing (1=success) |
8102
|
|
|
|
|
|
|
sub ProcessDirectory($$$;$) |
8103
|
|
|
|
|
|
|
{ |
8104
|
4988
|
|
|
4988
|
0
|
15929
|
my ($self, $dirInfo, $tagTablePtr, $proc) = @_; |
8105
|
|
|
|
|
|
|
|
8106
|
4988
|
50
|
33
|
|
|
20145
|
return 0 unless $tagTablePtr and $dirInfo; |
8107
|
|
|
|
|
|
|
# use default proc from tag table or EXIF proc as fallback if no proc specified |
8108
|
4988
|
100
|
100
|
|
|
21505
|
$proc or $proc = $$tagTablePtr{PROCESS_PROC} || \&Image::ExifTool::Exif::ProcessExif; |
8109
|
|
|
|
|
|
|
# set directory name from default group0 name if not done already |
8110
|
4988
|
|
|
|
|
9468
|
my $dirName = $$dirInfo{DirName}; |
8111
|
4988
|
100
|
|
|
|
11764
|
unless ($dirName) { |
8112
|
717
|
|
|
|
|
3106
|
$dirName = $$tagTablePtr{GROUPS}{0}; |
8113
|
717
|
100
|
|
|
|
2917
|
$dirName = $$tagTablePtr{GROUPS}{1} if $dirName =~ /^APP\d+$/; # (use specific APP name) |
8114
|
717
|
|
|
|
|
1800
|
$$dirInfo{DirName} = $dirName; |
8115
|
|
|
|
|
|
|
} |
8116
|
|
|
|
|
|
|
|
8117
|
|
|
|
|
|
|
# guard against cyclical recursion into the same directory |
8118
|
4988
|
100
|
100
|
|
|
26165
|
if (defined $$dirInfo{DirStart} and defined $$dirInfo{DataPos} and |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8119
|
|
|
|
|
|
|
# directories don't overlap if the length is zero |
8120
|
|
|
|
|
|
|
($$dirInfo{DirLen} or not defined $$dirInfo{DirLen})) |
8121
|
|
|
|
|
|
|
{ |
8122
|
4186
|
|
100
|
|
|
14665
|
my $addr = $$dirInfo{DirStart} + $$dirInfo{DataPos} + ($$dirInfo{Base}||0) + $$self{BASE}; |
8123
|
4186
|
50
|
|
|
|
11969
|
if ($$self{PROCESSED}{$addr}) { |
8124
|
0
|
|
|
|
|
0
|
$self->Warn("$dirName pointer references previous $$self{PROCESSED}{$addr} directory"); |
8125
|
|
|
|
|
|
|
# patch for bug in Windows phone 7.5 O/S that writes incorrect InteropIFD pointer |
8126
|
0
|
0
|
0
|
|
|
0
|
return 0 unless $dirName eq 'GPS' and $$self{PROCESSED}{$addr} eq 'InteropIFD'; |
8127
|
|
|
|
|
|
|
} |
8128
|
4186
|
50
|
66
|
|
|
20624
|
$$self{PROCESSED}{$addr} = $dirName unless $$tagTablePtr{VARS} and $$tagTablePtr{VARS}{ALLOW_REPROCESS}; |
8129
|
|
|
|
|
|
|
} |
8130
|
4988
|
|
|
|
|
12041
|
my $oldOrder = GetByteOrder(); |
8131
|
4988
|
|
|
|
|
19620
|
my @save = @$self{'INDENT','DIR_NAME','Compression','SubfileType'}; |
8132
|
4988
|
|
|
|
|
14048
|
$$self{LIST_TAGS} = { }; # don't build lists across different directories |
8133
|
4988
|
|
|
|
|
10214
|
$$self{INDENT} .= '| '; |
8134
|
4988
|
|
|
|
|
9040
|
$$self{DIR_NAME} = $dirName; |
8135
|
4988
|
|
|
|
|
7427
|
push @{$$self{PATH}}, $dirName; |
|
4988
|
|
|
|
|
11841
|
|
8136
|
4988
|
|
|
|
|
15251
|
$$self{FOUND_DIR}{$dirName} = 1; |
8137
|
|
|
|
|
|
|
|
8138
|
|
|
|
|
|
|
# process the directory |
8139
|
106
|
|
|
106
|
|
1026
|
no strict 'refs'; |
|
106
|
|
|
|
|
323
|
|
|
106
|
|
|
|
|
5603
|
|
8140
|
4988
|
|
|
|
|
26670
|
my $rtnVal = &$proc($self, $dirInfo, $tagTablePtr); |
8141
|
106
|
|
|
106
|
|
753
|
use strict 'refs'; |
|
106
|
|
|
|
|
279
|
|
|
106
|
|
|
|
|
858722
|
|
8142
|
|
|
|
|
|
|
|
8143
|
4988
|
|
|
|
|
8157
|
pop @{$$self{PATH}}; |
|
4988
|
|
|
|
|
11537
|
|
8144
|
4988
|
|
|
|
|
18471
|
@$self{'INDENT','DIR_NAME','Compression','SubfileType'} = @save; |
8145
|
4988
|
|
|
|
|
14035
|
SetByteOrder($oldOrder); |
8146
|
4988
|
|
|
|
|
20364
|
return $rtnVal; |
8147
|
|
|
|
|
|
|
} |
8148
|
|
|
|
|
|
|
|
8149
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8150
|
|
|
|
|
|
|
# Get Metadata path |
8151
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref |
8152
|
|
|
|
|
|
|
# Return: Metadata path string |
8153
|
|
|
|
|
|
|
sub MetadataPath($) |
8154
|
|
|
|
|
|
|
{ |
8155
|
725
|
|
|
725
|
0
|
1467
|
my $self = shift; |
8156
|
725
|
|
|
|
|
1339
|
return join '-', @{$$self{PATH}} |
|
725
|
|
|
|
|
3745
|
|
8157
|
|
|
|
|
|
|
} |
8158
|
|
|
|
|
|
|
|
8159
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8160
|
|
|
|
|
|
|
# Get standardized file extension |
8161
|
|
|
|
|
|
|
# Inputs: 0) file name |
8162
|
|
|
|
|
|
|
# Returns: standardized extension (all uppercase), or undefined if no extension |
8163
|
|
|
|
|
|
|
sub GetFileExtension($) |
8164
|
|
|
|
|
|
|
{ |
8165
|
1957
|
|
|
1957
|
0
|
3734
|
my $filename = shift; |
8166
|
1957
|
|
|
|
|
3019
|
my $fileExt; |
8167
|
1957
|
100
|
100
|
|
|
12974
|
if ($filename and $filename =~ /^.*\.([^.]+)$/s) { |
8168
|
1826
|
|
|
|
|
5289
|
$fileExt = uc($1); # change extension to upper case |
8169
|
|
|
|
|
|
|
# convert TIF extension to TIFF because we use the |
8170
|
|
|
|
|
|
|
# extension for the file type tag of TIFF images |
8171
|
1826
|
100
|
|
|
|
4602
|
$fileExt eq 'TIF' and $fileExt = 'TIFF'; |
8172
|
|
|
|
|
|
|
} |
8173
|
1957
|
|
|
|
|
6922
|
return $fileExt; |
8174
|
|
|
|
|
|
|
} |
8175
|
|
|
|
|
|
|
|
8176
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8177
|
|
|
|
|
|
|
# Get list of tag information hashes for given tag ID |
8178
|
|
|
|
|
|
|
# Inputs: 0) Tag table reference, 1) tag ID |
8179
|
|
|
|
|
|
|
# Returns: Array of tag information references |
8180
|
|
|
|
|
|
|
# Notes: Generates tagInfo hash if necessary |
8181
|
|
|
|
|
|
|
sub GetTagInfoList($$) |
8182
|
|
|
|
|
|
|
{ |
8183
|
538457
|
|
|
538457
|
0
|
859358
|
my ($tagTablePtr, $tagID) = @_; |
8184
|
538457
|
|
|
|
|
1044033
|
my $tagInfo = $$tagTablePtr{$tagID}; |
8185
|
|
|
|
|
|
|
|
8186
|
538457
|
50
|
|
|
|
1161930
|
if ($specialTags{$tagID}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8187
|
|
|
|
|
|
|
# (hopefully this won't happen) |
8188
|
0
|
|
|
|
|
0
|
warn "Tag $tagID conflicts with internal ExifTool variable in $$tagTablePtr{TABLE_NAME}\n"; |
8189
|
|
|
|
|
|
|
} elsif (ref $tagInfo eq 'HASH') { |
8190
|
493875
|
|
|
|
|
1012022
|
return ($tagInfo); |
8191
|
|
|
|
|
|
|
} elsif (ref $tagInfo eq 'ARRAY') { |
8192
|
11191
|
|
|
|
|
49357
|
return @$tagInfo; |
8193
|
|
|
|
|
|
|
} elsif ($tagInfo) { |
8194
|
|
|
|
|
|
|
# create hash with name |
8195
|
28909
|
|
|
|
|
65991
|
$tagInfo = $$tagTablePtr{$tagID} = { Name => $tagInfo }; |
8196
|
28909
|
|
|
|
|
59041
|
return ($tagInfo); |
8197
|
|
|
|
|
|
|
} |
8198
|
4482
|
|
|
|
|
8236
|
return (); |
8199
|
|
|
|
|
|
|
} |
8200
|
|
|
|
|
|
|
|
8201
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8202
|
|
|
|
|
|
|
# Find tag information, processing conditional tags |
8203
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) tagTable pointer, 2) tag ID |
8204
|
|
|
|
|
|
|
# 3) optional value reference, 4) optional format type, 5) optional value count |
8205
|
|
|
|
|
|
|
# Returns: pointer to tagInfo hash, undefined if none found, or '' if $valPt needed |
8206
|
|
|
|
|
|
|
# Notes: You should always call this routine to find a tag in a table because |
8207
|
|
|
|
|
|
|
# this routine will evaluate conditional tags. |
8208
|
|
|
|
|
|
|
# Arguments 3-5 are only required if the information type allows $valPt, $format and/or |
8209
|
|
|
|
|
|
|
# $count in a Condition, and if not given when needed this routine returns ''. |
8210
|
|
|
|
|
|
|
sub GetTagInfo($$$;$$$) |
8211
|
|
|
|
|
|
|
{ |
8212
|
109313
|
|
|
109313
|
0
|
205977
|
my ($self, $tagTablePtr, $tagID) = @_; |
8213
|
109313
|
|
|
|
|
154484
|
my ($valPt, $format, $count); |
8214
|
|
|
|
|
|
|
|
8215
|
109313
|
|
|
|
|
212730
|
my @infoArray = GetTagInfoList($tagTablePtr, $tagID); |
8216
|
|
|
|
|
|
|
# evaluate condition |
8217
|
109313
|
|
|
|
|
155972
|
my $tagInfo; |
8218
|
109313
|
|
|
|
|
181390
|
foreach $tagInfo (@infoArray) { |
8219
|
114177
|
|
|
|
|
246650
|
my $condition = $$tagInfo{Condition}; |
8220
|
114177
|
100
|
|
|
|
214448
|
if ($condition) { |
8221
|
13295
|
100
|
|
|
|
31642
|
($valPt, $format, $count) = splice(@_, 3) if @_ > 3; |
8222
|
13295
|
100
|
100
|
|
|
74197
|
return '' if $condition =~ /\$(valPt|format|count)\b/ and not defined $valPt; |
8223
|
|
|
|
|
|
|
# set old value for use in condition if needed |
8224
|
12608
|
|
|
|
|
54589
|
local $SIG{'__WARN__'} = \&SetWarning; |
8225
|
12608
|
|
|
|
|
22784
|
undef $evalWarning; |
8226
|
|
|
|
|
|
|
#### eval Condition ($self, [$valPt, $format, $count]) |
8227
|
12608
|
100
|
|
|
|
942572
|
unless (eval $condition) { |
8228
|
10126
|
50
|
|
|
|
25388
|
$@ and $evalWarning = $@; |
8229
|
10126
|
50
|
|
|
|
19434
|
$self->Warn("Condition $$tagInfo{Name}: " . CleanWarning()) if $evalWarning; |
8230
|
10126
|
|
|
|
|
47643
|
next; |
8231
|
|
|
|
|
|
|
} |
8232
|
|
|
|
|
|
|
} |
8233
|
|
|
|
|
|
|
# don't return Unknown tags unless that option is set (also see forum13716) |
8234
|
103364
|
100
|
100
|
|
|
266649
|
if ($$tagInfo{Unknown} and not $$self{OPTIONS}{Unknown} and not |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8235
|
|
|
|
|
|
|
($$self{OPTIONS}{Verbose} or $$self{HTML_DUMP} or |
8236
|
|
|
|
|
|
|
($$self{OPTIONS}{Validate} and not $$tagInfo{AddedUnknown}))) |
8237
|
|
|
|
|
|
|
{ |
8238
|
2095
|
|
|
|
|
5633
|
return undef; |
8239
|
|
|
|
|
|
|
} |
8240
|
|
|
|
|
|
|
# return the tag information we found |
8241
|
101269
|
|
|
|
|
237667
|
return $tagInfo; |
8242
|
|
|
|
|
|
|
} |
8243
|
|
|
|
|
|
|
# generate information for unknown tags (numerical only) if required |
8244
|
5262
|
100
|
100
|
|
|
35622
|
if (not $tagInfo and ($$self{OPTIONS}{Unknown} or $$self{OPTIONS}{Verbose}) and |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8245
|
|
|
|
|
|
|
$tagID =~ /^\d+$/ and not $$self{NO_UNKNOWN}) |
8246
|
|
|
|
|
|
|
{ |
8247
|
590
|
|
|
|
|
1085
|
my $printConv; |
8248
|
590
|
100
|
|
|
|
1315
|
if (defined $$tagTablePtr{PRINT_CONV}) { |
8249
|
155
|
|
|
|
|
325
|
$printConv = $$tagTablePtr{PRINT_CONV}; |
8250
|
|
|
|
|
|
|
} else { |
8251
|
|
|
|
|
|
|
# limit length of printout (can be very long) |
8252
|
435
|
|
|
|
|
737
|
$printConv = 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val'; |
8253
|
|
|
|
|
|
|
} |
8254
|
590
|
|
|
|
|
2035
|
my $hex = sprintf("0x%.4x", $tagID); |
8255
|
590
|
|
|
|
|
1195
|
my $prefix = $$tagTablePtr{TAG_PREFIX}; |
8256
|
590
|
|
|
|
|
1827
|
$tagInfo = { |
8257
|
|
|
|
|
|
|
Name => "${prefix}_$hex", |
8258
|
|
|
|
|
|
|
Description => MakeDescription($prefix, $hex), |
8259
|
|
|
|
|
|
|
Unknown => 1, |
8260
|
|
|
|
|
|
|
Writable => 0, # can't write unknown tags |
8261
|
|
|
|
|
|
|
PrintConv => $printConv, |
8262
|
|
|
|
|
|
|
AddedUnknown => 1, |
8263
|
|
|
|
|
|
|
}; |
8264
|
|
|
|
|
|
|
# add tag information to table |
8265
|
590
|
|
|
|
|
1721
|
AddTagToTable($tagTablePtr, $tagID, $tagInfo); |
8266
|
|
|
|
|
|
|
} else { |
8267
|
4672
|
|
|
|
|
7600
|
undef $tagInfo; |
8268
|
|
|
|
|
|
|
} |
8269
|
5262
|
|
|
|
|
12600
|
return $tagInfo; |
8270
|
|
|
|
|
|
|
} |
8271
|
|
|
|
|
|
|
|
8272
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8273
|
|
|
|
|
|
|
# Add new tag to table (must use this routine to add new tags to a table) |
8274
|
|
|
|
|
|
|
# Inputs: 0) reference to tag table, 1) tag ID |
8275
|
|
|
|
|
|
|
# 2) [optional] tag name or reference to tag information hash |
8276
|
|
|
|
|
|
|
# 3) [optional] flag to avoid adding prefix when generating tag name |
8277
|
|
|
|
|
|
|
# Returns: tagInfo ref |
8278
|
|
|
|
|
|
|
# Notes: - will not override existing entry in table |
8279
|
|
|
|
|
|
|
# - info need contain no entries when this routine is called |
8280
|
|
|
|
|
|
|
# - tag name is cleaned if necessary |
8281
|
|
|
|
|
|
|
sub AddTagToTable($$;$$) |
8282
|
|
|
|
|
|
|
{ |
8283
|
6096
|
|
|
6096
|
0
|
12636
|
my ($tagTablePtr, $tagID, $tagInfo, $noPrefix) = @_; |
8284
|
|
|
|
|
|
|
|
8285
|
|
|
|
|
|
|
# generate tag info hash if necessary |
8286
|
6096
|
0
|
|
|
|
13878
|
$tagInfo = $tagInfo ? { Name => $tagInfo } : { } unless ref $tagInfo eq 'HASH'; |
|
|
50
|
|
|
|
|
|
8287
|
|
|
|
|
|
|
|
8288
|
|
|
|
|
|
|
# define necessary entries in information hash |
8289
|
6096
|
100
|
|
|
|
11762
|
if ($$tagInfo{Groups}) { |
8290
|
|
|
|
|
|
|
# fill in default groups from table GROUPS |
8291
|
432
|
|
|
|
|
1125
|
foreach (keys %{$$tagTablePtr{GROUPS}}) { |
|
432
|
|
|
|
|
1578
|
|
8292
|
1296
|
100
|
|
|
|
2962
|
next if $$tagInfo{Groups}{$_}; |
8293
|
558
|
|
|
|
|
1333
|
$$tagInfo{Groups}{$_} = $$tagTablePtr{GROUPS}{$_}; |
8294
|
|
|
|
|
|
|
} |
8295
|
|
|
|
|
|
|
} else { |
8296
|
5664
|
|
|
|
|
7220
|
$$tagInfo{Groups} = { %{$$tagTablePtr{GROUPS}} }; |
|
5664
|
|
|
|
|
28918
|
|
8297
|
|
|
|
|
|
|
} |
8298
|
6096
|
100
|
|
|
|
14649
|
$$tagInfo{Flags} and ExpandFlags($tagInfo); |
8299
|
|
|
|
|
|
|
$$tagInfo{GotGroups} = 1, |
8300
|
6096
|
|
|
|
|
14048
|
$$tagInfo{Table} = $tagTablePtr; |
8301
|
6096
|
|
|
|
|
13001
|
$$tagInfo{TagID} = $tagID; |
8302
|
6096
|
100
|
100
|
|
|
15728
|
if (defined $$tagTablePtr{AVOID} and not defined $$tagInfo{Avoid}) { |
8303
|
1442
|
|
|
|
|
3098
|
$$tagInfo{Avoid} = $$tagTablePtr{AVOID}; |
8304
|
|
|
|
|
|
|
} |
8305
|
|
|
|
|
|
|
|
8306
|
6096
|
|
|
|
|
9941
|
my $name = $$tagInfo{Name}; |
8307
|
6096
|
100
|
|
|
|
11636
|
$name = $tagID unless defined $name; |
8308
|
6096
|
|
|
|
|
12855
|
$name =~ tr/-_a-zA-Z0-9//dc; # remove illegal characters |
8309
|
6096
|
|
|
|
|
11363
|
$name = ucfirst $name; # capitalize first letter |
8310
|
|
|
|
|
|
|
# add tag-name prefix if specified and tag name not provided |
8311
|
6096
|
100
|
100
|
|
|
13745
|
unless (defined $$tagInfo{Name} or $noPrefix or not $$tagTablePtr{TAG_PREFIX}) { |
|
|
|
66
|
|
|
|
|
8312
|
|
|
|
|
|
|
# make description to prevent tagID from getting mangled by MakeDescription() |
8313
|
22
|
|
|
|
|
62
|
$$tagInfo{Description} = MakeDescription($$tagTablePtr{TAG_PREFIX}, $name); |
8314
|
22
|
|
|
|
|
61
|
$name = "$$tagTablePtr{TAG_PREFIX}_$name"; |
8315
|
|
|
|
|
|
|
} |
8316
|
|
|
|
|
|
|
# tag names must be at least 2 characters long and prefer them to start with a letter |
8317
|
6096
|
100
|
100
|
|
|
27767
|
$name = "Tag$name" if length($name) < 2 or $name !~ /^[A-Z]/i; |
8318
|
6096
|
|
|
|
|
11464
|
$$tagInfo{Name} = $name; |
8319
|
|
|
|
|
|
|
# add tag to table, but never override existing entries (could potentially happen |
8320
|
|
|
|
|
|
|
# if someone thinks there isn't any tagInfo because a condition wasn't satisfied) |
8321
|
6096
|
50
|
66
|
|
|
21134
|
unless (defined $$tagTablePtr{$tagID} or $specialTags{$tagID}) { |
8322
|
6013
|
|
|
|
|
19965
|
$$tagTablePtr{$tagID} = $tagInfo; |
8323
|
|
|
|
|
|
|
} |
8324
|
6096
|
100
|
|
|
|
12391
|
$$tagInfo{AddedUnknown} = 1 if $$tagInfo{Unknown}; |
8325
|
6096
|
|
|
|
|
13453
|
return $tagInfo; |
8326
|
|
|
|
|
|
|
} |
8327
|
|
|
|
|
|
|
|
8328
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8329
|
|
|
|
|
|
|
# Handle simple extraction of new tag information |
8330
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag table reference, 2) tagID, 3) value, |
8331
|
|
|
|
|
|
|
# 4-N) parameters hash: Index, DataPt, DataPos, Base, Start, Size, Parent, |
8332
|
|
|
|
|
|
|
# TagInfo, ProcessProc, RAF, Format, Count |
8333
|
|
|
|
|
|
|
# Returns: tag key or undef if tag not found |
8334
|
|
|
|
|
|
|
# Notes: if value is not defined, it is extracted from DataPt using TagInfo |
8335
|
|
|
|
|
|
|
# Format and Count if provided |
8336
|
|
|
|
|
|
|
sub HandleTag($$$$;%) |
8337
|
|
|
|
|
|
|
{ |
8338
|
9502
|
|
|
9502
|
0
|
36047
|
my ($self, $tagTablePtr, $tag, $val, %parms) = @_; |
8339
|
9502
|
|
|
|
|
18213
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8340
|
9502
|
|
|
|
|
14250
|
my $pfmt = $parms{Format}; |
8341
|
9502
|
|
100
|
|
|
35355
|
my $tagInfo = $parms{TagInfo} || $self->GetTagInfo($tagTablePtr, $tag, \$val, $pfmt, $parms{Count}); |
8342
|
9502
|
|
|
|
|
19536
|
my $dataPt = $parms{DataPt}; |
8343
|
9502
|
|
|
|
|
14764
|
my ($subdir, $format, $noTagInfo, $rational); |
8344
|
|
|
|
|
|
|
|
8345
|
9502
|
100
|
|
|
|
18140
|
if ($tagInfo) { |
8346
|
7343
|
|
|
|
|
13208
|
$subdir = $$tagInfo{SubDirectory}; |
8347
|
|
|
|
|
|
|
} else { |
8348
|
2159
|
50
|
|
|
|
7628
|
return undef unless $verbose; |
8349
|
0
|
|
|
|
|
0
|
$tagInfo = { Name => "tag $tag" }; # create temporary tagInfo hash |
8350
|
0
|
|
|
|
|
0
|
$noTagInfo = 1; |
8351
|
|
|
|
|
|
|
} |
8352
|
|
|
|
|
|
|
# read value if not done already (not necessary for subdir) |
8353
|
7343
|
50
|
66
|
|
|
19731
|
unless (defined $val or ($subdir and not $$tagInfo{Writable} and not $$tagInfo{RawConv})) { |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8354
|
873
|
|
100
|
|
|
2559
|
my $start = $parms{Start} || 0; |
8355
|
873
|
50
|
|
|
|
2069
|
my $dLen = $dataPt ? length($$dataPt) : -1; |
8356
|
873
|
|
|
|
|
1571
|
my $size = $parms{Size}; |
8357
|
873
|
100
|
|
|
|
1847
|
$size = $dLen unless defined $size; |
8358
|
|
|
|
|
|
|
# read from data in memory if possible |
8359
|
873
|
50
|
33
|
|
|
3184
|
if ($start >= 0 and $start + $size <= $dLen) { |
8360
|
873
|
|
100
|
|
|
2933
|
$format = $$tagInfo{Format} || $$tagTablePtr{FORMAT}; |
8361
|
873
|
50
|
100
|
|
|
3408
|
$format = $pfmt if not $format and $pfmt and $formatSize{$pfmt}; |
|
|
|
66
|
|
|
|
|
8362
|
873
|
100
|
|
|
|
2594
|
if ($format) { |
8363
|
422
|
|
|
|
|
1478
|
$val = ReadValue($dataPt, $start, $format, $$tagInfo{Count}, $size, \$rational); |
8364
|
|
|
|
|
|
|
} else { |
8365
|
451
|
|
|
|
|
1251
|
$val = substr($$dataPt, $start, $size); |
8366
|
|
|
|
|
|
|
} |
8367
|
|
|
|
|
|
|
} else { |
8368
|
0
|
|
|
|
|
0
|
$self->Warn("Error extracting value for $$tagInfo{Name}"); |
8369
|
0
|
|
|
|
|
0
|
return undef; |
8370
|
|
|
|
|
|
|
} |
8371
|
|
|
|
|
|
|
} |
8372
|
|
|
|
|
|
|
# do verbose print if necessary |
8373
|
7343
|
100
|
|
|
|
15603
|
if ($verbose) { |
8374
|
51
|
50
|
|
|
|
106
|
undef $tagInfo if $noTagInfo; |
8375
|
51
|
|
|
|
|
93
|
$parms{Value} = $val; |
8376
|
51
|
50
|
|
|
|
101
|
$parms{Value} .= " ($rational)" if defined $rational; |
8377
|
51
|
|
|
|
|
94
|
$parms{Table} = $tagTablePtr; |
8378
|
51
|
50
|
|
|
|
109
|
if ($format) { |
8379
|
0
|
|
0
|
|
|
0
|
my $count = int(($parms{Size} || 0) / ($formatSize{$format} || 1)); |
|
|
|
0
|
|
|
|
|
8380
|
0
|
|
|
|
|
0
|
$parms{Format} = $format . "[$count]"; |
8381
|
|
|
|
|
|
|
} |
8382
|
51
|
|
|
|
|
249
|
$self->VerboseInfo($tag, $tagInfo, %parms); |
8383
|
|
|
|
|
|
|
} |
8384
|
7343
|
50
|
|
|
|
14208
|
if ($tagInfo) { |
8385
|
7343
|
100
|
|
|
|
13688
|
if ($subdir) { |
8386
|
747
|
|
|
|
|
1627
|
my $subdirStart = $parms{Start}; |
8387
|
747
|
|
|
|
|
1347
|
my $subdirLen = $parms{Size}; |
8388
|
747
|
100
|
66
|
|
|
2198
|
if ($$tagInfo{RawConv} and not $$tagInfo{Writable}) { |
8389
|
1
|
|
|
|
|
2
|
my $conv = $$tagInfo{RawConv}; |
8390
|
1
|
|
|
|
|
5
|
local $SIG{'__WARN__'} = \&SetWarning; |
8391
|
1
|
|
|
|
|
5
|
undef $evalWarning; |
8392
|
1
|
50
|
|
|
|
5
|
if (ref $conv eq 'CODE') { |
8393
|
0
|
|
|
|
|
0
|
$val = &$conv($val, $self); |
8394
|
|
|
|
|
|
|
} else { |
8395
|
1
|
|
|
|
|
3
|
my ($priority, @grps); |
8396
|
|
|
|
|
|
|
# NOTE: RawConv is evaluated in Writer.pl and twice in ExifTool.pm |
8397
|
|
|
|
|
|
|
#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) |
8398
|
1
|
|
|
|
|
91
|
$val = eval $conv; |
8399
|
1
|
50
|
|
|
|
7
|
$@ and $evalWarning = $@; |
8400
|
|
|
|
|
|
|
} |
8401
|
1
|
50
|
|
|
|
3
|
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; |
8402
|
1
|
50
|
|
|
|
4
|
return undef unless defined $val; |
8403
|
1
|
50
|
|
|
|
7
|
$val = $$val if ref $val eq 'SCALAR'; |
8404
|
1
|
|
|
|
|
3
|
$dataPt = \$val; |
8405
|
1
|
|
|
|
|
2
|
$subdirStart = 0; |
8406
|
1
|
|
|
|
|
6
|
$subdirLen = length $val; |
8407
|
|
|
|
|
|
|
} |
8408
|
747
|
100
|
|
|
|
2252
|
if ($$subdir{Start}) { |
8409
|
8
|
|
|
|
|
32
|
my $valuePtr = 0; |
8410
|
|
|
|
|
|
|
#### eval Start ($valuePtr) |
8411
|
8
|
|
|
|
|
427
|
my $off = eval $$subdir{Start}; |
8412
|
8
|
|
|
|
|
38
|
$subdirStart += $off; |
8413
|
8
|
|
|
|
|
27
|
$subdirLen -= $off; |
8414
|
|
|
|
|
|
|
} |
8415
|
747
|
100
|
|
|
|
1827
|
$dataPt or $dataPt = \$val; |
8416
|
|
|
|
|
|
|
# process subdirectory information |
8417
|
|
|
|
|
|
|
my %dirInfo = ( |
8418
|
|
|
|
|
|
|
DirName => $$subdir{DirName} || $$tagInfo{Name}, |
8419
|
|
|
|
|
|
|
DataPt => $dataPt, |
8420
|
|
|
|
|
|
|
DataLen => length $$dataPt, |
8421
|
|
|
|
|
|
|
DataPos => $parms{DataPos}, |
8422
|
|
|
|
|
|
|
DirStart => $subdirStart, |
8423
|
|
|
|
|
|
|
DirLen => $subdirLen, |
8424
|
|
|
|
|
|
|
Parent => $parms{Parent}, |
8425
|
|
|
|
|
|
|
Base => $parms{Base}, |
8426
|
|
|
|
|
|
|
Multi => $$subdir{Multi}, |
8427
|
|
|
|
|
|
|
TagInfo => $tagInfo, |
8428
|
|
|
|
|
|
|
RAF => $parms{RAF}, |
8429
|
747
|
|
66
|
|
|
7574
|
); |
8430
|
747
|
|
|
|
|
1946
|
my $oldOrder = GetByteOrder(); |
8431
|
747
|
100
|
|
|
|
2077
|
if ($$subdir{ByteOrder}) { |
8432
|
3
|
100
|
|
|
|
26
|
if ($$subdir{ByteOrder} eq 'Unknown') { |
8433
|
1
|
50
|
|
|
|
19
|
if ($subdirStart + 2 <= $subdirLen) { |
8434
|
|
|
|
|
|
|
# attempt to determine the byte ordering of an IFD-style subdirectory |
8435
|
1
|
|
|
|
|
8
|
my $num = Get16u($dataPt, $subdirStart); |
8436
|
1
|
50
|
33
|
|
|
10
|
ToggleByteOrder if $num & 0xff00 and ($num>>8) > ($num&0xff); |
8437
|
|
|
|
|
|
|
} |
8438
|
|
|
|
|
|
|
} else { |
8439
|
2
|
|
|
|
|
11
|
SetByteOrder($$subdir{ByteOrder}); |
8440
|
|
|
|
|
|
|
} |
8441
|
|
|
|
|
|
|
} |
8442
|
747
|
|
33
|
|
|
2243
|
my $subTablePtr = GetTagTable($$subdir{TagTable}) || $tagTablePtr; |
8443
|
747
|
|
100
|
|
|
5027
|
$self->ProcessDirectory(\%dirInfo, $subTablePtr, $$subdir{ProcessProc} || $parms{ProcessProc}); |
8444
|
747
|
|
|
|
|
2370
|
SetByteOrder($oldOrder); |
8445
|
|
|
|
|
|
|
# return now unless directory is writable as a block |
8446
|
747
|
50
|
|
|
|
6125
|
return undef unless $$tagInfo{Writable}; |
8447
|
|
|
|
|
|
|
} |
8448
|
6596
|
|
|
|
|
15010
|
my $key = $self->FoundTag($tagInfo, $val); |
8449
|
|
|
|
|
|
|
# save original components of rational numbers |
8450
|
6596
|
100
|
66
|
|
|
17678
|
$$self{RATIONAL}{$key} = $rational if defined $rational and defined $key; |
8451
|
6596
|
|
|
|
|
22295
|
return $key; |
8452
|
|
|
|
|
|
|
} |
8453
|
0
|
|
|
|
|
0
|
return undef; |
8454
|
|
|
|
|
|
|
} |
8455
|
|
|
|
|
|
|
|
8456
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8457
|
|
|
|
|
|
|
# Add tag to hash of extracted information |
8458
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8459
|
|
|
|
|
|
|
# 1) reference to tagInfo hash or tag name |
8460
|
|
|
|
|
|
|
# 2) data value (or reference to require hash if Composite) |
8461
|
|
|
|
|
|
|
# 3) optional family 0 group, 4) optional family 1 group |
8462
|
|
|
|
|
|
|
# Returns: tag key or undef if no value |
8463
|
|
|
|
|
|
|
sub FoundTag($$$;@) |
8464
|
|
|
|
|
|
|
{ |
8465
|
59806
|
|
|
59806
|
0
|
92073
|
local $_; |
8466
|
59806
|
|
|
|
|
114661
|
my ($self, $tagInfo, $value, @grps) = @_; |
8467
|
59806
|
|
|
|
|
86197
|
my ($tag, $noListDel, $tbl); |
8468
|
59806
|
|
|
|
|
105135
|
my $options = $$self{OPTIONS}; |
8469
|
|
|
|
|
|
|
|
8470
|
59806
|
100
|
|
|
|
129343
|
if (ref $tagInfo eq 'HASH') { |
8471
|
52302
|
50
|
|
|
|
153748
|
$tag = $$tagInfo{Name} or warn("No tag name\n"), return undef; |
8472
|
52302
|
|
|
|
|
93125
|
$tbl = $$tagInfo{Table}; |
8473
|
|
|
|
|
|
|
} else { |
8474
|
7504
|
|
|
|
|
11040
|
$tag = $tagInfo; |
8475
|
|
|
|
|
|
|
# look for tag in Extra |
8476
|
7504
|
|
|
|
|
15387
|
$tbl = GetTagTable('Image::ExifTool::Extra'); |
8477
|
7504
|
|
|
|
|
18005
|
$tagInfo = $self->GetTagInfo($tbl, $tag); |
8478
|
|
|
|
|
|
|
# make temporary hash if tag doesn't exist in Extra |
8479
|
|
|
|
|
|
|
# (not advised to do this since the tag won't show in list) |
8480
|
7504
|
100
|
|
|
|
15516
|
$tagInfo or $tagInfo = { Name => $tag, Groups => \%allGroupsExifTool }; |
8481
|
7504
|
100
|
|
|
|
16702
|
$$options{Verbose} and $self->VerboseInfo(undef, $tagInfo, Value => $value); |
8482
|
|
|
|
|
|
|
} |
8483
|
|
|
|
|
|
|
# get tag priority |
8484
|
59806
|
|
|
|
|
92599
|
my $priority = $$tagInfo{Priority}; |
8485
|
59806
|
100
|
|
|
|
116539
|
unless (defined $priority) { |
8486
|
55290
|
|
|
|
|
90075
|
$priority = $$tbl{PRIORITY}; |
8487
|
55290
|
100
|
100
|
|
|
191892
|
$priority = 0 if not defined $priority and $$tagInfo{Avoid}; |
8488
|
|
|
|
|
|
|
} |
8489
|
59806
|
100
|
|
|
|
133063
|
$grps[0] or $grps[0] = $$self{SET_GROUP0}; |
8490
|
59806
|
100
|
|
|
|
120298
|
$grps[1] or $grps[1] = $$self{SET_GROUP1}; |
8491
|
59806
|
|
|
|
|
96037
|
my $valueHash = $$self{VALUE}; |
8492
|
|
|
|
|
|
|
|
8493
|
59806
|
100
|
|
|
|
122992
|
if ($$tagInfo{RawConv}) { |
8494
|
|
|
|
|
|
|
# initialize @val for use in Composite RawConv expressions |
8495
|
9388
|
|
|
|
|
16394
|
my @val; |
8496
|
9388
|
50
|
66
|
|
|
26060
|
if (ref $value eq 'HASH' and $$tagInfo{IsComposite}) { |
8497
|
1814
|
|
|
|
|
5192
|
foreach (keys %$value) { $val[$_] = $$valueHash{$$value{$_}}; } |
|
6084
|
|
|
|
|
15753
|
|
8498
|
|
|
|
|
|
|
} |
8499
|
9388
|
|
|
|
|
19354
|
my $conv = $$tagInfo{RawConv}; |
8500
|
9388
|
|
|
|
|
46234
|
local $SIG{'__WARN__'} = \&SetWarning; |
8501
|
9388
|
|
|
|
|
18538
|
undef $evalWarning; |
8502
|
9388
|
100
|
|
|
|
19105
|
if (ref $conv eq 'CODE') { |
8503
|
220
|
|
|
|
|
1157
|
$value = &$conv($value, $self); |
8504
|
220
|
50
|
|
|
|
795
|
$$self{grps} and @grps = @{$$self{grps}}, delete $$self{grps}; |
|
0
|
|
|
|
|
0
|
|
8505
|
|
|
|
|
|
|
} else { |
8506
|
9168
|
|
|
|
|
14340
|
my $val = $value; # do this so eval can use $val |
8507
|
|
|
|
|
|
|
# NOTE: RawConv is also evaluated in Writer.pl |
8508
|
|
|
|
|
|
|
#### eval RawConv ($self, $val, $tag, $tagInfo, $priority, @grps) |
8509
|
9168
|
|
|
|
|
821056
|
$value = eval $conv; |
8510
|
9168
|
50
|
|
|
|
41319
|
$@ and $evalWarning = $@; |
8511
|
|
|
|
|
|
|
} |
8512
|
9388
|
50
|
|
|
|
22299
|
$self->Warn("RawConv $tag: " . CleanWarning()) if $evalWarning; |
8513
|
9388
|
100
|
|
|
|
42761
|
return undef unless defined $value; |
8514
|
|
|
|
|
|
|
} |
8515
|
|
|
|
|
|
|
# ignore specified tags (AFTER doing RawConv if necessary!) |
8516
|
57172
|
50
|
|
|
|
118352
|
if ($$options{IgnoreTags}) { |
8517
|
0
|
0
|
|
|
|
0
|
if ($$options{IgnoreTags}{all}) { |
8518
|
0
|
0
|
|
|
|
0
|
return undef unless $$self{REQ_TAG_LOOKUP}{lc $tag}; |
8519
|
|
|
|
|
|
|
} else { |
8520
|
0
|
0
|
|
|
|
0
|
return undef if $$options{IgnoreTags}{lc $tag}; |
8521
|
|
|
|
|
|
|
} |
8522
|
|
|
|
|
|
|
} |
8523
|
|
|
|
|
|
|
# handle duplicate tag names |
8524
|
57172
|
100
|
|
|
|
147671
|
if (defined $$valueHash{$tag}) { |
|
|
100
|
|
|
|
|
|
8525
|
|
|
|
|
|
|
# add to list if there is an active list for this tag |
8526
|
6671
|
100
|
|
|
|
20427
|
if ($$self{LIST_TAGS}{$tagInfo}) { |
8527
|
645
|
|
|
|
|
1765
|
$tag = $$self{LIST_TAGS}{$tagInfo}; # use key from previous list tag |
8528
|
645
|
100
|
|
|
|
1564
|
if (defined $$self{NO_LIST}) { |
8529
|
|
|
|
|
|
|
# accumulate list in TAG_EXTRA "NoList" element |
8530
|
65
|
100
|
|
|
|
207
|
if (defined $$self{TAG_EXTRA}{$tag}{NoList}) { |
8531
|
31
|
|
|
|
|
90
|
push @{$$self{TAG_EXTRA}{$tag}{NoList}}, $value; |
|
31
|
|
|
|
|
129
|
|
8532
|
|
|
|
|
|
|
} else { |
8533
|
34
|
|
|
|
|
145
|
$$self{TAG_EXTRA}{$tag}{NoList} = [ $$valueHash{$tag}, $value ]; |
8534
|
|
|
|
|
|
|
} |
8535
|
65
|
|
|
|
|
150
|
$noListDel = 1; # set flag to delete this tag if re-listed |
8536
|
|
|
|
|
|
|
} else { |
8537
|
580
|
100
|
|
|
|
1743
|
if (ref $$valueHash{$tag} ne 'ARRAY') { |
8538
|
300
|
|
|
|
|
1035
|
$$valueHash{$tag} = [ $$valueHash{$tag} ]; |
8539
|
|
|
|
|
|
|
} |
8540
|
580
|
|
|
|
|
1016
|
push @{$$valueHash{$tag}}, $value; |
|
580
|
|
|
|
|
1922
|
|
8541
|
580
|
|
|
|
|
2157
|
return $tag; # return without creating a new entry |
8542
|
|
|
|
|
|
|
} |
8543
|
|
|
|
|
|
|
} |
8544
|
|
|
|
|
|
|
# get next available tag key |
8545
|
6091
|
|
100
|
|
|
26967
|
my $nextInd = $$self{DUPL_TAG}{$tag} = ($$self{DUPL_TAG}{$tag} || 0) + 1; |
8546
|
6091
|
|
|
|
|
15492
|
my $nextTag = "$tag ($nextInd)"; |
8547
|
|
|
|
|
|
|
# |
8548
|
|
|
|
|
|
|
# take tag with highest priority |
8549
|
|
|
|
|
|
|
# |
8550
|
|
|
|
|
|
|
# promote existing 0-priority tag so it takes precedence over a new 0-tag |
8551
|
|
|
|
|
|
|
# (unless old tag was a sub-document and new tag isn't. Also, never override |
8552
|
|
|
|
|
|
|
# a Warning tag because they may be added by ValueConv, which could be confusing) |
8553
|
6091
|
|
|
|
|
12016
|
my $oldPriority = $$self{PRIORITY}{$tag}; |
8554
|
6091
|
100
|
|
|
|
12573
|
unless ($oldPriority) { |
8555
|
5183
|
100
|
100
|
|
|
29983
|
if ($$self{DOC_NUM} or not $$self{TAG_EXTRA}{$tag} or $tag eq 'Warning' or |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8556
|
|
|
|
|
|
|
not $$self{TAG_EXTRA}{$tag}{G3}) |
8557
|
|
|
|
|
|
|
{ |
8558
|
5148
|
|
|
|
|
8888
|
$oldPriority = 1; |
8559
|
|
|
|
|
|
|
} else { |
8560
|
35
|
|
|
|
|
71
|
$oldPriority = 0; # don't promote sub-document tag over main document |
8561
|
|
|
|
|
|
|
} |
8562
|
|
|
|
|
|
|
} |
8563
|
|
|
|
|
|
|
# set priority for this tag |
8564
|
6091
|
100
|
100
|
|
|
28111
|
if (defined $priority) { |
|
|
100
|
33
|
|
|
|
|
8565
|
|
|
|
|
|
|
# increase 0-priority tags if this is the priority directory |
8566
|
|
|
|
|
|
|
$priority = 1 if not $priority and $$self{DIR_NAME} and |
8567
|
2067
|
100
|
100
|
|
|
11756
|
$$self{DIR_NAME} eq $$self{PRIORITY_DIR}; |
|
|
|
100
|
|
|
|
|
8568
|
|
|
|
|
|
|
} elsif ($$self{LOW_PRIORITY_DIR}{'*'} or |
8569
|
|
|
|
|
|
|
($$self{DIR_NAME} and $$self{LOW_PRIORITY_DIR}{$$self{DIR_NAME}})) |
8570
|
|
|
|
|
|
|
{ |
8571
|
411
|
|
|
|
|
684
|
$priority = 0; # default is 0 for a LOW_PRIORITY_DIR |
8572
|
|
|
|
|
|
|
} else { |
8573
|
3613
|
|
|
|
|
6013
|
$priority = 1; # the normal default |
8574
|
|
|
|
|
|
|
} |
8575
|
6091
|
100
|
100
|
|
|
29198
|
if ($priority >= $oldPriority and (not $$self{DOC_NUM} or |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
8576
|
|
|
|
|
|
|
($$self{TAG_EXTRA}{$tag} and $$self{TAG_EXTRA}{$tag}{G3} and |
8577
|
|
|
|
|
|
|
$$self{DOC_NUM} eq $$self{TAG_EXTRA}{$tag}{G3})) and not $noListDel) |
8578
|
|
|
|
|
|
|
{ |
8579
|
|
|
|
|
|
|
# move existing tag out of the way since this tag is higher priority |
8580
|
|
|
|
|
|
|
# (NOTE: any new members added here must also be added to DeleteTag()) |
8581
|
2745
|
|
|
|
|
9932
|
$$self{PRIORITY}{$nextTag} = $$self{PRIORITY}{$tag}; |
8582
|
2745
|
|
|
|
|
7248
|
$$valueHash{$nextTag} = $$valueHash{$tag}; |
8583
|
2745
|
|
|
|
|
6741
|
$$self{FILE_ORDER}{$nextTag} = $$self{FILE_ORDER}{$tag}; |
8584
|
2745
|
|
|
|
|
7140
|
my $oldInfo = $$self{TAG_INFO}{$nextTag} = $$self{TAG_INFO}{$tag}; |
8585
|
2745
|
|
|
|
|
5910
|
foreach ('TAG_EXTRA','RATIONAL') { |
8586
|
5490
|
100
|
|
|
|
14199
|
if ($$self{$_}{$tag}) { |
8587
|
1897
|
|
|
|
|
4737
|
$$self{$_}{$nextTag} = $$self{$_}{$tag}; |
8588
|
1897
|
|
|
|
|
4566
|
delete $$self{$_}{$tag}; |
8589
|
|
|
|
|
|
|
} |
8590
|
|
|
|
|
|
|
} |
8591
|
2745
|
|
|
|
|
4854
|
delete $$self{BOTH}{$tag}; |
8592
|
|
|
|
|
|
|
# update tag key for list if necessary |
8593
|
2745
|
100
|
|
|
|
6969
|
$$self{LIST_TAGS}{$oldInfo} = $nextTag if $$self{LIST_TAGS}{$oldInfo}; |
8594
|
|
|
|
|
|
|
# update this key if used in a Composite tag |
8595
|
2745
|
100
|
|
|
|
7737
|
if ($$self{COMP_KEYS}{$tag}) { |
8596
|
89
|
|
|
|
|
156
|
$$_[0]{$$_[1]} = $nextTag foreach @{$$self{COMP_KEYS}{$tag}}; |
|
89
|
|
|
|
|
424
|
|
8597
|
89
|
|
|
|
|
250
|
$$self{COMP_KEYS}{$nextTag} = $$self{COMP_KEYS}{$tag}; |
8598
|
89
|
|
|
|
|
210
|
delete $$self{COMP_KEYS}{$tag}; |
8599
|
|
|
|
|
|
|
} |
8600
|
|
|
|
|
|
|
} else { |
8601
|
3346
|
|
|
|
|
5619
|
$tag = $nextTag; # don't override the existing tag |
8602
|
|
|
|
|
|
|
} |
8603
|
6091
|
|
|
|
|
16125
|
$$self{PRIORITY}{$tag} = $priority; |
8604
|
6091
|
100
|
|
|
|
14035
|
$$self{TAG_EXTRA}{$tag}{NoListDel} = 1 if $noListDel; |
8605
|
|
|
|
|
|
|
} elsif ($priority) { |
8606
|
|
|
|
|
|
|
# set tag priority (only if exists and is non-zero) |
8607
|
216
|
|
|
|
|
997
|
$$self{PRIORITY}{$tag} = $priority; |
8608
|
|
|
|
|
|
|
} |
8609
|
|
|
|
|
|
|
|
8610
|
|
|
|
|
|
|
# save the raw value, file order, tagInfo ref, group1 name, |
8611
|
|
|
|
|
|
|
# and tag key for lists if necessary |
8612
|
56592
|
|
|
|
|
165693
|
$$valueHash{$tag} = $value; |
8613
|
56592
|
|
|
|
|
123049
|
$$self{FILE_ORDER}{$tag} = ++$$self{NUM_FOUND}; |
8614
|
56592
|
|
|
|
|
112146
|
$$self{TAG_INFO}{$tag} = $tagInfo; |
8615
|
|
|
|
|
|
|
# set dynamic groups 0, 1 and 3 if necessary |
8616
|
56592
|
100
|
|
|
|
108043
|
$$self{TAG_EXTRA}{$tag}{G0} = $grps[0] if $grps[0]; |
8617
|
56592
|
100
|
|
|
|
111090
|
$$self{TAG_EXTRA}{$tag}{G1} = $grps[1] if $grps[1]; |
8618
|
56592
|
100
|
|
|
|
114053
|
if ($$self{DOC_NUM}) { |
8619
|
1753
|
|
|
|
|
4575
|
$$self{TAG_EXTRA}{$tag}{G3} = $$self{DOC_NUM}; |
8620
|
1753
|
50
|
|
|
|
6877
|
if ($$self{DOC_NUM} =~ /^(\d+)/) { |
8621
|
|
|
|
|
|
|
# keep track of maximum 1st-level sub-document number |
8622
|
1753
|
100
|
|
|
|
5869
|
$$self{DOC_COUNT} = $1 unless $$self{DOC_COUNT} >= $1; |
8623
|
|
|
|
|
|
|
} |
8624
|
|
|
|
|
|
|
} |
8625
|
|
|
|
|
|
|
# save path if requested |
8626
|
56592
|
100
|
|
|
|
114588
|
$$self{TAG_EXTRA}{$tag}{G5} = $self->MetadataPath() if $$options{SavePath}; |
8627
|
|
|
|
|
|
|
|
8628
|
|
|
|
|
|
|
# remember this tagInfo if we will be accumulating values in a list |
8629
|
|
|
|
|
|
|
# (but don't override earlier list if this may be deleted by NoListDel flag) |
8630
|
56592
|
100
|
100
|
|
|
131571
|
if ($$tagInfo{List} and not $$self{NO_LIST} and not $noListDel) { |
|
|
|
100
|
|
|
|
|
8631
|
1111
|
|
|
|
|
4252
|
$$self{LIST_TAGS}{$tagInfo} = $tag; |
8632
|
|
|
|
|
|
|
} |
8633
|
|
|
|
|
|
|
|
8634
|
|
|
|
|
|
|
# validate tag if requested (but only for simple values -- could result |
8635
|
|
|
|
|
|
|
# in infinite recursion if called for a Composite tag (HASH ref value) |
8636
|
|
|
|
|
|
|
# because FoundTag is called in the middle of building Composite tags |
8637
|
56592
|
100
|
100
|
|
|
123327
|
if ($$options{Validate} and not ref $value) { |
8638
|
213
|
|
|
|
|
594
|
Image::ExifTool::Validate::ValidateRaw($self, $tag, $value); |
8639
|
|
|
|
|
|
|
} |
8640
|
|
|
|
|
|
|
|
8641
|
56592
|
|
|
|
|
156600
|
return $tag; |
8642
|
|
|
|
|
|
|
} |
8643
|
|
|
|
|
|
|
|
8644
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8645
|
|
|
|
|
|
|
# Make current directory the priority directory if not set already |
8646
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8647
|
|
|
|
|
|
|
sub SetPriorityDir($) |
8648
|
|
|
|
|
|
|
{ |
8649
|
22
|
|
|
22
|
0
|
81
|
my $self = shift; |
8650
|
22
|
50
|
|
|
|
535
|
$$self{PRIORITY_DIR} = $$self{DIR_NAME} unless $$self{PRIORITY_DIR}; |
8651
|
|
|
|
|
|
|
} |
8652
|
|
|
|
|
|
|
|
8653
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8654
|
|
|
|
|
|
|
# Set family 0 or 1 group name specific to this tag instance |
8655
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) tag key, 2) group name, 3) family (default 1) |
8656
|
|
|
|
|
|
|
sub SetGroup($$$;$) |
8657
|
|
|
|
|
|
|
{ |
8658
|
13715
|
|
|
13715
|
0
|
30152
|
my ($self, $tagKey, $extra, $fam) = @_; |
8659
|
13715
|
50
|
|
|
|
61238
|
$$self{TAG_EXTRA}{$tagKey}{defined $fam ? "G$fam" : 'G1'} = $extra; |
8660
|
|
|
|
|
|
|
} |
8661
|
|
|
|
|
|
|
|
8662
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8663
|
|
|
|
|
|
|
# Delete specified tag |
8664
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tag key |
8665
|
|
|
|
|
|
|
sub DeleteTag($$) |
8666
|
|
|
|
|
|
|
{ |
8667
|
224
|
|
|
224
|
0
|
1134
|
my ($self, $tag) = @_; |
8668
|
224
|
|
|
|
|
445
|
delete $$self{VALUE}{$tag}; |
8669
|
224
|
|
|
|
|
373
|
delete $$self{FILE_ORDER}{$tag}; |
8670
|
224
|
|
|
|
|
397
|
delete $$self{TAG_INFO}{$tag}; |
8671
|
224
|
|
|
|
|
439
|
delete $$self{TAG_EXTRA}{$tag}; |
8672
|
224
|
|
|
|
|
381
|
delete $$self{PRIORITY}{$tag}; |
8673
|
224
|
|
|
|
|
386
|
delete $$self{RATIONAL}{$tag}; |
8674
|
224
|
|
|
|
|
621
|
delete $$self{BOTH}{$tag}; |
8675
|
|
|
|
|
|
|
} |
8676
|
|
|
|
|
|
|
|
8677
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8678
|
|
|
|
|
|
|
# Escape all elements of a value |
8679
|
|
|
|
|
|
|
# Inputs: 0) value, 1) escape proc |
8680
|
|
|
|
|
|
|
sub DoEscape($$) |
8681
|
|
|
|
|
|
|
{ |
8682
|
173
|
|
|
173
|
0
|
256
|
my ($val, $key); |
8683
|
173
|
100
|
|
|
|
348
|
if (not ref $_[0]) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
8684
|
167
|
|
|
|
|
251
|
$_[0] = &{$_[1]}($_[0]); |
|
167
|
|
|
|
|
389
|
|
8685
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'ARRAY') { |
8686
|
4
|
|
|
|
|
11
|
foreach $val (@{$_[0]}) { |
|
4
|
|
|
|
|
18
|
|
8687
|
10
|
|
|
|
|
25
|
DoEscape($val, $_[1]); |
8688
|
|
|
|
|
|
|
} |
8689
|
|
|
|
|
|
|
} elsif (ref $_[0] eq 'HASH') { |
8690
|
0
|
|
|
|
|
0
|
foreach $key (keys %{$_[0]}) { |
|
0
|
|
|
|
|
0
|
|
8691
|
0
|
|
|
|
|
0
|
DoEscape($_[0]{$key}, $_[1]); |
8692
|
|
|
|
|
|
|
} |
8693
|
|
|
|
|
|
|
} |
8694
|
|
|
|
|
|
|
} |
8695
|
|
|
|
|
|
|
|
8696
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8697
|
|
|
|
|
|
|
# Set the FileType and MIMEType tags |
8698
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference |
8699
|
|
|
|
|
|
|
# 1) Optional file type (uses FILE_TYPE if not specified) |
8700
|
|
|
|
|
|
|
# 2) Optional MIME type (uses our lookup if not specified) |
8701
|
|
|
|
|
|
|
# 3) Optional recommended extension (converted to lower case; uses FileType if undef) |
8702
|
|
|
|
|
|
|
# Notes: Will NOT set file type twice (subsequent calls ignored) |
8703
|
|
|
|
|
|
|
sub SetFileType($;$$$) |
8704
|
|
|
|
|
|
|
{ |
8705
|
651
|
|
|
651
|
0
|
2620
|
my ($self, $fileType, $mimeType, $normExt) = @_; |
8706
|
651
|
100
|
66
|
|
|
3642
|
unless ($$self{FileType} and not $$self{DOC_NUM}) { |
8707
|
603
|
|
|
|
|
1713
|
my $baseType = $$self{FILE_TYPE}; |
8708
|
603
|
|
|
|
|
1587
|
my $ext = $$self{FILE_EXT}; |
8709
|
603
|
100
|
|
|
|
2908
|
$fileType or $fileType = $baseType; |
8710
|
|
|
|
|
|
|
# handle sub-types which are identified by extension |
8711
|
603
|
100
|
100
|
|
|
4867
|
if (defined $ext and $ext ne $fileType and not $$self{DOC_NUM}) { |
|
|
|
66
|
|
|
|
|
8712
|
270
|
|
|
|
|
1450
|
my ($f,$e) = @fileTypeLookup{$fileType,$ext}; |
8713
|
270
|
100
|
100
|
|
|
2328
|
if (ref $f eq 'ARRAY' and ref $e eq 'ARRAY' and $$f[0] eq $$e[0]) { |
|
|
|
100
|
|
|
|
|
8714
|
|
|
|
|
|
|
# make sure $fileType was a root type and not another sub-type |
8715
|
10
|
100
|
66
|
|
|
73
|
$fileType = $ext if $$f[0] eq $fileType or not $fileTypeLookup{$$f[0]}; |
8716
|
|
|
|
|
|
|
} |
8717
|
|
|
|
|
|
|
} |
8718
|
603
|
100
|
|
|
|
3134
|
$mimeType or $mimeType = $mimeType{$fileType}; |
8719
|
|
|
|
|
|
|
# use base file type if necessary (except if 'TIFF', which is a special case) |
8720
|
603
|
100
|
66
|
|
|
2626
|
$mimeType = $mimeType{$baseType} unless $mimeType or $baseType eq 'TIFF'; |
8721
|
603
|
100
|
|
|
|
2930
|
unless (defined $normExt) { |
8722
|
593
|
|
|
|
|
1801
|
$normExt = $fileTypeExt{$fileType}; |
8723
|
593
|
100
|
|
|
|
2739
|
$normExt = $fileType unless defined $normExt; |
8724
|
|
|
|
|
|
|
} |
8725
|
|
|
|
|
|
|
# ($$self{FileType} is the file type of the main document) |
8726
|
603
|
50
|
|
|
|
2561
|
$$self{FileType} = $fileType unless $$self{DOC_NUM}; |
8727
|
603
|
|
|
|
|
2530
|
$self->FoundTag('FileType', $fileType); |
8728
|
603
|
|
|
|
|
4770
|
$self->FoundTag('FileTypeExtension', uc $normExt); |
8729
|
603
|
|
100
|
|
|
4222
|
$self->FoundTag('MIMEType', $mimeType || 'application/unknown'); |
8730
|
|
|
|
|
|
|
} |
8731
|
|
|
|
|
|
|
} |
8732
|
|
|
|
|
|
|
|
8733
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8734
|
|
|
|
|
|
|
# Override the FileType and MIMEType tags |
8735
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) file type, 2) MIME type, 3) normal extension (lower case) |
8736
|
|
|
|
|
|
|
# Notes: does nothing if FileType was not previously defined (ie. when writing) |
8737
|
|
|
|
|
|
|
sub OverrideFileType($$;$$) |
8738
|
|
|
|
|
|
|
{ |
8739
|
18
|
|
|
18
|
0
|
83
|
my ($self, $fileType, $mimeType, $normExt) = @_; |
8740
|
18
|
100
|
66
|
|
|
155
|
if (defined $$self{VALUE}{FileType} and $fileType ne $$self{VALUE}{FileType}) { |
8741
|
12
|
|
|
|
|
41
|
$$self{FileType} = $fileType; |
8742
|
12
|
|
|
|
|
31
|
$$self{VALUE}{FileType} = $fileType; |
8743
|
12
|
100
|
|
|
|
45
|
unless (defined $normExt) { |
8744
|
5
|
|
|
|
|
17
|
$normExt = $fileTypeExt{$fileType}; |
8745
|
5
|
50
|
|
|
|
21
|
$normExt = $fileType unless defined $normExt; |
8746
|
|
|
|
|
|
|
} |
8747
|
12
|
|
|
|
|
37
|
$$self{VALUE}{FileTypeExtension} = uc $normExt; |
8748
|
12
|
50
|
|
|
|
101
|
$mimeType or $mimeType = $mimeType{$fileType}; |
8749
|
12
|
100
|
|
|
|
48
|
$$self{VALUE}{MIMEType} = $mimeType if $mimeType; |
8750
|
12
|
50
|
|
|
|
126
|
if ($$self{OPTIONS}{Verbose}) { |
8751
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}FileType [override] = $fileType\n"); |
8752
|
0
|
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}FileTypeExtension [override] = $$self{VALUE}{FileTypeExtension}\n"); |
8753
|
0
|
0
|
|
|
|
0
|
$self->VPrint(0,"$$self{INDENT}MIMEType [override] = $mimeType\n") if $mimeType; |
8754
|
|
|
|
|
|
|
} |
8755
|
|
|
|
|
|
|
} |
8756
|
|
|
|
|
|
|
} |
8757
|
|
|
|
|
|
|
|
8758
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8759
|
|
|
|
|
|
|
# Modify the value of the MIMEType tag |
8760
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) file or MIME type |
8761
|
|
|
|
|
|
|
# Notes: combines existing type with new type: ie) a/b + c/d => c/b-d |
8762
|
|
|
|
|
|
|
sub ModifyMimeType($;$) |
8763
|
|
|
|
|
|
|
{ |
8764
|
8
|
|
|
8
|
0
|
61
|
my ($self, $mime) = @_; |
8765
|
8
|
50
|
33
|
|
|
60
|
$mime =~ m{/} or $mime = $mimeType{$mime} or return; |
8766
|
8
|
|
|
|
|
30
|
my $old = $$self{VALUE}{MIMEType}; |
8767
|
8
|
50
|
|
|
|
33
|
if (defined $old) { |
8768
|
8
|
|
|
|
|
42
|
my ($a, $b) = split '/', $old; |
8769
|
8
|
|
|
|
|
38
|
my ($c, $d) = split '/', $mime; |
8770
|
8
|
|
|
|
|
25
|
$d =~ s/^x-//; |
8771
|
8
|
|
|
|
|
34
|
$$self{VALUE}{MIMEType} = "$c/$b-$d"; |
8772
|
8
|
|
|
|
|
56
|
$self->VPrint(0, " Modified MIMEType = $c/$b-$d\n"); |
8773
|
|
|
|
|
|
|
} else { |
8774
|
0
|
|
|
|
|
0
|
$self->FoundTag('MIMEType', $mime); |
8775
|
|
|
|
|
|
|
} |
8776
|
|
|
|
|
|
|
} |
8777
|
|
|
|
|
|
|
|
8778
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8779
|
|
|
|
|
|
|
# Print verbose output |
8780
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) verbose level (prints if level > this), 2-N) print args |
8781
|
|
|
|
|
|
|
sub VPrint($$@) |
8782
|
|
|
|
|
|
|
{ |
8783
|
9311
|
|
|
9311
|
0
|
16601
|
my $self = shift; |
8784
|
9311
|
|
|
|
|
13512
|
my $level = shift; |
8785
|
9311
|
100
|
66
|
|
|
35805
|
if ($$self{OPTIONS}{Verbose} and $$self{OPTIONS}{Verbose} > $level) { |
8786
|
4
|
|
|
|
|
13
|
my $out = $$self{OPTIONS}{TextOut}; |
8787
|
4
|
|
|
|
|
19
|
print $out @_; |
8788
|
4
|
50
|
|
|
|
31
|
print $out "\n" unless $_[-1] =~ /\n$/; |
8789
|
|
|
|
|
|
|
} |
8790
|
|
|
|
|
|
|
} |
8791
|
|
|
|
|
|
|
|
8792
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8793
|
|
|
|
|
|
|
# Print verbose directory information |
8794
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) directory name or dirInfo ref |
8795
|
|
|
|
|
|
|
# 2) number of entries in directory (or 0 if unknown) |
8796
|
|
|
|
|
|
|
# 3) optional size of directory in bytes |
8797
|
|
|
|
|
|
|
sub VerboseDir($$;$$) |
8798
|
|
|
|
|
|
|
{ |
8799
|
450
|
|
|
450
|
0
|
1217
|
my ($self, $name, $entries, $size) = @_; |
8800
|
450
|
100
|
|
|
|
1635
|
return unless $$self{OPTIONS}{Verbose}; |
8801
|
44
|
50
|
|
|
|
113
|
if (ref $name eq 'HASH') { |
8802
|
0
|
0
|
|
|
|
0
|
$size = $$name{DirLen} unless $size; |
8803
|
0
|
|
0
|
|
|
0
|
$name = $$name{Name} || $$name{DirName}; |
8804
|
|
|
|
|
|
|
} |
8805
|
44
|
|
|
|
|
124
|
my $indent = substr($$self{INDENT}, 0, -2); |
8806
|
44
|
|
|
|
|
82
|
my $out = $$self{OPTIONS}{TextOut}; |
8807
|
44
|
100
|
66
|
|
|
240
|
my $str = ($entries or defined $entries and not $size) ? " with $entries entries" : ''; |
8808
|
44
|
100
|
|
|
|
130
|
$str .= ", $size bytes" if $size; |
8809
|
44
|
|
|
|
|
166
|
print $out "$indent+ [$name directory$str]\n"; |
8810
|
|
|
|
|
|
|
} |
8811
|
|
|
|
|
|
|
|
8812
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8813
|
|
|
|
|
|
|
# Verbose dump |
8814
|
|
|
|
|
|
|
# Inputs: 0) ExifTool ref, 1) data ref, 2-N) HexDump options |
8815
|
|
|
|
|
|
|
sub VerboseDump($$;%) |
8816
|
|
|
|
|
|
|
{ |
8817
|
128
|
|
|
128
|
0
|
248
|
my $self = shift; |
8818
|
128
|
|
|
|
|
211
|
my $dataPt = shift; |
8819
|
128
|
|
|
|
|
285
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8820
|
128
|
50
|
33
|
|
|
460
|
if ($verbose and $verbose > 2) { |
8821
|
|
|
|
|
|
|
my %parms = ( |
8822
|
|
|
|
|
|
|
Prefix => $$self{INDENT}, |
8823
|
|
|
|
|
|
|
Out => $$self{OPTIONS}{TextOut}, |
8824
|
0
|
0
|
|
|
|
0
|
MaxLen => $verbose < 4 ? 96 : $verbose < 5 ? 2048 : undef, |
|
|
0
|
|
|
|
|
|
8825
|
|
|
|
|
|
|
); |
8826
|
0
|
|
|
|
|
0
|
HexDump($dataPt, undef, %parms, @_); |
8827
|
|
|
|
|
|
|
} |
8828
|
|
|
|
|
|
|
} |
8829
|
|
|
|
|
|
|
|
8830
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8831
|
|
|
|
|
|
|
# Print data in hex |
8832
|
|
|
|
|
|
|
# Inputs: 0) data |
8833
|
|
|
|
|
|
|
# Returns: hex string |
8834
|
|
|
|
|
|
|
# (this is a convenience function for use in debugging PrintConv statements) |
8835
|
|
|
|
|
|
|
sub PrintHex($) |
8836
|
|
|
|
|
|
|
{ |
8837
|
0
|
|
|
0
|
0
|
0
|
my $val = shift; |
8838
|
0
|
|
|
|
|
0
|
return join(' ', unpack('H2' x length($val), $val)); |
8839
|
|
|
|
|
|
|
} |
8840
|
|
|
|
|
|
|
|
8841
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8842
|
|
|
|
|
|
|
# Extract binary data from file |
8843
|
|
|
|
|
|
|
# 0) ExifTool object reference, 1) offset, 2) length, 3) tag name if conditional |
8844
|
|
|
|
|
|
|
# Returns: binary data, or undef on error |
8845
|
|
|
|
|
|
|
# Notes: Returns "Binary data #### bytes" instead of data unless tag is |
8846
|
|
|
|
|
|
|
# specifically requested or the Binary option is set |
8847
|
|
|
|
|
|
|
sub ExtractBinary($$$;$) |
8848
|
|
|
|
|
|
|
{ |
8849
|
47
|
|
|
47
|
0
|
191
|
my ($self, $offset, $length, $tag) = @_; |
8850
|
47
|
|
|
|
|
107
|
my ($isPreview, $buff); |
8851
|
|
|
|
|
|
|
|
8852
|
47
|
100
|
|
|
|
1089
|
if ($tag) { |
8853
|
43
|
100
|
|
|
|
171
|
if ($tag eq 'PreviewImage') { |
8854
|
|
|
|
|
|
|
# save PreviewImage start/length in case we want to dump trailer |
8855
|
29
|
|
|
|
|
123
|
$$self{PreviewImageStart} = $offset; |
8856
|
29
|
|
|
|
|
116
|
$$self{PreviewImageLength} = $length; |
8857
|
29
|
|
|
|
|
71
|
$isPreview = 1; |
8858
|
|
|
|
|
|
|
} |
8859
|
43
|
|
|
|
|
125
|
my $lcTag = lc $tag; |
8860
|
43
|
50
|
66
|
|
|
541
|
if ((not $$self{OPTIONS}{Binary} or $$self{EXCL_TAG_LOOKUP}{$lcTag}) and |
|
|
|
66
|
|
|
|
|
|
|
|
66
|
|
|
|
|
8861
|
|
|
|
|
|
|
not $$self{OPTIONS}{Verbose} and not $$self{REQ_TAG_LOOKUP}{$lcTag}) |
8862
|
|
|
|
|
|
|
{ |
8863
|
34
|
|
|
|
|
217
|
return "Binary data $length bytes"; |
8864
|
|
|
|
|
|
|
} |
8865
|
|
|
|
|
|
|
} |
8866
|
13
|
100
|
66
|
|
|
74
|
unless ($$self{RAF}->Seek($offset,0) |
8867
|
|
|
|
|
|
|
and $$self{RAF}->Read($buff, $length) == $length) |
8868
|
|
|
|
|
|
|
{ |
8869
|
5
|
50
|
|
|
|
32
|
$tag or $tag = 'binary data'; |
8870
|
5
|
50
|
33
|
|
|
40
|
if ($isPreview and not $$self{BuildingComposite}) { |
8871
|
0
|
|
|
|
|
0
|
$$self{PreviewError} = 1; |
8872
|
|
|
|
|
|
|
} else { |
8873
|
5
|
|
|
|
|
44
|
$self->Warn("Error reading $tag from file", $isPreview); |
8874
|
|
|
|
|
|
|
} |
8875
|
5
|
|
|
|
|
40
|
return undef; |
8876
|
|
|
|
|
|
|
} |
8877
|
8
|
|
|
|
|
38
|
return $buff; |
8878
|
|
|
|
|
|
|
} |
8879
|
|
|
|
|
|
|
|
8880
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8881
|
|
|
|
|
|
|
# Process binary data |
8882
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) directory information ref, 2) tag table ref |
8883
|
|
|
|
|
|
|
# Returns: 1 on success |
8884
|
|
|
|
|
|
|
# Notes: dirInfo may contain VarFormatData (reference to empty list) to return |
8885
|
|
|
|
|
|
|
# details about any variable-length-format tags in the table (used when writing) |
8886
|
|
|
|
|
|
|
sub ProcessBinaryData($$$) |
8887
|
|
|
|
|
|
|
{ |
8888
|
2113
|
|
|
2113
|
0
|
4774
|
my ($self, $dirInfo, $tagTablePtr) = @_; |
8889
|
2113
|
|
|
|
|
4123
|
my $dataPt = $$dirInfo{DataPt}; |
8890
|
2113
|
|
|
|
|
4025
|
my $dataLen = length $$dataPt; |
8891
|
2113
|
|
100
|
|
|
6659
|
my $dirStart = $$dirInfo{DirStart} || 0; |
8892
|
2113
|
|
|
|
|
3658
|
my $maxLen = $dataLen - $dirStart; |
8893
|
2113
|
|
|
|
|
3638
|
my $size = $$dirInfo{DirLen}; |
8894
|
2113
|
|
100
|
|
|
6088
|
my $base = $$dirInfo{Base} || 0; |
8895
|
2113
|
|
|
|
|
4437
|
my $verbose = $$self{OPTIONS}{Verbose}; |
8896
|
2113
|
|
|
|
|
4055
|
my $unknown = $$self{OPTIONS}{Unknown}; |
8897
|
2113
|
|
100
|
|
|
6312
|
my $dataPos = $$dirInfo{DataPos} || 0; |
8898
|
|
|
|
|
|
|
|
8899
|
2113
|
100
|
66
|
|
|
8186
|
$size = $maxLen if not defined $size or $size > $maxLen; |
8900
|
|
|
|
|
|
|
# get default format ('int8u' unless specified) |
8901
|
2113
|
|
100
|
|
|
8111
|
my $defaultFormat = $$tagTablePtr{FORMAT} || 'int8u'; |
8902
|
2113
|
|
|
|
|
4261
|
my $increment = $formatSize{$defaultFormat}; |
8903
|
2113
|
50
|
|
|
|
4879
|
unless ($increment) { |
8904
|
0
|
|
|
|
|
0
|
warn "Unknown format $defaultFormat\n"; |
8905
|
0
|
|
|
|
|
0
|
$defaultFormat = 'int8u'; |
8906
|
0
|
|
|
|
|
0
|
$increment = $formatSize{$defaultFormat}; |
8907
|
|
|
|
|
|
|
} |
8908
|
|
|
|
|
|
|
# prepare list of tag numbers to extract |
8909
|
2113
|
|
|
|
|
3749
|
my (@tags, $topIndex); |
8910
|
2113
|
50
|
33
|
|
|
8704
|
if ($unknown > 1 and defined $$tagTablePtr{FIRST_ENTRY}) { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8911
|
|
|
|
|
|
|
# don't create a stupid number of tags if data is huge |
8912
|
0
|
0
|
|
|
|
0
|
my $sizeLimit = $size < 65536 ? $size : 65536; |
8913
|
|
|
|
|
|
|
# scan through entire binary table |
8914
|
0
|
|
|
|
|
0
|
$topIndex = int($sizeLimit/$increment); |
8915
|
0
|
|
|
|
|
0
|
@tags = ($$tagTablePtr{FIRST_ENTRY}..($topIndex - 1)); |
8916
|
|
|
|
|
|
|
# add in floating point tag ID's if they exist |
8917
|
0
|
|
|
|
|
0
|
my @ftags = grep /\./, TagTableKeys($tagTablePtr); |
8918
|
0
|
0
|
|
|
|
0
|
@tags = sort { $a <=> $b } @tags, @ftags if @ftags; |
|
0
|
|
|
|
|
0
|
|
8919
|
|
|
|
|
|
|
} elsif ($$dirInfo{DataMember}) { |
8920
|
195
|
|
|
|
|
329
|
@tags = @{$$dirInfo{DataMember}}; |
|
195
|
|
|
|
|
712
|
|
8921
|
195
|
|
|
|
|
429
|
$verbose = 0; # no verbose output of extracted values when writing |
8922
|
|
|
|
|
|
|
} elsif ($$dirInfo{MixedTags}) { |
8923
|
|
|
|
|
|
|
# process sorted integer-ID tags only |
8924
|
38
|
|
|
|
|
139
|
@tags = sort { $a <=> $b } grep /^\d+$/, TagTableKeys($tagTablePtr); |
|
444
|
|
|
|
|
823
|
|
8925
|
|
|
|
|
|
|
} else { |
8926
|
|
|
|
|
|
|
# extract known tags in numerical order |
8927
|
1880
|
50
|
|
|
|
4833
|
@tags = sort { ($a < 0 ? $a + 1e9 : $a) <=> ($b < 0 ? $b + 1e9 : $b) } TagTableKeys($tagTablePtr); |
|
55728
|
50
|
|
|
|
109628
|
|
8928
|
|
|
|
|
|
|
} |
8929
|
2113
|
100
|
|
|
|
7350
|
$self->VerboseDir('BinaryData', undef, $size) if $verbose; |
8930
|
|
|
|
|
|
|
# avoid creating unknown tags for tags that fail condition if Unknown is 1 |
8931
|
2113
|
50
|
|
|
|
8060
|
$$self{NO_UNKNOWN} = 1 if $unknown < 2; |
8932
|
2113
|
|
|
|
|
3600
|
my ($index, %val); |
8933
|
2113
|
|
|
|
|
3403
|
my $nextIndex = 0; |
8934
|
2113
|
|
|
|
|
3283
|
my $varSize = 0; |
8935
|
2113
|
|
|
|
|
3912
|
foreach $index (@tags) { |
8936
|
17684
|
|
|
|
|
30087
|
my ($tagInfo, $val, $saveNextIndex, $len, $mask, $wasVar, $rational); |
8937
|
17684
|
50
|
0
|
|
|
44577
|
if ($$tagTablePtr{$index}) { |
|
|
0
|
|
|
|
|
|
8938
|
17684
|
|
|
|
|
39616
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index); |
8939
|
17684
|
100
|
|
|
|
37248
|
unless ($tagInfo) { |
8940
|
730
|
100
|
|
|
|
2167
|
next unless defined $tagInfo; |
8941
|
|
|
|
|
|
|
# $entry = offset of value relative to directory start (or end if negative) |
8942
|
48
|
|
|
|
|
263
|
my $entry = int($index) * $increment + $varSize; |
8943
|
48
|
50
|
|
|
|
237
|
if ($entry < 0) { |
8944
|
0
|
|
|
|
|
0
|
$entry += $size; |
8945
|
0
|
0
|
|
|
|
0
|
next if $entry < 0; |
8946
|
|
|
|
|
|
|
} |
8947
|
48
|
100
|
|
|
|
208
|
next if $entry >= $size; |
8948
|
4
|
|
|
|
|
13
|
my $more = $size - $entry; |
8949
|
4
|
50
|
|
|
|
17
|
$more = 128 if $more > 128; |
8950
|
4
|
|
|
|
|
17
|
my $v = substr($$dataPt, $entry+$dirStart, $more); |
8951
|
4
|
|
|
|
|
17
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index, \$v); |
8952
|
4
|
50
|
|
|
|
33
|
next unless $tagInfo; |
8953
|
|
|
|
|
|
|
} |
8954
|
|
|
|
|
|
|
next if $$tagInfo{Unknown} and |
8955
|
16958
|
100
|
66
|
|
|
35544
|
($$tagInfo{Unknown} > $unknown or $index < $nextIndex); |
|
|
|
66
|
|
|
|
|
8956
|
|
|
|
|
|
|
} elsif ($topIndex and $$tagTablePtr{$index - $topIndex}) { |
8957
|
0
|
0
|
|
|
|
0
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index - $topIndex) or next; |
8958
|
|
|
|
|
|
|
} else { |
8959
|
|
|
|
|
|
|
# don't generate unknown tags in binary tables unless Unknown > 1 |
8960
|
0
|
0
|
|
|
|
0
|
next unless $unknown > 1; |
8961
|
0
|
0
|
|
|
|
0
|
next if $index < $nextIndex; # skip if data already used |
8962
|
0
|
0
|
|
|
|
0
|
$tagInfo = $self->GetTagInfo($tagTablePtr, $index) or next; |
8963
|
0
|
|
|
|
|
0
|
$$tagInfo{Unknown} = 2; # set unknown to 2 for binary unknowns |
8964
|
|
|
|
|
|
|
} |
8965
|
|
|
|
|
|
|
# get relative offset of this entry |
8966
|
16957
|
|
|
|
|
31370
|
my $entry = int($index) * $increment + $varSize; |
8967
|
|
|
|
|
|
|
# allow negative indices to represent bytes from end |
8968
|
16957
|
50
|
|
|
|
34037
|
if ($entry < 0) { |
8969
|
0
|
|
|
|
|
0
|
$entry += $size; |
8970
|
0
|
0
|
|
|
|
0
|
next if $entry < 0; |
8971
|
|
|
|
|
|
|
} |
8972
|
16957
|
|
|
|
|
25106
|
my $more = $size - $entry; |
8973
|
16957
|
100
|
|
|
|
31758
|
last if $more <= 0; # all done if we have reached the end of data |
8974
|
16684
|
|
|
|
|
23891
|
my $count = 1; |
8975
|
16684
|
|
|
|
|
34121
|
my $format = $$tagInfo{Format}; |
8976
|
16684
|
100
|
|
|
|
43403
|
if (not $format) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
8977
|
9652
|
|
|
|
|
15568
|
$format = $defaultFormat; |
8978
|
|
|
|
|
|
|
} elsif ($format eq 'string') { |
8979
|
|
|
|
|
|
|
# string with no specified count runs to end of block |
8980
|
104
|
|
|
|
|
237
|
$count = $more; |
8981
|
|
|
|
|
|
|
} elsif ($format eq 'pstring') { |
8982
|
0
|
|
|
|
|
0
|
$format = 'string'; |
8983
|
0
|
|
|
|
|
0
|
$count = Get8u($dataPt, ($entry++)+$dirStart); |
8984
|
0
|
|
|
|
|
0
|
--$more; |
8985
|
|
|
|
|
|
|
} elsif (not $formatSize{$format}) { |
8986
|
3182
|
100
|
|
|
|
17237
|
if ($format =~ /(.*)\[(.*)\]/) { |
|
|
50
|
|
|
|
|
|
8987
|
|
|
|
|
|
|
# handle format count field |
8988
|
2997
|
|
|
|
|
7957
|
$format = $1; |
8989
|
2997
|
|
|
|
|
5780
|
$count = $2; |
8990
|
|
|
|
|
|
|
# evaluate count to allow count to be based on previous values |
8991
|
|
|
|
|
|
|
#### eval Format size (%val, $size, $self) |
8992
|
2997
|
|
|
|
|
133339
|
$count = eval $count; |
8993
|
2997
|
50
|
|
|
|
12165
|
$@ and warn("Format $$tagInfo{Name}: $@"), next; |
8994
|
2997
|
50
|
|
|
|
7206
|
next if $count < 0; |
8995
|
|
|
|
|
|
|
# allow a variable-length value of any format |
8996
|
|
|
|
|
|
|
# (note: the next incremental index points to data immediately after |
8997
|
|
|
|
|
|
|
# this value, regardless of the size of this value, even if it is zero) |
8998
|
2997
|
50
|
|
|
|
7977
|
if ($format =~ s/^var_//) { |
8999
|
0
|
|
0
|
|
|
0
|
$varSize += $count * ($formatSize{$format} || 1) - $increment; |
9000
|
0
|
|
|
|
|
0
|
$wasVar = 1; |
9001
|
|
|
|
|
|
|
# save variable size data if required for writing |
9002
|
0
|
0
|
|
|
|
0
|
if ($$dirInfo{VarFormatData}) { |
9003
|
0
|
|
|
|
|
0
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
0
|
|
|
|
|
0
|
|
9004
|
|
|
|
|
|
|
} |
9005
|
|
|
|
|
|
|
# don't extract value if large and we wanted it just to get |
9006
|
|
|
|
|
|
|
# the variable-format information when writing |
9007
|
0
|
0
|
0
|
|
|
0
|
next if $$tagInfo{LargeTag} and $$dirInfo{VarFormatData}; |
9008
|
|
|
|
|
|
|
} |
9009
|
|
|
|
|
|
|
} elsif ($format =~ /^var_/) { |
9010
|
|
|
|
|
|
|
# handle variable-length string formats |
9011
|
185
|
|
|
|
|
497
|
$format = substr($format, 4); |
9012
|
185
|
|
|
|
|
715
|
pos($$dataPt) = $entry + $dirStart; |
9013
|
185
|
|
|
|
|
479
|
undef $count; |
9014
|
185
|
50
|
100
|
|
|
1292
|
if ($format eq 'ustring') { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
9015
|
0
|
0
|
|
|
|
0
|
$count = pos($$dataPt) - ($entry+$dirStart) if $$dataPt =~ /\G(..)*?\0\0/sg; |
9016
|
0
|
|
|
|
|
0
|
$varSize -= 2; # ($count includes base size of 2 bytes) |
9017
|
|
|
|
|
|
|
} elsif ($format eq 'pstring') { |
9018
|
0
|
|
|
|
|
0
|
$count = Get8u($dataPt, ($entry++)+$dirStart); |
9019
|
0
|
|
|
|
|
0
|
--$more; |
9020
|
|
|
|
|
|
|
} elsif ($format eq 'pstr32' or $format eq 'ustr32') { |
9021
|
170
|
50
|
|
|
|
434
|
last if $more < 4; |
9022
|
170
|
|
|
|
|
449
|
$count = Get32u($dataPt, $entry + $dirStart); |
9023
|
170
|
100
|
|
|
|
646
|
$count *= 2 if $format eq 'ustr32'; |
9024
|
170
|
|
|
|
|
304
|
$entry += 4; |
9025
|
170
|
|
|
|
|
288
|
$more -= 4; |
9026
|
170
|
|
|
|
|
482
|
$nextIndex += 4 / $increment; # (increment next index for int32u) |
9027
|
|
|
|
|
|
|
} elsif ($format eq 'int16u') { |
9028
|
|
|
|
|
|
|
# int16u size of binary data to follow |
9029
|
10
|
50
|
|
|
|
39
|
last if $more < 2; |
9030
|
10
|
|
|
|
|
60
|
$count = Get16u($dataPt, $entry + $dirStart) + 2; |
9031
|
10
|
|
|
|
|
22
|
$varSize -= 2; # ($count includes size word) |
9032
|
10
|
|
|
|
|
36
|
$format = 'undef'; |
9033
|
|
|
|
|
|
|
} elsif ($format eq 'ue7') { |
9034
|
3
|
|
|
|
|
16
|
require Image::ExifTool::BPG; |
9035
|
3
|
|
|
|
|
14
|
($val, $count) = Image::ExifTool::BPG::Get_ue7($dataPt, $entry + $dirStart); |
9036
|
3
|
50
|
|
|
|
7
|
last unless defined $val; |
9037
|
3
|
|
|
|
|
5
|
--$varSize; # ($count includes base size of 1 byte) |
9038
|
|
|
|
|
|
|
} elsif ($$dataPt =~ /\0/g) { |
9039
|
2
|
|
|
|
|
5
|
$count = pos($$dataPt) - ($entry+$dirStart); |
9040
|
2
|
|
|
|
|
3
|
--$varSize; # ($count includes base size of 1 byte) |
9041
|
|
|
|
|
|
|
} |
9042
|
185
|
50
|
33
|
|
|
877
|
$count = $more if not defined $count or $count > $more; |
9043
|
185
|
|
|
|
|
340
|
$varSize += $count; # shift subsequent indices |
9044
|
185
|
100
|
|
|
|
457
|
unless (defined $val) { |
9045
|
182
|
|
|
|
|
516
|
$val = substr($$dataPt, $entry+$dirStart, $count); |
9046
|
182
|
100
|
66
|
|
|
1081
|
$val = $self->Decode($val, 'UCS2') if $format eq 'ustring' or $format eq 'ustr32'; |
9047
|
182
|
100
|
|
|
|
684
|
$val =~ s/\0.*//s unless $format eq 'undef'; # truncate at null |
9048
|
|
|
|
|
|
|
} |
9049
|
185
|
|
|
|
|
334
|
$wasVar = 1; |
9050
|
|
|
|
|
|
|
# save variable size data if required for writing |
9051
|
185
|
100
|
|
|
|
523
|
if ($$dirInfo{VarFormatData}) { |
9052
|
5
|
|
|
|
|
10
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
5
|
|
|
|
|
21
|
|
9053
|
|
|
|
|
|
|
} |
9054
|
|
|
|
|
|
|
} |
9055
|
|
|
|
|
|
|
} |
9056
|
|
|
|
|
|
|
# hook to allow format, etc to be set dynamically |
9057
|
16684
|
100
|
|
|
|
38112
|
if (defined $$tagInfo{Hook}) { |
9058
|
540
|
|
|
|
|
903
|
my $oldVarSize = $varSize; |
9059
|
540
|
|
|
|
|
860
|
my $pos = $entry + $dirStart; |
9060
|
|
|
|
|
|
|
#### eval Hook ($format, $varSize, $size, $dataPt, $pos) |
9061
|
540
|
|
|
|
|
35337
|
eval $$tagInfo{Hook}; |
9062
|
|
|
|
|
|
|
# save variable size data if required for writing (in case changed by Hook) |
9063
|
540
|
100
|
66
|
|
|
3109
|
if ($$dirInfo{VarFormatData}) { |
|
|
50
|
|
|
|
|
|
9064
|
247
|
50
|
|
|
|
589
|
$#{$$dirInfo{VarFormatData}} -= 1 if $wasVar; # remove previous entry for this tag |
|
0
|
|
|
|
|
0
|
|
9065
|
247
|
|
|
|
|
377
|
push @{$$dirInfo{VarFormatData}}, [ $index, $varSize, $format ]; |
|
247
|
|
|
|
|
920
|
|
9066
|
|
|
|
|
|
|
} elsif ($varSize != $oldVarSize and $verbose > 2) { |
9067
|
0
|
|
|
|
|
0
|
my ($tmp, $sign) = ($varSize, '+'); |
9068
|
0
|
0
|
|
|
|
0
|
$tmp < 0 and $tmp = -$tmp, $sign = '-'; |
9069
|
0
|
|
|
|
|
0
|
$self->VPrint(2, sprintf("$$self{INDENT}\[offsets adjusted by ${sign}0x%.4x after 0x%.4x $$tagInfo{Name}]\n", $tmp, $index)); |
9070
|
|
|
|
|
|
|
} |
9071
|
|
|
|
|
|
|
} |
9072
|
16684
|
50
|
|
|
|
32577
|
if ($unknown > 1) { |
9073
|
|
|
|
|
|
|
# calculate next valid index for unknown tag |
9074
|
0
|
|
|
|
|
0
|
my $ni = int $index; |
9075
|
0
|
0
|
0
|
|
|
0
|
$ni += (($formatSize{$format} || 1) * $count) / $increment unless $wasVar; |
9076
|
0
|
|
|
|
|
0
|
$saveNextIndex = $nextIndex; |
9077
|
0
|
0
|
|
|
|
0
|
$nextIndex = $ni unless $nextIndex > $ni; |
9078
|
|
|
|
|
|
|
} |
9079
|
|
|
|
|
|
|
# allow large tags to be excluded from extraction |
9080
|
|
|
|
|
|
|
# (provides a work-around for some tight memory situations) |
9081
|
16684
|
50
|
33
|
|
|
37246
|
next if $$tagInfo{LargeTag} and $$self{EXCL_TAG_LOOKUP}{lc $$tagInfo{Name}}; |
9082
|
|
|
|
|
|
|
# read value now if necessary |
9083
|
16684
|
100
|
66
|
|
|
36797
|
unless (defined $val and not $$tagInfo{SubDirectory}) { |
9084
|
16499
|
|
|
|
|
41808
|
$val = ReadValue($dataPt, $entry+$dirStart, $format, $count, $more, \$rational); |
9085
|
16499
|
50
|
|
|
|
34264
|
next unless defined $val; |
9086
|
16499
|
|
|
|
|
30042
|
$mask = $$tagInfo{Mask}; |
9087
|
16499
|
100
|
|
|
|
33844
|
$val = ($val & $mask) >> $$tagInfo{BitShift} if $mask; |
9088
|
|
|
|
|
|
|
} |
9089
|
16684
|
100
|
66
|
|
|
35723
|
if ($verbose and not $$tagInfo{Hidden}) { |
9090
|
198
|
50
|
33
|
|
|
548
|
if (not $$tagInfo{SubDirectory} or $$tagInfo{Format}) { |
9091
|
198
|
|
50
|
|
|
441
|
$len = $count * ($formatSize{$format} || 1); |
9092
|
198
|
50
|
|
|
|
399
|
$len = $more if $len > $more; |
9093
|
|
|
|
|
|
|
} else { |
9094
|
0
|
|
|
|
|
0
|
$len = $more; |
9095
|
|
|
|
|
|
|
} |
9096
|
198
|
50
|
|
|
|
900
|
$self->VerboseInfo($index, $tagInfo, |
9097
|
|
|
|
|
|
|
Table => $tagTablePtr, |
9098
|
|
|
|
|
|
|
Value => $val, |
9099
|
|
|
|
|
|
|
DataPt => $dataPt, |
9100
|
|
|
|
|
|
|
Size => $len, |
9101
|
|
|
|
|
|
|
Start => $entry+$dirStart, |
9102
|
|
|
|
|
|
|
Addr => $entry+$dirStart+$base+$dataPos, |
9103
|
|
|
|
|
|
|
Format => $format, |
9104
|
|
|
|
|
|
|
Count => $count, |
9105
|
|
|
|
|
|
|
Extra => $mask ? sprintf(', mask 0x%.2x',$mask) : undef, |
9106
|
|
|
|
|
|
|
); |
9107
|
|
|
|
|
|
|
} |
9108
|
|
|
|
|
|
|
# parse nested BinaryData directories |
9109
|
16684
|
100
|
|
|
|
33579
|
if ($$tagInfo{SubDirectory}) { |
9110
|
14
|
|
|
|
|
84
|
my $subdir = $$tagInfo{SubDirectory}; |
9111
|
14
|
|
|
|
|
63
|
my $subTablePtr = GetTagTable($$subdir{TagTable}); |
9112
|
|
|
|
|
|
|
# use specified subdirectory length if given |
9113
|
14
|
100
|
66
|
|
|
146
|
if ($$tagInfo{Format} and $formatSize{$format}) { |
9114
|
12
|
|
|
|
|
39
|
$len = $count * $formatSize{$format}; |
9115
|
12
|
50
|
|
|
|
47
|
$len = $more if $len > $more; |
9116
|
|
|
|
|
|
|
} else { |
9117
|
2
|
|
|
|
|
3
|
$len = $more; # directory size is all of remaining data |
9118
|
2
|
50
|
33
|
|
|
16
|
if ($$subTablePtr{PROCESS_PROC} and |
9119
|
|
|
|
|
|
|
$$subTablePtr{PROCESS_PROC} eq \&ProcessBinaryData) |
9120
|
|
|
|
|
|
|
{ |
9121
|
|
|
|
|
|
|
# the rest of the data will be printed in the subdirectory |
9122
|
2
|
|
|
|
|
5
|
$nextIndex = $size / $increment; |
9123
|
|
|
|
|
|
|
} |
9124
|
|
|
|
|
|
|
} |
9125
|
14
|
|
|
|
|
32
|
my $subdirBase = $base; |
9126
|
14
|
50
|
|
|
|
69
|
if (defined $$subdir{Base}) { |
9127
|
|
|
|
|
|
|
#### eval Base ($start,$base) |
9128
|
0
|
|
|
|
|
0
|
my $start = $entry + $dirStart + $dataPos; |
9129
|
0
|
|
|
|
|
0
|
$subdirBase = eval($$subdir{Base}) + $base; |
9130
|
|
|
|
|
|
|
} |
9131
|
14
|
|
50
|
|
|
83
|
my $start = $$subdir{Start} || 0; |
9132
|
14
|
50
|
|
|
|
63
|
if ($start =~ /\$/) { |
9133
|
|
|
|
|
|
|
# ignore directories with a zero offset (ie. missing Nikon ShotInfo entries) |
9134
|
0
|
0
|
|
|
|
0
|
next unless $val; |
9135
|
|
|
|
|
|
|
#### eval Start ($val, $dirStart) |
9136
|
0
|
|
|
|
|
0
|
$start = eval($start); |
9137
|
0
|
0
|
0
|
|
|
0
|
next if $start < $dirStart or $start > $dataLen; |
9138
|
0
|
|
|
|
|
0
|
$len = $$subdir{DirLen}; |
9139
|
0
|
0
|
0
|
|
|
0
|
$len = $dataLen - $start unless $len and $len <= $dataLen - $start; |
9140
|
|
|
|
|
|
|
} else { |
9141
|
14
|
|
|
|
|
37
|
$start += $dirStart + $entry; |
9142
|
|
|
|
|
|
|
} |
9143
|
14
|
|
|
|
|
89
|
my %subdirInfo = ( |
9144
|
|
|
|
|
|
|
DataPt => $dataPt, |
9145
|
|
|
|
|
|
|
DataPos => $dataPos, |
9146
|
|
|
|
|
|
|
DataLen => $dataLen, |
9147
|
|
|
|
|
|
|
DirStart => $start, |
9148
|
|
|
|
|
|
|
DirLen => $len, |
9149
|
|
|
|
|
|
|
Base => $subdirBase, |
9150
|
|
|
|
|
|
|
); |
9151
|
14
|
|
|
|
|
46
|
delete $$self{NO_UNKNOWN}; |
9152
|
14
|
|
|
|
|
126
|
$self->ProcessDirectory(\%subdirInfo, $subTablePtr, $$subdir{ProcessProc}); |
9153
|
14
|
50
|
|
|
|
132
|
$$self{NO_UNKNOWN} = 1 if $unknown < 2; |
9154
|
14
|
|
|
|
|
57
|
next; |
9155
|
|
|
|
|
|
|
} |
9156
|
16670
|
100
|
66
|
|
|
35856
|
if ($$tagInfo{IsOffset} and $$tagInfo{IsOffset} ne '3') { |
9157
|
38
|
|
|
|
|
79
|
my $et = $self; |
9158
|
|
|
|
|
|
|
#### eval IsOffset ($val, $et) |
9159
|
38
|
100
|
|
|
|
2284
|
$val += $base + $$self{BASE} if eval $$tagInfo{IsOffset}; |
9160
|
|
|
|
|
|
|
} |
9161
|
16670
|
|
|
|
|
37914
|
$val{$index} = $val; |
9162
|
16670
|
|
|
|
|
22909
|
my $oldBase; |
9163
|
16670
|
50
|
|
|
|
34215
|
if ($$tagInfo{SetBase}) { |
9164
|
0
|
|
|
|
|
0
|
$oldBase = $$self{BASE}; |
9165
|
0
|
|
|
|
|
0
|
$$self{BASE} += $base; |
9166
|
|
|
|
|
|
|
} |
9167
|
16670
|
|
|
|
|
40421
|
my $key = $self->FoundTag($tagInfo,$val); |
9168
|
16670
|
50
|
|
|
|
36161
|
$$self{BASE} = $oldBase if defined $oldBase; |
9169
|
16670
|
100
|
|
|
|
30842
|
if ($key) { |
9170
|
15269
|
100
|
|
|
|
41127
|
$$self{RATIONAL}{$key} = $rational if defined $rational; |
9171
|
|
|
|
|
|
|
} else { |
9172
|
|
|
|
|
|
|
# don't increment nextIndex if we didn't extract a tag |
9173
|
1401
|
50
|
|
|
|
4730
|
$nextIndex = $saveNextIndex if defined $saveNextIndex; |
9174
|
|
|
|
|
|
|
} |
9175
|
|
|
|
|
|
|
} |
9176
|
2113
|
|
|
|
|
5075
|
delete $$self{NO_UNKNOWN}; |
9177
|
2113
|
|
|
|
|
10770
|
return 1; |
9178
|
|
|
|
|
|
|
} |
9179
|
|
|
|
|
|
|
|
9180
|
|
|
|
|
|
|
#.............................................................................. |
9181
|
|
|
|
|
|
|
# Load .ExifTool_config file from user's home directory |
9182
|
|
|
|
|
|
|
# (use of noConfig is now deprecated, use configFile = '' instead) |
9183
|
|
|
|
|
|
|
until ($Image::ExifTool::noConfig) { |
9184
|
|
|
|
|
|
|
my $config = $Image::ExifTool::configFile; |
9185
|
|
|
|
|
|
|
my $file; |
9186
|
|
|
|
|
|
|
if (not defined $config) { |
9187
|
|
|
|
|
|
|
$config = '.ExifTool_config'; |
9188
|
|
|
|
|
|
|
# get our home directory (HOMEDRIVE and HOMEPATH are used in Windows cmd shell) |
9189
|
|
|
|
|
|
|
my $home = $ENV{EXIFTOOL_HOME} || $ENV{HOME} || |
9190
|
|
|
|
|
|
|
($ENV{HOMEDRIVE} || '') . ($ENV{HOMEPATH} || '') || '.'; |
9191
|
|
|
|
|
|
|
# look for the config file in 1) the home directory, 2) the program dir |
9192
|
|
|
|
|
|
|
$file = "$home/$config"; |
9193
|
|
|
|
|
|
|
} else { |
9194
|
|
|
|
|
|
|
length $config or last; # filename of "" disables configuration |
9195
|
|
|
|
|
|
|
$file = $config; |
9196
|
|
|
|
|
|
|
} |
9197
|
|
|
|
|
|
|
# also check executable directory unless path is absolute |
9198
|
|
|
|
|
|
|
$exeDir = ($0 =~ /(.*)[\\\/]/) ? $1 : '.' unless defined $exeDir; |
9199
|
|
|
|
|
|
|
-r $file or $config =~ /^\// or $file = "$exeDir/$config"; |
9200
|
|
|
|
|
|
|
unless (-r $file) { |
9201
|
|
|
|
|
|
|
warn("Config file not found\n") if defined $Image::ExifTool::configFile; |
9202
|
|
|
|
|
|
|
last; |
9203
|
|
|
|
|
|
|
} |
9204
|
|
|
|
|
|
|
unshift @INC, '.'; # look in current directory first |
9205
|
|
|
|
|
|
|
eval { require $file }; # load the config file |
9206
|
|
|
|
|
|
|
shift @INC; |
9207
|
|
|
|
|
|
|
# print warning (minus "Compilation failed" part) |
9208
|
|
|
|
|
|
|
$@ and $_=$@, s/Compilation failed.*//s, warn $_; |
9209
|
|
|
|
|
|
|
last; |
9210
|
|
|
|
|
|
|
} |
9211
|
|
|
|
|
|
|
# read user-defined lenses (may have been defined by script instead of config file) |
9212
|
|
|
|
|
|
|
if (@Image::ExifTool::UserDefined::Lenses) { |
9213
|
|
|
|
|
|
|
foreach (@Image::ExifTool::UserDefined::Lenses) { |
9214
|
|
|
|
|
|
|
$Image::ExifTool::userLens{$_} = 1; |
9215
|
|
|
|
|
|
|
} |
9216
|
|
|
|
|
|
|
} |
9217
|
|
|
|
|
|
|
# add user-defined file types |
9218
|
|
|
|
|
|
|
if (%Image::ExifTool::UserDefined::FileTypes) { |
9219
|
|
|
|
|
|
|
foreach (sort keys %Image::ExifTool::UserDefined::FileTypes) { |
9220
|
|
|
|
|
|
|
my $fileInfo = $Image::ExifTool::UserDefined::FileTypes{$_}; |
9221
|
|
|
|
|
|
|
my $type = uc $_; |
9222
|
|
|
|
|
|
|
ref $fileInfo eq 'HASH' or $fileTypeLookup{$type} = $fileInfo, next; |
9223
|
|
|
|
|
|
|
my $baseType = $$fileInfo{BaseType}; |
9224
|
|
|
|
|
|
|
if ($baseType) { |
9225
|
|
|
|
|
|
|
if ($$fileInfo{Description}) { |
9226
|
|
|
|
|
|
|
$fileTypeLookup{$type} = [ $baseType, $$fileInfo{Description} ]; |
9227
|
|
|
|
|
|
|
} else { |
9228
|
|
|
|
|
|
|
$fileTypeLookup{$type} = $baseType; |
9229
|
|
|
|
|
|
|
} |
9230
|
|
|
|
|
|
|
if (defined $$fileInfo{Writable} and not $$fileInfo{Writable}) { |
9231
|
|
|
|
|
|
|
# first make sure we are using an actual base type and not a derived type |
9232
|
|
|
|
|
|
|
$baseType = $fileTypeLookup{$baseType} while $baseType and not ref $fileTypeLookup{$baseType}; |
9233
|
|
|
|
|
|
|
# mark this type as not writable |
9234
|
|
|
|
|
|
|
$noWriteFile{$baseType} or $noWriteFile{$baseType} = [ ]; |
9235
|
|
|
|
|
|
|
push @{$noWriteFile{$baseType}}, $type; |
9236
|
|
|
|
|
|
|
} |
9237
|
|
|
|
|
|
|
} else { |
9238
|
|
|
|
|
|
|
$fileTypeLookup{$type} = [ $type, $$fileInfo{Description} || $type ]; |
9239
|
|
|
|
|
|
|
$moduleName{$type} = 0; # not supported |
9240
|
|
|
|
|
|
|
if ($$fileInfo{Magic}) { |
9241
|
|
|
|
|
|
|
$magicNumber{$type} = $$fileInfo{Magic}; |
9242
|
|
|
|
|
|
|
push @fileTypes, $type unless grep /^$type$/, @fileTypes; |
9243
|
|
|
|
|
|
|
} |
9244
|
|
|
|
|
|
|
} |
9245
|
|
|
|
|
|
|
$mimeType{$type} = $$fileInfo{MIMEType} if defined $$fileInfo{MIMEType}; |
9246
|
|
|
|
|
|
|
} |
9247
|
|
|
|
|
|
|
} |
9248
|
|
|
|
|
|
|
|
9249
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
9250
|
|
|
|
|
|
|
1; # end |