File Coverage

blib/lib/Image/ExifTool/PhaseOne.pm
Criterion Covered Total %
statement 157 223 70.4
branch 66 116 56.9
condition 41 89 46.0
subroutine 6 7 85.7
pod 0 3 0.0
total 270 438 61.6


line stmt bran cond sub pod time code
1             #------------------------------------------------------------------------------
2             # File: PhaseOne.pm
3             #
4             # Description: Phase One maker notes tags
5             #
6             # Revisions: 2013-02-17 - P. Harvey Created
7             #
8             # References: 1) http://www.cybercom.net/~dcoffin/dcraw/
9             #------------------------------------------------------------------------------
10              
11             package Image::ExifTool::PhaseOne;
12              
13 19     19   7110 use strict;
  19         55  
  19         899  
14 19     19   134 use vars qw($VERSION);
  19         42  
  19         1111  
15 19     19   123 use Image::ExifTool qw(:DataAccess :Utils);
  19         60  
  19         5519  
16 19     19   1666 use Image::ExifTool::Exif;
  19         46  
  19         74969  
17              
18             $VERSION = '1.12';
19              
20             sub WritePhaseOne($$$);
21             sub ProcessPhaseOne($$$);
22              
23             # default formats based on PhaseOne format size
24             my @formatName = ( undef, 'string', 'int16s', undef, 'int32s' );
25              
26             # Phase One maker notes (ref PH)
27             %Image::ExifTool::PhaseOne::Main = (
28             PROCESS_PROC => \&ProcessPhaseOne,
29             WRITE_PROC => \&WritePhaseOne,
30             CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
31             WRITABLE => '1',
32             FORMAT => 'int32s',
33             GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
34             VARS => { ENTRY_SIZE => 16 }, # (entries contain a format field)
35             NOTES => 'These tags are extracted from the maker notes of Phase One images.',
36             0x0100 => { #1
37             Name => 'CameraOrientation',
38             ValueConv => '$val & 0x03', # ignore other bits for now
39             PrintConv => {
40             0 => 'Horizontal (normal)',
41             1 => 'Rotate 90 CW',
42             2 => 'Rotate 270 CW',
43             3 => 'Rotate 180',
44             },
45             },
46             # 0x0101 - int32u: 96,160,192,256,544 (same as 0x0213)
47             0x0102 => { Name => 'SerialNumber', Format => 'string' },
48             # 0x0103 - int32u: 19,20,59769034
49             # 0x0104 - int32u: 50,200
50             0x0105 => 'ISO',
51             0x0106 => {
52             Name => 'ColorMatrix1',
53             Format => 'float',
54             Count => 9,
55             PrintConv => q{
56             my @a = map { sprintf('%.3f', $_) } split ' ', $val;
57             return "@a";
58             },
59             PrintConvInv => '$val',
60             },
61             0x0107 => { Name => 'WB_RGBLevels', Format => 'float', Count => 3 },
62             0x0108 => 'SensorWidth',
63             0x0109 => 'SensorHeight',
64             0x010a => 'SensorLeftMargin', #1
65             0x010b => 'SensorTopMargin', #1
66             0x010c => 'ImageWidth',
67             0x010d => 'ImageHeight',
68             0x010e => { #1
69             Name => 'RawFormat',
70             # 1 = raw bit mask 0x5555 (>1 mask 0x1354)
71             # >2 = compressed
72             # 5 = non-linear
73             PrintConv => { #PH
74             0 => 'Uncompressed', #https://github.com/darktable-org/darktable/issues/7308
75             1 => 'RAW 1', #? (encrypted)
76             2 => 'RAW 2', #? (encrypted)
77             3 => 'IIQ L', # (now "L14", ref IB)
78             # 4?
79             5 => 'IIQ S',
80             6 => 'IIQ Sv2', # (now "S14" for "IIQ 14 Smart" and "IIQ 14 Sensor+", ref IB)
81             8 => 'IIQ L16', #IB ("IIQ 16 Extended" and "IIQ 16 Large")
82             },
83             },
84             0x010f => {
85             Name => 'RawData',
86             Format => 'undef', # (actually 2-byte integers, but don't convert)
87             Binary => 1,
88             IsImageData => 1,
89             PutFirst => 1,
90             Writable => 0,
91             Drop => 1, # don't copy to other file types
92             },
93             0x0110 => { #1
94             Name => 'SensorCalibration',
95             SubDirectory => { TagTable => 'Image::ExifTool::PhaseOne::SensorCalibration' },
96             },
97             0x0112 => {
98             Name => 'DateTimeOriginal',
99             Description => 'Date/Time Original',
100             Format => 'int32u',
101             Writable => 0, # (don't write because this is an encryption key for RawFormat 1 and 2)
102             Priority => 0,
103             Shift => 'Time',
104             Groups => { 2 => 'Time' },
105             Notes => 'may be used as a key to encrypt the raw data', #1
106             ValueConv => 'ConvertUnixTime($val)',
107             ValueConvInv => 'GetUnixTime($val)',
108             PrintConv => '$self->ConvertDateTime($val)',
109             PrintConvInv => '$self->InverseDateTime($val)',
110             },
111             0x0113 => 'ImageNumber', # (NC)
112             0x0203 => { Name => 'Software', Format => 'string' },
113             0x0204 => { Name => 'System', Format => 'string' },
114             # 0x020b - int32u: 0,1
115             # 0x020c - int32u: 1,2
116             # 0x020e - int32u: 1,3
117             0x0210 => { # (NC) (used in linearization formula - ref 1)
118             Name => 'SensorTemperature',
119             Format => 'float',
120             PrintConv => 'sprintf("%.2f C",$val)',
121             PrintConvInv => '$val=~s/ ?C//; $val',
122             },
123             0x0211 => { # (NC)
124             Name => 'SensorTemperature2',
125             Format => 'float',
126             PrintConv => 'sprintf("%.2f C",$val)',
127             PrintConvInv => '$val=~s/ ?C//; $val',
128             },
129             0x0212 => {
130             Name => 'UnknownDate',
131             Format => 'int32u',
132             Groups => { 2 => 'Time' },
133             # (this time is within about 10 minutes before or after 0x0112)
134             Unknown => 1,
135             Shift => 'Time',
136             ValueConv => 'ConvertUnixTime($val)',
137             ValueConvInv => 'GetUnixTime($val)',
138             PrintConv => '$self->ConvertDateTime($val)',
139             PrintConvInv => '$self->InverseDateTime($val)',
140             },
141             # 0x0213 - int32u: 96,160,192,256,544 (same as 0x0101)
142             # 0x0215 - int32u: 4,5
143             # 0x021a - used by dcraw
144             0x021c => { Name => 'StripOffsets', Binary => 1, Writable => 0 },
145             0x021d => 'BlackLevel', #1
146             # 0x021e - int32u: 1
147             # 0x0220 - int32u: 32
148             # 0x0221 - float: 0-271
149             0x0222 => 'SplitColumn', #1
150             0x0223 => { Name => 'BlackLevelData', Format => 'int16u', Count => -1, Binary => 1 }, #1
151             # 0x0224 - int32u: 1688,2748,3372
152             0x0225 => {
153             Name => 'PhaseOne_0x0225',
154             Format => 'int16s',
155             Count => -1,
156             Flags => ['Unknown','Hidden'],
157             PrintConv => \&Image::ExifTool::LimitLongValues,
158             },
159             0x0226 => {
160             Name => 'ColorMatrix2',
161             Format => 'float',
162             Count => 9,
163             PrintConv => q{
164             my @a = map { sprintf('%.3f', $_) } split ' ', $val;
165             return "@a";
166             },
167             PrintConvInv => '$val',
168             },
169             # 0x0227 - int32u: 0,1
170             # 0x0228 - int32u: 1,2
171             # 0x0229 - int32s: -2,0
172             0x0267 => { #PH
173             Name => 'AFAdjustment',
174             Format => 'float',
175             },
176             0x022b => { #PH
177             Name => 'PhaseOne_0x022b',
178             Format => 'float',
179             Flags => ['Unknown','Hidden'],
180             },
181             # 0x0242 - int32u: 55
182             # 0x0244 - int32u: 102
183             # 0x0245 - float: 1.2
184             0x0258 => { #PH
185             Name => 'PhaseOne_0x0258',
186             Format => 'int16s',
187             Flags => ['Unknown','Hidden'],
188             PrintConv => \&Image::ExifTool::LimitLongValues,
189             },
190             0x025a => { #PH
191             Name => 'PhaseOne_0x025a',
192             Format => 'int16s',
193             Flags => ['Unknown','Hidden'],
194             PrintConv => \&Image::ExifTool::LimitLongValues,
195             },
196             0x0262 => { Name => 'SequenceID', Format => 'string' },
197             0x0263 => {
198             Name => 'SequenceKind',
199             PrintConv => {
200             0 => 'Bracketing: Shutter Speed',
201             1 => 'Bracketing: Aperture',
202             2 => 'Bracketing: ISO',
203             3 => 'Hyperfocal',
204             4 => 'Time Lapse',
205             5 => 'HDR',
206             6 => 'Focus Stacking',
207             },
208             PrintConvInv => '$val',
209             },
210             0x0264 => 'SequenceFrameNumber',
211             0x0265 => 'SequenceFrameCount',
212             # 0x0300 - int32u: 100,101,102
213             0x0301 => { Name => 'FirmwareVersions', Format => 'string' },
214             # 0x0304 - int32u: 8,3073,3076
215             0x0400 => {
216             Name => 'ShutterSpeedValue',
217             Format => 'float',
218             ValueConv => 'abs($val)<100 ? 2**(-$val) : 0',
219             ValueConvInv => '$val>0 ? -log($val)/log(2) : -100',
220             PrintConv => 'Image::ExifTool::Exif::PrintExposureTime($val)',
221             PrintConvInv => 'Image::ExifTool::Exif::ConvertFraction($val)',
222             },
223             0x0401 => {
224             Name => 'ApertureValue',
225             Format => 'float',
226             ValueConv => '2 ** ($val / 2)',
227             ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
228             PrintConv => 'sprintf("%.1f",$val)',
229             PrintConvInv => '$val',
230             },
231             0x0402 => {
232             Name => 'ExposureCompensation',
233             Format => 'float',
234             PrintConv => 'sprintf("%.3f",$val)',
235             PrintConvInv => '$val',
236             },
237             0x0403 => {
238             Name => 'FocalLength',
239             Format => 'float',
240             PrintConv => 'sprintf("%.1f mm",$val)',
241             PrintConvInv => '$val=~s/\s*mm$//;$val',
242             },
243             # 0x0404 - int32u: 0,3
244             # 0x0405 - int32u? (big numbers)
245             # 0x0406 - int32u: 1
246             # 0x0407 - float: -0.333 (exposure compensation again?)
247             # 0x0408-0x0409 - int32u: 1
248             0x0410 => { Name => 'CameraModel', Format => 'string' },
249             # 0x0411 - int32u: 33556736
250             0x0412 => { Name => 'LensModel', Format => 'string' },
251             0x0414 => {
252             Name => 'MaxApertureValue',
253             Format => 'float',
254             ValueConv => '2 ** ($val / 2)',
255             ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
256             PrintConv => 'sprintf("%.1f",$val)',
257             PrintConvInv => '$val',
258             },
259             0x0415 => {
260             Name => 'MinApertureValue',
261             Format => 'float',
262             ValueConv => '2 ** ($val / 2)',
263             ValueConvInv => '$val>0 ? 2*log($val)/log(2) : 0',
264             PrintConv => 'sprintf("%.1f",$val)',
265             PrintConvInv => '$val',
266             },
267             # 0x0416 - float: (min focal length? ref LR, Credo50) (but looks more like an int32u date for the 645DF - PH)
268             # 0x0417 - float: 80 (max focal length? ref LR)
269             0x0455 => { #PH
270             Name => 'Viewfinder',
271             Format => 'string',
272             },
273             );
274              
275             # Phase One metadata (ref 1)
276             %Image::ExifTool::PhaseOne::SensorCalibration = (
277             PROCESS_PROC => \&ProcessPhaseOne,
278             WRITE_PROC => \&WritePhaseOne,
279             CHECK_PROC => \&Image::ExifTool::Exif::CheckExif,
280             GROUPS => { 0 => 'MakerNotes', 2 => 'Camera' },
281             TAG_PREFIX => 'SensorCalibration',
282             WRITE_GROUP => 'PhaseOne',
283             VARS => { ENTRY_SIZE => 12 }, # (entries do not contain a format field)
284             0x0400 => {
285             Name => 'SensorDefects',
286             # list of defects. each defect is 4 x int16u values:
287             # 0=column, 1=row, 2=type (129=bad pixel, 131=bad column), 3=?
288             # (but it isn't really worth the time decoding this -- it can be a few hundred kB)
289             Format => 'undef',
290             Binary => 1,
291             },
292             0x0401 => {
293             Name => 'AllColorFlatField1',
294             Format => 'undef',
295             Flags => ['Unknown','Binary'],
296             },
297             0x0404 => { #PH
298             Name => 'SensorCalibration_0x0404',
299             Format => 'string',
300             Flags => ['Unknown','Hidden'],
301             },
302             0x0405 => { #PH
303             Name => 'SensorCalibration_0x0405',
304             Format => 'string',
305             Flags => ['Unknown','Hidden'],
306             },
307             0x0406 => { #PH
308             Name => 'SensorCalibration_0x0406',
309             Format => 'string',
310             Flags => ['Unknown','Hidden'],
311             },
312             0x0407 => { #PH
313             Name => 'SerialNumber',
314             Format => 'string',
315             Writable => 1,
316             },
317             0x0408 => { #PH
318             Name => 'SensorCalibration_0x0408',
319             Format => 'float',
320             Flags => ['Unknown','Hidden'],
321             },
322             0x040b => {
323             Name => 'RedBlueFlatField',
324             Format => 'undef',
325             Flags => ['Unknown','Binary'],
326             },
327             0x040f => { #PH
328             Name => 'SensorCalibration_0x040f',
329             Format => 'undef',
330             Flags => ['Unknown','Hidden'],
331             },
332             0x0410 => {
333             Name => 'AllColorFlatField2',
334             Format => 'undef',
335             Flags => ['Unknown','Binary'],
336             },
337             # 0x0412 - used by dcraw
338             0x0413 => { #PH
339             Name => 'SensorCalibration_0x0413',
340             Format => 'double',
341             Flags => ['Unknown','Hidden'],
342             },
343             0x0414 => { #PH
344             Name => 'SensorCalibration_0x0414',
345             Format => 'undef',
346             Flags => ['Unknown','Hidden'],
347             ValueConv => q{
348             my $order = GetByteOrder();
349             if (length $val >= 8 and SetByteOrder(substr($val,0,2))) {
350             $val = ReadValue(\$val, 2, 'int16u', 1, length($val)-2) . ' ' .
351             ReadValue(\$val, 4, 'float', undef, length($val)-4);
352             SetByteOrder($order);
353             }
354             return $val;
355             },
356             },
357             0x0416 => {
358             Name => 'AllColorFlatField3',
359             Format => 'undef',
360             Flags => ['Unknown','Binary'],
361             },
362             0x0418 => { #PH
363             Name => 'SensorCalibration_0x0418',
364             Format => 'undef',
365             Flags => ['Unknown','Hidden'],
366             },
367             0x0419 => {
368             Name => 'LinearizationCoefficients1',
369             Format => 'float',
370             PrintConv => 'my @a=split " ",$val;join " ", map { sprintf("%.5g",$_) } @a',
371             },
372             0x041a => {
373             Name => 'LinearizationCoefficients2',
374             Format => 'float',
375             PrintConv => 'my @a=split " ",$val;join " ", map { sprintf("%.5g",$_) } @a',
376             },
377             0x041c => { #PH
378             Name => 'SensorCalibration_0x041c',
379             Format => 'float',
380             Flags => ['Unknown','Hidden'],
381             },
382             0x041e => { #PH
383             Name => 'SensorCalibration_0x041e',
384             Format => 'undef',
385             Flags => ['Unknown','Hidden'],
386             ValueConv => q{
387             my $order = GetByteOrder();
388             if (length $val >= 8 and SetByteOrder(substr($val,0,2))) {
389             $val = ReadValue(\$val, 2, 'int16u', 1, length($val)-2) . ' ' .
390             ReadValue(\$val, 4, 'float', undef, length($val)-4);
391             SetByteOrder($order);
392             }
393             return $val;
394             },
395             },
396             );
397              
398             #------------------------------------------------------------------------------
399             # Do HTML dump of an IFD entry
400             # Inputs: 0) ExifTool ref, 1) tag table ref, 3) tag ID, 4) tag value,
401             # 5) IFD entry offset, 6) IFD entry size, 7) parameter hash
402             sub HtmlDump($$$$$$%)
403             {
404 0     0 0 0 my ($et, $tagTablePtr, $tagID, $value, $entry, $entryLen, %parms) = @_;
405             my ($dirName, $index, $formatStr, $dataPos, $base, $size, $valuePtr) =
406 0         0 @parms{qw(DirName Index Format DataPos Base Size Start)};
407 0         0 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
408 0         0 my ($tagName, $colName, $subdir);
409 0   0     0 my $count = $parms{Count} || $size;
410 0 0       0 $base = 0 unless defined $base;
411 0 0       0 if ($tagInfo) {
412 0         0 $tagName = $$tagInfo{Name};
413 0         0 $subdir = $$tagInfo{SubDirectory};
414 0 0       0 if ($$tagInfo{Format}) {
415 0         0 $formatStr = $$tagInfo{Format};
416 0         0 $count = $size / Image::ExifTool::FormatSize($formatStr);
417             }
418             } else {
419 0         0 $tagName = sprintf("Tag 0x%.4x", $tagID);
420             }
421 0         0 my $dname = sprintf("${dirName}-%.2d", $index);
422             # build our tool tip
423 0         0 my $fstr = "$formatStr\[$count]";
424 0         0 my $tip = sprintf("Tag ID: 0x%.4x\n", $tagID) .
425             "Format: $fstr\nSize: $size bytes\n";
426 0 0       0 if ($size > 4) {
427 0         0 $tip .= sprintf("Value offset: 0x%.4x\n", $valuePtr - $base);
428 0         0 $tip .= sprintf("Actual offset: 0x%.4x\n", $valuePtr + $dataPos);
429 0         0 $tip .= sprintf("Offset base: 0x%.4x\n", $dataPos + $base);
430 0         0 $colName = "$tagName";
431             } else {
432 0         0 $colName = $tagName;
433             }
434 0 0       0 unless (ref $value) {
435 0 0       0 my $tval = length($value) > 32 ? substr($value,0,28) . '[...]' : $value;
436 0         0 $tval =~ tr/\x00-\x1f\x7f-\xff/./;
437 0         0 $tip .= "Value: $tval";
438             }
439 0         0 $et->HDump($entry+$dataPos, $entryLen, "$dname $colName", $tip, 1);
440 0 0       0 if ($size > 4) {
441 0         0 my $dumpPos = $valuePtr + $dataPos;
442             # add value data block
443 0 0       0 $et->HDump($dumpPos,$size,"$tagName value",'SAME', $subdir ? 0x04 : 0);
444             }
445             }
446              
447             #------------------------------------------------------------------------------
448             # Write PhaseOne maker notes (both types of PhaseOne IFD)
449             # Inputs: 0) ExifTool object ref, 1) source dirInfo ref, 2) tag table ref
450             # Returns: data block or undef on error
451             sub WritePhaseOne($$$)
452             {
453 203     203 0 643 my ($et, $dirInfo, $tagTablePtr) = @_;
454 203 100       1070 $et or return 1; # allow dummy access to autoload this package
455              
456             # nothing to do if we aren't changing any PhaseOne tags
457 2         9 my $newTags = $et->GetNewTagInfoHash($tagTablePtr);
458 2 0 33     10 return undef unless %$newTags or $$et{DropTags} or $$et{EDIT_DIRS}{PhaseOne};
      0        
459              
460 2         3 my $dataPt = $$dirInfo{DataPt};
461 2   100     8 my $dataPos = $$dirInfo{DataPos} || 0;
462 2   50     6 my $dirStart = $$dirInfo{DirStart} || 0;
463 2   66     6 my $dirLen = $$dirInfo{DirLen} || $$dirInfo{DataLen} - $dirStart;
464 2         3 my $dirName = $$dirInfo{DirName};
465 2         6 my $verbose = $et->Options('Verbose');
466              
467 2 50       6 return undef if $dirLen < 12;
468 2 50 33     10 unless ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{ENTRY_SIZE}) {
469 0         0 $et->Warn("No ENTRY_SIZE for $$tagTablePtr{TABLE_NAME}");
470 0         0 return undef;
471             }
472 2         5 my $entrySize = $$tagTablePtr{VARS}{ENTRY_SIZE};
473 2   50     5 my $ifdType = $$tagTablePtr{TAG_PREFIX} || 'PhaseOne';
474 2         7 my $hdr = substr($$dataPt, $dirStart, 12);
475 2 100       16 if ($entrySize == 16) {
    50          
476 1 50       8 return undef unless $hdr =~ /^(IIII.waR|MMMMRaw.)/s;
477             } elsif ($hdr !~ /^(IIII\x01\0\0\0|MMMM\0\0\0\x01)/s) {
478 0         0 $et->Warn("Unrecognized $ifdType directory version");
479 0         0 return undef;
480             }
481 2         9 SetByteOrder(substr($hdr, 0, 2));
482             # get offset to start of PhaseOne directory
483 2         6 my $ifdStart = Get32u(\$hdr, 8);
484 2 50       6 return undef if $ifdStart + 8 > $dirLen;
485             # initialize output directory buffer with (fixed) number of entries plus 4-byte padding
486 2         4 my $dirBuff = substr($$dataPt, $dirStart + $ifdStart, 8);
487             # get number of entries in PhaseOne directory
488 2         4 my $numEntries = Get32u(\$dirBuff, 0);
489 2         4 my $ifdEnd = $ifdStart + 8 + $entrySize * $numEntries;
490 2 50 33     20 return undef if $numEntries < 2 or $numEntries > 300 or $ifdEnd > $dirLen;
      33        
