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