File Coverage

blib/lib/Image/ExifTool/MIE.pm
Criterion Covered Total %
statement 422 623 67.7
branch 241 498 48.3
condition 84 214 39.2
subroutine 13 14 92.8
pod 0 9 0.0
total 760 1358 55.9


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__