line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
2
|
|
|
|
|
|
|
# File: MIE.pm |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Description: Read/write MIE meta information |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Revisions: 11/18/2005 - P. Harvey Created |
7
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Image::ExifTool::MIE; |
10
|
|
|
|
|
|
|
|
11
|
38
|
|
|
38
|
|
4112
|
use strict; |
|
38
|
|
|
|
|
76
|
|
|
38
|
|
|
|
|
1230
|
|
12
|
38
|
|
|
38
|
|
185
|
use vars qw($VERSION %tableDefaults); |
|
38
|
|
|
|
|
78
|
|
|
38
|
|
|
|
|
1793
|
|
13
|
38
|
|
|
38
|
|
200
|
use Image::ExifTool qw(:DataAccess :Utils); |
|
38
|
|
|
|
|
79
|
|
|
38
|
|
|
|
|
7284
|
|
14
|
38
|
|
|
38
|
|
1299
|
use Image::ExifTool::Exif; |
|
38
|
|
|
|
|
125
|
|
|
38
|
|
|
|
|
895
|
|
15
|
38
|
|
|
38
|
|
5897
|
use Image::ExifTool::GPS; |
|
38
|
|
|
|
|
86
|
|
|
38
|
|
|
|
|
271931
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
$VERSION = '1.49'; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub ProcessMIE($$); |
20
|
|
|
|
|
|
|
sub ProcessMIEGroup($$$); |
21
|
|
|
|
|
|
|
sub WriteMIEGroup($$$); |
22
|
|
|
|
|
|
|
sub CheckMIE($$$); |
23
|
|
|
|
|
|
|
sub GetLangInfo($$); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# local variables |
26
|
|
|
|
|
|
|
my $hasZlib; # 1=Zlib available, 0=no Zlib |
27
|
|
|
|
|
|
|
my %mieCode; # reverse lookup for MIE format names |
28
|
|
|
|
|
|
|
my $doneMieMap; # flag indicating we added user-defined groups to %mieMap |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# MIE format codes |
31
|
|
|
|
|
|
|
my %mieFormat = ( |
32
|
|
|
|
|
|
|
0x00 => 'undef', |
33
|
|
|
|
|
|
|
0x10 => 'MIE', |
34
|
|
|
|
|
|
|
0x18 => 'MIE', |
35
|
|
|
|
|
|
|
0x20 => 'string', # ASCII (ISO 8859-1) |
36
|
|
|
|
|
|
|
0x28 => 'utf8', |
37
|
|
|
|
|
|
|
0x29 => 'utf16', |
38
|
|
|
|
|
|
|
0x2a => 'utf32', |
39
|
|
|
|
|
|
|
0x30 => 'string_list', |
40
|
|
|
|
|
|
|
0x38 => 'utf8_list', |
41
|
|
|
|
|
|
|
0x39 => 'utf16_list', |
42
|
|
|
|
|
|
|
0x3a => 'utf32_list', |
43
|
|
|
|
|
|
|
0x40 => 'int8u', |
44
|
|
|
|
|
|
|
0x41 => 'int16u', |
45
|
|
|
|
|
|
|
0x42 => 'int32u', |
46
|
|
|
|
|
|
|
0x43 => 'int64u', |
47
|
|
|
|
|
|
|
0x48 => 'int8s', |
48
|
|
|
|
|
|
|
0x49 => 'int16s', |
49
|
|
|
|
|
|
|
0x4a => 'int32s', |
50
|
|
|
|
|
|
|
0x4b => 'int64s', |
51
|
|
|
|
|
|
|
0x52 => 'rational32u', |
52
|
|
|
|
|
|
|
0x53 => 'rational64u', |
53
|
|
|
|
|
|
|
0x5a => 'rational32s', |
54
|
|
|
|
|
|
|
0x5b => 'rational64s', |
55
|
|
|
|
|
|
|
0x61 => 'fixed16u', |
56
|
|
|
|
|
|
|
0x62 => 'fixed32u', |
57
|
|
|
|
|
|
|
0x69 => 'fixed16s', |
58
|
|
|
|
|
|
|
0x6a => 'fixed32s', |
59
|
|
|
|
|
|
|
0x72 => 'float', |
60
|
|
|
|
|
|
|
0x73 => 'double', |
61
|
|
|
|
|
|
|
0x80 => 'free', |
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
# map of MIE directory locations |
65
|
|
|
|
|
|
|
my %mieMap = ( |
66
|
|
|
|
|
|
|
'MIE-Meta' => 'MIE', |
67
|
|
|
|
|
|
|
'MIE-Audio' => 'MIE-Meta', |
68
|
|
|
|
|
|
|
'MIE-Camera' => 'MIE-Meta', |
69
|
|
|
|
|
|
|
'MIE-Doc' => 'MIE-Meta', |
70
|
|
|
|
|
|
|
'MIE-Geo' => 'MIE-Meta', |
71
|
|
|
|
|
|
|
'MIE-Image' => 'MIE-Meta', |
72
|
|
|
|
|
|
|
'MIE-MakerNotes' => 'MIE-Meta', |
73
|
|
|
|
|
|
|
'MIE-Preview' => 'MIE-Meta', |
74
|
|
|
|
|
|
|
'MIE-Thumbnail' => 'MIE-Meta', |
75
|
|
|
|
|
|
|
'MIE-Video' => 'MIE-Meta', |
76
|
|
|
|
|
|
|
'MIE-Flash' => 'MIE-Camera', |
77
|
|
|
|
|
|
|
'MIE-Lens' => 'MIE-Camera', |
78
|
|
|
|
|
|
|
'MIE-Orient' => 'MIE-Camera', |
79
|
|
|
|
|
|
|
'MIE-Extender' => 'MIE-Lens', |
80
|
|
|
|
|
|
|
'MIE-GPS' => 'MIE-Geo', |
81
|
|
|
|
|
|
|
'MIE-UTM' => 'MIE-Geo', |
82
|
|
|
|
|
|
|
'MIE-Canon' => 'MIE-MakerNotes', |
83
|
|
|
|
|
|
|
EXIF => 'MIE-Meta', |
84
|
|
|
|
|
|
|
XMP => 'MIE-Meta', |
85
|
|
|
|
|
|
|
IPTC => 'MIE-Meta', |
86
|
|
|
|
|
|
|
ICC_Profile => 'MIE-Meta', |
87
|
|
|
|
|
|
|
ID3 => 'MIE-Meta', |
88
|
|
|
|
|
|
|
CanonVRD => 'MIE-Canon', |
89
|
|
|
|
|
|
|
IFD0 => 'EXIF', |
90
|
|
|
|
|
|
|
IFD1 => 'IFD0', |
91
|
|
|
|
|
|
|
ExifIFD => 'IFD0', |
92
|
|
|
|
|
|
|
GPS => 'IFD0', |
93
|
|
|
|
|
|
|
SubIFD => 'IFD0', |
94
|
|
|
|
|
|
|
GlobParamIFD => 'IFD0', |
95
|
|
|
|
|
|
|
PrintIM => 'IFD0', |
96
|
|
|
|
|
|
|
InteropIFD => 'ExifIFD', |
97
|
|
|
|
|
|
|
MakerNotes => 'ExifIFD', |
98
|
|
|
|
|
|
|
); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# convenience variables for common tagInfo entries |
101
|
|
|
|
|
|
|
my %binaryConv = ( |
102
|
|
|
|
|
|
|
Writable => 'undef', |
103
|
|
|
|
|
|
|
Binary => 1, |
104
|
|
|
|
|
|
|
); |
105
|
|
|
|
|
|
|
my %dateInfo = ( |
106
|
|
|
|
|
|
|
Shift => 'Time', |
107
|
|
|
|
|
|
|
PrintConv => '$self->ConvertDateTime($val)', |
108
|
|
|
|
|
|
|
PrintConvInv => '$self->InverseDateTime($val)', |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
my %noYes = ( 0 => 'No', 1 => 'Yes' ); |
111
|
|
|
|
|
|
|
my %offOn = ( 0 => 'Off', 1 => 'On' ); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# default entries for MIE tag tables |
114
|
|
|
|
|
|
|
%tableDefaults = ( |
115
|
|
|
|
|
|
|
PROCESS_PROC => \&ProcessMIE, |
116
|
|
|
|
|
|
|
WRITE_PROC => \&ProcessMIE, |
117
|
|
|
|
|
|
|
CHECK_PROC => \&CheckMIE, |
118
|
|
|
|
|
|
|
LANG_INFO => \&GetLangInfo, |
119
|
|
|
|
|
|
|
WRITABLE => 'string', |
120
|
|
|
|
|
|
|
PREFERRED => 1, |
121
|
|
|
|
|
|
|
); |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# MIE info |
124
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Main = ( |
125
|
|
|
|
|
|
|
%tableDefaults, |
126
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Main' }, |
127
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Main', |
128
|
|
|
|
|
|
|
NOTES => q{ |
129
|
|
|
|
|
|
|
MIE is a flexible format which may be used as a stand-alone meta information |
130
|
|
|
|
|
|
|
format, for encapsulation of other files and information, or as a trailer |
131
|
|
|
|
|
|
|
appended to other file formats. The tables below represent currently |
132
|
|
|
|
|
|
|
defined MIE tags, however ExifTool will also extract any other information |
133
|
|
|
|
|
|
|
present in a MIE file. |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
When writing MIE information, some special features are supported: |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
1) String values may be written as ASCII (ISO 8859-1) or UTF-8. ExifTool |
138
|
|
|
|
|
|
|
automatically detects the presence of wide characters and treats the string |
139
|
|
|
|
|
|
|
appropriately. Internally, UTF-8 text may be converted to UTF-16 or UTF-32 |
140
|
|
|
|
|
|
|
and stored in this format in the file if it is more compact. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
2) All MIE string-value tags support localized text. Localized values are |
143
|
|
|
|
|
|
|
written by adding a language/country code to the tag name in the form |
144
|
|
|
|
|
|
|
C, where C is the tag name, C is a 2-character lower |
145
|
|
|
|
|
|
|
case ISO 639-1 language code, and C is a 2-character upper case ISO |
146
|
|
|
|
|
|
|
3166-1 alpha 2 country code (eg. C). But as usual, the user |
147
|
|
|
|
|
|
|
interface is case-insensitive, and ExifTool will write the correct case to |
148
|
|
|
|
|
|
|
the file. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
3) Some numerical MIE tags allow units of measurement to be specified. For |
151
|
|
|
|
|
|
|
these tags, units may be added in brackets immediately following the value |
152
|
|
|
|
|
|
|
(eg. C<55(mi/h)>). If no units are specified, the default units are |
153
|
|
|
|
|
|
|
written. |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
4) ExifTool writes compressed metadata to MIE files if the L (-z) |
156
|
|
|
|
|
|
|
option is used and Compress::Zlib is available. |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
See L for the official MIE |
159
|
|
|
|
|
|
|
specification. |
160
|
|
|
|
|
|
|
}, |
161
|
|
|
|
|
|
|
'0Type' => { |
162
|
|
|
|
|
|
|
Name => 'SubfileType', |
163
|
|
|
|
|
|
|
Notes => q{ |
164
|
|
|
|
|
|
|
the capitalized common extension for this type of file. If the extension |
165
|
|
|
|
|
|
|
has a dot-3 abbreviation, then the longer version is used here. For |
166
|
|
|
|
|
|
|
instance, JPEG and TIFF are used, not JPG and TIF |
167
|
|
|
|
|
|
|
}, |
168
|
|
|
|
|
|
|
}, |
169
|
|
|
|
|
|
|
'0Vers' => { |
170
|
|
|
|
|
|
|
Name => 'MIEVersion', |
171
|
|
|
|
|
|
|
Notes => 'version 1.1 is assumed if not specified', |
172
|
|
|
|
|
|
|
}, |
173
|
|
|
|
|
|
|
'1Directory' => { |
174
|
|
|
|
|
|
|
Name => 'SubfileDirectory', |
175
|
|
|
|
|
|
|
Notes => 'original directory for the file', |
176
|
|
|
|
|
|
|
}, |
177
|
|
|
|
|
|
|
'1Name' => { |
178
|
|
|
|
|
|
|
Name => 'SubfileName', |
179
|
|
|
|
|
|
|
Notes => 'the file name, including extension if it exists', |
180
|
|
|
|
|
|
|
}, |
181
|
|
|
|
|
|
|
'2MIME' => { Name => 'SubfileMIMEType' }, |
182
|
|
|
|
|
|
|
Meta => { |
183
|
|
|
|
|
|
|
SubDirectory => { |
184
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Meta', |
185
|
|
|
|
|
|
|
DirName => 'MIE-Meta', |
186
|
|
|
|
|
|
|
}, |
187
|
|
|
|
|
|
|
}, |
188
|
|
|
|
|
|
|
data => { |
189
|
|
|
|
|
|
|
Name => 'SubfileData', |
190
|
|
|
|
|
|
|
Notes => 'the subfile data', |
191
|
|
|
|
|
|
|
%binaryConv, |
192
|
|
|
|
|
|
|
}, |
193
|
|
|
|
|
|
|
rsrc => { |
194
|
|
|
|
|
|
|
Name => 'SubfileResource', |
195
|
|
|
|
|
|
|
Notes => 'subfile resource fork if it exists', |
196
|
|
|
|
|
|
|
%binaryConv, |
197
|
|
|
|
|
|
|
}, |
198
|
|
|
|
|
|
|
zmd5 => { |
199
|
|
|
|
|
|
|
Name => 'MD5Digest', |
200
|
|
|
|
|
|
|
Notes => q{ |
201
|
|
|
|
|
|
|
16-byte MD5 digest written in binary form or as a 32-character hex-encoded |
202
|
|
|
|
|
|
|
ASCII string. Value is an MD5 digest of the entire 0MIE group as it would be |
203
|
|
|
|
|
|
|
with the digest value itself set to all null bytes |
204
|
|
|
|
|
|
|
}, |
205
|
|
|
|
|
|
|
}, |
206
|
|
|
|
|
|
|
zmie => { |
207
|
|
|
|
|
|
|
Name => 'TrailerSignature', |
208
|
|
|
|
|
|
|
Writable => 'undef', |
209
|
|
|
|
|
|
|
Notes => q{ |
210
|
|
|
|
|
|
|
used as the last element in the main "0MIE" group to identify a MIE trailer |
211
|
|
|
|
|
|
|
when appended to another type of file. ExifTool will create this tag if set |
212
|
|
|
|
|
|
|
to any value, but always with an empty data block |
213
|
|
|
|
|
|
|
}, |
214
|
|
|
|
|
|
|
ValueConvInv => '""', # data block must be empty |
215
|
|
|
|
|
|
|
}, |
216
|
|
|
|
|
|
|
); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# MIE meta information group |
219
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Meta = ( |
220
|
|
|
|
|
|
|
%tableDefaults, |
221
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Meta', 2 => 'Image' }, |
222
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Meta', |
223
|
|
|
|
|
|
|
Audio => { |
224
|
|
|
|
|
|
|
SubDirectory => { |
225
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Audio', |
226
|
|
|
|
|
|
|
DirName => 'MIE-Audio', |
227
|
|
|
|
|
|
|
}, |
228
|
|
|
|
|
|
|
}, |
229
|
|
|
|
|
|
|
Camera => { |
230
|
|
|
|
|
|
|
SubDirectory => { |
231
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Camera', |
232
|
|
|
|
|
|
|
DirName => 'MIE-Camera', |
233
|
|
|
|
|
|
|
}, |
234
|
|
|
|
|
|
|
}, |
235
|
|
|
|
|
|
|
Document => { |
236
|
|
|
|
|
|
|
SubDirectory => { |
237
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Doc', |
238
|
|
|
|
|
|
|
DirName => 'MIE-Doc', |
239
|
|
|
|
|
|
|
}, |
240
|
|
|
|
|
|
|
}, |
241
|
|
|
|
|
|
|
EXIF => { |
242
|
|
|
|
|
|
|
SubDirectory => { |
243
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::Exif::Main', |
244
|
|
|
|
|
|
|
ProcessProc => \&Image::ExifTool::ProcessTIFF, |
245
|
|
|
|
|
|
|
WriteProc => \&Image::ExifTool::WriteTIFF, |
246
|
|
|
|
|
|
|
}, |
247
|
|
|
|
|
|
|
}, |
248
|
|
|
|
|
|
|
Geo => { |
249
|
|
|
|
|
|
|
SubDirectory => { |
250
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Geo', |
251
|
|
|
|
|
|
|
DirName => 'MIE-Geo', |
252
|
|
|
|
|
|
|
}, |
253
|
|
|
|
|
|
|
}, |
254
|
|
|
|
|
|
|
ICCProfile => { |
255
|
|
|
|
|
|
|
Name => 'ICC_Profile', |
256
|
|
|
|
|
|
|
SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::Main' }, |
257
|
|
|
|
|
|
|
}, |
258
|
|
|
|
|
|
|
ID3 => { SubDirectory => { TagTable => 'Image::ExifTool::ID3::Main' } }, |
259
|
|
|
|
|
|
|
IPTC => { SubDirectory => { TagTable => 'Image::ExifTool::IPTC::Main' } }, |
260
|
|
|
|
|
|
|
Image => { |
261
|
|
|
|
|
|
|
SubDirectory => { |
262
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Image', |
263
|
|
|
|
|
|
|
DirName => 'MIE-Image', |
264
|
|
|
|
|
|
|
}, |
265
|
|
|
|
|
|
|
}, |
266
|
|
|
|
|
|
|
MakerNotes => { |
267
|
|
|
|
|
|
|
SubDirectory => { |
268
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::MakerNotes', |
269
|
|
|
|
|
|
|
DirName => 'MIE-MakerNotes', |
270
|
|
|
|
|
|
|
}, |
271
|
|
|
|
|
|
|
}, |
272
|
|
|
|
|
|
|
Preview => { |
273
|
|
|
|
|
|
|
SubDirectory => { |
274
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Preview', |
275
|
|
|
|
|
|
|
DirName => 'MIE-Preview', |
276
|
|
|
|
|
|
|
}, |
277
|
|
|
|
|
|
|
}, |
278
|
|
|
|
|
|
|
Thumbnail => { |
279
|
|
|
|
|
|
|
SubDirectory => { |
280
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Thumbnail', |
281
|
|
|
|
|
|
|
DirName => 'MIE-Thumbnail', |
282
|
|
|
|
|
|
|
}, |
283
|
|
|
|
|
|
|
}, |
284
|
|
|
|
|
|
|
Video => { |
285
|
|
|
|
|
|
|
SubDirectory => { |
286
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Video', |
287
|
|
|
|
|
|
|
DirName => 'MIE-Video', |
288
|
|
|
|
|
|
|
}, |
289
|
|
|
|
|
|
|
}, |
290
|
|
|
|
|
|
|
XMP => { SubDirectory => { TagTable => 'Image::ExifTool::XMP::Main' } }, |
291
|
|
|
|
|
|
|
); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# MIE document information |
294
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Doc = ( |
295
|
|
|
|
|
|
|
%tableDefaults, |
296
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Doc', 2 => 'Document' }, |
297
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Doc', |
298
|
|
|
|
|
|
|
NOTES => 'Information describing the main document, image or file.', |
299
|
|
|
|
|
|
|
Author => { Groups => { 2 => 'Author' } }, |
300
|
|
|
|
|
|
|
Comment => { }, |
301
|
|
|
|
|
|
|
Contributors=> { Groups => { 2 => 'Author' }, List => 1 }, |
302
|
|
|
|
|
|
|
Copyright => { Groups => { 2 => 'Author' } }, |
303
|
|
|
|
|
|
|
CreateDate => { Groups => { 2 => 'Time' }, %dateInfo }, |
304
|
|
|
|
|
|
|
EMail => { Name => 'Email', Groups => { 2 => 'Author' } }, |
305
|
|
|
|
|
|
|
Keywords => { List => 1 }, |
306
|
|
|
|
|
|
|
ModifyDate => { Groups => { 2 => 'Time' }, %dateInfo }, |
307
|
|
|
|
|
|
|
OriginalDate=> { |
308
|
|
|
|
|
|
|
Name => 'DateTimeOriginal', |
309
|
|
|
|
|
|
|
Description => 'Date/Time Original', |
310
|
|
|
|
|
|
|
Groups => { 2 => 'Time' }, |
311
|
|
|
|
|
|
|
%dateInfo, |
312
|
|
|
|
|
|
|
}, |
313
|
|
|
|
|
|
|
Phone => { Name => 'PhoneNumber', Groups => { 2 => 'Author' } }, |
314
|
|
|
|
|
|
|
References => { List => 1 }, |
315
|
|
|
|
|
|
|
Software => { }, |
316
|
|
|
|
|
|
|
Title => { }, |
317
|
|
|
|
|
|
|
URL => { }, |
318
|
|
|
|
|
|
|
); |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# MIE geographic information |
321
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Geo = ( |
322
|
|
|
|
|
|
|
%tableDefaults, |
323
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Geo', 2 => 'Location' }, |
324
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Geo', |
325
|
|
|
|
|
|
|
NOTES => 'Information related to geographic location.', |
326
|
|
|
|
|
|
|
Address => { }, |
327
|
|
|
|
|
|
|
City => { }, |
328
|
|
|
|
|
|
|
Country => { }, |
329
|
|
|
|
|
|
|
GPS => { |
330
|
|
|
|
|
|
|
SubDirectory => { |
331
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::GPS', |
332
|
|
|
|
|
|
|
DirName => 'MIE-GPS', |
333
|
|
|
|
|
|
|
}, |
334
|
|
|
|
|
|
|
}, |
335
|
|
|
|
|
|
|
PostalCode => { }, |
336
|
|
|
|
|
|
|
State => { Notes => 'state or province' }, |
337
|
|
|
|
|
|
|
UTM => { |
338
|
|
|
|
|
|
|
SubDirectory => { |
339
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::UTM', |
340
|
|
|
|
|
|
|
DirName => 'MIE-UTM', |
341
|
|
|
|
|
|
|
}, |
342
|
|
|
|
|
|
|
}, |
343
|
|
|
|
|
|
|
); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# MIE GPS information |
346
|
|
|
|
|
|
|
%Image::ExifTool::MIE::GPS = ( |
347
|
|
|
|
|
|
|
%tableDefaults, |
348
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-GPS', 2 => 'Location' }, |
349
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-GPS', |
350
|
|
|
|
|
|
|
Altitude => { |
351
|
|
|
|
|
|
|
Name => 'GPSAltitude', |
352
|
|
|
|
|
|
|
Writable => 'rational64s', |
353
|
|
|
|
|
|
|
Units => [ qw(m ft) ], |
354
|
|
|
|
|
|
|
Notes => q{'m' above sea level unless 'ft' specified}, |
355
|
|
|
|
|
|
|
}, |
356
|
|
|
|
|
|
|
Bearing => { |
357
|
|
|
|
|
|
|
Name => 'GPSDestBearing', |
358
|
|
|
|
|
|
|
Writable => 'rational64s', |
359
|
|
|
|
|
|
|
Units => [ qw(deg deg{mag}) ], |
360
|
|
|
|
|
|
|
Notes => q{'deg' CW from true north unless 'deg{mag}' specified}, |
361
|
|
|
|
|
|
|
}, |
362
|
|
|
|
|
|
|
Datum => { Name => 'GPSMapDatum', Notes => 'WGS-84 assumed if not specified' }, |
363
|
|
|
|
|
|
|
Differential => { |
364
|
|
|
|
|
|
|
Name => 'GPSDifferential', |
365
|
|
|
|
|
|
|
Writable => 'int8u', |
366
|
|
|
|
|
|
|
PrintConv => { |
367
|
|
|
|
|
|
|
0 => 'No Correction', |
368
|
|
|
|
|
|
|
1 => 'Differential Corrected', |
369
|
|
|
|
|
|
|
}, |
370
|
|
|
|
|
|
|
}, |
371
|
|
|
|
|
|
|
Distance => { |
372
|
|
|
|
|
|
|
Name => 'GPSDestDistance', |
373
|
|
|
|
|
|
|
Writable => 'rational64s', |
374
|
|
|
|
|
|
|
Units => [ qw(km mi nmi) ], |
375
|
|
|
|
|
|
|
Notes => q{'km' unless 'mi' or 'nmi' specified}, |
376
|
|
|
|
|
|
|
}, |
377
|
|
|
|
|
|
|
Heading => { |
378
|
|
|
|
|
|
|
Name => 'GPSTrack', |
379
|
|
|
|
|
|
|
Writable => 'rational64s', |
380
|
|
|
|
|
|
|
Units => [ qw(deg deg{mag}) ], |
381
|
|
|
|
|
|
|
Notes => q{'deg' CW from true north unless 'deg{mag}' specified}, |
382
|
|
|
|
|
|
|
}, |
383
|
|
|
|
|
|
|
Latitude => { |
384
|
|
|
|
|
|
|
Name => 'GPSLatitude', |
385
|
|
|
|
|
|
|
Writable => 'rational64s', |
386
|
|
|
|
|
|
|
Count => -1, |
387
|
|
|
|
|
|
|
Notes => q{ |
388
|
|
|
|
|
|
|
1 to 3 numbers: degrees, minutes then seconds. South latitudes are stored |
389
|
|
|
|
|
|
|
as all negative numbers, but may be entered as positive numbers with a |
390
|
|
|
|
|
|
|
trailing 'S' for convenience. For example, these are all equivalent: "-40 |
391
|
|
|
|
|
|
|
-30", "-40.5", "40 30 0.00 S" |
392
|
|
|
|
|
|
|
}, |
393
|
|
|
|
|
|
|
ValueConv => 'Image::ExifTool::GPS::ToDegrees($val, 1)', |
394
|
|
|
|
|
|
|
ValueConvInv => 'Image::ExifTool::GPS::ToDMS($self, $val, 0)', |
395
|
|
|
|
|
|
|
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "N")', |
396
|
|
|
|
|
|
|
PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val, 1, "lat")', |
397
|
|
|
|
|
|
|
}, |
398
|
|
|
|
|
|
|
Longitude => { |
399
|
|
|
|
|
|
|
Name => 'GPSLongitude', |
400
|
|
|
|
|
|
|
Writable => 'rational64s', |
401
|
|
|
|
|
|
|
Count => -1, |
402
|
|
|
|
|
|
|
Notes => q{ |
403
|
|
|
|
|
|
|
1 to 3 numbers: degrees, minutes then seconds. West longitudes are |
404
|
|
|
|
|
|
|
negative, but may be entered as positive numbers with a trailing 'W' |
405
|
|
|
|
|
|
|
}, |
406
|
|
|
|
|
|
|
ValueConv => 'Image::ExifTool::GPS::ToDegrees($val, 1)', |
407
|
|
|
|
|
|
|
ValueConvInv => 'Image::ExifTool::GPS::ToDMS($self, $val, 0)', |
408
|
|
|
|
|
|
|
PrintConv => 'Image::ExifTool::GPS::ToDMS($self, $val, 1, "E")', |
409
|
|
|
|
|
|
|
PrintConvInv => 'Image::ExifTool::GPS::ToDegrees($val, 1, "lon")', |
410
|
|
|
|
|
|
|
}, |
411
|
|
|
|
|
|
|
MeasureMode => { |
412
|
|
|
|
|
|
|
Name => 'GPSMeasureMode', |
413
|
|
|
|
|
|
|
Writable => 'int8u', |
414
|
|
|
|
|
|
|
PrintConv => { 2 => '2-D', 3 => '3-D' }, |
415
|
|
|
|
|
|
|
}, |
416
|
|
|
|
|
|
|
Satellites => 'GPSSatellites', |
417
|
|
|
|
|
|
|
Speed => { |
418
|
|
|
|
|
|
|
Name => 'GPSSpeed', |
419
|
|
|
|
|
|
|
Writable => 'rational64s', |
420
|
|
|
|
|
|
|
Units => [ qw(km/h mi/h m/s kn) ], |
421
|
|
|
|
|
|
|
Notes => q{'km/h' unless 'mi/h', 'm/s' or 'kn' specified}, |
422
|
|
|
|
|
|
|
}, |
423
|
|
|
|
|
|
|
DateTime => { Name => 'GPSDateTime', Groups => { 2 => 'Time' }, %dateInfo }, |
424
|
|
|
|
|
|
|
); |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# MIE UTM information |
427
|
|
|
|
|
|
|
%Image::ExifTool::MIE::UTM = ( |
428
|
|
|
|
|
|
|
%tableDefaults, |
429
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-UTM', 2 => 'Location' }, |
430
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-UTM', |
431
|
|
|
|
|
|
|
Datum => { Name => 'UTMMapDatum', Notes => 'WGS-84 assumed if not specified' }, |
432
|
|
|
|
|
|
|
Easting => { Name => 'UTMEasting' }, |
433
|
|
|
|
|
|
|
Northing => { Name => 'UTMNorthing' }, |
434
|
|
|
|
|
|
|
Zone => { Name => 'UTMZone', Writable => 'int8s' }, |
435
|
|
|
|
|
|
|
); |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# MIE image information |
438
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Image = ( |
439
|
|
|
|
|
|
|
%tableDefaults, |
440
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Image', 2 => 'Image' }, |
441
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Image', |
442
|
|
|
|
|
|
|
'0Type' => { Name => 'FullSizeImageType', Notes => 'JPEG if not specified' }, |
443
|
|
|
|
|
|
|
'1Name' => { Name => 'FullSizeImageName' }, |
444
|
|
|
|
|
|
|
BitDepth => { Name => 'BitDepth', Writable => 'int16u' }, |
445
|
|
|
|
|
|
|
ColorSpace => { Notes => 'standard ColorSpace values are "sRGB" and "Adobe RGB"' }, |
446
|
|
|
|
|
|
|
Components => { |
447
|
|
|
|
|
|
|
Name => 'ComponentsConfiguration', |
448
|
|
|
|
|
|
|
Notes => 'string composed of R, G, B, Y, Cb and Cr', |
449
|
|
|
|
|
|
|
}, |
450
|
|
|
|
|
|
|
Compression => { Name => 'CompressionRatio', Writable => 'rational32u' }, |
451
|
|
|
|
|
|
|
ImageSize => { |
452
|
|
|
|
|
|
|
Writable => 'int16u', |
453
|
|
|
|
|
|
|
Count => -1, |
454
|
|
|
|
|
|
|
Notes => '2 or 3 values, for number of XY or XYZ pixels', |
455
|
|
|
|
|
|
|
PrintConv => '$val=~tr/ /x/;$val', |
456
|
|
|
|
|
|
|
PrintConvInv => '$val=~tr/x/ /;$val', |
457
|
|
|
|
|
|
|
}, |
458
|
|
|
|
|
|
|
Resolution => { |
459
|
|
|
|
|
|
|
Writable => 'rational64u', |
460
|
|
|
|
|
|
|
Units => [ qw(/in /cm /deg /arcmin /arcsec), '' ], |
461
|
|
|
|
|
|
|
Count => -1, |
462
|
|
|
|
|
|
|
Notes => q{ |
463
|
|
|
|
|
|
|
1 to 3 values. A single value for equal resolution in all directions, or |
464
|
|
|
|
|
|
|
separate X, Y and Z values if necessary. Units are '/in' unless '/cm', |
465
|
|
|
|
|
|
|
'/deg', '/arcmin', '/arcsec' or '' specified |
466
|
|
|
|
|
|
|
}, |
467
|
|
|
|
|
|
|
PrintConv => '$val=~tr/ /x/;$val', |
468
|
|
|
|
|
|
|
PrintConvInv => '$val=~tr/x/ /;$val', |
469
|
|
|
|
|
|
|
}, |
470
|
|
|
|
|
|
|
data => { |
471
|
|
|
|
|
|
|
Name => 'FullSizeImage', |
472
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
473
|
|
|
|
|
|
|
%binaryConv, |
474
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(\$val,$tag)', |
475
|
|
|
|
|
|
|
}, |
476
|
|
|
|
|
|
|
); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# MIE preview image |
479
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Preview = ( |
480
|
|
|
|
|
|
|
%tableDefaults, |
481
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Preview', 2 => 'Image' }, |
482
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Preview', |
483
|
|
|
|
|
|
|
'0Type' => { Name => 'PreviewImageType', Notes => 'JPEG if not specified' }, |
484
|
|
|
|
|
|
|
'1Name' => { Name => 'PreviewImageName' }, |
485
|
|
|
|
|
|
|
ImageSize => { |
486
|
|
|
|
|
|
|
Name => 'PreviewImageSize', |
487
|
|
|
|
|
|
|
Writable => 'int16u', |
488
|
|
|
|
|
|
|
Count => -1, |
489
|
|
|
|
|
|
|
Notes => '2 or 3 values, for number of XY or XYZ pixels', |
490
|
|
|
|
|
|
|
PrintConv => '$val=~tr/ /x/;$val', |
491
|
|
|
|
|
|
|
PrintConvInv => '$val=~tr/x/ /;$val', |
492
|
|
|
|
|
|
|
}, |
493
|
|
|
|
|
|
|
data => { |
494
|
|
|
|
|
|
|
Name => 'PreviewImage', |
495
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
496
|
|
|
|
|
|
|
%binaryConv, |
497
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(\$val,$tag)', |
498
|
|
|
|
|
|
|
}, |
499
|
|
|
|
|
|
|
); |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# MIE thumbnail image |
502
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Thumbnail = ( |
503
|
|
|
|
|
|
|
%tableDefaults, |
504
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Thumbnail', 2 => 'Image' }, |
505
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Thumbnail', |
506
|
|
|
|
|
|
|
'0Type' => { Name => 'ThumbnailImageType', Notes => 'JPEG if not specified' }, |
507
|
|
|
|
|
|
|
'1Name' => { Name => 'ThumbnailImageName' }, |
508
|
|
|
|
|
|
|
ImageSize => { |
509
|
|
|
|
|
|
|
Name => 'ThumbnailImageSize', |
510
|
|
|
|
|
|
|
Writable => 'int16u', |
511
|
|
|
|
|
|
|
Count => -1, |
512
|
|
|
|
|
|
|
Notes => '2 or 3 values, for number of XY or XYZ pixels', |
513
|
|
|
|
|
|
|
PrintConv => '$val=~tr/ /x/;$val', |
514
|
|
|
|
|
|
|
PrintConvInv => '$val=~tr/x/ /;$val', |
515
|
|
|
|
|
|
|
}, |
516
|
|
|
|
|
|
|
data => { |
517
|
|
|
|
|
|
|
Name => 'ThumbnailImage', |
518
|
|
|
|
|
|
|
Groups => { 2 => 'Preview' }, |
519
|
|
|
|
|
|
|
%binaryConv, |
520
|
|
|
|
|
|
|
RawConv => '$self->ValidateImage(\$val,$tag)', |
521
|
|
|
|
|
|
|
}, |
522
|
|
|
|
|
|
|
); |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# MIE audio information |
525
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Audio = ( |
526
|
|
|
|
|
|
|
%tableDefaults, |
527
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Audio', 2 => 'Audio' }, |
528
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Audio', |
529
|
|
|
|
|
|
|
NOTES => q{ |
530
|
|
|
|
|
|
|
For the Audio group (and any other group containing a 'data' element), tags |
531
|
|
|
|
|
|
|
refer to the contained data if present, otherwise they refer to the main |
532
|
|
|
|
|
|
|
SubfileData. The C<0Type> and C<1Name> elements should exist only if C |
533
|
|
|
|
|
|
|
is present. |
534
|
|
|
|
|
|
|
}, |
535
|
|
|
|
|
|
|
'0Type' => { Name => 'RelatedAudioFileType', Notes => 'MP3 if not specified' }, |
536
|
|
|
|
|
|
|
'1Name' => { Name => 'RelatedAudioFileName' }, |
537
|
|
|
|
|
|
|
SampleBits => { Writable => 'int16u' }, |
538
|
|
|
|
|
|
|
Channels => { Writable => 'int8u' }, |
539
|
|
|
|
|
|
|
Compression => { Name => 'AudioCompression' }, |
540
|
|
|
|
|
|
|
Duration => { Writable => 'rational64u', PrintConv => 'ConvertDuration($val)' }, |
541
|
|
|
|
|
|
|
SampleRate => { Writable => 'int32u' }, |
542
|
|
|
|
|
|
|
data => { Name => 'RelatedAudioFile', %binaryConv }, |
543
|
|
|
|
|
|
|
); |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
# MIE video information |
546
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Video = ( |
547
|
|
|
|
|
|
|
%tableDefaults, |
548
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Video', 2 => 'Video' }, |
549
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Video', |
550
|
|
|
|
|
|
|
'0Type' => { Name => 'RelatedVideoFileType', Notes => 'MOV if not specified' }, |
551
|
|
|
|
|
|
|
'1Name' => { Name => 'RelatedVideoFileName' }, |
552
|
|
|
|
|
|
|
Codec => { }, |
553
|
|
|
|
|
|
|
Duration => { Writable => 'rational64u', PrintConv => 'ConvertDuration($val)' }, |
554
|
|
|
|
|
|
|
data => { Name => 'RelatedVideoFile', %binaryConv }, |
555
|
|
|
|
|
|
|
); |
556
|
|
|
|
|
|
|
|
557
|
|
|
|
|
|
|
# MIE camera information |
558
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Camera = ( |
559
|
|
|
|
|
|
|
%tableDefaults, |
560
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Camera', 2 => 'Camera' }, |
561
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Camera', |
562
|
|
|
|
|
|
|
Brightness => { Writable => 'int8s' }, |
563
|
|
|
|
|
|
|
ColorTemperature=> { Writable => 'int32u' }, |
564
|
|
|
|
|
|
|
ColorBalance => { |
565
|
|
|
|
|
|
|
Writable => 'rational64u', |
566
|
|
|
|
|
|
|
Count => 3, |
567
|
|
|
|
|
|
|
Notes => 'RGB scaling factors', |
568
|
|
|
|
|
|
|
}, |
569
|
|
|
|
|
|
|
Contrast => { Writable => 'int8s' }, |
570
|
|
|
|
|
|
|
DigitalZoom => { Writable => 'rational64u' }, |
571
|
|
|
|
|
|
|
ExposureComp => { Name => 'ExposureCompensation', Writable => 'rational64s' }, |
572
|
|
|
|
|
|
|
ExposureMode => { }, |
573
|
|
|
|
|
|
|
ExposureTime => { |
574
|
|
|
|
|
|
|
Writable => 'rational64u', |
575
|
|
|
|
|
|
|
PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)', |
576
|
|
|
|
|
|
|
PrintConvInv => '$val', |
577
|
|
|
|
|
|
|
}, |
578
|
|
|
|
|
|
|
Flash => { |
579
|
|
|
|
|
|
|
SubDirectory => { |
580
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Flash', |
581
|
|
|
|
|
|
|
DirName => 'MIE-Flash', |
582
|
|
|
|
|
|
|
}, |
583
|
|
|
|
|
|
|
}, |
584
|
|
|
|
|
|
|
FirmwareVersion => { }, |
585
|
|
|
|
|
|
|
FocusMode => { }, |
586
|
|
|
|
|
|
|
ISO => { Writable => 'int16u' }, |
587
|
|
|
|
|
|
|
ISOSetting => { |
588
|
|
|
|
|
|
|
Writable => 'int16u', |
589
|
|
|
|
|
|
|
Notes => '0 = Auto, otherwise manual ISO speed setting', |
590
|
|
|
|
|
|
|
}, |
591
|
|
|
|
|
|
|
ImageNumber => { Writable => 'int32u' }, |
592
|
|
|
|
|
|
|
ImageQuality => { Notes => 'Economy, Normal, Fine, Super Fine or Raw' }, |
593
|
|
|
|
|
|
|
ImageStabilization => { Writable => 'int8u', %offOn }, |
594
|
|
|
|
|
|
|
Lens => { |
595
|
|
|
|
|
|
|
SubDirectory => { |
596
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Lens', |
597
|
|
|
|
|
|
|
DirName => 'MIE-Lens', |
598
|
|
|
|
|
|
|
}, |
599
|
|
|
|
|
|
|
}, |
600
|
|
|
|
|
|
|
Make => { }, |
601
|
|
|
|
|
|
|
MeasuredEV => { Writable => 'rational64s' }, |
602
|
|
|
|
|
|
|
Model => { }, |
603
|
|
|
|
|
|
|
OwnerName => { }, |
604
|
|
|
|
|
|
|
Orientation => { |
605
|
|
|
|
|
|
|
SubDirectory => { |
606
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Orient', |
607
|
|
|
|
|
|
|
DirName => 'MIE-Orient', |
608
|
|
|
|
|
|
|
}, |
609
|
|
|
|
|
|
|
}, |
610
|
|
|
|
|
|
|
Saturation => { Writable => 'int8s' }, |
611
|
|
|
|
|
|
|
SensorSize => { |
612
|
|
|
|
|
|
|
Writable => 'rational64u', |
613
|
|
|
|
|
|
|
Count => 2, |
614
|
|
|
|
|
|
|
Notes => 'width and height of active sensor area in mm', |
615
|
|
|
|
|
|
|
}, |
616
|
|
|
|
|
|
|
SerialNumber => { }, |
617
|
|
|
|
|
|
|
Sharpness => { Writable => 'int8s' }, |
618
|
|
|
|
|
|
|
ShootingMode => { }, |
619
|
|
|
|
|
|
|
); |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# Camera orientation information |
622
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Orient = ( |
623
|
|
|
|
|
|
|
%tableDefaults, |
624
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Orient', 2 => 'Camera' }, |
625
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Orient', |
626
|
|
|
|
|
|
|
NOTES => 'These tags describe the camera orientation.', |
627
|
|
|
|
|
|
|
Azimuth => { |
628
|
|
|
|
|
|
|
Writable => 'rational64s', |
629
|
|
|
|
|
|
|
Units => [ qw(deg deg{mag}) ], |
630
|
|
|
|
|
|
|
Notes => q{'deg' CW from true north unless 'deg{mag}' specified}, |
631
|
|
|
|
|
|
|
}, |
632
|
|
|
|
|
|
|
Declination => { Writable => 'rational64s' }, |
633
|
|
|
|
|
|
|
Elevation => { Writable => 'rational64s' }, |
634
|
|
|
|
|
|
|
RightAscension => { Writable => 'rational64s' }, |
635
|
|
|
|
|
|
|
Rotation => { |
636
|
|
|
|
|
|
|
Writable => 'rational64s', |
637
|
|
|
|
|
|
|
Notes => 'CW rotation angle of camera about lens axis', |
638
|
|
|
|
|
|
|
}, |
639
|
|
|
|
|
|
|
); |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# MIE camera lens information |
642
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Lens = ( |
643
|
|
|
|
|
|
|
%tableDefaults, |
644
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Lens', 2 => 'Camera' }, |
645
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Lens', |
646
|
|
|
|
|
|
|
NOTES => q{ |
647
|
|
|
|
|
|
|
All recorded lens parameters (focal length, aperture, etc) include the |
648
|
|
|
|
|
|
|
effects of the extender if present. |
649
|
|
|
|
|
|
|
}, |
650
|
|
|
|
|
|
|
Extender => { |
651
|
|
|
|
|
|
|
SubDirectory => { |
652
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Extender', |
653
|
|
|
|
|
|
|
DirName => 'MIE-Extender', |
654
|
|
|
|
|
|
|
}, |
655
|
|
|
|
|
|
|
}, |
656
|
|
|
|
|
|
|
FNumber => { Writable => 'rational64u' }, |
657
|
|
|
|
|
|
|
FocalLength => { Writable => 'rational64u', Notes => 'all focal lengths in mm' }, |
658
|
|
|
|
|
|
|
FocusDistance => { |
659
|
|
|
|
|
|
|
Writable => 'rational64u', |
660
|
|
|
|
|
|
|
Units => [ qw(m ft) ], |
661
|
|
|
|
|
|
|
Notes => q{'m' unless 'ft' specified}, |
662
|
|
|
|
|
|
|
}, |
663
|
|
|
|
|
|
|
Make => { Name => 'LensMake' }, |
664
|
|
|
|
|
|
|
MaxAperture => { Writable => 'rational64u' }, |
665
|
|
|
|
|
|
|
MaxApertureAtMaxFocal => { Writable => 'rational64u' }, |
666
|
|
|
|
|
|
|
MaxFocalLength => { Writable => 'rational64u' }, |
667
|
|
|
|
|
|
|
MinAperture => { Writable => 'rational64u' }, |
668
|
|
|
|
|
|
|
MinFocalLength => { Writable => 'rational64u' }, |
669
|
|
|
|
|
|
|
Model => { Name => 'LensModel' }, |
670
|
|
|
|
|
|
|
OpticalZoom => { Writable => 'rational64u' }, |
671
|
|
|
|
|
|
|
SerialNumber => { Name => 'LensSerialNumber' }, |
672
|
|
|
|
|
|
|
); |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# MIE lens extender information |
675
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Extender = ( |
676
|
|
|
|
|
|
|
%tableDefaults, |
677
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Extender', 2 => 'Camera' }, |
678
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Extender', |
679
|
|
|
|
|
|
|
Magnification => { Name => 'ExtenderMagnification', Writable => 'rational64s' }, |
680
|
|
|
|
|
|
|
Make => { Name => 'ExtenderMake' }, |
681
|
|
|
|
|
|
|
Model => { Name => 'ExtenderModel' }, |
682
|
|
|
|
|
|
|
SerialNumber => { Name => 'ExtenderSerialNumber' }, |
683
|
|
|
|
|
|
|
); |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
# MIE camera flash information |
686
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Flash = ( |
687
|
|
|
|
|
|
|
%tableDefaults, |
688
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Flash', 2 => 'Camera' }, |
689
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Flash', |
690
|
|
|
|
|
|
|
ExposureComp => { Name => 'FlashExposureComp', Writable => 'rational64s' }, |
691
|
|
|
|
|
|
|
Fired => { Name => 'FlashFired', Writable => 'int8u', PrintConv => \%noYes }, |
692
|
|
|
|
|
|
|
GuideNumber => { Name => 'FlashGuideNumber' }, |
693
|
|
|
|
|
|
|
Make => { Name => 'FlashMake' }, |
694
|
|
|
|
|
|
|
Mode => { Name => 'FlashMode' }, |
695
|
|
|
|
|
|
|
Model => { Name => 'FlashModel' }, |
696
|
|
|
|
|
|
|
SerialNumber => { Name => 'FlashSerialNumber' }, |
697
|
|
|
|
|
|
|
Type => { Name => 'FlashType', Notes => '"Internal" or "External"' }, |
698
|
|
|
|
|
|
|
); |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
# MIE maker notes information |
701
|
|
|
|
|
|
|
%Image::ExifTool::MIE::MakerNotes = ( |
702
|
|
|
|
|
|
|
%tableDefaults, |
703
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-MakerNotes' }, |
704
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-MakerNotes', |
705
|
|
|
|
|
|
|
NOTES => q{ |
706
|
|
|
|
|
|
|
MIE maker notes are contained within separate groups for each manufacturer |
707
|
|
|
|
|
|
|
to avoid name conflicts. |
708
|
|
|
|
|
|
|
}, |
709
|
|
|
|
|
|
|
Canon => { |
710
|
|
|
|
|
|
|
SubDirectory => { |
711
|
|
|
|
|
|
|
TagTable => 'Image::ExifTool::MIE::Canon', |
712
|
|
|
|
|
|
|
DirName => 'MIE-Canon', |
713
|
|
|
|
|
|
|
}, |
714
|
|
|
|
|
|
|
}, |
715
|
|
|
|
|
|
|
Casio => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
716
|
|
|
|
|
|
|
FujiFilm => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
717
|
|
|
|
|
|
|
Kodak => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
718
|
|
|
|
|
|
|
KonicaMinolta=>{ SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
719
|
|
|
|
|
|
|
Nikon => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
720
|
|
|
|
|
|
|
Olympus => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
721
|
|
|
|
|
|
|
Panasonic => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
722
|
|
|
|
|
|
|
Pentax => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
723
|
|
|
|
|
|
|
Ricoh => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
724
|
|
|
|
|
|
|
Sigma => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
725
|
|
|
|
|
|
|
Sony => { SubDirectory => { TagTable => 'Image::ExifTool::MIE::Unknown' } }, |
726
|
|
|
|
|
|
|
); |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
# MIE Canon-specific information |
729
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Canon = ( |
730
|
|
|
|
|
|
|
%tableDefaults, |
731
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Canon' }, |
732
|
|
|
|
|
|
|
WRITE_GROUP => 'MIE-Canon', |
733
|
|
|
|
|
|
|
VRD => { |
734
|
|
|
|
|
|
|
Name => 'CanonVRD', |
735
|
|
|
|
|
|
|
SubDirectory => { TagTable => 'Image::ExifTool::CanonVRD::Main' }, |
736
|
|
|
|
|
|
|
}, |
737
|
|
|
|
|
|
|
); |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
%Image::ExifTool::MIE::Unknown = ( |
740
|
|
|
|
|
|
|
PROCESS_PROC => \&ProcessMIE, |
741
|
|
|
|
|
|
|
GROUPS => { 1 => 'MIE-Unknown' }, |
742
|
|
|
|
|
|
|
); |
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
745
|
|
|
|
|
|
|
# Add user-defined MIE groups to %mieMap |
746
|
|
|
|
|
|
|
# Inputs: none; Returns: nothing, but sets $doneMieMap flag |
747
|
|
|
|
|
|
|
sub UpdateMieMap() |
748
|
|
|
|
|
|
|
{ |
749
|
3
|
|
|
3
|
0
|
7
|
$doneMieMap = 1; # set flag so we only do this once |
750
|
3
|
50
|
|
|
|
12
|
return unless %Image::ExifTool::UserDefined; |
751
|
0
|
|
|
|
|
0
|
my ($tableName, @tables, %doneTable, $tagID); |
752
|
|
|
|
|
|
|
# get list of top-level MIE tables with user-defined tags |
753
|
0
|
|
|
|
|
0
|
foreach $tableName (keys %Image::ExifTool::UserDefined) { |
754
|
0
|
0
|
|
|
|
0
|
next unless $tableName =~ /^Image::ExifTool::MIE::/; |
755
|
0
|
|
|
|
|
0
|
my $userTable = $Image::ExifTool::UserDefined{$tableName}; |
756
|
0
|
0
|
|
|
|
0
|
my $tagTablePtr = GetTagTable($tableName) or next; |
757
|
|
|
|
|
|
|
# copy the WRITE_GROUP from the actual table |
758
|
0
|
|
|
|
|
0
|
$$userTable{WRITE_GROUP} = $$tagTablePtr{WRITE_GROUP}; |
759
|
|
|
|
|
|
|
# add to list of tables to process |
760
|
0
|
|
|
|
|
0
|
$doneTable{$tableName} = 1; |
761
|
0
|
|
|
|
|
0
|
push @tables, [$tableName, $userTable]; |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
# recursively add all user-defined groups to MIE map |
764
|
0
|
|
|
|
|
0
|
while (@tables) { |
765
|
0
|
|
|
|
|
0
|
my ($tableName, $tagTablePtr) = @{shift @tables}; |
|
0
|
|
|
|
|
0
|
|
766
|
0
|
|
|
|
|
0
|
my $parent = $$tagTablePtr{WRITE_GROUP}; |
767
|
0
|
0
|
|
|
|
0
|
$parent or warn("No WRITE_GROUP for $tableName\n"), next; |
768
|
0
|
0
|
|
|
|
0
|
$mieMap{$parent} or warn("$parent is not in MIE map\n"), next; |
769
|
0
|
|
|
|
|
0
|
foreach $tagID (TagTableKeys($tagTablePtr)) { |
770
|
0
|
|
|
|
|
0
|
my $tagInfo = $$tagTablePtr{$tagID}; |
771
|
0
|
0
|
0
|
|
|
0
|
next unless ref $tagInfo eq 'HASH' and $$tagInfo{SubDirectory}; |
772
|
0
|
|
|
|
|
0
|
my $subTableName = $tagInfo->{SubDirectory}->{TagTable}; |
773
|
0
|
0
|
|
|
|
0
|
my $subTablePtr = GetTagTable($subTableName) or next; |
774
|
|
|
|
|
|
|
# only care about MIE tables |
775
|
|
|
|
|
|
|
next unless $$subTablePtr{PROCESS_PROC} and |
776
|
0
|
0
|
0
|
|
|
0
|
$$subTablePtr{PROCESS_PROC} eq \&ProcessMIE; |
777
|
0
|
|
|
|
|
0
|
my $group = $$subTablePtr{WRITE_GROUP}; |
778
|
0
|
0
|
|
|
|
0
|
$group or warn("No WRITE_GROUP for $subTableName\n"), next; |
779
|
0
|
0
|
0
|
|
|
0
|
if ($mieMap{$group} and $mieMap{$group} ne $parent) { |
780
|
0
|
|
|
|
|
0
|
warn("$group already has different parent ($mieMap{$group})\n"), next; |
781
|
|
|
|
|
|
|
} |
782
|
0
|
|
|
|
|
0
|
$mieMap{$group} = $parent; # add to map |
783
|
|
|
|
|
|
|
# process tables within this one too |
784
|
0
|
0
|
|
|
|
0
|
$doneTable{$subTableName} and next; |
785
|
0
|
|
|
|
|
0
|
$doneTable{$subTableName} = 1; |
786
|
0
|
|
|
|
|
0
|
push @tables, [$subTableName, $subTablePtr]; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
} |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
792
|
|
|
|
|
|
|
# Get localized version of tagInfo hash |
793
|
|
|
|
|
|
|
# Inputs: 0) tagInfo hash ref, 1) locale code (eg. "en_CA") |
794
|
|
|
|
|
|
|
# Returns: new tagInfo hash ref, or undef if invalid |
795
|
|
|
|
|
|
|
sub GetLangInfo($$) |
796
|
|
|
|
|
|
|
{ |
797
|
58
|
|
|
58
|
0
|
115
|
my ($tagInfo, $langCode) = @_; |
798
|
|
|
|
|
|
|
# check for properly formatted language code |
799
|
58
|
100
|
|
|
|
194
|
return undef unless $langCode =~ /^[a-z]{2}([-_])[A-Z]{2}$/; |
800
|
|
|
|
|
|
|
# use '_' as a separator, but recognize '_' or '-' |
801
|
48
|
50
|
|
|
|
112
|
$langCode =~ tr/-/_/ if $1 eq '-'; |
802
|
|
|
|
|
|
|
# can only set locale on string types |
803
|
48
|
50
|
33
|
|
|
118
|
return undef if $$tagInfo{Writable} and $$tagInfo{Writable} ne 'string'; |
804
|
48
|
|
|
|
|
132
|
return Image::ExifTool::GetLangInfo($tagInfo, $langCode); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
808
|
|
|
|
|
|
|
# return true if we have Zlib::Compress |
809
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) verb for what you want to do with the info |
810
|
|
|
|
|
|
|
# Returns: 1 if Zlib available, 0 otherwise |
811
|
|
|
|
|
|
|
sub HasZlib($$) |
812
|
|
|
|
|
|
|
{ |
813
|
0
|
0
|
|
0
|
0
|
0
|
unless (defined $hasZlib) { |
814
|
0
|
|
|
|
|
0
|
$hasZlib = eval { require Compress::Zlib }; |
|
0
|
|
|
|
|
0
|
|
815
|
0
|
0
|
|
|
|
0
|
unless ($hasZlib) { |
816
|
0
|
|
|
|
|
0
|
$hasZlib = 0; |
817
|
0
|
|
|
|
|
0
|
$_[0]->Warn("Install Compress::Zlib to $_[1] compressed information"); |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
} |
820
|
0
|
|
|
|
|
0
|
return $hasZlib; |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
824
|
|
|
|
|
|
|
# Get format code for MIE group element with current byte order |
825
|
|
|
|
|
|
|
# Inputs: 0) [optional] true to convert result to chr() |
826
|
|
|
|
|
|
|
# Returns: format code |
827
|
|
|
|
|
|
|
sub MIEGroupFormat(;$) |
828
|
|
|
|
|
|
|
{ |
829
|
31
|
|
|
31
|
0
|
54
|
my $chr = shift; |
830
|
31
|
50
|
|
|
|
70
|
my $format = GetByteOrder() eq 'MM' ? 0x10 : 0x18; |
831
|
31
|
50
|
|
|
|
148
|
return $chr ? chr($format) : $format; |
832
|
|
|
|
|
|
|
} |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
835
|
|
|
|
|
|
|
# ReadValue() with added support for UTF formats (utf8, utf16 and utf32) |
836
|
|
|
|
|
|
|
# Inputs: 0) data reference, 1) value offset, 2) format string, |
837
|
|
|
|
|
|
|
# 3) number of values (or undef to use all data) |
838
|
|
|
|
|
|
|
# 4) valid data length relative to offset, 5) returned rational ref |
839
|
|
|
|
|
|
|
# Returns: converted value, or undefined if data isn't there |
840
|
|
|
|
|
|
|
# or list of values in list context |
841
|
|
|
|
|
|
|
# Notes: all string formats are converted to UTF8 |
842
|
|
|
|
|
|
|
sub ReadMIEValue($$$$$;$) |
843
|
|
|
|
|
|
|
{ |
844
|
492
|
|
|
492
|
0
|
885
|
my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_; |
845
|
492
|
|
|
|
|
553
|
my $val; |
846
|
492
|
100
|
|
|
|
1597
|
if ($format =~ /^(utf(8|16|32)|string)/) { |
847
|
332
|
100
|
100
|
|
|
1200
|
if ($1 eq 'utf8' or $1 eq 'string') { |
848
|
|
|
|
|
|
|
# read the 8-bit string |
849
|
308
|
|
|
|
|
672
|
$val = substr($$dataPt, $offset, $size); |
850
|
|
|
|
|
|
|
# (as of ExifTool 7.62, leave string values unconverted) |
851
|
|
|
|
|
|
|
} else { |
852
|
|
|
|
|
|
|
# convert to UTF8 |
853
|
24
|
|
|
|
|
43
|
my $fmt; |
854
|
24
|
50
|
|
|
|
73
|
if (GetByteOrder() eq 'MM') { |
855
|
24
|
50
|
|
|
|
83
|
$fmt = ($1 eq 'utf16') ? 'n' : 'N'; |
856
|
|
|
|
|
|
|
} else { |
857
|
0
|
0
|
|
|
|
0
|
$fmt = ($1 eq 'utf16') ? 'v' : 'V'; |
858
|
|
|
|
|
|
|
} |
859
|
24
|
|
|
|
|
158
|
my @unpk = unpack("x$offset$fmt$size",$$dataPt); |
860
|
24
|
50
|
|
|
|
70
|
if ($] >= 5.006001) { |
861
|
24
|
|
|
|
|
136
|
$val = pack('C0U*', @unpk); |
862
|
|
|
|
|
|
|
} else { |
863
|
0
|
|
|
|
|
0
|
$val = Image::ExifTool::PackUTF8(@unpk); |
864
|
|
|
|
|
|
|
} |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
# truncate at null unless this is a list |
867
|
|
|
|
|
|
|
# (strings shouldn't have a null, but just in case) |
868
|
332
|
100
|
|
|
|
832
|
$val =~ s/\0.*//s unless $format =~ /_list$/; |
869
|
|
|
|
|
|
|
} else { |
870
|
160
|
50
|
|
|
|
324
|
$format = 'undef' if $format eq 'free'; # read 'free' as 'undef' |
871
|
160
|
|
|
|
|
424
|
return ReadValue($dataPt, $offset, $format, $count, $size, $ratPt); |
872
|
|
|
|
|
|
|
} |
873
|
332
|
|
|
|
|
646
|
return $val; |
874
|
|
|
|
|
|
|
} |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
877
|
|
|
|
|
|
|
# validate raw values for writing |
878
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object ref, 1) tagInfo hash ref, 2) raw value ref |
879
|
|
|
|
|
|
|
# Returns: error string or undef (and possibly changes value) on success |
880
|
|
|
|
|
|
|
sub CheckMIE($$$) |
881
|
|
|
|
|
|
|
{ |
882
|
543
|
|
|
543
|
0
|
1208
|
my ($et, $tagInfo, $valPtr) = @_; |
883
|
543
|
|
66
|
|
|
1938
|
my $format = $$tagInfo{Writable} || $tagInfo->{Table}->{WRITABLE}; |
884
|
543
|
|
|
|
|
759
|
my $err; |
885
|
|
|
|
|
|
|
|
886
|
543
|
50
|
33
|
|
|
2067
|
return 'No writable format' if not $format or $format eq '1'; |
887
|
|
|
|
|
|
|
# handle units if supported by this tag |
888
|
543
|
|
|
|
|
958
|
my $ulist = $$tagInfo{Units}; |
889
|
543
|
100
|
100
|
|
|
3654
|
if ($ulist and $$valPtr =~ /(.*)\((.*)\)$/) { |
|
|
100
|
100
|
|
|
|
|
890
|
1
|
|
|
|
|
5
|
my ($val, $units) = ($1, $2); |
891
|
1
|
|
|
|
|
19
|
($units) = grep /^$units$/i, @$ulist; |
892
|
1
|
50
|
|
|
|
5
|
defined $units or return 'Allowed units: (' . join('|', @$ulist) . ')'; |
893
|
1
|
|
|
|
|
8
|
$err = Image::ExifTool::CheckValue(\$val, $format, $$tagInfo{Count}); |
894
|
|
|
|
|
|
|
# add units back onto value |
895
|
1
|
50
|
|
|
|
7
|
$$valPtr = "$val($units)" unless $err; |
896
|
|
|
|
|
|
|
} elsif ($format !~ /^(utf|string|undef)/ and $$valPtr =~ /\)$/) { |
897
|
7
|
|
|
|
|
29
|
return 'Units not supported'; |
898
|
|
|
|
|
|
|
} else { |
899
|
535
|
50
|
66
|
|
|
2257
|
if ($format eq 'string' and $$et{OPTIONS}{Charset} ne 'UTF8' and |
|
|
|
33
|
|
|
|
|
900
|
|
|
|
|
|
|
$$valPtr =~ /[\x80-\xff]/) |
901
|
|
|
|
|
|
|
{ |
902
|
|
|
|
|
|
|
# convert from Charset to UTF-8 |
903
|
0
|
|
|
|
|
0
|
$$valPtr = $et->Encode($$valPtr,'UTF8'); |
904
|
|
|
|
|
|
|
} |
905
|
535
|
|
|
|
|
2163
|
$err = Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count}); |
906
|
|
|
|
|
|
|
} |
907
|
536
|
|
|
|
|
1589
|
return $err; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
911
|
|
|
|
|
|
|
# Rewrite a MIE directory |
912
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ptr |
913
|
|
|
|
|
|
|
# Returns: undef on success, otherwise error message (empty message if nothing to write) |
914
|
|
|
|
|
|
|
sub WriteMIEGroup($$$) |
915
|
|
|
|
|
|
|
{ |
916
|
45
|
|
|
45
|
0
|
95
|
my ($et, $dirInfo, $tagTablePtr) = @_; |
917
|
45
|
|
|
|
|
81
|
my $outfile = $$dirInfo{OutFile}; |
918
|
45
|
|
|
|
|
71
|
my $dirName = $$dirInfo{DirName}; |
919
|
45
|
|
50
|
|
|
104
|
my $toWrite = $$dirInfo{ToWrite} || ''; |
920
|
45
|
|
|
|
|
74
|
my $raf = $$dirInfo{RAF}; |
921
|
45
|
|
|
|
|
145
|
my $verbose = $et->Options('Verbose'); |
922
|
45
|
|
|
|
|
98
|
my $optCompress = $et->Options('Compress'); |
923
|
45
|
|
|
|
|
99
|
my $out = $et->Options('TextOut'); |
924
|
45
|
|
|
|
|
84
|
my ($msg, $err, $ok, $sync, $delGroup); |
925
|
45
|
|
|
|
|
96
|
my $tag = ''; |
926
|
45
|
|
|
|
|
63
|
my $deletedTag = ''; |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
# count each MIE directory found and make name for this specific instance |
929
|
45
|
|
|
|
|
60
|
my ($grp1, %isWriting); |
930
|
45
|
|
|
|
|
70
|
my $cnt = $$et{MIE_COUNT}; |
931
|
45
|
|
|
|
|
134
|
my $grp = $tagTablePtr->{GROUPS}->{1}; |
932
|
45
|
|
100
|
|
|
122
|
my $n = $$cnt{'MIE-Main'} || 0; |
933
|
45
|
100
|
|
|
|
97
|
if ($grp eq 'MIE-Main') { |
934
|
9
|
|
|
|
|
34
|
$$cnt{$grp} = ++$n; |
935
|
9
|
|
|
|
|
77
|
($grp1 = $grp) =~ s/MIE-/MIE$n-/; |
936
|
|
|
|
|
|
|
} else { |
937
|
36
|
|
|
|
|
215
|
($grp1 = $grp) =~ s/MIE-/MIE$n-/; |
938
|
36
|
|
50
|
|
|
185
|
my $m = $$cnt{$grp1} = ($$cnt{$grp1} || 0) + 1; |
939
|
36
|
|
|
|
|
106
|
$isWriting{"$grp$m"} = 1; # eg. 'MIE-Doc2' |
940
|
36
|
|
|
|
|
66
|
$isWriting{$grp1} = 1; # eg. 'MIE1-Doc' |
941
|
36
|
|
|
|
|
57
|
$grp1 .= $m; |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
# build lookup for all valid group names for this MIE group |
944
|
45
|
|
|
|
|
106
|
$isWriting{$grp} = 1; # eg. 'MIE-Doc' |
945
|
45
|
|
|
|
|
87
|
$isWriting{$grp1} = 1; # eg. 'MIE1-Doc2' |
946
|
45
|
|
|
|
|
98
|
$isWriting{"MIE$n"} = 1; # eg. 'MIE1' |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
# determine if we are deleting this group |
949
|
45
|
100
|
|
|
|
61
|
if (%{$$et{DEL_GROUP}}) { |
|
45
|
|
|
|
|
109
|
|
950
|
|
|
|
|
|
|
$delGroup = 1 if $$et{DEL_GROUP}{MIE} or |
951
|
|
|
|
|
|
|
$$et{DEL_GROUP}{$grp} or |
952
|
|
|
|
|
|
|
$$et{DEL_GROUP}{$grp1} or |
953
|
9
|
50
|
33
|
|
|
89
|
$$et{DEL_GROUP}{"MIE$n"}; |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
954
|
|
|
|
|
|
|
} |
955
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
# prepare lookups and lists for writing |
957
|
45
|
|
|
|
|
143
|
my $newTags = $et->GetNewTagInfoHash($tagTablePtr); |
958
|
45
|
|
|
|
|
136
|
my ($addDirs, $editDirs) = $et->GetAddDirHash($tagTablePtr, $dirName); |
959
|
45
|
|
|
|
|
202
|
my @editTags = sort keys %$newTags, keys %$editDirs; |
960
|
45
|
0
|
|
|
|
103
|
$verbose and print $out $raf ? 'Writing' : 'Creating', " $grp1:\n"; |
|
|
50
|
|
|
|
|
|
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
# loop through elements in MIE group |
963
|
45
|
|
|
|
|
66
|
MieElement: for (;;) { |
964
|
138
|
|
|
|
|
193
|
my ($format, $tagLen, $valLen, $units, $oldHdr, $buff); |
965
|
138
|
|
|
|
|
182
|
my $lastTag = $tag; |
966
|
138
|
100
|
|
|
|
235
|
if ($raf) { |
967
|
|
|
|
|
|
|
# read first 4 bytes of element header |
968
|
125
|
|
|
|
|
259
|
my $n = $raf->Read($oldHdr, 4); |
969
|
125
|
100
|
|
|
|
231
|
if ($n != 4) { |
970
|
1
|
50
|
33
|
|
|
8
|
last if $n or defined $sync; |
971
|
1
|
|
|
|
|
3
|
undef $raf; # all done reading |
972
|
1
|
|
|
|
|
2
|
$ok = 1; |
973
|
|
|
|
|
|
|
} |
974
|
|
|
|
|
|
|
} |
975
|
138
|
100
|
|
|
|
216
|
if ($raf) { |
976
|
124
|
|
|
|
|
341
|
($sync, $format, $tagLen, $valLen) = unpack('aC3', $oldHdr); |
977
|
124
|
50
|
|
|
|
237
|
$sync eq '~' or $msg = 'Invalid sync byte', last; |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
# read tag name |
980
|
124
|
100
|
|
|
|
189
|
if ($tagLen) { |
981
|
93
|
50
|
|
|
|
182
|
$raf->Read($tag, $tagLen) == $tagLen or last; |
982
|
93
|
|
|
|
|
138
|
$oldHdr .= $tag; # add tag to element header |
983
|
93
|
50
|
|
|
|
169
|
$et->Warn("MIE tag '${tag}' out of sequence") if $tag lt $lastTag; |
984
|
|
|
|
|
|
|
# separate units from tag name if they exist |
985
|
93
|
100
|
|
|
|
217
|
$units = $1 if $tag =~ s/\((.*)\)$//; |
986
|
|
|
|
|
|
|
} else { |
987
|
31
|
|
|
|
|
47
|
$tag = ''; |
988
|
|
|
|
|
|
|
} |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
# get multi-byte value length if necessary |
991
|
124
|
50
|
|
|
|
221
|
if ($valLen > 252) { |
992
|
|
|
|
|
|
|
# calculate number of bytes in extended DataLength |
993
|
0
|
|
|
|
|
0
|
my $n = 1 << (256 - $valLen); |
994
|
0
|
0
|
|
|
|
0
|
$raf->Read($buff, $n) == $n or last; |
995
|
0
|
|
|
|
|
0
|
$oldHdr .= $buff; # add to old header |
996
|
0
|
|
|
|
|
0
|
my $fmt = 'int' . ($n * 8) . 'u'; |
997
|
0
|
|
|
|
|
0
|
$valLen = ReadValue(\$buff, 0, $fmt, 1, $n); |
998
|
0
|
0
|
|
|
|
0
|
if ($valLen > 0x7fffffff) { |
999
|
0
|
|
|
|
|
0
|
$msg = "Can't write $tag (DataLength > 2GB not yet supported)"; |
1000
|
0
|
|
|
|
|
0
|
last; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
|
# don't rewrite free bytes or information in deleted groups |
1004
|
124
|
0
|
33
|
|
|
335
|
if ($format == 0x80 or ($delGroup and $tagLen and ($format & 0xf0) != 0x10)) { |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1005
|
0
|
0
|
|
|
|
0
|
$raf->Seek($valLen, 1) or $msg = 'Seek error', last; |
1006
|
0
|
0
|
|
|
|
0
|
if ($verbose > 1) { |
1007
|
0
|
0
|
|
|
|
0
|
my $free = ($format == 0x80) ? ' free' : ''; |
1008
|
0
|
|
|
|
|
0
|
print $out " - $grp1:$tag ($valLen$free bytes)\n"; |
1009
|
|
|
|
|
|
|
} |
1010
|
0
|
0
|
|
|
|
0
|
++$$et{CHANGED} if $delGroup; |
1011
|
0
|
|
|
|
|
0
|
next; |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
} else { |
1014
|
|
|
|
|
|
|
# no more elements to read |
1015
|
14
|
|
|
|
|
23
|
$tagLen = $valLen = 0; |
1016
|
14
|
|
|
|
|
27
|
$tag = ''; |
1017
|
|
|
|
|
|
|
} |
1018
|
|
|
|
|
|
|
# |
1019
|
|
|
|
|
|
|
# write necessary new tags and process directories |
1020
|
|
|
|
|
|
|
# |
1021
|
138
|
|
|
|
|
240
|
while (@editTags) { |
1022
|
134
|
100
|
100
|
|
|
329
|
last if $tagLen and $editTags[0] gt $tag; |
1023
|
|
|
|
|
|
|
# we are writing the new tag now |
1024
|
95
|
|
|
|
|
138
|
my ($newVal, $writable, $oldVal, $newFormat, $compress); |
1025
|
95
|
|
|
|
|
137
|
my $newTag = shift @editTags; |
1026
|
95
|
50
|
|
|
|
171
|
length($newTag) > 255 and $et->Warn('Tag name too long'), next; # (just to be safe) |
1027
|
95
|
|
|
|
|
140
|
my $newInfo = $$editDirs{$newTag}; |
1028
|
95
|
100
|
|
|
|
153
|
if ($newInfo) { |
1029
|
|
|
|
|
|
|
# create the new subdirectory or rewrite existing non-MIE directory |
1030
|
36
|
|
|
|
|
126
|
my $subTablePtr = GetTagTable($newInfo->{SubDirectory}->{TagTable}); |
1031
|
36
|
50
|
|
|
|
85
|
unless ($subTablePtr) { |
1032
|
0
|
|
|
|
|
0
|
$et->Warn("No tag table for $newTag $$newInfo{Name}"); |
1033
|
0
|
|
|
|
|
0
|
next; |
1034
|
|
|
|
|
|
|
} |
1035
|
36
|
|
|
|
|
52
|
my %subdirInfo; |
1036
|
|
|
|
|
|
|
my $isMieGroup = ($$subTablePtr{WRITE_PROC} and |
1037
|
36
|
|
66
|
|
|
161
|
$$subTablePtr{WRITE_PROC} eq \&ProcessMIE); |
1038
|
|
|
|
|
|
|
|
1039
|
36
|
100
|
|
|
|
82
|
if ($newTag eq $tag) { |
1040
|
|
|
|
|
|
|
# make sure that either both or neither old and new tags are MIE groups |
1041
|
10
|
50
|
25
|
|
|
63
|
if ($isMieGroup xor ($format & 0xf3) == 0x10) { |
1042
|
0
|
|
|
|
|
0
|
$et->Warn("Tag '${tag}' not expected type"); |
1043
|
0
|
|
|
|
|
0
|
next; # don't write our new tag |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
# uncompress existing directory into $oldVal since we are editing it |
1046
|
10
|
50
|
|
|
|
42
|
if ($format & 0x04) { |
1047
|
0
|
0
|
|
|
|
0
|
last unless HasZlib($et, 'edit'); |
1048
|
0
|
0
|
|
|
|
0
|
$raf->Read($oldVal, $valLen) == $valLen or last MieElement; |
1049
|
0
|
|
|
|
|
0
|
my $stat; |
1050
|
0
|
|
|
|
|
0
|
my $inflate = Compress::Zlib::inflateInit(); |
1051
|
0
|
0
|
|
|
|
0
|
$inflate and ($oldVal, $stat) = $inflate->inflate($oldVal); |
1052
|
0
|
0
|
0
|
|
|
0
|
unless ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) { |
1053
|
0
|
|
|
|
|
0
|
$msg = "Error inflating $tag"; |
1054
|
0
|
|
|
|
|
0
|
last MieElement; |
1055
|
|
|
|
|
|
|
} |
1056
|
0
|
|
|
|
|
0
|
$compress = 1; |
1057
|
0
|
|
|
|
|
0
|
$valLen = length $oldVal; # uncompressed value length |
1058
|
|
|
|
|
|
|
} |
1059
|
|
|
|
|
|
|
} else { |
1060
|
|
|
|
|
|
|
# don't create this directory unless necessary |
1061
|
26
|
100
|
|
|
|
74
|
next unless $$addDirs{$newTag}; |
1062
|
|
|
|
|
|
|
} |
1063
|
|
|
|
|
|
|
|
1064
|
29
|
100
|
|
|
|
70
|
if ($isMieGroup) { |
1065
|
23
|
|
|
|
|
39
|
my $hdr; |
1066
|
23
|
100
|
33
|
|
|
68
|
if ($newTag eq $tag) { |
|
|
50
|
|
|
|
|
|
1067
|
|
|
|
|
|
|
# rewrite existing directory later unless it was compressed |
1068
|
10
|
50
|
|
|
|
37
|
last unless $compress; |
1069
|
|
|
|
|
|
|
# rewrite directory to '$newVal' |
1070
|
0
|
|
|
|
|
0
|
$newVal = ''; |
1071
|
0
|
|
|
|
|
0
|
%subdirInfo = ( |
1072
|
|
|
|
|
|
|
OutFile => \$newVal, |
1073
|
|
|
|
|
|
|
RAF => new File::RandomAccess(\$oldVal), |
1074
|
|
|
|
|
|
|
); |
1075
|
|
|
|
|
|
|
} elsif ($optCompress and not $$dirInfo{IsCompressed}) { |
1076
|
|
|
|
|
|
|
# write to memory so we can compress the new MIE group |
1077
|
0
|
|
|
|
|
0
|
$compress = 1; |
1078
|
0
|
|
|
|
|
0
|
%subdirInfo = ( |
1079
|
|
|
|
|
|
|
OutFile => \$newVal, |
1080
|
|
|
|
|
|
|
); |
1081
|
|
|
|
|
|
|
} else { |
1082
|
13
|
|
|
|
|
28
|
$hdr = '~' . MIEGroupFormat(1) . chr(length($newTag)) . |
1083
|
|
|
|
|
|
|
"\0" . $newTag; |
1084
|
13
|
|
|
|
|
49
|
%subdirInfo = ( |
1085
|
|
|
|
|
|
|
OutFile => $outfile, |
1086
|
|
|
|
|
|
|
ToWrite => $toWrite . $hdr, |
1087
|
|
|
|
|
|
|
); |
1088
|
|
|
|
|
|
|
} |
1089
|
13
|
|
33
|
|
|
42
|
$subdirInfo{DirName} = $newInfo->{SubDirectory}->{DirName} || $newTag; |
1090
|
13
|
|
|
|
|
24
|
$subdirInfo{Parent} = $dirName; |
1091
|
|
|
|
|
|
|
# don't compress elements of an already compressed group |
1092
|
13
|
|
33
|
|
|
42
|
$subdirInfo{IsCompressed} = $$dirInfo{IsCompressed} || $compress; |
1093
|
13
|
|
|
|
|
55
|
$msg = WriteMIEGroup($et, \%subdirInfo, $subTablePtr); |
1094
|
13
|
50
|
|
|
|
31
|
last MieElement if $msg; |
1095
|
|
|
|
|
|
|
# message is defined but empty if nothing was written |
1096
|
13
|
100
|
|
|
|
30
|
if (defined $msg) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1097
|
2
|
|
|
|
|
3
|
undef $msg; # not a problem if nothing was written |
1098
|
2
|
|
|
|
|
7
|
next; |
1099
|
|
|
|
|
|
|
} elsif (not $compress) { |
1100
|
|
|
|
|
|
|
# group was written already |
1101
|
11
|
|
|
|
|
14
|
$toWrite = ''; |
1102
|
11
|
|
|
|
|
39
|
next; |
1103
|
|
|
|
|
|
|
} elsif (length($newVal) <= 4) { # terminator only? |
1104
|
0
|
0
|
|
|
|
0
|
$verbose and print $out "Deleted compressed $grp1 (empty)\n"; |
1105
|
0
|
0
|
|
|
|
0
|
next MieElement if $newTag eq $tag; # deleting the directory |
1106
|
0
|
|
|
|
|
0
|
next; # not creating the new directory |
1107
|
|
|
|
|
|
|
} |
1108
|
0
|
|
|
|
|
0
|
$writable = 'undef'; |
1109
|
0
|
|
|
|
|
0
|
$newFormat = MIEGroupFormat(); |
1110
|
|
|
|
|
|
|
} else { |
1111
|
6
|
50
|
|
|
|
20
|
if ($newTag eq $tag) { |
1112
|
0
|
0
|
|
|
|
0
|
unless ($compress) { |
1113
|
|
|
|
|
|
|
# read and edit existing directory |
1114
|
0
|
0
|
|
|
|
0
|
$raf->Read($oldVal, $valLen) == $valLen or last MieElement; |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
%subdirInfo = ( |
1117
|
|
|
|
|
|
|
DataPt => \$oldVal, |
1118
|
|
|
|
|
|
|
DataLen => $valLen, |
1119
|
|
|
|
|
|
|
DirName => $$newInfo{Name}, |
1120
|
0
|
0
|
|
|
|
0
|
DataPos => $$dirInfo{IsCompressed} ? undef : $raf->Tell() - $valLen, |
1121
|
|
|
|
|
|
|
DirStart=> 0, |
1122
|
|
|
|
|
|
|
DirLen => $valLen, |
1123
|
|
|
|
|
|
|
); |
1124
|
|
|
|
|
|
|
# write Compact subdirectories if we will compress the data |
1125
|
0
|
0
|
0
|
|
|
0
|
if (($compress or $optCompress or $$dirInfo{IsCompressed}) and |
|
|
|
0
|
|
|
|
|
1126
|
0
|
|
|
|
|
0
|
eval { require Compress::Zlib }) |
1127
|
|
|
|
|
|
|
{ |
1128
|
0
|
|
|
|
|
0
|
$subdirInfo{Compact} = 1; |
1129
|
0
|
|
|
|
|
0
|
$subdirInfo{ReadOnly} = 1; # because XMP is not writable in place |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
} |
1132
|
6
|
|
|
|
|
15
|
$subdirInfo{Parent} = $dirName; |
1133
|
6
|
|
|
|
|
61
|
my $writeProc = $newInfo->{SubDirectory}->{WriteProc}; |
1134
|
|
|
|
|
|
|
# reset processed lookup to avoid errors in case of multiple EXIF blocks |
1135
|
6
|
|
|
|
|
24
|
$$et{PROCESSED} = { }; |
1136
|
6
|
|
|
|
|
33
|
$newVal = $et->WriteDirectory(\%subdirInfo, $subTablePtr, $writeProc); |
1137
|
6
|
100
|
|
|
|
19
|
if (defined $newVal) { |
1138
|
5
|
50
|
|
|
|
17
|
if ($newVal eq '') { |
1139
|
0
|
0
|
|
|
|
0
|
next MieElement if $newTag eq $tag; # deleting the directory |
1140
|
0
|
|
|
|
|
0
|
next; # not creating the new directory |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
} else { |
1143
|
1
|
50
|
|
|
|
5
|
next unless defined $oldVal; |
1144
|
0
|
|
|
|
|
0
|
$newVal = $oldVal; # just copy over the old directory |
1145
|
|
|
|
|
|
|
} |
1146
|
5
|
|
|
|
|
10
|
$writable = 'undef'; |
1147
|
5
|
|
|
|
|
17
|
$newFormat = 0x00; # all other directories are 'undef' format |
1148
|
|
|
|
|
|
|
} |
1149
|
|
|
|
|
|
|
} else { |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
# get the new tag information |
1152
|
59
|
|
|
|
|
79
|
$newInfo = $$newTags{$newTag}; |
1153
|
59
|
|
|
|
|
151
|
my $nvHash = $et->GetNewValueHash($newInfo); |
1154
|
59
|
|
|
|
|
76
|
my @newVals; |
1155
|
|
|
|
|
|
|
|
1156
|
|
|
|
|
|
|
# write information only to specified group |
1157
|
59
|
|
|
|
|
113
|
my $writeGroup = $$nvHash{WriteGroup}; |
1158
|
59
|
50
|
|
|
|
116
|
last unless $isWriting{$writeGroup}; |
1159
|
|
|
|
|
|
|
|
1160
|
|
|
|
|
|
|
# if tag existed, must decide if we want to overwrite the value |
1161
|
59
|
100
|
|
|
|
101
|
if ($newTag eq $tag) { |
1162
|
1
|
|
|
|
|
1
|
my $isOverwriting; |
1163
|
1
|
|
|
|
|
4
|
my $isList = $$newInfo{List}; |
1164
|
1
|
50
|
|
|
|
3
|
if ($isList) { |
1165
|
0
|
0
|
|
|
|
0
|
last if $$nvHash{CreateOnly}; |
1166
|
0
|
|
|
|
|
0
|
$isOverwriting = -1; # force processing list elements individually |
1167
|
|
|
|
|
|
|
} else { |
1168
|
1
|
|
|
|
|
7
|
$isOverwriting = $et->IsOverwriting($nvHash); |
1169
|
1
|
50
|
|
|
|
3
|
last unless $isOverwriting; |
1170
|
|
|
|
|
|
|
} |
1171
|
1
|
|
|
|
|
2
|
my ($val, $cmpVal); |
1172
|
1
|
50
|
33
|
|
|
8
|
if ($isOverwriting < 0 or $verbose > 1) { |
1173
|
|
|
|
|
|
|
# check to be sure we can uncompress the value if necessary |
1174
|
0
|
0
|
0
|
|
|
0
|
HasZlib($et, 'edit') or last if $format & 0x04; |
1175
|
|
|
|
|
|
|
# read the old value |
1176
|
0
|
0
|
|
|
|
0
|
$raf->Read($oldVal, $valLen) == $valLen or last MieElement; |
1177
|
|
|
|
|
|
|
# uncompress if necessary |
1178
|
0
|
0
|
|
|
|
0
|
if ($format & 0x04) { |
1179
|
0
|
|
|
|
|
0
|
my $stat; |
1180
|
0
|
|
|
|
|
0
|
my $inflate = Compress::Zlib::inflateInit(); |
1181
|
|
|
|
|
|
|
# must save original compressed value in case we decide |
1182
|
|
|
|
|
|
|
# not to overwrite it later |
1183
|
0
|
|
|
|
|
0
|
$cmpVal = $oldVal; |
1184
|
0
|
0
|
|
|
|
0
|
$inflate and ($oldVal, $stat) = $inflate->inflate($oldVal); |
1185
|
0
|
0
|
0
|
|
|
0
|
unless ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) { |
1186
|
0
|
|
|
|
|
0
|
$msg = "Error inflating $tag"; |
1187
|
0
|
|
|
|
|
0
|
last MieElement; |
1188
|
|
|
|
|
|
|
} |
1189
|
0
|
|
|
|
|
0
|
$valLen = length $oldVal; # update value length |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
# convert according to specified format |
1192
|
0
|
|
0
|
|
|
0
|
my $formatStr = $mieFormat{$format & 0xfb} || 'undef'; |
1193
|
0
|
|
|
|
|
0
|
$val = ReadMIEValue(\$oldVal, 0, $formatStr, undef, $valLen); |
1194
|
0
|
0
|
0
|
|
|
0
|
if ($isOverwriting < 0 and defined $val) { |
1195
|
|
|
|
|
|
|
# handle list values individually |
1196
|
0
|
0
|
|
|
|
0
|
if ($isList) { |
1197
|
0
|
|
|
|
|
0
|
my (@vals, $v); |
1198
|
0
|
0
|
|
|
|
0
|
if ($formatStr =~ /_list$/) { |
1199
|
0
|
|
|
|
|
0
|
@vals = split "\0", $val; |
1200
|
|
|
|
|
|
|
} else { |
1201
|
0
|
|
|
|
|
0
|
@vals = $val; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
# keep any list items that we aren't overwriting |
1204
|
0
|
|
|
|
|
0
|
foreach $v (@vals) { |
1205
|
0
|
0
|
|
|
|
0
|
next if $et->IsOverwriting($nvHash, $v); |
1206
|
0
|
|
|
|
|
0
|
push @newVals, $v; |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
} else { |
1209
|
|
|
|
|
|
|
# test to see if we really want to overwrite the value |
1210
|
0
|
|
|
|
|
0
|
$isOverwriting = $et->IsOverwriting($nvHash, $val); |
1211
|
|
|
|
|
|
|
} |
1212
|
|
|
|
|
|
|
} |
1213
|
|
|
|
|
|
|
} |
1214
|
1
|
50
|
|
|
|
3
|
if ($isOverwriting) { |
1215
|
|
|
|
|
|
|
# skip the old value if we didn't read it already |
1216
|
1
|
50
|
|
|
|
8
|
unless (defined $oldVal) { |
1217
|
1
|
50
|
|
|
|
6
|
$raf->Seek($valLen, 1) or $msg = 'Seek error'; |
1218
|
|
|
|
|
|
|
} |
1219
|
1
|
50
|
|
|
|
5
|
if ($verbose > 1) { |
1220
|
0
|
0
|
|
|
|
0
|
$val .= "($units)" if defined $units; |
1221
|
0
|
|
|
|
|
0
|
$et->VerboseValue("- $grp1:$$newInfo{Name}", $val); |
1222
|
|
|
|
|
|
|
} |
1223
|
1
|
|
|
|
|
2
|
$deletedTag = $tag; # remember that we deleted this tag |
1224
|
1
|
|
|
|
|
2
|
++$$et{CHANGED}; # we deleted the old value |
1225
|
|
|
|
|
|
|
} else { |
1226
|
0
|
0
|
|
|
|
0
|
if (defined $oldVal) { |
1227
|
|
|
|
|
|
|
# write original compressed value |
1228
|
0
|
0
|
|
|
|
0
|
$oldVal = $cmpVal if defined $cmpVal; |
1229
|
|
|
|
|
|
|
} else { |
1230
|
0
|
0
|
|
|
|
0
|
$raf->Read($oldVal, $valLen) == $valLen or last MieElement; |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
# write the old value now |
1233
|
0
|
0
|
|
|
|
0
|
Write($outfile, $toWrite, $oldHdr, $oldVal) or $err = 1; |
1234
|
0
|
|
|
|
|
0
|
$toWrite = ''; |
1235
|
0
|
|
|
|
|
0
|
next MieElement; |
1236
|
|
|
|
|
|
|
} |
1237
|
1
|
50
|
|
|
|
5
|
unless (@newVals) { |
1238
|
|
|
|
|
|
|
# unshift the new tag info to write it later |
1239
|
1
|
|
|
|
|
2
|
unshift @editTags, $newTag; |
1240
|
1
|
|
|
|
|
3
|
next MieElement; # get next element from file |
1241
|
|
|
|
|
|
|
} |
1242
|
|
|
|
|
|
|
} else { |
1243
|
|
|
|
|
|
|
# write new value if creating, or if List and list existed, or |
1244
|
|
|
|
|
|
|
# if tag was previously deleted |
1245
|
|
|
|
|
|
|
next unless $$nvHash{IsCreating} or |
1246
|
58
|
0
|
0
|
|
|
107
|
($newTag eq $lastTag and ($$newInfo{List} or $deletedTag eq $lastTag)); |
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1247
|
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
|
# get the new value to write (undef to delete) |
1249
|
58
|
|
|
|
|
133
|
push @newVals, $et->GetNewValue($nvHash); |
1250
|
58
|
50
|
|
|
|
109
|
next unless @newVals; |
1251
|
58
|
|
66
|
|
|
160
|
$writable = $$newInfo{Writable} || $$tagTablePtr{WRITABLE}; |
1252
|
58
|
100
|
|
|
|
93
|
if ($writable eq 'string') { |
1253
|
|
|
|
|
|
|
# join multiple values into a single string |
1254
|
40
|
|
|
|
|
86
|
$newVal = join "\0", @newVals; |
1255
|
|
|
|
|
|
|
# write string as UTF-8,16 or 32 if value contains valid UTF-8 codes |
1256
|
40
|
|
|
|
|
162
|
require Image::ExifTool::XMP; |
1257
|
40
|
|
|
|
|
105
|
my $isUTF8 = Image::ExifTool::XMP::IsUTF8(\$newVal); |
1258
|
40
|
100
|
|
|
|
90
|
if ($isUTF8 > 0) { |
1259
|
9
|
|
|
|
|
13
|
$writable = 'utf8'; |
1260
|
|
|
|
|
|
|
# write UTF-16 or UTF-32 if it is more compact |
1261
|
9
|
50
|
|
|
|
17
|
my $to = $isUTF8 > 1 ? 'UCS4' : 'UCS2'; |
1262
|
9
|
|
|
|
|
26
|
my $tmp = Image::ExifTool::Decode(undef,$newVal,'UTF8',undef,$to); |
1263
|
9
|
100
|
|
|
|
37
|
if (length $tmp < length $newVal) { |
1264
|
3
|
|
|
|
|
7
|
$newVal = $tmp; |
1265
|
3
|
50
|
|
|
|
9
|
$writable = ($isUTF8 > 1) ? 'utf32' : 'utf16'; |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
# write as a list if we have multiple values |
1269
|
40
|
100
|
|
|
|
78
|
$writable .= '_list' if @newVals > 1; |
1270
|
|
|
|
|
|
|
} else { |
1271
|
|
|
|
|
|
|
# should only be one element in the list |
1272
|
18
|
|
|
|
|
25
|
$newVal = shift @newVals; |
1273
|
|
|
|
|
|
|
} |
1274
|
58
|
|
|
|
|
110
|
$newFormat = $mieCode{$writable}; |
1275
|
58
|
50
|
|
|
|
118
|
unless (defined $newFormat) { |
1276
|
0
|
|
|
|
|
0
|
$msg = "Bad format '${writable}' for $$newInfo{Name}"; |
1277
|
0
|
|
|
|
|
0
|
next MieElement; |
1278
|
|
|
|
|
|
|
} |
1279
|
|
|
|
|
|
|
} |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
# write the new or edited element |
1282
|
63
|
|
|
|
|
103
|
while (defined $newFormat) { |
1283
|
63
|
|
|
|
|
91
|
my $valPt = \$newVal; |
1284
|
|
|
|
|
|
|
# remove units from value and add to tag name if supported by this tag |
1285
|
63
|
100
|
|
|
|
110
|
if ($$newInfo{Units}) { |
1286
|
1
|
|
|
|
|
2
|
my $val2; |
1287
|
1
|
50
|
|
|
|
8
|
if ($$valPt =~ /(.*)\((.*)\)$/) { |
1288
|
1
|
|
|
|
|
4
|
$val2 = $1; |
1289
|
1
|
|
|
|
|
5
|
$newTag .= "($2)"; |
1290
|
|
|
|
|
|
|
} else { |
1291
|
0
|
|
|
|
|
0
|
$val2 = $$valPt; |
1292
|
|
|
|
|
|
|
# add default units |
1293
|
0
|
|
|
|
|
0
|
my $ustr = '(' . $newInfo->{Units}->[0] . ')'; |
1294
|
0
|
|
|
|
|
0
|
$newTag .= $ustr; |
1295
|
0
|
|
|
|
|
0
|
$$valPt .= $ustr; |
1296
|
|
|
|
|
|
|
} |
1297
|
1
|
|
|
|
|
2
|
$valPt = \$val2; |
1298
|
|
|
|
|
|
|
} |
1299
|
|
|
|
|
|
|
# convert value if necessary |
1300
|
63
|
100
|
|
|
|
208
|
if ($writable !~ /^(utf|string|undef)/) { |
1301
|
16
|
|
|
|
|
54
|
my $val3 = WriteValue($$valPt, $writable, $$newInfo{Count}); |
1302
|
16
|
50
|
|
|
|
35
|
defined $val3 or $et->Warn("Error writing $newTag"), last; |
1303
|
16
|
|
|
|
|
26
|
$valPt = \$val3; |
1304
|
|
|
|
|
|
|
} |
1305
|
63
|
|
|
|
|
96
|
my $len = length $$valPt; |
1306
|
|
|
|
|
|
|
# compress value before writing if required |
1307
|
63
|
0
|
33
|
|
|
205
|
if (($compress or $optCompress) and not $$dirInfo{IsCompressed} and |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1308
|
|
|
|
|
|
|
HasZlib($et, 'write')) |
1309
|
|
|
|
|
|
|
{ |
1310
|
0
|
|
|
|
|
0
|
my $deflate = Compress::Zlib::deflateInit(); |
1311
|
0
|
|
|
|
|
0
|
my $val4; |
1312
|
0
|
0
|
|
|
|
0
|
if ($deflate) { |
1313
|
0
|
|
|
|
|
0
|
$val4 = $deflate->deflate($$valPt); |
1314
|
0
|
0
|
|
|
|
0
|
$val4 .= $deflate->flush() if defined $val4; |
1315
|
|
|
|
|
|
|
} |
1316
|
0
|
0
|
|
|
|
0
|
if (defined $val4) { |
1317
|
0
|
|
|
|
|
0
|
my $len4 = length $val4; |
1318
|
0
|
|
|
|
|
0
|
my $saved = $len - $len4; |
1319
|
|
|
|
|
|
|
# only use compressed data if it is smaller |
1320
|
0
|
0
|
|
|
|
0
|
if ($saved > 0) { |
|
|
0
|
|
|
|
|
|
1321
|
0
|
0
|
|
|
|
0
|
$verbose and print $out " [$newTag compression saved $saved bytes]\n"; |
1322
|
0
|
|
|
|
|
0
|
$newFormat |= 0x04; # set compressed bit |
1323
|
0
|
|
|
|
|
0
|
$len = $len4; # set length |
1324
|
0
|
|
|
|
|
0
|
$valPt = \$val4; # set value pointer |
1325
|
|
|
|
|
|
|
} elsif ($verbose) { |
1326
|
0
|
|
|
|
|
0
|
print $out " [$newTag compression saved $saved bytes -- written uncompressed]\n"; |
1327
|
|
|
|
|
|
|
} |
1328
|
|
|
|
|
|
|
} else { |
1329
|
0
|
|
|
|
|
0
|
$et->Warn("Error deflating $newTag (written uncompressed)"); |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
} |
1332
|
|
|
|
|
|
|
# calculate the DataLength code |
1333
|
63
|
|
|
|
|
75
|
my $extLen; |
1334
|
63
|
100
|
|
|
|
110
|
if ($len < 253) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1335
|
60
|
|
|
|
|
70
|
$extLen = ''; |
1336
|
|
|
|
|
|
|
} elsif ($len < 65536) { |
1337
|
3
|
|
|
|
|
15
|
$extLen = Set16u($len); |
1338
|
3
|
|
|
|
|
5
|
$len = 255; |
1339
|
|
|
|
|
|
|
} elsif ($len <= 0x7fffffff) { |
1340
|
0
|
|
|
|
|
0
|
$extLen = Set32u($len); |
1341
|
0
|
|
|
|
|
0
|
$len = 254; |
1342
|
|
|
|
|
|
|
} else { |
1343
|
0
|
|
|
|
|
0
|
$et->Warn("Can't write $newTag (DataLength > 2GB not yet supported)"); |
1344
|
0
|
|
|
|
|
0
|
last; # don't write this tag |
1345
|
|
|
|
|
|
|
} |
1346
|
|
|
|
|
|
|
# write this element (with leading MIE group element if not done already) |
1347
|
63
|
|
|
|
|
189
|
my $hdr = $toWrite . '~' . chr($newFormat) . chr(length $newTag); |
1348
|
63
|
50
|
|
|
|
182
|
Write($outfile, $hdr, chr($len), $newTag, $extLen, $$valPt) or $err = 1; |
1349
|
63
|
|
|
|
|
107
|
$toWrite = ''; |
1350
|
|
|
|
|
|
|
# we changed a tag unless just editing a subdirectory |
1351
|
63
|
100
|
|
|
|
117
|
unless ($$editDirs{$newTag}) { |
1352
|
58
|
|
|
|
|
223
|
$et->VerboseValue("+ $grp1:$$newInfo{Name}", $newVal); |
1353
|
58
|
|
|
|
|
86
|
++$$et{CHANGED}; |
1354
|
|
|
|
|
|
|
} |
1355
|
63
|
|
|
|
|
101
|
last; # didn't want to loop anyway |
1356
|
|
|
|
|
|
|
} |
1357
|
63
|
50
|
|
|
|
184
|
next MieElement if defined $oldVal; |
1358
|
|
|
|
|
|
|
} |
1359
|
|
|
|
|
|
|
# |
1360
|
|
|
|
|
|
|
# rewrite existing element or descend into uncompressed MIE group |
1361
|
|
|
|
|
|
|
# |
1362
|
|
|
|
|
|
|
# all done this MIE group if we reached the terminator element |
1363
|
137
|
100
|
|
|
|
259
|
unless ($tagLen) { |
1364
|
|
|
|
|
|
|
# skip over existing terminator data (if any) |
1365
|
45
|
50
|
66
|
|
|
130
|
last if $valLen and not $raf->Seek($valLen, 1); |
1366
|
45
|
|
|
|
|
69
|
$ok = 1; |
1367
|
|
|
|
|
|
|
# write group terminator if necessary |
1368
|
45
|
100
|
|
|
|
87
|
unless ($toWrite) { |
1369
|
|
|
|
|
|
|
# write end-of-group terminator element |
1370
|
43
|
|
|
|
|
65
|
my $term = "~\0\0\0"; |
1371
|
43
|
100
|
|
|
|
105
|
unless ($$dirInfo{Parent}) { |
1372
|
|
|
|
|
|
|
# write extended terminator for file-level group |
1373
|
9
|
100
|
|
|
|
46
|
my $len = ref $outfile eq 'SCALAR' ? length($$outfile) : tell $outfile; |
1374
|
9
|
|
|
|
|
19
|
$len += 10; # include length of terminator itself |
1375
|
9
|
50
|
33
|
|
|
48
|
if ($len and $len <= 0x7fffffff) { |
1376
|
9
|
|
|
|
|
31
|
$term = "~\0\0\x06" . Set32u($len) . MIEGroupFormat(1) . "\x04"; |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
} |
1379
|
43
|
50
|
|
|
|
103
|
Write($outfile, $term) or $err = 1; |
1380
|
|
|
|
|
|
|
} |
1381
|
45
|
|
|
|
|
78
|
last; |
1382
|
|
|
|
|
|
|
} |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
# descend into existing uncompressed MIE group |
1385
|
92
|
100
|
66
|
|
|
239
|
if ($format == 0x10 or $format == 0x18) { |
1386
|
23
|
|
|
|
|
33
|
my ($subTablePtr, $dirName); |
1387
|
23
|
|
|
|
|
64
|
my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag); |
1388
|
23
|
50
|
33
|
|
|
107
|
if ($tagInfo and $$tagInfo{SubDirectory}) { |
1389
|
23
|
|
|
|
|
47
|
$dirName = $tagInfo->{SubDirectory}->{DirName}; |
1390
|
23
|
|
|
|
|
61
|
my $subTable = $tagInfo->{SubDirectory}->{TagTable}; |
1391
|
23
|
50
|
|
|
|
69
|
$subTablePtr = $subTable ? GetTagTable($subTable) : $tagTablePtr; |
1392
|
|
|
|
|
|
|
} else { |
1393
|
0
|
|
|
|
|
0
|
$subTablePtr = GetTagTable('Image::ExifTool::MIE::Unknown'); |
1394
|
|
|
|
|
|
|
} |
1395
|
23
|
|
|
|
|
88
|
my $hdr = '~' . chr($format) . chr(length $tag) . "\0" . $tag; |
1396
|
|
|
|
|
|
|
my %subdirInfo = ( |
1397
|
|
|
|
|
|
|
DirName => $dirName || $tag, |
1398
|
|
|
|
|
|
|
RAF => $raf, |
1399
|
|
|
|
|
|
|
ToWrite => $toWrite . $hdr, |
1400
|
|
|
|
|
|
|
OutFile => $outfile, |
1401
|
|
|
|
|
|
|
Parent => $dirName, |
1402
|
|
|
|
|
|
|
IsCompressed => $$dirInfo{IsCompressed}, |
1403
|
23
|
|
33
|
|
|
154
|
); |
1404
|
23
|
|
|
|
|
68
|
my $oldOrder = GetByteOrder(); |
1405
|
23
|
50
|
|
|
|
87
|
SetByteOrder($format & 0x08 ? 'II' : 'MM'); |
1406
|
23
|
|
|
|
|
267
|
$msg = WriteMIEGroup($et, \%subdirInfo, $subTablePtr); |
1407
|
23
|
|
|
|
|
73
|
SetByteOrder($oldOrder); |
1408
|
23
|
50
|
|
|
|
48
|
last if $msg; |
1409
|
23
|
50
|
|
|
|
48
|
if (defined $msg) { |
1410
|
0
|
|
|
|
|
0
|
undef $msg; # no problem if nothing written |
1411
|
|
|
|
|
|
|
} else { |
1412
|
23
|
|
|
|
|
37
|
$toWrite = ''; |
1413
|
|
|
|
|
|
|
} |
1414
|
23
|
|
|
|
|
66
|
next; |
1415
|
|
|
|
|
|
|
} |
1416
|
|
|
|
|
|
|
# just copy existing element |
1417
|
69
|
|
|
|
|
90
|
my $oldVal; |
1418
|
69
|
50
|
|
|
|
134
|
$raf->Read($oldVal, $valLen) == $valLen or last; |
1419
|
69
|
100
|
|
|
|
115
|
if ($toWrite) { |
1420
|
15
|
50
|
|
|
|
49
|
Write($outfile, $toWrite) or $err = 1; |
1421
|
15
|
|
|
|
|
36
|
$toWrite = ''; |
1422
|
|
|
|
|
|
|
} |
1423
|
69
|
50
|
|
|
|
135
|
Write($outfile, $oldHdr, $oldVal) or $err = 1; |
1424
|
|
|
|
|
|
|
} |
1425
|
|
|
|
|
|
|
# return error message |
1426
|
45
|
50
|
33
|
|
|
208
|
if ($err) { |
|
|
50
|
66
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1427
|
0
|
|
|
|
|
0
|
$msg = 'Error writing file'; |
1428
|
|
|
|
|
|
|
} elsif (not $ok and not $msg) { |
1429
|
0
|
|
|
|
|
0
|
$msg = 'Unexpected end of file'; |
1430
|
|
|
|
|
|
|
} elsif (not $msg and $toWrite) { |
1431
|
2
|
|
|
|
|
4
|
$msg = ''; # flag for nothing written |
1432
|
2
|
50
|
|
|
|
7
|
$verbose and print $out "Deleted $grp1 (empty)\n"; |
1433
|
|
|
|
|
|
|
} |
1434
|
45
|
|
|
|
|
241
|
return $msg; |
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1438
|
|
|
|
|
|
|
# Process MIE directory |
1439
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref |
1440
|
|
|
|
|
|
|
# Returns: undef on success, or error message if there was a problem |
1441
|
|
|
|
|
|
|
# Notes: file pointer is positioned at the MIE end on entry |
1442
|
|
|
|
|
|
|
sub ProcessMIEGroup($$$) |
1443
|
|
|
|
|
|
|
{ |
1444
|
139
|
|
|
139
|
0
|
286
|
my ($et, $dirInfo, $tagTablePtr) = @_; |
1445
|
139
|
|
|
|
|
247
|
my $raf = $$dirInfo{RAF}; |
1446
|
139
|
|
|
|
|
407
|
my $verbose = $et->Options('Verbose'); |
1447
|
139
|
|
|
|
|
297
|
my $out = $et->Options('TextOut'); |
1448
|
139
|
|
|
|
|
335
|
my $notUTF8 = ($$et{OPTIONS}{Charset} ne 'UTF8'); |
1449
|
139
|
|
|
|
|
264
|
my ($msg, $buff, $ok, $oldIndent, $mime); |
1450
|
139
|
|
|
|
|
221
|
my $lastTag = ''; |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
# get group 1 names: $grp doesn't have numbers (eg. 'MIE-Doc'), |
1453
|
|
|
|
|
|
|
# and $grp1 does (eg. 'MIE1-Doc1') |
1454
|
139
|
|
|
|
|
228
|
my $cnt = $$et{MIE_COUNT}; |
1455
|
139
|
|
|
|
|
359
|
my $grp1 = $tagTablePtr->{GROUPS}->{1}; |
1456
|
139
|
|
100
|
|
|
382
|
my $n = $$cnt{'MIE-Main'} || 0; |
1457
|
139
|
100
|
|
|
|
299
|
if ($grp1 eq 'MIE-Main') { |
1458
|
27
|
|
|
|
|
85
|
$$cnt{$grp1} = ++$n; |
1459
|
27
|
50
|
|
|
|
91
|
$grp1 =~ s/MIE-/MIE$n-/ if $n > 1; |
1460
|
|
|
|
|
|
|
} else { |
1461
|
112
|
50
|
|
|
|
266
|
$grp1 =~ s/MIE-/MIE$n-/ if $n > 1; |
1462
|
112
|
|
50
|
|
|
488
|
$$cnt{$grp1} = ($$cnt{$grp1} || 0) + 1; |
1463
|
112
|
50
|
|
|
|
299
|
$grp1 .= $$cnt{$grp1} if $$cnt{$grp1} > 1; |
1464
|
|
|
|
|
|
|
} |
1465
|
|
|
|
|
|
|
# set group1 name for all tags extracted from this group |
1466
|
139
|
|
|
|
|
256
|
$$et{SET_GROUP1} = $grp1; |
1467
|
|
|
|
|
|
|
|
1468
|
139
|
50
|
|
|
|
274
|
if ($verbose) { |
1469
|
0
|
|
|
|
|
0
|
$oldIndent = $$et{INDENT}; |
1470
|
0
|
|
|
|
|
0
|
$$et{INDENT} .= '| '; |
1471
|
0
|
|
|
|
|
0
|
$et->VerboseDir($grp1); |
1472
|
|
|
|
|
|
|
} |
1473
|
139
|
|
|
|
|
214
|
my $wasCompressed = $$dirInfo{WasCompressed}; |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
# process all MIE elements |
1476
|
139
|
|
|
|
|
170
|
for (;;) { |
1477
|
743
|
50
|
|
|
|
1703
|
$raf->Read($buff, 4) == 4 or last; |
1478
|
743
|
|
|
|
|
2364
|
my ($sync, $format, $tagLen, $valLen) = unpack('aC3', $buff); |
1479
|
743
|
50
|
|
|
|
1469
|
$sync eq '~' or $msg = 'Invalid sync byte', last; |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
# read tag name |
1482
|
743
|
|
|
|
|
955
|
my ($tag, $units); |
1483
|
743
|
100
|
|
|
|
1070
|
if ($tagLen) { |
1484
|
604
|
50
|
|
|
|
1101
|
$raf->Read($tag, $tagLen) == $tagLen or last; |
1485
|
604
|
50
|
|
|
|
1064
|
$et->Warn("MIE tag '${tag}' out of sequence") if $tag lt $lastTag; |
1486
|
604
|
|
|
|
|
773
|
$lastTag = $tag; |
1487
|
|
|
|
|
|
|
# separate units from tag name if they exist |
1488
|
604
|
100
|
|
|
|
1247
|
$units = $1 if $tag =~ s/\((.*)\)$//; |
1489
|
|
|
|
|
|
|
} else { |
1490
|
139
|
|
|
|
|
222
|
$tag = ''; |
1491
|
|
|
|
|
|
|
} |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
# get multi-byte value length if necessary |
1494
|
743
|
100
|
|
|
|
1274
|
if ($valLen > 252) { |
1495
|
3
|
|
|
|
|
9
|
my $n = 1 << (256 - $valLen); |
1496
|
3
|
50
|
|
|
|
10
|
$raf->Read($buff, $n) == $n or last; |
1497
|
3
|
|
|
|
|
12
|
my $fmt = 'int' . ($n * 8) . 'u'; |
1498
|
3
|
|
|
|
|
13
|
$valLen = ReadValue(\$buff, 0, $fmt, 1, $n); |
1499
|
3
|
50
|
|
|
|
12
|
if ($valLen > 0x7fffffff) { |
1500
|
0
|
|
|
|
|
0
|
$msg = "Can't read $tag (DataLength > 2GB not yet supported)"; |
1501
|
0
|
|
|
|
|
0
|
last; |
1502
|
|
|
|
|
|
|
} |
1503
|
|
|
|
|
|
|
} |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
# all done if we reached the group terminator |
1506
|
743
|
100
|
|
|
|
1145
|
unless ($tagLen) { |
1507
|
|
|
|
|
|
|
# skip over terminator data block |
1508
|
139
|
50
|
66
|
|
|
448
|
$ok = 1 unless $valLen and not $raf->Seek($valLen, 1); |
1509
|
139
|
|
|
|
|
218
|
last; |
1510
|
|
|
|
|
|
|
} |
1511
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
# get tag information hash unless this is free space |
1513
|
604
|
|
|
|
|
803
|
my ($tagInfo, $value); |
1514
|
604
|
|
|
|
|
1025
|
while ($format != 0x80) { |
1515
|
604
|
|
|
|
|
1309
|
$tagInfo = $et->GetTagInfo($tagTablePtr, $tag); |
1516
|
604
|
100
|
|
|
|
1198
|
last if $tagInfo; |
1517
|
|
|
|
|
|
|
# extract tags with locale code |
1518
|
36
|
50
|
|
|
|
140
|
if ($tag =~ /\W/) { |
1519
|
36
|
50
|
|
|
|
144
|
if ($tag =~ /^(\w+)-([a-z]{2}_[A-Z]{2})$/) { |
1520
|
36
|
|
|
|
|
102
|
my ($baseTag, $langCode) = ($1, $2); |
1521
|
36
|
|
|
|
|
71
|
$tagInfo = $et->GetTagInfo($tagTablePtr, $baseTag); |
1522
|
36
|
50
|
|
|
|
101
|
$tagInfo = GetLangInfo($tagInfo, $langCode) if $tagInfo; |
1523
|
36
|
50
|
|
|
|
86
|
last if $tagInfo; |
1524
|
|
|
|
|
|
|
} else { |
1525
|
0
|
|
|
|
|
0
|
$et->Warn('Invalid MIE tag name'); |
1526
|
0
|
|
|
|
|
0
|
last; |
1527
|
|
|
|
|
|
|
} |
1528
|
|
|
|
|
|
|
} |
1529
|
|
|
|
|
|
|
# extract unknown tags if specified |
1530
|
|
|
|
|
|
|
$tagInfo = { |
1531
|
0
|
|
|
|
|
0
|
Name => $tag, |
1532
|
|
|
|
|
|
|
Writable => 0, |
1533
|
|
|
|
|
|
|
PrintConv => 'length($val) > 60 ? substr($val,0,55) . "[...]" : $val', |
1534
|
|
|
|
|
|
|
}; |
1535
|
0
|
|
|
|
|
0
|
AddTagToTable($tagTablePtr, $tag, $tagInfo); |
1536
|
0
|
|
|
|
|
0
|
last; |
1537
|
|
|
|
|
|
|
} |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
# read value and uncompress if necessary |
1540
|
604
|
|
50
|
|
|
1615
|
my $formatStr = $mieFormat{$format & 0xfb} || 'undef'; |
1541
|
604
|
50
|
0
|
|
|
1149
|
if ($tagInfo or ($formatStr eq 'MIE' and $format & 0x04)) { |
|
|
|
33
|
|
|
|
|
1542
|
604
|
50
|
|
|
|
1153
|
$raf->Read($value, $valLen) == $valLen or last; |
1543
|
604
|
50
|
|
|
|
1085
|
if ($format & 0x04) { |
1544
|
0
|
0
|
|
|
|
0
|
if ($verbose) { |
1545
|
0
|
|
|
|
|
0
|
print $out "$$et{INDENT}\[Tag '${tag}' $valLen bytes compressed]\n"; |
1546
|
|
|
|
|
|
|
} |
1547
|
0
|
0
|
|
|
|
0
|
next unless HasZlib($et, 'decode'); |
1548
|
0
|
|
|
|
|
0
|
my $stat; |
1549
|
0
|
|
|
|
|
0
|
my $inflate = Compress::Zlib::inflateInit(); |
1550
|
0
|
0
|
|
|
|
0
|
$inflate and ($value, $stat) = $inflate->inflate($value); |
1551
|
0
|
0
|
0
|
|
|
0
|
unless ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) { |
1552
|
0
|
|
|
|
|
0
|
$et->Warn("Error inflating $tag"); |
1553
|
0
|
|
|
|
|
0
|
next; |
1554
|
|
|
|
|
|
|
} |
1555
|
0
|
|
|
|
|
0
|
$valLen = length $value; |
1556
|
0
|
|
|
|
|
0
|
$wasCompressed = 1; |
1557
|
|
|
|
|
|
|
} |
1558
|
|
|
|
|
|
|
} |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
# process this tag |
1561
|
604
|
100
|
|
|
|
982
|
if ($formatStr eq 'MIE') { |
1562
|
|
|
|
|
|
|
# process MIE directory |
1563
|
112
|
|
|
|
|
184
|
my ($subTablePtr, $dirName); |
1564
|
112
|
50
|
33
|
|
|
392
|
if ($tagInfo and $$tagInfo{SubDirectory}) { |
1565
|
112
|
|
|
|
|
241
|
$dirName = $tagInfo->{SubDirectory}->{DirName}; |
1566
|
112
|
|
|
|
|
223
|
my $subTable = $tagInfo->{SubDirectory}->{TagTable}; |
1567
|
112
|
50
|
|
|
|
386
|
$subTablePtr = $subTable ? GetTagTable($subTable) : $tagTablePtr; |
1568
|
|
|
|
|
|
|
} else { |
1569
|
0
|
|
|
|
|
0
|
$subTablePtr = GetTagTable('Image::ExifTool::MIE::Unknown'); |
1570
|
|
|
|
|
|
|
} |
1571
|
112
|
50
|
|
|
|
266
|
if ($verbose) { |
1572
|
0
|
|
|
|
|
0
|
my $order = ', byte order ' . GetByteOrder(); |
1573
|
0
|
|
|
|
|
0
|
$et->VerboseInfo($tag, $tagInfo, Size => $valLen, Extra => $order); |
1574
|
|
|
|
|
|
|
} |
1575
|
|
|
|
|
|
|
my %subdirInfo = ( |
1576
|
|
|
|
|
|
|
DirName => $dirName || $tag, |
1577
|
|
|
|
|
|
|
RAF => $raf, |
1578
|
|
|
|
|
|
|
Parent => $$dirInfo{DirName}, |
1579
|
112
|
|
33
|
|
|
646
|
WasCompressed => $wasCompressed, |
1580
|
|
|
|
|
|
|
); |
1581
|
|
|
|
|
|
|
# read from uncompressed data instead if necessary |
1582
|
112
|
50
|
|
|
|
287
|
$subdirInfo{RAF} = new File::RandomAccess(\$value) if $valLen; |
1583
|
|
|
|
|
|
|
|
1584
|
112
|
|
|
|
|
262
|
my $oldOrder = GetByteOrder(); |
1585
|
112
|
50
|
|
|
|
394
|
SetByteOrder($format & 0x08 ? 'II' : 'MM'); |
1586
|
112
|
|
|
|
|
546
|
$msg = ProcessMIEGroup($et, \%subdirInfo, $subTablePtr); |
1587
|
112
|
|
|
|
|
330
|
SetByteOrder($oldOrder); |
1588
|
112
|
|
|
|
|
201
|
$$et{SET_GROUP1} = $grp1; # restore this group1 name |
1589
|
112
|
50
|
|
|
|
389
|
last if $msg; |
1590
|
|
|
|
|
|
|
} else { |
1591
|
|
|
|
|
|
|
# process MIE data format types |
1592
|
492
|
50
|
|
|
|
735
|
if ($tagInfo) { |
1593
|
492
|
|
|
|
|
586
|
my $rational; |
1594
|
|
|
|
|
|
|
# extract tag value |
1595
|
492
|
|
|
|
|
998
|
my $val = ReadMIEValue(\$value, 0, $formatStr, undef, $valLen, \$rational); |
1596
|
492
|
50
|
|
|
|
893
|
unless (defined $val) { |
1597
|
0
|
|
|
|
|
0
|
$et->Warn("Error reading $tag value"); |
1598
|
0
|
|
|
|
|
0
|
$val = ''; |
1599
|
|
|
|
|
|
|
} |
1600
|
|
|
|
|
|
|
# save type or mime type |
1601
|
492
|
100
|
100
|
|
|
1423
|
$mime = $val if $tag eq '0Type' or $tag eq '2MIME'; |
1602
|
492
|
50
|
|
|
|
799
|
if ($verbose) { |
1603
|
0
|
|
|
|
|
0
|
my $count; |
1604
|
0
|
|
|
|
|
0
|
my $s = Image::ExifTool::FormatSize($formatStr); |
1605
|
0
|
0
|
0
|
|
|
0
|
if ($s and $formatStr !~ /^(utf|string|undef)/) { |
1606
|
0
|
|
|
|
|
0
|
$count = $valLen / $s; |
1607
|
|
|
|
|
|
|
} |
1608
|
0
|
0
|
|
|
|
0
|
$et->VerboseInfo($lastTag, $tagInfo, |
1609
|
|
|
|
|
|
|
DataPt => \$value, |
1610
|
|
|
|
|
|
|
DataPos => $wasCompressed ? undef : $raf->Tell() - $valLen, |
1611
|
|
|
|
|
|
|
Size => $valLen, |
1612
|
|
|
|
|
|
|
Format => $formatStr, |
1613
|
|
|
|
|
|
|
Value => $val, |
1614
|
|
|
|
|
|
|
Count => $count, |
1615
|
|
|
|
|
|
|
); |
1616
|
|
|
|
|
|
|
} |
1617
|
492
|
100
|
|
|
|
835
|
if ($$tagInfo{SubDirectory}) { |
1618
|
5
|
|
|
|
|
21
|
my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable}); |
1619
|
|
|
|
|
|
|
my %subdirInfo = ( |
1620
|
|
|
|
|
|
|
DirName => $$tagInfo{Name}, |
1621
|
|
|
|
|
|
|
DataPt => \$value, |
1622
|
|
|
|
|
|
|
DataLen => $valLen, |
1623
|
|
|
|
|
|
|
DirStart=> 0, |
1624
|
|
|
|
|
|
|
DirLen => $valLen, |
1625
|
|
|
|
|
|
|
Parent => $$dirInfo{DirName}, |
1626
|
5
|
|
|
|
|
39
|
WasCompressed => $wasCompressed, |
1627
|
|
|
|
|
|
|
); |
1628
|
|
|
|
|
|
|
# set DataPos and Base for uncompressed information only |
1629
|
5
|
50
|
|
|
|
15
|
unless ($wasCompressed) { |
1630
|
5
|
|
|
|
|
25
|
$subdirInfo{DataPos} = 0; # (relative to Base) |
1631
|
5
|
|
|
|
|
20
|
$subdirInfo{Base} = $raf->Tell() - $valLen; |
1632
|
|
|
|
|
|
|
} |
1633
|
|
|
|
|
|
|
# reset PROCESSED lookup for each MIE directory |
1634
|
|
|
|
|
|
|
# (there is no possibility of double-processing a MIE directory) |
1635
|
5
|
|
|
|
|
62
|
$$et{PROCESSED} = { }; |
1636
|
5
|
|
|
|
|
13
|
my $processProc = $tagInfo->{SubDirectory}->{ProcessProc}; |
1637
|
5
|
|
|
|
|
10
|
delete $$et{SET_GROUP1}; |
1638
|
5
|
|
|
|
|
9
|
delete $$et{NO_LIST}; |
1639
|
5
|
|
|
|
|
23
|
$et->ProcessDirectory(\%subdirInfo, $subTablePtr, $processProc); |
1640
|
5
|
|
|
|
|
13
|
$$et{SET_GROUP1} = $grp1; |
1641
|
5
|
|
|
|
|
24
|
$$et{NO_LIST} = 1; |
1642
|
|
|
|
|
|
|
} else { |
1643
|
|
|
|
|
|
|
# convert to specified character set if necessary |
1644
|
487
|
100
|
100
|
|
|
1268
|
if ($notUTF8 and $formatStr =~ /^(utf|string)/) { |
1645
|
117
|
|
|
|
|
303
|
$val = $et->Decode($val, 'UTF8'); |
1646
|
|
|
|
|
|
|
} |
1647
|
487
|
100
|
|
|
|
945
|
if ($formatStr =~ /_list$/) { |
1648
|
|
|
|
|
|
|
# split list value into separate strings |
1649
|
8
|
|
|
|
|
50
|
my @vals = split "\0", $val; |
1650
|
8
|
|
|
|
|
22
|
$val = \@vals; |
1651
|
|
|
|
|
|
|
} |
1652
|
487
|
100
|
|
|
|
783
|
if (defined $units) { |
1653
|
8
|
50
|
|
|
|
28
|
$val = "@$val" if ref $val; # convert string list to number list |
1654
|
|
|
|
|
|
|
# add units to value if specified |
1655
|
8
|
50
|
|
|
|
50
|
$val .= "($units)" if defined $units; |
1656
|
|
|
|
|
|
|
} |
1657
|
487
|
|
|
|
|
1127
|
my $key = $et->FoundTag($tagInfo, $val); |
1658
|
487
|
100
|
66
|
|
|
1387
|
$$et{RATIONAL}{$key} = $rational if defined $rational and defined $key; |
1659
|
|
|
|
|
|
|
} |
1660
|
|
|
|
|
|
|
} else { |
1661
|
|
|
|
|
|
|
# skip over unknown information or free bytes |
1662
|
0
|
0
|
|
|
|
0
|
$raf->Seek($valLen, 1) or $msg = 'Seek error', last; |
1663
|
0
|
0
|
|
|
|
0
|
$verbose and $et->VerboseInfo($tag, undef, Size => $valLen); |
1664
|
|
|
|
|
|
|
} |
1665
|
|
|
|
|
|
|
} |
1666
|
|
|
|
|
|
|
} |
1667
|
|
|
|
|
|
|
# modify MIME type if necessary |
1668
|
139
|
100
|
66
|
|
|
374
|
$mime and not $$dirInfo{Parent} and $et->ModifyMimeType($mime); |
1669
|
|
|
|
|
|
|
|
1670
|
139
|
50
|
33
|
|
|
297
|
$ok or $msg or $msg = 'Unexpected end of file'; |
1671
|
139
|
50
|
|
|
|
272
|
$verbose and $$et{INDENT} = $oldIndent; |
1672
|
139
|
|
|
|
|
308
|
return $msg; |
1673
|
|
|
|
|
|
|
} |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
1676
|
|
|
|
|
|
|
# Read/write a MIE file |
1677
|
|
|
|
|
|
|
# Inputs: 0) ExifTool object reference, 1) DirInfo reference |
1678
|
|
|
|
|
|
|
# Returns: 1 on success, 0 if this wasn't a valid MIE file, or -1 on write error |
1679
|
|
|
|
|
|
|
# - process as a trailer if "Trailer" flag set in dirInfo |
1680
|
|
|
|
|
|
|
sub ProcessMIE($$) |
1681
|
|
|
|
|
|
|
{ |
1682
|
692
|
|
|
692
|
0
|
1559
|
my ($et, $dirInfo) = @_; |
1683
|
692
|
100
|
|
|
|
2637
|
return 1 unless defined $et; |
1684
|
36
|
|
|
|
|
104
|
my $raf = $$dirInfo{RAF}; |
1685
|
36
|
|
|
|
|
78
|
my $outfile = $$dirInfo{OutFile}; |
1686
|
36
|
|
|
|
|
94
|
my ($buff, $err, $msg, $pos, $end, $isCreating); |
1687
|
36
|
|
|
|
|
66
|
my $numDocs = 0; |
1688
|
|
|
|
|
|
|
# |
1689
|
|
|
|
|
|
|
# process as a trailer (from end of file) if specified |
1690
|
|
|
|
|
|
|
# |
1691
|
36
|
100
|
|
|
|
121
|
if ($$dirInfo{Trailer}) { |
1692
|
26
|
|
50
|
|
|
104
|
my $offset = $$dirInfo{Offset} || 0; # offset from end of file |
1693
|
26
|
50
|
|
|
|
107
|
$raf->Seek(-10 - $offset, 2) or return 0; |
1694
|
26
|
|
|
|
|
75
|
for (;;) { |
1695
|
|
|
|
|
|
|
# read and validate last 10 bytes |
1696
|
52
|
50
|
|
|
|
159
|
$raf->Read($buff, 10) == 10 or last; |
1697
|
52
|
100
|
66
|
|
|
434
|
last unless $buff =~ /~\0\0\x06.{4}(\x10|\x18)(\x04)$/s or |
1698
|
|
|
|
|
|
|
$buff =~ /(\x10|\x18)(\x08)$/s; |
1699
|
26
|
50
|
|
|
|
181
|
SetByteOrder($1 eq "\x10" ? 'MM' : 'II'); |
1700
|
26
|
50
|
|
|
|
190
|
my $len = ($2 eq "\x04") ? Get32u(\$buff, 4) : Get64u(\$buff, 0); |
1701
|
26
|
50
|
|
|
|
98
|
my $curPos = $raf->Tell() or last; |
1702
|
26
|
50
|
33
|
|
|
155
|
last if $len < 12 or $len > $curPos; |
1703
|
|
|
|
|
|
|
# validate element header if 8-byte offset was used |
1704
|
26
|
50
|
|
|
|
88
|
if ($2 eq "\x08") { |
1705
|
0
|
0
|
|
|
|
0
|
last if $len < 14; |
1706
|
0
|
0
|
0
|
|
|
0
|
$raf->Seek($curPos - 14, 0) and $raf->Read($buff, 4) or last; |
1707
|
0
|
0
|
|
|
|
0
|
last unless $buff eq "~\0\0\x0a"; |
1708
|
|
|
|
|
|
|
} |
1709
|
|
|
|
|
|
|
# looks like a good group, so remember start position |
1710
|
26
|
|
|
|
|
53
|
$pos = $curPos - $len; |
1711
|
26
|
50
|
|
|
|
81
|
$end = $curPos unless $end; |
1712
|
|
|
|
|
|
|
# seek to 10 bytes from end of previous group |
1713
|
26
|
50
|
|
|
|
82
|
$raf->Seek($pos - 10, 0) or last; |
1714
|
|
|
|
|
|
|
} |
1715
|
|
|
|
|
|
|
# seek to start of first MIE group |
1716
|
26
|
50
|
33
|
|
|
149
|
return 0 unless defined $pos and $raf->Seek($pos, 0); |
1717
|
|
|
|
|
|
|
# update DataPos and DirLen for ProcessTrailers() |
1718
|
26
|
|
|
|
|
80
|
$$dirInfo{DataPos} = $pos; |
1719
|
26
|
|
|
|
|
72
|
$$dirInfo{DirLen} = $end - $pos; |
1720
|
26
|
50
|
66
|
|
|
180
|
if ($outfile and $$et{DEL_GROUP}{MIE}) { |
|
|
50
|
33
|
|
|
|
|
1721
|
|
|
|
|
|
|
# delete the trailer |
1722
|
0
|
|
|
|
|
0
|
$et->VPrint(0," Deleting MIE trailer\n"); |
1723
|
0
|
|
|
|
|
0
|
++$$et{CHANGED}; |
1724
|
0
|
|
|
|
|
0
|
return 1; |
1725
|
|
|
|
|
|
|
} elsif ($et->Options('Verbose') or $$et{HTML_DUMP}) { |
1726
|
0
|
|
|
|
|
0
|
$et->DumpTrailer($dirInfo); |
1727
|
|
|
|
|
|
|
} |
1728
|
|
|
|
|
|
|
} |
1729
|
|
|
|
|
|
|
# |
1730
|
|
|
|
|
|
|
# loop through all documents in MIE file |
1731
|
|
|
|
|
|
|
# |
1732
|
36
|
|
|
|
|
80
|
for (;;) { |
1733
|
|
|
|
|
|
|
# look for "0MIE" group element |
1734
|
72
|
|
|
|
|
219
|
my $num = $raf->Read($buff, 8); |
1735
|
72
|
100
|
|
|
|
277
|
if ($num == 8) { |
|
|
100
|
|
|
|
|
|
1736
|
|
|
|
|
|
|
# verify file identifier |
1737
|
61
|
100
|
|
|
|
322
|
if ($buff =~ /^~(\x10|\x18)\x04(.)0MIE/s) { |
1738
|
35
|
50
|
|
|
|
226
|
SetByteOrder($1 eq "\x10" ? 'MM' : 'II'); |
1739
|
35
|
|
|
|
|
108
|
my $len = ord($2); |
1740
|
|
|
|
|
|
|
# skip extended DataLength if it exists |
1741
|
35
|
50
|
33
|
|
|
253
|
if ($len > 252 and not $raf->Seek(1 << (256 - $len), 1)) { |
1742
|
0
|
|
|
|
|
0
|
$msg = 'Seek error'; |
1743
|
0
|
|
|
|
|
0
|
last; |
1744
|
|
|
|
|
|
|
} |
1745
|
|
|
|
|
|
|
} else { |
1746
|
26
|
50
|
|
|
|
104
|
return 0 unless $numDocs; # not a MIE file |
1747
|
26
|
50
|
|
|
|
107
|
if ($buff =~ /^~/) { |
1748
|
0
|
|
|
|
|
0
|
$msg = 'Non-standard file-level MIE element'; |
1749
|
|
|
|
|
|
|
} else { |
1750
|
26
|
|
|
|
|
62
|
$msg = 'Invalid MIE file-level data'; |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
} |
1753
|
|
|
|
|
|
|
} elsif ($numDocs) { |
1754
|
10
|
50
|
|
|
|
40
|
last unless $num; # OK, all done with file |
1755
|
0
|
|
|
|
|
0
|
$msg = 'Truncated MIE element header'; |
1756
|
|
|
|
|
|
|
} else { |
1757
|
1
|
50
|
33
|
|
|
7
|
return 0 if $num or not $outfile; |
1758
|
|
|
|
|
|
|
# we have the ability to create a MIE file from scratch |
1759
|
1
|
|
|
|
|
2
|
$buff = ''; # start from nothing |
1760
|
|
|
|
|
|
|
# set byte order according to preferences |
1761
|
1
|
|
|
|
|
6
|
$et->SetPreferredByteOrder(); |
1762
|
1
|
|
|
|
|
3
|
$isCreating = 1; |
1763
|
|
|
|
|
|
|
} |
1764
|
62
|
100
|
|
|
|
200
|
if ($msg) { |
1765
|
26
|
50
|
|
|
|
102
|
last if $$dirInfo{Trailer}; # allow other trailers after MIE |
1766
|
0
|
0
|
|
|
|
0
|
if ($outfile) { |
1767
|
0
|
|
|
|
|
0
|
$et->Error($msg); |
1768
|
|
|
|
|
|
|
} else { |
1769
|
0
|
|
|
|
|
0
|
$et->Warn($msg); |
1770
|
|
|
|
|
|
|
} |
1771
|
0
|
|
|
|
|
0
|
last; |
1772
|
|
|
|
|
|
|
} |
1773
|
|
|
|
|
|
|
# this is a new MIE document -- increment document count |
1774
|
36
|
50
|
|
|
|
543
|
unless ($numDocs) { |
1775
|
|
|
|
|
|
|
# this is a valid MIE file (unless a trailer on another file) |
1776
|
36
|
|
|
|
|
194
|
$et->SetFileType(); |
1777
|
36
|
|
|
|
|
118
|
$$et{NO_LIST} = 1; # handle lists ourself |
1778
|
36
|
|
|
|
|
109
|
$$et{MIE_COUNT} = { }; |
1779
|
36
|
|
|
|
|
88
|
undef $hasZlib; |
1780
|
|
|
|
|
|
|
} |
1781
|
36
|
|
|
|
|
73
|
++$numDocs; |
1782
|
|
|
|
|
|
|
|
1783
|
|
|
|
|
|
|
# process the MIE groups recursively, beginning with the main MIE group |
1784
|
36
|
|
|
|
|
337
|
my $tagTablePtr = GetTagTable('Image::ExifTool::MIE::Main'); |
1785
|
|
|
|
|
|
|
|
1786
|
36
|
|
|
|
|
212
|
my %subdirInfo = ( |
1787
|
|
|
|
|
|
|
DirName => 'MIE', |
1788
|
|
|
|
|
|
|
RAF => $raf, |
1789
|
|
|
|
|
|
|
OutFile => $outfile, |
1790
|
|
|
|
|
|
|
# don't define Parent so WriteMIEGroup() writes extended terminator |
1791
|
|
|
|
|
|
|
); |
1792
|
36
|
100
|
|
|
|
117
|
if ($outfile) { |
1793
|
|
|
|
|
|
|
# generate lookup for MIE format codes if not done already |
1794
|
9
|
100
|
|
|
|
33
|
unless (%mieCode) { |
1795
|
3
|
|
|
|
|
41
|
foreach (keys %mieFormat) { |
1796
|
90
|
|
|
|
|
182
|
$mieCode{$mieFormat{$_}} = $_; |
1797
|
|
|
|
|
|
|
} |
1798
|
|
|
|
|
|
|
} |
1799
|
|
|
|
|
|
|
# update %mieMap with user-defined MIE groups |
1800
|
9
|
100
|
|
|
|
51
|
UpdateMieMap() unless $doneMieMap; |
1801
|
|
|
|
|
|
|
# initialize write directories, with MIE tags taking priority |
1802
|
|
|
|
|
|
|
# (note that this may re-initialize directories when writing trailer |
1803
|
|
|
|
|
|
|
# to another type of image, but this is OK because we are done writing |
1804
|
|
|
|
|
|
|
# the other format by the time we start writing the trailer) |
1805
|
9
|
|
|
|
|
43
|
$et->InitWriteDirs(\%mieMap, 'MIE'); |
1806
|
9
|
|
|
|
|
47
|
$subdirInfo{ToWrite} = '~' . MIEGroupFormat(1) . "\x04\xfe0MIE\0\0\0\0"; |
1807
|
9
|
|
|
|
|
46
|
$msg = WriteMIEGroup($et, \%subdirInfo, $tagTablePtr); |
1808
|
9
|
50
|
33
|
|
|
65
|
if ($msg) { |
|
|
50
|
|
|
|
|
|
1809
|
0
|
|
|
|
|
0
|
$et->Error($msg); |
1810
|
0
|
|
|
|
|
0
|
$err = 1; |
1811
|
0
|
|
|
|
|
0
|
last; |
1812
|
|
|
|
|
|
|
} elsif (defined $msg and $isCreating) { |
1813
|
0
|
|
|
|
|
0
|
last; |
1814
|
|
|
|
|
|
|
} |
1815
|
|
|
|
|
|
|
} else { |
1816
|
27
|
|
|
|
|
123
|
$msg = ProcessMIEGroup($et, \%subdirInfo, $tagTablePtr); |
1817
|
27
|
50
|
|
|
|
128
|
if ($msg) { |
1818
|
0
|
|
|
|
|
0
|
$et->Warn($msg); |
1819
|
0
|
|
|
|
|
0
|
last; |
1820
|
|
|
|
|
|
|
} |
1821
|
|
|
|
|
|
|
} |
1822
|
|
|
|
|
|
|
} |
1823
|
36
|
|
|
|
|
104
|
delete $$et{NO_LIST}; |
1824
|
36
|
|
|
|
|
131
|
delete $$et{MIE_COUNT}; |
1825
|
36
|
|
|
|
|
73
|
delete $$et{SET_GROUP1}; |
1826
|
36
|
50
|
|
|
|
167
|
return $err ? -1 : 1; |
1827
|
|
|
|
|
|
|
} |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
1; # end |
1830
|
|
|
|
|
|
|
|
1831
|
|
|
|
|
|
|
__END__ |