merge PNG branch and some clean-up
authorTony Cook <tony@develop=help.com>
Fri, 6 Aug 2010 10:25:30 +0000 (10:25 +0000)
committerTony Cook <tony@develop=help.com>
Fri, 6 Aug 2010 10:25:30 +0000 (10:25 +0000)
22 files changed:
Changes
Imager.pm
Imager.xs
MANIFEST
Makefile.PL
PNG/Makefile.PL [new file with mode: 0644]
PNG/PNG.pm [new file with mode: 0644]
PNG/PNG.xs [new file with mode: 0644]
PNG/impng.c [new file with mode: 0644]
PNG/impng.h [new file with mode: 0644]
PNG/t/00load.t [new file with mode: 0644]
PNG/t/10png.t [new file with mode: 0644]
PNG/testimg/palette.png [new file with mode: 0644]
PNG/testimg/palette_out.png [new file with mode: 0644]
imager.h
lib/Imager/Probe.pm [new file with mode: 0644]
png.c [deleted file]
t/t102nopng.t
t/t102png.t [deleted file]
t/t104ppm.t
testimg/palette.png [deleted file]
testimg/palette_out.png [deleted file]

diff --git a/Changes b/Changes
index 98fd5b1..4250f8f 100644 (file)
--- a/Changes
+++ b/Changes
@@ -8,6 +8,12 @@ Imager 0.76
    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
index c0fc391..d35732f 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -81,9 +81,6 @@ use Imager::Font;
                i_writetiff_wiol
                i_writetiff_wiol_faxable
 
-               i_readpng_wiol
-               i_writepng_wiol
-
                i_readgif
                i_readgif_wiol
                i_readgif_callback
@@ -185,15 +182,25 @@ BEGIN {
   }
 }
 
+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;
@@ -1367,7 +1374,7 @@ sub read {
     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;
@@ -1407,15 +1414,6 @@ sub read {
     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}) ) {
@@ -1572,7 +1570,7 @@ sub write_types {
 sub _reader_autoload {
   my $type = shift;
 
-  return if $formats{$type} || $readers{$type};
+  return if $formats_low{$type} || $readers{$type};
 
   return unless $type =~ /^\w+$/;
 
@@ -1600,7 +1598,7 @@ sub _reader_autoload {
 sub _writer_autoload {
   my $type = shift;
 
-  return if $formats{$type} || $readers{$type};
+  return if $formats_low{$type} || $readers{$type};
 
   return unless $type =~ /^\w+$/;
 
@@ -1759,7 +1757,7 @@ sub write {
       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;
@@ -3929,6 +3927,106 @@ sub Inline {
 # 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!
index d5e898e..f42d22d 100644 (file)
--- a/Imager.xs
+++ b/Imager.xs
@@ -2502,18 +2502,6 @@ i_tiff_has_compression(name)
 
 #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
 
 
index 5ad5ab3..70023cf 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -55,6 +55,15 @@ Mandelbrot/mandel.c
 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
@@ -175,6 +184,7 @@ lib/Imager/IO.pod           Document Imager::IO objects
 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
@@ -190,7 +200,6 @@ maskimg.c
 palimg.c
 paste.im
 plug.h
-png.c
 pnm.c
 polygon.c
 ppport.h
@@ -239,7 +248,6 @@ t/t1000files.t          Format independent file tests
 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
@@ -340,8 +348,6 @@ testimg/maxval_asc.ppm
 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
index cda92e4..b727d19 100644 (file)
@@ -11,6 +11,10 @@ use vars qw(%formats $VERBOSE $INCPATH $LIBPATH $NOLOG $DEBUG_MALLOC $MANUAL $CF
 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
@@ -55,6 +59,8 @@ GetOptions("help" => \$help,
           'coverage' => \$coverage,
           "assert|a" => \$assert);
 
+setenv();
+
 if ($ENV{AUTOMATED_TESTING}) {
   $assert = 1;
 }
@@ -534,19 +540,19 @@ sub init {
                    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',
@@ -678,6 +684,13 @@ sub getenv {
 
 }
 
+# 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) = @_;
 
diff --git a/PNG/Makefile.PL b/PNG/Makefile.PL
new file mode 100644 (file)
index 0000000..f11bb37
--- /dev/null
@@ -0,0 +1,100 @@
+#!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
+}
diff --git a/PNG/PNG.pm b/PNG/PNG.pm
new file mode 100644 (file)
index 0000000..7c4c18a
--- /dev/null
@@ -0,0 +1,83 @@
+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
diff --git a/PNG/PNG.xs b/PNG/PNG.xs
new file mode 100644 (file)
index 0000000..af23586
--- /dev/null
@@ -0,0 +1,26 @@
+#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;
diff --git a/PNG/impng.c b/PNG/impng.c
new file mode 100644 (file)
index 0000000..d1821cd
--- /dev/null
@@ -0,0 +1,290 @@
+#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);
+    }
+  }
+}
diff --git a/PNG/impng.h b/PNG/impng.h
new file mode 100644 (file)
index 0000000..afd5af1
--- /dev/null
@@ -0,0 +1,9 @@
+#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
diff --git a/PNG/t/00load.t b/PNG/t/00load.t
new file mode 100644 (file)
index 0000000..2227441
--- /dev/null
@@ -0,0 +1,5 @@
+#!perl -w
+use strict;
+use Test::More tests => 1;
+
+use_ok("Imager::File::PNG");
diff --git a/PNG/t/10png.t b/PNG/t/10png.t
new file mode 100644 (file)
index 0000000..9dbc399
--- /dev/null
@@ -0,0 +1,154 @@
+#!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");
+}
+
diff --git a/PNG/testimg/palette.png b/PNG/testimg/palette.png
new file mode 100644 (file)
index 0000000..4a3c374
Binary files /dev/null and b/PNG/testimg/palette.png differ
diff --git a/PNG/testimg/palette_out.png b/PNG/testimg/palette_out.png
new file mode 100644 (file)
index 0000000..6385b71
Binary files /dev/null and b/PNG/testimg/palette_out.png differ
index ec508c4..347a75c 100644 (file)
--- a/imager.h
+++ b/imager.h
@@ -399,11 +399,6 @@ int i_tiff_has_compression(char const *name);
 
 #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);
diff --git a/lib/Imager/Probe.pm b/lib/Imager/Probe.pm
new file mode 100644 (file)
index 0000000..11d9bae
--- /dev/null
@@ -0,0 +1,414 @@
+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
diff --git a/png.c b/png.c
deleted file mode 100644 (file)
index af9033e..0000000
--- a/png.c
+++ /dev/null
@@ -1,293 +0,0 @@
-#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);
-    }
-  }
-}
index 9b16391..9ba2eb8 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 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;
diff --git a/t/t102png.t b/t/t102png.t
deleted file mode 100644 (file)
index 98cd895..0000000
+++ /dev/null
@@ -1,152 +0,0 @@
-#!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");
-}
-
index f35c8ad..ebe319c 100644 (file)
@@ -572,6 +572,7 @@ print "# check error handling\n";
   {
     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");
diff --git a/testimg/palette.png b/testimg/palette.png
deleted file mode 100644 (file)
index 4a3c374..0000000
Binary files a/testimg/palette.png and /dev/null differ
diff --git a/testimg/palette_out.png b/testimg/palette_out.png
deleted file mode 100644 (file)
index 6385b71..0000000
Binary files a/testimg/palette_out.png and /dev/null differ