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