exiftool_vendored 9.45.0 → 9.46.0

data/bin/Image-ExifTool-9.46/lib/Image/ExifTool/ICC_Profile.pm

@@ -0,0 +1,999 @@
+#------------------------------------------------------------------------------
+# File:         ICC_Profile.pm
+#
+# Description:  Read ICC Profile meta information
+#
+# Revisions:    11/16/2004 - P. Harvey Created
+#
+# References:   1) http://www.color.org/icc_specs2.html (ICC.1:2003-09)
+#               2) http://www.color.org/icc_specs2.html (ICC.1:2001-04)
+#               3) http://developer.apple.com/documentation/GraphicsImaging/Reference/ColorSync_Manager/ColorSync_Manager.pdf
+#               4) http://www.color.org/privatetag2007-01.pdf
+#               5) http://www.color.org/icc_specs2.xalter (approved revisions, 2010-07-16)
+#
+# Notes:        The ICC profile information is different: the format of each
+#               tag is embedded in the information instead of in the directory
+#               structure. This makes things a bit more complex because I need
+#               an extra level of logic to decode the variable-format tags.
+#------------------------------------------------------------------------------
+
+package Image::ExifTool::ICC_Profile;
+
+use strict;
+use vars qw($VERSION);
+use Image::ExifTool qw(:DataAccess :Utils);
+
+$VERSION = '1.27';
+
+sub ProcessICC($$);
+sub ProcessICC_Profile($$$);
+sub WriteICC_Profile($$;$);
+sub ProcessMetadata($$$);
+sub ValidateICC($);
+
+# illuminant type definitions
+my %illuminantType = (
+    1 => 'D50',
+    2 => 'D65',
+    3 => 'D93',
+    4 => 'F2',
+    5 => 'D55',
+    6 => 'A',
+    7 => 'Equi-Power (E)',
+    8 => 'F8',
+);
+my %profileClass = (
+    scnr => 'Input Device Profile',
+    mntr => 'Display Device Profile',
+    prtr => 'Output Device Profile',
+   'link'=> 'DeviceLink Profile',
+    spac => 'ColorSpace Conversion Profile',
+    abst => 'Abstract Profile',
+    nmcl => 'NamedColor Profile',
+    nkpf => 'Nikon Input Device Profile (NON-STANDARD!)', # (written by Nikon utilities)
+);
+
+# ICC_Profile tag table
+%Image::ExifTool::ICC_Profile::Main = (
+    GROUPS => { 2 => 'Image' },
+    PROCESS_PROC => \&ProcessICC_Profile,
+    WRITE_PROC => \&WriteICC_Profile,
+    NOTES => q{
+        ICC profile information is used in many different file types including JPEG,
+        TIFF, PDF, PostScript, Photoshop, PNG, MIFF, PICT, QuickTime, XCF and some
+        RAW formats.  While the tags listed below are not individually writable, the
+        entire profile itself can be accessed via the extra 'ICC_Profile' tag, but
+        this tag is neither extracted nor written unless specified explicitly.  See
+        L<http://www.color.org/icc_specs2.xalter> for the official ICC
+        specification.
+    },
+    A2B0 => 'AToB0',
+    A2B1 => 'AToB1',
+    A2B2 => 'AToB2',
+    bXYZ => 'BlueMatrixColumn', # (called BlueColorant in ref 2)
+    bTRC => {
+        Name => 'BlueTRC',
+        Description => 'Blue Tone Reproduction Curve',
+    },
+    B2A0 => 'BToA0',
+    B2A1 => 'BToA1',
+    B2A2 => 'BToA2',
+    calt => {
+        Name => 'CalibrationDateTime',
+        Groups => { 2 => 'Time' },
+        PrintConv => '$self->ConvertDateTime($val)',
+    },
+    targ => {
+        Name => 'CharTarget',
+        ValueConv => 'length $val > 128 ? \$val : $val',
+    },
+    chad => 'ChromaticAdaptation',
+    chrm => {
+        Name => 'Chromaticity',
+        Groups => { 1 => 'ICC_Profile#' }, #(just for the group list)
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::ICC_Profile::Chromaticity',
+            Validate => '$type eq "chrm"',
+        },
+    },
+    clro => 'ColorantOrder',
+    clrt => {
+        Name => 'ColorantTable',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::ICC_Profile::ColorantTable',
+            Validate => '$type eq "clrt"',
+        },
+    },
+    clot => { # new in version 4.2
+        Name => 'ColorantTableOut',
+        Binary => 1,
+    },
+    cprt => {
+        Name => 'ProfileCopyright',
+        ValueConv => '$val=~s/\0.*//; $val', # may be null terminated
+    },
+    crdi => 'CRDInfo', #2
+    dmnd => {
+        Name => 'DeviceMfgDesc',
+        Groups => { 2 => 'Camera' },
+    },
+    dmdd => {
+        Name => 'DeviceModelDesc',
+        Groups => { 2 => 'Camera' },
+    },
+    devs => {
+        Name => 'DeviceSettings', #2
+        Groups => { 2 => 'Camera' },
+    },
+    gamt => 'Gamut',
+    kTRC => {
+        Name => 'GrayTRC',
+        Description => 'Gray Tone Reproduction Curve',
+    },
+    gXYZ => 'GreenMatrixColumn', # (called GreenColorant in ref 2)
+    gTRC => {
+        Name => 'GreenTRC',
+        Description => 'Green Tone Reproduction Curve',
+    },
+    lumi => 'Luminance',
+    meas => {
+        Name => 'Measurement',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::ICC_Profile::Measurement',
+            Validate => '$type eq "meas"',
+        },
+    },
+    bkpt => 'MediaBlackPoint',
+    wtpt => 'MediaWhitePoint',
+    ncol => 'NamedColor', #2
+    ncl2 => 'NamedColor2',
+    resp => 'OutputResponse',
+    pre0 => 'Preview0',
+    pre1 => 'Preview1',
+    pre2 => 'Preview2',
+    desc => 'ProfileDescription',
+    pseq => 'ProfileSequenceDesc',
+    psd0 => 'PostScript2CRD0', #2
+    psd1 => 'PostScript2CRD1', #2
+    psd2 => 'PostScript2CRD2', #2
+    ps2s => 'PostScript2CSA', #2
+    ps2i => 'PS2RenderingIntent', #2
+    rXYZ => 'RedMatrixColumn', # (called RedColorant in ref 2)
+    rTRC => {
+        Name => 'RedTRC',
+        Description => 'Red Tone Reproduction Curve',
+    },
+    scrd => 'ScreeningDesc',
+    scrn => 'Screening',
+   'bfd '=> {
+        Name => 'UCRBG',
+        Description => 'Under Color Removal and Black Gen.',
+    },
+    tech => {
+        Name => 'Technology',
+        PrintConv => {
+            fscn => 'Film Scanner',
+            dcam => 'Digital Camera',
+            rscn => 'Reflective Scanner',
+            ijet => 'Ink Jet Printer',
+            twax => 'Thermal Wax Printer',
+            epho => 'Electrophotographic Printer',
+            esta => 'Electrostatic Printer',
+            dsub => 'Dye Sublimation Printer',
+            rpho => 'Photographic Paper Printer',
+            fprn => 'Film Writer',
+            vidm => 'Video Monitor',
+            vidc => 'Video Camera',
+            pjtv => 'Projection Television',
+           'CRT '=> 'Cathode Ray Tube Display',
+           'PMD '=> 'Passive Matrix Display',
+           'AMD '=> 'Active Matrix Display',
+            KPCD => 'Photo CD',
+            imgs => 'Photo Image Setter',
+            grav => 'Gravure',
+            offs => 'Offset Lithography',
+            silk => 'Silkscreen',
+            flex => 'Flexography',
+            mpfs => 'Motion Picture Film Scanner', #5
+            mpfr => 'Motion Picture Film Recorder', #5
+            dmpc => 'Digital Motion Picture Camera', #5
+            dcpj => 'Digital Cinema Projector', #5
+        },
+    },
+    vued => 'ViewingCondDesc',
+    view => {
+        Name => 'ViewingConditions',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::ICC_Profile::ViewingConditions',
+            Validate => '$type eq "view"',
+        },
+    },
+    ciis => 'ColorimetricIntentImageState', #5
+    scoe => 'SceneColorimetryEstimates', #5
+    sape => 'SceneAppearanceEstimates', #5
+    fpce => 'FocalPlaneColorimetryEstimates', #5
+    rhoc => 'ReflectionHardcopyOrigColorimetry', #5
+    rpoc => 'ReflectionPrintOutputColorimetry', #5
+    psid => { #5
+        Name => 'ProfileSequenceIdentifier',
+        Binary => 1,
+    },
+    B2D0 => { Name => 'BToD0', Binary => 1 }, #5
+    B2D1 => { Name => 'BToD1', Binary => 1 }, #5
+    B2D2 => { Name => 'BToD2', Binary => 1 }, #5
+    B2D3 => { Name => 'BToD3', Binary => 1 }, #5
+    D2B0 => { Name => 'DToB0', Binary => 1 }, #5
+    D2B1 => { Name => 'DToB1', Binary => 1 }, #5
+    D2B2 => { Name => 'DToB2', Binary => 1 }, #5
+    D2B3 => { Name => 'DToB3', Binary => 1 }, #5
+    rig0 => { #5
+        Name => 'PerceptualRenderingIntentGamut',
+        PrintConv => {
+            prmg => 'Perceptual Reference Medium Gamut',
+        },
+    },
+    rig2 => { #5
+        Name => 'SaturationRenderingIntentGamut',
+        PrintConv => {
+            prmg => 'Perceptual Reference Medium Gamut',
+        },
+    },
+    meta => { #5 (EVENTUALLY DECODE THIS ONCE WE HAVE A SAMPLE!!)
+        Name => 'Metadata',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::ICC_Profile::Metadata',
+            Validate => '$type eq "meta"',
+        },
+    },
+
+    # ColorSync custom tags (ref 3)
+    psvm => 'PS2CRDVMSize',
+    vcgt => 'VideoCardGamma',
+    mmod => 'MakeAndModel',
+    dscm => 'ProfileDescriptionML',
+    ndin => 'NativeDisplayInfo',
+
+    # Microsoft custom tags (ref http://msdn2.microsoft.com/en-us/library/ms536870.aspx)
+    MS00 => 'WCSProfiles',
+
+    # the following entry represents the ICC profile header, and doesn't
+    # exist as a tag in the directory.  It is only in this table to provide
+    # a link so ExifTool can locate the header tags
+    Header => {
+        Name => 'ProfileHeader',
+        SubDirectory => {
+            TagTable => 'Image::ExifTool::ICC_Profile::Header',
+        },
+    },
+);
+
+# ICC profile header definition
+%Image::ExifTool::ICC_Profile::Header = (
+    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
+    GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-header', 2 => 'Image' },
+    4 => {
+        Name => 'ProfileCMMType',
+        Format => 'string[4]',
+    },
+    8 => {
+        Name => 'ProfileVersion',
+        Format => 'int16s',
+        PrintConv => '($val >> 8).".".(($val & 0xf0)>>4).".".($val & 0x0f)',
+    },
+    12 => {
+        Name => 'ProfileClass',
+        Format => 'string[4]',
+        PrintConv => \%profileClass,
+    },
+    16 => {
+        Name => 'ColorSpaceData',
+        Format => 'string[4]',
+    },
+    20 => {
+        Name => 'ProfileConnectionSpace',
+        Format => 'string[4]',
+    },
+    24 => {
+        Name => 'ProfileDateTime',
+        Groups => { 2 => 'Time' },
+        Format => 'int16u[6]',
+        ValueConv => 'sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d",split(" ",$val));',
+        PrintConv => '$self->ConvertDateTime($val)',
+    },
+    36 => {
+        Name => 'ProfileFileSignature',
+        Format => 'string[4]',
+    },
+    40 => {
+        Name => 'PrimaryPlatform',
+        Format => 'string[4]',
+        PrintConv => {
+            'APPL' => 'Apple Computer Inc.',
+            'MSFT' => 'Microsoft Corporation',
+            'SGI ' => 'Silicon Graphics Inc.',
+            'SUNW' => 'Sun Microsystems Inc.',
+            'TGNT' => 'Taligent Inc.',
+        },
+    },
+    44 => {
+        Name => 'CMMFlags',
+        Format => 'int32u',
+        PrintConv => q[
+            ($val & 0x01 ? "Embedded, " : "Not Embedded, ") .
+            ($val & 0x02 ? "Not Independent" : "Independent")
+        ],
+    },
+    48 => {
+        Name => 'DeviceManufacturer',
+        Format => 'string[4]',
+        # KODA = Kodak
+    },
+    52 => {
+        Name => 'DeviceModel',
+        Format => 'string[4]',
+        # ROMM = Refrence Output Medium Metric
+    },
+    56 => {
+        Name => 'DeviceAttributes',
+        Format => 'int32u[2]',
+        PrintConv => q[
+            my @v = split ' ', $val;
+            ($v[1] & 0x01 ? "Transparency, " : "Reflective, ") .
+            ($v[1] & 0x02 ? "Matte, " : "Glossy, ") .
+            ($v[1] & 0x04 ? "Negative, " : "Positive, ") .
+            ($v[1] & 0x08 ? "B&W" : "Color");
+        ],
+    },
+    64 => {
+        Name => 'RenderingIntent',
+        Format => 'int32u',
+        PrintConv => {
+            0 => 'Perceptual',
+            1 => 'Media-Relative Colorimetric',
+            2 => 'Saturation',
+            3 => 'ICC-Absolute Colorimetric',
+        },
+    },
+    68 => {
+        Name => 'ConnectionSpaceIlluminant',
+        Format => 'fixed32s[3]',  # xyz
+    },
+    80 => {
+        Name => 'ProfileCreator',
+        Format => 'string[4]',
+        # KODA = Kodak
+    },
+    84 => {
+        Name => 'ProfileID',
+        Format => 'int8u[16]',
+        PrintConv => 'Image::ExifTool::ICC_Profile::HexID($val)',
+    },
+);
+
+# viewingConditionsType (view) definition
+%Image::ExifTool::ICC_Profile::ViewingConditions = (
+    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
+    GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-view', 2 => 'Image' },
+    8 => {
+        Name => 'ViewingCondIlluminant',
+        Format => 'fixed32s[3]',   # xyz
+    },
+    20 => {
+        Name => 'ViewingCondSurround',
+        Format => 'fixed32s[3]',   # xyz
+    },
+    32 => {
+        Name => 'ViewingCondIlluminantType',
+        Format => 'int32u',
+        PrintConv => \%illuminantType,
+    },
+);
+
+# measurementType (meas) definition
+%Image::ExifTool::ICC_Profile::Measurement = (
+    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
+    GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-meas', 2 => 'Image' },
+    8 => {
+        Name => 'MeasurementObserver',
+        Format => 'int32u',
+        PrintConv => {
+            1 => 'CIE 1931',
+            2 => 'CIE 1964',
+        },
+    },
+    12 => {
+        Name => 'MeasurementBacking',
+        Format => 'fixed32s[3]',   # xyz
+    },
+    24 => {
+        Name => 'MeasurementGeometry',
+        Format => 'int32u',
+        PrintConv => {
+            1 => '0/45 or 45/0',
+            2 => '0/d or d/0',
+        },
+    },
+    28 => {
+        Name => 'MeasurementFlare',
+        Format => 'fixed32u',
+        PrintConv => '$val*100 . "%"',  # change into a percent
+    },
+    32 => {
+        Name => 'MeasurementIlluminant',
+        Format => 'int32u',
+        PrintConv => \%illuminantType,
+    },
+);
+
+# chromaticity (chrm) definition
+%Image::ExifTool::ICC_Profile::Chromaticity = (
+    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
+    GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-chrm', 2 => 'Image' },
+    8 => {
+        Name => 'ChromaticityChannels',
+        Format => 'int16u',
+    },
+    10 => {
+        Name => 'ChromaticityColorant',
+        Format => 'int16u',
+        PrintConv => {
+            1 => 'ITU-R BT.709',
+            2 => 'SMPTE RP145-1994',
+            3 => 'EBU Tech.3213-E',
+            4 => 'P22',
+        },
+    },
+    # include definitions for 4 channels -- if there are
+    # fewer then the ProcessBinaryData logic won't print them.
+    # If there are more, oh well.
+    12 => {
+        Name => 'ChromaticityChannel1',
+        Format => 'fixed32u[2]',
+    },
+    20 => {
+        Name => 'ChromaticityChannel2',
+        Format => 'fixed32u[2]',
+    },
+    28 => {
+        Name => 'ChromaticityChannel3',
+        Format => 'fixed32u[2]',
+    },
+    36 => {
+        Name => 'ChromaticityChannel4',
+        Format => 'fixed32u[2]',
+    },
+);
+
+# colorantTable (clrt) definition
+%Image::ExifTool::ICC_Profile::ColorantTable = (
+    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
+    GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-clrt', 2 => 'Image' },
+    8 => {
+        Name => 'ColorantCount',
+        Format => 'int32u',
+    },
+    # include definitions for 3 colorants -- if there are
+    # fewer then the ProcessBinaryData logic won't print them.
+    # If there are more, oh well.
+    12 => {
+        Name => 'Colorant1Name',
+        Format => 'string[32]',
+    },
+    44 => {
+        Name => 'Colorant1Coordinates',
+        Format => 'int16u[3]',
+    },
+    50 => {
+        Name => 'Colorant2Name',
+        Format => 'string[32]',
+    },
+    82 => {
+        Name => 'Colorant2Coordinates',
+        Format => 'int16u[3]',
+    },
+    88 => {
+        Name => 'Colorant3Name',
+        Format => 'string[32]',
+    },
+    120 => {
+        Name => 'Colorant3Coordinates',
+        Format => 'int16u[3]',
+    },
+);
+
+# metadata (meta) tags
+%Image::ExifTool::ICC_Profile::Metadata = (
+    PROCESS_PROC => \&ProcessMetadata,
+    GROUPS => { 0 => 'ICC_Profile', 1 => 'ICC-meta', 2 => 'Image' },
+    VARS => { NO_ID => 1 },
+    NOTES => q{
+        Only these few tags have been pre-defined, but ExifTool will extract any
+        Metadata tags that exist.
+    },
+    ManufacturerName => { },
+    MediaColor       => { },
+    MediaWeight      => { },
+);
+
+#------------------------------------------------------------------------------
+# print ICC Profile ID in hex
+# Inputs: 1) string of numbers
+# Returns: string of hex digits
+sub HexID($)
+{
+    my $val = shift;
+    my @vals = split(' ', $val);
+    # return a simple zero if no MD5 done
+    return 0 unless grep(!/^0/, @vals);
+    $val = '';
+    foreach (@vals) { $val .= sprintf("%.2x",$_); }
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# get formatted value from ICC tag (which has the type embedded)
+# Inputs: 0) data reference, 1) offset to tag data, 2) tag data size
+# Returns: Formatted value or undefined if format not supported
+# Notes: The following types are handled by BinaryTables:
+#  chromaticityType, colorantTableType, measurementType, viewingConditionsType
+# The following types are currently not handled (most are large tables):
+#  curveType, lut16Type, lut8Type, lutAtoBType, lutBtoAType, namedColor2Type,
+#  parametricCurveType, profileSeqDescType, responseCurveSet16Type
+# The multiLocalizedUnicodeType must be handled by the calling routine.
+sub FormatICCTag($$$)
+{
+    my ($dataPt, $offset, $size) = @_;
+
+    my $type;
+    if ($size >= 8) {
+        # get data type from start of tag data
+        $type = substr($$dataPt, $offset, 4);
+    } else {
+        $type = 'err';
+    }
+    # colorantOrderType
+    if ($type eq 'clro' and $size >= 12) {
+        my $num = Get32u($dataPt, $offset+8);
+        if ($size >= $num + 12) {
+            my $pos = $offset + 12;
+            return join(' ',unpack("x$pos c$num", $$dataPt));
+        }
+    }
+    # dataType
+    if ($type eq 'data' and $size >= 12) {
+        my $form = Get32u($dataPt, $offset+8);
+        # format 0 is ASCII data
+        $form == 0 and return substr($$dataPt, $offset+12, $size-12);
+        # binary data and other data types treat as binary (ie. don't format)
+    }
+    # dateTimeType
+    if ($type eq 'dtim' and $size >= 20) {
+        return sprintf("%.4d:%.2d:%.2d %.2d:%.2d:%.2d",
+               Get16u($dataPt, $offset+8),  Get16u($dataPt, $offset+10),
+               Get16u($dataPt, $offset+12), Get16u($dataPt, $offset+14),
+               Get16u($dataPt, $offset+16), Get16u($dataPt, $offset+18));
+    }
+    # s15Fixed16ArrayType
+    if ($type eq 'sf32') {
+        return ReadValue($dataPt,$offset+8,'fixed32s',($size-8)/4,$size-8);
+    }
+    # signatureType
+    if ($type eq 'sig ' and $size >= 12) {
+        return substr($$dataPt, $offset+8, 4);
+    }
+    # textType
+    $type eq 'text' and return substr($$dataPt, $offset+8, $size-8);
+    # textDescriptionType (ref 2, replaced by multiLocalizedUnicodeType)
+    if ($type eq 'desc' and $size >= 12) {
+        my $len = Get32u($dataPt, $offset+8);
+        if ($size >= $len + 12) {
+            my $str = substr($$dataPt, $offset+12, $len);
+            $str =~ s/\0.*//s;   # truncate at null terminator
+            return $str;
+        }
+    }
+    # u16Fixed16ArrayType
+    if ($type eq 'uf32') {
+        return ReadValue($dataPt,$offset+8,'fixed32u',($size-8)/4,$size-8);
+    }
+    # uInt32ArrayType
+    if ($type eq 'ui32') {
+        return ReadValue($dataPt,$offset+8,'int32u',($size-8)/4,$size-8);
+    }
+    # uInt64ArrayType
+    if ($type eq 'ui64') {
+        return ReadValue($dataPt,$offset+8,'int64u',($size-8)/8,$size-8);
+    }
+    # uInt8ArrayType
+    if ($type eq 'ui08') {
+        return ReadValue($dataPt,$offset+8,'int8u',$size-8,$size-8);
+    }
+    # XYZType
+    if ($type eq 'XYZ ') {
+        my $str = '';
+        my $pos;
+        for ($pos=8; $pos+12<=$size; $pos+=12) {
+            $str and $str .= ', ';
+            $str .= ReadValue($dataPt,$offset+$pos,'fixed32s',3,$size-$pos);
+        }
+        return $str;
+    }
+    return undef;   # data type is not supported
+}
+
+#------------------------------------------------------------------------------
+# Process ICC metadata record (ref 5) (UNTESTED!)
+# Inputs: 0) ExifTool ref, 1) dirInfo ref, 2) tag table ref
+# Returns: 1 on success
+sub ProcessMetadata($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    my $dataPt = $$dirInfo{DataPt};
+    my $dirStart = $$dirInfo{DirStart};
+    my $dirLen = $$dirInfo{DirLen};
+    my $dirEnd = $dirStart + $dirLen;
+    
+    if ($dirLen < 16 or substr($$dataPt, $dirStart, 4) ne 'dict') {
+        $et->Warn('Invalid ICC meta dictionary');
+        return 0;
+    }
+    my $num = Get32u($dataPt, $dirStart + 8);
+    $et->VerboseDir('Metadata', $num);
+    my $size = Get32u($dataPt, $dirStart + 12);
+    $size < 16 and $et->Warn('Invalid ICC meta record size'), return 0;
+    # NOTE: In the example the minimum offset is 20,
+    # but this doesn't jive with the table (both in ref 5)
+    my $minPtr = 16 + $size * $num;
+    my $index;
+    for ($index=0; $index<$num; ++$index) {
+        my $entry = $dirStart + 16 + $size * $index;
+        if ($entry + $size > $dirEnd) {
+            $et->Warn('Truncated ICC meta dictionary');
+            last;
+        }
+        my $namePtr = Get32u($dataPt, $entry);
+        my $nameLen = Get32u($dataPt, $entry + 4);
+        my $valuePtr = Get32u($dataPt, $entry + 8);
+        my $valueLen = Get32u($dataPt, $entry + 16);
+        next unless $namePtr and $valuePtr;   # ignore if offsets are zero
+        if ($namePtr < $minPtr or $namePtr + $nameLen > $dirLen or
+            $valuePtr < $minPtr or $valuePtr + $valueLen > $dirLen)
+        {
+            $et->Warn('Corrupted ICC meta dictionary');
+            last;
+        }
+        my $tag = substr($dataPt, $dirStart + $namePtr, $nameLen);
+        my $val = substr($dataPt, $dirStart + $valuePtr, $valueLen);
+        $tag = $et->Decode($tag, 'UTF16', 'MM', 'UTF8');
+        $val = $et->Decode($val, 'UTF16', 'MM');
+        # generate tagInfo if it doesn't exist
+        unless ($$tagTablePtr{$tag}) {
+            my $name = ucfirst $tag;
+            $name =~ s/\s+(.)/\u$1/g;
+            $name =~ tr/-_a-zA-Z0-9//dc;
+            next unless length $name;
+            AddTagToTable($tagTablePtr, $tag, { Name => $name });
+        }
+        $et->HandleTag($tagTablePtr, $tag, $val);
+    }
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+# Write ICC profile file
+# Inputs: 0) ExifTool object reference, 1) Reference to directory information
+# Returns: 1 on success, 0 if this wasn't a valid ICC file,
+#          or -1 if a write error occurred
+sub WriteICC($$)
+{
+    my ($et, $dirInfo) = @_;
+    # first make sure this is a valid ICC file (or no file at all)
+    my $raf = $$dirInfo{RAF};
+    my $buff;
+    return 0 if $raf->Read($buff, 24) and ValidateICC(\$buff);
+    # now write the new ICC
+    $buff = WriteICC_Profile($et, $dirInfo);
+    if (defined $buff and length $buff) {
+        Write($$dirInfo{OutFile}, $buff) or return -1;
+    } else {
+        $et->Error('No ICC information to write');
+    }
+    return 1;
+}
+
+#------------------------------------------------------------------------------
+# Write ICC data as a block
+# Inputs: 0) ExifTool object reference, 1) source dirInfo reference,
+#         2) tag table reference
+# Returns: ICC data block (may be empty if no ICC data)
+# Notes: Increments ExifTool CHANGED flag if changed
+sub WriteICC_Profile($$;$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    $et or return 1;    # allow dummy access
+    my $dirName = $$dirInfo{DirName} || 'ICC_Profile';
+    # (don't write AsShotICCProfile or CurrentICCProfile here)
+    return undef unless $dirName eq 'ICC_Profile';
+    my $nvHash = $et->GetNewValueHash($Image::ExifTool::Extra{$dirName});
+    return undef unless $et->IsOverwriting($nvHash);
+    my $val = $et->GetNewValues($nvHash);
+    $val = '' unless defined $val;
+    ++$$et{CHANGED};
+    return $val;
+}
+
+#------------------------------------------------------------------------------
+# Validate ICC data
+# Inputs: 0) ICC data reference
+# Returns: error string or undef on success
+sub ValidateICC($)
+{
+    my $valPtr = shift;
+    my $err;
+    length($$valPtr) < 24 and return 'Invalid ICC profile';
+    $profileClass{substr($$valPtr, 12, 4)} or $err = 'profile class';
+    my $col = substr($$valPtr, 16, 4); # ColorSpaceData
+    my $con = substr($$valPtr, 20, 4); # ConnectionSpace
+    my $match = '(XYZ |Lab |Luv |YCbr|Yxy |RGB |GRAY|HSV |HLS |CMYK|CMY |[2-9A-F]CLR)';
+    $col =~ /$match/ or $err = 'color space';
+    $con =~ /$match/ or $err = 'connection space';
+    return $err ? "Invalid ICC profile (bad $err)" : undef;
+}
+
+#------------------------------------------------------------------------------
+# Process ICC profile file
+# Inputs: 0) ExifTool object reference, 1) Reference to directory information
+# Returns: 1 if this was an ICC file
+sub ProcessICC($$)
+{
+    my ($et, $dirInfo) = @_;
+    my $raf = $$dirInfo{RAF};
+    my $buff;
+    $raf->Read($buff, 24) == 24 or return 0;
+    # check to see if this is a valid ICC profile file
+    return 0 if ValidateICC(\$buff);
+    $et->SetFileType();
+    # read the profile
+    my $size = unpack('N', $buff);
+    if ($size < 128 or $size & 0x80000000) {
+        $et->Error("Bad ICC Profile length ($size)");
+        return 1;
+    }
+    $raf->Seek(0, 0);
+    unless ($raf->Read($buff, $size)) {
+        $et->Error('Truncated ICC profile');
+        return 1;
+    }
+    my %dirInfo = (
+        DataPt => \$buff,
+        DataLen => $size,
+        DirStart => 0,
+        DirLen => $size,
+    );
+    my $tagTablePtr = GetTagTable('Image::ExifTool::ICC_Profile::Main');
+    return ProcessICC_Profile($et, \%dirInfo, $tagTablePtr);
+}
+
+#------------------------------------------------------------------------------
+# Process ICC_Profile APP13 record
+# Inputs: 0) ExifTool object reference, 1) Reference to directory information
+#         2) Tag table reference (undefined to read ICC file)
+# Returns: 1 on success
+sub ProcessICC_Profile($$$)
+{
+    my ($et, $dirInfo, $tagTablePtr) = @_;
+    my $dataPt = $$dirInfo{DataPt};
+    my $dirStart = $$dirInfo{DirStart} || 0;
+    my $dirLen = $$dirInfo{DirLen};
+    my $verbose = $et->Options('Verbose');
+
+    return 0 if $dirLen < 4;
+
+    # extract binary ICC_Profile data block if binary mode or requested
+    if ((($$et{TAGS_FROM_FILE} and not $$et{EXCL_TAG_LOOKUP}{icc_profile}) or
+        $$et{REQ_TAG_LOOKUP}{icc_profile}) and
+        # (don't extract from AsShotICCProfile or CurrentICCProfile)
+        (not $$dirInfo{Name} or $$dirInfo{Name} eq 'ICC_Profile'))
+    {
+        $et->FoundTag('ICC_Profile', substr($$dataPt, $dirStart, $dirLen));
+    }
+
+    SetByteOrder('MM');     # ICC_Profile is always big-endian
+
+    # check length of table
+    my $len = Get32u($dataPt, $dirStart);
+    if ($len != $dirLen or $len < 128) {
+        $et->Warn("Bad length ICC_Profile (length $len)");
+        return 0 if $len < 128 or $dirLen < $len;
+    }
+    my $pos = $dirStart + 128;  # position at start of table
+    my $numEntries = Get32u($dataPt, $pos);
+    if ($numEntries < 1 or $numEntries >= 0x100
+        or $numEntries * 12 + 132 > $dirLen)
+    {
+        $et->Warn("Bad ICC_Profile table ($numEntries entries)");
+        return 0;
+    }
+
+    if ($verbose) {
+        $et->VerboseDir('ICC_Profile', $numEntries, $dirLen);
+        my $fakeInfo = { Name=>'ProfileHeader', SubDirectory => { } };
+        $et->VerboseInfo(undef, $fakeInfo);
+    }
+    # increment ICC dir count
+    my $dirCount = $$et{DIR_COUNT}{ICC} = ($$et{DIR_COUNT}{ICC} || 0) + 1;
+    $$et{SET_GROUP1} = '+' . $dirCount if $dirCount > 1;
+    # process the header block
+    my %subdirInfo = (
+        Name     => 'ProfileHeader',
+        DataPt   => $dataPt,
+        DataLen  => $$dirInfo{DataLen},
+        DirStart => $dirStart,
+        DirLen   => 128,
+        Parent   => $$dirInfo{DirName},
+        DirName  => 'Header',
+    );
+    my $newTagTable = GetTagTable('Image::ExifTool::ICC_Profile::Header');
+    $et->ProcessDirectory(\%subdirInfo, $newTagTable);
+
+    $pos += 4;    # skip item count
+    my $index;
+    for ($index=0; $index<$numEntries; ++$index) {
+        my $tagID  = substr($$dataPt, $pos, 4);
+        my $offset = Get32u($dataPt, $pos + 4);
+        my $size   = Get32u($dataPt, $pos + 8);
+        $pos += 12;
+        my $tagInfo = $et->GetTagInfo($tagTablePtr, $tagID);
+        # unknown tags aren't generated automatically by GetTagInfo()
+        # if the tagID's aren't numeric, so we must do this manually:
+        if (not $tagInfo and $$et{OPTIONS}{Unknown}) {
+            $tagInfo = { Unknown => 1 };
+            AddTagToTable($tagTablePtr, $tagID, $tagInfo);
+        }
+        next unless defined $tagInfo;
+
+        if ($offset + $size > $dirLen) {
+            $et->Warn("Bad ICC_Profile table (truncated)");
+            last;
+        }
+        my $valuePtr = $dirStart + $offset;
+
+        my $subdir = $$tagInfo{SubDirectory};
+        # format the value unless this is a subdirectory
+        my ($value, $fmt);
+        if ($size > 4) {
+            $fmt = substr($$dataPt, $valuePtr, 4);
+            # handle multiLocalizedUnicodeType
+            if ($fmt eq 'mluc' and not $subdir) {
+                next if $size < 28;
+                my $count = Get32u($dataPt, $valuePtr + 8);
+                my $recLen = Get32u($dataPt, $valuePtr + 12);
+                next if $recLen < 12;
+                my $i;
+                for ($i=0; $i<$count; ++$i) {
+                    my $recPos = $valuePtr + 16 + $i * $recLen;
+                    last if $recPos + $recLen > $valuePtr + $size;
+                    my $lang = substr($$dataPt, $recPos, 4);
+                    my $langInfo;
+                    # validate language code and change to standard case (just in case)
+                    if ($lang =~ s/^([a-z]{2})([A-Z]{2})$/\L$1-\U$2/i and $lang ne 'en-US') {
+                        $langInfo = Image::ExifTool::GetLangInfo($tagInfo, $lang);
+                    }
+                    my $strLen = Get32u($dataPt, $recPos + 4);
+                    my $strPos = Get32u($dataPt, $recPos + 8);
+                    last if $strPos + $strLen > $size; 
+                    my $str = substr($$dataPt, $valuePtr + $strPos, $strLen);
+                    $str = $et->Decode($str, 'UTF16');
+                    $et->HandleTag($tagTablePtr, $tagID, $str,
+                        TagInfo => $langInfo || $tagInfo,
+                        Table  => $tagTablePtr,
+                        Index  => $index,
+                        Value  => $str,
+                        DataPt => $dataPt,
+                        Size   => $strLen,
+                        Start  => $valuePtr + $strPos,
+                        Format => "type '$fmt'",
+                    );
+                }
+                $et->Warn("Corrupted $$tagInfo{Name} data") if $i < $count;
+                next;
+            }
+        } else {
+            $fmt = 'err ';
+        }
+        $value = FormatICCTag($dataPt, $valuePtr, $size) unless $subdir;
+        $verbose and $et->VerboseInfo($tagID, $tagInfo,
+            Table  => $tagTablePtr,
+            Index  => $index,
+            Value  => $value,
+            DataPt => $dataPt,
+            Size   => $size,
+            Start  => $valuePtr,
+            Format => "type '$fmt'",
+        );
+        if ($subdir) {
+            my $name = $$tagInfo{Name};
+            undef $newTagTable;
+            if ($$subdir{TagTable}) {
+                $newTagTable = GetTagTable($$subdir{TagTable});
+                unless ($newTagTable) {
+                    warn "Unknown tag table $$subdir{TagTable}\n";
+                    next;
+                }
+            } else {
+                warn "Must specify TagTable for SubDirectory $name\n";
+                next;
+            }
+            %subdirInfo = (
+                Name     => $name,
+                DataPt   => $dataPt,
+                DataPos  => $$dirInfo{DataPos},
+                DataLen  => $$dirInfo{DataLen},
+                DirStart => $valuePtr,
+                DirLen   => $size,
+                DirName  => $name,
+                Parent   => $$dirInfo{DirName},
+            );
+            my $type = substr($$dataPt, $valuePtr, 4);
+            #### eval Validate ($type)
+            if (defined $$subdir{Validate} and not eval $$subdir{Validate}) {
+                $et->Warn("Invalid $name data");
+            } else {
+                $et->ProcessDirectory(\%subdirInfo, $newTagTable, $$subdir{ProcessProc});
+            }
+        } elsif (defined $value) {
+            $et->FoundTag($tagInfo, $value);
+        } else {
+            $value = substr($$dataPt, $valuePtr, $size);
+            # treat unsupported formats as binary data
+            $$tagInfo{ValueConv} = '\$val' unless defined $$tagInfo{ValueConv};
+            $et->FoundTag($tagInfo, $value);
+        }
+    }
+    delete $$et{SET_GROUP1};
+    return 1;
+}
+
+
+1; # end
+
+
+__END__
+
+=head1 NAME
+
+Image::ExifTool::ICC_Profile - Read ICC Profile meta information
+
+=head1 SYNOPSIS
+
+This module is loaded automatically by Image::ExifTool when required.
+
+=head1 DESCRIPTION
+
+This module contains the definitions to read information from ICC profiles.
+ICC (International Color Consortium) profiles are used to translate color
+data created on one device into another device's native color space.
+
+=head1 AUTHOR
+
+Copyright 2003-2014, Phil Harvey (phil at owl.phy.queensu.ca)
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 REFERENCES
+
+=over 4
+
+=item L<http://www.color.org/icc_specs2.html>
+
+=item L<http://developer.apple.com/documentation/GraphicsImaging/Reference/ColorSync_Manager/ColorSync_Manager.pdf>
+
+=back
+
+=head1 SEE ALSO
+
+L<Image::ExifTool::TagNames/ICC_Profile Tags>,
+L<Image::ExifTool(3pm)|Image::ExifTool>
+
+=cut