File Coverage

blib/lib/Image/ExifTool/PCX.pm

Criterion	Covered	Total	%
statement	18	18	100.0
branch	1	2	50.0
condition	1	3	33.3
subroutine	4	4	100.0
pod	0	1	0.0
total	24	28	85.7

#------------------------------------------------------------------------------
# File:         PCX.pm
#
# Description:  Read metadata from PC Paintbrush files
#
# Revisions:    2018/12/12 - P. Harvey Created
#
# References:   1) http://qzx.com/pc-gpe/pcx.txt
#               2) https://www.fileformat.info/format/pcx/corion.htm
#------------------------------------------------------------------------------

package Image::ExifTool::PCX;

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

$VERSION = '1.00';

# PCX info
%Image::ExifTool::PCX::Main = (
    PROCESS_PROC => \&Image::ExifTool::ProcessBinaryData,
    GROUPS => { 0 => 'File', 1 => 'File', 2 => 'Image' },
    NOTES => 'Tags extracted from PC Paintbrush images.',
    DATAMEMBER => [ 0x04, 0x05 ],
    0x00 => {
        Name => 'Manufacturer',
        PrintConv => { 10 => 'ZSoft' },
    },
    0x01 => {
        Name => 'Software',
        PrintConv => {
            0 => 'PC Paintbrush 2.5',
            2 => 'PC Paintbrush 2.8 (with palette)',
            3 => 'PC Paintbrush 2.8 (without palette)',
            4 => 'PC Paintbrush for Windows',
            5 => 'PC Paintbrush 3.0+',
        },
    },
    0x02 => { Name => 'Encoding', PrintConv => { 1 => 'RLE' } },
    0x03 => 'BitsPerPixel',
    0x04 => {
        Name => 'LeftMargin',
        Format => 'int16u',
        RawConv => '$$self{LeftMargin} = $val',
    },
    0x06 => {
        Name => 'TopMargin',
        Format => 'int16u',
        RawConv => '$$self{TopMargin} = $val',
    },
    0x08 => {
        Name => 'ImageWidth',
        Format => 'int16u',
        Notes => 'adjusted for LeftMargin',
        ValueConv => '$val - $$self{LeftMargin} + 1',
    },
    0x0a => {
        Name => 'ImageHeight',
        Format => 'int16u',
        Notes => 'adjusted for TopMargin',
        ValueConv => '$val - $$self{TopMargin} + 1',
    },
    0x0c => 'XResolution',
    0x0e => 'YResolution',
    0x41 => 'ColorPlanes',
    0x42 => { Name => 'BytesPerLine', Format => 'int16u' },
    0x44 => {
        Name => 'ColorMode',
        PrintConv => {
            0 => 'n/a',
            1 => 'Color Palette',
            2 => 'Grayscale',
        },
    },
    0x46 => { Name => 'ScreenWidth',  Format => 'int16u', RawConv => '$val or undef' },
    0x48 => { Name => 'ScreenHeight', Format => 'int16u', RawConv => '$val or undef' },
);

#------------------------------------------------------------------------------
# Extract information from a PCX image
# Inputs: 0) ExifTool object reference, 1) dirInfo reference
# Returns: 1 on success, 0 if this wasn't a valid PCX file
sub ProcessPCX($$)
{
    my ($et, $dirInfo) = @_;
    my $raf = $$dirInfo{RAF};
    my $buff;
    return 0 unless $raf->Read($buff, 0x50) == 0x50 and
                    $buff =~ /^\x0a[\0-\x05]\x01[\x01\x02\x04\x08].{64}[\0-\x02]/s;
    SetByteOrder('II');
    $et->SetFileType();
    my %dirInfo = ( DirName => 'PCX', DataPt => \$buff );
    my $tagTablePtr = GetTagTable('Image::ExifTool::PCX::Main');
    return $et->ProcessBinaryData(\%dirInfo, $tagTablePtr);
}

1;  # end

__END__