add page parameter to read() method when reading TIFF files

diff --git a/Changes b/Changes
index 8f29408638fb2ae400b7ae6044b7d2c9b08c4861..2b08676de5f9a4de9ae73703071c732f23b17b58 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1148,6 +1148,8 @@ Revision history for Perl extension Imager.
 - renamed lib/Imager/Cookbook.pm to lib/Imager/Cookbook.pod - CPANTS
   complains about it not having 'use strict;'
 - add samples/replace_color.pl
+- you can now supply a page parameter to read() to read a given page
+  from a TIFF file.
 
 =================================================================
 

diff --git a/Imager.pm b/Imager.pm
index d6995912931ba13a124605656e60675e8225eada..5a7b77a61dbfc6783e2be5d921ae69c88a093416 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -1149,7 +1149,10 @@ sub read {
   }
 
   if ( $input{'type'} eq 'tiff' ) {
-    $self->{IMG}=i_readtiff_wiol( $IO, -1 ); # Fixme, check if that length parameter is ever needed
+    my $page = $input{'page'};
+    defined $page or $page = 0;
+    # Fixme, check if that length parameter is ever needed
+    $self->{IMG}=i_readtiff_wiol( $IO, -1, $page ); 
     if ( !defined($self->{IMG}) ) {
       $self->{ERRSTR}=$self->_error_as_msg(); return undef;
     }

diff --git a/Imager.xs b/Imager.xs
index 66939fa4388b105aa1038d436de0fdac19bfada5..03082e14ab2629599c36c53c8ae2796440a44d49 100644 (file)
--- a/Imager.xs
+++ b/Imager.xs
@@ -2035,9 +2035,10 @@ i_test_format_probe(ig, length)
 #ifdef HAVE_LIBTIFF
 
 Imager::ImgRaw
-i_readtiff_wiol(ig, length)
+i_readtiff_wiol(ig, length, page=0)
         Imager::IO     ig
               int     length
+               int     page
 
 void
 i_readtiff_multi_wiol(ig, length)

diff --git a/image.h b/image.h
index cbc929c0b187e73dc734a9d4b4c2584ad9118189..fa8814f0397150c855d107e05888e6c147713f2e 100644 (file)
--- a/image.h
+++ b/image.h
@@ -572,7 +572,7 @@ undef_int i_writejpeg_wiol(i_img *im, io_glue *ig, int qfactor);
 #endif /* HAVE_LIBJPEG */
 
 #ifdef HAVE_LIBTIFF
-i_img   * i_readtiff_wiol(io_glue *ig, int length);
+i_img   * i_readtiff_wiol(io_glue *ig, int length, int page);
 i_img  ** i_readtiff_multi_wiol(io_glue *ig, int length, int *count);
 undef_int i_writetiff_wiol(i_img *im, io_glue *ig);
 undef_int i_writetiff_multi_wiol(io_glue *ig, i_img **imgs, int count);

diff --git a/lib/Imager/Files.pod b/lib/Imager/Files.pod
index 14f5b753343fb0b07a375adf7e8f1c11c81e971b..02708f35818fbc382bceb79c39ba5192e098dcc5 100644 (file)
--- a/lib/Imager/Files.pod
+++ b/lib/Imager/Files.pod
@@ -532,6 +532,13 @@ as "YYYY:MM:DD HH:MM:SS".  These correspond directly to the mixed case
 names in the TIFF specification.  These are set in images read from a
 TIFF and saved when writing a TIFF image.
 
+You can supply a C<page> parameter to the C<read()> method to read
+some page other than the first.  The page is 0 based:
+
+  # read the second image in the file
+  $image->read(file=>"example.tif", page=>1)
+    or die "Cannot read second page: ",$image->errstr,"\n";
+
 =back
 
 =head2 BMP (BitMaP)

diff --git a/t/t106tiff.t b/t/t106tiff.t
index 984f3f82ad4ac0f5721887940e60f9c9696dd830..e58b5d51e323a412710a35c982f086dca68d60f6 100644 (file)
--- a/t/t106tiff.t
+++ b/t/t106tiff.t
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use lib 't';
-use Test::More tests => 81;
+use Test::More tests => 89;
 use Imager qw(:all);
 $^W=1; # warnings during command-line tests
 $|=1;  # give us some progress in the test harness
@@ -32,7 +32,7 @@ SKIP:
     $im = Imager->new(xsize=>2, ysize=>2);
     ok(!$im->write(file=>"testout/notiff.tif"), "should fail to write tiff");
     is($im->errstr, 'format not supported', "check no tiff message");
-    skip("no tiff support", 77);
+    skip("no tiff support", 85);
   }
 
   Imager::i_tags_add($img, "i_xres", 0, "300", 0);
@@ -337,4 +337,33 @@ SKIP:
   my ($warning) = $warned->tags(name=>'i_warning');
   ok(defined $warning && $warning =~ /unknown field with tag 28712/,
      "check that warning tag set and correct");
+
+  { # support for reading a given page
+    # first build a simple test image
+    my $im1 = Imager->new(xsize=>50, ysize=>50);
+    $im1->box(filled=>1, color=>$blue);
+    $im1->addtag(name=>'tiff_pagename', value => "Page One");
+    my $im2 = Imager->new(xsize=>60, ysize=>60);
+    $im2->box(filled=>1, color=>$green);
+    $im2->addtag(name=>'tiff_pagename', value=>"Page Two");
+
+    # read second page
+    my $page_file = 'testout/t106_pages.tif';
+    ok(Imager->write_multi({ file=> $page_file}, $im1, $im2),
+       "build simple multiimage for page tests");
+    my $imwork = Imager->new;
+    ok($imwork->read(file=>$page_file, page=>1),
+       "read second page");
+    is($im2->getwidth, $imwork->getwidth, "check width");
+    is($im2->getwidth, $imwork->getheight, "check height");
+    is(i_img_diff($imwork->{IMG}, $im2->{IMG}), 0,
+       "check image content");
+    my ($page_name) = $imwork->tags(name=>'tiff_pagename');
+    is($page_name, 'Page Two', "check tag we set");
+
+    # try an out of range page
+    ok(!$imwork->read(file=>$page_file, page=>2),
+       "check out of range page");
+    is($imwork->errstr, "could not switch to page 2", "check message");
+  }
 }

diff --git a/tiff.c b/tiff.c
index 7cc5bf4cde4bf7d9f453235f13c3f5d48180d7a6..9833cbc6a665a2c543bd68706940e0d3969e8c49 100644 (file)
--- a/tiff.c
+++ b/tiff.c
@@ -400,7 +400,7 @@ static i_img *read_one_tiff(TIFF *tif) {
 =cut
 */
 i_img*
-i_readtiff_wiol(io_glue *ig, int length) {
+i_readtiff_wiol(io_glue *ig, int length, int page) {
   TIFF* tif;
   TIFFErrorHandler old_handler;
   TIFFErrorHandler old_warn_handler;
@@ -437,6 +437,16 @@ i_readtiff_wiol(io_glue *ig, int length) {
     return NULL;
   }
 
+  if (page != 0) {
+    if (!TIFFSetDirectory(tif, page)) {
+      mm_log((1, "i_readtiff_wiol: Unable to switch to directory %d\n", page));
+      i_push_errorf(0, "could not switch to page %d", page);
+      TIFFSetErrorHandler(old_handler);
+      TIFFSetWarningHandler(old_warn_handler);
+      return NULL;
+    }
+  }
+
   im = read_one_tiff(tif);
 
   if (TIFFLastDirectory(tif)) mm_log((1, "Last directory of tiff file\n"));