format files and allows white space padding between files.
Thanks to Philip Gwyn (Leolo) for this patch.
+ - moved the PNG file handling code into a sub-module in preparation
+ for separate distribution.
+ https://rt.cpan.org/Ticket/Display.html?id=49616 (partial)
+ Also helps avoid complications from -I/-L compile/link options from
+ other libraries.
+
Bugs:
- Imager->new(data => $data) didn't try to process image file data in
i_writetiff_wiol
i_writetiff_wiol_faxable
- i_readpng_wiol
- i_writepng_wiol
-
i_readgif
i_readgif_wiol
i_readgif_callback
}
}
+my %formats_low;
+my %format_classes =
+ (
+ png => "Imager::File::PNG",
+ gif => "Imager::File::GIF",
+ tiff => "Imager::File::TIFF",
+ jpeg => "Imager::File::JPEG",
+ );
+
+tie %formats, "Imager::FORMATS", \%formats_low, \%format_classes;
+
BEGIN {
Imager::Font::__init();
- for(i_list_formats()) { $formats{$_}++; }
+ for(i_list_formats()) { $formats_low{$_}++; }
- if (!$formats{'t1'} and !$formats{'tt'}
- && !$formats{'ft2'} && !$formats{'w32'}) {
+ if (!$formats_low{'t1'} and !$formats_low{'tt'}
+ && !$formats_low{'ft2'} && !$formats_low{'w32'}) {
$fontstate='no font support';
}
-
%OPCODES=(Add=>[0],Sub=>[1],Mult=>[2],Div=>[3],Parm=>[4],'sin'=>[5],'cos'=>[6],'x'=>[4,0],'y'=>[4,1]);
$DEBUG=0;
return $readers{$input{type}}{single}->($self, $IO, %input);
}
- unless ($formats{$input{'type'}}) {
+ unless ($formats_low{$input{'type'}}) {
my $read_types = join ', ', sort Imager->read_types();
$self->_set_error("format '$input{'type'}' not supported - formats $read_types available for reading");
return;
return $self;
}
- if ( $input{'type'} eq 'png' ) {
- $self->{IMG}=i_readpng_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
- if ( !defined($self->{IMG}) ) {
- $self->{ERRSTR} = $self->_error_as_msg();
- return undef;
- }
- $self->{DEBUG} && print "loading a png file\n";
- }
-
if ( $input{'type'} eq 'bmp' ) {
$self->{IMG}=i_readbmp_wiol( $IO, $allow_incomplete );
if ( !defined($self->{IMG}) ) {
sub _reader_autoload {
my $type = shift;
- return if $formats{$type} || $readers{$type};
+ return if $formats_low{$type} || $readers{$type};
return unless $type =~ /^\w+$/;
sub _writer_autoload {
my $type = shift;
- return if $formats{$type} || $readers{$type};
+ return if $formats_low{$type} || $readers{$type};
return unless $type =~ /^\w+$/;
or return undef;
}
else {
- if (!$formats{$input{'type'}}) {
+ if (!$formats_low{$input{'type'}}) {
my $write_types = join ', ', sort Imager->write_types();
$self->_set_error("format '$input{'type'}' not supported - formats $write_types available for writing");
return undef;
# threads shouldn't try to close raw Imager objects
sub Imager::ImgRaw::CLONE_SKIP { 1 }
+# backward compatibility for %formats
+package Imager::FORMATS;
+use strict;
+use constant IX_FORMATS => 0;
+use constant IX_LIST => 1;
+use constant IX_INDEX => 2;
+use constant IX_CLASSES => 3;
+
+sub TIEHASH {
+ my ($class, $formats, $classes) = @_;
+
+ return bless [ $formats, [ ], 0, $classes ], $class;
+}
+
+sub _check {
+ my ($self, $key) = @_;
+
+ (my $file = $self->[IX_CLASSES]{$key} . ".pm") =~ s(::)(/)g;
+ my $value;
+ if (eval { require $file; 1 }) {
+ $value = 1;
+ }
+ else {
+ $value = undef;
+ }
+ $self->[IX_FORMATS]{$key} = $value;
+
+ return $value;
+}
+
+sub FETCH {
+ my ($self, $key) = @_;
+
+ exists $self->[IX_FORMATS]{$key} and return $self->[IX_FORMATS]{$key};
+
+ $self->[IX_CLASSES]{$key} or return undef;
+
+ return $self->_check($key);
+}
+
+sub STORE {
+ die "%Imager::formats is not user monifiable";
+}
+
+sub DELETE {
+ die "%Imager::formats is not user monifiable";
+}
+
+sub CLEAR {
+ die "%Imager::formats is not user monifiable";
+}
+
+sub EXISTS {
+ my ($self, $key) = @_;
+
+ if (exists $self->[IX_FORMATS]{$key}) {
+ my $value = $self->[IX_FORMATS]{$key}
+ or return;
+ return 1;
+ }
+
+ $self->_check($key) or return 1==0;
+
+ return 1==1;
+}
+
+sub FIRSTKEY {
+ my ($self) = @_;
+
+ unless (@{$self->[IX_LIST]}) {
+ # full populate it
+ @{$self->[IX_LIST]} = keys %{$self->[IX_FORMATS]};
+
+ for my $key (keys %{$self->[IX_CLASSES]}) {
+ $self->[IX_FORMATS]{$key} and next;
+ $self->_check($key)
+ and push @{$self->[IX_LIST]}, $key;
+ }
+ }
+
+ @{$self->[IX_LIST]} or return;
+ $self->[IX_INDEX] = 1;
+ return $self->[IX_LIST][0];
+}
+
+sub NEXTKEY {
+ my ($self) = @_;
+
+ $self->[IX_INDEX] < @{$self->[IX_LIST]}
+ or return;
+
+ return $self->[IX_LIST][$self->[IX_INDEX]++];
+}
+
+sub SCALAR {
+ my ($self) = @_;
+
+ return scalar @{$self->[IX_LIST]};
+}
+
1;
__END__
# Below is the stub of documentation for your module. You better edit it!
#ifdef HAVE_LIBPNG
-Imager::ImgRaw
-i_readpng_wiol(ig, length)
- Imager::IO ig
- int length
-
-
-undef_int
-i_writepng_wiol(im, ig)
- Imager::ImgRaw im
- Imager::IO ig
-
-
#endif
Mandelbrot/t/t00mandel.t
Makefile.PL
README
+PNG/Makefile.PL
+PNG/PNG.pm
+PNG/PNG.xs
+PNG/impng.c
+PNG/impng.h
+PNG/t/00load.t
+PNG/t/10png.t Test png support
+PNG/testimg/palette.png
+PNG/testimg/palette_out.png
SGI/Makefile.PL
SGI/SGI.pm
SGI/SGI.xs
lib/Imager/LargeSamples.pod Track large sample support
lib/Imager/Matrix2d.pm
lib/Imager/Preprocess.pm
+lib/Imager/Probe.pm Library probes
lib/Imager/Regops.pm
lib/Imager/Test.pm
lib/Imager/Transform.pm
palimg.c
paste.im
plug.h
-png.c
pnm.c
polygon.c
ppport.h
t/t101jpeg.t Test jpeg support
t/t101nojpeg.t Test handling when jpeg not available
t/t102nopng.t Test handling when png not available
-t/t102png.t Test png support
t/t103raw.t
t/t104ppm.t
t/t105gif.t Test gif support
testimg/multiple.ppm Test multiple PPM reading
testimg/newgimpgrad.ggr Test GIMP Gradient file (newer type)
testimg/nocmap.gif
-testimg/palette.png
-testimg/palette_out.png
testimg/penguin-base.ppm
testimg/pengtile.tif Tiled tiff image, same as penguin-base.ppm
testimg/pgm.pgm Simple pgm for testing the right sample is in the right place
use lib 'inc';
use Devel::CheckLib;
+# EU::MM runs Makefile.PL all in the same process, so sub-modules will
+# see this
+our $BUILDING_IMAGER = 1;
+
#
# IM_INCPATH colon seperated list of paths to extra include paths
# IM_LIBPATH colon seperated list of paths to extra library paths
'coverage' => \$coverage,
"assert|a" => \$assert);
+setenv();
+
if ($ENV{AUTOMATED_TESTING}) {
$assert = 1;
}
postcheck => \&postcheck_tiff,
};
- $formats{'png'}={
- order=>'22',
- def=>'HAVE_LIBPNG',
- inccheck=>sub { -e catfile($_[0], 'png.h') },
- libcheck=>sub { $_[0] eq "libpng$aext" or $_[0] eq "libpng.$lext" },
- libfiles=>$^O eq 'MSWin32' ? '-lpng -lzlib' : '-lpng -lz',
- objfiles=>'png.o',
- docs=>q{
- Png stands for Portable Network Graphics and is intended as
- a replacement for gif on the web. It is patent free and
- is recommended by the w3c, you need libpng to use these formats},
- code => \&png_probe,
- };
+# $formats{'png'}={
+# order=>'22',
+# def=>'HAVE_LIBPNG',
+# inccheck=>sub { -e catfile($_[0], 'png.h') },
+# libcheck=>sub { $_[0] eq "libpng$aext" or $_[0] eq "libpng.$lext" },
+# libfiles=>$^O eq 'MSWin32' ? '-lpng -lzlib' : '-lpng -lz',
+# objfiles=>'png.o',
+# docs=>q{
+# Png stands for Portable Network Graphics and is intended as
+# a replacement for gif on the web. It is patent free and
+# is recommended by the w3c, you need libpng to use these formats},
+# code => \&png_probe,
+# };
$formats{'gif'}={
order=>'20',
}
+# populate the environment so that sub-modules get the same info
+sub setenv {
+ $ENV{IM_VERBOSE} = 1 if $VERBOSE;
+ $ENV{IM_INCPATH} = join $Config{path_sep}, @incpaths if @incpaths;
+ $ENV{IM_LIBPATH} = join $Config{path_sep}, @libpaths if @libpaths;
+}
+
sub make_imconfig {
my ($defines) = @_;
--- /dev/null
+#!perl -w
+use strict;
+use ExtUtils::MakeMaker qw(WriteMakefile WriteEmptyMakefile);
+use Getopt::Long;
+
+my $verbose = $ENV{IM_VERBOSE};
+my @libpaths;
+my @incpaths;
+
+GetOptions("incpath=s", \@incpaths,
+ "libpath=s" => \@libpaths,
+ "verbose|v" => \$verbose);
+
+our $BUILDING_IMAGER;
+
+my $MM_ver = eval $ExtUtils::MakeMaker::VERSION;
+
+my %opts =
+ (
+ NAME => 'Imager::File::PNG',
+ VERSION_FROM => 'PNG.pm',
+ OBJECT => 'PNG.o impng.o',
+ );
+
+my @inc;
+if ($BUILDING_IMAGER) {
+ push @inc, "-I..";
+ push @INC, "../lib";
+}
+else {
+ print "PNG: building independently\n";
+ require Imager::ExtUtils;
+ push @inc, Imager::ExtUtils->includes;
+ $opts{TYPEMAPS} = [ Imager::ExtUtils->typemap ];
+
+ # Imager required configure through use
+ my @Imager_req = ( Imager => "0.76" );
+ if ($MM_ver >= 6.46) {
+ $opts{META_MERGE} =
+ {
+ configure_requires =>
+ {
+ @Imager_req,
+ },
+ build_requires =>
+ {
+ @Imager_req,
+ "Test::More" => "0.47",
+ }
+ };
+ $opts{PREREQ_PM} =
+ {
+ @Imager_req,
+ };
+ }
+}
+
+require Imager::Probe;
+
+my %probe =
+ (
+ name => "PNG",
+ pkg => [ qw/libpng14 libpng12 libpng10 libpng/ ],
+ inccheck => sub { -e File::Spec->catfile($_[0], "png.h") },
+ libbase => "png",
+ testcode => _png_test_code(),
+ testcodeheaders => [ "png.h", "stdio.h" ],
+ );
+
+my $probe_res = Imager::Probe->probe(\%probe);
+if ($probe_res) {
+ push @inc, $probe_res->{INC};
+ $opts{LIBS} = $probe_res->{LIBS};
+
+ $opts{INC} = "@inc";
+
+ if ($MM_ver > 6.06) {
+ $opts{AUTHOR} = 'Tony Cook <tony@imager.perl.org>';
+ $opts{ABSTRACT} = 'PNG Image file support';
+ }
+
+ WriteMakefile(%opts);
+}
+else {
+ if ($BUILDING_IMAGER) {
+ WriteEmptyMakefile(%opts);
+ }
+ else {
+ # fail in good way
+ die "OS unsupported: PNG libraries or headers not found\n";
+ }
+}
+
+sub _png_test_code {
+ return <<'CODE';
+
+fprintf(stderr, "PNG: library version %ld, header version %ld\n", (long)png_access_version_number(), (long)PNG_LIBPNG_VER);
+return 0;
+CODE
+}
--- /dev/null
+package Imager::File::PNG;
+use strict;
+use Imager;
+use vars qw($VERSION @ISA);
+
+BEGIN {
+ $VERSION = "0.76";
+
+ eval {
+ require XSLoader;
+ XSLoader::load('Imager::File::PNG', $VERSION);
+ 1;
+ } or do {
+ require DynaLoader;
+ push @ISA, 'DynaLoader';
+ bootstrap Imager::File::PNG $VERSION;
+ };
+}
+
+Imager->register_reader
+ (
+ type=>'png',
+ single =>
+ sub {
+ my ($im, $io, %hsh) = @_;
+ $im->{IMG} = i_readpng_wiol($io);
+
+ unless ($im->{IMG}) {
+ $im->_set_error(Imager->_error_as_msg);
+ return;
+ }
+ return $im;
+ },
+ );
+
+Imager->register_writer
+ (
+ type=>'png',
+ single =>
+ sub {
+ my ($im, $io, %hsh) = @_;
+
+ $im->_set_opts(\%hsh, "i_", $im);
+ $im->_set_opts(\%hsh, "png_", $im);
+
+ unless (i_writepng_wiol($im->{IMG}, $io)) {
+ $im->_set_error(Imager->_error_as_msg);
+ return;
+ }
+ return $im;
+ },
+ );
+
+__END__
+
+=head1 NAME
+
+Imager::File::PNG - read and write PNG files
+
+=head1 SYNOPSIS
+
+ use Imager;
+
+ my $img = Imager->new;
+ $img->read(file=>"foo.png")
+ or die $img->errstr;
+
+ $img->write(file => "foo.png")
+ or die $img->errstr;
+
+=head1 DESCRIPTION
+
+Imager's PNG support is documented in L<Imager::Files>.
+
+=head1 AUTHOR
+
+Tony Cook <tony@imager.perl.org>
+
+=head1 SEE ALSO
+
+Imager, Imager::Files.
+
+=cut
--- /dev/null
+#define PERL_NO_GET_CONTEXT
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "imext.h"
+#include "imperl.h"
+#include "impng.h"
+
+DEFINE_IMAGER_CALLBACKS;
+
+MODULE = Imager::File::PNG PACKAGE = Imager::File::PNG
+
+Imager::ImgRaw
+i_readpng_wiol(ig)
+ Imager::IO ig
+
+undef_int
+i_writepng_wiol(im, ig)
+ Imager::ImgRaw im
+ Imager::IO ig
+
+BOOT:
+ PERL_INITIALIZE_IMAGER_CALLBACKS;
--- /dev/null
+#include "impng.h"
+#include "png.h"
+
+/* Check to see if a file is a PNG file using png_sig_cmp(). png_sig_cmp()
+ * returns zero if the image is a PNG and nonzero if it isn't a PNG.
+ *
+ * The function check_if_png() shown here, but not used, returns nonzero (true)
+ * if the file can be opened and is a PNG, 0 (false) otherwise.
+ *
+ * If this call is successful, and you are going to keep the file open,
+ * you should call png_set_sig_bytes(png_ptr, PNG_BYTES_TO_CHECK); once
+ * you have created the png_ptr, so that libpng knows your application
+ * has read that many bytes from the start of the file. Make sure you
+ * don't call png_set_sig_bytes() with more than 8 bytes read or give it
+ * an incorrect number of bytes read, or you will either have read too
+ * many bytes (your fault), or you are telling libpng to read the wrong
+ * number of magic bytes (also your fault).
+ *
+ * Many applications already read the first 2 or 4 bytes from the start
+ * of the image to determine the file type, so it would be easiest just
+ * to pass the bytes to png_sig_cmp() or even skip that if you know
+ * you have a PNG file, and call png_set_sig_bytes().
+ */
+
+/* this is a way to get number of channels from color space
+ * Color code to channel number */
+
+static int CC2C[PNG_COLOR_MASK_PALETTE|PNG_COLOR_MASK_COLOR|PNG_COLOR_MASK_ALPHA];
+
+#define PNG_BYTES_TO_CHECK 4
+
+
+
+static void
+wiol_read_data(png_structp png_ptr, png_bytep data, png_size_t length) {
+ io_glue *ig = (io_glue *)png_ptr->io_ptr;
+ int rc = ig->readcb(ig, data, length);
+ if (rc != length) png_error(png_ptr, "Read overflow error on an iolayer source.");
+}
+
+static void
+wiol_write_data(png_structp png_ptr, png_bytep data, png_size_t length) {
+ int rc;
+ io_glue *ig = (io_glue *)png_ptr->io_ptr;
+ rc = ig->writecb(ig, data, length);
+ if (rc != length) png_error(png_ptr, "Write error on an iolayer source.");
+}
+
+static void
+wiol_flush_data(png_structp png_ptr) {
+ /* XXX : This needs to be added to the io layer */
+}
+
+
+/* Check function demo
+
+int
+check_if_png(char *file_name, FILE **fp) {
+ char buf[PNG_BYTES_TO_CHECK];
+ if ((*fp = fopen(file_name, "rb")) != NULL) return 0;
+ if (fread(buf, 1, PNG_BYTES_TO_CHECK, *fp) != PNG_BYTES_TO_CHECK) return 0;
+ return(!png_sig_cmp((png_bytep)buf, (png_size_t)0, PNG_BYTES_TO_CHECK));
+}
+*/
+
+undef_int
+i_writepng_wiol(i_img *im, io_glue *ig) {
+ png_structp png_ptr;
+ png_infop info_ptr = NULL;
+ int width,height,y;
+ volatile int cspace,channels;
+ double xres, yres;
+ int aspect_only, have_res;
+
+ mm_log((1,"i_writepng(im %p ,ig %p)\n", im, ig));
+
+ height = im->ysize;
+ width = im->xsize;
+
+ channels=im->channels;
+
+ if (channels > 2) { cspace = PNG_COLOR_TYPE_RGB; channels-=3; }
+ else { cspace=PNG_COLOR_TYPE_GRAY; channels--; }
+
+ if (channels) cspace|=PNG_COLOR_MASK_ALPHA;
+ mm_log((1,"cspace=%d\n",cspace));
+
+ channels = im->channels;
+
+ /* Create and initialize the png_struct with the desired error handler
+ * functions. If you want to use the default stderr and longjump method,
+ * you can supply NULL for the last three parameters. We also check that
+ * the library version is compatible with the one used at compile time,
+ * in case we are using dynamically linked libraries. REQUIRED.
+ */
+
+ png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING,NULL,NULL,NULL);
+
+ if (png_ptr == NULL) return 0;
+
+
+ /* Allocate/initialize the image information data. REQUIRED */
+ info_ptr = png_create_info_struct(png_ptr);
+
+ if (info_ptr == NULL) {
+ png_destroy_write_struct(&png_ptr, &info_ptr);
+ return 0;
+ }
+
+ /* Set error handling. REQUIRED if you aren't supplying your own
+ * error hadnling functions in the png_create_write_struct() call.
+ */
+ if (setjmp(png_ptr->jmpbuf)) {
+ png_destroy_write_struct(&png_ptr, &info_ptr);
+ return(0);
+ }
+
+ png_set_write_fn(png_ptr, (png_voidp) (ig), wiol_write_data, wiol_flush_data);
+ png_ptr->io_ptr = (png_voidp) ig;
+
+ /* Set the image information here. Width and height are up to 2^31,
+ * bit_depth is one of 1, 2, 4, 8, or 16, but valid values also depend on
+ * the color_type selected. color_type is one of PNG_COLOR_TYPE_GRAY,
+ * PNG_COLOR_TYPE_GRAY_ALPHA, PNG_COLOR_TYPE_PALETTE, PNG_COLOR_TYPE_RGB,
+ * or PNG_COLOR_TYPE_RGB_ALPHA. interlace is either PNG_INTERLACE_NONE or
+ * PNG_INTERLACE_ADAM7, and the compression_type and filter_type MUST
+ * currently be PNG_COMPRESSION_TYPE_BASE and PNG_FILTER_TYPE_BASE. REQUIRED
+ */
+
+ png_set_IHDR(png_ptr, info_ptr, width, height, 8, cspace,
+ PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE, PNG_FILTER_TYPE_BASE);
+
+ have_res = 1;
+ if (i_tags_get_float(&im->tags, "i_xres", 0, &xres)) {
+ if (i_tags_get_float(&im->tags, "i_yres", 0, &yres))
+ ; /* nothing to do */
+ else
+ yres = xres;
+ }
+ else {
+ if (i_tags_get_float(&im->tags, "i_yres", 0, &yres))
+ xres = yres;
+ else
+ have_res = 0;
+ }
+ if (have_res) {
+ aspect_only = 0;
+ i_tags_get_int(&im->tags, "i_aspect_only", 0, &aspect_only);
+ xres /= 0.0254;
+ yres /= 0.0254;
+ png_set_pHYs(png_ptr, info_ptr, xres + 0.5, yres + 0.5,
+ aspect_only ? PNG_RESOLUTION_UNKNOWN : PNG_RESOLUTION_METER);
+ }
+
+ png_write_info(png_ptr, info_ptr);
+
+ if (!im->virtual && im->type == i_direct_type && im->bits == i_8_bits) {
+ for (y = 0; y < height; y++)
+ png_write_row(png_ptr, (png_bytep) &(im->idata[channels*width*y]));
+ }
+ else {
+ unsigned char *data = mymalloc(im->xsize * im->channels);
+ for (y = 0; y < height; y++) {
+ i_gsamp(im, 0, im->xsize, y, data, NULL, im->channels);
+ png_write_row(png_ptr, (png_bytep)data);
+ }
+ myfree(data);
+ }
+
+ png_write_end(png_ptr, info_ptr);
+
+ png_destroy_write_struct(&png_ptr, &info_ptr);
+
+ ig->closecb(ig);
+
+ return(1);
+}
+
+
+
+static void get_png_tags(i_img *im, png_structp png_ptr, png_infop info_ptr);
+
+i_img*
+i_readpng_wiol(io_glue *ig) {
+ i_img *im = NULL;
+ png_structp png_ptr;
+ png_infop info_ptr;
+ png_uint_32 width, height;
+ int bit_depth, color_type, interlace_type;
+ int number_passes,y;
+ int channels,pass;
+ unsigned int sig_read;
+
+ sig_read = 0;
+
+ mm_log((1,"i_readpng_wiol(ig %p)\n", ig));
+
+ png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING,NULL,NULL,NULL);
+ png_set_read_fn(png_ptr, (png_voidp) (ig), wiol_read_data);
+
+ info_ptr = png_create_info_struct(png_ptr);
+ if (info_ptr == NULL) {
+ png_destroy_read_struct(&png_ptr, (png_infopp)NULL, (png_infopp)NULL);
+ return NULL;
+ }
+
+ if (setjmp(png_ptr->jmpbuf)) {
+ if (im) i_img_destroy(im);
+ mm_log((1,"i_readpng_wiol: error.\n"));
+ png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
+ return NULL;
+ }
+
+ png_ptr->io_ptr = (png_voidp) ig;
+ png_set_sig_bytes(png_ptr, sig_read);
+ png_read_info(png_ptr, info_ptr);
+ png_get_IHDR(png_ptr, info_ptr, &width, &height, &bit_depth, &color_type, &interlace_type, NULL, NULL);
+
+ mm_log((1,
+ "png_get_IHDR results: width %d, height %d, bit_depth %d, color_type %d, interlace_type %d\n",
+ width,height,bit_depth,color_type,interlace_type));
+
+ CC2C[PNG_COLOR_TYPE_GRAY]=1;
+ CC2C[PNG_COLOR_TYPE_PALETTE]=3;
+ CC2C[PNG_COLOR_TYPE_RGB]=3;
+ CC2C[PNG_COLOR_TYPE_RGB_ALPHA]=4;
+ CC2C[PNG_COLOR_TYPE_GRAY_ALPHA]=2;
+ channels = CC2C[color_type];
+
+ mm_log((1,"i_readpng_wiol: channels %d\n",channels));
+
+ if (!i_int_check_image_file_limits(width, height, channels, sizeof(i_sample_t))) {
+ mm_log((1, "i_readpnm: image size exceeds limits\n"));
+ png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
+ return NULL;
+ }
+
+ png_set_strip_16(png_ptr);
+ png_set_packing(png_ptr);
+ if (color_type == PNG_COLOR_TYPE_PALETTE) png_set_expand(png_ptr);
+ if (color_type == PNG_COLOR_TYPE_GRAY && bit_depth < 8) png_set_expand(png_ptr);
+
+ if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS)) {
+ channels++;
+ mm_log((1, "image has transparency, adding alpha: channels = %d\n", channels));
+ png_set_expand(png_ptr);
+ }
+
+ number_passes = png_set_interlace_handling(png_ptr);
+ mm_log((1,"number of passes=%d\n",number_passes));
+ png_read_update_info(png_ptr, info_ptr);
+
+ im = i_img_8_new(width,height,channels);
+ if (!im) {
+ png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
+ return NULL;
+ }
+
+ for (pass = 0; pass < number_passes; pass++)
+ for (y = 0; y < height; y++) { png_read_row(png_ptr,(png_bytep) &(im->idata[channels*width*y]), NULL); }
+
+ png_read_end(png_ptr, info_ptr);
+
+ get_png_tags(im, png_ptr, info_ptr);
+
+ png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
+
+ mm_log((1,"(0x%08X) <- i_readpng_scalar\n", im));
+
+ return im;
+}
+
+static void get_png_tags(i_img *im, png_structp png_ptr, png_infop info_ptr) {
+ png_uint_32 xres, yres;
+ int unit_type;
+
+ i_tags_set(&im->tags, "i_format", "png", -1);
+ if (png_get_pHYs(png_ptr, info_ptr, &xres, &yres, &unit_type)) {
+ mm_log((1,"pHYs (%d, %d) %d\n", xres, yres, unit_type));
+ if (unit_type == PNG_RESOLUTION_METER) {
+ i_tags_set_float2(&im->tags, "i_xres", 0, xres * 0.0254, 5);
+ i_tags_set_float2(&im->tags, "i_yres", 0, yres * 0.0254, 5);
+ }
+ else {
+ i_tags_setn(&im->tags, "i_xres", xres);
+ i_tags_setn(&im->tags, "i_yres", yres);
+ i_tags_setn(&im->tags, "i_aspect_only", 1);
+ }
+ }
+}
--- /dev/null
+#ifndef IMAGER_IMPNG_H
+#define IMAGER_IMPNG_H
+
+#include "imext.h"
+
+i_img *i_readpng_wiol(io_glue *ig);
+undef_int i_writepng_wiol(i_img *im, io_glue *ig);
+
+#endif
--- /dev/null
+#!perl -w
+use strict;
+use Test::More tests => 1;
+
+use_ok("Imager::File::PNG");
--- /dev/null
+#!perl -w
+use strict;
+use Imager qw(:all);
+use Test::More;
+use Imager::Test qw(test_image_raw);
+
+-d "testout" or mkdir "testout";
+
+init_log("testout/t102png.log",1);
+
+$Imager::formats{"png"}
+ or plan skip_all => "No png support";
+
+plan tests => 33;
+
+my $green = i_color_new(0, 255, 0, 255);
+my $blue = i_color_new(0, 0, 255, 255);
+my $red = i_color_new(255, 0, 0, 255);
+
+my $img = test_image_raw();
+
+my $timg = Imager::ImgRaw::new(20, 20, 4);
+my $trans = i_color_new(255, 0, 0, 127);
+i_box_filled($timg, 0, 0, 20, 20, $green);
+i_box_filled($timg, 2, 2, 18, 18, $trans);
+
+Imager::i_tags_add($img, "i_xres", 0, "300", 0);
+Imager::i_tags_add($img, "i_yres", 0, undef, 200);
+# the following confuses the GIMP
+#Imager::i_tags_add($img, "i_aspect_only", 0, undef, 1);
+open(FH,">testout/t102.png") || die "cannot open testout/t102.png for writing\n";
+binmode(FH);
+my $IO = Imager::io_new_fd(fileno(FH));
+ok(Imager::File::PNG::i_writepng_wiol($img, $IO), "write");
+close(FH);
+
+open(FH,"testout/t102.png") || die "cannot open testout/t102.png\n";
+binmode(FH);
+$IO = Imager::io_new_fd(fileno(FH));
+my $cmpimg = Imager::File::PNG::i_readpng_wiol($IO);
+close(FH);
+ok($cmpimg, "read png");
+
+print "# png average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
+is(i_img_diff($img, $cmpimg), 0, "compare saved and original images");
+
+my %tags = map { Imager::i_tags_get($cmpimg, $_) }
+ 0..Imager::i_tags_count($cmpimg) - 1;
+ok(abs($tags{i_xres} - 300) < 1, "i_xres: $tags{i_xres}");
+ok(abs($tags{i_yres} - 200) < 1, "i_yres: $tags{i_yres}");
+is($tags{i_format}, "png", "i_format: $tags{i_format}");
+
+open FH, "> testout/t102_trans.png"
+ or die "Cannot open testout/t102_trans.png: $!";
+binmode FH;
+$IO = Imager::io_new_fd(fileno(FH));
+ok(Imager::File::PNG::i_writepng_wiol($timg, $IO), "write tranparent");
+close FH;
+
+open FH,"testout/t102_trans.png"
+ or die "cannot open testout/t102_trans.png\n";
+binmode(FH);
+$IO = Imager::io_new_fd(fileno(FH));
+$cmpimg = Imager::File::PNG::i_readpng_wiol($IO);
+ok($cmpimg, "read transparent");
+close(FH);
+
+print "# png average mean square pixel difference: ",sqrt(i_img_diff($timg,$cmpimg))/150*150,"\n";
+is(i_img_diff($timg, $cmpimg), 0, "compare saved and original transparent");
+
+# REGRESSION TEST
+# png.c 1.1 would produce an incorrect image when loading images with
+# less than 8 bits/pixel with a transparent palette entry
+open FH, "< testimg/palette.png"
+ or die "cannot open testimg/palette.png: $!\n";
+binmode FH;
+$IO = Imager::io_new_fd(fileno(FH));
+# 1.1 may segfault here (it does with libefence)
+my $pimg = Imager::File::PNG::i_readpng_wiol($IO);
+ok($pimg, "read transparent paletted image");
+close FH;
+
+open FH, "< testimg/palette_out.png"
+ or die "cannot open testimg/palette_out.png: $!\n";
+binmode FH;
+$IO = Imager::io_new_fd(fileno(FH));
+my $poimg = Imager::File::PNG::i_readpng_wiol($IO);
+ok($poimg, "read palette_out image");
+close FH;
+if (!is(i_img_diff($pimg, $poimg), 0, "images the same")) {
+ print <<EOS;
+# this tests a bug in Imager's png.c v1.1
+# if also tickles a bug in libpng before 1.0.5, so you may need to
+# upgrade libpng
+EOS
+}
+
+{ # check file limits are checked
+ my $limit_file = "testout/t102.png";
+ ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
+ my $im = Imager->new;
+ ok(!$im->read(file=>$limit_file),
+ "should fail read due to size limits");
+ print "# ",$im->errstr,"\n";
+ like($im->errstr, qr/image width/, "check message");
+
+ ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
+ ok(!$im->read(file=>$limit_file),
+ "should fail read due to size limits");
+ print "# ",$im->errstr,"\n";
+ like($im->errstr, qr/image height/, "check message");
+
+ ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
+ ok($im->read(file=>$limit_file),
+ "should succeed - just inside width limit");
+ ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
+ ok($im->read(file=>$limit_file),
+ "should succeed - just inside height limit");
+
+ # 150 x 150 x 3 channel image uses 67500 bytes
+ ok(Imager->set_file_limits(reset=>1, bytes=>67499),
+ "set bytes limit 67499");
+ ok(!$im->read(file=>$limit_file),
+ "should fail - too many bytes");
+ print "# ",$im->errstr,"\n";
+ like($im->errstr, qr/storage size/, "check error message");
+ ok(Imager->set_file_limits(reset=>1, bytes=>67500),
+ "set bytes limit 67500");
+ ok($im->read(file=>$limit_file),
+ "should succeed - just inside bytes limit");
+ Imager->set_file_limits(reset=>1);
+}
+
+{ # check if the read_multi fallback works
+ my @imgs = Imager->read_multi(file => 'testout/t102.png');
+ is(@imgs, 1, "check the image was loaded");
+ is(i_img_diff($img, $imgs[0]), 0, "check image matches");
+
+ # check the write_multi fallback
+ ok(Imager->write_multi({ file => 'testout/t102m.png', type => 'png' },
+ @imgs),
+ 'test write_multi() callback');
+
+ # check that we fail if we actually write 2
+ ok(!Imager->write_multi({ file => 'testout/t102m.png', type => 'png' },
+ @imgs, @imgs),
+ 'test write_multi() callback failure');
+}
+
+{
+ ok(grep($_ eq 'png', Imager->read_types), "check png in read types");
+ ok(grep($_ eq 'png', Imager->write_types), "check png in write types");
+}
+
#endif /* HAVE_LIBTIFF */
-#ifdef HAVE_LIBPNG
-i_img *i_readpng_wiol(io_glue *ig, int length);
-undef_int i_writepng_wiol(i_img *im, io_glue *ig);
-#endif /* HAVE_LIBPNG */
-
#ifdef HAVE_LIBGIF
i_img *i_readgif(int fd, int **colour_table, int *colours);
i_img *i_readgif_wiol(io_glue *ig, int **colour_table, int *colours);
--- /dev/null
+package Imager::Probe;
+use strict;
+use File::Spec;
+use Config;
+
+sub probe {
+ my ($class, $req) = @_;
+
+ $req->{verbose} ||= $ENV{IM_VERBOSE};
+
+ my $name = $req->{name};
+ my $result;
+ if ($req->{code}) {
+ $result = _probe_code($req);
+ }
+ if (!$result && $req->{pkg}) {
+ $result = _probe_pkg($req);
+ }
+ if (!$result && $req->{inccheck} && ($req->{libcheck} || $req->{libbase})) {
+ $result = _probe_check($req);
+ }
+
+ if (!$result && $req->{testcode}) {
+ $result = _probe_fake($req);
+ }
+ $result or return;
+
+ if ($req->{testcode}) {
+ $result = _probe_test($req, $result);
+ }
+
+ $result or return;
+
+ return $result;
+}
+
+sub _probe_code {
+ my ($req) = @_;
+
+ my $code = $req->{code};
+ my @probes = ref $code eq "ARRAY" ? @$code : $code;
+
+ my $result;
+ for my $probe (@probes) {
+ $result = $probe->($req)
+ and return $result;
+ }
+
+ return;
+}
+
+sub is_exe {
+ my ($name) = @_;
+
+ my @exe_suffix = $Config{_exe};
+ if ($^O eq 'MSWin32') {
+ push @exe_suffix, qw/.bat .cmd/;
+ }
+
+ for my $dir (File::Spec->path) {
+ for my $suffix (@exe_suffix) {
+ -x File::Spec->catfile($dir, "$name$suffix")
+ and return 1;
+ }
+ }
+
+ return;
+}
+
+sub _probe_pkg {
+ my ($req) = @_;
+
+ is_exe('pkg-config') or return;
+ my $redir = $^O eq 'MSWin32' ? '' : '2>/dev/null';
+
+ my @pkgs = @{$req->{pkg}};
+ for my $pkg (@pkgs) {
+ if (!system("pkg-config $pkg --exists $redir")) {
+ # if we find it, but the following fail, then pkg-config is too
+ # broken to be useful
+ my $cflags = `pkg-config $pkg --cflags`
+ and !$? or return;
+
+ my $lflags = `pkg-config $pkg --libs`
+ and !$? or return;
+
+ chomp $cflags;
+ chomp $lflags;
+ print "$req->{name}: Found via pkg-config $pkg\n";
+ return
+ {
+ INC => $cflags,
+ LIBS => $lflags,
+ };
+ }
+ }
+
+ print "$req->{name}: Not found via pkg-config\n";
+
+ return;
+}
+
+sub _probe_check {
+ my ($req) = @_;
+
+ my $libcheck = $req->{libcheck};
+ my $libbase = $req->{libbase};
+ if (!$libcheck && $req->{libbase}) {
+ # synthesize a libcheck
+ my $lext=$Config{'so'}; # Get extensions of libraries
+ my $aext=$Config{'_a'};
+ $libcheck = sub {
+ -e File::Spec->catfile($_[0], "lib$libbase$aext")
+ || -e File::Spec->catfile($_[0], "lib$libbase.$lext")
+ };
+ }
+
+ my $found_libpath;
+ my @lib_search = _lib_paths($req);
+ print "$req->{name}: Searching directories for libraries:\n"
+ if $req->{verbose};
+ for my $path (@lib_search) {
+ print "$req->{name}: $path\n" if $req->{verbose};
+ if ($libcheck->($path)) {
+ print "$req->{name}: Found!\n" if $req->{verbose};
+ $found_libpath = $path;
+ last;
+ }
+ }
+
+ my $found_incpath;
+ my $inccheck = $req->{inccheck};
+ my @inc_search = _inc_paths($req);
+ print "$req->{name}: Searching directories for headers:\n"
+ if $req->{verbose};
+ for my $path (@inc_search) {
+ print "$req->{name}: $path\n" if $req->{verbose};
+ if ($inccheck->($path)) {
+ print "$req->{name}: Found!\n" if $req->{verbose};
+ $found_incpath = $path;
+ last;
+ }
+ }
+
+ print "$req->{name}: includes ", $found_incpath ? "" : "not ",
+ "found - libraries ", $found_libpath ? "" : "not ", "found\n";
+
+ $found_libpath && $found_incpath
+ or return;
+
+ my @libs = "-L$found_libpath";
+ if ($req->{libopts}) {
+ push @libs, $req->{libopts};
+ }
+ elsif ($libbase) {
+ push @libs, "-l$libbase";
+ }
+ else {
+ die "$req->{name}: inccheck but no libbase or libopts";
+ }
+
+ return
+ {
+ INC => "-I$found_incpath",
+ LIBS => "@libs",
+ };
+}
+
+sub _probe_fake {
+ my ($req) = @_;
+
+ # the caller provided test code, and the compiler may look in
+ # places we don't, see Imager-Screenshot ticket 56793,
+ # so fake up a result so the test code can
+ my $lopts;
+ if ($req->{libopts}) {
+ $lopts = $req->{libopts};
+ }
+ elsif (defined $req->{libbase}) {
+ # might not need extra libraries, eg. Win32 perl already links
+ # everything
+ $lopts = $req->{libbase} ? "-l$req->{libbase}" : "";
+ }
+ if (defined $lopts) {
+ print "$req->{name}: Checking if the compiler can find them on it's own\n";
+ return
+ {
+ INC => "",
+ LIBS => $lopts,
+ };
+ }
+ else {
+ print "$req->{name}: Can't fake it - no libbase or libopts\n"
+ if $req->{verbose};
+ return;
+ }
+}
+
+sub _probe_test {
+ my ($req, $result) = @_;
+
+ require Devel::CheckLib;
+ # setup LD_RUN_PATH to match link time
+ my ($extra, $bs_load, $ld_load, $ld_run_path) =
+ ExtUtils::Liblist->ext($req->{LIBS}, $req->{verbose});
+ local $ENV{LD_RUN_PATH};
+
+ if ($ld_run_path) {
+ print "Setting LD_RUN_PATH=$ld_run_path for TIFF probe\n"
+ if $req->{verbose};
+ $ENV{LD_RUN_PATH} = $ld_run_path;
+ }
+ my $good =
+ Devel::CheckLib::check_lib
+ (
+ debug => $req->{verbose},
+ LIBS => $result->{LIBS},
+ INC => $result->{INC},
+ header => $req->{testcodeheaders},
+ function => $req->{testcode},
+ );
+ unless ($good) {
+ print "$req->{name}: Test code failed checklib probe: $@\n"
+ if $req->{verbose};
+ return;
+ }
+
+ print "$req->{name}: Passed code check\n";
+ return $result;
+}
+
+sub _lib_paths {
+ my ($req) = @_;
+
+ return _paths
+ (
+ $ENV{IM_LIBPATH},
+ $req->{libpath},
+ (
+ map { split ' ' }
+ grep $_,
+ @Config{qw/loclibpath libpth libspath/}
+ ),
+ $^O eq "MSWin32" ? $ENV{LIB} : "",
+ $^O eq "cygwin" ? "/usr/lib/w32api" : "",
+ );
+}
+
+sub _inc_paths {
+ my ($req) = @_;
+
+ return _paths
+ (
+ $ENV{IM_INCPATH},
+ $req->{incpath},
+ $^O eq "MSWin32" ? $ENV{INCLUDE} : "",
+ $^O eq "cygwin" ? "/usr/include/w32api" : "",
+ (
+ map { split ' ' }
+ grep $_,
+ @Config{qw/locincpath incpath/}
+ ),
+ "/usr/include",
+ "/usr/local/include",
+ );
+}
+
+sub _paths {
+ my (@in) = @_;
+
+ my @out;
+
+ for my $path (@in) {
+ $path or next;
+ $path = _tilde_expand($path);
+
+ push @out, grep -d $_, split /\Q$Config{path_sep}/, $path;
+ }
+
+ return @out;
+}
+
+my $home;
+sub _tilde_expand {
+ my ($path) = @_;
+
+ if ($path =~ m!^~[/\\]!) {
+ defined $home or $home = $ENV{HOME};
+ if (!defined $home && $^O eq 'MSWin32'
+ && defined $ENV{HOMEDRIVE} && defined $ENV{HOMEPATH}) {
+ $home = $ENV{HOMEDRIVE} . $ENV{HOMEPATH};
+ }
+ unless (defined $home) {
+ $home = eval { (getpwuid($<))[7] };
+ }
+ defined $home or die "You supplied $path, but I can't find your home directory\n";
+ $path =~ s/^~//;
+ $path = File::Spec->catdir($home, $path);
+ }
+
+ return $path;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Imager::Probe - hot needle of inquiry for libraries
+
+=head1 SYNOPSIS
+
+ require Imager::Probe;
+
+ my %probe =
+ (
+ # short name of what we're looking for (displayed to user)
+ name => "FOO",
+ # pkg-config lookup
+ pkg => [ qw/name1 name2 name3/ ],
+ # perl subs that probe for the library
+ code => [ \&foo_probe1, \&foo_probe2 ],
+ # or just: code => \&foo_probe,
+ inccheck => sub { ... },
+ libcheck => sub { ... },
+ # search for this library if libcheck not supplied
+ libbase => "foo",
+ # library link time options, uses libbase to build options otherwise
+ libopts => "-lfoo",
+ # C code to check the library is sane
+ testcode => "...",
+ # header files needed
+ testcodeheaders => [ "stdio.h", "foo.h" ],
+ );
+ my $result = Imager::Probe->probe(\%probe)
+ or print "Foo library not found: ",Imager::Probe->error;
+
+=head1 DESCRIPTION
+
+Does the probes that were hidden in Imager's F<Makefile.PL>, pulled
+out so the file format libraries can be externalized.
+
+The return value is either nothing if the probe fails, or a hash
+containing:
+
+=over
+
+=item *
+
+C<INC> - C<-I> and other C options
+
+=item *
+
+C<LIBS> - C<-L>, C<-l> and other link-time options
+
+=back
+
+The possible values for the hash supplied to the probe() method are:
+
+=over
+
+=item *
+
+C<pkg> - an array of F<pkg-config> names to probe for. If the
+F<pkg-config> checks pass, C<inccheck> and C<libcheck> aren't used.
+
+=item *
+
+C<inccheck> - a code reference that checks if the supplied include
+directory contains the required header files.
+
+=item *
+
+C<libcheck> - a code reference that checks if the supplied library
+directory contains the required library files. Note: the
+F<Makefile.PL> version of this was supplied all of the library file
+names instead.
+
+=item *
+
+C<libbase> - if C<inccheck> is supplied, but C<libcheck> isn't, then a
+C<libcheck> that checks for C<lib>I<libbase>I<$Config{_a}> and
+C<lib>I<libbase>.I<$Config{so}> is created. If C<libopts> isn't
+supplied then that can be synthesized as C<-l>C<<I<libbase>>>.
+
+=item *
+
+C<libopts> - if the libraries are found via C<inccheck>/C<libcheck>,
+these are the C<-l> options to supply during the link phase.
+
+=item *
+
+C<code> - a code reference to perform custom checks. Returns the
+probe result directly. Can also be an array ref of functions to call.
+
+=item *
+
+C<testcode> - test C code that is run with Devel::CheckLib. You also
+need to set C<testcodeheaders>.
+
+=item *
+
+C<incpath> - C<$Config{path_sep}> separated list of header file
+directories to check.
+
+=item *
+
+C<libpath> - C<$Config{path_sep}> separated list of library file
+directories to check.
+
+=back
+
+=cut
+++ /dev/null
-#include "iolayer.h"
-#include "imageri.h"
-#include "png.h"
-
-/* Check to see if a file is a PNG file using png_sig_cmp(). png_sig_cmp()
- * returns zero if the image is a PNG and nonzero if it isn't a PNG.
- *
- * The function check_if_png() shown here, but not used, returns nonzero (true)
- * if the file can be opened and is a PNG, 0 (false) otherwise.
- *
- * If this call is successful, and you are going to keep the file open,
- * you should call png_set_sig_bytes(png_ptr, PNG_BYTES_TO_CHECK); once
- * you have created the png_ptr, so that libpng knows your application
- * has read that many bytes from the start of the file. Make sure you
- * don't call png_set_sig_bytes() with more than 8 bytes read or give it
- * an incorrect number of bytes read, or you will either have read too
- * many bytes (your fault), or you are telling libpng to read the wrong
- * number of magic bytes (also your fault).
- *
- * Many applications already read the first 2 or 4 bytes from the start
- * of the image to determine the file type, so it would be easiest just
- * to pass the bytes to png_sig_cmp() or even skip that if you know
- * you have a PNG file, and call png_set_sig_bytes().
- */
-
-/* this is a way to get number of channels from color space
- * Color code to channel number */
-
-static int CC2C[PNG_COLOR_MASK_PALETTE|PNG_COLOR_MASK_COLOR|PNG_COLOR_MASK_ALPHA];
-
-#define PNG_BYTES_TO_CHECK 4
-
-
-
-static void
-wiol_read_data(png_structp png_ptr, png_bytep data, png_size_t length) {
- io_glue *ig = (io_glue *)png_ptr->io_ptr;
- int rc = ig->readcb(ig, data, length);
- if (rc != length) png_error(png_ptr, "Read overflow error on an iolayer source.");
-}
-
-static void
-wiol_write_data(png_structp png_ptr, png_bytep data, png_size_t length) {
- int rc;
- io_glue *ig = (io_glue *)png_ptr->io_ptr;
- rc = ig->writecb(ig, data, length);
- if (rc != length) png_error(png_ptr, "Write error on an iolayer source.");
-}
-
-static void
-wiol_flush_data(png_structp png_ptr) {
- /* XXX : This needs to be added to the io layer */
-}
-
-
-/* Check function demo
-
-int
-check_if_png(char *file_name, FILE **fp) {
- char buf[PNG_BYTES_TO_CHECK];
- if ((*fp = fopen(file_name, "rb")) != NULL) return 0;
- if (fread(buf, 1, PNG_BYTES_TO_CHECK, *fp) != PNG_BYTES_TO_CHECK) return 0;
- return(!png_sig_cmp((png_bytep)buf, (png_size_t)0, PNG_BYTES_TO_CHECK));
-}
-*/
-
-undef_int
-i_writepng_wiol(i_img *im, io_glue *ig) {
- png_structp png_ptr;
- png_infop info_ptr = NULL;
- int width,height,y;
- volatile int cspace,channels;
- double xres, yres;
- int aspect_only, have_res;
-
- io_glue_commit_types(ig);
- mm_log((1,"i_writepng(im %p ,ig %p)\n", im, ig));
-
- height = im->ysize;
- width = im->xsize;
-
- channels=im->channels;
-
- if (channels > 2) { cspace = PNG_COLOR_TYPE_RGB; channels-=3; }
- else { cspace=PNG_COLOR_TYPE_GRAY; channels--; }
-
- if (channels) cspace|=PNG_COLOR_MASK_ALPHA;
- mm_log((1,"cspace=%d\n",cspace));
-
- channels = im->channels;
-
- /* Create and initialize the png_struct with the desired error handler
- * functions. If you want to use the default stderr and longjump method,
- * you can supply NULL for the last three parameters. We also check that
- * the library version is compatible with the one used at compile time,
- * in case we are using dynamically linked libraries. REQUIRED.
- */
-
- png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING,NULL,NULL,NULL);
-
- if (png_ptr == NULL) return 0;
-
-
- /* Allocate/initialize the image information data. REQUIRED */
- info_ptr = png_create_info_struct(png_ptr);
-
- if (info_ptr == NULL) {
- png_destroy_write_struct(&png_ptr, &info_ptr);
- return 0;
- }
-
- /* Set error handling. REQUIRED if you aren't supplying your own
- * error hadnling functions in the png_create_write_struct() call.
- */
- if (setjmp(png_ptr->jmpbuf)) {
- png_destroy_write_struct(&png_ptr, &info_ptr);
- return(0);
- }
-
- png_set_write_fn(png_ptr, (png_voidp) (ig), wiol_write_data, wiol_flush_data);
- png_ptr->io_ptr = (png_voidp) ig;
-
- /* Set the image information here. Width and height are up to 2^31,
- * bit_depth is one of 1, 2, 4, 8, or 16, but valid values also depend on
- * the color_type selected. color_type is one of PNG_COLOR_TYPE_GRAY,
- * PNG_COLOR_TYPE_GRAY_ALPHA, PNG_COLOR_TYPE_PALETTE, PNG_COLOR_TYPE_RGB,
- * or PNG_COLOR_TYPE_RGB_ALPHA. interlace is either PNG_INTERLACE_NONE or
- * PNG_INTERLACE_ADAM7, and the compression_type and filter_type MUST
- * currently be PNG_COMPRESSION_TYPE_BASE and PNG_FILTER_TYPE_BASE. REQUIRED
- */
-
- png_set_IHDR(png_ptr, info_ptr, width, height, 8, cspace,
- PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE, PNG_FILTER_TYPE_BASE);
-
- have_res = 1;
- if (i_tags_get_float(&im->tags, "i_xres", 0, &xres)) {
- if (i_tags_get_float(&im->tags, "i_yres", 0, &yres))
- ; /* nothing to do */
- else
- yres = xres;
- }
- else {
- if (i_tags_get_float(&im->tags, "i_yres", 0, &yres))
- xres = yres;
- else
- have_res = 0;
- }
- if (have_res) {
- aspect_only = 0;
- i_tags_get_int(&im->tags, "i_aspect_only", 0, &aspect_only);
- xres /= 0.0254;
- yres /= 0.0254;
- png_set_pHYs(png_ptr, info_ptr, xres + 0.5, yres + 0.5,
- aspect_only ? PNG_RESOLUTION_UNKNOWN : PNG_RESOLUTION_METER);
- }
-
- png_write_info(png_ptr, info_ptr);
-
- if (!im->virtual && im->type == i_direct_type && im->bits == i_8_bits) {
- for (y = 0; y < height; y++)
- png_write_row(png_ptr, (png_bytep) &(im->idata[channels*width*y]));
- }
- else {
- unsigned char *data = mymalloc(im->xsize * im->channels);
- for (y = 0; y < height; y++) {
- i_gsamp(im, 0, im->xsize, y, data, NULL, im->channels);
- png_write_row(png_ptr, (png_bytep)data);
- }
- myfree(data);
- }
-
- png_write_end(png_ptr, info_ptr);
-
- png_destroy_write_struct(&png_ptr, &info_ptr);
-
- ig->closecb(ig);
-
- return(1);
-}
-
-
-
-static void get_png_tags(i_img *im, png_structp png_ptr, png_infop info_ptr);
-
-i_img*
-i_readpng_wiol(io_glue *ig, int length) {
- i_img *im = NULL;
- png_structp png_ptr;
- png_infop info_ptr;
- png_uint_32 width, height;
- int bit_depth, color_type, interlace_type;
- int number_passes,y;
- int channels,pass;
- unsigned int sig_read;
-
- sig_read = 0;
-
- io_glue_commit_types(ig);
- mm_log((1,"i_readpng_wiol(ig %p, length %d)\n", ig, length));
-
- png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING,NULL,NULL,NULL);
- png_set_read_fn(png_ptr, (png_voidp) (ig), wiol_read_data);
-
- info_ptr = png_create_info_struct(png_ptr);
- if (info_ptr == NULL) {
- png_destroy_read_struct(&png_ptr, (png_infopp)NULL, (png_infopp)NULL);
- return NULL;
- }
-
- if (setjmp(png_ptr->jmpbuf)) {
- if (im) i_img_destroy(im);
- mm_log((1,"i_readpng_wiol: error.\n"));
- png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
- return NULL;
- }
-
- png_ptr->io_ptr = (png_voidp) ig;
- png_set_sig_bytes(png_ptr, sig_read);
- png_read_info(png_ptr, info_ptr);
- png_get_IHDR(png_ptr, info_ptr, &width, &height, &bit_depth, &color_type, &interlace_type, NULL, NULL);
-
- mm_log((1,
- "png_get_IHDR results: width %d, height %d, bit_depth %d, color_type %d, interlace_type %d\n",
- width,height,bit_depth,color_type,interlace_type));
-
- CC2C[PNG_COLOR_TYPE_GRAY]=1;
- CC2C[PNG_COLOR_TYPE_PALETTE]=3;
- CC2C[PNG_COLOR_TYPE_RGB]=3;
- CC2C[PNG_COLOR_TYPE_RGB_ALPHA]=4;
- CC2C[PNG_COLOR_TYPE_GRAY_ALPHA]=2;
- channels = CC2C[color_type];
-
- mm_log((1,"i_readpng_wiol: channels %d\n",channels));
-
- if (!i_int_check_image_file_limits(width, height, channels, sizeof(i_sample_t))) {
- mm_log((1, "i_readpnm: image size exceeds limits\n"));
- png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
- return NULL;
- }
-
- png_set_strip_16(png_ptr);
- png_set_packing(png_ptr);
- if (color_type == PNG_COLOR_TYPE_PALETTE) png_set_expand(png_ptr);
- if (color_type == PNG_COLOR_TYPE_GRAY && bit_depth < 8) png_set_expand(png_ptr);
-
- if (png_get_valid(png_ptr, info_ptr, PNG_INFO_tRNS)) {
- channels++;
- mm_log((1, "image has transparency, adding alpha: channels = %d\n", channels));
- png_set_expand(png_ptr);
- }
-
- number_passes = png_set_interlace_handling(png_ptr);
- mm_log((1,"number of passes=%d\n",number_passes));
- png_read_update_info(png_ptr, info_ptr);
-
- im = i_img_empty_ch(NULL,width,height,channels);
- if (!im) {
- png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
- return NULL;
- }
-
- for (pass = 0; pass < number_passes; pass++)
- for (y = 0; y < height; y++) { png_read_row(png_ptr,(png_bytep) &(im->idata[channels*width*y]), NULL); }
-
- png_read_end(png_ptr, info_ptr);
-
- get_png_tags(im, png_ptr, info_ptr);
-
- png_destroy_read_struct(&png_ptr, &info_ptr, (png_infopp)NULL);
-
- mm_log((1,"(0x%08X) <- i_readpng_scalar\n", im));
-
- return im;
-}
-
-static void get_png_tags(i_img *im, png_structp png_ptr, png_infop info_ptr) {
- png_uint_32 xres, yres;
- int unit_type;
-
- i_tags_add(&im->tags, "i_format", 0, "png", -1, 0);
- if (png_get_pHYs(png_ptr, info_ptr, &xres, &yres, &unit_type)) {
- mm_log((1,"pHYs (%d, %d) %d\n", xres, yres, unit_type));
- if (unit_type == PNG_RESOLUTION_METER) {
- i_tags_set_float2(&im->tags, "i_xres", 0, xres * 0.0254, 5);
- i_tags_set_float2(&im->tags, "i_yres", 0, yres * 0.0254, 5);
- }
- else {
- i_tags_addn(&im->tags, "i_xres", 0, xres);
- i_tags_addn(&im->tags, "i_yres", 0, yres);
- i_tags_addn(&im->tags, "i_aspect_only", 0, 1);
- }
- }
-}
use Imager qw(:all);
use Test::More;
-i_has_format("png")
+$Imager::formats{"png"}
and plan skip_all => "png available, and this tests the lack of it";
plan tests => 6;
+++ /dev/null
-#!perl -w
-use strict;
-use Imager qw(:all);
-use Test::More;
-use Imager::Test qw(test_image_raw);
-
-init_log("testout/t102png.log",1);
-
-i_has_format("png")
- or plan skip_all => "No png support";
-
-plan tests => 33;
-
-my $green = i_color_new(0, 255, 0, 255);
-my $blue = i_color_new(0, 0, 255, 255);
-my $red = i_color_new(255, 0, 0, 255);
-
-my $img = test_image_raw();
-
-my $timg = Imager::ImgRaw::new(20, 20, 4);
-my $trans = i_color_new(255, 0, 0, 127);
-i_box_filled($timg, 0, 0, 20, 20, $green);
-i_box_filled($timg, 2, 2, 18, 18, $trans);
-
-Imager::i_tags_add($img, "i_xres", 0, "300", 0);
-Imager::i_tags_add($img, "i_yres", 0, undef, 200);
-# the following confuses the GIMP
-#Imager::i_tags_add($img, "i_aspect_only", 0, undef, 1);
-open(FH,">testout/t102.png") || die "cannot open testout/t102.png for writing\n";
-binmode(FH);
-my $IO = Imager::io_new_fd(fileno(FH));
-ok(i_writepng_wiol($img, $IO), "write");
-close(FH);
-
-open(FH,"testout/t102.png") || die "cannot open testout/t102.png\n";
-binmode(FH);
-$IO = Imager::io_new_fd(fileno(FH));
-my $cmpimg = i_readpng_wiol($IO, -1);
-close(FH);
-ok($cmpimg, "read png");
-
-print "# png average mean square pixel difference: ",sqrt(i_img_diff($img,$cmpimg))/150*150,"\n";
-is(i_img_diff($img, $cmpimg), 0, "compare saved and original images");
-
-my %tags = map { Imager::i_tags_get($cmpimg, $_) }
- 0..Imager::i_tags_count($cmpimg) - 1;
-ok(abs($tags{i_xres} - 300) < 1, "i_xres: $tags{i_xres}");
-ok(abs($tags{i_yres} - 200) < 1, "i_yres: $tags{i_yres}");
-is($tags{i_format}, "png", "i_format: $tags{i_format}");
-
-open FH, "> testout/t102_trans.png"
- or die "Cannot open testout/t102_trans.png: $!";
-binmode FH;
-$IO = Imager::io_new_fd(fileno(FH));
-ok(i_writepng_wiol($timg, $IO), "write tranparent");
-close FH;
-
-open FH,"testout/t102_trans.png"
- or die "cannot open testout/t102_trans.png\n";
-binmode(FH);
-$IO = Imager::io_new_fd(fileno(FH));
-$cmpimg = i_readpng_wiol($IO, -1);
-ok($cmpimg, "read transparent");
-close(FH);
-
-print "# png average mean square pixel difference: ",sqrt(i_img_diff($timg,$cmpimg))/150*150,"\n";
-is(i_img_diff($timg, $cmpimg), 0, "compare saved and original transparent");
-
-# REGRESSION TEST
-# png.c 1.1 would produce an incorrect image when loading images with
-# less than 8 bits/pixel with a transparent palette entry
-open FH, "< testimg/palette.png"
- or die "cannot open testimg/palette.png: $!\n";
-binmode FH;
-$IO = Imager::io_new_fd(fileno(FH));
-# 1.1 may segfault here (it does with libefence)
-my $pimg = i_readpng_wiol($IO,-1);
-ok($pimg, "read transparent paletted image");
-close FH;
-
-open FH, "< testimg/palette_out.png"
- or die "cannot open testimg/palette_out.png: $!\n";
-binmode FH;
-$IO = Imager::io_new_fd(fileno(FH));
-my $poimg = i_readpng_wiol($IO, -1);
-ok($poimg, "read palette_out image");
-close FH;
-if (!is(i_img_diff($pimg, $poimg), 0, "images the same")) {
- print <<EOS;
-# this tests a bug in Imager's png.c v1.1
-# if also tickles a bug in libpng before 1.0.5, so you may need to
-# upgrade libpng
-EOS
-}
-
-{ # check file limits are checked
- my $limit_file = "testout/t102.png";
- ok(Imager->set_file_limits(reset=>1, width=>149), "set width limit 149");
- my $im = Imager->new;
- ok(!$im->read(file=>$limit_file),
- "should fail read due to size limits");
- print "# ",$im->errstr,"\n";
- like($im->errstr, qr/image width/, "check message");
-
- ok(Imager->set_file_limits(reset=>1, height=>149), "set height limit 149");
- ok(!$im->read(file=>$limit_file),
- "should fail read due to size limits");
- print "# ",$im->errstr,"\n";
- like($im->errstr, qr/image height/, "check message");
-
- ok(Imager->set_file_limits(reset=>1, width=>150), "set width limit 150");
- ok($im->read(file=>$limit_file),
- "should succeed - just inside width limit");
- ok(Imager->set_file_limits(reset=>1, height=>150), "set height limit 150");
- ok($im->read(file=>$limit_file),
- "should succeed - just inside height limit");
-
- # 150 x 150 x 3 channel image uses 67500 bytes
- ok(Imager->set_file_limits(reset=>1, bytes=>67499),
- "set bytes limit 67499");
- ok(!$im->read(file=>$limit_file),
- "should fail - too many bytes");
- print "# ",$im->errstr,"\n";
- like($im->errstr, qr/storage size/, "check error message");
- ok(Imager->set_file_limits(reset=>1, bytes=>67500),
- "set bytes limit 67500");
- ok($im->read(file=>$limit_file),
- "should succeed - just inside bytes limit");
- Imager->set_file_limits(reset=>1);
-}
-
-{ # check if the read_multi fallback works
- my @imgs = Imager->read_multi(file => 'testout/t102.png');
- is(@imgs, 1, "check the image was loaded");
- is(i_img_diff($img, $imgs[0]), 0, "check image matches");
-
- # check the write_multi fallback
- ok(Imager->write_multi({ file => 'testout/t102m.png', type => 'png' },
- @imgs),
- 'test write_multi() callback');
-
- # check that we fail if we actually write 2
- ok(!Imager->write_multi({ file => 'testout/t102m.png', type => 'png' },
- @imgs, @imgs),
- 'test write_multi() callback failure');
-}
-
-{
- ok(grep($_ eq 'png', Imager->read_types), "check png in read types");
- ok(grep($_ eq 'png', Imager->write_types), "check png in write types");
-}
-
{
ok(open(FH, "< testimg/penguin-base.ppm"), "open test file")
or skip("couldn't open data source", 4);
+ binmode FH;
my $imdata = do { local $/; <FH> };
close FH;
ok(length $imdata, "we got the data");
projects / imager.git / commitdiff
