PhaseOne.pm 25 KB

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