File Coverage

blib/lib/Image/ExifTool/ICC_Profile.pm
Criterion Covered Total %
statement 129 236 54.6
branch 59 134 44.0
condition 29 84 34.5
subroutine 9 11 81.8
pod 0 8 0.0
total 226 473 47.7


line stmt bran cond sub pod time code
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             # 6) Eef Vreeland private communication
14             # 7) https://color.org/specification/ICC.2-2019.pdf
15             # 8) https://www.color.org/specification/ICC.1-2022-05.pdf
16             #
17             # Notes: The ICC profile information is different: the format of each
18             # tag is embedded in the information instead of in the directory
19             # structure. This makes things a bit more complex because I need
20             # an extra level of logic to decode the variable-format tags.
21             #------------------------------------------------------------------------------
22              
23             package Image::ExifTool::ICC_Profile;
24              
25 14     14   104 use strict;
  14         37  
  14         710  
26 14     14   86 use vars qw($VERSION);
  14         29  
  14         872  
27 14     14   81 use Image::ExifTool qw(:DataAccess :Utils);
  14         30  
  14         84942  
28              
29             $VERSION = '1.42';
30              
31             sub ProcessICC($$);
32             sub ProcessICC_Profile($$$);
33             sub WriteICC_Profile($$;$);
34             sub ProcessMetadata($$$);
35             sub ValidateICC($);
36              
37             # illuminant type definitions
38             my %illuminantType = (
39             1 => 'D50',
40             2 => 'D65',
41             3 => 'D93',
42             4 => 'F2',
43             5 => 'D55',
44             6 => 'A',
45             7 => 'Equi-Power (E)',
46             8 => 'F8',
47             );
48             my %profileClass = (
49             scnr => 'Input Device Profile',
50             mntr => 'Display Device Profile',
51             prtr => 'Output Device Profile',
52             'link'=> 'DeviceLink Profile',
53             spac => 'ColorSpace Conversion Profile',
54             abst => 'Abstract Profile',
55             nmcl => 'NamedColor Profile',
56             nkpf => 'Nikon Input Device Profile (NON-STANDARD!)', # (written by Nikon utilities)
57             # additions in v5 (ref 7)
58             cenc => 'ColorEncodingSpace Profile',
59             'mid '=> 'MultiplexIdentification Profile',
60             mlnk => 'MultiplexLink Profile',
61             mvis => 'MultiplexVisualization Profile',
62             );
63             my %manuSig = ( #6
64             'NONE' => 'none',
65             'none' => 'none', #PH
66             '' => '', #PH
67             '4d2p' => 'Erdt Systems GmbH & Co KG',
68             'AAMA' => 'Aamazing Technologies, Inc.',
69             'ACER' => 'Acer Peripherals',
70             'ACLT' => 'Acolyte Color Research',
71             'ACTI' => 'Actix Systems, Inc.',
72             'ADAR' => 'Adara Technology, Inc.',
73             'ADBE' => 'Adobe Systems Inc.',
74             'ADI ' => 'ADI Systems, Inc.',
75             'AGFA' => 'Agfa Graphics N.V.',
76             'ALMD' => 'Alps Electric USA, Inc.',
77             'ALPS' => 'Alps Electric USA, Inc.',
78             'ALWN' => 'Alwan Color Expertise',
79             'AMTI' => 'Amiable Technologies, Inc.',
80             'AOC ' => 'AOC International (U.S.A), Ltd.',
81             'APAG' => 'Apago',
82             'APPL' => 'Apple Computer Inc.',
83             'appl' => 'Apple Computer Inc.',
84             'AST ' => 'AST',
85             'AT&T' => 'AT&T Computer Systems',
86             'BAEL' => 'BARBIERI electronic',
87             'berg' => 'bergdesign incorporated',
88             'bICC' => 'basICColor GmbH',
89             'BRCO' => 'Barco NV',
90             'BRKP' => 'Breakpoint Pty Limited',
91             'BROT' => 'Brother Industries, LTD',
92             'BULL' => 'Bull',
93             'BUS ' => 'Bus Computer Systems',
94             'C-IT' => 'C-Itoh',
95             'CAMR' => 'Intel Corporation',
96             'CANO' => 'Canon, Inc. (Canon Development Americas, Inc.)',
97             'CARR' => 'Carroll Touch',
98             'CASI' => 'Casio Computer Co., Ltd.',
99             'CBUS' => 'Colorbus PL',
100             'CEL ' => 'Crossfield',
101             'CELx' => 'Crossfield',
102             'ceyd' => 'Integrated Color Solutions, Inc.',
103             'CGS ' => 'CGS Publishing Technologies International GmbH',
104             'CHM ' => 'Rochester Robotics',
105             'CIGL' => 'Colour Imaging Group, London',
106             'CITI' => 'Citizen',
107             'CL00' => 'Candela, Ltd.',
108             'CLIQ' => 'Color IQ',
109             'clsp' => 'MacDermid ColorSpan, Inc.',
110             'CMCO' => 'Chromaco, Inc.',
111             'CMiX' => 'CHROMiX',
112             'COLO' => 'Colorgraphic Communications Corporation',
113             'COMP' => 'COMPAQ Computer Corporation',
114             'COMp' => 'Compeq USA/Focus Technology',
115             'CONR' => 'Conrac Display Products',
116             'CORD' => 'Cordata Technologies, Inc.',
117             'CPQ ' => 'Compaq Computer Corporation',
118             'CPRO' => 'ColorPro',
119             'CRN ' => 'Cornerstone',
120             'CTX ' => 'CTX International, Inc.',
121             'CVIS' => 'ColorVision',
122             'CWC ' => 'Fujitsu Laboratories, Ltd.',
123             'DARI' => 'Darius Technology, Ltd.',
124             'DATA' => 'Dataproducts',
125             'DCP ' => 'Dry Creek Photo',
126             'DCRC' => 'Digital Contents Resource Center, Chung-Ang University',
127             'DELL' => 'Dell Computer Corporation',
128             'DIC ' => 'Dainippon Ink and Chemicals',
129             'DICO' => 'Diconix',
130             'DIGI' => 'Digital',
131             'DL&C' => 'Digital Light & Color',
132             'DPLG' => 'Doppelganger, LLC',
133             'DS ' => 'Dainippon Screen',
134             'ds ' => 'Dainippon Screen',
135             'DSOL' => 'DOOSOL',
136             'DUPN' => 'DuPont',
137             'dupn' => 'DuPont',
138             'Eizo' => 'EIZO NANAO CORPORATION',
139             'EPSO' => 'Epson',
140             'ESKO' => 'Esko-Graphics',
141             'ETRI' => 'Electronics and Telecommunications Research Institute',
142             'EVER' => 'Everex Systems, Inc.',
143             'EXAC' => 'ExactCODE GmbH',
144             'FALC' => 'Falco Data Products, Inc.',
145             'FF ' => 'Fuji Photo Film Co.,LTD',
146             'FFEI' => 'FujiFilm Electronic Imaging, Ltd.',
147             'ffei' => 'FujiFilm Electronic Imaging, Ltd.',
148             'flux' => 'FluxData Corporation',
149             'FNRD' => 'fnord software',
150             'FORA' => 'Fora, Inc.',
151             'FORE' => 'Forefront Technology Corporation',
152             'FP ' => 'Fujitsu',
153             'FPA ' => 'WayTech Development, Inc.',
154             'FUJI' => 'Fujitsu',
155             'FX ' => 'Fuji Xerox Co., Ltd.',
156             'GCC ' => 'GCC Technologies, Inc.',
157             'GGSL' => 'Global Graphics Software Limited',
158             'GMB ' => 'Gretagmacbeth',
159             'GMG ' => 'GMG GmbH & Co. KG',
160             'GOLD' => 'GoldStar Technology, Inc.',
161             'GOOG' => 'Google', #PH
162             'GPRT' => 'Giantprint Pty Ltd',
163             'GTMB' => 'Gretagmacbeth',
164             'GVC ' => 'WayTech Development, Inc.',
165             'GW2K' => 'Sony Corporation',
166             'HCI ' => 'HCI',
167             'HDM ' => 'Heidelberger Druckmaschinen AG',
168             'HERM' => 'Hermes',
169             'HITA' => 'Hitachi America, Ltd.',
170             'HiTi' => 'HiTi Digital, Inc.',
171             'HP ' => 'Hewlett-Packard',
172             'HTC ' => 'Hitachi, Ltd.',
173             'IBM ' => 'IBM Corporation',
174             'IDNT' => 'Scitex Corporation, Ltd.',
175             'Idnt' => 'Scitex Corporation, Ltd.',
176             'IEC ' => 'Hewlett-Packard',
177             'IIYA' => 'Iiyama North America, Inc.',
178             'IKEG' => 'Ikegami Electronics, Inc.',
179             'IMAG' => 'Image Systems Corporation',
180             'IMI ' => 'Ingram Micro, Inc.',
181             'Inca' => 'Inca Digital Printers Ltd.',
182             'INTC' => 'Intel Corporation',
183             'INTL' => 'N/A (INTL)',
184             'INTR' => 'Intra Electronics USA, Inc.',
185             'IOCO' => 'Iocomm International Technology Corporation',
186             'IPS ' => 'InfoPrint Solutions Company',
187             'IRIS' => 'Scitex Corporation, Ltd.',
188             'Iris' => 'Scitex Corporation, Ltd.',
189             'iris' => 'Scitex Corporation, Ltd.',
190             'ISL ' => 'Ichikawa Soft Laboratory',
191             'ITNL' => 'N/A (ITNL)',
192             'IVM ' => 'IVM',
193             'IWAT' => 'Iwatsu Electric Co., Ltd.',
194             'JPEG' => 'Joint Photographic Experts Group', #PH
195             'JSFT' => 'Jetsoft Development',
196             'JVC ' => 'JVC Information Products Co.',
197             'KART' => 'Scitex Corporation, Ltd.',
198             'Kart' => 'Scitex Corporation, Ltd.',
199             'kart' => 'Scitex Corporation, Ltd.',
200             'KFC ' => 'KFC Computek Components Corporation',
201             'KLH ' => 'KLH Computers',
202             'KMHD' => 'Konica Minolta Holdings, Inc.',
203             'KNCA' => 'Konica Corporation',
204             'KODA' => 'Kodak',
205             'KYOC' => 'Kyocera',
206             'LCAG' => 'Leica Camera AG',
207             'LCCD' => 'Leeds Colour',
208             'lcms' => 'Little CMS', #NealKrawetz
209             'LDAK' => 'Left Dakota',
210             'LEAD' => 'Leading Technology, Inc.',
211             'Leaf' => 'Leaf', #PH
212             'LEXM' => 'Lexmark International, Inc.',
213             'LINK' => 'Link Computer, Inc.',
214             'LINO' => 'Linotronic',
215             'Lino' => 'Linotronic', #PH (NC)
216             'lino' => 'Linotronic', #PH (NC)
217             'LITE' => 'Lite-On, Inc.',
218             'MAGC' => 'Mag Computronic (USA) Inc.',
219             'MAGI' => 'MAG Innovision, Inc.',
220             'MANN' => 'Mannesmann',
221             'MICN' => 'Micron Technology, Inc.',
222             'MICR' => 'Microtek',
223             'MICV' => 'Microvitec, Inc.',
224             'MINO' => 'Minolta',
225             'MITS' => 'Mitsubishi Electronics America, Inc.',
226             'MITs' => 'Mitsuba Corporation',
227             'Mits' => 'Mitsubishi Electric Corporation Kyoto Works',
228             'MNLT' => 'Minolta',
229             'MODG' => 'Modgraph, Inc.',
230             'MONI' => 'Monitronix, Inc.',
231             'MONS' => 'Monaco Systems Inc.',
232             'MORS' => 'Morse Technology, Inc.',
233             'MOTI' => 'Motive Systems',
234             'MSFT' => 'Microsoft Corporation',
235             'MUTO' => 'MUTOH INDUSTRIES LTD.',
236             'NANA' => 'NANAO USA Corporation',
237             'NEC ' => 'NEC Corporation',
238             'NEXP' => 'NexPress Solutions LLC',
239             'NISS' => 'Nissei Sangyo America, Ltd.',
240             'NKON' => 'Nikon Corporation',
241             'ob4d' => 'Erdt Systems GmbH & Co KG',
242             'obic' => 'Medigraph GmbH',
243             'OCE ' => 'Oce Technologies B.V.',
244             'OCEC' => 'OceColor',
245             'OKI ' => 'Oki',
246             'OKID' => 'Okidata',
247             'OKIP' => 'Okidata',
248             'OLIV' => 'Olivetti',
249             'OLYM' => 'OLYMPUS OPTICAL CO., LTD',
250             'ONYX' => 'Onyx Graphics',
251             'OPTI' => 'Optiquest',
252             'PACK' => 'Packard Bell',
253             'PANA' => 'Matsushita Electric Industrial Co., Ltd.',
254             'PANT' => 'Pantone, Inc.',
255             'PBN ' => 'Packard Bell',
256             'PFU ' => 'PFU Limited',
257             'PHIL' => 'Philips Consumer Electronics Co.',
258             'PNTX' => 'HOYA Corporation PENTAX Imaging Systems Division',
259             'POne' => 'Phase One A/S',
260             'PREM' => 'Premier Computer Innovations',
261             'PRIN' => 'Princeton Graphic Systems',
262             'PRIP' => 'Princeton Publishing Labs',
263             'QLUX' => 'Hong Kong',
264             'QMS ' => 'QMS, Inc.',
265             'QPCD' => 'QPcard AB',
266             'QUAD' => 'QuadLaser',
267             'quby' => 'Qubyx Sarl',
268             'QUME' => 'Qume Corporation',
269             'RADI' => 'Radius, Inc.',
270             'RDDx' => 'Integrated Color Solutions, Inc.',
271             'RDG ' => 'Roland DG Corporation',
272             'REDM' => 'REDMS Group, Inc.',
273             'RELI' => 'Relisys',
274             'RGMS' => 'Rolf Gierling Multitools',
275             'RICO' => 'Ricoh Corporation',
276             'RNLD' => 'Edmund Ronald',
277             'ROYA' => 'Royal',
278             'RPC ' => 'Ricoh Printing Systems,Ltd.',
279             'RTL ' => 'Royal Information Electronics Co., Ltd.',
280             'SAMP' => 'Sampo Corporation of America',
281             'SAMS' => 'Samsung, Inc.',
282             'SANT' => 'Jaime Santana Pomares',
283             'SCIT' => 'Scitex Corporation, Ltd.',
284             'Scit' => 'Scitex Corporation, Ltd.',
285             'scit' => 'Scitex Corporation, Ltd.',
286             'SCRN' => 'Dainippon Screen',
287             'scrn' => 'Dainippon Screen',
288             'SDP ' => 'Scitex Corporation, Ltd.',
289             'Sdp ' => 'Scitex Corporation, Ltd.',
290             'sdp ' => 'Scitex Corporation, Ltd.',
291             'SEC ' => 'SAMSUNG ELECTRONICS CO.,LTD',
292             'SEIK' => 'Seiko Instruments U.S.A., Inc.',
293             'SEIk' => 'Seikosha',
294             'SGUY' => 'ScanGuy.com',
295             'SHAR' => 'Sharp Laboratories',
296             'SICC' => 'International Color Consortium',
297             'siwi' => 'SIWI GRAFIKA CORPORATION',
298             'SONY' => 'SONY Corporation',
299             'Sony' => 'Sony Corporation',
300             'SPCL' => 'SpectraCal',
301             'STAR' => 'Star',
302             'STC ' => 'Sampo Technology Corporation',
303             'TALO' => 'Talon Technology Corporation',
304             'TAND' => 'Tandy',
305             'TATU' => 'Tatung Co. of America, Inc.',
306             'TAXA' => 'TAXAN America, Inc.',
307             'TDS ' => 'Tokyo Denshi Sekei K.K.',
308             'TECO' => 'TECO Information Systems, Inc.',
309             'TEGR' => 'Tegra',
310             'TEKT' => 'Tektronix, Inc.',
311             'TI ' => 'Texas Instruments',
312             'TMKR' => 'TypeMaker Ltd.',
313             'TOSB' => 'TOSHIBA corp.',
314             'TOSH' => 'Toshiba, Inc.',
315             'TOTK' => 'TOTOKU ELECTRIC Co., LTD',
316             'TRIU' => 'Triumph',
317             'TSBT' => 'TOSHIBA TEC CORPORATION',
318             'TTX ' => 'TTX Computer Products, Inc.',
319             'TVM ' => 'TVM Professional Monitor Corporation',
320             'TW ' => 'TW Casper Corporation',
321             'ULSX' => 'Ulead Systems',
322             'UNIS' => 'Unisys',
323             'UTZF' => 'Utz Fehlau & Sohn',
324             'VARI' => 'Varityper',
325             'VIEW' => 'Viewsonic',
326             'VISL' => 'Visual communication',
327             'VIVO' => 'Vivo Mobile Communication Co., Ltd',
328             'WANG' => 'Wang',
329             'WLBR' => 'Wilbur Imaging',
330             'WTG2' => 'Ware To Go',
331             'WYSE' => 'WYSE Technology',
332             'XERX' => 'Xerox Corporation',
333             'XM ' => 'Xiaomi',
334             'XRIT' => 'X-Rite',
335             'yxym' => 'YxyMaster GmbH',
336             'Z123' => "Lavanya's test Company",
337             'Zebr' => 'Zebra Technologies Inc',
338             'ZRAN' => 'Zoran Corporation',
339             # also seen: " ",ACMS,KCMS,UCCM,etc2,SCTX
340             # registry: https://www.color.org/signatureRegistry/index.xalter
341             );
342              
343             # ICC_Profile tag table
344             %Image::ExifTool::ICC_Profile::Main = (
345             GROUPS => { 2 => 'Image' },
346             PROCESS_PROC => \&ProcessICC_Profile,
347             WRITE_PROC => \&WriteICC_Profile,
348             NOTES => q{
349             ICC profile information is used in many different file types including JPEG,
350             TIFF, PDF, PostScript, Photoshop, PNG, MIFF, PICT, QuickTime, XCF and some
351             RAW formats. While the tags listed below are not individually writable, the
352             entire profile itself can be accessed via the extra 'ICC_Profile' tag, but
353             this tag is neither extracted nor written unless specified explicitly. See
354             L for the official ICC
355             specification.
356             },
357             A2B0 => 'AToB0',
358             A2B1 => 'AToB1',
359             A2B2 => 'AToB2',
360             bXYZ => 'BlueMatrixColumn', # (called BlueColorant in ref 2)
361             bTRC => {
362             Name => 'BlueTRC',
363             Description => 'Blue Tone Reproduction Curve',
364             },
365             B2A0 => 'BToA0',
366             B2A1 => 'BToA1',
367             B2A2 => 'BToA2',
368             calt => {
369             Name => 'CalibrationDateTime',
370             Groups => { 2 => 'Time' },
371             PrintConv => '$self->ConvertDateTime($val)',
372             },
373             targ => {
374             Name => 'CharTarget',
375             ValueConv => '$val=~s/\0.*//; length $val > 128 ? \$val : $val',
376             },
377             chad => 'ChromaticAdaptation',
378             chrm => {
379             Name => 'Chromaticity',
380             Groups => { 1 => 'ICC_Profile#' }, #(just for the group list)
381             SubDirectory => {
382             TagTable => 'Image::ExifTool::ICC_Profile::Chromaticity',
383             Validate => '$type eq "chrm"',
384             },
385             },
386             clro => 'ColorantOrder',
387             clrt => {
388             Name => 'ColorantTable',
389             SubDirectory => {
390             TagTable => 'Image::ExifTool::ICC_Profile::ColorantTable',
391             Validate => '$type eq "clrt"',
392             },
393             },
394             clot => { # new in version 4.2
395             Name => 'ColorantTableOut',
396             Binary => 1,
397             },
398             cprt => {
399             Name => 'ProfileCopyright',
400             ValueConv => '$val=~s/\0.*//; $val', # may be null terminated
401             },
402             crdi => 'CRDInfo', #2
403             dmnd => {
404             Name => 'DeviceMfgDesc',
405             Groups => { 2 => 'Camera' },
406             },
407             dmdd => {
408             Name => 'DeviceModelDesc',
409             Groups => { 2 => 'Camera' },
410             },
411             devs => {
412             Name => 'DeviceSettings', #2
413             Groups => { 2 => 'Camera' },
414             },
415             gamt => 'Gamut',
416             kTRC => {
417             Name => 'GrayTRC',
418             Description => 'Gray Tone Reproduction Curve',
419             },
420             gXYZ => 'GreenMatrixColumn', # (called GreenColorant in ref 2)
421             gTRC => {
422             Name => 'GreenTRC',
423             Description => 'Green Tone Reproduction Curve',
424             },
425             lumi => 'Luminance',
426             meas => {
427             Name => 'Measurement',
428             SubDirectory => {
429             TagTable => 'Image::ExifTool::ICC_Profile::Measurement',
430             Validate => '$type eq "meas"',
431             },
432             },
433             bkpt => 'MediaBlackPoint',
434             wtpt => 'MediaWhitePoint',
435             ncol => 'NamedColor', #2
436             ncl2 => 'NamedColor2',
437             resp => 'OutputResponse',
438             pre0 => 'Preview0',
439             pre1 => 'Preview1',
440             pre2 => 'Preview2',
441             desc => 'ProfileDescription',
442             pseq => 'ProfileSequenceDesc',
443             psd0 => 'PostScript2CRD0', #2
444             psd1 => 'PostScript2CRD1', #2
445             psd2 => 'PostScript2CRD2', #2
446             ps2s => 'PostScript2CSA', #2
447             ps2i => 'PS2RenderingIntent', #2
448             rXYZ => 'RedMatrixColumn', # (called RedColorant in ref 2)
449             rTRC => {
450             Name => 'RedTRC',
451             Description => 'Red Tone Reproduction Curve',
452             },
453             scrd => 'ScreeningDesc',
454             scrn => 'Screening',
455             'bfd '=> {
456             Name => 'UCRBG',
457             Description => 'Under Color Removal and Black Gen.',
458             },
459             tech => {
460             Name => 'Technology',
461             PrintConv => {
462             fscn => 'Film Scanner',
463             dcam => 'Digital Camera',
464             rscn => 'Reflective Scanner',
465             ijet => 'Ink Jet Printer',
466             twax => 'Thermal Wax Printer',
467             epho => 'Electrophotographic Printer',
468             esta => 'Electrostatic Printer',
469             dsub => 'Dye Sublimation Printer',
470             rpho => 'Photographic Paper Printer',
471             fprn => 'Film Writer',
472             vidm => 'Video Monitor',
473             vidc => 'Video Camera',
474             pjtv => 'Projection Television',
475             'CRT '=> 'Cathode Ray Tube Display',
476             'PMD '=> 'Passive Matrix Display',
477             'AMD '=> 'Active Matrix Display',
478             KPCD => 'Photo CD',
479             imgs => 'Photo Image Setter',
480             grav => 'Gravure',
481             offs => 'Offset Lithography',
482             silk => 'Silkscreen',
483             flex => 'Flexography',
484             mpfs => 'Motion Picture Film Scanner', #5
485             mpfr => 'Motion Picture Film Recorder', #5
486             dmpc => 'Digital Motion Picture Camera', #5
487             dcpj => 'Digital Cinema Projector', #5
488             },
489             },
490             vued => 'ViewingCondDesc',
491             view => {
492             Name => 'ViewingConditions',
493             SubDirectory => {
494             TagTable => 'Image::ExifTool::ICC_Profile::ViewingConditions',
495             Validate => '$type eq "view"',
496             },
497             },
498             ciis => 'ColorimetricIntentImageState', #5
499             cicp => { #8 (Coding-independent Code Points)
500             Name => 'ColorRepresentation',
501             SubDirectory => { TagTable => 'Image::ExifTool::ICC_Profile::ColorRep' },
502             },
503             scoe => 'SceneColorimetryEstimates', #5
504             sape => 'SceneAppearanceEstimates', #5
505             fpce => 'FocalPlaneColorimetryEstimates', #5
506             rhoc => 'ReflectionHardcopyOrigColorimetry', #5
507             rpoc => 'ReflectionPrintOutputColorimetry', #5
508             psid => { #5
509             Name => 'ProfileSequenceIdentifier',
510             Binary => 1,
511             },
512             B2D0 => { Name => 'BToD0', Binary => 1 }, #5
513             B2D1 => { Name => 'BToD1', Binary => 1 }, #5
514             B2D2 => { Name => 'BToD2', Binary => 1 }, #5
515             B2D3 => { Name => 'BToD3', Binary => 1 }, #5
516             D2B0 => { Name => 'DToB0', Binary => 1 }, #5
517             D2B1 => { Name => 'DToB1', Binary => 1 }, #5
518             D2B2 => { Name => 'DToB2', Binary => 1 }, #5
519             D2B3 => { Name => 'DToB3', Binary => 1 }, #5
520             rig0 => { #5
521             Name => 'PerceptualRenderingIntentGamut',
522             PrintConv => {
523             prmg => 'Perceptual Reference Medium Gamut',
524             },
525             },
526             rig2 => { #5
527             Name => 'SaturationRenderingIntentGamut',
528             PrintConv => {
529             prmg => 'Perceptual Reference Medium Gamut',
530             },
531             },
532             meta => { #5
533             Name => 'Metadata',
534             SubDirectory => {
535             TagTable => 'Image::ExifTool::ICC_Profile::Metadata',
536             Validate => '$type eq "dict"',
537             },
538             },
539              
540             # ColorSync custom tags (ref 3)
541             psvm => 'PS2CRDVMSize',
542             vcgt => 'VideoCardGamma',
543             mmod => 'MakeAndModel',
544             dscm => 'ProfileDescriptionML',
545             ndin => 'NativeDisplayInfo',
546              
547             # Microsoft custom tags (ref http://msdn2.microsoft.com/en-us/library/ms536870.aspx)
548             MS00 => 'WCSProfiles',
549              
550             psd3 => { #6
551             Name => 'PostScript2CRD3',
552             Binary => 1, # (NC)
553             },
554              
555             # new tags in v5 (ref 7)
556             A2B3 => 'AToB3',
557             A2M0 => 'AToM0',
558             B2A3 => 'BToA3',
559             bcp0 => 'BRDFColorimetricParam0',
560             bcp1 => 'BRDFColorimetricParam1',
561             bcp2 => 'BRDFColorimetricParam2',
562             bcp3 => 'BRDFColorimetricParam3',
563             bsp0 => 'BRDFSpectralParam0',
564             bsp1 => 'BRDFSpectralParam1',
565             bsp2 => 'BRDFSpectralParam2',
566             bsp3 => 'BRDFSpectralParam3',
567             bAB0 => 'BRDFAToB0',
568             bAB1 => 'BRDFAToB1',
569             bAB2 => 'BRDFAToB2',
570             bAB3 => 'BRDFAToB3',
571             bBA0 => 'BRDFBToA0',
572             bBA1 => 'BRDFBToA1',
573             bBA2 => 'BRDFBToA2',
574             bBA3 => 'BRDFBToA3',
575             bBD0 => 'BRDFBToD0',
576             bBD1 => 'BRDFBToD1',
577             bBD2 => 'BRDFBToD2',
578             bBD3 => 'BRDFBToD3',
579             bDB0 => 'BRDFDToB0',
580             bDB1 => 'BRDFDToB1',
581             bDB2 => 'BRDFDToB2',
582             bDB3 => 'BRDFDToB3',
583             bMB0 => 'BRDFMToB0',
584             bMB1 => 'BRDFMToB1',
585             bMB2 => 'BRDFMToB2',
586             bMB3 => 'BRDFMToB3',
587             bMS0 => 'BRDFMToS0',
588             bMS1 => 'BRDFMToS1',
589             bMS2 => 'BRDFMToS2',
590             bMS3 => 'BRDFMToS3',
591             dAB0 => 'DirectionalAToB0',
592             dAB1 => 'DirectionalAToB1',
593             dAB2 => 'DirectionalAToB2',
594             dAB3 => 'DirectionalAToB3',
595             dBA0 => 'DirectionalBToA0',
596             dBA1 => 'DirectionalBToA1',
597             dBA2 => 'DirectionalBToA2',
598             dBA3 => 'DirectionalBToA3',
599             dBD0 => 'DirectionalBToD0',
600             dBD1 => 'DirectionalBToD1',
601             dBD2 => 'DirectionalBToD2',
602             dBD3 => 'DirectionalBToD3',
603             dDB0 => 'DirectionalDToB0',
604             dDB1 => 'DirectionalDToB1',
605             dDB2 => 'DirectionalDToB2',
606             dDB3 => 'DirectionalDToB3',
607             gdb0 => 'GamutBoundaryDescription0',
608             gdb1 => 'GamutBoundaryDescription1',
609             gdb2 => 'GamutBoundaryDescription2',
610             gdb3 => 'GamutBoundaryDescription3',
611             'mdv '=> 'MultiplexDefaultValues',
612             mcta => 'MultiplexTypeArray',
613             minf => 'MeasurementInfo',
614             miin => 'MeasurementInputInfo',
615             M2A0 => 'MToA0',
616             M2B0 => 'MToB0',
617             M2B1 => 'MToB1',
618             M2B2 => 'MToB2',
619             M2B3 => 'MToB3',
620             M2S0 => 'MToS0',
621             M2S1 => 'MToS1',
622             M2S2 => 'MToS2',
623             M2S3 => 'MToS3',
624             cept => 'ColorEncodingParams',
625             csnm => 'ColorSpaceName',
626             cloo => 'ColorantOrderOut',
627             clio => 'ColorantInfoOut',
628             c2sp => 'CustomToStandardPcc',
629             'CxF '=> 'CXF',
630             nmcl => 'NamedColor',
631             psin => 'ProfileSequenceInfo',
632             rfnm => 'ReferenceName',
633             svcn => 'SpectralViewingConditions',
634             swpt => 'SpectralWhitePoint',
635             s2cp => 'StandardToCustomPcc',
636             smap => 'SurfaceMap',
637             # smwp ? (seen in some v5 samples [was a mistake in sample production])
638             hdgm => { Name => 'HDGainMapInfo', Binary => 1 }, #PH
639              
640             # the following entry represents the ICC profile header, and doesn't
641             # exist as a tag in the directory. It is only in this table to provide
642             # a link so ExifTool can locate the header tags
643             Header => {
644             Name => 'ProfileHeader',
645             SubDirectory => {
646             TagTable => 'Image::ExifTool::ICC_Profile::Header',
647             },
648             },
649             );
650              
651             # ICC profile header definition
652             %Image::ExifTool::ICC_Profile::Header = (
653             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
654             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-header', 2 => 'Image' },
655             4 => {
656             Name => 'ProfileCMMType',
657             Format => 'string[4]',
658             SeparateTable => 'ManuSig',
659             PrintConv => \%manuSig,
660             },
661             8 => {
662             Name => 'ProfileVersion',
663             Format => 'int16s',
664             PrintConv => '($val >> 8).".".(($val & 0xf0)>>4).".".($val & 0x0f)',
665             },
666             12 => {
667             Name => 'ProfileClass',
668             Format => 'string[4]',
669             PrintConv => \%profileClass,
670             },
671             16 => {
672             Name => 'ColorSpaceData',
673             Format => 'string[4]',
674             },
675             20 => {
676             Name => 'ProfileConnectionSpace',
677             Format => 'string[4]',
678             },
679             24 => {
680             Name => 'ProfileDateTime',
681             Groups => { 2 => 'Time' },
682             Format => 'int16u[6]',
683             ValueConv => 'sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d",split(" ",$val));',
684             PrintConv => '$self->ConvertDateTime($val)',
685             },
686             36 => {
687             Name => 'ProfileFileSignature',
688             Format => 'string[4]',
689             },
690             40 => {
691             Name => 'PrimaryPlatform',
692             Format => 'string[4]',
693             PrintConv => {
694             'APPL' => 'Apple Computer Inc.',
695             'MSFT' => 'Microsoft Corporation',
696             'SGI ' => 'Silicon Graphics Inc.',
697             'SUNW' => 'Sun Microsystems Inc.',
698             'TGNT' => 'Taligent Inc.',
699             },
700             },
701             44 => {
702             Name => 'CMMFlags',
703             Format => 'int32u',
704             PrintConv => q[
705             ($val & 0x01 ? "Embedded, " : "Not Embedded, ") .
706             ($val & 0x02 ? "Not Independent" : "Independent")
707             ],
708             },
709             48 => {
710             Name => 'DeviceManufacturer',
711             Format => 'string[4]',
712             SeparateTable => 'ManuSig',
713             PrintConv => \%manuSig,
714             },
715             52 => {
716             Name => 'DeviceModel',
717             Format => 'string[4]',
718             # ROMM = Reference Output Medium Metric
719             },
720             56 => {
721             Name => 'DeviceAttributes',
722             Format => 'int32u[2]',
723             PrintConv => q[
724             my @v = split ' ', $val;
725             ($v[1] & 0x01 ? "Transparency, " : "Reflective, ") .
726             ($v[1] & 0x02 ? "Matte, " : "Glossy, ") .
727             ($v[1] & 0x04 ? "Negative, " : "Positive, ") .
728             ($v[1] & 0x08 ? "B&W" : "Color");
729             ],
730             },
731             64 => {
732             Name => 'RenderingIntent',
733             Format => 'int32u',
734             PrintConv => {
735             0 => 'Perceptual',
736             1 => 'Media-Relative Colorimetric',
737             2 => 'Saturation',
738             3 => 'ICC-Absolute Colorimetric',
739             },
740             },
741             68 => {
742             Name => 'ConnectionSpaceIlluminant',
743             Format => 'fixed32s[3]', # xyz
744             },
745             80 => {
746             Name => 'ProfileCreator',
747             Format => 'string[4]',
748             SeparateTable => 'ManuSig',
749             PrintConv => \%manuSig,
750             },
751             84 => {
752             Name => 'ProfileID',
753             Format => 'int8u[16]',
754             PrintConv => 'Image::ExifTool::ICC_Profile::HexID($val)',
755             },
756             );
757              
758             # Coding-independent code points (cicp) definition
759             # (NOTE: conversions are the same as Image::ExifTool::QuickTime::ColorRep tags)
760             %Image::ExifTool::ICC_Profile::ColorRep = (
761             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
762             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-cicp', 2 => 'Image' },
763             8 => {
764             Name => 'ColorPrimaries',
765             PrintConv => {
766             1 => 'BT.709',
767             2 => 'Unspecified',
768             4 => 'BT.470 System M (historical)',
769             5 => 'BT.470 System B, G (historical)',
770             6 => 'BT.601',
771             7 => 'SMPTE 240',
772             8 => 'Generic film (color filters using illuminant C)',
773             9 => 'BT.2020, BT.2100',
774             10 => 'SMPTE 428 (CIE 1931 XYZ)', #forum14766
775             11 => 'SMPTE RP 431-2',
776             12 => 'SMPTE EG 432-1',
777             22 => 'EBU Tech. 3213-E',
778             },
779             },
780             9 => {
781             Name => 'TransferCharacteristics',
782             PrintConv => {
783             0 => 'For future use (0)',
784             1 => 'BT.709',
785             2 => 'Unspecified',
786             3 => 'For future use (3)',
787             4 => 'BT.470 System M (historical)', # Gamma 2.2? (ref forum14960)
788             5 => 'BT.470 System B, G (historical)', # Gamma 2.8? (ref forum14960)
789             6 => 'BT.601',
790             7 => 'SMPTE 240 M',
791             8 => 'Linear',
792             9 => 'Logarithmic (100 : 1 range)',
793             10 => 'Logarithmic (100 * Sqrt(10) : 1 range)',
794             11 => 'IEC 61966-2-4',
795             12 => 'BT.1361',
796             13 => 'sRGB or sYCC',
797             14 => 'BT.2020 10-bit systems',
798             15 => 'BT.2020 12-bit systems',
799             16 => 'SMPTE ST 2084, ITU BT.2100 PQ',
800             17 => 'SMPTE ST 428',
801             18 => 'BT.2100 HLG, ARIB STD-B67',
802             },
803             },
804             10 => {
805             Name => 'MatrixCoefficients',
806             PrintConv => {
807             0 => 'Identity matrix',
808             1 => 'BT.709',
809             2 => 'Unspecified',
810             3 => 'For future use (3)',
811             4 => 'US FCC 73.628',
812             5 => 'BT.470 System B, G (historical)',
813             6 => 'BT.601',
814             7 => 'SMPTE 240 M',
815             8 => 'YCgCo',
816             9 => 'BT.2020 non-constant luminance, BT.2100 YCbCr',
817             10 => 'BT.2020 constant luminance',
818             11 => 'SMPTE ST 2085 YDzDx',
819             12 => 'Chromaticity-derived non-constant luminance',
820             13 => 'Chromaticity-derived constant luminance',
821             14 => 'BT.2100 ICtCp',
822             },
823             },
824             11 => {
825             Name => 'VideoFullRangeFlag',
826             PrintConv => { 0 => 'Limited', 1 => 'Full' },
827             },
828             );
829              
830             # viewingConditionsType (view) definition
831             %Image::ExifTool::ICC_Profile::ViewingConditions = (
832             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
833             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-view', 2 => 'Image' },
834             8 => {
835             Name => 'ViewingCondIlluminant',
836             Format => 'fixed32s[3]', # xyz
837             },
838             20 => {
839             Name => 'ViewingCondSurround',
840             Format => 'fixed32s[3]', # xyz
841             },
842             32 => {
843             Name => 'ViewingCondIlluminantType',
844             Format => 'int32u',
845             PrintConv => \%illuminantType,
846             },
847             );
848              
849             # measurementType (meas) definition
850             %Image::ExifTool::ICC_Profile::Measurement = (
851             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
852             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-meas', 2 => 'Image' },
853             8 => {
854             Name => 'MeasurementObserver',
855             Format => 'int32u',
856             PrintConv => {
857             1 => 'CIE 1931',
858             2 => 'CIE 1964',
859             },
860             },
861             12 => {
862             Name => 'MeasurementBacking',
863             Format => 'fixed32s[3]', # xyz
864             },
865             24 => {
866             Name => 'MeasurementGeometry',
867             Format => 'int32u',
868             PrintConv => {
869             0 => 'Unknown',
870             1 => '0/45 or 45/0',
871             2 => '0/d or d/0',
872             },
873             },
874             28 => {
875             Name => 'MeasurementFlare',
876             Format => 'fixed32u',
877             PrintConv => '$val*100 . "%"', # change into a percent
878             },
879             32 => {
880             Name => 'MeasurementIlluminant',
881             Format => 'int32u',
882             PrintConv => \%illuminantType,
883             },
884             );
885              
886             # chromaticity (chrm) definition
887             %Image::ExifTool::ICC_Profile::Chromaticity = (
888             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
889             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-chrm', 2 => 'Image' },
890             8 => {
891             Name => 'ChromaticityChannels',
892             Format => 'int16u',
893             },
894             10 => {
895             Name => 'ChromaticityColorant',
896             Format => 'int16u',
897             PrintConv => {
898             0 => 'Unknown',
899             1 => 'ITU-R BT.709',
900             2 => 'SMPTE RP145-1994',
901             3 => 'EBU Tech.3213-E',
902             4 => 'P22',
903             },
904             },
905             # include definitions for 4 channels -- if there are
906             # fewer then the ProcessBinaryData logic won't print them.
907             # If there are more, oh well.
908             12 => {
909             Name => 'ChromaticityChannel1',
910             Format => 'fixed32u[2]',
911             },
912             20 => {
913             Name => 'ChromaticityChannel2',
914             Format => 'fixed32u[2]',
915             },
916             28 => {
917             Name => 'ChromaticityChannel3',
918             Format => 'fixed32u[2]',
919             },
920             36 => {
921             Name => 'ChromaticityChannel4',
922             Format => 'fixed32u[2]',
923             },
924             );
925              
926             # colorantTable (clrt) definition
927             %Image::ExifTool::ICC_Profile::ColorantTable = (
928             PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
929             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-clrt', 2 => 'Image' },
930             8 => {
931             Name => 'ColorantCount',
932             Format => 'int32u',
933             },
934             # include definitions for 3 colorants -- if there are
935             # fewer then the ProcessBinaryData logic won't print them.
936             # If there are more, oh well.
937             12 => {
938             Name => 'Colorant1Name',
939             Format => 'string[32]',
940             },
941             44 => {
942             Name => 'Colorant1Coordinates',
943             Format => 'int16u[3]',
944             },
945             50 => {
946             Name => 'Colorant2Name',
947             Format => 'string[32]',
948             },
949             82 => {
950             Name => 'Colorant2Coordinates',
951             Format => 'int16u[3]',
952             },
953             88 => {
954             Name => 'Colorant3Name',
955             Format => 'string[32]',
956             },
957             120 => {
958             Name => 'Colorant3Coordinates',
959             Format => 'int16u[3]',
960             },
961             );
962              
963             # metadata (meta) tags
964             %Image::ExifTool::ICC_Profile::Metadata = (
965             PROCESS_PROC => \&ProcessMetadata,
966             GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-meta', 2 => 'Image' },
967             VARS => { ID_FMT => 'none' },
968             NOTES => q{
969             Only these few tags have been pre-defined, but ExifTool will extract any
970             Metadata tags that exist.
971             },
972             ManufacturerName => { },
973             MediaColor => { },
974             MediaWeight => { },
975             CreatorApp => { },
976             );
977              
978             #------------------------------------------------------------------------------
979             # Print ICC Profile ID in hex
980             # Inputs: 1) string of numbers
981             # Returns: string of hex digits
982             sub HexID($)
983             {
984 34     34 0 99 my $val = shift;
985 34         287 my @vals = split(' ', $val);
986             # return a simple zero if no MD5 done
987 34 50       681 return 0 unless grep(!/^0/, @vals);
988 0         0 $val = '';
989 0         0 foreach (@vals) { $val .= sprintf("%.2x",$_); }
  0         0  
990 0         0 return $val;
991             }
992              
993             #------------------------------------------------------------------------------
994             # Get formatted value from ICC tag (which has the type embedded)
995             # Inputs: 0) data reference, 1) offset to tag data, 2) tag data size
996             # Returns: Formatted value or undefined if format not supported
997             # Notes: The following types are handled by BinaryTables:
998             # chromaticityType, colorantTableType, measurementType, viewingConditionsType
999             # The following types are currently not handled (most are large tables):
1000             # curveType, lut16Type, lut8Type, lutAtoBType, lutBtoAType, namedColor2Type,
1001             # parametricCurveType, profileSeqDescType, responseCurveSet16Type
1002             # The multiLocalizedUnicodeType must be handled by the calling routine.
1003             sub FormatICCTag($$$)
1004             {
1005 660     660 0 1440 my ($dataPt, $offset, $size) = @_;
1006              
1007 660         1005 my $type;
1008 660 50       1385 if ($size >= 8) {
1009             # get data type from start of tag data
1010 660         1339 $type = substr($$dataPt, $offset, 4);
1011             } else {
1012 0         0 $type = 'err';
1013             }
1014             # colorantOrderType
1015 660 50 33     1773 if ($type eq 'clro' and $size >= 12) {
1016 0         0 my $num = Get32u($dataPt, $offset+8);
1017 0 0       0 if ($size >= $num + 12) {
1018 0         0 my $pos = $offset + 12;
1019 0         0 return join(' ',unpack("x$pos c$num", $$dataPt));
1020             }
1021             }
1022             # dataType
1023 660 50 33     1911 if ($type eq 'data' and $size >= 12) {
1024 0         0 my $form = Get32u($dataPt, $offset+8);
1025             # format 0 is UTF-8 data
1026 0 0       0 $form == 0 and return substr($$dataPt, $offset+12, $size-12);
1027             # binary data and other data types treat as binary (ie. don't format)
1028             }
1029             # dateTimeType
1030 660 50 33     1620 if ($type eq 'dtim' and $size >= 20) {
1031 0         0 return sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d",
1032             Get16u($dataPt, $offset+8), Get16u($dataPt, $offset+10),
1033             Get16u($dataPt, $offset+12), Get16u($dataPt, $offset+14),
1034             Get16u($dataPt, $offset+16), Get16u($dataPt, $offset+18));
1035             }
1036             # s15Fixed16ArrayType
1037 660 50       1537 if ($type eq 'sf32') {
1038 0         0 return ReadValue($dataPt,$offset+8,'fixed32s',($size-8)/4,$size-8);
1039             }
1040             # signatureType
1041 660 100 66     1738 if ($type eq 'sig ' and $size >= 12) {
1042 20         88 return substr($$dataPt, $offset+8, 4);
1043             }
1044             # textType
1045 640 100       1591 $type eq 'text' and return substr($$dataPt, $offset+8, $size-8);
1046             # textDescriptionType (ref 2, replaced by multiLocalizedUnicodeType)
1047 583 100 66     1783 if ($type eq 'desc' and $size >= 12) {
1048 117         402 my $len = Get32u($dataPt, $offset+8);
1049 117 50       411 if ($size >= $len + 12) {
1050 117         371 my $str = substr($$dataPt, $offset+12, $len);
1051 117         888 $str =~ s/\0.*//s; # truncate at null terminator
1052 117         392 return $str;
1053             }
1054             }
1055             # u16Fixed16ArrayType
1056 466 50       1201 if ($type eq 'uf32') {
1057 0         0 return ReadValue($dataPt,$offset+8,'fixed32u',($size-8)/4,$size-8);
1058             }
1059             # uInt32ArrayType
1060 466 50       1065 if ($type eq 'ui32') {
1061 0         0 return ReadValue($dataPt,$offset+8,'int32u',($size-8)/4,$size-8);
1062             }
1063             # uInt64ArrayType
1064 466 50       1036 if ($type eq 'ui64') {
1065 0         0 return ReadValue($dataPt,$offset+8,'int64u',($size-8)/8,$size-8);
1066             }
1067             # uInt8ArrayType
1068 466 50       1203 if ($type eq 'ui08') {
1069 0         0 return ReadValue($dataPt,$offset+8,'int8u',$size-8,$size-8);
1070             }
1071             # XYZType
1072 466 100       1036 if ($type eq 'XYZ ') {
1073 295         595 my $str = '';
1074 295         469 my $pos;
1075 295         803 for ($pos=8; $pos+12<=$size; $pos+=12) {
1076 295 50       741 $str and $str .= ', ';
1077 295         1180 $str .= ReadValue($dataPt,$offset+$pos,'fixed32s',3,$size-$pos);
1078             }
1079 295         894 return $str;
1080             }
1081 171         437 return undef; # data type is not supported
1082             }
1083              
1084             #------------------------------------------------------------------------------
1085             # Process ICC metadata record (ref 5)
1086             # Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
1087             # Returns: 1 on success
1088             sub ProcessMetadata($$$)
1089             {
1090 0     0 0 0 my ($et, $dirInfo, $tagTablePtr) = @_;
1091 0         0 my $dataPt = $$dirInfo{DataPt};
1092 0         0 my $dirStart = $$dirInfo{DirStart};
1093 0         0 my $dirLen = $$dirInfo{DirLen};
1094 0         0 my $dirEnd = $dirStart + $dirLen;
1095              
1096 0 0 0     0 if ($dirLen < 16 or substr($$dataPt, $dirStart, 4) ne 'dict') {
1097 0         0 $et->Warn('Invalid ICC meta dictionary');
1098 0         0 return 0;
1099             }
1100 0         0 my $num = Get32u($dataPt, $dirStart + 8);
1101 0         0 $et->VerboseDir('Metadata', $num);
1102 0         0 my $size = Get32u($dataPt, $dirStart + 12);
1103 0 0       0 $size < 16 and $et->Warn('Invalid ICC meta record size'), return 0;
1104             # NOTE: In the example the minimum offset is 20,
1105             # but this doesn't jive with the table (both in ref 5)
1106 0         0 my $minPtr = 16 + $size * $num;
1107 0         0 my $index;
1108 0         0 for ($index=0; $index<$num; ++$index) {
1109 0         0 my $entry = $dirStart + 16 + $size * $index;
1110 0 0       0 if ($entry + $size > $dirEnd) {
1111 0         0 $et->Warn('Truncated ICC meta dictionary');
1112 0         0 last;
1113             }
1114 0         0 my $namePtr = Get32u($dataPt, $entry);
1115 0         0 my $nameLen = Get32u($dataPt, $entry + 4);
1116 0         0 my $valuePtr = Get32u($dataPt, $entry + 8);
1117 0         0 my $valueLen = Get32u($dataPt, $entry + 12);
1118 0 0 0     0 next unless $namePtr and $valuePtr; # ignore if offsets are zero
1119 0 0 0     0 if ($namePtr < $minPtr or $namePtr + $nameLen > $dirLen or
      0        
      0        
1120             $valuePtr < $minPtr or $valuePtr + $valueLen > $dirLen)
1121             {
1122 0         0 $et->Warn('Corrupted ICC meta dictionary');
1123 0         0 last;
1124             }
1125 0         0 my $tag = substr($$dataPt, $dirStart + $namePtr, $nameLen);
1126 0         0 my $val = substr($$dataPt, $dirStart + $valuePtr, $valueLen);
1127 0         0 $tag = $et->Decode($tag, 'UTF16', 'MM', 'UTF8');
1128 0         0 $val = $et->Decode($val, 'UTF16', 'MM');
1129             # generate tagInfo if it doesn't exist
1130 0 0       0 unless ($$tagTablePtr{$tag}) {
1131 0         0 my $name = ucfirst $tag;
1132 0         0 $name =~ s/\s+(.)/\u$1/g;
1133 0         0 $name =~ tr/-_a-zA-Z0-9//dc;
1134 0 0       0 next unless length $name;
1135 0         0 $et->VPrint(0, $$et{INDENT}, "[adding $tag]\n");
1136 0         0 AddTagToTable($tagTablePtr, $tag, { Name => $name });
1137             }
1138 0         0 $et->HandleTag($tagTablePtr, $tag, $val);
1139             }
1140 0         0 return 1;
1141             }
1142              
1143             #------------------------------------------------------------------------------
1144             # Write ICC profile file
1145             # Inputs: 0) ExifTool object reference, 1) Reference to directory information
1146             # Returns: 1 on success, 0 if this wasn't a valid ICC file,
1147             # or -1 if a write error occurred
1148             sub WriteICC($$)
1149             {
1150 0     0 0 0 my ($et, $dirInfo) = @_;
1151             # first make sure this is a valid ICC file (or no file at all)
1152 0         0 my $raf = $$dirInfo{RAF};
1153 0         0 my $buff;
1154 0 0 0     0 return 0 if $raf->Read($buff, 24) and ValidateICC(\$buff);
1155             # now write the new ICC
1156 0         0 $buff = WriteICC_Profile($et, $dirInfo);
1157 0 0 0     0 if (defined $buff and length $buff) {
1158 0 0       0 Write($$dirInfo{OutFile}, $buff) or return -1;
1159             } else {
1160 0         0 $et->Error('No ICC information to write');
1161             }
1162 0         0 return 1;
1163             }
1164              
1165             #------------------------------------------------------------------------------
1166             # Write ICC data as a block
1167             # Inputs: 0) ExifTool object reference, 1) source dirInfo reference,
1168             # 2) tag table reference
1169             # Returns: ICC data block (may be empty if no ICC data)
1170             # Notes: Increments ExifTool CHANGED flag if changed
1171             sub WriteICC_Profile($$;$)
1172             {
1173 9     9 0 27 my ($et, $dirInfo, $tagTablePtr) = @_;
1174 9 50       33 $et or return 1; # allow dummy access
1175 9   50     62 my $dirName = $$dirInfo{DirName} || 'ICC_Profile';
1176             # (don't write AsShotICCProfile or CurrentICCProfile here)
1177 9 100       35 return undef unless $dirName eq 'ICC_Profile';
1178 7         41 my $nvHash = $et->GetNewValueHash($Image::ExifTool::Extra{$dirName});
1179 7         79 my $val = $et->GetNewValue($nvHash);
1180 7 50       25 $val = '' unless defined $val;
1181 7 50       108 return undef unless $et->IsOverwriting($nvHash, $val);
1182 0         0 ++$$et{CHANGED};
1183 0         0 return $val;
1184             }
1185              
1186             #------------------------------------------------------------------------------
1187             # Validate ICC data
1188             # Inputs: 0) ICC data reference
1189             # Returns: error string or undef on success
1190             sub ValidateICC($)
1191             {
1192 12     12 0 76 my $valPtr = shift;
1193 12         26 my $err;
1194 12 50       50 length($$valPtr) < 24 and return 'Invalid ICC profile';
1195 12 50       76 $profileClass{substr($$valPtr, 12, 4)} or $err = 'profile class';
1196 12         35 my $col = substr($$valPtr, 16, 4); # ColorSpaceData
1197 12         32 my $con = substr($$valPtr, 20, 4); # ConnectionSpace
1198 12         34 my $match = '(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR|nc..|\0{4})';
1199 12 50       523 $col =~ /$match/ or $err = 'color space';
1200 12 50       347 $con =~ /$match/ or $err = 'connection space';
1201 12 50       168 return $err ? "Invalid ICC profile (bad $err)" : undef;
1202             }
1203              
1204             #------------------------------------------------------------------------------
1205             # Process ICC profile file
1206             # Inputs: 0) ExifTool object reference, 1) Reference to directory information
1207             # Returns: 1 if this was an ICC file
1208             sub ProcessICC($$)
1209             {
1210 1     1 0 3 my ($et, $dirInfo) = @_;
1211 1         3 my $raf = $$dirInfo{RAF};
1212 1         3 my $buff;
1213 1 50       3 $raf->Read($buff, 24) == 24 or return 0;
1214             # check to see if this is a valid ICC profile file
1215 1 50       6 return 0 if ValidateICC(\$buff);
1216 1         6 $et->SetFileType();
1217             # read the profile
1218 1         3 my $size = unpack('N', $buff);
1219 1 50 33     7 if ($size < 128 or $size & 0x80000000) {
1220 0         0 $et->Error("Bad ICC Profile length ($size)");
1221 0         0 return 1;
1222             }
1223 1         5 $raf->Seek(0, 0);
1224 1 50       3 unless ($raf->Read($buff, $size) == $size) {
1225 0         0 $et->Error('Truncated ICC profile');
1226 0         0 return 1;
1227             }
1228 1         6 my %dirInfo = (
1229             DataPt => \$buff,
1230             DataLen => $size,
1231             DirStart => 0,
1232             DirLen => $size,
1233             );
1234 1         4 my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
1235 1         6 return ProcessICC_Profile($et, \%dirInfo, $tagTablePtr);
1236             }
1237              
1238             #------------------------------------------------------------------------------
1239             # Process ICC_Profile APP13 record
1240             # Inputs: 0) ExifTool object reference, 1) Reference to directory information
1241             # 2) Tag table reference (undefined to read ICC file)
1242             # Returns: 1 on success
1243             sub ProcessICC_Profile($$$)
1244             {
1245 62     62 0 194 my ($et, $dirInfo, $tagTablePtr) = @_;
1246 62         203 my $dataPt = $$dirInfo{DataPt};
1247 62   100     355 my $dirStart = $$dirInfo{DirStart} || 0;
1248 62         234 my $dirLen = $$dirInfo{DirLen};
1249 62         361 my $verbose = $et->Options('Verbose');
1250              
1251 62 50       256 return 0 if $dirLen < 4;
1252              
1253             # extract binary ICC_Profile data block if binary mode or requested
1254 62 100 100     697 if ((($$et{TAGS_FROM_FILE} and not $$et{EXCL_TAG_LOOKUP}{icc_profile}) or
      100        
      100        
1255             $$et{REQ_TAG_LOOKUP}{icc_profile}) and
1256             # (don't extract from AsShotICCProfile or CurrentICCProfile)
1257             (not $$dirInfo{Name} or $$dirInfo{Name} eq 'ICC_Profile'))
1258             {
1259 19         127 $et->FoundTag('ICC_Profile', substr($$dataPt, $dirStart, $dirLen));
1260             }
1261              
1262 62         342 SetByteOrder('MM'); # ICC_Profile is always big-endian
1263              
1264             # check length of table
1265 62         270 my $len = Get32u($dataPt, $dirStart);
1266 62 100 66     402 if ($len != $dirLen or $len < 128) {
1267 5         27 $et->Warn("Bad length ICC_Profile (length $len)");
1268 5 50 33     22 return 0 if $len < 128 or $dirLen < $len;
1269             }
1270 57         242 my $pos = $dirStart + 128; # position at start of table
1271 57         370 my $numEntries = Get32u($dataPt, $pos);
1272 57 50 33     636 if ($numEntries < 1 or $numEntries >= 0x100
      33        
1273             or $numEntries * 12 + 132 > $dirLen)
1274             {
1275 0         0 $et->Warn("Bad ICC_Profile table ($numEntries entries)");
1276 0         0 return 0;
1277             }
1278              
1279 57 50       257 if ($verbose) {
1280 0         0 $et->VerboseDir('ICC_Profile', $numEntries, $dirLen);
1281 0         0 my $fakeInfo = { Name=>'ProfileHeader', SubDirectory => { } };
1282 0         0 $et->VerboseInfo(undef, $fakeInfo);
1283             }
1284             # increment ICC dir count
1285 57   50     479 my $dirCount = $$et{DIR_COUNT}{ICC} = ($$et{DIR_COUNT}{ICC} || 0) + 1;
1286 57 50       212 $$et{SET_GROUP1} = '+' . $dirCount if $dirCount > 1;
1287             # process the header block
1288             my %subdirInfo = (
1289             Name => 'ProfileHeader',
1290             DataPt => $dataPt,
1291             DataLen => $$dirInfo{DataLen},
1292             DirStart => $dirStart,
1293             DirLen => 128,
1294             Parent => $$dirInfo{DirName},
1295 57         624 DirName => 'Header',
1296             );
1297 57         258 my $newTagTable = GetTagTable('Image::ExifTool::ICC_Profile::Header');
1298 57         353 $et->ProcessDirectory(\%subdirInfo, $newTagTable);
1299              
1300 57         172 $pos += 4; # skip item count
1301 57         146 my $index;
1302 57         299 for ($index=0; $index<$numEntries; ++$index) {
1303 700         1763 my $tagID = substr($$dataPt, $pos, 4);
1304 700         2143 my $offset = Get32u($dataPt, $pos + 4);
1305 700         1999 my $size = Get32u($dataPt, $pos + 8);
1306 700         1346 $pos += 12;
1307 700         2192 my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
1308             # unknown tags aren't generated automatically by GetTagInfo()
1309             # if the tagID's aren't numeric, so we must do this manually:
1310 700 0 0     1879 if (not $tagInfo and ($$et{OPTIONS}{Unknown} or $verbose)) {
      33        
1311 0         0 $tagInfo = { Unknown => 1 };
1312 0         0 AddTagToTable($tagTablePtr, $tagID, $tagInfo);
1313             }
1314 700 50       1756 next unless defined $tagInfo;
1315              
1316 700 50       1780 if ($offset + $size > $dirLen) {
1317 0         0 $et->Warn("Bad ICC_Profile table (truncated)");
1318 0         0 last;
1319             }
1320 700         1127 my $valuePtr = $dirStart + $offset;
1321              
1322 700         1529 my $subdir = $$tagInfo{SubDirectory};
1323             # format the value unless this is a subdirectory
1324 700         1369 my ($value, $fmt);
1325 700 50       1481 if ($size > 4) {
1326 700         1470 $fmt = substr($$dataPt, $valuePtr, 4);
1327             # handle multiLocalizedUnicodeType
1328 700 50 33     2059 if ($fmt eq 'mluc' and not $subdir) {
1329 0 0       0 next if $size < 28;
1330 0         0 my $count = Get32u($dataPt, $valuePtr + 8);
1331 0         0 my $recLen = Get32u($dataPt, $valuePtr + 12);
1332 0 0       0 next if $recLen < 12;
1333 0         0 my $i;
1334 0         0 for ($i=0; $i<$count; ++$i) {
1335 0         0 my $recPos = $valuePtr + 16 + $i * $recLen;
1336 0 0       0 last if $recPos + $recLen > $valuePtr + $size;
1337 0         0 my $lang = substr($$dataPt, $recPos, 4);
1338 0         0 my $langInfo;
1339             # validate language code and change to standard case (just in case)
1340 0 0 0     0 if ($lang =~ s/^([a-z]{2})([A-Z]{2})$/\L$1-\U$2/i and $lang ne 'en-US') {
1341 0         0 $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
1342             }
1343 0         0 my $strLen = Get32u($dataPt, $recPos + 4);
1344 0         0 my $strPos = Get32u($dataPt, $recPos + 8);
1345 0 0       0 last if $strPos + $strLen > $size;
1346 0         0 my $str = substr($$dataPt, $valuePtr + $strPos, $strLen);
1347 0         0 $str = $et->Decode($str, 'UTF16');
1348 0   0     0 $et->HandleTag($tagTablePtr, $tagID, $str,
1349             TagInfo => $langInfo || $tagInfo,
1350             Table => $tagTablePtr,
1351             Index => $index,
1352             Value => $str,
1353             DataPt => $dataPt,
1354             Size => $strLen,
1355             Start => $valuePtr + $strPos,
1356             Format => "type '${fmt}'",
1357             );
1358             }
1359 0 0       0 $et->Warn("Corrupted $$tagInfo{Name} data") if $i < $count;
1360 0         0 next;
1361             }
1362             } else {
1363 0         0 $fmt = 'err ';
1364             }
1365 700 100       2420 $value = FormatICCTag($dataPt, $valuePtr, $size) unless $subdir;
1366 700 50       1764 $verbose and $et->VerboseInfo($tagID, $tagInfo,
1367             Table => $tagTablePtr,
1368             Index => $index,
1369             Value => $value,
1370             DataPt => $dataPt,
1371             Size => $size,
1372             Start => $valuePtr,
1373             Format => "type '${fmt}'",
1374             );
1375 700 100       2036 if ($subdir) {
    100          
1376 40         127 my $name = $$tagInfo{Name};
1377 40         94 undef $newTagTable;
1378 40 50       139 if ($$subdir{TagTable}) {
1379 40         202 $newTagTable = GetTagTable($$subdir{TagTable});
1380 40 50       121 unless ($newTagTable) {
1381 0         0 warn "Unknown tag table $$subdir{TagTable}\n";
1382 0         0 next;
1383             }
1384             } else {
1385 0         0 warn "Must specify TagTable for SubDirectory $name\n";
1386 0         0 next;
1387             }
1388             %subdirInfo = (
1389             Name => $name,
1390             DataPt => $dataPt,
1391             DataPos => $$dirInfo{DataPos},
1392             DataLen => $$dirInfo{DataLen},
1393             DirStart => $valuePtr,
1394             DirLen => $size,
1395             DirName => $name,
1396             Parent => $$dirInfo{DirName},
1397 40         554 );
1398 40         107 my $type = $fmt;
1399             #### eval Validate ($type)
1400 40 50 33     3466 if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
1401 0         0 $et->Warn("Invalid ICC $name data");
1402             } else {
1403 40         322 $et->ProcessDirectory(\%subdirInfo, $newTagTable, $$subdir{ProcessProc});
1404             }
1405             } elsif (defined $value) {
1406 489         1868 $et->FoundTag($tagInfo, $value);
1407             } else {
1408 171         571 $value = substr($$dataPt, $valuePtr, $size);
1409             # treat unsupported formats as binary data
1410 171 100       575 $$tagInfo{ValueConv} = '\$val' unless defined $$tagInfo{ValueConv};
1411 171         618 $et->FoundTag($tagInfo, $value);
1412             }
1413             }
1414 57         196 delete $$et{SET_GROUP1};
1415 57         439 return 1;
1416             }
1417              
1418              
1419             1; # end
1420              
1421              
1422             __END__