File Coverage

blib/lib/Image/ExifTool/ICO.pm

Criterion	Covered	Total	%
statement	25	25	100.0
branch	5	10	50.0
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	34	40	85.0

#------------------------------------------------------------------------------
# File:         ICO.pm
#
# Description:  Read Windows ICO and CUR files
#
# Revisions:    2020-10-18 - P. Harvey Created
#
# References:   1) https://docs.fileformat.com/image/ico/
#------------------------------------------------------------------------------

package Image::ExifTool::ICO;

use strict;
use vars qw($VERSION);
use Image::ExifTool qw(:DataAccess :Utils);

$VERSION = '1.00';

%Image::ExifTool::ICO::Main = (
    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
    NOTES => 'Information extracted from Windows ICO (icon) and CUR (cursor) files.',
    2 => {
        Name => 'ImageType',
        Format => 'int16u',
        PrintConv => { 1 => 'Icon', 2 => 'Cursor' },
    },
    4 => {
        Name => 'ImageCount',
        Format => 'int16u',
        RawConv => '$$self{ImageCount} = $val',
    },
    6 => {
        Name => 'IconDir',
        SubDirectory => { TagTable => 'Image::ExifTool::ICO::IconDir' },
    },
);

%Image::ExifTool::ICO::IconDir = (
    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
    0 => {
        Name => 'ImageWidth',
        ValueConv => '$val or $val + 256',
    },
    1 => {
        Name => 'ImageHeight',
        ValueConv => '$val or $val + 256',
    },
    2 => 'NumColors',
    4 => [{
        Name => 'ColorPlanes',
        Condition => '$$self{FileType} eq "ICO"',
        Format => 'int16u',
        Notes => 'ICO files',
    },{
        Name => 'HotspotX',
        Format => 'int16u',
        Notes => 'CUR files',
    }],
    6 => [{
        Name => 'BitsPerPixel',
        Condition => '$$self{FileType} eq "ICO"',
        Format => 'int16u',
        Notes => 'ICO files',
    },{
        Name => 'HotspotY',
        Format => 'int16u',
        Notes => 'CUR files',
    }],
    8 => {
        Name => 'ImageLength',
        Format => 'int32u',
    },
);

#------------------------------------------------------------------------------
# Process ICO/CUR file
# Inputs: 0) ExifTool ref, 1) dirInfo ref
# Returns: 1 on success, 0 if this wasn't a valid ICO/CUR file
sub ProcessICO($$$)
{
    my ($et, $dirInfo) = @_;
    my $raf = $$dirInfo{RAF};
    my ($i, $buff);
    # verify this is a valid ICO/CUR file
    return 0 unless $raf->Read($buff, 6) == 6;
    return 0 unless $buff =~ /^\0\0([\x01\x02])\0[^0]\0/s;
    # (note: have seen cursor files in the wild with an 0x01 here,
    # but SetFileType will use the .cur extension to identify these)
    $et->SetFileType($1 eq "\x01" ? 'ICO' : 'CUR');
    SetByteOrder('II');
    my $tagTbl = GetTagTable('Image::ExifTool::ICO::Main');
    my $num = Get16u(\$buff, 4);
    $et->HandleTag($tagTbl, 4, $num);
    for ($i=0; $i<$num; ++$i) {
        $raf->Read($buff, 16) == 16 or $et->Warn('Truncated file'), last;
        $$et{DOC_NUM} = ++$$et{DOC_COUNT} if $i;
        $et->HandleTag($tagTbl, 6, $buff);
    }
    delete $$et{DOC_NUM};
    return 1;
}

1;  # end

__END__