File Coverage

blib/lib/Image/ExifTool/MIE.pm
Criterion Covered Total %
statement 423 624 67.7
branch 241 498 48.3
condition 84 214 39.2
subroutine 13 14 92.8
pod 0 9 0.0
total 761 1359 56.0


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