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   5009 use strict;
  38         102  
  38         1478  
12 38     38   231 use vars qw($VERSION %tableDefaults);
  38         502  
  38         2190  
13 38     38   259 use Image::ExifTool qw(:DataAccess :Utils);
  38         88  
  38         9006  
14 38     38   1596 use Image::ExifTool::Exif;
  38         154  
  38         1042  
15 38     38   7396 use Image::ExifTool::GPS;
  38         115  
  38         335902  
16              
17             $VERSION = '1.50';
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             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       23 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 155 my ($tagInfo, $langCode) = @_;
805             # check for properly formatted language code
806 58 100       247 return undef unless $langCode =~ /^[a-z]{2}([-_])[A-Z]{2}$/;
807             # use '_' as a separator, but recognize '_' or '-'
808 48 50       125 $langCode =~ tr/-/_/ if $1 eq '-';
809             # can only set locale on string types
810 48 50 33     127 return undef if $$tagInfo{Writable} and $$tagInfo{Writable} ne 'string';
811 48         160 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 31     31 0 57 my $chr = shift;
837 31 50       99 my $format = GetByteOrder() eq 'MM' ? 0x10 : 0x18;
838 31 50       189 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 492     492 0 1102 my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_;
852 492         732 my $val;
853 492 100       1892 if ($format =~ /^(utf(8|16|32)|string)/) {
854 332 100 100     1514 if ($1 eq 'utf8' or $1 eq 'string') {
855             # read the 8-bit string
856 308         773 $val = substr($$dataPt, $offset, $size);
857             # (as of ExifTool 7.62, leave string values unconverted)
858             } else {
859             # convert to UTF8
860 24         37 my $fmt;
861 24 50       67 if (GetByteOrder() eq 'MM') {
862 24 50       70 $fmt = ($1 eq 'utf16') ? 'n' : 'N';
863             } else {
864 0 0       0 $fmt = ($1 eq 'utf16') ? 'v' : 'V';
865             }
866 24         204 my @unpk = unpack("x$offset$fmt$size",$$dataPt);
867 24 50       74 if ($] >= 5.006001) {
868 24         154 $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       999 $val =~ s/\0.*//s unless $format =~ /_list$/;
876             } else {
877 160 50       422 $format = 'undef' if $format eq 'free'; # read 'free' as 'undef'
878 160         488 return ReadValue($dataPt, $offset, $format, $count, $size, $ratPt);
879             }
880 332         737 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 543     543 0 1645 my ($et, $tagInfo, $valPtr) = @_;
890 543   66     2705 my $format = $$tagInfo{Writable} || $tagInfo->{Table}->{WRITABLE};
891 543         1021 my $err;
892              
893 543 50 33     2733 return 'No writable format' if not $format or $format eq '1';
894             # handle units if supported by this tag
895 543         1261 my $ulist = $$tagInfo{Units};
896 543 100 100     4996 if ($ulist and $$valPtr =~ /(.*)\((.*)\)$/) {
    100 100        
897 1         7 my ($val, $units) = ($1, $2);
898 1         20 ($units) = grep /^$units$/i, @$ulist;
899 1 50       7 defined $units or return 'Allowed units: (' . join('|', @$ulist) . ')';
900 1         5 $err = Image::ExifTool::CheckValue(\$val, $format, $$tagInfo{Count});
901             # add units back onto value
902 1 50       8 $$valPtr = "$val($units)" unless $err;
903             } elsif ($format !~ /^(utf|string|undef)/ and $$valPtr =~ /\)$/) {
904 7         36 return 'Units not supported';
905             } else {
906 535 50 66     3253 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 535         2874 $err = Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count});
913             }
914 536         2041 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 45     45 0 117 my ($et, $dirInfo, $tagTablePtr) = @_;
924 45         104 my $outfile = $$dirInfo{OutFile};
925 45         91 my $dirName = $$dirInfo{DirName};
926 45   50     141 my $toWrite = $$dirInfo{ToWrite} || '';
927 45         86 my $raf = $$dirInfo{RAF};
928 45         148 my $verbose = $et->Options('Verbose');
929 45         123 my $optCompress = $et->Options('Compress');
930 45         125 my $out = $et->Options('TextOut');
931 45         102 my ($msg, $err, $ok, $sync, $delGroup);
932 45         79 my $tag = '';
933 45         84 my $deletedTag = '';
934              
935             # count each MIE directory found and make name for this specific instance
936 45         78 my ($grp1, %isWriting);
937 45         85 my $cnt = $$et{MIE_COUNT};
938 45         155 my $grp = $tagTablePtr->{GROUPS}->{1};
939 45   100     164 my $n = $$cnt{'MIE-Main'} || 0;
940 45 100       113 if ($grp eq 'MIE-Main') {
941 9         33 $$cnt{$grp} = ++$n;
942 9         113 ($grp1 = $grp) =~ s/MIE-/MIE$n-/;
943             } else {
944 36         283 ($grp1 = $grp) =~ s/MIE-/MIE$n-/;
945 36   50     228 my $m = $$cnt{$grp1} = ($$cnt{$grp1} || 0) + 1;
946 36         139 $isWriting{"$grp$m"} = 1; # eg. 'MIE-Doc2'
947 36         75 $isWriting{$grp1} = 1; # eg. 'MIE1-Doc'
948 36         84 $grp1 .= $m;
949             }
950             # build lookup for all valid group names for this MIE group
951 45         134 $isWriting{$grp} = 1; # eg. 'MIE-Doc'
952 45         131 $isWriting{$grp1} = 1; # eg. 'MIE1-Doc2'
953 45         114 $isWriting{"MIE$n"} = 1; # eg. 'MIE1'
954              
955             # determine if we are deleting this group
956 45 100       71 if (%{$$et{DEL_GROUP}}) {
  45         152  
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     100 $$et{DEL_GROUP}{"MIE$n"};
      33        
      33        
961             }
962              
963             # prepare lookups and lists for writing
964 45         174 my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
965 45         178 my ($addDirs, $editDirs) = $et->GetAddDirHash($tagTablePtr, $dirName);
966 45         319 my @editTags = sort keys %$newTags, keys %$editDirs;
967 45 0       171 $verbose and print $out $raf ? 'Writing' : 'Creating', " $grp1:\n";
    50          
