From 8f8bd9aa4da9748035948b44aa8c06389117b2e9 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 19 Oct 2005 03:50:59 +0000 Subject: [PATCH] add page parameter to read() method when reading TIFF files --- Changes | 2 ++ Imager.pm | 5 ++++- Imager.xs | 3 ++- image.h | 2 +- lib/Imager/Files.pod | 7 +++++++ t/t106tiff.t | 33 +++++++++++++++++++++++++++++++-- tiff.c | 12 +++++++++++- 7 files changed, 58 insertions(+), 6 deletions(-) diff --git a/Changes b/Changes index 8f294086..2b08676d 100644 --- 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 d6995912..5a7b77a6 100644 --- 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 66939fa4..03082e14 100644 --- 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 cbc929c0..fa8814f0 100644 --- 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 14f5b753..02708f35 100644 --- 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 parameter to the C 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 984f3f82..e58b5d51 100644 --- 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 7cc5bf4c..9833cbc6 100644 --- 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")); -- 2.39.5