File Coverage

blib/lib/Image/ExifTool/MIE.pm
Criterion Covered Total %
statement 428 629 68.0
branch 247 508 48.6
condition 85 217 39.1
subroutine 13 14 92.8
pod 0 9 0.0
total 773 1377 56.1


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 39     39   9862 use strict;
  39         122  
  39         2019  
12 39     39   343 use vars qw($VERSION %tableDefaults);
  39         83  
  39         2804  
13 39     39   281 use Image::ExifTool qw(:DataAccess :Utils);
  39         88  
  39         11538  
14 39     39   2459 use Image::ExifTool::Exif;
  39         142  
  39         1597  
15 39     39   7565 use Image::ExifTool::GPS;
  39         105  
  39         476205  
16              
17             $VERSION = '1.56';
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 6 $doneMieMap = 1; # set flag so we only do this once
757 3 50       11 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 62     62 0 192 my ($tagInfo, $langCode) = @_;
805             # check for properly formatted language code
806 62 100       375 return undef unless $langCode =~ /^[a-z]{2}([-_])[A-Z]{2}$/;
807             # use '_' as a separator, but recognize '_' or '-'
808 48 50       149 $langCode =~ tr/-/_/ if $1 eq '-';
809             # can only set locale on string types
810 48 50 33     130 return undef if $$tagInfo{Writable} and $$tagInfo{Writable} ne 'string';
811 48         204 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 100 my $chr = shift;
837 32 50       119 my $format = GetByteOrder() eq 'MM' ? 0x10 : 0x18;
838 32 50       204 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 1244 my ($dataPt, $offset, $format, $count, $size, $ratPt) = @_;
852 493         756 my $val;
853 493 100       2111 if ($format =~ /^(utf(8|16|32)|string)/) {
854 332 100 100     1822 if ($1 eq 'utf8' or $1 eq 'string') {
855             # read the 8-bit string
856 308         955 $val = substr($$dataPt, $offset, $size);
857             # (as of ExifTool 7.62, leave string values unconverted)
858             } else {
859             # convert to UTF8
860 24         82 my $fmt;
861 24 50       79 if (GetByteOrder() eq 'MM') {
862 24 50       72 $fmt = ($1 eq 'utf16') ? 'n' : 'N';
863             } else {
864 0 0       0 $fmt = ($1 eq 'utf16') ? 'v' : 'V';
865             }
866 24         229 my @unpk = unpack("x$offset$fmt$size",$$dataPt);
867 24 50       99 if ($] >= 5.006001) {
868 24         176 $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       1109 $val =~ s/\0.*//s unless $format =~ /_list$/;
876             } else {
877 161 50       498 $format = 'undef' if $format eq 'free'; # read 'free' as 'undef'
878 161         589 return ReadValue($dataPt, $offset, $format, $count, $size, $ratPt);
879             }
880 332         886 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 552     552 0 1759 my ($et, $tagInfo, $valPtr) = @_;
890 552   66     3038 my $format = $$tagInfo{Writable} || $tagInfo->{Table}->{WRITABLE};
891 552         1273 my $err;
892              
893 552 50 33     3106 return 'No writable format' if not $format or $format eq '1';
894             # handle units if supported by this tag
895 552         1598 my $ulist = $$tagInfo{Units};
896 552 100 100     5604 if ($ulist and $$valPtr =~ /(.*)\((.*)\)$/) {
    100 100        
897 1         7 my ($val, $units) = ($1, $2);
898 1         33 ($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       7 $$valPtr = "$val($units)" unless $err;
903             } elsif ($format !~ /^(utf|string|undef)/ and $$valPtr =~ /\)$/) {
904 7         36 return 'Units not supported';
905             } else {
906 544 50 66     3624 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 544         3889 $err = Image::ExifTool::CheckValue($valPtr, $format, $$tagInfo{Count});
913             }
914 545         2121 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 125 my ($et, $dirInfo, $tagTablePtr) = @_;
924 46         120 my $outfile = $$dirInfo{OutFile};
925 46         107 my $dirName = $$dirInfo{DirName};
926 46   50     148 my $toWrite = $$dirInfo{ToWrite} || '';
927 46         86 my $raf = $$dirInfo{RAF};
928 46         201 my $verbose = $et->Options('Verbose');
929 46         123 my $optCompress = $et->Options('Compress');
930 46         112 my $out = $et->Options('TextOut');
931 46         112 my ($msg, $err, $ok, $sync, $delGroup);
932 46         101 my $tag = '';
933 46         87 my $deletedTag = '';
934              
935             # count each MIE directory found and make name for this specific instance
936 46         140 my ($grp1, %isWriting);
937 46         101 my $cnt = $$et{MIE_COUNT};
938 46         213 my $grp = $tagTablePtr->{GROUPS}->{1};
939 46   100     178 my $n = $$cnt{'MIE-Main'} || 0;
940 46 100       131 if ($grp eq 'MIE-Main') {
941 9         38 $$cnt{$grp} = ++$n;
942 9         92 ($grp1 = $grp) =~ s/MIE-/MIE$n-/;
943             } else {
944 37         360 ($grp1 = $grp) =~ s/MIE-/MIE$n-/;
945 37   50     285 my $m = $$cnt{$grp1} = ($$cnt{$grp1} || 0) + 1;
946 37         151 $isWriting{"$grp$m"} = 1; # eg. 'MIE-Doc2'
947 37         90 $isWriting{$grp1} = 1; # eg. 'MIE1-Doc'
948 37         79 $grp1 .= $m;
949             }
950             # build lookup for all valid group names for this MIE group
951 46         116 $isWriting{$grp} = 1; # eg. 'MIE-Doc'
952 46         124 $isWriting{$grp1} = 1; # eg. 'MIE1-Doc2'
953 46         141 $isWriting{"MIE$n"} = 1; # eg. 'MIE1'
954              
955             # determine if we are deleting this group
956 46 100       82 if (%{$$et{DEL_GROUP}}) {
  46         168  
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     104 $$et{DEL_GROUP}{"MIE$n"};
      33        
      33        
961             }
962              
963             # prepare lookups and lists for writing
964 46         244 my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
965 46         215 my ($addDirs, $editDirs) = $et->GetAddDirHash($tagTablePtr, $dirName);
966 46         336 my @editTags = sort keys %$newTags, keys %$editDirs;
967 46 0       154 $verbose and print $out $raf ? 'Writing' : 'Creating', " $grp1:\n";
    50          
968              
969             # loop through elements in MIE group
970 46         79 MieElement: for (;;) {
971 139         233 my ($format, $tagLen, $valLen, $units, $oldHdr, $buff);
972 139         237 my $lastTag = $tag;
973 139 100       306 if ($raf) {
974             # read first 4 bytes of element header
975 125         342 my $n = $raf->Read($oldHdr, 4);
976 125 100       248 if ($n != 4) {
977 1 50 33     11 last if $n or defined $sync;
978 1         3 undef $raf; # all done reading
979 1         3 $ok = 1;
980             }
981             }
982 139 100       254 if ($raf) {
983 124         399 ($sync, $format, $tagLen, $valLen) = unpack('aC3', $oldHdr);
984 124 50       250 $sync eq '~' or $msg = 'Invalid sync byte', last;
985              
986             # read tag name
987 124 100       219 if ($tagLen) {
988 93 50       167 $raf->Read($tag, $tagLen) == $tagLen or last;
989 93         135 $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       266 $units = $1 if $tag =~ s/\((.*)\)$//;
993             } else {
994 31         54 $tag = '';
995             }
996              
997             # get multi-byte value length if necessary
998 124 50       221 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     484 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         67 $tagLen = $valLen = 0;
1023 15         36 $tag = '';
1024             }
1025             #
1026             # write necessary new tags and process directories
1027             #
1028 139         297 while (@editTags) {
1029 138 100 100     418 last if $tagLen and $editTags[0] gt $tag;
1030             # we are writing the new tag now
1031 98         212 my ($newVal, $writable, $oldVal, $newFormat, $compress);
1032 98         198 my $newTag = shift @editTags;
1033 98 50       277 length($newTag) > 255 and $et->Warn('Tag name too long'), next; # (just to be safe)
1034 98         242 my $newInfo = $$editDirs{$newTag};
1035 98 100       230 if ($newInfo) {
1036             # create the new subdirectory or rewrite existing non-MIE directory
1037 38         203 my $subTablePtr = GetTagTable($newInfo->{SubDirectory}->{TagTable});
1038 38 50       100 unless ($subTablePtr) {
1039 0         0 $et->Warn("No tag table for $newTag $$newInfo{Name}");
1040 0         0 next;
1041             }
1042 38         80 my %subdirInfo;
1043             my $isMieGroup = ($$subTablePtr{WRITE_PROC} and
1044 38   66     261 $$subTablePtr{WRITE_PROC} eq \&ProcessMIE);
1045              
1046 38 100       135 if ($newTag eq $tag) {
1047             # make sure that either both or neither old and new tags are MIE groups
1048 11 50 25     78 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       40 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       125 next unless $$addDirs{$newTag};
1069             }
1070              
1071 31 100       78 if ($isMieGroup) {
1072 25         49 my $hdr;
1073 25 100 33     112 if ($newTag eq $tag) {
    50          
1074             # rewrite existing directory later unless it was compressed
1075 11 50       55 last unless $compress;
1076             # rewrite directory to '$newVal'
1077 0         0 $newVal = '';
1078 0         0 %subdirInfo = (
1079             OutFile => \$newVal,
1080             RAF => File::RandomAccess->new(\$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         58 $hdr = '~' . MIEGroupFormat(1) . chr(length($newTag)) .
1090             "\0" . $newTag;
1091 14         106 %subdirInfo = (
1092             OutFile => $outfile,
1093             ToWrite => $toWrite . $hdr,
1094             );
1095             }
1096 14   33     95 $subdirInfo{DirName} = $newInfo->{SubDirectory}->{DirName} || $newTag;
1097 14         43 $subdirInfo{Parent} = $dirName;
1098             # don't compress elements of an already compressed group
1099 14   33     110 $subdirInfo{IsCompressed} = $$dirInfo{IsCompressed} || $compress;
1100 14         90 $msg = WriteMIEGroup($et, \%subdirInfo, $subTablePtr);
1101 14 50       59 last MieElement if $msg;
1102             # message is defined but empty if nothing was written
1103 14 100       49 if (defined $msg) {
    50          
    0          
1104 2         7 undef $msg; # not a problem if nothing was written
1105 2         15 next;
1106             } elsif (not $compress) {
1107             # group was written already
1108 12         31 $toWrite = '';
1109 12         87 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       43 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         20 $subdirInfo{Parent} = $dirName;
1140 6         16 my $writeProc = $newInfo->{SubDirectory}->{WriteProc};
1141             # reset processed lookup to avoid errors in case of multiple EXIF blocks
1142 6         39 $$et{PROCESSED} = { };
1143 6         42 $newVal = $et->WriteDirectory(\%subdirInfo, $subTablePtr, $writeProc);
1144 6 100       26 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       11 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 60         183 $newInfo = $$newTags{$newTag};
1160 60         248 my $nvHash = $et->GetNewValueHash($newInfo);
1161 60         159 my @newVals;
1162              
1163             # write information only to specified group
1164 60         183 my $writeGroup = $$nvHash{WriteGroup};
1165 60 50       199 last unless $isWriting{$writeGroup};
1166              
1167             # if tag existed, must decide if we want to overwrite the value
1168 60 100       160 if ($newTag eq $tag) {
1169 1         1 my $isOverwriting;
1170 1         2 my $isList = $$newInfo{List};
1171 1 50       3 if ($isList) {
1172 0 0       0 last if $$nvHash{CreateOnly};
1173 0         0 $isOverwriting = -1; # force processing list elements individually
1174             } else {
1175 1         4 $isOverwriting = $et->IsOverwriting($nvHash);
1176 1 50       3 last unless $isOverwriting;
1177             }
1178 1         2 my ($val, $cmpVal);
1179 1 50 33     13 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       3 if ($isOverwriting) {
1222             # skip the old value if we didn't read it already
1223 1 50       3 unless (defined $oldVal) {
1224 1 50       7 $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         5 $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       3 unless (@newVals) {
1245             # unshift the new tag info to write it later
1246 1         4 unshift @editTags, $newTag;
1247 1         6 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     171 ($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         281 push @newVals, $et->GetNewValue($nvHash);
1257 59 50       145 next unless @newVals;
1258 59   66     271 $writable = $$newInfo{Writable} || $$tagTablePtr{WRITABLE};
1259 59 100       149 if ($writable eq 'string') {
1260             # join multiple values into a single string
1261 40         157 $newVal = join "\0", @newVals;
1262             # write string as UTF-8,16 or 32 if value contains valid UTF-8 codes
1263 40         209 my $isUTF8 = Image::ExifTool::IsUTF8(\$newVal);
1264 40 100       124 if ($isUTF8 > 0) {
1265 9         20 $writable = 'utf8';
1266             # write UTF-16 or UTF-32 if it is more compact
1267 9 50       22 my $to = $isUTF8 > 1 ? 'UCS4' : 'UCS2';
1268 9         43 my $tmp = Image::ExifTool::Decode(undef,$newVal,'UTF8',undef,$to);
1269 9 100       27 if (length $tmp < length $newVal) {
1270 3         9 $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       127 $writable .= '_list' if @newVals > 1;
1276             } else {
1277             # should only be one element in the list
1278 19         42 $newVal = shift @newVals;
1279             }
1280 59         197 $newFormat = $mieCode{$writable};
1281 59 50       175 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         209 while (defined $newFormat) {
1289 64         131 my $valPt = \$newVal;
1290             # remove units from value and add to tag name if supported by this tag
1291 64 100       215 if ($$newInfo{Units}) {
1292 1         3 my $val2;
1293 1 50       11 if ($$valPt =~ /(.*)\((.*)\)$/) {
1294 1         7 $val2 = $1;
1295 1         9 $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         5 $valPt = \$val2;
1304             }
1305             # convert value if necessary
1306 64 100       318 if ($writable !~ /^(utf|string|undef)/) {
1307 17         126 my $val3 = WriteValue($$valPt, $writable, $$newInfo{Count});
1308 17 50       51 defined $val3 or $et->Warn("Error writing $newTag"), last;
1309 17         43 $valPt = \$val3;
1310             }
1311 64         142 my $len = length $$valPt;
1312             # compress value before writing if required
1313 64 0 33     326 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         125 my $extLen;
1340 64 100       150 if ($len < 253) {
    50          
    0          
1341 61         99 $extLen = '';
1342             } elsif ($len < 65536) {
1343 3         15 $extLen = Set16u($len);
1344 3         8 $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         361 my $hdr = $toWrite . '~' . chr($newFormat) . chr(length $newTag);
1354 64 50       343 Write($outfile, $hdr, chr($len), $newTag, $extLen, $$valPt) or $err = 1;
1355 64         170 $toWrite = '';
1356             # we changed a tag unless just editing a subdirectory
1357 64 100       247 unless ($$editDirs{$newTag}) {
1358 59         438 $et->VerboseValue("+ $grp1:$$newInfo{Name}", $newVal);
1359 59         136 ++$$et{CHANGED};
1360             }
1361 64         167 last; # didn't want to loop anyway
1362             }
1363 64 50       309 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       283 unless ($tagLen) {
1370             # skip over existing terminator data (if any)
1371 46 50 66     251 last if $valLen and not $raf->Seek($valLen, 1);
1372 46         87 $ok = 1;
1373             # write group terminator if necessary
1374 46 100       124 unless ($toWrite) {
1375             # write end-of-group terminator element
1376 44         82 my $term = "~\0\0\0";
1377 44 100       145 unless ($$dirInfo{Parent}) {
1378             # write extended terminator for file-level group
1379 9 100 50     64 my $len = ref $outfile eq 'SCALAR' ? length($$outfile) || 0 : tell $outfile;
1380             # include length of terminator itself minus original $outfile position
1381 9   50     60 $len += 10 - ($$dirInfo{OutPos} || 0);
1382 9 50 33     101 if ($len and $len <= 0x7fffffff) {
1383 9         47 $term = "~\0\0\x06" . Set32u($len) . MIEGroupFormat(1) . "\x04";
1384             }
1385             }
1386 44 50       164 Write($outfile, $term) or $err = 1;
1387             }
1388 46         138 last;
1389             }
1390              
1391             # descend into existing uncompressed MIE group
1392 92 100 66     254 if ($format == 0x10 or $format == 0x18) {
1393 23         49 my ($subTablePtr, $dirName);
1394 23         104 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1395 23 50 33     97 if ($tagInfo and $$tagInfo{SubDirectory}) {
1396 23         61 $dirName = $tagInfo->{SubDirectory}->{DirName};
1397 23         45 my $subTable = $tagInfo->{SubDirectory}->{TagTable};
1398 23 50       76 $subTablePtr = $subTable ? GetTagTable($subTable) : $tagTablePtr;
1399             } else {
1400 0         0 $subTablePtr = GetTagTable('Image::ExifTool::MIE::Unknown');
1401             }
1402 23         89 my $hdr = '~' . chr($format) . chr(length $tag) . "\0" . $tag;
1403             my %subdirInfo = (
1404             DirName => $dirName || $tag,
1405             RAF => $raf,
1406             ToWrite => $toWrite . $hdr,
1407             OutFile => $outfile,
1408             Parent => $dirName,
1409             IsCompressed => $$dirInfo{IsCompressed},
1410 23   33     228 );
1411 23         98 my $oldOrder = GetByteOrder();
1412 23 50       140 SetByteOrder($format & 0x08 ? 'II' : 'MM');
1413 23         254 $msg = WriteMIEGroup($et, \%subdirInfo, $subTablePtr);
1414 23         88 SetByteOrder($oldOrder);
1415 23 50       98 last if $msg;
1416 23 50       60 if (defined $msg) {
1417 0         0 undef $msg; # no problem if nothing written
1418             } else {
1419 23         76 $toWrite = '';
1420             }
1421 23         97 next;
1422             }
1423             # just copy existing element
1424 69         110 my $oldVal;
1425 69 50       145 $raf->Read($oldVal, $valLen) == $valLen or last;
1426 69 100       130 if ($toWrite) {
1427 15 50       60 Write($outfile, $toWrite) or $err = 1;
1428 15         36 $toWrite = '';
1429             }
1430 69 50       137 Write($outfile, $oldHdr, $oldVal) or $err = 1;
1431             }
1432             # return error message
1433 46 50 33     284 if ($err) {
    50 66        
    100          
1434 0         0 $msg = 'Error writing file';
1435             } elsif (not $ok and not $msg) {
1436 0         0 $msg = 'Unexpected end of file';
1437             } elsif (not $msg and $toWrite) {
1438 2         6 $msg = ''; # flag for nothing written
1439 2 50       7 $verbose and print $out "Deleted $grp1 (empty)\n";
1440             }
1441 46         456 return $msg;
1442             }
1443              
1444             #------------------------------------------------------------------------------
1445             # Process MIE directory
1446             # Inputs: 0) ExifTool object reference, 1) DirInfo reference, 2) tag table ref
1447             # Returns: undef on success, or error message if there was a problem
1448             # Notes: file pointer is positioned at the MIE end on entry
1449             sub ProcessMIEGroup($$$)
1450             {
1451 140     140 0 395 my ($et, $dirInfo, $tagTablePtr) = @_;
1452 140         351 my $raf = $$dirInfo{RAF};
1453 140         569 my $verbose = $et->Options('Verbose');
1454 140         362 my $out = $et->Options('TextOut');
1455 140         443 my $notUTF8 = ($$et{OPTIONS}{Charset} ne 'UTF8');
1456 140         341 my ($msg, $buff, $ok, $oldIndent, $mime);
1457 140         267 my $lastTag = '';
1458              
1459             # get group 1 names: $grp doesn't have numbers (eg. 'MIE-Doc'),
1460             # and $grp1 does (eg. 'MIE1-Doc1')
1461 140         347 my $cnt = $$et{MIE_COUNT};
1462 140         492 my $grp1 = $tagTablePtr->{GROUPS}->{1};
1463 140   100     496 my $n = $$cnt{'MIE-Main'} || 0;
1464 140 100       394 if ($grp1 eq 'MIE-Main') {
1465 27         108 $$cnt{$grp1} = ++$n;
1466 27 50       104 $grp1 =~ s/MIE-/MIE$n-/ if $n > 1;
1467             } else {
1468 113 50       382 $grp1 =~ s/MIE-/MIE$n-/ if $n > 1;
1469 113   50     720 $$cnt{$grp1} = ($$cnt{$grp1} || 0) + 1;
1470 113 50       333 $grp1 .= $$cnt{$grp1} if $$cnt{$grp1} > 1;
1471             }
1472             # set group1 name for all tags extracted from this group
1473 140         335 $$et{SET_GROUP1} = $grp1;
1474              
1475 140 50       311 if ($verbose) {
1476 0         0 $oldIndent = $$et{INDENT};
1477 0         0 $$et{INDENT} .= '| ';
1478 0         0 $et->VerboseDir($grp1);
1479             }
1480 140         270 my $wasCompressed = $$dirInfo{WasCompressed};
1481              
1482             # process all MIE elements
1483 140         224 for (;;) {
1484 746 50       2709 $raf->Read($buff, 4) == 4 or last;
1485 746         3235 my ($sync, $format, $tagLen, $valLen) = unpack('aC3', $buff);
1486 746 50       2155 $sync eq '~' or $msg = 'Invalid sync byte', last;
1487              
1488             # read tag name
1489 746         1319 my ($tag, $units);
1490 746 100       1588 if ($tagLen) {
1491 606 50       1544 $raf->Read($tag, $tagLen) == $tagLen or last;
1492 606 50       1502 $et->Warn("MIE tag '${tag}' out of sequence") if $tag lt $lastTag;
1493 606         1050 $lastTag = $tag;
1494             # separate units from tag name if they exist
1495 606 100       1904 $units = $1 if $tag =~ s/\((.*)\)$//;
1496             } else {
1497 140         299 $tag = '';
1498             }
1499              
1500             # get multi-byte value length if necessary
1501 746 100       1616 if ($valLen > 252) {
1502 3         10 my $n = 1 << (256 - $valLen);
1503 3 50       14 $raf->Read($buff, $n) == $n or last;
1504 3         11 my $fmt = 'int' . ($n * 8) . 'u';
1505 3         16 $valLen = ReadValue(\$buff, 0, $fmt, 1, $n);
1506 3 50       12 if ($valLen > 0x7fffffff) {
1507 0         0 $msg = "Can't read $tag (DataLength > 2GB not yet supported)";
1508 0         0 last;
1509             }
1510             }
1511              
1512             # all done if we reached the group terminator
1513 746 100       1813 unless ($tagLen) {
1514             # skip over terminator data block
1515 140 50 66     582 $ok = 1 unless $valLen and not $raf->Seek($valLen, 1);
1516 140         343 last;
1517             }
1518              
1519             # get tag information hash unless this is free space
1520 606         986 my ($tagInfo, $value);
1521 606         1344 while ($format != 0x80) {
1522 606         2043 $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
1523 606 100       1563 last if $tagInfo;
1524             # extract tags with locale code
1525 36 50       159 if ($tag =~ /\W/) {
1526 36 50       193 if ($tag =~ /^(\w+)-([a-z]{2}_[A-Z]{2})$/) {
1527 36         128 my ($baseTag, $langCode) = ($1, $2);
1528 36         127 $tagInfo = $et->GetTagInfo($tagTablePtr, $baseTag);
1529 36 50       132 $tagInfo = GetLangInfo($tagInfo, $langCode) if $tagInfo;
1530 36 50       97 last if $tagInfo;
1531             } else {
1532 0         0 $et->Warn('Invalid MIE tag name');
1533 0         0 last;
1534             }
1535             }
1536             # extract unknown tags if specified
1537             $tagInfo = {
1538 0         0 Name => $tag,
1539             Writable => 0,
1540             PrintConv => \&Image::ExifTool::LimitLongValues,
1541             };
1542 0         0 AddTagToTable($tagTablePtr, $tag, $tagInfo);
1543 0         0 last;
1544             }
1545              
1546             # read value and uncompress if necessary
1547 606   50     2512 my $formatStr = $mieFormat{$format & 0xfb} || 'undef';
1548 606 50 0     1547 if ($tagInfo or ($formatStr eq 'MIE' and $format & 0x04)) {
      33        
1549 606 50       1817 $raf->Read($value, $valLen) == $valLen or last;
1550 606 50       1582 if ($format & 0x04) {
1551 0 0       0 if ($verbose) {
1552 0         0 print $out "$$et{INDENT}\[Tag '${tag}' $valLen bytes compressed]\n";
1553             }
1554 0 0       0 next unless HasZlib($et, 'decode');
1555 0         0 my $stat;
1556 0         0 my $inflate = Compress::Zlib::inflateInit();
1557 0 0       0 $inflate and ($value, $stat) = $inflate->inflate($value);
1558 0 0 0     0 unless ($inflate and $stat == Compress::Zlib::Z_STREAM_END()) {
1559 0         0 $et->Warn("Error inflating $tag");
1560 0         0 next;
1561             }
1562 0         0 $valLen = length $value;
1563 0         0 $wasCompressed = 1;
1564             }
1565             }
1566              
1567             # process this tag
1568 606 100       1235 if ($formatStr eq 'MIE') {
1569             # process MIE directory
1570 113         264 my ($subTablePtr, $dirName);
1571 113 50 33     600 if ($tagInfo and $$tagInfo{SubDirectory}) {
1572 113         276 $dirName = $tagInfo->{SubDirectory}->{DirName};
1573 113         276 my $subTable = $tagInfo->{SubDirectory}->{TagTable};
1574 113 50       634 $subTablePtr = $subTable ? GetTagTable($subTable) : $tagTablePtr;
1575             } else {
1576 0         0 $subTablePtr = GetTagTable('Image::ExifTool::MIE::Unknown');
1577             }
1578 113 50       379 if ($verbose) {
1579 0         0 my $order = ', byte order ' . GetByteOrder();
1580 0         0 $et->VerboseInfo($tag, $tagInfo, Size => $valLen, Extra => $order);
1581             }
1582             my %subdirInfo = (
1583             DirName => $dirName || $tag,
1584             RAF => $raf,
1585             Parent => $$dirInfo{DirName},
1586 113   33     943 WasCompressed => $wasCompressed,
1587             );
1588             # read from uncompressed data instead if necessary
1589 113 50       321 $subdirInfo{RAF} = File::RandomAccess->new(\$value) if $valLen;
1590              
1591 113         336 my $oldOrder = GetByteOrder();
1592 113 50       484 SetByteOrder($format & 0x08 ? 'II' : 'MM');
1593 113         596 $msg = ProcessMIEGroup($et, \%subdirInfo, $subTablePtr);
1594 113         446 SetByteOrder($oldOrder);
1595 113         293 $$et{SET_GROUP1} = $grp1; # restore this group1 name
1596 113 50       588 last if $msg;
1597             } else {
1598             # process MIE data format types
1599 493 50       992 if ($tagInfo) {
1600 493         830 my ($rational, $binVal);
1601             # extract tag value
1602 493         1549 my $val = ReadMIEValue(\$value, 0, $formatStr, undef, $valLen, \$rational);
1603 493 50       2054 $binVal = substr($value, 0, $valLen) if $$et{OPTIONS}{SaveBin};
1604 493 50       1338 unless (defined $val) {
1605 0         0 $et->Warn("Error reading $tag value");
1606 0         0 $val = '';
1607             }
1608             # save type or mime type
1609 493 100 100     2107 $mime = $val if $tag eq '0Type' or $tag eq '2MIME';
1610 493 50       1074 if ($verbose) {
1611 0         0 my $count;
1612 0         0 my $s = Image::ExifTool::FormatSize($formatStr);
1613 0 0 0     0 if ($s and $formatStr !~ /^(utf|string|undef)/) {
1614 0         0 $count = $valLen / $s;
1615             }
1616 0 0       0 $et->VerboseInfo($lastTag, $tagInfo,
1617             DataPt => \$value,
1618             DataPos => $wasCompressed ? undef : $raf->Tell() - $valLen,
1619             Size => $valLen,
1620             Format => $formatStr,
1621             Value => $val,
1622             Count => $count,
1623             );
1624             }
1625 493 100       1260 if ($$tagInfo{SubDirectory}) {
1626 5         24 my $subTablePtr = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
1627             my %subdirInfo = (
1628             DirName => $$tagInfo{Name},
1629             DataPt => \$value,
1630             DataLen => $valLen,
1631             DirStart=> 0,
1632             DirLen => $valLen,
1633             Parent => $$dirInfo{DirName},
1634 5         51 WasCompressed => $wasCompressed,
1635             );
1636             # set DataPos and Base for uncompressed information only
1637 5 50       21 unless ($wasCompressed) {
1638 5         19 $subdirInfo{DataPos} = 0; # (relative to Base)
1639 5         36 $subdirInfo{Base} = $raf->Tell() - $valLen;
1640             }
1641             # reset PROCESSED lookup for each MIE directory
1642             # (there is no possibility of double-processing a MIE directory)
1643 5         153 $$et{PROCESSED} = { };
1644 5         16 my $processProc = $tagInfo->{SubDirectory}->{ProcessProc};
1645 5         17 delete $$et{SET_GROUP1};
1646 5         11 delete $$et{NO_LIST};
1647 5         30 $et->ProcessDirectory(\%subdirInfo, $subTablePtr, $processProc);
1648 5         23 $$et{SET_GROUP1} = $grp1;
1649 5         37 $$et{NO_LIST} = 1;
1650             } else {
1651             # convert to specified character set if necessary
1652 488 100 100     1824 if ($notUTF8 and $formatStr =~ /^(utf|string)/) {
1653 117         401 $val = $et->Decode($val, 'UTF8');
1654             }
1655 488 100       1405 if ($formatStr =~ /_list$/) {
1656             # split list value into separate strings
1657 8         51 my @vals = split "\0", $val;
1658 8         23 $val = \@vals;
1659             }
1660 488 100       1025 if (defined $units) {
1661 8 50       27 $val = "@$val" if ref $val; # convert string list to number list
1662             # add units to value if specified
1663 8 50       39 $val .= "($units)" if defined $units;
1664             }
1665 488         1773 my $key = $et->FoundTag($tagInfo, $val);
1666 488 50       1179 if (defined $key) {
1667 488         1105 my $ex = $$et{TAG_EXTRA}{$key};
1668 488 100       1149 $$ex{Rational} = $rational if defined $rational;
1669 488 50       992 $$ex{BinVal} = $binVal if defined $binVal;
1670 488 50       1841 $$ex{G6} = $formatStr if $$et{OPTIONS}{SaveFormat};
1671             }
1672             }
1673             } else {
1674             # skip over unknown information or free bytes
1675 0 0       0 $raf->Seek($valLen, 1) or $msg = 'Seek error', last;
1676 0 0       0 $verbose and $et->VerboseInfo($tag, undef, Size => $valLen);
1677             }
1678             }
1679             }
1680             # modify MIME type if necessary
1681 140 100 66     413 $mime and not $$dirInfo{Parent} and $et->ModifyMimeType($mime);
1682              
1683 140 50 33     459 $ok or $msg or $msg = 'Unexpected end of file';
1684 140 50       332 $verbose and $$et{INDENT} = $oldIndent;
1685 140         440 return $msg;
1686             }
1687              
1688             #------------------------------------------------------------------------------
1689             # Read/write a MIE file
1690             # Inputs: 0) ExifTool object reference, 1) DirInfo reference
1691             # Returns: 1 on success, 0 if this wasn't a valid MIE file, or -1 on write error
1692             # - process as a trailer if "Trailer" flag set in dirInfo
1693             sub ProcessMIE($$)
1694             {
1695 704     704 0 2539 my ($et, $dirInfo) = @_;
1696 704 100       3796 return 1 unless defined $et;
1697 36         122 my $raf = $$dirInfo{RAF};
1698 36         110 my $outfile = $$dirInfo{OutFile};
1699 36         103 my ($buff, $err, $msg, $pos, $end, $isCreating);
1700 36         86 my $numDocs = 0;
1701             #
1702             # process as a trailer (from end of file) if specified
1703             #
1704 36 100       154 if ($$dirInfo{Trailer}) {
1705 26   50     98 my $offset = $$dirInfo{Offset} || 0; # offset from end of file
1706 26 50       110 $raf->Seek(-10 - $offset, 2) or return 0;
1707 26         62 for (;;) {
1708             # read and validate last 10 bytes
1709 52 50       181 $raf->Read($buff, 10) == 10 or last;
1710 52 100 66     445 last unless $buff =~ /~\0\0\x06.{4}(\x10|\x18)(\x04)$/s or
1711             $buff =~ /(\x10|\x18)(\x08)$/s;
1712 26 50       200 SetByteOrder($1 eq "\x10" ? 'MM' : 'II');
1713 26 50       188 my $len = ($2 eq "\x04") ? Get32u(\$buff, 4) : Get64u(\$buff, 0);
1714 26 50       131 my $curPos = $raf->Tell() or last;
1715 26 50 33     184 last if $len < 12 or $len > $curPos;
1716             # validate element header if 8-byte offset was used
1717 26 50       102 if ($2 eq "\x08") {
1718 0 0       0 last if $len < 14;
1719 0 0 0     0 $raf->Seek($curPos - 14, 0) and $raf->Read($buff, 4) or last;
1720 0 0       0 last unless $buff eq "~\0\0\x0a";
1721             }
1722             # looks like a good group, so remember start position
1723 26         62 $pos = $curPos - $len;
1724 26 50       96 $end = $curPos unless $end;
1725             # seek to 10 bytes from end of previous group
1726 26 50       124 $raf->Seek($pos - 10, 0) or last;
1727             }
1728             # seek to start of first MIE group
1729 26 50 33     140 return 0 unless defined $pos and $raf->Seek($pos, 0);
1730             # update DataPos and DirLen for ProcessTrailers()
1731 26         88 $$dirInfo{DataPos} = $pos;
1732 26         93 $$dirInfo{DirLen} = $end - $pos;
1733 26 50 66     253 if ($outfile and $$et{DEL_GROUP}{MIE}) {
    50 33        
1734             # delete the trailer
1735 0         0 $et->VPrint(0," Deleting MIE trailer\n");
1736 0         0 ++$$et{CHANGED};
1737 0         0 return 1;
1738             } elsif ($et->Options('Verbose') or $$et{HTML_DUMP}) {
1739 0         0 $et->DumpTrailer($dirInfo);
1740             }
1741             }
1742             #
1743             # loop through all documents in MIE file
1744             #
1745 36         74 for (;;) {
1746             # look for "0MIE" group element
1747 72         331 my $num = $raf->Read($buff, 8);
1748 72 100       280 if ($num == 8) {
    100          
1749             # verify file identifier
1750 61 100       395 if ($buff =~ /^~(\x10|\x18)\x04(.)0MIE/s) {
1751 35 50       260 SetByteOrder($1 eq "\x10" ? 'MM' : 'II');
1752 35         113 my $len = ord($2);
1753             # skip extended DataLength if it exists
1754 35 50 33     264 if ($len > 252 and not $raf->Seek(1 << (256 - $len), 1)) {
1755 0         0 $msg = 'Seek error';
1756 0         0 last;
1757             }
1758             } else {
1759 26 50       77 return 0 unless $numDocs; # not a MIE file
1760 26 50       194 if ($buff =~ /^~/) {
1761 0         0 $msg = 'Non-standard file-level MIE element';
1762             } else {
1763 26         75 $msg = 'Invalid MIE file-level data';
1764             }
1765             }
1766             } elsif ($numDocs) {
1767 10 50       48 last unless $num; # OK, all done with file
1768 0         0 $msg = 'Truncated MIE element header';
1769             } else {
1770 1 50 33     12 return 0 if $num or not $outfile;
1771             # we have the ability to create a MIE file from scratch
1772 1         3 $buff = ''; # start from nothing
1773             # set byte order according to preferences
1774 1         8 $et->SetPreferredByteOrder();
1775 1         3 $isCreating = 1;
1776             }
1777 62 100       244 if ($msg) {
1778 26 50       141 last if $$dirInfo{Trailer}; # allow other trailers after MIE
1779 0 0       0 if ($outfile) {
1780 0         0 $et->Error($msg);
1781             } else {
1782 0         0 $et->Warn($msg);
1783             }
1784 0         0 last;
1785             }
1786             # this is a new MIE document -- increment document count
1787 36 50       135 unless ($numDocs) {
1788             # this is a valid MIE file (unless a trailer on another file)
1789 36         276 $et->SetFileType();
1790 36         142 $$et{NO_LIST} = 1; # handle lists ourself
1791 36         148 $$et{MIE_COUNT} = { };
1792 36         114 undef $hasZlib;
1793             }
1794 36         77 ++$numDocs;
1795              
1796             # process the MIE groups recursively, beginning with the main MIE group
1797 36         145 my $tagTablePtr = GetTagTable('Image::ExifTool::MIE::Main');
1798              
1799 36         223 my %subdirInfo = (
1800             DirName => 'MIE',
1801             RAF => $raf,
1802             OutFile => $outfile,
1803             # don't define Parent so WriteMIEGroup() writes extended terminator
1804             );
1805 36 100       139 if ($outfile) {
1806             # save start position in $outfile
1807 9 100 50     79 $subdirInfo{OutPos} = ref $outfile eq 'SCALAR' ? length($$outfile) || 0 : tell $outfile;
1808             # generate lookup for MIE format codes if not done already
1809 9 100       36 unless (%mieCode) {
1810 3         43 foreach (keys %mieFormat) {
1811 90         251 $mieCode{$mieFormat{$_}} = $_;
1812             }
1813             }
1814             # update %mieMap with user-defined MIE groups
1815 9 100       48 UpdateMieMap() unless $doneMieMap;
1816             # initialize write directories, with MIE tags taking priority
1817             # (note that this may re-initialize directories when writing trailer
1818             # to another type of image, but this is OK because we are done writing
1819             # the other format by the time we start writing the trailer)
1820 9         148 $et->InitWriteDirs(\%mieMap, 'MIE');
1821 9         55 $subdirInfo{ToWrite} = '~' . MIEGroupFormat(1) . "\x04\xfe0MIE\0\0\0\0";
1822 9         53 $msg = WriteMIEGroup($et, \%subdirInfo, $tagTablePtr);
1823 9 50 33     101 if ($msg) {
    50          
1824 0         0 $et->Error($msg);
1825 0         0 $err = 1;
1826 0         0 last;
1827             } elsif (defined $msg and $isCreating) {
1828 0         0 last;
1829             }
1830             } else {
1831 27         150 $msg = ProcessMIEGroup($et, \%subdirInfo, $tagTablePtr);
1832 27 50       162 if ($msg) {
1833 0         0 $et->Warn($msg);
1834 0         0 last;
1835             }
1836             }
1837             }
1838 36         113 delete $$et{NO_LIST};
1839 36         171 delete $$et{MIE_COUNT};
1840 36         96 delete $$et{SET_GROUP1};
1841 36 50       244 return $err ? -1 : 1;
1842             }
1843              
1844             1; # end
1845              
1846             __END__