968              
969             # loop through elements in MIE group
970 45         74 MieElement: for (;;) {
971 138         256 my ($format, $tagLen, $valLen, $units, $oldHdr, $buff);
972 138         220 my $lastTag = $tag;
973 138 100       296 if ($raf) {
974             # read first 4 bytes of element header
975 125         360 my $n = $raf->Read($oldHdr, 4);
976 125 100       294 if ($n != 4) {
977 1 50 33     10 last if $n or defined $sync;
978 1         3 undef $raf; # all done reading
979 1         3 $ok = 1;
980             }
981             }
982 138 100       285 if ($raf) {
983 124         406 ($sync, $format, $tagLen, $valLen) = unpack('aC3', $oldHdr);
984 124 50       292 $sync eq '~' or $msg = 'Invalid sync byte', last;
985              
986             # read tag name
987 124 100       242 if ($tagLen) {
988 93 50       213 $raf->Read($tag, $tagLen) == $tagLen or last;
989 93         173 $oldHdr .= $tag; # add tag to element header
990 93 50       193 $et->Warn("MIE tag '${tag}' out of sequence") if $tag lt $lastTag;
991             # separate units from tag name if they exist
992 93 100       255 $units = $1 if $tag =~ s/\((.*)\)$//;
993             } else {
994 31         77 $tag = '';
995             }
996              
997             # get multi-byte value length if necessary
998 124 50       278 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     430 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 14         32 $tagLen = $valLen = 0;
1023 14         30 $tag = '';
1024             }
1025             #
1026             # write necessary new tags and process directories
1027             #
1028 138         320 while (@editTags) {
1029 134 100 100     372 last if $tagLen and $editTags[0] gt $tag;
1030             # we are writing the new tag now
1031 95         159 my ($newVal, $writable, $oldVal, $newFormat, $compress);
1032 95         181 my $newTag = shift @editTags;
1033 95 50       237 length($newTag) > 255 and $et->Warn('Tag name too long'), next; # (just to be safe)
1034 95         308 my $newInfo = $$editDirs{$newTag};
1035 95 100       186 if ($newInfo) {
1036             # create the new subdirectory or rewrite existing non-MIE directory
1037 36         142 my $subTablePtr = GetTagTable($newInfo->{SubDirectory}->{TagTable});
1038 36 50       88 unless ($subTablePtr) {
1039 0         0 $et->Warn("No tag table for $newTag $$newInfo{Name}");
1040 0         0 next;
1041             }
1042 36         60 my %subdirInfo;
1043             my $isMieGroup = ($$subTablePtr{WRITE_PROC} and
1044 36   66     228 $$subTablePtr{WRITE_PROC} eq \&ProcessMIE);
1045              
1046 36 100       97 if ($newTag eq $tag) {
1047             # make sure that either both or neither old and new tags are MIE groups
1048 10 50 25     70 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 10 50       41 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 26 100       124 next unless $$addDirs{$newTag};
1069             }
1070              
1071 29 100       68 if ($isMieGroup) {
1072 23         39 my $hdr;
1073 23 100 33     83 if ($newTag eq $tag) {
    50          
1074             # rewrite existing directory later unless it was compressed
1075 10 50       46 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 13         45 $hdr = '~' . MIEGroupFormat(1) . chr(length($newTag)) .
1090             "\0" . $newTag;
1091 13         66 %subdirInfo = (
1092             OutFile => $outfile,
1093             ToWrite => $toWrite . $hdr,
1094             );
1095             }
1096 13   33     60 $subdirInfo{DirName} = $newInfo->{SubDirectory}->{DirName} || $newTag;
1097 13         31 $subdirInfo{Parent} = $dirName;
1098             # don't compress elements of an already compressed group
1099 13   33     52 $subdirInfo{IsCompressed} = $$dirInfo{IsCompressed} || $compress;
1100 13         81 $msg = WriteMIEGroup($et, \%subdirInfo, $subTablePtr);
1101 13 50       39 last MieElement if $msg;
1102             # message is defined but empty if nothing was written
1103 13 100       41 if (defined $msg) {
    50          
    0          
1104 2         6 undef $msg; # not a problem if nothing was written
1105 2         7 next;
1106             } elsif (not $compress) {
1107             # group was written already
1108 11         18 $toWrite = '';
1109 11         50 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       30 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         22 $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         36 $$et{PROCESSED} = { };
1143 6         46 $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       9 next unless defined $oldVal;
1151 0         0 $newVal = $oldVal; # just copy over the old directory
1152             }
1153 5         12 $writable = 'undef';
1154 5         26 $newFormat = 0x00; # all other directories are 'undef' format
1155             }
1156             } else {
1157              
1158             # get the new tag information
1159 59         103 $newInfo = $$newTags{$newTag};
1160 59         175 my $nvHash = $et->GetNewValueHash($newInfo);
1161 59         100 my @newVals;
1162              
1163             # write information only to specified group
1164 59         157 my $writeGroup = $$nvHash{WriteGroup};
1165 59 50       134 last unless $isWriting{$writeGroup};
1166              
1167             # if tag existed, must decide if we want to overwrite the value
1168 59 100       134 if ($newTag eq $tag) {
1169 1         18 my $isOverwriting;
1170 1         15 my $isList = $$newInfo{List};
1171 1 50       5 if ($isList) {
1172 0 0       0 last if $$nvHash{CreateOnly};
1173 0         0 $isOverwriting = -1; # force processing list elements individually
1174             } else {
1175 1         7 $isOverwriting = $et->IsOverwriting($nvHash);
1176 1 50       6 last unless $isOverwriting;
1177             }
1178 1         3 my ($val, $cmpVal);
1179 1 50 33     29 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       5 if ($isOverwriting) {
1222             # skip the old value if we didn't read it already
1223 1 50       5 unless (defined $oldVal) {
1224 1 50       4 $raf->Seek($valLen, 1) or $msg = 'Seek error';
1225             }
1226 1 50       8 if ($verbose > 1) {
1227 0 0       0 $val .= "($units)" if defined $units;
1228 0         0 $et->VerboseValue("- $grp1:$$newInfo{Name}", $val);
1229             }
1230 1         3 $deletedTag = $tag; # remember that we deleted this tag
1231 1         4 ++$$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       3 unless (@newVals) {
1245             # unshift the new tag info to write it later
1246 1         4 unshift @editTags, $newTag;
1247 1         8 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 58 0 0     151 ($newTag eq $lastTag and ($$newInfo{List} or $deletedTag eq $lastTag));
      0        
      33        
1254             }
1255             # get the new value to write (undef to delete)
1256 58         164 push @newVals, $et->GetNewValue($nvHash);
1257 58 50       123 next unless @newVals;
1258 58   66     228 $writable = $$newInfo{Writable} || $$tagTablePtr{WRITABLE};
1259 58 100       126 if ($writable eq 'string') {
1260             # join multiple values into a single string
1261 40         108 $newVal = join "\0", @newVals;
1262             # write string as UTF-8,16 or 32 if value contains valid UTF-8 codes
1263 40         132 my $isUTF8 = Image::ExifTool::IsUTF8(\$newVal);
1264 40 100       90 if ($isUTF8 > 0) {
1265 9         15 $writable = 'utf8';
1266             # write UTF-16 or UTF-32 if it is more compact
1267 9 50       17 my $to = $isUTF8 > 1 ? 'UCS4' : 'UCS2';
1268 9         33 my $tmp = Image::ExifTool::Decode(undef,$newVal,'UTF8',undef,$to);
1269 9 100       33 if (length $tmp < length $newVal) {
1270 3         8 $newVal = $tmp;
1271 3 50       9 $writable = ($isUTF8 > 1) ? 'utf32' : 'utf16';
1272             }
1273             }
1274             # write as a list if we have multiple values
1275 40 100       87 $writable .= '_list' if @newVals > 1;
1276             } else {
1277             # should only be one element in the list
1278 18         36 $newVal = shift @newVals;
1279             }
1280 58         140 $newFormat = $mieCode{$writable};
1281 58 50       133 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 63         137 while (defined $newFormat) {
1289 63         107 my $valPt = \$newVal;
1290             # remove units from value and add to tag name if supported by this tag
1291 63 100       147 if ($$newInfo{Units}) {
1292 1         3 my $val2;
1293 1 50       10 if ($$valPt =~ /(.*)\((.*)\)$/) {
1294 1         4 $val2 = $1;
1295 1         8 $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         3 $valPt = \$val2;
1304             }
1305             # convert value if necessary
1306 63 100       271 if ($writable !~ /^(utf|string|undef)/) {
1307 16         84 my $val3 = WriteValue($$valPt, $writable, $$newInfo{Count});
1308 16 50       72 defined $val3 or $et->Warn("Error writing $newTag"), last;
1309 16         34 $valPt = \$val3;
1310             }
1311 63         120 my $len = length $$valPt;
1312             # compress value before writing if required
1313 63 0 33     230 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 63         82 my $extLen;
1340 63 100       162 if ($len < 253) {
    50          
    0          
1341 60         104 $extLen = '';
1342             } elsif ($len < 65536) {
1343 3         14 $extLen = Set16u($len);
1344 3         10 $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 63         246 my $hdr = $toWrite . '~' . chr($newFormat) . chr(length $newTag);
1354 63 50       201 Write($outfile, $hdr, chr($len), $newTag, $extLen, $$valPt) or $err = 1;
1355 63         129 $toWrite = '';
1356             # we changed a tag unless just editing a subdirectory
1357 63 100       150 unless ($$editDirs{$newTag}) {
1358 58         271 $et->VerboseValue("+ $grp1:$$newInfo{Name}", $newVal);
1359 58         104 ++$$et{CHANGED};
1360             }
1361 63         115 last; # didn't want to loop anyway
1362             }
1363 63 50       218 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 137 100       292 unless ($tagLen) {
1370             # skip over existing terminator data (if any)
1371 45 50 66     269 last if $valLen and not $raf->Seek($valLen, 1);
1372 45         77 $ok = 1;
1373             # write group terminator if necessary
1374 45 100       110 unless ($toWrite) {
1375             # write end-of-group terminator element
1376 43         93 my $term = "~\0\0\0";
1377 43 100       128 unless ($$dirInfo{Parent}) {
1378             # write extended terminator for file-level group
1379 9 100       64 my $len = ref $outfile eq 'SCALAR' ? length($$outfile) : tell $outfile;
1380 9         28 $len += 10; # include length of terminator itself
1381 9 50 33     88 if ($len and $len <= 0x7fffffff) {
1382 9         41 $term = "~\0\0\x06" . Set32u($len) . MIEGroupFormat(1) . "\x04";
1383             }
1384             }
1385 43 50       125 Write($outfile, $term) or $err = 1;
1386             }
1387 45         97 last;
1388             }
1389              
1390             # descend into existing uncompressed MIE group
1391 92 100 66     316 if ($format == 0x10 or $format == 0x18) {
1392 23         52 my ($subTablePtr, $dirName);
1393 23         91 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1394 23 50 33     121 if ($tagInfo and $$tagInfo{SubDirectory}) {
1395 23         57 $dirName = $tagInfo->{SubDirectory}->{DirName};
1396 23         56 my $subTable = $tagInfo->{SubDirectory}->{TagTable};
1397 23 50       84 $subTablePtr = $subTable ? GetTagTable($subTable) : $tagTablePtr;
1398             } else {
1399 0         0 $subTablePtr = GetTagTable('Image::ExifTool::MIE::Unknown');
1400             }
1401 23         122 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     221 );
1410 23         74 my $oldOrder = GetByteOrder();
1411 23 50       128 SetByteOrder($format & 0x08 ? 'II' : 'MM');
1412 23         317 $msg = WriteMIEGroup($et, \%subdirInfo, $subTablePtr);
1413 23         120 SetByteOrder($oldOrder);
1414 23 50       65 last if $msg;
1415 23 50       83 if (defined $msg) {
1416 0         0 undef $msg; # no problem if nothing written
1417             } else {
1418 23         53 $toWrite = '';
1419             }
1420 23         78 next;
1421             }
1422             # just copy existing element
1423 69         90 my $oldVal;
1424 69 50       177 $raf->Read($oldVal, $valLen) == $valLen or last;
1425 69 100       154 if ($toWrite) {
1426 15 50       59 Write($outfile, $toWrite) or $err = 1;
1427 15         49 $toWrite = '';
1428             }
1429 69 50       149 Write($outfile, $oldHdr, $oldVal) or $err = 1;
1430             }
1431             # return error message
1432 45 50 33     275 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         5 $msg = ''; # flag for nothing written
1438 2 50       6 $verbose and print $out "Deleted $grp1 (empty)\n";
1439             }
1440 45         311 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 139     139 0 354 my ($et, $dirInfo, $tagTablePtr) = @_;
1451 139         283 my $raf = $$dirInfo{RAF};
1452 139         442 my $verbose = $et->Options('Verbose');
1453 139         395 my $out = $et->Options('TextOut');
1454 139         399 my $notUTF8 = ($$et{OPTIONS}{Charset} ne 'UTF8');
1455 139         367 my ($msg, $buff, $ok, $oldIndent, $mime);
1456 139         258 my $lastTag = '';
1457              
1458             # get group 1 names: $grp doesn't have numbers (eg. 'MIE-Doc'),
1459             # and $grp1 does (eg. 'MIE1-Doc1')
1460 139         245 my $cnt = $$et{MIE_COUNT};
1461 139         507 my $grp1 = $tagTablePtr->{GROUPS}->{1};
1462 139   100     411 my $n = $$cnt{'MIE-Main'} || 0;
1463 139 100       347 if ($grp1 eq 'MIE-Main') {
1464 27         94 $$cnt{$grp1} = ++$n;
1465 27 50       112 $grp1 =~ s/MIE-/MIE$n-/ if $n > 1;
1466             } else {
1467 112 50       311 $grp1 =~ s/MIE-/MIE$n-/ if $n > 1;
1468 112   50     532 $$cnt{$grp1} = ($$cnt{$grp1} || 0) + 1;
1469 112 50       328 $grp1 .= $$cnt{$grp1} if $$cnt{$grp1} > 1;
1470             }
1471             # set group1 name for all tags extracted from this group
1472 139         298 $$et{SET_GROUP1} = $grp1;
1473              
1474 139 50       324 if ($verbose) {
1475 0         0 $oldIndent = $$et{INDENT};
1476 0         0 $$et{INDENT} .= '| ';
1477 0         0 $et->VerboseDir($grp1);
1478             }
1479 139         262 my $wasCompressed = $$dirInfo{WasCompressed};
1480              
1481             # process all MIE elements
1482 139         200 for (;;) {
1483 743 50       1977 $raf->Read($buff, 4) == 4 or last;
1484 743         2758 my ($sync, $format, $tagLen, $valLen) = unpack('aC3', $buff);
1485 743 50       1757 $sync eq '~' or $msg = 'Invalid sync byte', last;
1486              
1487             # read tag name
1488 743         1078 my ($tag, $units);
1489 743 100       1329 if ($tagLen) {
1490 604 50       1400 $raf->Read($tag, $tagLen) == $tagLen or last;
1491 604 50       1362 $et->Warn("MIE tag '${tag}' out of sequence") if $tag lt $lastTag;
1492 604         974 $lastTag = $tag;
1493             # separate units from tag name if they exist
1494 604 100       1588 $units = $1 if $tag =~ s/\((.*)\)$//;
1495             } else {
1496 139         282 $tag = '';
1497             }
1498              
1499             # get multi-byte value length if necessary
1500 743 100       1466 if ($valLen > 252) {
1501 3         11 my $n = 1 << (256 - $valLen);
1502 3 50       31 $raf->Read($buff, $n) == $n or last;
1503 3         15 my $fmt = 'int' . ($n * 8) . 'u';
1504 3         16 $valLen = ReadValue(\$buff, 0, $fmt, 1, $n);
1505 3 50       15 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 743 100       1445 unless ($tagLen) {
1513             # skip over terminator data block
1514 139 50 66     535 $ok = 1 unless $valLen and not $raf->Seek($valLen, 1);
1515 139         290 last;
1516             }
1517              
1518             # get tag information hash unless this is free space
1519 604         933 my ($tagInfo, $value);
1520 604         1201 while ($format != 0x80) {
1521 604         1688 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1522 604 100       1541 last if $tagInfo;
1523             # extract tags with locale code
1524 36 50       142 if ($tag =~ /\W/) {
1525 36 50       170 if ($tag =~ /^(\w+)-([a-z]{2}_[A-Z]{2})$/) {
1526 36         132 my ($baseTag, $langCode) = ($1, $2);
1527 36         90 $tagInfo = $et->GetTagInfo($tagTablePtr, $baseTag);
1528 36 50       121 $tagInfo = GetLangInfo($tagInfo, $langCode) if $tagInfo;
1529 36 50       166 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 604   50     1934 my $formatStr = $mieFormat{$format & 0xfb} || 'undef';
1547 604 50 0     1415 if ($tagInfo or ($formatStr eq 'MIE' and $format & 0x04)) {
      33        
1548 604 50       1400 $raf->Read($value, $valLen) == $valLen or last;
1549 604 50       1266 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 604 100       1203 if ($formatStr eq 'MIE') {
1568             # process MIE directory
1569 112         277 my ($subTablePtr, $dirName);
1570 112 50 33     497 if ($tagInfo and $$tagInfo{SubDirectory}) {
1571 112         275 $dirName = $tagInfo->{SubDirectory}->{DirName};
1572 112         260 my $subTable = $tagInfo->{SubDirectory}->{TagTable};
1573 112 50       390 $subTablePtr = $subTable ? GetTagTable($subTable) : $tagTablePtr;
1574             } else {
1575 0         0 $subTablePtr = GetTagTable('Image::ExifTool::MIE::Unknown');
1576             }
1577 112 50       301 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 112   33     637 WasCompressed => $wasCompressed,
1586             );
1587             # read from uncompressed data instead if necessary
1588 112 50       289 $subdirInfo{RAF} = new File::RandomAccess(\$value) if $valLen;
1589              
1590 112         319 my $oldOrder = GetByteOrder();
1591 112 50       447 SetByteOrder($format & 0x08 ? 'II' : 'MM');
1592 112         637 $msg = ProcessMIEGroup($et, \%subdirInfo, $subTablePtr);
1593 112         371 SetByteOrder($oldOrder);
1594 112         282 $$et{SET_GROUP1} = $grp1; # restore this group1 name
1595 112 50       437 last if $msg;
1596             } else {
1597             # process MIE data format types
1598 492 50       951 if ($tagInfo) {
1599 492         718 my $rational;
1600             # extract tag value
1601 492         1228 my $val = ReadMIEValue(\$value, 0, $formatStr, undef, $valLen, \$rational);
1602 492 50       1129 unless (defined $val) {
1603 0         0 $et->Warn("Error reading $tag value");
1604 0         0 $val = '';
1605             }
1606             # save type or mime type
1607 492 100 100     1830 $mime = $val if $tag eq '0Type' or $tag eq '2MIME';
1608 492 50       929 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 492 100       1045 if ($$tagInfo{SubDirectory}) {
1624 5         33 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         63 WasCompressed => $wasCompressed,
1633             );
1634             # set DataPos and Base for uncompressed information only
1635 5 50       20 unless ($wasCompressed) {
1636 5         16 $subdirInfo{DataPos} = 0; # (relative to Base)
1637 5         20 $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         103 $$et{PROCESSED} = { };
1642 5         18 my $processProc = $tagInfo->{SubDirectory}->{ProcessProc};
1643 5         13 delete $$et{SET_GROUP1};
1644 5         10 delete $$et{NO_LIST};
1645 5         41 $et->ProcessDirectory(\%subdirInfo, $subTablePtr, $processProc);
1646 5         15 $$et{SET_GROUP1} = $grp1;
1647 5         28 $$et{NO_LIST} = 1;
1648             } else {
1649             # convert to specified character set if necessary
1650 487 100 100     1742 if ($notUTF8 and $formatStr =~ /^(utf|string)/) {
1651 117         371 $val = $et->Decode($val, 'UTF8');
1652             }
1653 487 100       1165 if ($formatStr =~ /_list$/) {
1654             # split list value into separate strings
1655 8         53 my @vals = split "\0", $val;
1656 8         25 $val = \@vals;
1657             }
1658 487 100       965 if (defined $units) {
1659 8 50       34 $val = "@$val" if ref $val; # convert string list to number list
1660             # add units to value if specified
1661 8 50       34 $val .= "($units)" if defined $units;
1662             }
1663 487         1366 my $key = $et->FoundTag($tagInfo, $val);
1664 487 100 66     1712 $$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 139 100 66     422 $mime and not $$dirInfo{Parent} and $et->ModifyMimeType($mime);
1675              
1676 139 50 33     347 $ok or $msg or $msg = 'Unexpected end of file';
1677 139 50       292 $verbose and $$et{INDENT} = $oldIndent;
1678 139         370 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 693     693 0 2108 my ($et, $dirInfo) = @_;
1689 693 100       3438 return 1 unless defined $et;
1690 36         120 my $raf = $$dirInfo{RAF};
1691 36         96 my $outfile = $$dirInfo{OutFile};
1692 36         125 my ($buff, $err, $msg, $pos, $end, $isCreating);
1693 36         94 my $numDocs = 0;
1694             #
1695             # process as a trailer (from end of file) if specified
1696             #
1697 36 100       144 if ($$dirInfo{Trailer}) {
1698 26   50     122 my $offset = $$dirInfo{Offset} || 0; # offset from end of file
1699 26 50       124 $raf->Seek(-10 - $offset, 2) or return 0;
1700 26         136 for (;;) {
1701             # read and validate last 10 bytes
1702 52 50       194 $raf->Read($buff, 10) == 10 or last;
1703 52 100 66     549 last unless $buff =~ /~\0\0\x06.{4}(\x10|\x18)(\x04)$/s or
1704             $buff =~ /(\x10|\x18)(\x08)$/s;
1705 26 50       209 SetByteOrder($1 eq "\x10" ? 'MM' : 'II');
1706 26 50       241 my $len = ($2 eq "\x04") ? Get32u(\$buff, 4) : Get64u(\$buff, 0);
1707 26 50       122 my $curPos = $raf->Tell() or last;
1708 26 50 33     213 last if $len < 12 or $len > $curPos;
1709             # validate element header if 8-byte offset was used
1710 26 50       121 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         72 $pos = $curPos - $len;
1717 26 50       679 $end = $curPos unless $end;
1718             # seek to 10 bytes from end of previous group
1719 26 50       130 $raf->Seek($pos - 10, 0) or last;
1720             }
1721             # seek to start of first MIE group
1722 26 50 33     164 return 0 unless defined $pos and $raf->Seek($pos, 0);
1723             # update DataPos and DirLen for ProcessTrailers()
1724 26         104 $$dirInfo{DataPos} = $pos;
1725 26         101 $$dirInfo{DirLen} = $end - $pos;
1726 26 50 66     220 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         404 for (;;) {
1739             # look for "0MIE" group element
1740 72         261 my $num = $raf->Read($buff, 8);
1741 72 100       341 if ($num == 8) {
    100          
1742             # verify file identifier
1743 61 100       403 if ($buff =~ /^~(\x10|\x18)\x04(.)0MIE/s) {
1744 35 50       297 SetByteOrder($1 eq "\x10" ? 'MM' : 'II');
1745 35         192 my $len = ord($2);
1746             # skip extended DataLength if it exists
1747 35 50 33     286 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       134 return 0 unless $numDocs; # not a MIE file
1753 26 50       123 if ($buff =~ /^~/) {
1754 0         0 $msg = 'Non-standard file-level MIE element';
1755             } else {
1756 26         95 $msg = 'Invalid MIE file-level data';
1757             }
1758             }
1759             } elsif ($numDocs) {
1760 10 50       49 last unless $num; # OK, all done with file
1761 0         0 $msg = 'Truncated MIE element header';
1762             } else {
1763 1 50 33     7 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         7 $et->SetPreferredByteOrder();
1768 1         3 $isCreating = 1;
1769             }
1770 62 100       254 if ($msg) {
1771 26 50       100 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       126 unless ($numDocs) {
1781             # this is a valid MIE file (unless a trailer on another file)
1782 36         244 $et->SetFileType();
1783 36         158 $$et{NO_LIST} = 1; # handle lists ourself
1784 36         153 $$et{MIE_COUNT} = { };
1785 36         101 undef $hasZlib;
1786             }
1787 36         77 ++$numDocs;
1788              
1789             # process the MIE groups recursively, beginning with the main MIE group
1790 36         153 my $tagTablePtr = GetTagTable('Image::ExifTool::MIE::Main');
1791              
1792 36         289 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       149 if ($outfile) {
1799             # generate lookup for MIE format codes if not done already
1800 9 100       52 unless (%mieCode) {
1801 3         41 foreach (keys %mieFormat) {
1802 90         242 $mieCode{$mieFormat{$_}} = $_;
1803             }
1804             }
1805             # update %mieMap with user-defined MIE groups
1806 9 100       63 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         60 $et->InitWriteDirs(\%mieMap, 'MIE');
1812 9         60 $subdirInfo{ToWrite} = '~' . MIEGroupFormat(1) . "\x04\xfe0MIE\0\0\0\0";
1813 9         63 $msg = WriteMIEGroup($et, \%subdirInfo, $tagTablePtr);
1814 9 50 33     86 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         152 $msg = ProcessMIEGroup($et, \%subdirInfo, $tagTablePtr);
1823 27 50       187 if ($msg) {
1824 0         0 $et->Warn($msg);
1825 0         0 last;
1826             }
1827             }
1828             }
1829 36         118 delete $$et{NO_LIST};
1830 36         149 delete $$et{MIE_COUNT};
1831 36         98 delete $$et{SET_GROUP1};
1832 36 50       185 return $err ? -1 : 1;
1833             }
1834              
1835             1; # end
1836              
1837             __END__