ICC_Profile.pm 33 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000
  1. #------------------------------------------------------------------------------
  2. # File: ICC_Profile.pm
  3. #
  4. # Description: Read ICC Profile meta information
  5. #
  6. # Revisions: 11/16/2004 - P. Harvey Created
  7. #
  8. # References: 1) http://www.color.org/icc_specs2.html (ICC.1:2003-09)
  9. # 2) http://www.color.org/icc_specs2.html (ICC.1:2001-04)
  10. # 3) http://developer.apple.com/documentation/GraphicsImaging/Reference/ColorSync_Manager/ColorSync_Manager.pdf
  11. # 4) http://www.color.org/privatetag2007-01.pdf
  12. # 5) http://www.color.org/icc_specs2.xalter (approved revisions, 2010-07-16)
  13. #
  14. # Notes: The ICC profile information is different: the format of each
  15. # tag is embedded in the information instead of in the directory
  16. # structure. This makes things a bit more complex because I need
  17. # an extra level of logic to decode the variable-format tags.
  18. #------------------------------------------------------------------------------
  19. package Image::ExifTool::ICC_Profile;
  20. use strict;
  21. use vars qw($VERSION);
  22. use Image::ExifTool qw(:DataAccess :Utils);
  23. $VERSION = '1.30';
  24. sub ProcessICC($$);
  25. sub ProcessICC_Profile($$$);
  26. sub WriteICC_Profile($$;$);
  27. sub ProcessMetadata($$$);
  28. sub ValidateICC($);
  29. # illuminant type definitions
  30. my %illuminantType = (
  31. 1 => 'D50',
  32. 2 => 'D65',
  33. 3 => 'D93',
  34. 4 => 'F2',
  35. 5 => 'D55',
  36. 6 => 'A',
  37. 7 => 'Equi-Power (E)',
  38. 8 => 'F8',
  39. );
  40. my %profileClass = (
  41. scnr => 'Input Device Profile',
  42. mntr => 'Display Device Profile',
  43. prtr => 'Output Device Profile',
  44. 'link'=> 'DeviceLink Profile',
  45. spac => 'ColorSpace Conversion Profile',
  46. abst => 'Abstract Profile',
  47. nmcl => 'NamedColor Profile',
  48. nkpf => 'Nikon Input Device Profile (NON-STANDARD!)', # (written by Nikon utilities)
  49. );
  50. # ICC_Profile tag table
  51. %Image::ExifTool::ICC_Profile::Main = (
  52. GROUPS => { 2 => 'Image' },
  53. PROCESS_PROC => \&ProcessICC_Profile,
  54. WRITE_PROC => \&WriteICC_Profile,
  55. NOTES => q{
  56. ICC profile information is used in many different file types including JPEG,
  57. TIFF, PDF, PostScript, Photoshop, PNG, MIFF, PICT, QuickTime, XCF and some
  58. RAW formats. While the tags listed below are not individually writable, the
  59. entire profile itself can be accessed via the extra 'ICC_Profile' tag, but
  60. this tag is neither extracted nor written unless specified explicitly. See
  61. L<http://www.color.org/icc_specs2.xalter> for the official ICC
  62. specification.
  63. },
  64. A2B0 => 'AToB0',
  65. A2B1 => 'AToB1',
  66. A2B2 => 'AToB2',
  67. bXYZ => 'BlueMatrixColumn', # (called BlueColorant in ref 2)
  68. bTRC => {
  69. Name => 'BlueTRC',
  70. Description => 'Blue Tone Reproduction Curve',
  71. },
  72. B2A0 => 'BToA0',
  73. B2A1 => 'BToA1',
  74. B2A2 => 'BToA2',
  75. calt => {
  76. Name => 'CalibrationDateTime',
  77. Groups => { 2 => 'Time' },
  78. PrintConv => '$self->ConvertDateTime($val)',
  79. },
  80. targ => {
  81. Name => 'CharTarget',
  82. ValueConv => 'length $val > 128 ? \$val : $val',
  83. },
  84. chad => 'ChromaticAdaptation',
  85. chrm => {
  86. Name => 'Chromaticity',
  87. Groups => { 1 => 'ICC_Profile#' }, #(just for the group list)
  88. SubDirectory => {
  89. TagTable => 'Image::ExifTool::ICC_Profile::Chromaticity',
  90. Validate => '$type eq "chrm"',
  91. },
  92. },
  93. clro => 'ColorantOrder',
  94. clrt => {
  95. Name => 'ColorantTable',
  96. SubDirectory => {
  97. TagTable => 'Image::ExifTool::ICC_Profile::ColorantTable',
  98. Validate => '$type eq "clrt"',
  99. },
  100. },
  101. clot => { # new in version 4.2
  102. Name => 'ColorantTableOut',
  103. Binary => 1,
  104. },
  105. cprt => {
  106. Name => 'ProfileCopyright',
  107. ValueConv => '$val=~s/\0.*//; $val', # may be null terminated
  108. },
  109. crdi => 'CRDInfo', #2
  110. dmnd => {
  111. Name => 'DeviceMfgDesc',
  112. Groups => { 2 => 'Camera' },
  113. },
  114. dmdd => {
  115. Name => 'DeviceModelDesc',
  116. Groups => { 2 => 'Camera' },
  117. },
  118. devs => {
  119. Name => 'DeviceSettings', #2
  120. Groups => { 2 => 'Camera' },
  121. },
  122. gamt => 'Gamut',
  123. kTRC => {
  124. Name => 'GrayTRC',
  125. Description => 'Gray Tone Reproduction Curve',
  126. },
  127. gXYZ => 'GreenMatrixColumn', # (called GreenColorant in ref 2)
  128. gTRC => {
  129. Name => 'GreenTRC',
  130. Description => 'Green Tone Reproduction Curve',
  131. },
  132. lumi => 'Luminance',
  133. meas => {
  134. Name => 'Measurement',
  135. SubDirectory => {
  136. TagTable => 'Image::ExifTool::ICC_Profile::Measurement',
  137. Validate => '$type eq "meas"',
  138. },
  139. },
  140. bkpt => 'MediaBlackPoint',
  141. wtpt => 'MediaWhitePoint',
  142. ncol => 'NamedColor', #2
  143. ncl2 => 'NamedColor2',
  144. resp => 'OutputResponse',
  145. pre0 => 'Preview0',
  146. pre1 => 'Preview1',
  147. pre2 => 'Preview2',
  148. desc => 'ProfileDescription',
  149. pseq => 'ProfileSequenceDesc',
  150. psd0 => 'PostScript2CRD0', #2
  151. psd1 => 'PostScript2CRD1', #2
  152. psd2 => 'PostScript2CRD2', #2
  153. ps2s => 'PostScript2CSA', #2
  154. ps2i => 'PS2RenderingIntent', #2
  155. rXYZ => 'RedMatrixColumn', # (called RedColorant in ref 2)
  156. rTRC => {
  157. Name => 'RedTRC',
  158. Description => 'Red Tone Reproduction Curve',
  159. },
  160. scrd => 'ScreeningDesc',
  161. scrn => 'Screening',
  162. 'bfd '=> {
  163. Name => 'UCRBG',
  164. Description => 'Under Color Removal and Black Gen.',
  165. },
  166. tech => {
  167. Name => 'Technology',
  168. PrintConv => {
  169. fscn => 'Film Scanner',
  170. dcam => 'Digital Camera',
  171. rscn => 'Reflective Scanner',
  172. ijet => 'Ink Jet Printer',
  173. twax => 'Thermal Wax Printer',
  174. epho => 'Electrophotographic Printer',
  175. esta => 'Electrostatic Printer',
  176. dsub => 'Dye Sublimation Printer',
  177. rpho => 'Photographic Paper Printer',
  178. fprn => 'Film Writer',
  179. vidm => 'Video Monitor',
  180. vidc => 'Video Camera',
  181. pjtv => 'Projection Television',
  182. 'CRT '=> 'Cathode Ray Tube Display',
  183. 'PMD '=> 'Passive Matrix Display',
  184. 'AMD '=> 'Active Matrix Display',
  185. KPCD => 'Photo CD',
  186. imgs => 'Photo Image Setter',
  187. grav => 'Gravure',
  188. offs => 'Offset Lithography',
  189. silk => 'Silkscreen',
  190. flex => 'Flexography',
  191. mpfs => 'Motion Picture Film Scanner', #5
  192. mpfr => 'Motion Picture Film Recorder', #5
  193. dmpc => 'Digital Motion Picture Camera', #5
  194. dcpj => 'Digital Cinema Projector', #5
  195. },
  196. },
  197. vued => 'ViewingCondDesc',
  198. view => {
  199. Name => 'ViewingConditions',
  200. SubDirectory => {
  201. TagTable => 'Image::ExifTool::ICC_Profile::ViewingConditions',
  202. Validate => '$type eq "view"',
  203. },
  204. },
  205. ciis => 'ColorimetricIntentImageState', #5
  206. scoe => 'SceneColorimetryEstimates', #5
  207. sape => 'SceneAppearanceEstimates', #5
  208. fpce => 'FocalPlaneColorimetryEstimates', #5
  209. rhoc => 'ReflectionHardcopyOrigColorimetry', #5
  210. rpoc => 'ReflectionPrintOutputColorimetry', #5
  211. psid => { #5
  212. Name => 'ProfileSequenceIdentifier',
  213. Binary => 1,
  214. },
  215. B2D0 => { Name => 'BToD0', Binary => 1 }, #5
  216. B2D1 => { Name => 'BToD1', Binary => 1 }, #5
  217. B2D2 => { Name => 'BToD2', Binary => 1 }, #5
  218. B2D3 => { Name => 'BToD3', Binary => 1 }, #5
  219. D2B0 => { Name => 'DToB0', Binary => 1 }, #5
  220. D2B1 => { Name => 'DToB1', Binary => 1 }, #5
  221. D2B2 => { Name => 'DToB2', Binary => 1 }, #5
  222. D2B3 => { Name => 'DToB3', Binary => 1 }, #5
  223. rig0 => { #5
  224. Name => 'PerceptualRenderingIntentGamut',
  225. PrintConv => {
  226. prmg => 'Perceptual Reference Medium Gamut',
  227. },
  228. },
  229. rig2 => { #5
  230. Name => 'SaturationRenderingIntentGamut',
  231. PrintConv => {
  232. prmg => 'Perceptual Reference Medium Gamut',
  233. },
  234. },
  235. meta => { #5 (EVENTUALLY DECODE THIS ONCE WE HAVE A SAMPLE!!)
  236. Name => 'Metadata',
  237. SubDirectory => {
  238. TagTable => 'Image::ExifTool::ICC_Profile::Metadata',
  239. Validate => '$type eq "meta"',
  240. },
  241. },
  242. # ColorSync custom tags (ref 3)
  243. psvm => 'PS2CRDVMSize',
  244. vcgt => 'VideoCardGamma',
  245. mmod => 'MakeAndModel',
  246. dscm => 'ProfileDescriptionML',
  247. ndin => 'NativeDisplayInfo',
  248. # Microsoft custom tags (ref http://msdn2.microsoft.com/en-us/library/ms536870.aspx)
  249. MS00 => 'WCSProfiles',
  250. # the following entry represents the ICC profile header, and doesn't
  251. # exist as a tag in the directory. It is only in this table to provide
  252. # a link so ExifTool can locate the header tags
  253. Header => {
  254. Name => 'ProfileHeader',
  255. SubDirectory => {
  256. TagTable => 'Image::ExifTool::ICC_Profile::Header',
  257. },
  258. },
  259. );
  260. # ICC profile header definition
  261. %Image::ExifTool::ICC_Profile::Header = (
  262. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  263. GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-header', 2 => 'Image' },
  264. 4 => {
  265. Name => 'ProfileCMMType',
  266. Format => 'string[4]',
  267. },
  268. 8 => {
  269. Name => 'ProfileVersion',
  270. Format => 'int16s',
  271. PrintConv => '($val >> 8).".".(($val & 0xf0)>>4).".".($val & 0x0f)',
  272. },
  273. 12 => {
  274. Name => 'ProfileClass',
  275. Format => 'string[4]',
  276. PrintConv => \%profileClass,
  277. },
  278. 16 => {
  279. Name => 'ColorSpaceData',
  280. Format => 'string[4]',
  281. },
  282. 20 => {
  283. Name => 'ProfileConnectionSpace',
  284. Format => 'string[4]',
  285. },
  286. 24 => {
  287. Name => 'ProfileDateTime',
  288. Groups => { 2 => 'Time' },
  289. Format => 'int16u[6]',
  290. ValueConv => 'sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d",split(" ",$val));',
  291. PrintConv => '$self->ConvertDateTime($val)',
  292. },
  293. 36 => {
  294. Name => 'ProfileFileSignature',
  295. Format => 'string[4]',
  296. },
  297. 40 => {
  298. Name => 'PrimaryPlatform',
  299. Format => 'string[4]',
  300. PrintConv => {
  301. 'APPL' => 'Apple Computer Inc.',
  302. 'MSFT' => 'Microsoft Corporation',
  303. 'SGI ' => 'Silicon Graphics Inc.',
  304. 'SUNW' => 'Sun Microsystems Inc.',
  305. 'TGNT' => 'Taligent Inc.',
  306. },
  307. },
  308. 44 => {
  309. Name => 'CMMFlags',
  310. Format => 'int32u',
  311. PrintConv => q[
  312. ($val & 0x01 ? "Embedded, " : "Not Embedded, ") .
  313. ($val & 0x02 ? "Not Independent" : "Independent")
  314. ],
  315. },
  316. 48 => {
  317. Name => 'DeviceManufacturer',
  318. Format => 'string[4]',
  319. # KODA = Kodak
  320. },
  321. 52 => {
  322. Name => 'DeviceModel',
  323. Format => 'string[4]',
  324. # ROMM = Refrence Output Medium Metric
  325. },
  326. 56 => {
  327. Name => 'DeviceAttributes',
  328. Format => 'int32u[2]',
  329. PrintConv => q[
  330. my @v = split ' ', $val;
  331. ($v[1] & 0x01 ? "Transparency, " : "Reflective, ") .
  332. ($v[1] & 0x02 ? "Matte, " : "Glossy, ") .
  333. ($v[1] & 0x04 ? "Negative, " : "Positive, ") .
  334. ($v[1] & 0x08 ? "B&W" : "Color");
  335. ],
  336. },
  337. 64 => {
  338. Name => 'RenderingIntent',
  339. Format => 'int32u',
  340. PrintConv => {
  341. 0 => 'Perceptual',
  342. 1 => 'Media-Relative Colorimetric',
  343. 2 => 'Saturation',
  344. 3 => 'ICC-Absolute Colorimetric',
  345. },
  346. },
  347. 68 => {
  348. Name => 'ConnectionSpaceIlluminant',
  349. Format => 'fixed32s[3]', # xyz
  350. },
  351. 80 => {
  352. Name => 'ProfileCreator',
  353. Format => 'string[4]',
  354. # KODA = Kodak
  355. },
  356. 84 => {
  357. Name => 'ProfileID',
  358. Format => 'int8u[16]',
  359. PrintConv => 'Image::ExifTool::ICC_Profile::HexID($val)',
  360. },
  361. );
  362. # viewingConditionsType (view) definition
  363. %Image::ExifTool::ICC_Profile::ViewingConditions = (
  364. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  365. GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-view', 2 => 'Image' },
  366. 8 => {
  367. Name => 'ViewingCondIlluminant',
  368. Format => 'fixed32s[3]', # xyz
  369. },
  370. 20 => {
  371. Name => 'ViewingCondSurround',
  372. Format => 'fixed32s[3]', # xyz
  373. },
  374. 32 => {
  375. Name => 'ViewingCondIlluminantType',
  376. Format => 'int32u',
  377. PrintConv => \%illuminantType,
  378. },
  379. );
  380. # measurementType (meas) definition
  381. %Image::ExifTool::ICC_Profile::Measurement = (
  382. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  383. GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-meas', 2 => 'Image' },
  384. 8 => {
  385. Name => 'MeasurementObserver',
  386. Format => 'int32u',
  387. PrintConv => {
  388. 1 => 'CIE 1931',
  389. 2 => 'CIE 1964',
  390. },
  391. },
  392. 12 => {
  393. Name => 'MeasurementBacking',
  394. Format => 'fixed32s[3]', # xyz
  395. },
  396. 24 => {
  397. Name => 'MeasurementGeometry',
  398. Format => 'int32u',
  399. PrintConv => {
  400. 0 => 'Unknown',
  401. 1 => '0/45 or 45/0',
  402. 2 => '0/d or d/0',
  403. },
  404. },
  405. 28 => {
  406. Name => 'MeasurementFlare',
  407. Format => 'fixed32u',
  408. PrintConv => '$val*100 . "%"', # change into a percent
  409. },
  410. 32 => {
  411. Name => 'MeasurementIlluminant',
  412. Format => 'int32u',
  413. PrintConv => \%illuminantType,
  414. },
  415. );
  416. # chromaticity (chrm) definition
  417. %Image::ExifTool::ICC_Profile::Chromaticity = (
  418. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  419. GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-chrm', 2 => 'Image' },
  420. 8 => {
  421. Name => 'ChromaticityChannels',
  422. Format => 'int16u',
  423. },
  424. 10 => {
  425. Name => 'ChromaticityColorant',
  426. Format => 'int16u',
  427. PrintConv => {
  428. 1 => 'ITU-R BT.709',
  429. 2 => 'SMPTE RP145-1994',
  430. 3 => 'EBU Tech.3213-E',
  431. 4 => 'P22',
  432. },
  433. },
  434. # include definitions for 4 channels -- if there are
  435. # fewer then the ProcessBinaryData logic won't print them.
  436. # If there are more, oh well.
  437. 12 => {
  438. Name => 'ChromaticityChannel1',
  439. Format => 'fixed32u[2]',
  440. },
  441. 20 => {
  442. Name => 'ChromaticityChannel2',
  443. Format => 'fixed32u[2]',
  444. },
  445. 28 => {
  446. Name => 'ChromaticityChannel3',
  447. Format => 'fixed32u[2]',
  448. },
  449. 36 => {
  450. Name => 'ChromaticityChannel4',
  451. Format => 'fixed32u[2]',
  452. },
  453. );
  454. # colorantTable (clrt) definition
  455. %Image::ExifTool::ICC_Profile::ColorantTable = (
  456. PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
  457. GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-clrt', 2 => 'Image' },
  458. 8 => {
  459. Name => 'ColorantCount',
  460. Format => 'int32u',
  461. },
  462. # include definitions for 3 colorants -- if there are
  463. # fewer then the ProcessBinaryData logic won't print them.
  464. # If there are more, oh well.
  465. 12 => {
  466. Name => 'Colorant1Name',
  467. Format => 'string[32]',
  468. },
  469. 44 => {
  470. Name => 'Colorant1Coordinates',
  471. Format => 'int16u[3]',
  472. },
  473. 50 => {
  474. Name => 'Colorant2Name',
  475. Format => 'string[32]',
  476. },
  477. 82 => {
  478. Name => 'Colorant2Coordinates',
  479. Format => 'int16u[3]',
  480. },
  481. 88 => {
  482. Name => 'Colorant3Name',
  483. Format => 'string[32]',
  484. },
  485. 120 => {
  486. Name => 'Colorant3Coordinates',
  487. Format => 'int16u[3]',
  488. },
  489. );
  490. # metadata (meta) tags
  491. %Image::ExifTool::ICC_Profile::Metadata = (
  492. PROCESS_PROC => \&ProcessMetadata,
  493. GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-meta', 2 => 'Image' },
  494. VARS => { NO_ID => 1 },
  495. NOTES => q{
  496. Only these few tags have been pre-defined, but ExifTool will extract any
  497. Metadata tags that exist.
  498. },
  499. ManufacturerName => { },
  500. MediaColor => { },
  501. MediaWeight => { },
  502. );
  503. #------------------------------------------------------------------------------
  504. # print ICC Profile ID in hex
  505. # Inputs: 1) string of numbers
  506. # Returns: string of hex digits
  507. sub HexID($)
  508. {
  509. my $val = shift;
  510. my @vals = split(' ', $val);
  511. # return a simple zero if no MD5 done
  512. return 0 unless grep(!/^0/, @vals);
  513. $val = '';
  514. foreach (@vals) { $val .= sprintf("%.2x",$_); }
  515. return $val;
  516. }
  517. #------------------------------------------------------------------------------
  518. # get formatted value from ICC tag (which has the type embedded)
  519. # Inputs: 0) data reference, 1) offset to tag data, 2) tag data size
  520. # Returns: Formatted value or undefined if format not supported
  521. # Notes: The following types are handled by BinaryTables:
  522. # chromaticityType, colorantTableType, measurementType, viewingConditionsType
  523. # The following types are currently not handled (most are large tables):
  524. # curveType, lut16Type, lut8Type, lutAtoBType, lutBtoAType, namedColor2Type,
  525. # parametricCurveType, profileSeqDescType, responseCurveSet16Type
  526. # The multiLocalizedUnicodeType must be handled by the calling routine.
  527. sub FormatICCTag($$$)
  528. {
  529. my ($dataPt, $offset, $size) = @_;
  530. my $type;
  531. if ($size >= 8) {
  532. # get data type from start of tag data
  533. $type = substr($$dataPt, $offset, 4);
  534. } else {
  535. $type = 'err';
  536. }
  537. # colorantOrderType
  538. if ($type eq 'clro' and $size >= 12) {
  539. my $num = Get32u($dataPt, $offset+8);
  540. if ($size >= $num + 12) {
  541. my $pos = $offset + 12;
  542. return join(' ',unpack("x$pos c$num", $$dataPt));
  543. }
  544. }
  545. # dataType
  546. if ($type eq 'data' and $size >= 12) {
  547. my $form = Get32u($dataPt, $offset+8);
  548. # format 0 is ASCII data
  549. $form == 0 and return substr($$dataPt, $offset+12, $size-12);
  550. # binary data and other data types treat as binary (ie. don't format)
  551. }
  552. # dateTimeType
  553. if ($type eq 'dtim' and $size >= 20) {
  554. return sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d",
  555. Get16u($dataPt, $offset+8), Get16u($dataPt, $offset+10),
  556. Get16u($dataPt, $offset+12), Get16u($dataPt, $offset+14),
  557. Get16u($dataPt, $offset+16), Get16u($dataPt, $offset+18));
  558. }
  559. # s15Fixed16ArrayType
  560. if ($type eq 'sf32') {
  561. return ReadValue($dataPt,$offset+8,'fixed32s',($size-8)/4,$size-8);
  562. }
  563. # signatureType
  564. if ($type eq 'sig ' and $size >= 12) {
  565. return substr($$dataPt, $offset+8, 4);
  566. }
  567. # textType
  568. $type eq 'text' and return substr($$dataPt, $offset+8, $size-8);
  569. # textDescriptionType (ref 2, replaced by multiLocalizedUnicodeType)
  570. if ($type eq 'desc' and $size >= 12) {
  571. my $len = Get32u($dataPt, $offset+8);
  572. if ($size >= $len + 12) {
  573. my $str = substr($$dataPt, $offset+12, $len);
  574. $str =~ s/\0.*//s; # truncate at null terminator
  575. return $str;
  576. }
  577. }
  578. # u16Fixed16ArrayType
  579. if ($type eq 'uf32') {
  580. return ReadValue($dataPt,$offset+8,'fixed32u',($size-8)/4,$size-8);
  581. }
  582. # uInt32ArrayType
  583. if ($type eq 'ui32') {
  584. return ReadValue($dataPt,$offset+8,'int32u',($size-8)/4,$size-8);
  585. }
  586. # uInt64ArrayType
  587. if ($type eq 'ui64') {
  588. return ReadValue($dataPt,$offset+8,'int64u',($size-8)/8,$size-8);
  589. }
  590. # uInt8ArrayType
  591. if ($type eq 'ui08') {
  592. return ReadValue($dataPt,$offset+8,'int8u',$size-8,$size-8);
  593. }
  594. # XYZType
  595. if ($type eq 'XYZ ') {
  596. my $str = '';
  597. my $pos;
  598. for ($pos=8; $pos+12<=$size; $pos+=12) {
  599. $str and $str .= ', ';
  600. $str .= ReadValue($dataPt,$offset+$pos,'fixed32s',3,$size-$pos);
  601. }
  602. return $str;
  603. }
  604. return undef; # data type is not supported
  605. }
  606. #------------------------------------------------------------------------------
  607. # Process ICC metadata record (ref 5) (UNTESTED!)
  608. # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
  609. # Returns: 1 on success
  610. sub ProcessMetadata($$$)
  611. {
  612. my ($et, $dirInfo, $tagTablePtr) = @_;
  613. my $dataPt = $$dirInfo{DataPt};
  614. my $dirStart = $$dirInfo{DirStart};
  615. my $dirLen = $$dirInfo{DirLen};
  616. my $dirEnd = $dirStart + $dirLen;
  617. if ($dirLen < 16 or substr($$dataPt, $dirStart, 4) ne 'dict') {
  618. $et->Warn('Invalid ICC meta dictionary');
  619. return 0;
  620. }
  621. my $num = Get32u($dataPt, $dirStart + 8);
  622. $et->VerboseDir('Metadata', $num);
  623. my $size = Get32u($dataPt, $dirStart + 12);
  624. $size < 16 and $et->Warn('Invalid ICC meta record size'), return 0;
  625. # NOTE: In the example the minimum offset is 20,
  626. # but this doesn't jive with the table (both in ref 5)
  627. my $minPtr = 16 + $size * $num;
  628. my $index;
  629. for ($index=0; $index<$num; ++$index) {
  630. my $entry = $dirStart + 16 + $size * $index;
  631. if ($entry + $size > $dirEnd) {
  632. $et->Warn('Truncated ICC meta dictionary');
  633. last;
  634. }
  635. my $namePtr = Get32u($dataPt, $entry);
  636. my $nameLen = Get32u($dataPt, $entry + 4);
  637. my $valuePtr = Get32u($dataPt, $entry + 8);
  638. my $valueLen = Get32u($dataPt, $entry + 16);
  639. next unless $namePtr and $valuePtr; # ignore if offsets are zero
  640. if ($namePtr < $minPtr or $namePtr + $nameLen > $dirLen or
  641. $valuePtr < $minPtr or $valuePtr + $valueLen > $dirLen)
  642. {
  643. $et->Warn('Corrupted ICC meta dictionary');
  644. last;
  645. }
  646. my $tag = substr($dataPt, $dirStart + $namePtr, $nameLen);
  647. my $val = substr($dataPt, $dirStart + $valuePtr, $valueLen);
  648. $tag = $et->Decode($tag, 'UTF16', 'MM', 'UTF8');
  649. $val = $et->Decode($val, 'UTF16', 'MM');
  650. # generate tagInfo if it doesn't exist
  651. unless ($$tagTablePtr{$tag}) {
  652. my $name = ucfirst $tag;
  653. $name =~ s/\s+(.)/\u$1/g;
  654. $name =~ tr/-_a-zA-Z0-9//dc;
  655. next unless length $name;
  656. AddTagToTable($tagTablePtr, $tag, { Name => $name });
  657. }
  658. $et->HandleTag($tagTablePtr, $tag, $val);
  659. }
  660. return 1;
  661. }
  662. #------------------------------------------------------------------------------
  663. # Write ICC profile file
  664. # Inputs: 0) ExifTool object reference, 1) Reference to directory information
  665. # Returns: 1 on success, 0 if this wasn't a valid ICC file,
  666. # or -1 if a write error occurred
  667. sub WriteICC($$)
  668. {
  669. my ($et, $dirInfo) = @_;
  670. # first make sure this is a valid ICC file (or no file at all)
  671. my $raf = $$dirInfo{RAF};
  672. my $buff;
  673. return 0 if $raf->Read($buff, 24) and ValidateICC(\$buff);
  674. # now write the new ICC
  675. $buff = WriteICC_Profile($et, $dirInfo);
  676. if (defined $buff and length $buff) {
  677. Write($$dirInfo{OutFile}, $buff) or return -1;
  678. } else {
  679. $et->Error('No ICC information to write');
  680. }
  681. return 1;
  682. }
  683. #------------------------------------------------------------------------------
  684. # Write ICC data as a block
  685. # Inputs: 0) ExifTool object reference, 1) source dirInfo reference,
  686. # 2) tag table reference
  687. # Returns: ICC data block (may be empty if no ICC data)
  688. # Notes: Increments ExifTool CHANGED flag if changed
  689. sub WriteICC_Profile($$;$)
  690. {
  691. my ($et, $dirInfo, $tagTablePtr) = @_;
  692. $et or return 1; # allow dummy access
  693. my $dirName = $$dirInfo{DirName} || 'ICC_Profile';
  694. # (don't write AsShotICCProfile or CurrentICCProfile here)
  695. return undef unless $dirName eq 'ICC_Profile';
  696. my $nvHash = $et->GetNewValueHash($Image::ExifTool::Extra{$dirName});
  697. my $val = $et->GetNewValue($nvHash);
  698. $val = '' unless defined $val;
  699. return undef unless $et->IsOverwriting($nvHash, $val);
  700. ++$$et{CHANGED};
  701. return $val;
  702. }
  703. #------------------------------------------------------------------------------
  704. # Validate ICC data
  705. # Inputs: 0) ICC data reference
  706. # Returns: error string or undef on success
  707. sub ValidateICC($)
  708. {
  709. my $valPtr = shift;
  710. my $err;
  711. length($$valPtr) < 24 and return 'Invalid ICC profile';
  712. $profileClass{substr($$valPtr, 12, 4)} or $err = 'profile class';
  713. my $col = substr($$valPtr, 16, 4); # ColorSpaceData
  714. my $con = substr($$valPtr, 20, 4); # ConnectionSpace
  715. my $match = '(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR)';
  716. $col =~ /$match/ or $err = 'color space';
  717. $con =~ /$match/ or $err = 'connection space';
  718. return $err ? "Invalid ICC profile (bad $err)" : undef;
  719. }
  720. #------------------------------------------------------------------------------
  721. # Process ICC profile file
  722. # Inputs: 0) ExifTool object reference, 1) Reference to directory information
  723. # Returns: 1 if this was an ICC file
  724. sub ProcessICC($$)
  725. {
  726. my ($et, $dirInfo) = @_;
  727. my $raf = $$dirInfo{RAF};
  728. my $buff;
  729. $raf->Read($buff, 24) == 24 or return 0;
  730. # check to see if this is a valid ICC profile file
  731. return 0 if ValidateICC(\$buff);
  732. $et->SetFileType();
  733. # read the profile
  734. my $size = unpack('N', $buff);
  735. if ($size < 128 or $size & 0x80000000) {
  736. $et->Error("Bad ICC Profile length ($size)");
  737. return 1;
  738. }
  739. $raf->Seek(0, 0);
  740. unless ($raf->Read($buff, $size)) {
  741. $et->Error('Truncated ICC profile');
  742. return 1;
  743. }
  744. my %dirInfo = (
  745. DataPt => \$buff,
  746. DataLen => $size,
  747. DirStart => 0,
  748. DirLen => $size,
  749. );
  750. my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
  751. return ProcessICC_Profile($et, \%dirInfo, $tagTablePtr);
  752. }
  753. #------------------------------------------------------------------------------
  754. # Process ICC_Profile APP13 record
  755. # Inputs: 0) ExifTool object reference, 1) Reference to directory information
  756. # 2) Tag table reference (undefined to read ICC file)
  757. # Returns: 1 on success
  758. sub ProcessICC_Profile($$$)
  759. {
  760. my ($et, $dirInfo, $tagTablePtr) = @_;
  761. my $dataPt = $$dirInfo{DataPt};
  762. my $dirStart = $$dirInfo{DirStart} || 0;
  763. my $dirLen = $$dirInfo{DirLen};
  764. my $verbose = $et->Options('Verbose');
  765. return 0 if $dirLen < 4;
  766. # extract binary ICC_Profile data block if binary mode or requested
  767. if ((($$et{TAGS_FROM_FILE} and not $$et{EXCL_TAG_LOOKUP}{icc_profile}) or
  768. $$et{REQ_TAG_LOOKUP}{icc_profile}) and
  769. # (don't extract from AsShotICCProfile or CurrentICCProfile)
  770. (not $$dirInfo{Name} or $$dirInfo{Name} eq 'ICC_Profile'))
  771. {
  772. $et->FoundTag('ICC_Profile', substr($$dataPt, $dirStart, $dirLen));
  773. }
  774. SetByteOrder('MM'); # ICC_Profile is always big-endian
  775. # check length of table
  776. my $len = Get32u($dataPt, $dirStart);
  777. if ($len != $dirLen or $len < 128) {
  778. $et->Warn("Bad length ICC_Profile (length $len)");
  779. return 0 if $len < 128 or $dirLen < $len;
  780. }
  781. my $pos = $dirStart + 128; # position at start of table
  782. my $numEntries = Get32u($dataPt, $pos);
  783. if ($numEntries < 1 or $numEntries >= 0x100
  784. or $numEntries * 12 + 132 > $dirLen)
  785. {
  786. $et->Warn("Bad ICC_Profile table ($numEntries entries)");
  787. return 0;
  788. }
  789. if ($verbose) {
  790. $et->VerboseDir('ICC_Profile', $numEntries, $dirLen);
  791. my $fakeInfo = { Name=>'ProfileHeader', SubDirectory => { } };
  792. $et->VerboseInfo(undef, $fakeInfo);
  793. }
  794. # increment ICC dir count
  795. my $dirCount = $$et{DIR_COUNT}{ICC} = ($$et{DIR_COUNT}{ICC} || 0) + 1;
  796. $$et{SET_GROUP1} = '+' . $dirCount if $dirCount > 1;
  797. # process the header block
  798. my %subdirInfo = (
  799. Name => 'ProfileHeader',
  800. DataPt => $dataPt,
  801. DataLen => $$dirInfo{DataLen},
  802. DirStart => $dirStart,
  803. DirLen => 128,
  804. Parent => $$dirInfo{DirName},
  805. DirName => 'Header',
  806. );
  807. my $newTagTable = GetTagTable('Image::ExifTool::ICC_Profile::Header');
  808. $et->ProcessDirectory(\%subdirInfo, $newTagTable);
  809. $pos += 4; # skip item count
  810. my $index;
  811. for ($index=0; $index<$numEntries; ++$index) {
  812. my $tagID = substr($$dataPt, $pos, 4);
  813. my $offset = Get32u($dataPt, $pos + 4);
  814. my $size = Get32u($dataPt, $pos + 8);
  815. $pos += 12;
  816. my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
  817. # unknown tags aren't generated automatically by GetTagInfo()
  818. # if the tagID's aren't numeric, so we must do this manually:
  819. if (not $tagInfo and $$et{OPTIONS}{Unknown}) {
  820. $tagInfo = { Unknown => 1 };
  821. AddTagToTable($tagTablePtr, $tagID, $tagInfo);
  822. }
  823. next unless defined $tagInfo;
  824. if ($offset + $size > $dirLen) {
  825. $et->Warn("Bad ICC_Profile table (truncated)");
  826. last;
  827. }
  828. my $valuePtr = $dirStart + $offset;
  829. my $subdir = $$tagInfo{SubDirectory};
  830. # format the value unless this is a subdirectory
  831. my ($value, $fmt);
  832. if ($size > 4) {
  833. $fmt = substr($$dataPt, $valuePtr, 4);
  834. # handle multiLocalizedUnicodeType
  835. if ($fmt eq 'mluc' and not $subdir) {
  836. next if $size < 28;
  837. my $count = Get32u($dataPt, $valuePtr + 8);
  838. my $recLen = Get32u($dataPt, $valuePtr + 12);
  839. next if $recLen < 12;
  840. my $i;
  841. for ($i=0; $i<$count; ++$i) {
  842. my $recPos = $valuePtr + 16 + $i * $recLen;
  843. last if $recPos + $recLen > $valuePtr + $size;
  844. my $lang = substr($$dataPt, $recPos, 4);
  845. my $langInfo;
  846. # validate language code and change to standard case (just in case)
  847. if ($lang =~ s/^([a-z]{2})([A-Z]{2})$/\L$1-\U$2/i and $lang ne 'en-US') {
  848. $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
  849. }
  850. my $strLen = Get32u($dataPt, $recPos + 4);
  851. my $strPos = Get32u($dataPt, $recPos + 8);
  852. last if $strPos + $strLen > $size;
  853. my $str = substr($$dataPt, $valuePtr + $strPos, $strLen);
  854. $str = $et->Decode($str, 'UTF16');
  855. $et->HandleTag($tagTablePtr, $tagID, $str,
  856. TagInfo => $langInfo || $tagInfo,
  857. Table => $tagTablePtr,
  858. Index => $index,
  859. Value => $str,
  860. DataPt => $dataPt,
  861. Size => $strLen,
  862. Start => $valuePtr + $strPos,
  863. Format => "type '$fmt'",
  864. );
  865. }
  866. $et->Warn("Corrupted $$tagInfo{Name} data") if $i < $count;
  867. next;
  868. }
  869. } else {
  870. $fmt = 'err ';
  871. }
  872. $value = FormatICCTag($dataPt, $valuePtr, $size) unless $subdir;
  873. $verbose and $et->VerboseInfo($tagID, $tagInfo,
  874. Table => $tagTablePtr,
  875. Index => $index,
  876. Value => $value,
  877. DataPt => $dataPt,
  878. Size => $size,
  879. Start => $valuePtr,
  880. Format => "type '$fmt'",
  881. );
  882. if ($subdir) {
  883. my $name = $$tagInfo{Name};
  884. undef $newTagTable;
  885. if ($$subdir{TagTable}) {
  886. $newTagTable = GetTagTable($$subdir{TagTable});
  887. unless ($newTagTable) {
  888. warn "Unknown tag table $$subdir{TagTable}\n";
  889. next;
  890. }
  891. } else {
  892. warn "Must specify TagTable for SubDirectory $name\n";
  893. next;
  894. }
  895. %subdirInfo = (
  896. Name => $name,
  897. DataPt => $dataPt,
  898. DataPos => $$dirInfo{DataPos},
  899. DataLen => $$dirInfo{DataLen},
  900. DirStart => $valuePtr,
  901. DirLen => $size,
  902. DirName => $name,
  903. Parent => $$dirInfo{DirName},
  904. );
  905. my $type = substr($$dataPt, $valuePtr, 4);
  906. #### eval Validate ($type)
  907. if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
  908. $et->Warn("Invalid $name data");
  909. } else {
  910. $et->ProcessDirectory(\%subdirInfo, $newTagTable, $$subdir{ProcessProc});
  911. }
  912. } elsif (defined $value) {
  913. $et->FoundTag($tagInfo, $value);
  914. } else {
  915. $value = substr($$dataPt, $valuePtr, $size);
  916. # treat unsupported formats as binary data
  917. $$tagInfo{ValueConv} = '\$val' unless defined $$tagInfo{ValueConv};
  918. $et->FoundTag($tagInfo, $value);
  919. }
  920. }
  921. delete $$et{SET_GROUP1};
  922. return 1;
  923. }
  924. 1; # end
  925. __END__
  926. =head1 NAME
  927. Image::ExifTool::ICC_Profile - Read ICC Profile meta information
  928. =head1 SYNOPSIS
  929. This module is loaded automatically by Image::ExifTool when required.
  930. =head1 DESCRIPTION
  931. This module contains the definitions to read information from ICC profiles.
  932. ICC (International Color Consortium) profiles are used to translate color
  933. data created on one device into another device's native color space.
  934. =head1 AUTHOR
  935. Copyright 2003-2016, Phil Harvey (phil at owl.phy.queensu.ca)
  936. This library is free software; you can redistribute it and/or modify it
  937. under the same terms as Perl itself.
  938. =head1 REFERENCES
  939. =over 4
  940. =item L<http://www.color.org/icc_specs2.html>
  941. =item L<http://developer.apple.com/documentation/GraphicsImaging/Reference/ColorSync_Manager/ColorSync_Manager.pdf>
  942. =back
  943. =head1 SEE ALSO
  944. L<Image::ExifTool::TagNames/ICC_Profile Tags>,
  945. L<Image::ExifTool(3pm)|Image::ExifTool>
  946. =cut