Image-Pngslimmer
view release on metacpan or search on metacpan
Revision history for Perl extension Image::Pngslimmer.
(Times are UTC)
0.30 Sun Sep 07 13:15:00 2008
- various small optimizations
0.29 Sat Aug 30 12:33:00 2008
- code tidy, runs a bit faster now
0.28 Sun Aug 24 18:24:00 2008
- general code cleanup
- fixed minor breakages in 0.03
0.03 Fri Jan 26 15:30:00 2007
- added CRC checking
0.02 Sat Jan 20 19:52:00 2007
- corrected documentation etc
0.01 Fri Dec 22 21:08:01 2006
- original version; created by h2xs 1.23 with options
-XA -n Image::Pngslimmer
Changes
Makefile.PL
MANIFEST
README
t/Image-Pngslimmer.t
t/01-ispng.t
t/02-slimnoncrit.t
t/03-analyze.t
t/04-zlibcompress.t
t/05-filter.t
t/06-palettize.t
t/07-mediancut.t
t/08-dither.t
t/test1.gif
t/test1.png
t/test2.png
t/test3.png
t/test6.png
lib/Image/Pngslimmer.pm
META.yml Module meta-data (added by MakeMaker)
--- #YAML:1.0
name: Image-Pngslimmer
version: 0.30
abstract: slims (dynamically created) PNGs
license: perl
author:
- Adrian McMenamin <adrian@mcmen.demon.co.uk>
generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
Compress::Raw::Zlib: 2.003
Compress::Zlib: 2.003
Makefile.PL view on Meta::CPAN
use 5.008004;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'Image::Pngslimmer',
VERSION_FROM => 'lib/Image/Pngslimmer.pm', # finds $VERSION
PREREQ_PM => {POSIX => 1.08, Compress::Zlib => 2.003, Compress::Raw::Zlib => 2.003}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Image/Pngslimmer.pm', # retrieve abstract from module
AUTHOR => 'Adrian McMenamin <adrian@mcmen.demon.co.uk>',
LICENSE => 'perl') : ()),
);
Image::Pngslimmer version 0.30
=============================
OVERVIEW
Image::Pngslimmer reduces the size of PNGs by removing non-critcal chunks and
recompressing, filtering or palettizing images.
Other tools, such as pngcrush (http://pmt.sourceforge.net/pngcrush/)
will deliver better results for static PNGs and Image::Pnglimmer
was orginally designed for dynamically created PNGs.
use Image::Pngslimmer
Image::Pngslimmer::ispng($blob) - returns 1 if the BLOB conforms to the
structure for a PNG and that all CRCs are correct.
Image::Pngslimmer::discard_noncritical($blob) - returns a BLOB stripped of any
non-critcal chunks. If the passed-in BLOB does not conform to the basic
structure of a PNG the returned BLOB is identical to the passed-in BLOB.
The passed in BLOB is not altered by this function.
Image::Pngslimmer::analyze($blob) - after calling Image::Pngslimmer::ispng($blob)
this will iterate through the chunks in the supplied byte stream represented by
$blob and return an array of strings describing the chunks in the PNG. It can be
useful for testing the "before and after" effect of discard_noncritical($blob).
Image::Pngzlimmer::zlibshrink($blob) will attempt to improve compression of the
supplied BLOB.
Image::Pngslimmer::filter($blob) will attempt to apply adaptive filtering for
better compression of the supplied BLOB - filtering normally results in better
compression once zlibshrink() is reapplied if the original image is truecolour.
Image::Pngslimmer::indexcolours($blob) will attempt to losslessly convert the
supplied PNG to a colour indexed image - of the image contains more than 256
colours this will not work and the original PNG is returned instead.
Image::Pngslimmer::palettize($blob[, $colours[, $dither]]) will colour index
(with a PLTE chunk) a 24 bit RGB image. If the original image has 256
colours or less it will do this losslessly by calling indexcolours(), otherwise
it will generate a palette by using the median cut algorithm. The size of the
palette can be set by the optional $colours in the range 1 - 256 (the defult 0
gives 256 colours). If the optional $dither is set to 1, then the output image
will be dithered.
Dithering is now up to 75 (!) times faster than in previous versions though
still 3 - 5 times slower than simple quantization for most images.
NB: Alpha channels in the original image will be lost with with quantization
or indexation.
Image::Pngslimmer::reportcolours($blob) will print details of the colour
frequencies in the passed in PNG.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
lib/Image/Pngslimmer.pm view on Meta::CPAN
package Image::Pngslimmer;
use 5.008004;
use strict;
use warnings;
use Compress::Zlib;
use Compress::Raw::Zlib;
use POSIX();
require Exporter;
our @ISA = qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Image::Pngslimmer ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [qw()] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
lib/Image/Pngslimmer.pm view on Meta::CPAN
return $blobout;
}
sub analyze {
my ( $chunk_desc, $chunk_text, $chunk_length, $chunk_crc );
my ( $crit_status, $pub_status, @chunk_array, $searchindex, $pnglength );
my ( $chunk_crc_checked, $nextindex );
my $blob = shift;
#is it a PNG?
if ( Image::Pngslimmer::ispng($blob) < 1 ) {
#no it's not, so return a simple array stating so
push( @chunk_array, "Not a PNG file" );
return @chunk_array;
}
#ignore signature - it's not a chunk
#so straight to IHDR
$searchindex = 12;
$pnglength = length($blob);
lib/Image/Pngslimmer.pm view on Meta::CPAN
return @chunk_array;
}
1;
__END__
=pod
=head1 NAME
Image::Pngslimmer - slims (dynamically created) PNGs
=head1 SYNOPSIS
$ping = ispng($blob) #is this a PNG?
$ping == 1 if it is
$newblob = discard_noncritical($blob) #discard non critcal
chunks and return a new
PNG
my @chunklist = analyze($blob) #get the chunklist as
an array
lib/Image/Pngslimmer.pm view on Meta::CPAN
$newblob = palettize($blob[, $colourlimit
[, $dither]]) #replace RGB IDAT with
colour index palette
(usually lossy)
\%colourhash = reportcolours($blob) #return details of the
colours in the PNG
=head1 DESCRIPTION
Image::Pngslimmer aims to cut down the size of PNGs. Users pass a PNG to
various functions and a slimmer version is returned. Image::Pngslimmer
was designed for use where PNGs are being generated on the fly and where size
matters more than speed- eg for J2ME use or any similiar low speed or high
latency environment. There are other options - probably better ones - for
handling static PNGs, though you may still find the fuctions useful.
Filtering and recompressing an image is not fast - for example on a 4300
BogoMIPS box with 1G of memory the author processes PNGs at about 30KB per
second.
=head2 Functions
Call Image::Pngslimmer::discard_noncritical($blob) on a stream of bytes
(eg as created by Perl Magick's Image::Magick package) to remove sections of
the PNG that are not essential for display.
Do not expect this to result in a big saving - the author suggests maybe
200 bytes is typical - but in an environment such as the backend of J2ME
applications that may still be a worthwhile reduction.
Image::Pngslimmer::discard_noncritical($blob) will call ispng($blob) before
attempting to manipulate the supplied stream of bytes - hopefully, therefore,
avoiding the accidental mangling of JPEGs or other files. ispng checks for PNG
definition conformity - it looks for a correct signature, an image header
(IHDR) chunk in the right place, looks for (but does not check beyond the CRC)
an image data (IDAT) chunk and checks there is an end (IEND) chunk in the right
place. CRCs are also checked throughout.
Image::Pngslimmer::analyze($blob) is supplied for completeness and to aid
debugging. It is not called by discard_noncritical but may be used to show
'before-and-after' to demonstrate the savings delivered by discard_noncritical.
Image::Pngslimmer::zlibshrink($blob) will attempt to better compress the
supplied PNG and will achieve good results with poorly compressed PNGs.
Image::Pngsimmer::filter($blob) will attempt to apply adaptive filtering to the
PNG - filtering should deliver better compression results (though the results
can be mixed). Please note that filter() will compress the image with
Z_BEST_SPEED and so the blob returned from the function may even be larger
than the blob passed in. You must call zlibshrink if you want to recompress
the blob at maximum level. All PNG compression and filtering is lossless.
Image::Pngslimmer::indexcolours($blob) will attempt to replace an RGB image
with a colourmapped image. NB This is not the same as quantization - this
process is lossless, but also only works if there are less than 256 colours
in the image.
(indexcolours now supports PNGs with alpha channels but all alpha information
is lost in the indexed PNG.)
Image::Pngslimmer::palettize($blob[, $colourlimit[, $dither]]) will replace a
24 bit RGB image with a colourmapped (256 or less colours) image. If the
original image has less than $colourlimit colours it will do this by calling
indexcolours and so losslessly (except for any alpha channel)process the image.
More generally it will process the image using the lossy median cut algorithm.
Currently this only works for 24 bit images, though now also supports the alpha
channel (ie the alpha channel is accounted for in quantization - there is no
alpha in the quantized image). Again this process is relatively slow - the
author can process images at about 30 - 50KB per second - meaning it can be
used for J2ME in "real time" but is likely to be too slow for many other
dynamic uses. Setting $colourlimit between 1 and 255 allows control over the
size of the generated palette (the default is 0 which generates a 256 colour
palette). Setting $dither to 1 will turn on the much slower dithering. It is
not recommended for anything that requires quick image display.
$hashref = Image::Pngslimmer::reportcolours($blob) will return a reference to
a hash with a frequency table of the colours in the image.
=head1 LICENCE AND COPYRIGHT
This is free software and is licensed under the same terms as Perl itself
ie Artistic and GPL
It is copyright (c) Adrian McMenamin, 2006, 2007, 2008
=head1 REQUIREMENTS
POSIX
Compress::Zlib
Compress::Raw::Zlib
=head1 TODO
To make Pngslimmer really useful it needs to handle a broader range of bit map
depths etc. The work goes on and the range of PNG types supported is growing.
But at the moment it really only works well with 24 bit images (though
discard_noncritical will work with all PNGs).
=head1 AUTHOR
Adrian McMenamin <adrian AT mcmen DOT demon DOT co DOT uk>
=head1 SEE ALSO
t/01-ispng.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>2;
my ($giffile, $pngfile, $blob1, $blob2, $read);
sysopen($giffile, "./t/test1.gif", 0x0);
$read = (stat ($giffile))[7];
(sysread($giffile, $blob1, $read) == $read) or die "Could not open GIF\n";
is(Image::Pngslimmer::ispng($blob1), 0);
close ($giffile);
sysopen($pngfile, "./t/test1.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob2, $read) == $read) or die "Could not open PNG\n";
is(Image::Pngslimmer::ispng($blob2), 1);
close($pngfile);
t/02-slimnoncrit.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, $lengthfat, $lengthslim, $weightloss);
sysopen($pngfile, "./t/test1.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
$blob2 = Image::Pngslimmer::discard_noncritical($blob1);
$lengthfat = length($blob1);
$lengthslim = length($blob2);
$weightloss = $lengthfat - $lengthslim;
print "Fat file was $lengthfat bytes long, slimmed file was $lengthslim bytes, saving $weightloss bytes\n";
ok($weightloss > 0);
close($pngfile);
t/03-analyze.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, @analfat, @analslim, $weightloss, $fatel, $slimel);
sysopen($pngfile, "./t/test1.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
$blob2 = Image::Pngslimmer::discard_noncritical($blob1);
$fatel = Image::Pngslimmer::analyze($blob1);
$slimel = Image::Pngslimmer::analyze($blob2);
$weightloss = $fatel - $slimel;
print "Fat file had $fatel chunks, slimmed file has $slimel chunks, saving $weightloss chunks\n";
print "Fat file details:\n";
print Image::Pngslimmer::analyze($blob1);
print "\nSlimmed file details:\n";
print Image::Pngslimmer::analyze($blob2);
ok($weightloss > 0);
close($pngfile);
t/04-zlibcompress.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, $lengthfat, $lengthslim, $weightloss);
sysopen($pngfile, "./t/test1.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
$lengthfat = length($blob1);
$blob2 = Image::Pngslimmer::zlibshrink($blob1);
$lengthslim = length($blob2);
$weightloss = $lengthfat - $lengthslim;
print "Fat file was $lengthfat bytes long, zlibprocessed file was $lengthslim bytes, saving $weightloss bytes\n";
my $stillpng = Image::Pngslimmer::ispng($blob2);
print "Image::Pngslimmer::ispng returns $stillpng\n";
print "Zlib compressed file details:\n";
print Image::Pngslimmer::analyze($blob2);
print "\nUncompressed file details\n";
print Image::Pngslimmer::analyze($blob1);
ok($weightloss > 0);
close($pngfile);
t/05-filter.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, $lengthfat, $lengthslim, $weightloss);
sysopen($pngfile, "./t/test3.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
print "*********************************FILTERING********************\n";
print "Input file looks like this:\n";
print Image::Pngslimmer::analyze($blob1);
$blob2 = Image::Pngslimmer::filter($blob1);
$lengthfat = length($blob2);
print "After filtering and best speed compression file is $lengthfat bytes long.\n";
print "Uncompressed filtered file looks like this:\n";
print Image::Pngslimmer::analyze($blob2);
print "********************************COMPRESSING*****************\n";
my $blob3 = Image::Pngslimmer::zlibshrink($blob2);
$lengthfat = length($blob1);
$lengthslim = length($blob3);
print "Length of unfiltered file was $lengthfat, length of filtered and recrushed file was $lengthslim\n";
print "Compressed and filtered file looks like this:\n";
print Image::Pngslimmer::analyze($blob3);
#save the file
open(PNGTEST, ">./t/testout.png");
print PNGTEST $blob3;
close (PNGTEST);
ok($lengthslim < $lengthfat);
t/06-palettize.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, $lengthfat, $lengthslim, $weightloss);
print "INDEXING IMAGE\n";
sysopen($pngfile, "./t/test6.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
print "Input file looks like this:\n";
print Image::Pngslimmer::analyze($blob1);
$lengthfat = length($blob1);
print "Input file is $lengthfat bytes long\n";
print "Colour information is:\n";
Image::Pngslimmer::reportcolours($blob1);
$blob2 = Image::Pngslimmer::indexcolours($blob1);
$lengthslim = length($blob2);
print "After colour indexation the file is $lengthslim bytes long.\n";
open (PNGTEST, ">./t/testind.png");
print PNGTEST $blob2;
close (PNGTEST);
print "Output file looks like this:\n";
print Image::Pngslimmer::analyze($blob2);
ok($lengthfat > $lengthslim);
close($pngfile);
t/07-mediancut.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, $lengthfat, $lengthslim, $weightloss, $x);
print "****QUANTIZING IMAGE USING MEDIAN CUT****\n";
sysopen($pngfile, "./t/test2.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
print "Input file looks like this:\n";
print Image::Pngslimmer::analyze($blob1);
$lengthfat = length($blob1);
print "Input file is $lengthfat bytes long\n";
print "Colour information is: ";
my $colourinfo = Image::Pngslimmer::reportcolours($blob1);
my %colourinfo = %$colourinfo;
foreach $x (keys %colourinfo)
{
my $y = sprintf("%06x", $x);
print "Colour 0x$y appears $colourinfo{$x} times\n";
}
$blob2 = Image::Pngslimmer::palettize($blob1);
$lengthslim = length($blob2);
print "After colour indexation the file is $lengthslim bytes long.\n";
open (PNGTEST, ">./t/testpal.png");
print PNGTEST $blob2;
close (PNGTEST);
print "Output file looks like this:\n";
print Image::Pngslimmer::analyze($blob2);
ok($lengthfat > $lengthslim);
close($pngfile);
t/08-dither.t view on Meta::CPAN
use strict;
use Image::Pngslimmer();
use Test::More tests =>1;
my ($pngfile, $blob1, $blob2, $read, $lengthfat, $lengthslim, $weightloss);
print "****QUANTIZING IMAGE USING MEDIAN CUT AND THEN DITHERING****\n";
sysopen($pngfile, "./t/test2.png", 0x0);
$read = (stat ($pngfile))[7];
(sysread($pngfile, $blob1, $read) == $read) or die "Could not open PNG\n";
print "Input file looks like this:\n";
print Image::Pngslimmer::analyze($blob1);
$lengthfat = length($blob1);
print "Input file is $lengthfat bytes long\n";
$blob2 = Image::Pngslimmer::palettize($blob1, 0, 1);
$lengthslim = length($blob2);
print "After colour indexation the file is $lengthslim bytes long.\n";
open (PNGTEST, ">./t/testdither.png");
print PNGTEST $blob2;
close (PNGTEST);
print "Output file looks like this:\n";
print Image::Pngslimmer::analyze($blob2);
ok($lengthfat > $lengthslim);
close($pngfile);
t/Image-Pngslimmer.t view on Meta::CPAN
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Image-Pngslimmer.t'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 1;
BEGIN { use_ok('Image::Pngslimmer') };
#########################
# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.
( run in 0.978 second using v1.01-cache-2.11-cpan-0a6323c29d9 )