File Coverage

blib/lib/Image/ExifTool/MinoltaRaw.pm
Criterion Covered Total %
statement 73 86 84.8
branch 27 56 48.2
condition 5 15 33.3
subroutine 6 7 85.7
pod 0 3 0.0
total 111 167 66.4


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: MinoltaRaw.pm
3             #
4             # Description: Read/write Konica-Minolta RAW (MRW) meta information
5             #
6             # Revisions: 03/11/2006 - P. Harvey Split out from Minolta.pm
7             #
8             # References: 1) http://www.cybercom.net/~dcoffin/dcraw/
9             # 2) http://www.chauveau-central.net/mrw-format/
10             # 3) Igal Milchtaich private communication (A100)
11             #------------------------------------------------------------------------------
12              
13             package Image::ExifTool::MinoltaRaw;
14              
15 14     14   87 use strict;
  14         31  
  14         460  
16 14     14   75 use vars qw($VERSION);
  14         28  
  14         543  
17 14     14   81 use Image::ExifTool qw(:DataAccess :Utils);
  14         30  
  14         2676  
18 14     14   3536 use Image::ExifTool::Minolta;
  14         66  
  14         19324  
19              
20             $VERSION = '1.16';
21              
22             sub ProcessMRW($$;$);
23             sub WriteMRW($$;$);
24              
25             # Minolta MRW tags
26             %Image::ExifTool::MinoltaRaw::Main = (
27             GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
28             PROCESS_PROC => \&Image::ExifTool::MinoltaRaw::ProcessMRW,
29             WRITE_PROC => \&Image::ExifTool::MinoltaRaw::WriteMRW,
30             NOTES => 'These tags are used in Minolta RAW format (MRW) images.',
31             "\0TTW" => { # TIFF Tags
32             Name => 'MinoltaTTW',
33             SubDirectory => {
34             TagTable => 'Image::ExifTool::Exif::Main',
35             # this EXIF information starts with a TIFF header
36             ProcessProc => \&Image::ExifTool::ProcessTIFF,
37             WriteProc => \&Image::ExifTool::WriteTIFF,
38             },
39             },
40             "\0PRD" => { # Raw Picture Dimensions
41             Name => 'MinoltaPRD',
42             SubDirectory => { TagTable => 'Image::ExifTool::MinoltaRaw::PRD' },
43             },
44             "\0WBG" => { # White Balance Gains
45             Name => 'MinoltaWBG',
46             SubDirectory => { TagTable => 'Image::ExifTool::MinoltaRaw::WBG' },
47             },
48             "\0RIF" => { # Requested Image Format
49             Name => 'MinoltaRIF',
50             SubDirectory => { TagTable => 'Image::ExifTool::MinoltaRaw::RIF' },
51             },
52             # "\0CSA" is padding
53             );
54              
55             # Minolta MRW PRD information (ref 2)
56             %Image::ExifTool::MinoltaRaw::PRD = (
57             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
58             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
59             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
60             WRITABLE => 1,
61             GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
62             DATAMEMBER => [ 0 ],
63             FIRST_ENTRY => 0,
64             0 => {
65             Name => 'FirmwareID',
66             Format => 'string[8]',
67             RawConv => '$$self{MinoltaPRD} = 1 if $$self{FILE_TYPE} eq "MRW"; $val', # used in decoding RIF info
68             },
69             8 => {
70             Name => 'SensorHeight',
71             Format => 'int16u',
72             },
73             10 => {
74             Name => 'SensorWidth',
75             Format => 'int16u',
76             },
77             12 => {
78             Name => 'ImageHeight',
79             Format => 'int16u',
80             },
81             14 => {
82             Name => 'ImageWidth',
83             Format => 'int16u',
84             },
85             16 => {
86             Name => 'RawDepth',
87             Format => 'int8u',
88             },
89             17 => {
90             Name => 'BitDepth',
91             Format => 'int8u',
92             },
93             18 => {
94             Name => 'StorageMethod',
95             Format => 'int8u',
96             PrintConv => {
97             82 => 'Padded',
98             89 => 'Linear',
99             },
100             },
101             23 => {
102             Name => 'BayerPattern',
103             Format => 'int8u',
104             PrintConv => {
105             # 0 - seen in some Sony A850 ARW images
106             1 => 'RGGB',
107             4 => 'GBRG',
108             },
109             },
110             );
111              
112             # Minolta MRW WBG information (ref 2)
113             %Image::ExifTool::MinoltaRaw::WBG = (
114             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
115             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
116             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
117             WRITABLE => 1,
118             GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
119             FIRST_ENTRY => 0,
120             0 => {
121             Name => 'WBScale',
122             Format => 'int8u[4]',
123             },
124             4 => [
125             {
126             Condition => '$$self{Model} =~ /DiMAGE A200\b/',
127             Name => 'WB_GBRGLevels',
128             Format => 'int16u[4]',
129             Notes => 'DiMAGE A200',
130             },
131             {
132             Name => 'WB_RGGBLevels',
133             Format => 'int16u[4]',
134             Notes => 'other models',
135             },
136             ],
137             );
138              
139             # Minolta MRW RIF information (ref 2)
140             %Image::ExifTool::MinoltaRaw::RIF = (
141             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
142             WRITE_PROC => \&Image::ExifTool::WriteBinaryData,
143             CHECK_PROC => \&Image::ExifTool::CheckBinaryData,
144             WRITABLE => 1,
145             GROUPS => { 0 => 'MakerNotes', 2 => 'Image' },
146             FIRST_ENTRY => 0,
147             1 => {
148             Name => 'Saturation',
149             Format => 'int8s',
150             },
151             2 => {
152             Name => 'Contrast',
153             Format => 'int8s',
154             },
155             3 => {
156             Name => 'Sharpness',
157             Format => 'int8s',
158             },
159             4 => {
160             Name => 'WBMode',
161             PrintConv => 'Image::ExifTool::MinoltaRaw::ConvertWBMode($val)',
162             },
163             5 => {
164             Name => 'ProgramMode',
165             PrintConv => {
166             0 => 'None',
167             1 => 'Portrait',
168             2 => 'Text',
169             3 => 'Night Portrait',
170             4 => 'Sunset',
171             5 => 'Sports',
172             # have seen these values in Sony ARW images: - PH
173             # 7, 128, 129, 160
174             },
175             },
176             6 => {
177             Name => 'ISOSetting',
178             RawConv => '$val == 255 ? undef : $val',
179             PrintConv => { #3
180             0 => 'Auto',
181             48 => 100,
182             56 => 200,
183             64 => 400,
184             72 => 800,
185             80 => 1600,
186             174 => '80 (Zone Matching Low)',
187             184 => '200 (Zone Matching High)',
188             OTHER => sub {
189             my ($val, $inv) = @_;
190             return int(2 ** (($val-48)/8) * 100 + 0.5) unless $inv;
191             # (must check for zero below in inverse conversion)
192             return 48 + 8*log($val/100)/log(2) if Image::ExifTool::IsFloat($val) and $val != 0;
193             return undef;
194             },
195             },
196             #ValueConv => '2 ** (($val-48)/8) * 100',
197             #ValueConvInv => '48 + 8*log($val/100)/log(2)',
198             #PrintConv => 'int($val + 0.5)',
199             #PrintConvInv => '$val',
200             },
201             7 => [
202             {
203             Name => 'ColorMode',
204             Condition => '$$self{Make} !~ /^SONY/',
205             Priority => 0,
206             Writable => 'int32u',
207             PrintConv => \%Image::ExifTool::Minolta::minoltaColorMode,
208             },
209             { #3
210             Name => 'ColorMode',
211             Condition => '$$self{Model} eq "DSLR-A100"',
212             Writable => 'int32u',
213             Notes => 'Sony A100',
214             Priority => 0,
215             PrintHex => 1,
216             PrintConv => \%Image::ExifTool::Minolta::sonyColorMode,
217             },
218             ],
219             # NOTE: WB_RBLevels up to Custom also apply to Minolta models which write PRD info (ref IB)
220             8 => { #3
221             Name => 'WB_RBLevelsTungsten',
222             Condition => '$$self{Model} eq "DSLR-A100" or $$self{MinoltaPRD}',
223             Format => 'int16u[2]',
224             Notes => 'these WB_RBLevels currently decoded only for the Sony A100',
225             },
226             12 => { #3
227             Name => 'WB_RBLevelsDaylight',
228             Condition => '$$self{Model} eq "DSLR-A100" or $$self{MinoltaPRD}',
229             Format => 'int16u[2]',
230             },
231             16 => { #3
232             Name => 'WB_RBLevelsCloudy',
233             Condition => '$$self{Model} eq "DSLR-A100" or $$self{MinoltaPRD}',
234             Format => 'int16u[2]',
235             },
236             20 => { #3
237             Name => 'WB_RBLevelsCoolWhiteF',
238             Condition => '$$self{Model} eq "DSLR-A100" or $$self{MinoltaPRD}',
239             Format => 'int16u[2]',
240             },
241             24 => { #3
242             Name => 'WB_RBLevelsFlash',
243             Condition => '$$self{Model} eq "DSLR-A100" or $$self{MinoltaPRD}',
244             Format => 'int16u[2]',
245             },
246             28 => { #3
247             Name => 'WB_RBLevelsCustom', #IB
248             Condition => '$$self{Model} eq "DSLR-A100" or $$self{MinoltaPRD}',
249             Format => 'int16u[2]',
250             },
251             32 => { #3
252             Name => 'WB_RBLevelsShade',
253             Condition => '$$self{Model} eq "DSLR-A100"',
254             Format => 'int16u[2]',
255             },
256             36 => { #3
257             Name => 'WB_RBLevelsDaylightF',
258             Condition => '$$self{Model} eq "DSLR-A100"',
259             Format => 'int16u[2]',
260             },
261             40 => { #3
262             Name => 'WB_RBLevelsDayWhiteF',
263             Condition => '$$self{Model} eq "DSLR-A100"',
264             Format => 'int16u[2]',
265             },
266             44 => { #3
267             Name => 'WB_RBLevelsWhiteF',
268             Condition => '$$self{Model} eq "DSLR-A100"',
269             Format => 'int16u[2]',
270             },
271             56 => {
272             Name => 'ColorFilter',
273             Condition => '$$self{Make} !~ /^SONY/',
274             Format => 'int8s',
275             Notes => 'Minolta models',
276             },
277             57 => 'BWFilter',
278             58 => {
279             Name => 'ZoneMatching',
280             Condition => '$$self{Make} !~ /^SONY/',
281             Priority => 0,
282             Notes => 'Minolta models',
283             PrintConv => {
284             0 => 'ISO Setting Used',
285             1 => 'High Key',
286             2 => 'Low Key',
287             },
288             },
289             59 => {
290             Name => 'Hue',
291             Format => 'int8s',
292             },
293             60 => {
294             Name => 'ColorTemperature',
295             Condition => '$$self{Make} !~ /^SONY/',
296             Notes => 'Minolta models',
297             ValueConv => '$val * 100',
298             ValueConvInv => '$val / 100',
299             },
300             74 => { #3
301             Name => 'ZoneMatching',
302             Condition => '$$self{Make} =~ /^SONY/',
303             Priority => 0,
304             Notes => 'Sony models',
305             PrintConv => {
306             0 => 'ISO Setting Used',
307             1 => 'High Key',
308             2 => 'Low Key',
309             },
310             },
311             76 => { #3
312             Name => 'ColorTemperature',
313             Condition => '$$self{Model} eq "DSLR-A100"',
314             Notes => 'A100',
315             ValueConv => '$val * 100',
316             ValueConvInv => '$val / 100',
317             PrintConv => '$val ? $val : "Auto"',
318             PrintConvInv => '$val=~/Auto/i ? 0 : $val',
319             },
320             77 => { #3
321             Name => 'ColorFilter',
322             Condition => '$$self{Model} eq "DSLR-A100"',
323             Notes => 'A100',
324             },
325             78 => { #3
326             Name => 'ColorTemperature',
327             Condition => '$$self{Model} =~ /^DSLR-A(200|700)$/',
328             Notes => 'A200 and A700',
329             ValueConv => '$val * 100',
330             ValueConvInv => '$val / 100',
331             PrintConv => '$val ? $val : "Auto"',
332             PrintConvInv => '$val=~/Auto/i ? 0 : $val',
333             },
334             79 => { #3
335             Name => 'ColorFilter',
336             Condition => '$$self{Model} =~ /^DSLR-A(200|700)$/',
337             Notes => 'A200 and A700',
338             },
339             80 => { #3
340             Name => 'RawDataLength',
341             Condition => '$$self{Model} eq "DSLR-A100"',
342             Format => 'int32u',
343             Notes => 'A100',
344             Writable => 0,
345             },
346             );
347              
348             #------------------------------------------------------------------------------
349             # PrintConv for WBMode
350             sub ConvertWBMode($)
351             {
352 1     1 0 3 my $val = shift;
353 1         17 my %mrwWB = (
354             0 => 'Auto',
355             1 => 'Daylight',
356             2 => 'Cloudy',
357             3 => 'Tungsten',
358             4 => 'Flash/Fluorescent',
359             5 => 'Fluorescent',
360             6 => 'Shade',
361             7 => 'User 1',
362             8 => 'User 2',
363             9 => 'User 3',
364             10 => 'Temperature',
365             );
366 1         3 my $lo = $val & 0x0f;
367 1   33     5 my $wbstr = $mrwWB{$lo} || "Unknown ($lo)";
368 1         3 my $hi = $val >> 4;
369 1 50 33     10 $wbstr .= ' (' . ($hi - 8) . ')' if $hi >= 6 and $hi <=12;
370 1         8 return $wbstr;
371             }
372              
373             #------------------------------------------------------------------------------
374             # Write MRW directory (eg. in ARW images)
375             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
376             # Returns: new MRW data or undef on error
377             sub WriteMRW($$;$)
378             {
379 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
380 0 0       0 $et or return 1; # allow dummy access
381 0         0 my $buff = '';
382 0         0 $$dirInfo{OutFile} = \$buff;
383 0 0       0 ProcessMRW($et, $dirInfo, $tagTablePtr) > 0 or undef $buff;
384 0         0 return $buff;
385             }
386              
387             #------------------------------------------------------------------------------
388             # Read or write Minolta MRW file
389             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) optional tag table ref
390             # Returns: 1 on success, 0 if this wasn't a valid MRW file, or -1 on write error
391             # Notes: File pointer must be set to start of MRW in RAF upon entry
392             sub ProcessMRW($$;$)
393             {
394 2     2 0 15 my ($et, $dirInfo, $tagTablePtr) = @_;
395 2         6 my $raf = $$dirInfo{RAF};
396 2         6 my $outfile = $$dirInfo{OutFile};
397 2         9 my $verbose = $et->Options('Verbose');
398 2         7 my $out = $et->Options('TextOut');
399 2         5 my ($data, $err, $outBuff);
400              
401 2 50       7 if ($$dirInfo{DataPt}) {
402             # make a RAF object for MRW information extracted from other file types
403 0         0 $raf = new File::RandomAccess($$dirInfo{DataPt});
404             # MRW information in DNG images may not start at beginning of data block
405 0 0       0 $raf->Seek($$dirInfo{DirStart}, 0) if $$dirInfo{DirStart};
406             }
407 2 50       9 $raf->Read($data,8) == 8 or return 0;
408             # "\0MRM" for big-endian (MRW images), and
409             # "\0MRI" for little-endian (MRWInfo in ARW images)
410 2 50       13 $data =~ /^\0MR([MI])/ or return 0;
411 2         9 my $hdr = "\0MR$1";
412 2         13 SetByteOrder($1 . $1);
413 2         12 $et->SetFileType();
414 2         6 $tagTablePtr = GetTagTable('Image::ExifTool::MinoltaRaw::Main');
415 2 100       6 if ($outfile) {
416 1         7 $et->InitWriteDirs('TIFF'); # use same write dirs as TIFF
417 1         2 $outBuff = '';
418             }
419 2         8 my $pos = $raf->Tell();
420 2         9 my $offset = Get32u(\$data, 4) + $pos;
421 2         3 my $rtnVal = 1;
422 2 50       6 $verbose and printf $out " [MRW Data Offset: 0x%x]\n", $offset;
423             # loop through MRW segments (ref 1)
424 2         7 while ($pos < $offset) {
425 10 50       34 $raf->Read($data,8) == 8 or $err = 1, last;
426 10         18 $pos += 8;
427 10         25 my $tag = substr($data, 0, 4);
428 10         29 my $len = Get32u(\$data, 4);
429 10 50       223 if ($verbose) {
430 0         0 print $out "MRW ",$et->Printable($tag)," segment ($len bytes):\n";
431 0 0       0 if ($verbose > 2) {
432 0 0 0     0 $raf->Read($data,$len) == $len and $raf->Seek($pos,0) or $err = 1, last;
433 0         0 $et->VerboseDump(\$data);
434             }
435             }
436 10         31 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tag);
437 10 100 66     45 if ($tagInfo and $$tagInfo{SubDirectory}) {
    100          
438 8         23 my $subTable = GetTagTable($tagInfo->{SubDirectory}->{TagTable});
439 8         13 my $buff;
440             # save shift for values stored with wrong base offset
441 8         22 $$et{MRW_WrongBase} = -($raf->Tell());
442 8 50       18 $raf->Read($buff, $len) == $len or $err = 1, last;
443             my %subdirInfo = (
444             DataPt => \$buff,
445             DataLen => $len,
446             DataPos => $pos,
447             DirStart => 0,
448             DirLen => $len,
449             DirName => $$tagInfo{Name},
450 8         57 Parent => 'MRW',
451             NoTiffEnd => 1, # no end-of-TIFF check
452             );
453 8 100       21 if ($outfile) {
454 4         5 my $writeProc = $tagInfo->{SubDirectory}->{WriteProc};
455 4         17 my $val = $et->WriteDirectory(\%subdirInfo, $subTable, $writeProc);
456 4 50 33     18 if (defined $val and length $val) {
    0          
457             # pad to an even 4 bytes (can't hurt, and it seems to be the standard)
458 4 50       11 $val .= "\0" x (4 - (length($val) & 0x03)) if length($val) & 0x03;
459 4         11 $outBuff .= $tag . Set32u(length $val) . $val;
460             } elsif (not defined $val) {
461 0         0 $outBuff .= $data . $buff; # copy over original information
462             }
463             } else {
464 4         8 my $processProc = $tagInfo->{SubDirectory}->{ProcessProc};
465 4         16 $et->ProcessDirectory(\%subdirInfo, $subTable, $processProc);
466             }
467             } elsif ($outfile) {
468             # add this segment to the output buffer
469 1         2 my $buff;
470 1 50       3 $raf->Read($buff, $len) == $len or $err = 1, last;
471 1         4 $outBuff .= $data . $buff;
472             } else {
473             # skip this segment
474 1 50       7 $raf->Seek($pos+$len, 0) or $err = 1, last;
475             }
476 10         42 $pos += $len;
477             }
478 2 50       8 $pos == $offset or $err = 1; # meta information length check
479              
480 2 100       7 if ($outfile) {
481             # write the file header then the buffered meta information
482 1 50       4 Write($outfile, $hdr, Set32u(length $outBuff), $outBuff) or $rtnVal = -1;
483             # copy over image data
484 1         4 while ($raf->Read($outBuff, 65536)) {
485 1 50       5 Write($outfile, $outBuff) or $rtnVal = -1;
486             }
487             # Sony IDC utility corrupts MRWInfo when writing ARW images,
488             # so make this a minor error for these images
489 1 50       4 $err and $et->Error("MRW format error", $$et{TIFF_TYPE} eq 'ARW');
490             } else {
491 1 50       5 $err and $et->Warn("MRW format error");
492             }
493 2         8 return $rtnVal;
494             }
495              
496             1; # end
497              
498             __END__