491 2         3 my $hdrBuff = $hdr;
492 2         4 my $valBuff = ''; # buffer for value data
493 2         10 my $fixup = Image::ExifTool::Fixup->new;
494 2         3 my $index;
495 2         7 for ($index=0; $index<$numEntries; ++$index) {
496 102         110 my $entry = $dirStart + $ifdStart + 8 + $entrySize * $index;
497 102         130 my $tagID = Get32u($dataPt, $entry);
498 102         125 my $size = Get32u($dataPt, $entry+$entrySize-8);
499 102         114 my ($formatSize, $formatStr);
500 102 100       115 if ($entrySize == 16) {
501 58         78 $formatSize = Get32u($dataPt, $entry+4);
502 58         69 $formatStr = $formatName[$formatSize];
503 58 50       74 unless ($formatStr) {
504 0         0 $et->Warn("Possibly invalid $ifdType IFD entry $index",1);
505 0         0 delete $$newTags{$tagID}; # make sure we don't try to change this one
506             }
507             } else {
508             # (no format code for SensorCalibration IFD entries)
509 44         56 $formatSize = 1;
510 44         35 $formatStr = 'undef';
511             }
512 102         102 my $valuePtr = $entry + $entrySize - 4;
513 102 100       145 if ($size > 4) {
514 56 50       66 if ($size > 0x7fffffff) {
515 0         0 $et->Error("Invalid size for $ifdType IFD entry $index",1);
516 0         0 return undef;
517             }
518 56         63 $valuePtr = Get32u($dataPt, $valuePtr);
519 56 50       71 if ($valuePtr + $size > $dirLen) {
520 0         0 $et->Error(sprintf("Invalid offset 0x%.4x for $ifdType IFD entry $index",$valuePtr),1);
521 0         0 return undef;
522             }
523 56         59 $valuePtr += $dirStart;
524             }
525 102         120 my $value = substr($$dataPt, $valuePtr, $size);
526 102   100     206 my $tagInfo = $$newTags{$tagID} || $$tagTablePtr{$tagID};
527 102 50 66     194 $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID) if $tagInfo and ref($tagInfo) ne 'HASH';
528 102 100 66     262 if ($$newTags{$tagID}) {
    100 0        
    50 33        
529 2 50       8 $formatStr = $$tagInfo{Format} if $$tagInfo{Format};
530 2         5 my $count = int($size / Image::ExifTool::FormatSize($formatStr));
531 2         7 my $val = ReadValue(\$value, 0, $formatStr, $count, $size);
532 2         18 my $nvHash = $et->GetNewValueHash($tagInfo);
533 2 50       7 if ($et->IsOverwriting($nvHash, $val)) {
534 2         9 my $newVal = $et->GetNewValue($nvHash);
535             # allow count to change for string and undef types only
536 2 50 33     7 undef $count if $formatStr eq 'string' or $formatStr eq 'undef';
537 2         10 my $newValue = WriteValue($newVal, $formatStr, $count);
538 2 50       7 if (defined $newValue) {
539 2         2 $value = $newValue;
540 2         3 $size = length $newValue;
541 2         10 $et->VerboseValue("- $dirName:$$tagInfo{Name}", $val);
542 2         5 $et->VerboseValue("+ $dirName:$$tagInfo{Name}", $newVal);
543 2         3 ++$$et{CHANGED};
544             }
545             }
546             } elsif ($tagInfo and $$tagInfo{SubDirectory}) {
547 1         5 my $subTable = GetTagTable($$tagInfo{SubDirectory}{TagTable});
548             my %subdirInfo = (
549             DirName => $$tagInfo{Name},
550 1         6 DataPt => \$value,
551             DataLen => length $value,
552             );
553 1         15 my $newValue = $et->WriteDirectory(\%subdirInfo, $subTable);
554 1 50 33     6 if (defined $newValue and length($newValue)) {
555 1         1 $value = $newValue;
556 1         3 $size = length $newValue;
557             }
558             } elsif ($$et{DropTags} and (($tagInfo and $$tagInfo{Drop}) or $size > 8192)) {
559             # decrease the number of entries in the directory
560 0         0 Set32u(Get32u(\$dirBuff, 0) - 1, \$dirBuff, 0);
561 0         0 next; # drop this tag
562             }
563             # add the tagID, possibly format size, and size to this directory entry
564 102         153 $dirBuff .= substr($$dataPt, $entry, $entrySize - 8) . Set32u($size);
565              
566             # pad value to an even 4-byte boundary just in case
567 102 100 100     193 $value .= ("\0" x (4 - ($size & 0x03))) if $size & 0x03 or not $size;
568 102 100 66     161 if ($size <= 4) {
    100          
569             # store value in place of the IFD value pointer (already padded to 4 bytes)
570 46         69 $dirBuff .= $value;
571             } elsif ($tagInfo and $$tagInfo{PutFirst}) {
572             # store value immediately after header
573 1         2 $dirBuff .= Set32u(length $hdrBuff);
574 1         4 $hdrBuff .= $value;
575             } else {
576             # store value at end of value buffer
577 55         100 $fixup->AddFixup(length $dirBuff);
578 55         73 $dirBuff .= Set32u(length $valBuff);
579 55         107 $valBuff .= $value;
580             }
581             }
582             # apply necessary fixup to offsets in PhaseOne directory
583 2         5 $$fixup{Shift} = length $hdrBuff;
584 2         8 $fixup->ApplyFixup(\$dirBuff);
585             # set pointer to PhaseOneIFD in header
586 2         5 Set32u(length($hdrBuff) + length($valBuff), \$hdrBuff, 8);
587 2         31 return $hdrBuff . $valBuff . $dirBuff;
588             }
589              
590             #------------------------------------------------------------------------------
591             # Read Phase One maker notes
592             # Inputs: 0) ExifTool object ref, 1) dirInfo ref, 2) tag table ref
593             # Returns: 1 on success
594             # Notes: This routine processes both the main PhaseOne IFD type (with 16 bytes
595             # per entry), and the SensorCalibration IFD type (12 bytes per entry)
596             sub ProcessPhaseOne($$$)
597             {
598 5     5 0 23 my ($et, $dirInfo, $tagTablePtr) = @_;
599 5         13 my $dataPt = $$dirInfo{DataPt};
600 5   50     40 my $dataPos = ($$dirInfo{DataPos} || 0) + ($$dirInfo{Base} || 0);
      50        
601 5   100     39 my $dirStart = $$dirInfo{DirStart} || 0;
602 5   33     28 my $dirLen = $$dirInfo{DirLen} || $$dirInfo{DataLen} - $dirStart;
603 5         20 my $binary = $et->Options('Binary');
604 5         17 my $verbose = $et->Options('Verbose');
605 5         11 my $hash = $$et{ImageDataHash};
606 5         14 my $htmlDump = $$et{HTML_DUMP};
607              
608 5 50       19 return 0 if $dirLen < 12;
609 5 50 33     33 unless ($$tagTablePtr{VARS} and $$tagTablePtr{VARS}{ENTRY_SIZE}) {
610 0         0 $et->Warn("No ENTRY_SIZE for $$tagTablePtr{TABLE_NAME}");
611 0         0 return undef;
612             }
613 5         14 my $entrySize = $$tagTablePtr{VARS}{ENTRY_SIZE};
614 5   50     19 my $ifdType = $$tagTablePtr{TAG_PREFIX} || 'PhaseOne';
615              
616 5         18 my $hdr = substr($$dataPt, $dirStart, 12);
617 5 100       30 if ($entrySize == 16) {
    50          
618 3 50       20 return 0 unless $hdr =~ /^(IIII.waR|MMMMRaw.)/s;
619             } elsif ($hdr !~ /^(IIII\x01\0\0\0|MMMM\0\0\0\x01)/s) {
620 0         0 $et->Warn("Unrecognized $ifdType directory version");
621 0         0 return 0;
622             }
623 5         58 SetByteOrder(substr($hdr, 0, 2));
624             # get offset to start of PhaseOne directory
625 5         23 my $ifdStart = Get32u(\$hdr, 8);
626 5 100       19 return 0 if $ifdStart + 8 > $dirLen;
627             # get number of entries in PhaseOne directory
628 4         16 my $numEntries = Get32u($dataPt, $dirStart + $ifdStart);
629 4         26 my $ifdEnd = $ifdStart + 8 + $entrySize * $numEntries;
630 4 50 33     40 return 0 if $numEntries < 2 or $numEntries > 300 or $ifdEnd > $dirLen;
      33        
631 4         31 $et->VerboseDir($ifdType, $numEntries);
632 4 50       11 if ($htmlDump) {
633 0         0 $et->HDump($dirStart + $dataPos, 8, "$ifdType header");
634 0         0 $et->HDump($dirStart + $dataPos + 8, 4, "$ifdType IFD offset");
635 0         0 $et->HDump($dirStart + $dataPos + $ifdStart, 4, "$ifdType entries",
636             "Entry count: $numEntries");
637 0         0 $et->HDump($dirStart + $dataPos + $ifdStart + 4, 4, '[unused]');
638             }
639 4         26 my $index;
640 4         15 for ($index=0; $index<$numEntries; ++$index) {
641 204         638 my $entry = $dirStart + $ifdStart + 8 + $entrySize * $index;
642 204         634 my $tagID = Get32u($dataPt, $entry);
643 204         544 my $size = Get32u($dataPt, $entry+$entrySize-8);
644 204         427 my $valuePtr = $entry + $entrySize - 4;
645 204         400 my ($formatSize, $formatStr, $value);
646 204 100       597 if ($entrySize == 16) {
    100          
647             # (format code only for the 16-byte IFD entry)
648 116         297 $formatSize = Get32u($dataPt, $entry+4);
649 116         290 $formatStr = $formatName[$formatSize];
650 116 50       296 unless ($formatStr) {
651 0         0 $et->Warn("Unrecognized $ifdType format size $formatSize",1);
652 0         0 $formatSize = 1;
653 0         0 $formatStr = 'undef';
654             }
655             } elsif ($size %4) {
656 8         13 $formatSize = 1;
657 8         15 $formatStr = 'undef';
658             } else {
659 80         285 $formatSize = 4;
660 80         156 $formatStr = 'int32s';
661             }
662 204 100       468 if ($size > 4) {
663 112 50       386 if ($size > 0x7fffffff) {
664 0         0 $et->Warn("Invalid size for $ifdType IFD entry $index");
665 0         0 return 0;
666             }
667 112         355 $valuePtr = Get32u($dataPt, $valuePtr);
668 112 50       287 if ($valuePtr + $size > $dirLen) {
669 0         0 $et->Warn(sprintf("Invalid offset 0x%.4x for $ifdType IFD entry $index",$valuePtr));
670 0         0 return 0;
671             }
672 112         197 $valuePtr += $dirStart;
673             }
674 204         653 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
675 204 100       502 if ($tagInfo) {
676 134 100       379 $formatStr = $$tagInfo{Format} if $$tagInfo{Format};
677             } else {
678 70 50 33     371 next unless $verbose or $htmlDump;
679             }
680 134         366 my $count = int($size / Image::ExifTool::FormatSize($formatStr));
681 134 50 33     440 if ($count > 100000 and not $binary) {
682 0         0 $value = \ "Binary data $size bytes";
683             } else {
684 134         370 $value = ReadValue($dataPt,$valuePtr,$formatStr,$count,$size);
685             # try to distinguish between the various format types
686 134 100       387 if ($formatStr eq 'int32s') {
687 67         226 my ($val) = split ' ', $value;
688 67 100       173 if (defined $val) {
689             # get floating point exponent (has bias of 127)
690 66         190 my $exp = ($val & 0x7f800000) >> 23;
691 66 100 100     250 if ($exp > 120 and $exp < 140) {
692 1         3 $formatStr = 'float';
693 1         5 $value = ReadValue($dataPt,$valuePtr,$formatStr,$count,$size);
694             }
695             }
696             }
697             }
698 134 0 33     448 if ($hash and $tagInfo and $$tagInfo{IsImageData}) {
      33        
699 0         0 my ($pos, $len) = ($valuePtr, $size);
700 0         0 while ($len) {
701 0 0       0 my $n = $len > 65536 ? 65536 : $len;
702 0         0 my $tmp = substr($$dataPt, $pos, $n);
703 0         0 $hash->add($tmp);
704 0         0 $len -= $n;
705 0         0 $pos += $n;
706             }
707 0         0 $et->VPrint(0, "$$et{INDENT}(ImageDataHash: $size bytes of PhaseOne:$$tagInfo{Name})\n");
708             }
709 134         1035 my %parms = (
710             DirName => $ifdType,
711             Index => $index,
712             DataPt => $dataPt,
713             DataPos => $dataPos,
714             Size => $size,
715             Start => $valuePtr,
716             Format => $formatStr,
717             Count => $count
718             );
719 134 50       375 $htmlDump and HtmlDump($et, $tagTablePtr, $tagID, $value, $entry, $entrySize,
720             %parms, Base => $dirStart);
721 134         832 $et->HandleTag($tagTablePtr, $tagID, $value, %parms);
722             }
723 4         19 return 1;
724             }
725              
726             1; # end
727              
728             __END__