Chapter A
# -*- Perl -*-
# PNGObject.pm
# A Perl module that will decode the chunks of a PNG formatted file and
# dump a printout of the various fields.
#
package PNGObject;
use strict;
# This hash defines the ordering of fields within the critical chunks
#
my %png_fields = (
# Critical chunks
#
header =>
[qw( width height bit_depth color_type
compression filter interlace )],
palette =>
[qw( red green blue )],
image_data =>
[qw( data )]
);
# This will create a string which can be used for
# valid signature comparisons
#
my $png_signature = pack "H16", "89504E470D0A1A0A";
# A list of the standard ancillary chunks for use in a later
# regular exression.
#
my $ancillary_chunks =
join "|",
qw( bKGD cHRM gAMA hIST pHYs sBIT tEXT
tIME tRNS oFFs sCAL tIME );
# This hash may be referenced to determine the length of
# each field (in bytes) for a particular chunk.
#
my %png_format = (
# Every chunk has an 8 byte header and a 4 byte trailer
#
all => {
'length' => 4,
type => 4,
# Chunk-specific data goes here
#
crc => 4
},
header => {
width => 4,
height => 4,
bit_depth => 1,
color_type => 1,
compression => 1,
filter => 1,
interlace => 1,
},
palette => {
red => 1,
green => 1,
blue => 1,
},
image_data => {
data => undef,
},
image_trailer => {
type => 4,
}
)
# Three variables for storing the decoded values
#
my $header;
my @image;
my @palette;
# The new method is the constructor for the PNGObject.
# It creates an anonymour array which may be used to store the
# decoded chunk data.
#
sub new {
my $class = shift;
my $self = [];
bless ($self, $class);
return $self;
}
sub readPNG {
my $self = shift;
my $filename = shift;
my ($nextlength, $nexttype) = (0, '');
my ($crc, $imagedata);
open PNG, $filename || return 1000; # Error 1000 = couldn't open file
binmode(PNG);
# Read and check signature
#
my $signature;
sysread(PNG, $signature, 8);
unless ($signature eq $png_signature) {
return 2000; # Error 2000 = not a valid PNG file
}
# The sysread() function returns the number of bytes read.
#
while (sysread(PNG, $nextlength, $png_format{'all'}->{'length'})) {
# The length field is more than one byte so we must worry about the
# byte ordering. PNG is saved in big-endian order so we
# can use Perl's unpack function with the 'N' option (N for
# 'network' or big-endian order) to convert it into a long integer.
#
$nextlength =unpack "N", $nextlength;
unless (sysread(PNG, $nexttype, $png_format{'all'}->{'type'})) {
print "Premature end-of-file!\n";
return 3000; # Error 3000 = premature end of file
}
# Now check to see what the type of the next field is
#
if ($nexttype eq 'IHDR') {
# A Header chunk
#
print "Found a Header Chunk!\n";
$header = $self->readChunk(*PNG, 'header');
# The data in CRC can be used to determine whether the
# data in $header has been corrpted
#
sysread(PNG, $crc, $png_format{'all'}->{'crc'});
} elsif ($nexttype eq 'PLTE') {
# A Palette chunk
#
print "Found a palette!\n";
my $size = $nextlength/3;
print "Color table with $size entries:\n";
for (my $index=0; $index < $size; $index++) {
print "Index $index:\n";
push @palette,
$self->readChunk(*PNG, 'palette');
print " \n";
}
sysread(PNG, $crc, $png_format{'all'}->{'crc'});
} elsif ($nexttype eq 'IDAT') {
# An Image Data chunk
#
print "Found an image data chunk!\n";
print "Read ".sysread(PNG, $imagedata, $nextlength)." bytes.\n";
# The @image list of image data must still be decoded
#
push @image, $imagedata;
sysread(PNG, $crc, $png_format{'all'}->{'crc'});
} elsif ($nexttype eq 'IEND') {
# An Image Trailer chunk
#
print "Found the image trailer chunk!\n";
return 1;
} elsif ($nexttype =~ /$ancillary_chunks/) {
# One of the standard ancillary chunks.
# A more robust decoder should recognize all of these.
#
print "Skipping an ancillary chunk of type $nexttype.\n";
print " This chunk is a standard part of the PNG 1.0 spec,\n";
print " but is not supported by this decoder. Sorry.\n";
skipChunk(*PNG, $nextlength);
} else {
# An unrecognized chunk. It should be skipped.
#
print "Skipping a chunk of type $nexttype.\n";
print " This chunk is not recognized as a standard part of the\n";
print " PNG 1.0 spec, but it could be a private or\n";
print " special purpose public chunk.\n";
skipChunk(*PNG, $nextlength);
}
}
print "Premature end of file (no IEND chunk encountered)...\n";
return 3000; # Error 3000 = premature end of file
}
sub skipChunk {
my ($fh, $bytes) = @_;
my $skip;
# Skip the chunk, throwing the data away.
# The number of bytes to skip is +4 because of CRC bytes
#
for (my $count=0; $count < $bytes + 4; $count++) {
sysread($fh, $skip, 1);
}
}
sub readChunk {
# A convenience routine to read in generic chunk data.
# Note that 'chunk data' does not include the chunk header or
# the crc trailer. This method returns a hash containing
# the data. It also prints each field as it is read as an
# appropriate sized integer for easy reading.
#
my $self = shift;
my $fh = shift; # the filehandle
my $chunkname = shift; # a string that is the key to the png_format hash
my @fields = @{$png_fields{$chunkname}};
my %returnhash = ();
foreach my $field (@fields) {
sysread($fh,
$returnhash{$field},
$png_format{$chunkname}->{$field});
print "$field: ";
# If the field is more four bytes long, we must unpack
# it as a 'network' (big-endian) long integer.
# If it is a two byte field, it must be unpacked as a
# 'network' short integer.
# Otherwise it is only a single byte and we can make it an
# integer with ord.
#
if ($png_format{$chunkname}->{$field} == 4) {
print unpack("N", $returnhash{$field});
}elsif ($png_format{$chunkname}->{$field} == 2) {
print unpack("n", $returnhash{$field});
} else {
print ord($returnhash{$field});
}
print "\n";
}
return { %returnhash };
}
1; # All Perl modules should return true
DRAFT, August 21, 1998
DRAFT, August 21, 1998
�
