Graphics-TIFF-20/0000755000175000017500000000000014437671602012203 5ustar jeffjeffGraphics-TIFF-20/MANIFEST0000644000175000017500000000061314437671602013334 0ustar jeffjeffChanges MANIFEST Makefile.PL README TIFF.xs examples/tiff2pdf.pl examples/tiffinfo.pl lib/Graphics/TIFF.pm t/1.t t/2.t t/8_enums.t t/90_MANIFEST.t t/91_critic.t t/92_tiffinfo.t t/93_tiff2pdf.t t/perlcriticrc tiffperl.h typemap META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Graphics-TIFF-20/typemap0000644000175000017500000000071314436713615013606 0ustar jeffjeffTYPEMAP TIFF T_TIFF TIFF * T_PTRREF uint16_t T_IV uint32_t T_IV uint64_t T_IV tmsize_t T_IV toff_t T_IV void * T_PV INPUT T_TIFF if (sv_derived_from($arg, \"Graphics::TIFF::Image\")) { $var = INT2PTR (TIFF, SvIV ((SV*)SvRV ($arg))); } else { croak(\"$var is not of type Graphics::TIFF::Image\"); } OUTPUT T_TIFF sv_setref_pv($arg, \"TIFF\", (void*)$var); Graphics-TIFF-20/t/0000755000175000017500000000000014437671601012445 5ustar jeffjeffGraphics-TIFF-20/t/93_tiff2pdf.t0000644000175000017500000000627714437671567014700 0ustar jeffjeffuse warnings; use strict; use English; use IPC::Cmd qw(can_run); use Test::More; use Test::Requires qw( v5.10 Image::Magick ); use File::Temp; use File::Spec; ######################### if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } if ( can_run('tiff2pdf') ) { plan tests => 5; } else { plan skip_all => 'tiff2pdf not installed'; exit; } my $directory = File::Temp->newdir; my $cmd = 'PERL5LIB="blib:blib/arch:lib:$PERL5LIB" ' . "$EXECUTABLE_NAME examples/tiff2pdf.pl"; my $tif = File::Spec->catfile( $directory, 'test.tif' ); my $pdf = File::Spec->catfile( $directory, 'C.pdf' ); my $compressed_tif = File::Spec->catfile( $directory, 'comp.tif' ); my $make_reproducible = 'grep --binary-files=text -v "/ID" | grep --binary-files=text -v "/CreationDate" | grep --binary-files=text -v "/ModDate" | grep --binary-files=text -v "/Producer"'; # strip '' from around ?, which newer glibc libraries seem to have added my $expected = `tiff2pdf -? $tif 2>&1`; $expected =~ s/'\?'/?/xsm; # strip '-m' option added in tiff-4.2.0 $expected =~ s/^ -m: .*?\R//ms; # strip a description line added in libtiff 4.3.0 $expected =~ s/^Convert a TIFF image to a PDF document\R\R//sm; # adjust options introduction changed in libtiff 4.3.0 $expected =~ s/^where options are:/options:/sm; is( `$cmd -? $tif 2>&1`, $expected, '-?' ); ######################### my $image = Image::Magick->new; $image->Read('rose:'); $image->Set( density => '72x72' ); $image->Write($tif); system("tiff2pdf -d -o $pdf $tif"); $expected = `cat $pdf | $make_reproducible | hexdump`; my @expected = split "\n", $expected; my @output = split "\n", `$cmd -d $tif | $make_reproducible | hexdump`; is_deeply( \@output, \@expected, 'basic functionality' ); ######################### system("tiffcp -c lzw $tif $compressed_tif"); system("tiff2pdf -d -o $pdf $compressed_tif"); $expected = `cat $pdf | $make_reproducible | hexdump`; @expected = split "\n", $expected; @output = split "\n", `$cmd -d $compressed_tif | $make_reproducible | hexdump`; is_deeply( \@output, \@expected, 'decompress lzw' ); ######################### SKIP: { skip "tiff2pdf doesn't decompress in this case", 1; system( sprintf "convert -depth 1 -gravity center -pointsize 78 -size 500x500 caption:'Lorem ipsum etc etc' -background white -alpha off %s", $tif ); system("tiffcp -c g3 $tif $compressed_tif"); system("tiff2pdf -d -o $pdf $compressed_tif"); $expected = `cat $pdf | $make_reproducible | hexdump`; @expected = split "\n", $expected; @output = split "\n", `$cmd -d $compressed_tif | $make_reproducible | hexdump`; is_deeply( \@output, \@expected, 'decompress g3' ); } ######################### system("convert -depth 1 -size 6x2 pattern:gray50 -alpha off -define tiff:fill-order=lsb -compress group4 $compressed_tif"); system("tiff2pdf -d -o $pdf $compressed_tif"); $expected = `cat $pdf | $make_reproducible | hexdump`; @expected = split "\n", $expected; @output = split "\n", `$cmd -d $compressed_tif | $make_reproducible | hexdump`; is_deeply( \@output, \@expected, 'reverse lsb2msb' ); ######################### Graphics-TIFF-20/t/92_tiffinfo.t0000644000175000017500000000424314437671567014766 0ustar jeffjeffuse warnings; use strict; use English; use IPC::Cmd qw(can_run); use Test::More; use Test::Requires qw( v5.10 Image::Magick ); use File::Temp; use File::Spec; ######################### if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } if ( can_run('tiffinfo') ) { plan tests => 15; } else { plan skip_all => 'tiffinfo not installed'; exit; } my $directory = File::Temp->newdir; my $file = File::Spec->catfile( $directory, 'test.tif' ); my $image = Image::Magick->new; $image->Read( 'rose:', 'rose:' ); $image->Set( density => '72x72' ); $image->Write($file); my $cmd = 'PERL5LIB="blib:blib/arch:lib:$PERL5LIB" ' . "$EXECUTABLE_NAME examples/tiffinfo.pl"; is( `$cmd $file`, `tiffinfo $file`, 'basic multi-directory' ); is( `$cmd -2 $file`, `tiffinfo -2 $file`, 'dirnum' ); $image = Image::Magick->new; $image->Read('rose:'); $image->Set( density => '72x72' ); $image->Write($file); is( `$cmd -d $file`, `tiffinfo -d $file`, '-d' ); is( `$cmd -D $file`, `tiffinfo -D $file`, '-D' ); is( `$cmd -d -f lsb2msb $file`, `tiffinfo -d -f lsb2msb $file`, '-f lsb2msb' ); is( `$cmd -d -f msb2lsb $file`, `tiffinfo -d -f msb2lsb $file`, '-f msb2lsb' ); is( `$cmd -c $file`, `tiffinfo -c $file`, '-c' ); is( `$cmd -i $file`, `tiffinfo -i $file`, '-i' ); is( `$cmd -o 2 $file 2>&1`, `tiffinfo -o 2 $file 2>&1`, '-o' ); is( `$cmd -j $file`, `tiffinfo -j $file`, '-j' ); is( `$cmd -r -d $file`, `tiffinfo -r -d $file`, '-r -d' ); is( `$cmd -s -d $file`, `tiffinfo -s -d $file`, '-s -d' ); is( `$cmd -w -d $file`, `tiffinfo -w -d $file`, '-w -d' ); is( `$cmd -z -d $file`, `tiffinfo -z -d $file`, '-z -d' ); # strip '' from around ?, which newer glibc libraries seem to have added my $expected = `tiffinfo -? $file 2>&1`; $expected =~ s/'\?'/?/xsm; # strip a description line added in libtiff 4.3.0 $expected =~ s/^Display information about TIFF files\R\R//sm; # strip unsupported -M option added in libtiff 4.4.0 $expected =~ s/^ -M size\tset the memory allocation limit in MiB\. 0 to disable limit\R//sm; is( `$cmd -? $file 2>&1`, $expected, '-?' ); ######################### Graphics-TIFF-20/t/90_MANIFEST.t0000644000175000017500000000147114436713615014354 0ustar jeffjeffuse strict; use warnings; use English; use Graphics::TIFF ':all'; use Test::More tests => 2; my $git; SKIP: { skip 'Need the git repository to compare the MANIFEST.', 1 unless ( -d '.git' and eval { $git = `git ls-tree --name-status -r HEAD | grep -E -v '^\.git'`; } ); is( $git, `cat MANIFEST`, 'MANIFEST up to date' ); } local $INPUT_RECORD_SEPARATOR = undef; my $file = $INC{'Graphics/TIFF.pm'}; open my $fh, '<:encoding(UTF8)', $file or die "Error: cannot open $file\n"; my $text = <$fh>; close $fh or die "Error: cannot close $file\n"; if ( $text =~ /=head1\s+VERSION\s+([0-9][.]?[0-9]*)/xsm ) { my $version = $1; is( $version, $Graphics::TIFF::VERSION, 'version number correctly documented' ); } else { fail 'version string not found'; } Graphics-TIFF-20/t/2.t0000644000175000017500000000457014437671567013014 0ustar jeffjeffuse warnings; use strict; use Graphics::TIFF ':all'; use Test::More tests => 12; use Test::Deep; use File::Temp; use File::Spec; BEGIN { use_ok('Graphics::TIFF') } ######################### like( Graphics::TIFF->GetVersion, qr/LIBTIFF, Version/, 'version string' ); my $version = Graphics::TIFF->get_version_scalar; isnt $version, undef, 'version'; if ( $version < 4.000003 ) { plan skip_all => 'libtiff 4.0.3 or better required'; exit; } ok( Graphics::TIFF->IsCODECConfigured(COMPRESSION_DEFLATE), 'IsCODECConfigured' ); my $directory = File::Temp->newdir; ######################### my $width = 200; my $height = 200; my $depth = 1; my $resolution = 100; my $bit_per_byte = 8; # start with blank white image my @buffer; my $buffer_size = int( $width * $height / $bit_per_byte ) + ( $width * $height ) % $bit_per_byte; for my $i ( 0 .. $buffer_size - 1 ) { $buffer[$i] = 0; } my $expected = pack "C*", @buffer; # write TIFF my $file = File::Spec->catfile( $directory, 'test.tif' ); my $tif = Graphics::TIFF->Open( $file, 'w' ); $tif->SetField( TIFFTAG_IMAGEWIDTH, $width ); $tif->SetField( TIFFTAG_IMAGELENGTH, $height ); $tif->SetField( TIFFTAG_SAMPLESPERPIXEL, $depth ); $tif->SetField( TIFFTAG_BITSPERSAMPLE, $depth ); $tif->SetField( TIFFTAG_XRESOLUTION, $resolution ); $tif->SetField( TIFFTAG_YRESOLUTION, $resolution ); $tif->SetField( TIFFTAG_PHOTOMETRIC, PHOTOMETRIC_MINISWHITE ); $tif->WriteEncodedStrip( 0, $expected, length($expected) ); $tif->WriteDirectory; $tif->Close; # read TIFF $tif = Graphics::TIFF->Open( $file, 'r' ); my $stripsize = $tif->StripSize; my $example = ''; for my $i ( 0 .. $tif->NumberOfStrips - 1 ) { $example .= $tif->ReadEncodedStrip( $i, $stripsize ); } is( $example, $expected, 'buffer' ); is( $tif->GetField(TIFFTAG_IMAGEWIDTH), $width, 'IMAGEWIDTH' ); is( $tif->GetField(TIFFTAG_IMAGELENGTH), $height, 'IMAGELENGTH' ); is( $tif->GetField(TIFFTAG_SAMPLESPERPIXEL), $depth, 'SAMPLESPERPIXEL' ); is( $tif->GetField(TIFFTAG_BITSPERSAMPLE), $depth, 'BITSPERSAMPLE' ); is( $tif->GetField(TIFFTAG_XRESOLUTION), $resolution, 'XRESOLUTION' ); is( $tif->GetField(TIFFTAG_YRESOLUTION), $resolution, 'YRESOLUTION' ); is( $tif->GetField(TIFFTAG_PHOTOMETRIC), PHOTOMETRIC_MINISWHITE, 'PHOTOMETRIC' ); $tif->Close; ######################### Graphics-TIFF-20/t/8_enums.t0000644000175000017500000002170414436736726014225 0ustar jeffjeffuse Test::More tests => 153; use warnings; use strict; use Graphics::TIFF ':all'; BEGIN { use_ok('Graphics::TIFF') } ######################### ok( TIFFLIB_VERSION > 20120921, "TIFFLIB_VERSION" ); is( TIFFTAG_SUBFILETYPE, 254, "TIFFTAG_SUBFILETYPE" ); is( FILETYPE_REDUCEDIMAGE, 0x1, "FILETYPE_REDUCEDIMAGE" ); is( FILETYPE_PAGE, 0x2, "FILETYPE_PAGE" ); is( FILETYPE_MASK, 0x4, "FILETYPE_MASK" ); is( TIFFTAG_OSUBFILETYPE, 255, "TIFFTAG_OSUBFILETYPE" ); is( OFILETYPE_IMAGE, 1, "OFILETYPE_IMAGE" ); is( OFILETYPE_REDUCEDIMAGE, 2, "OFILETYPE_REDUCEDIMAGE" ); is( OFILETYPE_PAGE, 3, "OFILETYPE_PAGE" ); is( TIFFTAG_IMAGEWIDTH, 256, "TIFFTAG_IMAGEWIDTH" ); is( TIFFTAG_IMAGELENGTH, 257, "TIFFTAG_IMAGELENGTH" ); is( TIFFTAG_BITSPERSAMPLE, 258, 'TIFFTAG_BITSPERSAMPLE' ); is( TIFFTAG_COMPRESSION, 259, 'TIFFTAG_COMPRESSION' ); is( COMPRESSION_NONE, 1, 'COMPRESSION_NONE' ); is( COMPRESSION_CCITTRLE, 2, 'COMPRESSION_CCITTRLE' ); is( COMPRESSION_CCITTFAX3, 3, 'COMPRESSION_CCITTFAX3' ); is( COMPRESSION_CCITT_T4, 3, 'COMPRESSION_CCITT_T4' ); is( COMPRESSION_CCITTFAX4, 4, 'COMPRESSION_CCITTFAX4' ); is( COMPRESSION_CCITT_T6, 4, 'COMPRESSION_CCITT_T6' ); is( COMPRESSION_LZW, 5, 'COMPRESSION_LZW' ); is( COMPRESSION_OJPEG, 6, 'COMPRESSION_OJPEG' ); is( COMPRESSION_JPEG, 7, 'COMPRESSION_JPEG' ); is( COMPRESSION_T85, 9, 'COMPRESSION_T85' ); is( COMPRESSION_T43, 10, 'COMPRESSION_T43' ); is( COMPRESSION_NEXT, 32766, 'COMPRESSION_NEXT' ); is( COMPRESSION_CCITTRLEW, 32771, 'COMPRESSION_CCITTRLEW' ); is( COMPRESSION_PACKBITS, 32773, 'COMPRESSION_PACKBITS' ); is( COMPRESSION_THUNDERSCAN, 32809, 'COMPRESSION_THUNDERSCAN' ); is( COMPRESSION_IT8CTPAD, 32895, 'COMPRESSION_IT8CTPAD' ); is( COMPRESSION_IT8LW, 32896, 'COMPRESSION_IT8LW' ); is( COMPRESSION_IT8MP, 32897, 'COMPRESSION_IT8MP' ); is( COMPRESSION_IT8BL, 32898, 'COMPRESSION_IT8BL' ); is( COMPRESSION_PIXARFILM, 32908, 'COMPRESSION_PIXARFILM' ); is( COMPRESSION_PIXARLOG, 32909, 'COMPRESSION_PIXARLOG' ); is( COMPRESSION_DEFLATE, 32946, 'COMPRESSION_DEFLATE' ); is( COMPRESSION_ADOBE_DEFLATE, 8, 'COMPRESSION_ADOBE_DEFLATE' ); is( COMPRESSION_DCS, 32947, 'COMPRESSION_DCS' ); is( COMPRESSION_JBIG, 34661, 'COMPRESSION_JBIG' ); is( COMPRESSION_SGILOG, 34676, 'COMPRESSION_SGILOG' ); is( COMPRESSION_SGILOG24, 34677, 'COMPRESSION_SGILOG24' ); is( COMPRESSION_JP2000, 34712, 'COMPRESSION_JP2000' ); is( COMPRESSION_LZMA, 34925, 'COMPRESSION_LZMA' ); is( TIFFTAG_PHOTOMETRIC, 262, 'TIFFTAG_PHOTOMETRIC' ); is( PHOTOMETRIC_MINISWHITE, 0, 'PHOTOMETRIC_MINISWHITE' ); is( PHOTOMETRIC_MINISBLACK, 1, 'PHOTOMETRIC_MINISBLACK' ); is( PHOTOMETRIC_RGB, 2, 'PHOTOMETRIC_RGB' ); is( PHOTOMETRIC_PALETTE, 3, 'PHOTOMETRIC_PALETTE' ); is( PHOTOMETRIC_MASK, 4, 'PHOTOMETRIC_MASK' ); is( PHOTOMETRIC_SEPARATED, 5, 'PHOTOMETRIC_SEPARATED' ); is( PHOTOMETRIC_YCBCR, 6, 'PHOTOMETRIC_YCBCR' ); is( PHOTOMETRIC_CIELAB, 8, 'PHOTOMETRIC_CIELAB' ); is( PHOTOMETRIC_ICCLAB, 9, 'PHOTOMETRIC_ICCLAB' ); is( PHOTOMETRIC_ITULAB, 10, 'PHOTOMETRIC_ITULAB' ); is( PHOTOMETRIC_LOGL, 32844, 'PHOTOMETRIC_LOGL' ); is( PHOTOMETRIC_LOGLUV, 32845, 'PHOTOMETRIC_LOGLUV' ); is( TIFFTAG_FILLORDER, 266, "TIFFTAG_FILLORDER" ); is( FILLORDER_MSB2LSB, 1, "FILLORDER_MSB2LSB" ); is( FILLORDER_LSB2MSB, 2, "FILLORDER_LSB2MSB" ); is( TIFFTAG_DOCUMENTNAME, 269, 'TIFFTAG_DOCUMENTNAME' ); is( TIFFTAG_IMAGEDESCRIPTION, 270, 'TIFFTAG_IMAGEDESCRIPTION' ); is( TIFFTAG_STRIPOFFSETS, 273, 'TIFFTAG_STRIPOFFSETS' ); is( TIFFTAG_ORIENTATION, 274, 'TIFFTAG_ORIENTATION' ); is( ORIENTATION_TOPLEFT, 1, 'ORIENTATION_TOPLEFT' ); is( ORIENTATION_TOPRIGHT, 2, 'ORIENTATION_TOPRIGHT' ); is( ORIENTATION_BOTRIGHT, 3, 'ORIENTATION_BOTRIGHT' ); is( ORIENTATION_BOTLEFT, 4, 'ORIENTATION_BOTLEFT' ); is( ORIENTATION_LEFTTOP, 5, 'ORIENTATION_LEFTTOP' ); is( ORIENTATION_RIGHTTOP, 6, 'ORIENTATION_RIGHTTOP' ); is( ORIENTATION_RIGHTBOT, 7, 'ORIENTATION_RIGHTBOT' ); is( ORIENTATION_LEFTBOT, 8, 'ORIENTATION_LEFTBOT' ); is( TIFFTAG_SAMPLESPERPIXEL, 277, 'TIFFTAG_SAMPLESPERPIXEL' ); is( TIFFTAG_ROWSPERSTRIP, 278, "TIFFTAG_ROWSPERSTRIP" ); is( TIFFTAG_STRIPBYTECOUNTS, 279, "TIFFTAG_STRIPBYTECOUNTS" ); is( TIFFTAG_XRESOLUTION, 282, "TIFFTAG_XRESOLUTION" ); is( TIFFTAG_YRESOLUTION, 283, "TIFFTAG_YRESOLUTION" ); is( TIFFTAG_XPOSITION, 286, "TIFFTAG_XPOSITION" ); is( TIFFTAG_YPOSITION, 287, "TIFFTAG_YPOSITION" ); is( TIFFTAG_PLANARCONFIG, 284, "TIFFTAG_PLANARCONFIG" ); is( PLANARCONFIG_CONTIG, 1, "PLANARCONFIG_CONTIG" ); is( PLANARCONFIG_SEPARATE, 2, "PLANARCONFIG_SEPARATE" ); is( TIFFTAG_GROUP3OPTIONS, 292, 'TIFFTAG_GROUP3OPTIONS' ); is( TIFFTAG_T4OPTIONS, 292, 'TIFFTAG_T4OPTIONS' ); is( GROUP3OPT_2DENCODING, 0x1, 'GROUP3OPT_2DENCODING' ); is( GROUP3OPT_UNCOMPRESSED, 0x2, 'GROUP3OPT_UNCOMPRESSED' ); is( GROUP3OPT_FILLBITS, 0x4, 'GROUP3OPT_FILLBITS' ); is( TIFFTAG_GROUP4OPTIONS, 293, 'TIFFTAG_GROUP4OPTIONS' ); is( TIFFTAG_T6OPTIONS, 293, 'TIFFTAG_T6OPTIONS' ); is( GROUP4OPT_UNCOMPRESSED, 0x2, 'GROUP4OPT_UNCOMPRESSED' ); is( TIFFTAG_RESOLUTIONUNIT, 296, 'TIFFTAG_RESOLUTIONUNIT' ); is( RESUNIT_NONE, 1, 'RESUNIT_NONE' ); is( RESUNIT_INCH, 2, 'RESUNIT_INCH' ); is( RESUNIT_CENTIMETER, 3, 'RESUNIT_CENTIMETER' ); is( TIFFTAG_PAGENUMBER, 297, "TIFFTAG_PAGENUMBER" ); is( TIFFTAG_TRANSFERFUNCTION, 301, 'TIFFTAG_TRANSFERFUNCTION' ); is( TIFFTAG_SOFTWARE, 305, 'TIFFTAG_SOFTWARE' ); is( TIFFTAG_DATETIME, 306, 'TIFFTAG_DATETIME' ); is( TIFFTAG_ARTIST, 315, 'TIFFTAG_ARTIST' ); is( TIFFTAG_PREDICTOR, 317, 'TIFFTAG_PREDICTOR' ); is( PREDICTOR_NONE, 1, 'PREDICTOR_NONE' ); is( PREDICTOR_HORIZONTAL, 2, 'PREDICTOR_HORIZONTAL' ); is( PREDICTOR_FLOATINGPOINT, 3, 'PREDICTOR_FLOATINGPOINT' ); is( TIFFTAG_WHITEPOINT, 318, 'TIFFTAG_WHITEPOINT' ); is( TIFFTAG_PRIMARYCHROMATICITIES, 319, 'TIFFTAG_PRIMARYCHROMATICITIES' ); is( TIFFTAG_COLORMAP, 320, 'TIFFTAG_COLORMAP' ); is( TIFFTAG_TILEWIDTH, 322, 'TIFFTAG_TILEWIDTH' ); is( TIFFTAG_TILELENGTH, 323, 'TIFFTAG_TILELENGTH' ); is( TIFFTAG_INKSET, 332, 'TIFFTAG_INKSET' ); is( INKSET_CMYK, 1, 'INKSET_CMYK' ); is( INKSET_MULTIINK, 2, 'INKSET_MULTIINK' ); is( TIFFTAG_EXTRASAMPLES, 338, 'TIFFTAG_EXTRASAMPLES' ); is( EXTRASAMPLE_UNSPECIFIED, 0, 'EXTRASAMPLES_UNSPECIFIED' ); is( EXTRASAMPLE_ASSOCALPHA, 1, 'EXTRASAMPLES_ASSOCALPHA' ); is( EXTRASAMPLE_UNASSALPHA, 2, 'EXTRASAMPLES_UNASSALPHA' ); is( TIFFTAG_SAMPLEFORMAT, 339, 'TIFFTAG_SAMPLEFORMAT' ); is( SAMPLEFORMAT_UINT, 1, 'SAMPLEFORMAT_UINT' ); is( SAMPLEFORMAT_INT, 2, 'SAMPLEFORMAT_INT' ); is( SAMPLEFORMAT_IEEEFP, 3, 'SAMPLEFORMAT_IEEEFP' ); is( SAMPLEFORMAT_VOID, 4, 'SAMPLEFORMAT_VOID' ); is( SAMPLEFORMAT_COMPLEXINT, 5, 'SAMPLEFORMAT_COMPLEXINT' ); is( SAMPLEFORMAT_COMPLEXIEEEFP, 6, 'SAMPLEFORMAT_COMPLEXIEEEFP' ); is( TIFFTAG_INDEXED, 346, 'TIFFTAG_INDEXED' ); is( TIFFTAG_JPEGTABLES, 347, 'TIFFTAG_JPEGTABLES' ); is( TIFFTAG_JPEGPROC, 512, 'TIFFTAG_JPEGPROC' ); is( JPEGPROC_BASELINE, 1, 'JPEGPROC_BASELINE' ); is( JPEGPROC_LOSSLESS, 14, 'JPEGPROC_LOSSLESS' ); is( TIFFTAG_JPEGIFOFFSET, 513, 'TIFFTAG_JPEGIFOFFSET' ); is( TIFFTAG_JPEGIFBYTECOUNT, 514, 'TIFFTAG_JPEGIFBYTECOUNT' ); is( TIFFTAG_JPEGLOSSLESSPREDICTORS, 517, 'TIFFTAG_JPEGLOSSLESSPREDICTORS' ); is( TIFFTAG_JPEGPOINTTRANSFORM, 518, 'TIFFTAG_JPEGPOINTTRANSFORM' ); is( TIFFTAG_JPEGQTABLES, 519, 'TIFFTAG_JPEGQTABLES' ); is( TIFFTAG_JPEGDCTABLES, 520, 'TIFFTAG_JPEGDCTABLES' ); is( TIFFTAG_JPEGACTABLES, 521, 'TIFFTAG_JPEGACTABLES' ); is( TIFFTAG_YCBCRSUBSAMPLING, 530, 'TIFFTAG_YCBCRSUBSAMPLING' ); is( TIFFTAG_REFERENCEBLACKWHITE, 532, 'TIFFTAG_REFERENCEBLACKWHITE' ); is( TIFFTAG_OPIIMAGEID, 32781, 'TIFFTAG_OPIIMAGEID' ); is( TIFFTAG_COPYRIGHT, 33432, 'TIFFTAG_COPYRIGHT' ); is( TIFFTAG_EXIFIFD, 34665, "TIFFTAG_EXIFIFD" ); is( TIFFTAG_ICCPROFILE, 34675, 'TIFFTAG_ICCPROFILE' ); is( TIFFTAG_JPEGQUALITY, 65537, 'TIFFTAG_JPEGQUALITY' ); is( TIFFTAG_JPEGCOLORMODE, 65538, 'TIFFTAG_JPEGCOLORMODE' ); is( JPEGCOLORMODE_RAW, 0x0000, 'JPEGCOLORMODE_RAW' ); is( JPEGCOLORMODE_RGB, 0x0001, 'JPEGCOLORMODE_RGB' ); is( TIFFTAG_JPEGTABLESMODE, 65539, 'TIFFTAG_JPEGTABLESMODE' ); is( JPEGTABLESMODE_QUANT, 0x0001, 'JPEGTABLESMODE_QUANT' ); is( JPEGTABLESMODE_HUFF, 0x0002, 'JPEGTABLESMODE_HUFF' ); is( TIFFTAG_ZIPQUALITY, 65557, 'TIFFTAG_ZIPQUALITY' ); is( TIFFPRINT_STRIPS, 1, "TIFFPRINT_STRIPS" ); is( TIFFPRINT_CURVES, 2, "TIFFPRINT_CURVES" ); is( TIFFPRINT_COLORMAP, 4, "TIFFPRINT_COLORMAP" ); is( TIFFPRINT_JPEGQTABLES, 0x100, "TIFFPRINT_JPEGQTABLES" ); is( TIFFPRINT_JPEGACTABLES, 0x200, "TIFFPRINT_JPEGACTABLES" ); is( TIFFPRINT_JPEGDCTABLES, 0x200, "TIFFPRINT_JPEGDCTABLES" ); Graphics-TIFF-20/t/1.t0000644000175000017500000001542114437671567013010 0ustar jeffjeffuse warnings; use strict; use Graphics::TIFF ':all'; use Test::More tests => 50; use Test::Deep; use IPC::Cmd qw(can_run); use Test::Requires qw( Image::Magick ); use File::Temp; use File::Spec; use English; BEGIN { use_ok('Graphics::TIFF') } ######################### like( Graphics::TIFF->GetVersion, qr/LIBTIFF, Version/, 'version string' ); my $version = Graphics::TIFF->get_version_scalar; isnt $version, undef, 'version'; if ( $version < 4.000003 ) { plan skip_all => 'libtiff 4.0.3 or better required'; exit; } ok( Graphics::TIFF->IsCODECConfigured(COMPRESSION_DEFLATE), 'IsCODECConfigured' ); my $directory = File::Temp->newdir; my $image = Image::Magick->new; my $file = File::Spec->catfile( $directory, 'test.tif' ); $image->Read('rose:'); $image->Set( density => '72x72' ); $image->Write($file); my $tif = Graphics::TIFF->Open( $file, 'r' ); is( $tif->FileName, $file, 'FileName' ); isa_ok $tif, 'Graphics::TIFF'; can_ok $tif, qw(Close ReadDirectory ReadEXIFDirectory GetField); is( $tif->ReadDirectory, 0, 'ReadDirectory' ); SKIP: { skip "Don't know how to create TIFF with EXIF on the fly, " . 'and reading an empty one crashes some implementations', 1; is( $tif->ReadEXIFDirectory(0), 0, 'ReadEXIFDirectory' ); } is( $tif->NumberOfDirectories, 1, 'NumberOfDirectories' ); is( $tif->SetDirectory(0), 1, 'SetDirectory' ); is( $tif->SetSubDirectory(0), 0, 'SetSubDirectory' ); is( $tif->GetField(TIFFTAG_FILLORDER), FILLORDER_MSB2LSB, 'GetField uint16' ); is( $tif->GetField(TIFFTAG_XRESOLUTION), 72, 'GetField float' ); my @counts = $tif->GetField(TIFFTAG_PAGENUMBER); is_deeply( \@counts, [ 0, 1 ], 'GetField 2 uint16' ); @counts = $tif->GetField(TIFFTAG_STRIPBYTECOUNTS); is_deeply( \@counts, [ 8190, 1470 ], 'GetField array of uint64' ); is( $tif->GetField(TIFFTAG_IMAGEWIDTH), 70, 'GetField uint32' ); @counts = $tif->GetField(TIFFTAG_PRIMARYCHROMATICITIES); my @expected = ( 0.639999985694885, 0.330000013113022, 0.300000011920929, 0.600000023841858, 0.150000005960464, 0.0599999986588955 ); for my $i ( 0 .. $#expected ) { cmp_deeply( $counts[$i], num( $expected[$i], 0.0001 ), 'GetField TIFFTAG_PRIMARYCHROMATICITIES (array of float)' ); } @counts = $tif->GetField(TIFFTAG_WHITEPOINT); @expected = ( 0.312700003385544, 0.328999996185303 ); for my $i ( 0 .. $#expected ) { cmp_deeply( $counts[$i], num( $expected[$i], 0.0001 ), 'GetField TIFFTAG_WHITEPOINT (array of float)' ); } is( $tif->GetFieldDefaulted(TIFFTAG_FILLORDER), FILLORDER_MSB2LSB, 'GetFieldDefaulted uint16' ); is( $tif->SetField( TIFFTAG_FILLORDER, FILLORDER_LSB2MSB ), 1, 'SetField status' ); is( $tif->GetField(TIFFTAG_FILLORDER), FILLORDER_LSB2MSB, 'SetField result' ); $tif->SetField( TIFFTAG_FILLORDER, FILLORDER_MSB2LSB ); # reset is( $tif->IsTiled, 0, 'IsTiled' ); is( $tif->ScanlineSize, 210, 'ScanlineSize' ); is( $tif->StripSize, 8190, 'StripSize' ); is( $tif->NumberOfStrips, 2, 'NumberOfStrips' ); is( $tif->TileSize, 8190, 'TileSize' ); is( $tif->TileRowSize, 210, 'TileRowSize' ); is( $tif->ComputeStrip( 16, 0 ), 0, 'ComputeStrip' ); is( length( $tif->ReadEncodedStrip( 0, 8190 ) ), 8190, 'ReadEncodedStrip full strip' ); is( length( $tif->ReadEncodedStrip( 1, 8190 ) ), 1470, 'ReadEncodedStrip part strip' ); is( length( $tif->ReadRawStrip( 1, 20 ) ), 20, 'ReadRawStrip' ); my $position_defined = defined $tif->GetField(TIFFTAG_XPOSITION) && defined $tif->GetField(TIFFTAG_YPOSITION); my $filename = File::Spec->catfile( $directory, 'out.txt' ); open my $fh, '>', $filename; $tif->PrintDirectory( $fh, 0 ); $tif->Close; close $fh; is( -s $filename, $position_defined ? 466 : 449, 'PrintDirectory' ); unlink $filename; ######################### SKIP: { skip 'tiffcmp not installed', 1 if ( not can_run('tiffcmp') ); my $tif = Graphics::TIFF->Open( $file, 'r' ); my $file2 = File::Spec->catfile($directory, 'test2.tif'); my $out = Graphics::TIFF->Open( $file2, 'w' ); for my $tag ( ( TIFFTAG_IMAGEWIDTH, TIFFTAG_IMAGELENGTH, TIFFTAG_SAMPLESPERPIXEL, TIFFTAG_BITSPERSAMPLE, TIFFTAG_ORIENTATION, TIFFTAG_PLANARCONFIG, TIFFTAG_PAGENUMBER, TIFFTAG_PHOTOMETRIC, TIFFTAG_ROWSPERSTRIP, TIFFTAG_FILLORDER, TIFFTAG_RESOLUTIONUNIT, TIFFTAG_XRESOLUTION, TIFFTAG_YRESOLUTION, TIFFTAG_XPOSITION, TIFFTAG_YPOSITION ) ) { my @values = $tif->GetField($tag); if (@values) { $out->SetField( $tag, @values ); } } my $stripsize = $tif->StripSize; for my $stripnum ( 0 .. $tif->NumberOfStrips - 1 ) { my $buffer = $tif->ReadEncodedStrip( $stripnum, $stripsize ); $out->WriteEncodedStrip( $stripnum, $buffer, length($buffer) ); } $out->WriteDirectory; $tif->Close; $out->Close; is( `tiffcmp $file $file2`, '', 'tiffcmp' ); } ######################### $image = Image::Magick->new; $image->Read('rose:'); $image->Set( density => '72x72', alpha => 'Set' ); $image->Write($file); $tif = Graphics::TIFF->Open( $file, 'r' ); my @values = $tif->GetField(TIFFTAG_EXTRASAMPLES); is_deeply( \@values, [EXTRASAMPLE_UNASSALPHA], 'GetField TIFFTAG_EXTRASAMPLES' ); @values = $tif->GetFieldDefaulted(TIFFTAG_EXTRASAMPLES); is_deeply( \@values, [EXTRASAMPLE_UNASSALPHA], 'GetFieldDefaulted TIFFTAG_EXTRASAMPLES' ); $tif->Close; ######################### $image = Image::Magick->new; $image->Read('rose:'); $image->Set( density => '72x72', type => 'palette', depth => 2 ); $image->Write($file); $tif = Graphics::TIFF->Open( $file, 'r' ); @values = $tif->GetField(TIFFTAG_COLORMAP); is $#{ $values[0] }, 255, 'GetField TIFFTAG_COLORMAP r'; is $#{ $values[1] }, 255, 'GetField TIFFTAG_COLORMAP g'; is $#{ $values[2] }, 255, 'GetField TIFFTAG_COLORMAP b'; @values = $tif->GetFieldDefaulted(TIFFTAG_COLORMAP); is $#{ $values[0] }, 255, 'GetFieldDefaulted TIFFTAG_COLORMAP r'; is $#{ $values[1] }, 255, 'GetFieldDefaulted TIFFTAG_COLORMAP g'; is $#{ $values[2] }, 255, 'GetFieldDefaulted TIFFTAG_COLORMAP b'; $tif->Close; ######################### my $convert; if ( can_run('magick') ) { $convert = 'magick convert'; } elsif ( $OSNAME ne 'MSWin32' and can_run('convert') ) { $convert = 'convert'; } SKIP: { skip 'convert not installed', 2 if ( not $convert ); system "$convert rose: -define tiff:predictor=2 -compress lzw $file"; $tif = Graphics::TIFF->Open( $file, 'r' ); is $tif->GetField(TIFFTAG_PREDICTOR), PREDICTOR_HORIZONTAL, 'GetField TIFFTAG_PREDICTOR'; $tif->Close; ######################### system "$convert rose: -define tiff:tile-geometry=256x256 $file"; $tif = Graphics::TIFF->Open( $file, 'r' ); is( length( $tif->ReadTile( 0, 0, 0, 0 ) ), 196608, 'ReadTile' ); $tif->Close; } Graphics-TIFF-20/t/perlcriticrc0000644000175000017500000000143214436713615015056 0ustar jeffjeffseverity = 1 [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 3 [ValuesAndExpressions::ProhibitInterpolationOfLiterals] allow_if_string_contains_single_quote = 1 [Documentation::PodSpelling] stop_words = API BitsPerSample bitwise boolean buf CheckpointDirectory dirnum diroff EXIF fd FillOrder filename GetField ImageLength LIBTIFF libtiff NumberOfTiles NumberOfStrips Perlish Ratcliffe ReadDirectory ReadEncodedStrip ReadScanline ReadTile RewriteDirectory RowsPerStrip Runtime runtime SetDirectory StripSize subdirectories subfile subfiles SubIFD TIFFTileSize TIFFWriteDirectory TIFFWriteEncodedStrip tif WriteDirectory WriteEncodedStrip WriteScanline WriteTile [InputOutput::RequireCheckedSyscalls] functions = :defaults exclude_functions = print Graphics-TIFF-20/t/91_critic.t0000644000175000017500000000075214436713615014425 0ustar jeffjeffuse strict; use warnings; use File::Spec; use Test::More; if ( not $ENV{TEST_AUTHOR} ) { my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.'; plan( skip_all => $msg ); } if ( not eval { require Test::Perl::Critic; } ) { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); } my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile ); all_critic_ok( 'examples', 'lib' ); Graphics-TIFF-20/TIFF.xs0000644000175000017500000006664514436736726013340 0ustar jeffjeff#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include #include MODULE = Graphics::TIFF PACKAGE = Graphics::TIFF PREFIX = tiff_ PROTOTYPES: ENABLE BOOT: HV *stash; stash = gv_stashpv("Graphics::TIFF", TRUE); newCONSTSUB(stash, "TIFFLIB_VERSION", newSViv(TIFFLIB_VERSION)); newCONSTSUB(stash, "TIFFTAG_SUBFILETYPE", newSViv(TIFFTAG_SUBFILETYPE)); newCONSTSUB(stash, "FILETYPE_REDUCEDIMAGE", newSViv(FILETYPE_REDUCEDIMAGE)); newCONSTSUB(stash, "FILETYPE_PAGE", newSViv(FILETYPE_PAGE)); newCONSTSUB(stash, "FILETYPE_MASK", newSViv(FILETYPE_MASK)); newCONSTSUB(stash, "TIFFTAG_OSUBFILETYPE", newSViv(TIFFTAG_OSUBFILETYPE)); newCONSTSUB(stash, "OFILETYPE_IMAGE", newSViv(OFILETYPE_IMAGE)); newCONSTSUB(stash, "OFILETYPE_REDUCEDIMAGE", newSViv(OFILETYPE_REDUCEDIMAGE)); newCONSTSUB(stash, "OFILETYPE_PAGE", newSViv(OFILETYPE_PAGE)); newCONSTSUB(stash, "TIFFTAG_IMAGEWIDTH", newSViv(TIFFTAG_IMAGEWIDTH)); newCONSTSUB(stash, "TIFFTAG_IMAGELENGTH", newSViv(TIFFTAG_IMAGELENGTH)); newCONSTSUB(stash, "TIFFTAG_BITSPERSAMPLE", newSViv(TIFFTAG_BITSPERSAMPLE)); newCONSTSUB(stash, "TIFFTAG_COMPRESSION", newSViv(TIFFTAG_COMPRESSION)); newCONSTSUB(stash, "COMPRESSION_NONE", newSViv(COMPRESSION_NONE)); newCONSTSUB(stash, "COMPRESSION_CCITTRLE", newSViv(COMPRESSION_CCITTRLE)); newCONSTSUB(stash, "COMPRESSION_CCITTFAX3", newSViv(COMPRESSION_CCITTFAX3)); newCONSTSUB(stash, "COMPRESSION_CCITT_T4", newSViv(COMPRESSION_CCITT_T4)); newCONSTSUB(stash, "COMPRESSION_CCITTFAX4", newSViv(COMPRESSION_CCITTFAX4)); newCONSTSUB(stash, "COMPRESSION_CCITT_T6", newSViv(COMPRESSION_CCITT_T6)); newCONSTSUB(stash, "COMPRESSION_LZW", newSViv(COMPRESSION_LZW)); newCONSTSUB(stash, "COMPRESSION_OJPEG", newSViv(COMPRESSION_OJPEG)); newCONSTSUB(stash, "COMPRESSION_JPEG", newSViv(COMPRESSION_JPEG)); newCONSTSUB(stash, "COMPRESSION_T85", newSViv(COMPRESSION_T85)); newCONSTSUB(stash, "COMPRESSION_T43", newSViv(COMPRESSION_T43)); newCONSTSUB(stash, "COMPRESSION_NEXT", newSViv(COMPRESSION_NEXT)); newCONSTSUB(stash, "COMPRESSION_CCITTRLEW", newSViv(COMPRESSION_CCITTRLEW)); newCONSTSUB(stash, "COMPRESSION_PACKBITS", newSViv(COMPRESSION_PACKBITS)); newCONSTSUB(stash, "COMPRESSION_THUNDERSCAN", newSViv(COMPRESSION_THUNDERSCAN)); newCONSTSUB(stash, "COMPRESSION_IT8CTPAD", newSViv(COMPRESSION_IT8CTPAD)); newCONSTSUB(stash, "COMPRESSION_IT8LW", newSViv(COMPRESSION_IT8LW)); newCONSTSUB(stash, "COMPRESSION_IT8MP", newSViv(COMPRESSION_IT8MP)); newCONSTSUB(stash, "COMPRESSION_IT8BL", newSViv(COMPRESSION_IT8BL)); newCONSTSUB(stash, "COMPRESSION_PIXARFILM", newSViv(COMPRESSION_PIXARFILM)); newCONSTSUB(stash, "COMPRESSION_PIXARLOG", newSViv(COMPRESSION_PIXARLOG)); newCONSTSUB(stash, "COMPRESSION_DEFLATE", newSViv(COMPRESSION_DEFLATE)); newCONSTSUB(stash, "COMPRESSION_ADOBE_DEFLATE", newSViv(COMPRESSION_ADOBE_DEFLATE)); newCONSTSUB(stash, "COMPRESSION_DCS", newSViv(COMPRESSION_DCS)); newCONSTSUB(stash, "COMPRESSION_JBIG", newSViv(COMPRESSION_JBIG)); newCONSTSUB(stash, "COMPRESSION_SGILOG", newSViv(COMPRESSION_SGILOG)); newCONSTSUB(stash, "COMPRESSION_SGILOG24", newSViv(COMPRESSION_SGILOG24)); newCONSTSUB(stash, "COMPRESSION_JP2000", newSViv(COMPRESSION_JP2000)); newCONSTSUB(stash, "COMPRESSION_LZMA", newSViv(COMPRESSION_LZMA)); newCONSTSUB(stash, "TIFFTAG_PHOTOMETRIC", newSViv(TIFFTAG_PHOTOMETRIC)); newCONSTSUB(stash, "PHOTOMETRIC_MINISWHITE", newSViv(PHOTOMETRIC_MINISWHITE)); newCONSTSUB(stash, "PHOTOMETRIC_MINISBLACK", newSViv(PHOTOMETRIC_MINISBLACK)); newCONSTSUB(stash, "PHOTOMETRIC_RGB", newSViv(PHOTOMETRIC_RGB)); newCONSTSUB(stash, "PHOTOMETRIC_PALETTE", newSViv(PHOTOMETRIC_PALETTE)); newCONSTSUB(stash, "PHOTOMETRIC_MASK", newSViv(PHOTOMETRIC_MASK)); newCONSTSUB(stash, "PHOTOMETRIC_SEPARATED", newSViv(PHOTOMETRIC_SEPARATED)); newCONSTSUB(stash, "PHOTOMETRIC_YCBCR", newSViv(PHOTOMETRIC_YCBCR)); newCONSTSUB(stash, "PHOTOMETRIC_CIELAB", newSViv(PHOTOMETRIC_CIELAB)); newCONSTSUB(stash, "PHOTOMETRIC_ICCLAB", newSViv(PHOTOMETRIC_ICCLAB)); newCONSTSUB(stash, "PHOTOMETRIC_ITULAB", newSViv(PHOTOMETRIC_ITULAB)); newCONSTSUB(stash, "PHOTOMETRIC_LOGL", newSViv(PHOTOMETRIC_LOGL)); newCONSTSUB(stash, "PHOTOMETRIC_LOGLUV", newSViv(PHOTOMETRIC_LOGLUV)); newCONSTSUB(stash, "TIFFTAG_FILLORDER", newSViv(TIFFTAG_FILLORDER)); newCONSTSUB(stash, "FILLORDER_MSB2LSB", newSViv(FILLORDER_MSB2LSB)); newCONSTSUB(stash, "FILLORDER_LSB2MSB", newSViv(FILLORDER_LSB2MSB)); newCONSTSUB(stash, "TIFFTAG_DOCUMENTNAME", newSViv(TIFFTAG_DOCUMENTNAME)); newCONSTSUB(stash, "TIFFTAG_IMAGEDESCRIPTION", newSViv(TIFFTAG_IMAGEDESCRIPTION)); newCONSTSUB(stash, "TIFFTAG_STRIPOFFSETS", newSViv(TIFFTAG_STRIPOFFSETS)); newCONSTSUB(stash, "TIFFTAG_ORIENTATION", newSViv(TIFFTAG_ORIENTATION)); newCONSTSUB(stash, "ORIENTATION_TOPLEFT", newSViv(ORIENTATION_TOPLEFT)); newCONSTSUB(stash, "ORIENTATION_TOPRIGHT", newSViv(ORIENTATION_TOPRIGHT)); newCONSTSUB(stash, "ORIENTATION_BOTRIGHT", newSViv(ORIENTATION_BOTRIGHT)); newCONSTSUB(stash, "ORIENTATION_BOTLEFT", newSViv(ORIENTATION_BOTLEFT)); newCONSTSUB(stash, "ORIENTATION_LEFTTOP", newSViv(ORIENTATION_LEFTTOP)); newCONSTSUB(stash, "ORIENTATION_RIGHTTOP", newSViv(ORIENTATION_RIGHTTOP)); newCONSTSUB(stash, "ORIENTATION_RIGHTBOT", newSViv(ORIENTATION_RIGHTBOT)); newCONSTSUB(stash, "ORIENTATION_LEFTBOT", newSViv(ORIENTATION_LEFTBOT)); newCONSTSUB(stash, "TIFFTAG_SAMPLESPERPIXEL", newSViv(TIFFTAG_SAMPLESPERPIXEL)); newCONSTSUB(stash, "TIFFTAG_ROWSPERSTRIP", newSViv(TIFFTAG_ROWSPERSTRIP)); newCONSTSUB(stash, "TIFFTAG_STRIPBYTECOUNTS", newSViv(TIFFTAG_STRIPBYTECOUNTS)); newCONSTSUB(stash, "TIFFTAG_XRESOLUTION", newSViv(TIFFTAG_XRESOLUTION)); newCONSTSUB(stash, "TIFFTAG_YRESOLUTION", newSViv(TIFFTAG_YRESOLUTION)); newCONSTSUB(stash, "TIFFTAG_XPOSITION", newSViv(TIFFTAG_XPOSITION)); newCONSTSUB(stash, "TIFFTAG_YPOSITION", newSViv(TIFFTAG_YPOSITION)); newCONSTSUB(stash, "TIFFTAG_PLANARCONFIG", newSViv(TIFFTAG_PLANARCONFIG)); newCONSTSUB(stash, "PLANARCONFIG_CONTIG", newSViv(PLANARCONFIG_CONTIG)); newCONSTSUB(stash, "PLANARCONFIG_SEPARATE", newSViv(PLANARCONFIG_SEPARATE)); newCONSTSUB(stash, "TIFFTAG_GROUP3OPTIONS", newSViv(TIFFTAG_GROUP3OPTIONS)); newCONSTSUB(stash, "TIFFTAG_T4OPTIONS", newSViv(TIFFTAG_T4OPTIONS)); newCONSTSUB(stash, "GROUP3OPT_2DENCODING", newSViv(GROUP3OPT_2DENCODING)); newCONSTSUB(stash, "GROUP3OPT_UNCOMPRESSED", newSViv(GROUP3OPT_UNCOMPRESSED)); newCONSTSUB(stash, "GROUP3OPT_FILLBITS", newSViv(GROUP3OPT_FILLBITS)); newCONSTSUB(stash, "TIFFTAG_GROUP4OPTIONS", newSViv(TIFFTAG_GROUP4OPTIONS)); newCONSTSUB(stash, "TIFFTAG_T6OPTIONS", newSViv(TIFFTAG_T6OPTIONS)); newCONSTSUB(stash, "GROUP4OPT_UNCOMPRESSED", newSViv(GROUP4OPT_UNCOMPRESSED)); newCONSTSUB(stash, "TIFFTAG_RESOLUTIONUNIT", newSViv(TIFFTAG_RESOLUTIONUNIT)); newCONSTSUB(stash, "RESUNIT_NONE", newSViv(RESUNIT_NONE)); newCONSTSUB(stash, "RESUNIT_INCH", newSViv(RESUNIT_INCH)); newCONSTSUB(stash, "RESUNIT_CENTIMETER", newSViv(RESUNIT_CENTIMETER)); newCONSTSUB(stash, "TIFFTAG_PAGENUMBER", newSViv(TIFFTAG_PAGENUMBER)); newCONSTSUB(stash, "TIFFTAG_TRANSFERFUNCTION", newSViv(TIFFTAG_TRANSFERFUNCTION)); newCONSTSUB(stash, "TIFFTAG_SOFTWARE", newSViv(TIFFTAG_SOFTWARE)); newCONSTSUB(stash, "TIFFTAG_DATETIME", newSViv(TIFFTAG_DATETIME)); newCONSTSUB(stash, "TIFFTAG_ARTIST", newSViv(TIFFTAG_ARTIST)); newCONSTSUB(stash, "TIFFTAG_PREDICTOR", newSViv(TIFFTAG_PREDICTOR)); newCONSTSUB(stash, "PREDICTOR_NONE", newSViv(PREDICTOR_NONE)); newCONSTSUB(stash, "PREDICTOR_HORIZONTAL", newSViv(PREDICTOR_HORIZONTAL)); newCONSTSUB(stash, "PREDICTOR_FLOATINGPOINT", newSViv(PREDICTOR_FLOATINGPOINT)); newCONSTSUB(stash, "TIFFTAG_WHITEPOINT", newSViv(TIFFTAG_WHITEPOINT)); newCONSTSUB(stash, "TIFFTAG_PRIMARYCHROMATICITIES", newSViv(TIFFTAG_PRIMARYCHROMATICITIES)); newCONSTSUB(stash, "TIFFTAG_COLORMAP", newSViv(TIFFTAG_COLORMAP)); newCONSTSUB(stash, "TIFFTAG_TILEWIDTH", newSViv(TIFFTAG_TILEWIDTH)); newCONSTSUB(stash, "TIFFTAG_TILELENGTH", newSViv(TIFFTAG_TILELENGTH)); newCONSTSUB(stash, "TIFFTAG_INKSET", newSViv(TIFFTAG_INKSET)); newCONSTSUB(stash, "INKSET_CMYK", newSViv(INKSET_CMYK)); newCONSTSUB(stash, "INKSET_MULTIINK", newSViv(INKSET_MULTIINK)); newCONSTSUB(stash, "TIFFTAG_EXTRASAMPLES", newSViv(TIFFTAG_EXTRASAMPLES)); newCONSTSUB(stash, "EXTRASAMPLE_UNSPECIFIED", newSViv(EXTRASAMPLE_UNSPECIFIED)); newCONSTSUB(stash, "EXTRASAMPLE_ASSOCALPHA", newSViv(EXTRASAMPLE_ASSOCALPHA)); newCONSTSUB(stash, "EXTRASAMPLE_UNASSALPHA", newSViv(EXTRASAMPLE_UNASSALPHA)); newCONSTSUB(stash, "TIFFTAG_SAMPLEFORMAT", newSViv(TIFFTAG_SAMPLEFORMAT)); newCONSTSUB(stash, "SAMPLEFORMAT_UINT", newSViv(SAMPLEFORMAT_UINT)); newCONSTSUB(stash, "SAMPLEFORMAT_INT", newSViv(SAMPLEFORMAT_INT)); newCONSTSUB(stash, "SAMPLEFORMAT_IEEEFP", newSViv(SAMPLEFORMAT_IEEEFP)); newCONSTSUB(stash, "SAMPLEFORMAT_VOID", newSViv(SAMPLEFORMAT_VOID)); newCONSTSUB(stash, "SAMPLEFORMAT_COMPLEXINT", newSViv(SAMPLEFORMAT_COMPLEXINT)); newCONSTSUB(stash, "SAMPLEFORMAT_COMPLEXIEEEFP", newSViv(SAMPLEFORMAT_COMPLEXIEEEFP)); newCONSTSUB(stash, "TIFFTAG_INDEXED", newSViv(TIFFTAG_INDEXED)); newCONSTSUB(stash, "TIFFTAG_JPEGTABLES", newSViv(TIFFTAG_JPEGTABLES)); newCONSTSUB(stash, "TIFFTAG_JPEGPROC", newSViv(TIFFTAG_JPEGPROC)); newCONSTSUB(stash, "JPEGPROC_BASELINE", newSViv(JPEGPROC_BASELINE)); newCONSTSUB(stash, "JPEGPROC_LOSSLESS", newSViv(JPEGPROC_LOSSLESS)); newCONSTSUB(stash, "TIFFTAG_JPEGIFOFFSET", newSViv(TIFFTAG_JPEGIFOFFSET)); newCONSTSUB(stash, "TIFFTAG_JPEGIFBYTECOUNT", newSViv(TIFFTAG_JPEGIFBYTECOUNT)); newCONSTSUB(stash, "TIFFTAG_JPEGLOSSLESSPREDICTORS", newSViv(TIFFTAG_JPEGLOSSLESSPREDICTORS)); newCONSTSUB(stash, "TIFFTAG_JPEGPOINTTRANSFORM", newSViv(TIFFTAG_JPEGPOINTTRANSFORM)); newCONSTSUB(stash, "TIFFTAG_JPEGQTABLES", newSViv(TIFFTAG_JPEGQTABLES)); newCONSTSUB(stash, "TIFFTAG_JPEGDCTABLES", newSViv(TIFFTAG_JPEGDCTABLES)); newCONSTSUB(stash, "TIFFTAG_JPEGACTABLES", newSViv(TIFFTAG_JPEGACTABLES)); newCONSTSUB(stash, "TIFFTAG_YCBCRSUBSAMPLING", newSViv(TIFFTAG_YCBCRSUBSAMPLING)); newCONSTSUB(stash, "TIFFTAG_REFERENCEBLACKWHITE", newSViv(TIFFTAG_REFERENCEBLACKWHITE)); newCONSTSUB(stash, "TIFFTAG_OPIIMAGEID", newSViv(TIFFTAG_OPIIMAGEID)); newCONSTSUB(stash, "TIFFTAG_COPYRIGHT", newSViv(TIFFTAG_COPYRIGHT)); newCONSTSUB(stash, "TIFFTAG_EXIFIFD", newSViv(TIFFTAG_EXIFIFD)); newCONSTSUB(stash, "TIFFTAG_ICCPROFILE", newSViv(TIFFTAG_ICCPROFILE)); newCONSTSUB(stash, "TIFFTAG_JPEGQUALITY", newSViv(TIFFTAG_JPEGQUALITY)); newCONSTSUB(stash, "TIFFTAG_JPEGCOLORMODE", newSViv(TIFFTAG_JPEGCOLORMODE)); newCONSTSUB(stash, "JPEGCOLORMODE_RAW", newSViv(JPEGCOLORMODE_RAW)); newCONSTSUB(stash, "JPEGCOLORMODE_RGB", newSViv(JPEGCOLORMODE_RGB)); newCONSTSUB(stash, "TIFFTAG_JPEGTABLESMODE", newSViv(TIFFTAG_JPEGTABLESMODE)); newCONSTSUB(stash, "JPEGTABLESMODE_QUANT", newSViv(JPEGTABLESMODE_QUANT)); newCONSTSUB(stash, "JPEGTABLESMODE_HUFF", newSViv(JPEGTABLESMODE_HUFF)); newCONSTSUB(stash, "TIFFTAG_ZIPQUALITY", newSViv(TIFFTAG_ZIPQUALITY)); newCONSTSUB(stash, "TIFFPRINT_STRIPS", newSViv(TIFFPRINT_STRIPS)); newCONSTSUB(stash, "TIFFPRINT_CURVES", newSViv(TIFFPRINT_CURVES)); newCONSTSUB(stash, "TIFFPRINT_COLORMAP", newSViv(TIFFPRINT_COLORMAP)); newCONSTSUB(stash, "TIFFPRINT_JPEGQTABLES", newSViv(TIFFPRINT_JPEGQTABLES)); newCONSTSUB(stash, "TIFFPRINT_JPEGACTABLES", newSViv(TIFFPRINT_JPEGACTABLES)); newCONSTSUB(stash, "TIFFPRINT_JPEGDCTABLES", newSViv(TIFFPRINT_JPEGDCTABLES)); void tiff_GetVersion (class) PPCODE: XPUSHs(sv_2mortal(newSVpv((char *) TIFFGetVersion(), 0))); void tiff_IsCODECConfigured (class, compression) uint16_t compression PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFIsCODECConfigured(compression)))); void tiff__Open (class, path, flags) const char* path const char* flags INIT: TIFF *tif; PPCODE: tif = TIFFOpen(path, flags); XPUSHs(sv_2mortal(newSViv(PTR2IV(tif)))); void tiff_Close (tif) TIFF *tif; PPCODE: TIFFClose(tif); void tiff_FileName (tif) TIFF *tif; PPCODE: XPUSHs(sv_2mortal(newSVpv((char *) TIFFFileName(tif), 0))); void tiff_ReadDirectory (tif) TIFF *tif; PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFReadDirectory(tif)))); void tiff_WriteDirectory (tif) TIFF *tif; PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFWriteDirectory(tif)))); void tiff_ReadEXIFDirectory (tif, diroff) TIFF *tif toff_t diroff; PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFReadEXIFDirectory(tif, diroff)))); void tiff_NumberOfDirectories (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFNumberOfDirectories(tif)))); void tiff_SetDirectory (tif, dirnum) TIFF *tif uint16_t dirnum; PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFSetDirectory(tif, dirnum)))); void tiff_SetSubDirectory(tif, diroff) TIFF *tif uint64_t diroff; PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFSetSubDirectory(tif, diroff)))); void tiff_GetField (tif, tag) TIFF *tif uint32_t tag INIT: uint16_t ui16, ui16_2, *aui16, *aui16_2, *aui16_3; uint32_t ui32; uint64_t *aui; float f; float *af; int vector_length, nvals; PPCODE: /* See http://www.libtiff.org/man/TIFFGetField.3t.html */ switch (tag) { /* byte single uint8 */ /* short single uint16 */ case TIFFTAG_BITSPERSAMPLE: case TIFFTAG_COMPRESSION: case TIFFTAG_FILLORDER: case TIFFTAG_MATTEING: case TIFFTAG_MAXSAMPLEVALUE: case TIFFTAG_MINSAMPLEVALUE: case TIFFTAG_ORIENTATION: case TIFFTAG_PHOTOMETRIC: case TIFFTAG_PLANARCONFIG: case TIFFTAG_PREDICTOR: case TIFFTAG_RESOLUTIONUNIT: case TIFFTAG_SAMPLESPERPIXEL: case TIFFTAG_THRESHHOLDING: if (TIFFGetField (tif, tag, &ui16)) { XPUSHs(sv_2mortal(newSViv(ui16))); } break; /* single 64-bit unsigned fraction float */ case TIFFTAG_XRESOLUTION: case TIFFTAG_YRESOLUTION: case TIFFTAG_XPOSITION: case TIFFTAG_YPOSITION: if (TIFFGetField (tif, tag, &f)) { XPUSHs(sv_2mortal(newSVnv(f))); } break; /* two short uint16 */ case TIFFTAG_PAGENUMBER: case TIFFTAG_HALFTONEHINTS: if (TIFFGetField (tif, tag, &ui16, &ui16_2)) { XPUSHs(sv_2mortal(newSViv(ui16))); XPUSHs(sv_2mortal(newSViv(ui16_2))); } break; /* count + array of short uint16 */ case TIFFTAG_EXTRASAMPLES: if (TIFFGetField (tif, tag, &ui16, &aui16)) { int i; for (i = 0; i < ui16; ++i) XPUSHs(sv_2mortal(newSViv(aui16[i]))); } break; /* three array of short uint16 */ case TIFFTAG_COLORMAP: if (TIFFGetField (tif, tag, &aui16, &aui16_2, &aui16_3)) { if ((aui16 != (uint16_t *) NULL) && (aui16_2 != (uint16_t *) NULL) && (aui16_3 != (uint16_t *) NULL)) { AV* rav = newAV(); AV* gav = newAV(); AV* bav = newAV(); mXPUSHs(newRV_noinc((SV*)rav)); mXPUSHs(newRV_noinc((SV*)gav)); mXPUSHs(newRV_noinc((SV*)bav)); TIFFGetField (tif, TIFFTAG_BITSPERSAMPLE, &ui16); int i; for (i=0; i < (ssize_t) pow(2.0, (double) ui16); i++) { av_push(rav, newSViv(aui16[i])); av_push(gav, newSViv(aui16_2[i])); av_push(bav, newSViv(aui16_3[i])); } } } break; /* array of uint64 */ case TIFFTAG_TILEOFFSETS: case TIFFTAG_TILEBYTECOUNTS: case TIFFTAG_STRIPOFFSETS: case TIFFTAG_STRIPBYTECOUNTS: if (TIFFGetField (tif, tag, &aui)) { nvals = TIFFNumberOfStrips(tif); int i; for (i = 0; i < nvals; ++i) XPUSHs(sv_2mortal(newSViv(aui[i]))); } break; /* array of float */ case TIFFTAG_WHITEPOINT: case TIFFTAG_PRIMARYCHROMATICITIES: switch (tag) { case TIFFTAG_PRIMARYCHROMATICITIES: nvals = 6; break; /* TIFFTAG_WHITEPOINT */ default: nvals = 2; } if (TIFFGetField (tif, tag, &af)) { int i; for (i = 0; i < nvals; ++i) XPUSHs(sv_2mortal(newSVnv(af[i]))); } break; /* single uint32 */ default: if (TIFFGetField (tif, tag, &ui32)) { XPUSHs(sv_2mortal(newSViv(ui32))); } break; } void tiff_GetFieldDefaulted (tif, tag) TIFF *tif uint32_t tag INIT: uint16_t ui16, ui16_2, *aui16, *aui16_2, *aui16_3; uint32_t ui32; uint64_t *aui; float f; int vector_length; PPCODE: switch (tag) { /* byte single uint8 */ /* short single uint16 */ case TIFFTAG_BITSPERSAMPLE: case TIFFTAG_COMPRESSION: case TIFFTAG_FILLORDER: case TIFFTAG_MATTEING: case TIFFTAG_MAXSAMPLEVALUE: case TIFFTAG_MINSAMPLEVALUE: case TIFFTAG_ORIENTATION: case TIFFTAG_PHOTOMETRIC: case TIFFTAG_PLANARCONFIG: case TIFFTAG_PREDICTOR: case TIFFTAG_RESOLUTIONUNIT: case TIFFTAG_SAMPLESPERPIXEL: case TIFFTAG_THRESHHOLDING: if (TIFFGetFieldDefaulted (tif, tag, &ui16)) { XPUSHs(sv_2mortal(newSViv(ui16))); } break; /* single 64-bit unsigned fraction float */ case TIFFTAG_XRESOLUTION: case TIFFTAG_YRESOLUTION: case TIFFTAG_XPOSITION: case TIFFTAG_YPOSITION: if (TIFFGetFieldDefaulted (tif, tag, &f)) { XPUSHs(sv_2mortal(newSVnv(f))); } break; /* two short uint16 */ case TIFFTAG_PAGENUMBER: case TIFFTAG_HALFTONEHINTS: if (TIFFGetFieldDefaulted (tif, tag, &ui16, &ui16_2)) { XPUSHs(sv_2mortal(newSViv(ui16))); XPUSHs(sv_2mortal(newSViv(ui16_2))); } break; /* count + array of short uint16 */ case TIFFTAG_EXTRASAMPLES: if (TIFFGetFieldDefaulted (tif, tag, &ui16, &aui16)) { int i; for (i = 0; i < ui16; ++i) XPUSHs(sv_2mortal(newSViv(aui16[i]))); } break; /* three array of short uint16 */ case TIFFTAG_COLORMAP: if (TIFFGetFieldDefaulted (tif, tag, &aui16, &aui16_2, &aui16_3)) { if ((aui16 != (uint16_t *) NULL) && (aui16_2 != (uint16_t *) NULL) && (aui16_3 != (uint16_t *) NULL)) { AV* rav = newAV(); AV* gav = newAV(); AV* bav = newAV(); mXPUSHs(newRV_noinc((SV*)rav)); mXPUSHs(newRV_noinc((SV*)gav)); mXPUSHs(newRV_noinc((SV*)bav)); TIFFGetFieldDefaulted (tif, TIFFTAG_BITSPERSAMPLE, &ui16); int i; for (i=0; i < (ssize_t) pow(2.0, (double) ui16); i++) { av_push(rav, newSViv(aui16[i])); av_push(gav, newSViv(aui16_2[i])); av_push(bav, newSViv(aui16_3[i])); } } } break; /* array of uint64 */ case TIFFTAG_TILEOFFSETS: case TIFFTAG_TILEBYTECOUNTS: case TIFFTAG_STRIPOFFSETS: case TIFFTAG_STRIPBYTECOUNTS: if (TIFFGetFieldDefaulted (tif, tag, &aui)) { int nstrips = TIFFNumberOfStrips(tif); int i; for (i = 0; i < nstrips; ++i) XPUSHs(sv_2mortal(newSViv(aui[i]))); } break; /* single uint32 */ default: if (TIFFGetFieldDefaulted (tif, tag, &ui32)) { XPUSHs(sv_2mortal(newSViv(ui32))); } break; } void tiff_SetField (tif, tag, ...) TIFF *tif uint32_t tag INIT: uint16_t ui16, ui16_2; uint32_t ui32; float f; PPCODE: switch (tag) { /* single float */ case TIFFTAG_XRESOLUTION: case TIFFTAG_YRESOLUTION: case TIFFTAG_XPOSITION: case TIFFTAG_YPOSITION: f = SvNV(ST(2)); XPUSHs(sv_2mortal(newSViv(TIFFSetField (tif, tag, f)))); break; /* two uint16 */ case TIFFTAG_PAGENUMBER: ui16 = SvIV(ST(2)); ui16_2 = SvIV(ST(3)); XPUSHs(sv_2mortal(newSViv(TIFFSetField (tif, tag, ui16, ui16_2)))); break; /* single uint32 */ default: ui32 = SvIV(ST(2)); XPUSHs(sv_2mortal(newSViv(TIFFSetField (tif, tag, ui32)))); break; } void tiff_IsTiled (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFIsTiled(tif)))); void tiff_ScanlineSize (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFScanlineSize(tif)))); void tiff_StripSize (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFStripSize(tif)))); void tiff_NumberOfStrips (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFNumberOfStrips(tif)))); void tiff_TileSize (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFTileSize(tif)))); void tiff_TileRowSize (tif) TIFF *tif PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFTileRowSize(tif)))); void tiff_ComputeStrip (tif, row, sample) TIFF *tif uint32_t row uint16_t sample PPCODE: XPUSHs(sv_2mortal(newSViv(TIFFComputeStrip(tif, row, sample)))); void tiff_ReadEncodedStrip (tif, strip, size) TIFF *tif uint32_t strip tmsize_t size INIT: void *buf; tmsize_t stripsize, bufsize; PPCODE: stripsize = TIFFStripSize(tif); buf = _TIFFmalloc(stripsize); bufsize = TIFFReadEncodedStrip(tif, strip, buf, size); if (bufsize > 0) { XPUSHs(sv_2mortal(newSVpvn(buf, bufsize))); } _TIFFfree(buf); void tiff_WriteEncodedStrip (tif, strip, data, size) TIFF *tif uint32_t strip void* data tmsize_t size INIT: tmsize_t stripsize; PPCODE: stripsize = TIFFWriteEncodedStrip(tif, strip, data, size); XPUSHs(sv_2mortal(newSViv(stripsize))); void tiff_ReadRawStrip (tif, strip, size) TIFF *tif uint32_t strip tmsize_t size INIT: void *buf; tmsize_t stripsize, bufsize; PPCODE: stripsize = TIFFStripSize(tif); buf = _TIFFmalloc(stripsize); bufsize = TIFFReadRawStrip(tif, strip, buf, size); if (bufsize > 0) { XPUSHs(sv_2mortal(newSVpvn(buf, bufsize))); } _TIFFfree(buf); void tiff_ReadTile (tif, x, y, z, s) TIFF *tif uint32_t x uint32_t y uint32_t z uint16_t s INIT: void *buf; tmsize_t tilesize, bufsize; PPCODE: tilesize = TIFFTileSize(tif); buf = _TIFFmalloc(tilesize); bufsize = TIFFReadTile(tif, buf, x, y, z, s); if (bufsize > 0) { XPUSHs(sv_2mortal(newSVpvn(buf, bufsize))); } _TIFFfree(buf); uint16_t tiff_CurrentDirectory (tif) TIFF *tif CODE: RETVAL = TIFFCurrentDirectory(tif); OUTPUT: RETVAL void tiff_PrintDirectory (tif, file, flags) TIFF *tif FILE *file long flags CODE: TIFFPrintDirectory(tif, file, flags); void tiff_ReverseBits (data, size) void* data tmsize_t size CODE: TIFFReverseBits((uint8_t*) data, size); Graphics-TIFF-20/lib/0000755000175000017500000000000014437671601012750 5ustar jeffjeffGraphics-TIFF-20/lib/Graphics/0000755000175000017500000000000014437671601014510 5ustar jeffjeffGraphics-TIFF-20/lib/Graphics/TIFF.pm0000644000175000017500000005136314437204365015605 0ustar jeffjeffpackage Graphics::TIFF; use 5.008005; use strict; use warnings; use Exporter (); use base qw(Exporter); use Readonly; Readonly my $MINOR => 1000; Readonly my $MICRO => 1_000_000; # This allows declaration use Graphics::TIFF ':all'; our %EXPORT_TAGS = ( 'all' => [ qw( TIFFLIB_VERSION TIFFTAG_SUBFILETYPE FILETYPE_REDUCEDIMAGE FILETYPE_PAGE FILETYPE_MASK TIFFTAG_OSUBFILETYPE OFILETYPE_IMAGE OFILETYPE_REDUCEDIMAGE OFILETYPE_PAGE TIFFTAG_IMAGEWIDTH TIFFTAG_IMAGELENGTH TIFFTAG_BITSPERSAMPLE TIFFTAG_COMPRESSION COMPRESSION_NONE COMPRESSION_CCITTRLE COMPRESSION_CCITTFAX3 COMPRESSION_CCITT_T4 COMPRESSION_CCITTFAX4 COMPRESSION_CCITT_T6 COMPRESSION_LZW COMPRESSION_OJPEG COMPRESSION_JPEG COMPRESSION_T85 COMPRESSION_T43 COMPRESSION_NEXT COMPRESSION_CCITTRLEW COMPRESSION_PACKBITS COMPRESSION_THUNDERSCAN COMPRESSION_IT8CTPAD COMPRESSION_IT8LW COMPRESSION_IT8MP COMPRESSION_IT8BL COMPRESSION_PIXARFILM COMPRESSION_PIXARLOG COMPRESSION_DEFLATE COMPRESSION_ADOBE_DEFLATE COMPRESSION_DCS COMPRESSION_JBIG COMPRESSION_SGILOG COMPRESSION_SGILOG24 COMPRESSION_JP2000 COMPRESSION_LZMA TIFFTAG_PHOTOMETRIC PHOTOMETRIC_MINISWHITE PHOTOMETRIC_MINISBLACK PHOTOMETRIC_RGB PHOTOMETRIC_PALETTE PHOTOMETRIC_MASK PHOTOMETRIC_SEPARATED PHOTOMETRIC_YCBCR PHOTOMETRIC_CIELAB PHOTOMETRIC_ICCLAB PHOTOMETRIC_ITULAB PHOTOMETRIC_LOGL PHOTOMETRIC_LOGLUV TIFFTAG_FILLORDER FILLORDER_MSB2LSB FILLORDER_LSB2MSB TIFFTAG_DOCUMENTNAME TIFFTAG_IMAGEDESCRIPTION TIFFTAG_STRIPOFFSETS TIFFTAG_ORIENTATION ORIENTATION_TOPLEFT ORIENTATION_TOPRIGHT ORIENTATION_BOTRIGHT ORIENTATION_BOTLEFT ORIENTATION_LEFTTOP ORIENTATION_RIGHTTOP ORIENTATION_RIGHTBOT ORIENTATION_LEFTBOT TIFFTAG_SAMPLESPERPIXEL TIFFTAG_ROWSPERSTRIP TIFFTAG_STRIPBYTECOUNTS TIFFTAG_XRESOLUTION TIFFTAG_YRESOLUTION TIFFTAG_XPOSITION TIFFTAG_YPOSITION TIFFTAG_PLANARCONFIG PLANARCONFIG_CONTIG PLANARCONFIG_SEPARATE TIFFTAG_GROUP3OPTIONS TIFFTAG_T4OPTIONS GROUP3OPT_2DENCODING GROUP3OPT_UNCOMPRESSED GROUP3OPT_FILLBITS TIFFTAG_GROUP4OPTIONS TIFFTAG_T6OPTIONS GROUP4OPT_UNCOMPRESSED TIFFTAG_RESOLUTIONUNIT RESUNIT_NONE RESUNIT_INCH RESUNIT_CENTIMETER TIFFTAG_PAGENUMBER TIFFTAG_TRANSFERFUNCTION TIFFTAG_SOFTWARE TIFFTAG_DATETIME TIFFTAG_ARTIST TIFFTAG_PREDICTOR PREDICTOR_NONE PREDICTOR_HORIZONTAL PREDICTOR_FLOATINGPOINT TIFFTAG_WHITEPOINT TIFFTAG_PRIMARYCHROMATICITIES TIFFTAG_COLORMAP TIFFTAG_TILEWIDTH TIFFTAG_TILELENGTH TIFFTAG_INKSET INKSET_CMYK INKSET_MULTIINK TIFFTAG_EXTRASAMPLES EXTRASAMPLE_UNSPECIFIED EXTRASAMPLE_ASSOCALPHA EXTRASAMPLE_UNASSALPHA TIFFTAG_SAMPLEFORMAT SAMPLEFORMAT_UINT SAMPLEFORMAT_INT SAMPLEFORMAT_IEEEFP SAMPLEFORMAT_VOID SAMPLEFORMAT_COMPLEXINT SAMPLEFORMAT_COMPLEXIEEEFP TIFFTAG_INDEXED TIFFTAG_JPEGTABLES TIFFTAG_JPEGPROC JPEGPROC_BASELINE JPEGPROC_LOSSLESS TIFFTAG_JPEGIFOFFSET TIFFTAG_JPEGIFBYTECOUNT TIFFTAG_JPEGLOSSLESSPREDICTORS TIFFTAG_JPEGPOINTTRANSFORM TIFFTAG_JPEGQTABLES TIFFTAG_JPEGDCTABLES TIFFTAG_JPEGACTABLES TIFFTAG_YCBCRSUBSAMPLING TIFFTAG_REFERENCEBLACKWHITE TIFFTAG_OPIIMAGEID TIFFTAG_COPYRIGHT TIFFTAG_EXIFIFD TIFFTAG_ICCPROFILE TIFFTAG_JPEGQUALITY TIFFTAG_JPEGCOLORMODE JPEGCOLORMODE_RAW JPEGCOLORMODE_RGB TIFFTAG_JPEGTABLESMODE JPEGTABLESMODE_QUANT JPEGTABLESMODE_HUFF TIFFTAG_ZIPQUALITY TIFFPRINT_STRIPS TIFFPRINT_CURVES TIFFPRINT_COLORMAP TIFFPRINT_JPEGQTABLES TIFFPRINT_JPEGACTABLES TIFFPRINT_JPEGDCTABLES ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our $VERSION = 20; require XSLoader; XSLoader::load( 'Graphics::TIFF', $VERSION ); sub get_version { my ($version) = Graphics::TIFF->GetVersion; if ( $version =~ /LIBTIFF,[ ]Version[ ](\d+)[.](\d+)[.](\d+)/xsm ) { return $1, $2, $3; } return; } sub get_version_scalar { my (@version) = Graphics::TIFF->get_version; if ( defined $version[0] and defined $version[1] and defined $version[2] ) { return $version[0] + $version[1] / $MINOR + $version[2] / $MICRO; } return; } sub Open { ## no critic (Capitalization) my ( $class, $path, $flags ) = @_; my $self = Graphics::TIFF->_Open( $path, $flags ); ## no critic (ProtectPrivateSubs) bless \$self, $class; return \$self; } 1; __END__ =head1 NAME Graphics::TIFF - Perl extension for the libtiff library =head1 VERSION 20 =head1 SYNOPSIS Perl bindings for the libtiff library. This module allows you to access TIFF images in a Perlish and object-oriented way, freeing you from the casting and memory management in C, yet remaining very close in spirit to original API. The following snippet can be used to read the image data from a TIFF: use Graphics::TIFF ':all'; my $tif = Graphics::TIFF->Open( 'test.tif', 'r' ); my $stripsize = $tif->StripSize; for my $stripnum ( 0 .. $tif->NumberOfStrips - 1 ) { my $buffer = $tif->ReadEncodedStrip( $stripnum, $stripsize ); # do something with $buffer } $tif->Close; =head1 DESCRIPTION The Graphics::TIFF module allows a Perl developer to access TIFF images. Find out more about libtiff at L. =for readme stop =head1 SUBROUTINES/METHODS =head2 Graphics::TIFF->get_version Returns an array with the LIBTIFF_VERSION_(MAJOR|MINOR|MICRO) versions: join('.',Graphics::TIFF->get_version) =head2 Graphics::TIFF->get_version_scalar Returns an scalar with the LIBTIFF_VERSION_(MAJOR|MINOR|MICRO) versions combined as per the Perl version numbering, i.e. libtiff 4.0.6 gives 4.000006. This allows simple version comparisons. =head2 Graphics::TIFF->GetVersion Returns a string with the format "LIBTIFF, Version MAJOR.MINOR.MICRO" =head2 Graphics::TIFF->IsCODECConfigured(compression) Returns a boolean if libtiff was configured with the given compression method. See the possible values for the TIFFTAG_COMPRESSION tag for valid compression methods. =head2 Graphics::TIFF->Open(filename, flags) Returns a TIFF object. 'r' and 'w' are valid flags. =head2 $tif->Close Closes the tiff given TIFF object. =head2 $tif->FileName Returns the filename associated with the given TIFF object. =head2 $tif->ReadDirectory Read the next directory in the specified file and make it the current directory. Applications only need to call ReadDirectory to read multiple subfiles in a single TIFF file - the first directory in a file is automatically read when Open is called. =head3 Notes If the library is compiled with STRIPCHOP_SUPPORT enabled, then images that have a single uncompressed strip or tile of data are automatically treated as if they were made up of multiple strips or tiles of approximately 8 kilobytes each. This operation is done only in-memory; it does not alter the contents of the file. However, the construction of the ''chopped strips'' is visible to the application through the number of strips [tiles] returned by NumberOfStrips [NumberOfTiles]. =head3 Return Values If the next directory was successfully read, 1 is returned. Otherwise, 0 is returned if an error was encountered, or if there are no more directories to be read. =head2 $tif->WriteDirectory WriteDirectory will write the contents of the current directory to the file and setup to create a new subfile in the same file. Applications only need to call WriteDirectory when writing multiple subfiles to a single TIFF file. WriteDirectory is automatically called by Close and Flush to write a modified directory if the file is open for writing. The RewriteDirectory function operates similarly to WriteDirectory, but can be called with directories previously read or written that already have an established location in the file. It will rewrite the directory, but instead of place it at it's old location (as TIFFWriteDirectory would) it will place them at the end of the file, correcting the pointer from the preceding directory or file header to point to it's new location. This is particularly important in cases where the size of the directory and pointed to data has grown, so it won't fit in the space available at the old location. The CheckpointDirectory writes the current state of the tiff directory into the file to make what is currently in the file readable. Unlike WriteDirectory, CheckpointDirectory does not free up the directory data structures in memory, so they can be updated (as strips/tiles are written) and written again. Reading such a partial file you will at worst get a tiff read error for the first strip/tile encountered that is incomplete, but you will at least get all the valid data in the file before that. When the file is complete, just use WriteDirectory as usual to finish it off cleanly. =head3 Return Values 1 is returned when the contents are successfully written to the file. Otherwise, 0 is returned if an error was encountered when writing the directory contents. =head2 $tif->ReadEXIFDirectory(diroff) Required before reading EXIF tags. =head2 $tif->NumberOfDirectories Returns the number of directory in the given TIFF object. =head2 $tif->SetDirectory(dirnum) Changes the current directory and reads its contents with ReadDirectory. The parameter dirnum specifies the subfile/directory as an integer number, with the first directory numbered zero. =head3 Return Values On successful return 1 is returned. Otherwise, 0 is returned if dirnum or diroff specifies a non-existent directory, or if an error was encountered while reading the directory's contents. =head2 $tif->SetSubDirectory(diroff) Acts like SetDirectory, except the directory is specified as a file offset instead of an index; this is required for accessing subdirectories linked through a SubIFD tag. =head2 $tif->GetField(tag) Returns the value of a tag or pseudo-tag associated with the the current directory of the open TIFF file tif. (A pseudo-tag is a parameter that is used to control the operation of the TIFF library but whose value is not read or written to the underlying file.) The file must have been previously opened with Open. The type and number of values returned is dependent on the tag being requested. The tags understood by libtiff are shown below. Consult the TIFF specification for information on the meaning of each tag and their possible values. TIFFTAG_ARTIST TIFFTAG_BADFAXLINES TIFFTAG_BITSPERSAMPLE TIFFTAG_CLEANFAXDATA TIFFTAG_COLORMAP TIFFTAG_COMPRESSION (COMPRESSION_NONE COMPRESSION_CCITTRLE COMPRESSION_CCITTFAX3 COMPRESSION_CCITT_T4 COMPRESSION_CCITTFAX4 COMPRESSION_CCITT_T6 COMPRESSION_LZW COMPRESSION_OJPEG COMPRESSION_JPEG COMPRESSION_T85 COMPRESSION_T43 COMPRESSION_NEXT COMPRESSION_CCITTRLEW COMPRESSION_PACKBITS COMPRESSION_THUNDERSCAN COMPRESSION_IT8CTPAD COMPRESSION_IT8LW COMPRESSION_IT8MP COMPRESSION_IT8BL COMPRESSION_PIXARFILM COMPRESSION_PIXARLOG COMPRESSION_DEFLATE COMPRESSION_ADOBE_DEFLATE COMPRESSION_DCS COMPRESSION_JBIG COMPRESSION_SGILOG COMPRESSION_SGILOG24 COMPRESSION_JP2000 COMPRESSION_LZMA) TIFFTAG_CONSECUTIVEBADFAXLINES TIFFTAG_COPYRIGHT TIFFTAG_DATATYPE TIFFTAG_DATETIME TIFFTAG_DOCUMENTNAME TIFFTAG_DOTRANGE TIFFTAG_EXTRASAMPLES (EXTRASAMPLE_UNSPECIFIED EXTRASAMPLE_ASSOCALPHA EXTRASAMPLE_UNASSALPHA) TIFFTAG_FAXMODE TIFFTAG_FAXFILLFUNC TIFFTAG_FILLORDER (FILLORDER_MSB2LSB FILLORDER_LSB2MSB) TIFFTAG_GROUP3OPTIONS (GROUP3OPT_2DENCODING GROUP3OPT_UNCOMPRESSED GROUP3OPT_FILLBITS) TIFFTAG_GROUP4OPTIONS (GROUP4OPT_UNCOMPRESSED) TIFFTAG_HALFTONEHINTS TIFFTAG_HOSTCOMPUTER TIFFTAG_IMAGEDEPTH TIFFTAG_IMAGEDESCRIPTION TIFFTAG_IMAGELENGTH TIFFTAG_IMAGEWIDTH TIFFTAG_INKNAMES TIFFTAG_INKSET (INKSET_CMYK INKSET_MULTIINK) TIFFTAG_JPEGTABLES TIFFTAG_JPEGQUALITY TIFFTAG_JPEGCOLORMODE (JPEGCOLORMODE_RAW JPEGCOLORMODE_RGB) TIFFTAG_JPEGPROC (JPEGPROC_BASELINE JPEGPROC_LOSSLESS) TIFFTAG_JPEGTABLESMODE (JPEGTABLESMODE_QUANT JPEGTABLESMODE_HUFF) TIFFTAG_MAKE TIFFTAG_MATTEING TIFFTAG_MAXSAMPLEVALUE TIFFTAG_MINSAMPLEVALUE TIFFTAG_MODEL TIFFTAG_ORIENTATION (ORIENTATION_TOPLEFT ORIENTATION_TOPRIGHT ORIENTATION_BOTRIGHT ORIENTATION_BOTLEFT ORIENTATION_LEFTTOP ORIENTATION_RIGHTTOP ORIENTATION_RIGHTBOT ORIENTATION_LEFTBOT) TIFFTAG_OSUBFILETYPE (OFILETYPE_IMAGE OFILETYPE_REDUCEDIMAGE OFILETYPE_PAGE) TIFFTAG_PAGENAME TIFFTAG_PAGENUMBER TIFFTAG_PHOTOMETRIC (PHOTOMETRIC_MINISWHITE PHOTOMETRIC_MINISBLACK PHOTOMETRIC_RGB PHOTOMETRIC_PALETTE PHOTOMETRIC_MASK PHOTOMETRIC_SEPARATED PHOTOMETRIC_YCBCR PHOTOMETRIC_CIELAB PHOTOMETRIC_ICCLAB PHOTOMETRIC_ITULAB PHOTOMETRIC_LOGL PHOTOMETRIC_LOGLUV) TIFFTAG_PLANARCONFIG (PLANARCONFIG_CONTIG PLANARCONFIG_SEPARATE) TIFFTAG_PREDICTOR (PREDICTOR_NONE PREDICTOR_HORIZONTAL PREDICTOR_FLOATINGPOINT) TIFFTAG_PRIMARYCHROMATICITIES TIFFTAG_REFERENCEBLACKWHITE TIFFTAG_RESOLUTIONUNIT (RESUNIT_NONE RESUNIT_INCH RESUNIT_CENTIMETER) TIFFTAG_ROWSPERSTRIP TIFFTAG_SAMPLEFORMAT (SAMPLEFORMAT_UINT SAMPLEFORMAT_INT SAMPLEFORMAT_IEEEFP SAMPLEFORMAT_VOID SAMPLEFORMAT_COMPLEXINT SAMPLEFORMAT_COMPLEXIEEEFP) TIFFTAG_SAMPLESPERPIXEL TIFFTAG_SMAXSAMPLEVALUE TIFFTAG_SMINSAMPLEVALUE TIFFTAG_SOFTWARE TIFFTAG_STONITS TIFFTAG_STRIPBYTECOUNTS TIFFTAG_STRIPOFFSETS TIFFTAG_SUBFILETYPE (FILETYPE_REDUCEDIMAGE FILETYPE_PAGE FILETYPE_MASK) TIFFTAG_SUBIFD TIFFTAG_TARGETPRINTER TIFFTAG_THRESHHOLDING TIFFTAG_TILEBYTECOUNTS TIFFTAG_TILEDEPTH TIFFTAG_TILELENGTH TIFFTAG_TILEOFFSETS TIFFTAG_TILEWIDTH TIFFTAG_TRANSFERFUNCTION TIFFTAG_WHITEPOINT TIFFTAG_XPOSITION TIFFTAG_XRESOLUTION TIFFTAG_YCBCRCOEFFICIENTS TIFFTAG_YCBCRPOSITIONING TIFFTAG_YCBCRSUBSAMPLING TIFFTAG_YPOSITION TIFFTAG_YRESOLUTION TIFFTAG_ICCPROFILE =head2 $tif->GetFieldDefaulted(tag) Identical to GetField, except that if a tag is not defined in the current directory and it has a default value, then the default value is returned. =head2 $tif->SetField(tag, ...) Sets the value of a field or pseudo-tag in the current directory associated with the open TIFF file tif. Set GetField for Possible values for# tag. =head2 $tif->IsTiled Returns a non-zero value if the image data has a tiled organisation. Zero is returned if the image data is organised in strips. =head2 $tif->ScanlineSize Returns the size in bytes of a row of data as it would be returned in a call to ReadScanline, or as it would be expected in a call to WriteScanline. =head2 $tif->StripSize Returns the equivalent size for a strip of data as it would be returned in a call to ReadEncodedStrip or as it would be expected in a call to WriteEncodedStrip. =head2 $tif->NumberOfStrips Returns the number of strips in the image. =head2 $tif->TileSize Returns the equivalent size for a tile of data as it would be returned in a call to ReadTile or as it would be expected in a call to WriteTile. =head2 $tif->TileRowSize Returns the number of bytes of a row of data in a tile. =head2 $tif->ComputeStrip(row, sample) Returns the strip that contains the specified coordinates. A valid strip is always returned; out-of-range coordinate values are clamped to the bounds of the image. The row parameter is always used in calculating a strip. The sample parameter is used only if data are organised in separate planes (PlanarConfiguration=2). =head2 $tif->ReadEncodedStrip(strip, size) Returns a buffer of up to size bytes of decompressed information. The value of strip is a ``raw strip number.'' That is, the caller must take into account whether or not the data are organised in separate planes (PlanarConfiguration=2). To read a full strip of data the data buffer should typically be at least as large as the number returned by StripSize. The library attempts to hide bit- and byte-ordering differences between the image and the native machine by converting data to the native machine order. Bit reversal is done if the FillOrder tag is opposite to the native machine bit order. 16- and 32-bit samples are automatically byte-swapped if the file was written with a byte order opposite to the native machine byte order. =head2 $tif->WriteEncodedStrip(strip, data, size) Compress size bytes of raw data from buf and write the result to the specified strip; replacing any previously written data. Note that the value of strip is a ``raw strip number.'' That is, the caller must take into account whether or not the data are organised in separate places (PlanarConfiguration=2). The library writes encoded data using the native machine byte order. Correctly implemented TIFF readers are expected to do any necessary byte-swapping to correctly process image data with BitsPerSample greater than 8. The strip number must be valid according to the current settings of the ImageLength and RowsPerStrip tags. An image may be dynamically grown by increasing the value of ImageLength prior to each call to TIFFWriteEncodedStrip. -1 is returned if an error was encountered. Otherwise, the value of size is returned. =head2 $tif->ReadRawStrip(strip, size) Returns the contents of the specified strip. Note that the value of strip is a ''raw strip number.'' That is, the caller must take into account whether or not the data is organised in separate planes (PlanarConfiguration=2). To read a full strip of data the data buffer should typically be at least as large as the number returned by StripSize. =head2 $tif->ReadTile(x, y, z, s) Returns the data for the tile containing the specified coordinates. The data is returned decompressed and, typically, in the native byte- and bit-ordering, but are otherwise packed (see further below). The buffer must be large enough to hold an entire tile of data. Applications should call the routine TIFFTileSize to find out the size (in bytes) of a tile buffer. The x and y parameters are always used by ReadTile. The z parameter is used if the image is deeper than 1 slice (ImageDepth>1). The sample parameter is used only if data are organised in separate planes (PlanarConfiguration=2). The library attempts to hide bit- and byte-ordering differences between the image and the native machine by converting data to the native machine order. Bit reversal is done if the FillOrder tag is opposite to the native machine bit order. 16- and 32-bit samples are automatically byte-swapped if the file was written with a byte order opposite to the native machine byte order. =head2 $tif->CurrentDirectory() Return an index number of the current directory in the specified TIFF file. =head2 $tif->PrintDirectory(file, flags) Prints a description of the current directory in the specified TIFF file to the standard I/O output stream fd. The flags parameter is used to control the level of detail of the printed information, and is a bitwise or of the following values: TIFFPRINT_NONE TIFFPRINT_STRIPS TIFFPRINT_CURVES TIFFPRINT_COLORMAP TIFFPRINT_JPEGQTABLES TIFFPRINT_JPEGACTABLES TIFFPRINT_JPEGDCTABLES =head2 Graphics::TIFF::ReverseBits(data, size) Replaces each byte in data with the equivalent bit-reversed value. This operation is done with a lookup table. =for readme continue =head1 DIAGNOSTICS =head1 CONFIGURATION AND ENVIRONMENT =head1 DEPENDENCIES =head2 Runtime The runtime dependencies are just libtiff itself. In Windows this is satisfied by Alien::libtiff. =head2 Build The build dependencies are additionally the development headers for libtiff and Perl. =head2 Test In addition to the above, the Perl module Image::Magick is required to run some of the tests. =head1 INCOMPATIBILITIES =head1 BUGS AND LIMITATIONS =head1 SEE ALSO The LIBTIFF Standard Reference L is a handy companion. The Perl bindings follow the C API very closely, and the C reference documentation should be considered the canonical source. =head1 AUTHOR Jeffrey Ratcliffe, Ejffry@posteo.netE =head1 LICENSE AND COPYRIGHT Copyright (C) 2017--2023 by Jeffrey Ratcliffe This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available. =cut Graphics-TIFF-20/Changes0000644000175000017500000000755114437663602013507 0ustar jeffjeffRevision history for Perl extension Graphics::TIFF. 20 Wed, 7 Jun 2023 00:00 +0000 - Add TIFFTAG_XPOSITION and TIFFTAG_YPOSITION Closes RT #148337 (t/1.t fails with ImageMagick-7.1.1.8: Failed test 'tiffcmp') Thanks to Petr Pisar for the patch. - Only run t/92_tiffinfo.t & t/93_tiff2pdf.t as AUTHOR tests Closes RT #148450 (92_tiffinfo.t and 93_tiff2pdf.t failes with perl 5.37.11) 19 Thu, 9 Jun 2022 00:00 +0000 - Adapt tests to tiff-4.4.0. Closes RT #143153 (t/92_tiffinfo.t fails with tiff-4.4.0) Thanks to Petr Pisar for the patch. 18 Tue, 1 Nov 2021 00:00 +0000 - Remove unnecessary cast from (unsigned char *) to (void * ) in buffers 17 Tue, 11 Oct 2021 00:00 +0000 - Wrap TIFFReverseBits() 16 Thu, 24 Jun 2021 00:00 +0000 - The *_t types seem only to be missing from msvcrt, so altered the guards appropriately. 15 Thu, 03 Jun 2021 00:00 +0000 - + *_t types for those versions of libc that do not have them. Closes GH #5 (GT 14 will not install on Strawberry Perl 5.22) 14 Mon, 31 May 2021 00:00 +0000 - Windows runtime dependency on Alien::libtiff - Use the standardised uint16_t etc. types. Closes RT #136629 (uint16, uint32, and unint64 types are deprecated) 13 Thu, 28 May 2021 00:00 +0000 - Makefile.PL - Fix error creating Makefile on Windows - tiffperl.h - follow Google style guide to satisfy linter - Windows dependency on Alien::libtiff 12 Thu, 29 Apr 2021 22:30 +0200 - Changes to tests to fix RT 122933 (t/1.t test crashes with ImageMagick 7.0.6.9) 11 Tue, 27 Apr 2021 22:30 +0200 - Adapt tests to tiff-4.3.0. Closes RT 135330 (Tests fail with libtiff 4.3.0) Thanks to Petr Písař for the patch. 10 Sun, 11 Apr 2021 22:30 +0200 - Fix TIFFGetField for TIFFTAG_PREDICTOR 9 Wed, 10 Feb 2021 22:30 +0100 - Use temporary directories to enable parallel testing. Closes RT 134352 (Parallel tests fail) Thanks to Petr Pisar for the patch. 8 Tue, 09 Feb 2021 22:30 +0100 - Adapt tests to tiff-4.2.0. Closes RT 134344 (t/93_tiff2pdf.t fails with tiff-4.2.0) Thanks to Petr Pisar and Thierry Vignaud for the patches. 7 Thu, 27 Oct 2020 19:30 +0100 - Fix TIFFGetField for TIFFTAG_COLORMAP 6 Wed, 02 Aug 2017 19:30 +0200 - correct number of tests to skip in t/1.t. Closes RT 122665 (t/1.t fails on some Linux systems) 5 Sat, 29 Jul 2017 19:30 +0200 - correct pkgconfig identifier. Closes RT 122628. Thanks to Petr Pisar for the patch. - don't depend on Image::Magick and skip tests if not installed - + tests with no dependencies 4 Mon, 17 Jul 2017 19:30 +0200 - rewrite test in 1.t to fix failure with older Perls - skip 92_tiffinfo.t & 93_tiff2pdf.t if we don't have Perl 5.10, adding Test::Requires to TEST_REQUIRES - use Pod::Readme to build README from POD - use perlmagick to build test images and thus fix test failures from smokers without Imagemagick 3 Sat, 15 Jul 2017 11:00 +0200 - Skip tests in 1.t, 92_tiffinfo.t & 93_tiff2pdf.t if tiffcmp, tiffinfo & tiff2pdf not installed to fix RT 122486 - use Test::Deeply::num to fix test failures due to rounding in 1.t and fix RT 122488 - invalid->illegal in error messages in tiffinfo.pl and tiff2pdf.pl for freebsd to fix RT 122489 2 Fri, 14 Jul 2017 19:30 +0200 - fix GetFieldDefaulted(TIFFTAG_EXTRASAMPLES) - use $EXECUTABLE_NAME in tests to fix RT 122470 - + Readonly to PREREQ_PM in Makefile.PL - Moved Test::More in BUILD_REQUIRES -> TEST_REQUIRES 1 Thu, 13 Jul 2017 19:30 +0200 - original version; created by h2xs 1.23 with options -A -n Graphics::TIFF Graphics-TIFF-20/tiffperl.h0000644000175000017500000000124314437203630014157 0ustar jeffjeff/* * Copyright (c) 2017--2023 by Jeffrey Ratcliffe * * This library is free software; you can redistribute it and/or modify * it under the same terms as Perl itself, either Perl version 5.8.5 or, * at your option, any later version of Perl 5 you may have available. */ #ifndef TIFFPERL_H_ #define TIFFPERL_H_ // Include all of libtiff's headers for internal consistency #include /* * *_t types aren't defined by msvcrt which ming64 (used by Strawberry Perl) * uses instead of glibc */ #ifdef __MINGW32__ typedef uint8 uint8_t; typedef uint16 uint16_t; typedef uint32 uint32_t; typedef uint64 uint64_t; #endif #endif // TIFFPERL_H_ Graphics-TIFF-20/Makefile.PL0000644000175000017500000000620314437671567014170 0ustar jeffjeffuse strict; use warnings; use 5.008; use ExtUtils::MakeMaker; use ExtUtils::Depends; use ExtUtils::PkgConfig; use English; # minimum required version of dependancies we need to build our %build_reqs = ( 'libtiff' => '4.0.3', ); # minimum required version of dependancies we need to run our %runtime_reqs = ( 'libtiff' => '4.0.3', ); # Can't assume ExtUtils::PkgConfig will return anything useful until # the pkg-config files ship with libtiff. my $lib = '-ltiff'; my $inc = '-I. '; my %pkgcfg; if ( eval { %pkgcfg = ExtUtils::PkgConfig->find( 'libtiff-4 >= ' . $build_reqs{libtiff} ); } ) { $lib = $pkgcfg{libs}; $inc .= $pkgcfg{cflags}; $runtime_reqs{libtiff} = $pkgcfg{modversion}; } # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Graphics::TIFF', VERSION_FROM => 'lib/Graphics/TIFF.pm', # finds $VERSION PREREQ_PM => { Readonly => 0, ( $OSNAME =~ /mswin/i ) ? ( "Alien::libtiff" => 0 ) : (), }, CONFIGURE_REQUIRES => { 'ExtUtils::Depends' => 0, 'ExtUtils::PkgConfig' => 0, ( $OSNAME =~ /mswin/i ) ? ( "Alien::libtiff" => 0 ) : (), }, TEST_REQUIRES => { 'File::Spec' => 0, 'File::Temp' => 0.19, 'Test::More' => 0, 'Test::Requires' => 0, 'Test::Deep' => 0, }, META_MERGE => { 'meta-spec' => { version => 2 }, resources => { repository => { type => 'git', url => 'https://github.com/carygravel/graphics-tiff.git', web => 'https://github.com/carygravel/graphics-tiff', }, }, # because Alien::libtiff is only required for Windows dynamic_config => 1, }, clean => { FILES => '$(SOURCE_TIDY)' }, # CPAN does not recognise .xz encoded files # dist => { COMPRESS => 'xz -9', SUFFIX => '.xz', }, ( $] >= 5.005 ? ## Add these new keywords supported since 5.005 ( ABSTRACT_FROM => 'lib/Graphics/TIFF.pm', # retrieve abstract from module AUTHOR => 'Jeffrey Ratcliffe' ) : () ), LIBS => [$lib], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => $inc, # e.g., '-I. -I/usr/include/other' # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too ); sub MY::postamble { # GNU Make extensions that BSD make doesn't like. # Author-only stuff, so comment out for non-Linux. if ( $OSNAME ne 'linux' ) { return '' } return <<'END'; SHELL = bash MANIFEST = $(shell cat MANIFEST) SOURCE = $(filter bin/% examples/% %.pm %.PL %.pl %.t,$(MANIFEST)) SOURCE_TIDY = $(foreach file,$(SOURCE),$(file).tdy) MANIFEST : $(SOURCE) git ls-files | egrep -v '^\.(git|be)' > $@ tardist : README README : lib/Graphics/TIFF.pm pod2readme $< $@ tidy : MANIFEST $(SOURCE_TIDY) README %.tdy : % perltidy $* && if ! diff -q $@ $* > /dev/null; then cp $@ $*; fi END } Graphics-TIFF-20/examples/0000755000175000017500000000000014437671601014020 5ustar jeffjeffGraphics-TIFF-20/examples/tiff2pdf.pl0000644000175000017500000040516014436713615016070 0ustar jeffjeff#!/usr/bin/perl use warnings; use strict; use Graphics::TIFF ':all'; use feature 'switch'; no if $] >= 5.018, warnings => 'experimental::smartmatch'; use English qw( -no_match_vars ); use File::Temp; # To create temporary files use Readonly; Readonly my $PS_UNIT_SIZE => 72; Readonly my $T2P_CS_BILEVEL => 0x01; Readonly my $T2P_CS_GRAY => 0x02; Readonly my $T2P_CS_RGB => 0x04; Readonly my $T2P_CS_CMYK => 0x08; Readonly my $T2P_CS_LAB => 0x10; Readonly my $T2P_CS_PALETTE => 0x1000; Readonly my $T2P_CS_CALGRAY => 0x20; Readonly my $T2P_CS_CALRGB => 0x40; Readonly my $T2P_CS_ICCBASED => 0x80; Readonly my $T2P_COMPRESS_NONE => 0x00; Readonly my $T2P_COMPRESS_G4 => 0x01; Readonly my $T2P_COMPRESS_JPEG => 0x02; Readonly my $T2P_COMPRESS_ZIP => 0x04; Readonly my $T2P_TRANSCODE_RAW => 0x01; Readonly my $T2P_TRANSCODE_ENCODE => 0x02; Readonly my $T2P_SAMPLE_NOTHING => 0x0000; Readonly my $T2P_SAMPLE_ABGR_TO_RGB => 0x0001; Readonly my $T2P_SAMPLE_RGBA_TO_RGB => 0x0002; Readonly my $T2P_SAMPLE_RGBAA_TO_RGB => 0x0004; Readonly my $T2P_SAMPLE_YCBCR_TO_RGB => 0x0008; Readonly my $T2P_SAMPLE_YCBCR_TO_LAB => 0x0010; Readonly my $T2P_SAMPLE_REALIZE_PALETTE => 0x0020; Readonly my $T2P_SAMPLE_SIGNED_TO_UNSIGNED => 0x0040; Readonly my $T2P_SAMPLE_LAB_SIGNED_TO_UNSIGNED => 0x0040; Readonly my $T2P_SAMPLE_PLANAR_SEPARATE_TO_CONTIG => 0x0100; Readonly my $EXIT_SUCCESS => 0; Readonly my $EXIT_FAILURE => 1; Readonly my $T2P_ERR_OK => 0; Readonly my $T2P_ERR_ERROR => 1; Readonly my $SEEK_SET => 0; # Seek from beginning of file. Readonly my $SEEK_CUR => 1; # Seek from current position. our $VERSION; my ($optarg); my $optind = 0; my $stoponerr = 1; my $TIFF2PDF_MODULE = 'tiff2pdf'; # Procs for TIFFClientOpen sub t2pReadFile { my ( $tif, $data, $size ) = @_; my $client = $tif->Clientdata(); my $proc = $tif->GetReadProc(); if ($proc) { return $proc->( $client, $data, $size ) } return -1; } sub t2pWriteFile { my ( $output, $buffer ) = @_; print {$output} $buffer; return length $buffer; } sub t2pSeekFile { my ( $tif, $offset, $whence ) = @_; my $client = $tif->Clientdata(); my $proc = $tif->GetSeekProc(); if ($proc) { return $proc->( $client, $offset, $whence ) } return -1; } sub t2p_readproc { my ( $handle, $data, $size ) = @_; return -1; } sub t2p_writeproc { my ( $t2p, $data, $size ) = @_; if ( $t2p->{outputdisable} <= 0 && $t2p->{outputfile} ) { my $written = fwrite( $data, 1, $size, $t2p->{outputfile} ); $t2p->{outputwritten} += $written; return $written; } return $size; } sub t2p_seekproc { my ( $t2p, $offset, $whence ) = @_; if ( $t2p->{outputdisable} <= 0 && $t2p->{outputfile} ) { return fseek( $t2p->{outputfile}, $offset, $whence ); } return $offset; } sub t2p_closeproc { my ($handle) = @_; return 0; } sub t2p_sizeproc { my ($handle) = @_; return -1; } sub t2p_mapproc { my ( $handle, $data, $offset ) = @_; return -1; } sub t2p_unmapproc { my ( $handle, $data, $offset ) = @_; return; } sub main { my ( %t2p, $outfilename, $input, $output ); $t2p{pdf_majorversion} = 1; $t2p{pdf_minorversion} = 1; $t2p{pdf_defaultxres} = 300.0; $t2p{pdf_defaultyres} = 300.0; $t2p{pdf_defaultpagewidth} = 612.0; $t2p{pdf_defaultpagelength} = 792.0; $t2p{pdf_xrefcount} = 3; # Catalog, Info, Pages $t2p{pdf_centimeters} = 0; $t2p{pdf_overridepagesize} = 0; $t2p{pdf_colorspace_invert} = 0; while ( my $c = getopt('o:q:u:x:y:w:l:r:p:e:c:a:t:s:k:jzndifbhF') ) { given ($c) { when ('a') { $t2p{pdf_author} = $optarg; } when ('b') { $t2p{pdf_image_interpolate} = 1; } when ('c') { $t2p{pdf_creator} = $optarg; } when ('d') { $t2p{pdf_defaultcompression} = $T2P_COMPRESS_NONE; } when ('e') { if ( not defined $optarg ) { $t2p{pdf_datetime} = q{}; } else { $t2p{pdf_datetime} = "D:$optarg"; } } when ('F') { $t2p{pdf_image_fillpage} = 1; } when ('f') { $t2p{pdf_fitwindow} = 1; } when ('i') { $t2p{pdf_colorspace_invert} = 1; } when ('j') { $t2p{pdf_defaultcompression} = $T2P_COMPRESS_JPEG; } when ('k') { $t2p{pdf_keywords} = $optarg; } when ('l') { $t2p{pdf_overridepagesize} = 1; $t2p{pdf_defaultpagelength} = $optarg * $PS_UNIT_SIZE / ( $t2p{pdf_centimeters} ? 2.54 : 1 ) } when ('n') { $t2p{pdf_nopassthrough} = 1; } when ('o') { $outfilename = $optarg; } when ('p') { if ( match_paper_size( \%t2p, $optarg ) ) { $t2p{pdf_overridepagesize} = 1; } else { warn "$TIFF2PDF_MODULE: Unknown paper size $optarg, ignoring option\n"; } } when ('q') { $t2p{pdf_defaultcompressionquality} = $optarg; } when ('r') { if ( substr( $optarg, 0, 1 ) eq 'o' ) { $t2p{pdf_overrideres} = 1; } } when ('s') { $t2p{pdf_subject} = $optarg; } when ('t') { $t2p{pdf_title} = $optarg; } when ('u') { if ( substr( $optarg, 0, 1 ) eq 'm' ) { $t2p{pdf_centimeters} = 1; } } when ('w') { $t2p{pdf_overridepagesize} = 1; $t2p{pdf_defaultpagewidth} = $optarg * $PS_UNIT_SIZE / ( $t2p{pdf_centimeters} ? 2.54 : 1 ) } when ('x') { $t2p{pdf_defaultxres} = $optarg / ( $t2p{pdf_centimeters} ? 2.54 : 1 ) } when ('y') { $t2p{pdf_defaultyres} = $optarg / ( $t2p{pdf_centimeters} ? 2.54 : 1 ) } when ('z') { $t2p{pdf_defaultcompression} = $T2P_COMPRESS_ZIP; } default { usage(); } } } # Input if ( $optind < @ARGV ) { $input = Graphics::TIFF->Open( $ARGV[ $optind++ ], 'r' ); if ( not defined $input ) { die "$TIFF2PDF_MODULE: Unknown paper size $ARGV[$optind-1], ignoring option\n"; } } else { warn "$TIFF2PDF_MODULE: No input file specified\n"; usage(); exit $EXIT_FAILURE; } if ( $optind < @ARGV ) { warn "$TIFF2PDF_MODULE: No support for multiple input files\n"; usage(); exit $EXIT_FAILURE; } # Output $t2p{outputdisable} = 0; if ( defined $outfilename ) { open $output, '>', $outfilename or die "$TIFF2PDF_MODULE: Can't open output file $outfilename for writing\n"; } else { $outfilename = q{-}; $output = *STDOUT; } if ( not defined $output ) { die "$TIFF2PDF_MODULE: Can't initialize output descriptor\n"; } # Validate t2p_validate( \%t2p ); # Write t2p_write_pdf( \%t2p, $input, $output ); if ( $t2p{t2p_error} != 0 ) { die "$TIFF2PDF_MODULE: An error occurred creating output PDF file\n"; } if ( defined $input ) { $input->Close } return $EXIT_SUCCESS; } sub getopt { my ($options) = @_; my $c; if ( substr( $ARGV[$optind], 0, 1 ) eq qw{-} ) { $c = substr $ARGV[ $optind++ ], 1, 1; my $regex = $c; if ( $regex eq qw{?} ) { $regex = qw{\?} } if ( $options =~ /$regex(:)?/xsm ) { if ( defined $1 ) { $optarg = $ARGV[ $optind++ ] } } else { if ( $OSNAME eq 'freebsd' ) { warn "$TIFF2PDF_MODULE: illegal option -- $c\n"; } else { warn "$TIFF2PDF_MODULE: invalid option -- $c\n"; } usage(); } } return $c; } sub usage { warn Graphics::TIFF->GetVersion() . "\n\n"; warn <<'EOS'; usage: tiff2pdf [options] input.tiff options: -o: output to file name -j: compress with JPEG -z: compress with Zip/Deflate -q: compression quality -n: no compressed data passthrough -d: do not compress (decompress) -i: invert colors -u: set distance unit, 'i' for inch, 'm' for centimeter -x: set x resolution default in dots per unit -y: set y resolution default in dots per unit -w: width in units -l: length in units -r: 'd' for resolution default, 'o' for resolution override -p: paper size, eg "letter", "legal", "A4" -F: make the tiff fill the PDF page -f: set PDF "Fit Window" user preference -e: date, overrides image or current date/time default, YYYYMMDDHHMMSS -c: sets document creator, overrides image software default -a: sets document author, overrides image artist default -t: sets document title, overrides image document name default -s: sets document subject, overrides image image description default -k: sets document keywords -b: set PDF "Interpolate" user preference -h: usage EOS exit $EXIT_FAILURE; } sub match_paper_size { my ( $t2p, $papersize ) = @_; my @sizes = qw( LETTER A4 LEGAL EXECUTIVE LETTER LEGAL LEDGER TABLOID A B C D E F G H J K A10 A9 A8 A7 A6 A5 A4 A3 A2 A1 A0 2A0 4A0 2A 4A B10 B9 B8 B7 B6 B5 B4 B3 B2 B1 B0 JISB10 JISB9 JISB8 JISB7 JISB6 JISB5 JISB4 JISB3 JISB2 JISB1 JISB0 C10 C9 C8 C7 C6 C5 C4 C3 C2 C1 C0 RA2 RA1 RA0 SRA4 SRA3 SRA2 SRA1 SRA0 A3EXTRA A4EXTRA STATEMENT FOLIO QUARTO ); my @widths = ( 612, 595, 612, 522, 612, 612, 792, 792, 612, 792, 1224, 1584, 2448, 2016, 792, 2016, 2448, 2880, 74, 105, 147, 210, 298, 420, 595, 842, 1191, 1684, 2384, 3370, 4768, 3370, 4768, 88, 125, 176, 249, 354, 499, 709, 1001, 1417, 2004, 2835, 91, 128, 181, 258, 363, 516, 729, 1032, 1460, 2064, 2920, 79, 113, 162, 230, 323, 459, 649, 918, 1298, 1298, 2599, 1219, 1729, 2438, 638, 907, 1276, 1814, 2551, 914, 667, 396, 612, 609, ); my @lengths = ( 792, 842, 1008, 756, 792, 1008, 1224, 1224, 792, 1224, 1584, 2448, 3168, 2880, 6480, 10_296, 12_672, 10_296, 105, 147, 210, 298, 420, 595, 842, 1191, 1684, 2384, 3370, 4768, 6741, 4768, 6741, 125, 176, 249, 354, 499, 709, 1001, 1417, 2004, 2835, 4008, 128, 181, 258, 363, 516, 729, 1032, 1460, 2064, 2920, 4127, 113, 162, 230, 323, 459, 649, 918, 1298, 1837, 1837, 3677, 1729, 2438, 3458, 907, 1276, 1814, 2551, 3628, 1262, 914, 612, 936, 780, ); for my $i ( 0 .. @sizes ) { if ( $papersize eq $sizes[$i] ) { $t2p->{pdf_defaultpagewidth} = $widths[$i]; $t2p->{pdf_defaultpagelength} = $lengths[$i]; return 1; } } return; } # This function validates the values of a T2P context struct pointer # before calling t2p_write_pdf with it. sub t2p_validate { my ($t2p) = @_; if ( $t2p->{pdf_defaultcompression} == $T2P_COMPRESS_JPEG ) { if ( $t2p->{pdf_defaultcompressionquality} > 100 || $t2p->{pdf_defaultcompressionquality} < 1 ) { $t2p->{pdf_defaultcompressionquality} = 0; } } elsif ( $t2p->{pdf_defaultcompression} == $T2P_COMPRESS_ZIP ) { my $m = $t2p->{pdf_defaultcompressionquality} % 100; if ( $t2p->{pdf_defaultcompressionquality} / 100 > 9 || ( $m > 1 && $m < 10 ) || $m > 15 ) { $t2p->{pdf_defaultcompressionquality} = 0; } if ( $t2p->{pdf_defaultcompressionquality} % 100 != 0 ) { $t2p->{pdf_defaultcompressionquality} /= 100; $t2p->{pdf_defaultcompressionquality} *= 100; warn "$TIFF2PDF_MODULE: PNG Group predictor differencing not implemented, assuming compression quality $t2p->{pdf_defaultcompressionquality}\n"; } $t2p->{pdf_defaultcompressionquality} %= 100; if ( $t2p->{pdf_minorversion} < 2 ) { $t2p->{pdf_minorversion} = 2; } } return; } # This function scans the input TIFF file for pages. It attempts # to determine which IFD's of the TIFF file contain image document # pages. For each, it gathers some information that has to do # with the output of the PDF document as a whole. sub t2p_read_tiff_init { my ( $t2p, $input ) = @_; my $directorycount = $input->NumberOfDirectories(); $t2p->{tiff_pagecount} = 0; $t2p->{t2p_error} = $T2P_ERR_OK; for my $i ( 0 .. $directorycount - 1 ) { my $subfiletype = 0; if ( !$input->SetDirectory($i) ) { my $msg = sprintf "%s: Can't allocate %lu bytes of memory for tiff_pages array, %s", $TIFF2PDF_MODULE, $i, $input->FileName; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } my ( $pagen, $paged ) = $input->GetField(TIFFTAG_PAGENUMBER); if ( defined $pagen and defined $paged ) { if ( ( $pagen > $paged ) && ( $paged != 0 ) ) { $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_number} = $paged; } else { $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_number} = $pagen; } goto ISPAGE2; } if ( $subfiletype = $input->GetField(TIFFTAG_SUBFILETYPE) ) { if ( ( ( $subfiletype & FILETYPE_PAGE ) != 0 ) || ( $subfiletype == 0 ) ) { goto ISPAGE; } else { goto ISNOTPAGE; } } if ( $subfiletype = $input->GetField(TIFFTAG_OSUBFILETYPE) ) { if ( ( $subfiletype == OFILETYPE_IMAGE ) || ( $subfiletype == OFILETYPE_PAGE ) || ( $subfiletype == 0 ) ) { goto ISPAGE; } else { goto ISNOTPAGE; } } ISPAGE: $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_number} = $t2p->{tiff_pagecount}; ISPAGE2: $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_extra} = 0; $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_directory} = $i; if ( $input->IsTiled() ) { $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_tilecount} = $input->NumberOfTiles(); } else { $t2p->{tiff_pages}[ $t2p->{tiff_pagecount} ]{page_tilecount} = 0; } $t2p->{tiff_pagecount}++; ISNOTPAGE: 0; } @{ $t2p->{tiff_pages} } = sort { $a->{page_number} <=> $b->{page_number} } @{ $t2p->{tiff_pages} }; my $xuint16; for my $i ( 0 .. $t2p->{tiff_pagecount} - 1 ) { $t2p->{pdf_xrefcount} += 5; $input->SetDirectory( $t2p->{tiff_pages}[$i]{page_directory} ); if ( $input->GetField(TIFFTAG_PHOTOMETRIC) == PHOTOMETRIC_PALETTE || $input->GetField(TIFFTAG_INDEXED) ) { $t2p->{tiff_pages}[$i]{page_extra}++; $t2p->{pdf_xrefcount}++; } my $xuint16 = $input->GetField(TIFFTAG_COMPRESSION); if ( defined $xuint16 ) { if ( ( $xuint16 == COMPRESSION_DEFLATE || $xuint16 == COMPRESSION_ADOBE_DEFLATE ) && ( ( $t2p->{tiff_pages}[$i]{page_tilecount} != 0 ) || $input->NumberOfStrips() == 1 ) && ( $t2p->{pdf_nopassthrough} == 0 ) ) { if ( $t2p->{pdf_minorversion} < 2 ) { $t2p->{pdf_minorversion} = 2; } } } if ( @{ $t2p->{tiff_transferfunction} } = $input->GetField(TIFFTAG_TRANSFERFUNCTION) ) { if ( $t2p->{tiff_transferfunction}[1] != $t2p->{tiff_transferfunction}[0] ) { $t2p->{tiff_transferfunctioncount} = 3; $t2p->{tiff_pages}[$i]{page_extra} += 4; $t2p->{pdf_xrefcount} += 4; } else { $t2p->{tiff_transferfunctioncount} = 1; $t2p->{tiff_pages}[$i]{page_extra} += 2; $t2p->{pdf_xrefcount} += 2; } if ( $t2p->{pdf_minorversion} < 2 ) { $t2p->{pdf_minorversion} = 2; } } else { $t2p->{tiff_transferfunctioncount} = 0; } if ( $t2p->{tiff_iccprofile} = $input->GetField(TIFFTAG_ICCPROFILE) ) { $t2p->{tiff_pages}[$i]{page_extra}++; $t2p->{pdf_xrefcount}++; if ( $t2p->{pdf_minorversion} < 3 ) { $t2p->{pdf_minorversion} = 3 } } $t2p->{tiff_tiles}[$i]{tiles_tilecount} = $t2p->{tiff_pages}[$i]{page_tilecount}; if ( ( $xuint16 = $input->GetField(TIFFTAG_PLANARCONFIG) != 0 ) && ( $xuint16 == PLANARCONFIG_SEPARATE ) ) { $xuint16 = $input->GetField(TIFFTAG_SAMPLESPERPIXEL); $t2p->{tiff_tiles}[$i]{tiles_tilecount} /= $xuint16; } if ( $t2p->{tiff_tiles}[$i]{tiles_tilecount} > 0 ) { $t2p->{pdf_xrefcount} += ( $t2p->{tiff_tiles}[$i]{tiles_tilecount} - 1 ) * 2; $t2p->{tiff_tiles}[$i]{tiles_tilewidth} = $input->GetField(TIFFTAG_TILEWIDTH); $t2p->{tiff_tiles}[$i]{tiles_tilelength} = $input = GetField(TIFFTAG_TILELENGTH); } } return; } # This function sets the input directory to the directory of a given # page and determines information about the image. It checks # the image characteristics to determine if it is possible to convert # the image data into a page of PDF output, setting values of the T2P # struct for this page. It determines what color space is used in # the output PDF to represent the image. # It determines if the image can be converted as raw data without # requiring transcoding of the image data. sub t2p_read_tiff_data { my ( $t2p, $input ) = @_; $t2p->{pdf_transcode} = $T2P_TRANSCODE_ENCODE; $t2p->{pdf_sample} = $T2P_SAMPLE_NOTHING; $t2p->{pdf_switchdecode} = $t2p->{pdf_colorspace_invert}; $input->SetDirectory( $t2p->{tiff_pages}[ $t2p->{pdf_page} ]{page_directory} ); $t2p->{tiff_width} = $input->GetField(TIFFTAG_IMAGEWIDTH); if ( $t2p->{tiff_width} == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with zero width", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } $t2p->{tiff_length} = $input->GetField(TIFFTAG_IMAGELENGTH); if ( not defined $t2p->{tiff_length} ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with zero length", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } $t2p->{tiff_compression} = $input->GetField(TIFFTAG_COMPRESSION); if ( not defined $t2p->{tiff_compression} ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with no compression tag", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } if ( Graphics::TIFF->IsCODECConfigured( $t2p->{tiff_compression} ) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with compression type %u: not configured", $input->FileName(), $t2p->{tiff_compression}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } $t2p->{tiff_bitspersample} = $input->GetFieldDefaulted(TIFFTAG_BITSPERSAMPLE); given ( $t2p->{tiff_bitspersample} ) { when (1) { } when (2) { } when (4) { } when (8) { } when (0) { my $msg = sprintf "$TIFF2PDF_MODULE: Image %s has 0 bits per sample, assuming 1", $input->FileName(); warn "$msg\n"; $t2p->{tiff_bitspersample} = 1; } default { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with %u bits per sample", $input->FileName(), $t2p->{tiff_bitspersample}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } $t2p->{tiff_samplesperpixel} = $input->GetFieldDefaulted(TIFFTAG_SAMPLESPERPIXEL); if ( $t2p->{tiff_samplesperpixel} > 4 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with %u samples per pixel", $input->FileName(), $t2p->{tiff_samplesperpixel}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } if ( $t2p->{tiff_samplesperpixel} == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Image %s has 0 samples per pixel, assuming 1", $input->FileName(); warn "$msg\n"; $t2p->{tiff_samplesperpixel} = 1; } my $xuint16 = $input->GetField(TIFFTAG_SAMPLEFORMAT); if ( defined $xuint16 and $xuint16 != 1 and $xuint16 != 4 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with sample format %u", $input->FileName(), $xuint16; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } $t2p->{tiff_fillorder} = $input->GetFieldDefaulted(TIFFTAG_FILLORDER); $t2p->{tiff_photometric} = $input->GetField(TIFFTAG_PHOTOMETRIC); if ( not defined $t2p->{tiff_photometric} ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with no photometric interpretation tag", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } given ( $t2p->{tiff_photometric} ) { when ( [ PHOTOMETRIC_MINISWHITE, PHOTOMETRIC_MINISBLACK ] ) { if ( $t2p->{tiff_bitspersample} == 1 ) { $t2p->{pdf_colorspace} = $T2P_CS_BILEVEL; if ( $t2p->{tiff_photometric} == PHOTOMETRIC_MINISWHITE ) { $t2p->{pdf_switchdecode} ^= 1; } } else { $t2p->{pdf_colorspace} = $T2P_CS_GRAY; if ( $t2p->{tiff_photometric} == PHOTOMETRIC_MINISWHITE ) { $t2p->{pdf_switchdecode} ^= 1; } } } when (PHOTOMETRIC_RGB) { $t2p->{pdf_colorspace} = $T2P_CS_RGB; if ( $t2p->{tiff_samplesperpixel} == 3 ) { break; } if ( $xuint16 = $input->GetField(TIFFTAG_INDEXED) ) { if ( $xuint16 == 1 ) { goto PHOTOMETRIC_PALETTE } } if ( $t2p->{tiff_samplesperpixel} > 3 ) { if ( $t2p->{tiff_samplesperpixel} == 4 ) { $t2p->{pdf_colorspace} = $T2P_CS_RGB; my @extra = $input->GetField(TIFFTAG_EXTRASAMPLES); if ( @extra and $extra[0] == 1 ) { if ( $extra[1] == EXTRASAMPLE_ASSOCALPHA ) { $t2p->{pdf_sample} = $T2P_SAMPLE_RGBAA_TO_RGB; break; } if ( $extra[1] == EXTRASAMPLE_UNASSALPHA ) { $t2p->{pdf_sample} = $T2P_SAMPLE_RGBA_TO_RGB; break; } my $msg = sprintf "$TIFF2PDF_MODULE: RGB image %s has 4 samples per pixel, assuming RGBA", $input->FileName(); warn "$msg\n"; break; } $t2p->{pdf_colorspace} = $T2P_CS_CMYK; $t2p->{pdf_switchdecode} ^= 1; my $msg = sprintf "$TIFF2PDF_MODULE: RGB image %s has 4 samples per pixel, assuming inverse CMYK", $input->FileName(); warn "$msg\n"; break; } else { my $msg = sprintf "$TIFF2PDF_MODULE: No support for RGB image %s with %u samples per pixel", $input->FileName(), $t2p->{tiff_samplesperpixel}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; break; } } else { my $msg = sprintf "$TIFF2PDF_MODULE: No support for RGB image %s with %u samples per pixel", $input->FileName(), $t2p->{tiff_samplesperpixel}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; break; } } when (PHOTOMETRIC_PALETTE) { PHOTOMETRIC_PALETTE: if ( $t2p->{tiff_samplesperpixel} != 1 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for palettized image %s with not one sample per pixel", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } $t2p->{pdf_colorspace} = $T2P_CS_RGB | $T2P_CS_PALETTE; $t2p->{pdf_palettesize} = 0x0001 << $t2p->{tiff_bitspersample}; my @rgb = $input->GetField(TIFFTAG_COLORMAP); if ( !@rgb ) { my $msg = sprintf "$TIFF2PDF_MODULE: Palettized image %s has no color map", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } for my $i ( 0 .. $t2p->{pdf_palettesize} - 1 ) { $t2p->{pdf_palette}[ $i * 3 ] = $rgb[0][$i] >> 8; $t2p->{pdf_palette}[ $i * 3 + 1 ] = $rgb[1][$i] >> 8; $t2p->{pdf_palette}[ $i * 3 + 2 ] = $rgb[2][$i] >> 8; } $t2p->{pdf_palettesize} *= 3; break; } when (PHOTOMETRIC_SEPARATED) { if ( $xuint16 = $input->GetField(TIFFTAG_INDEXED) ) { if ( $xuint16 == 1 ) { goto PHOTOMETRIC_PALETTE_CMYK } } if ( $xuint16 = $input->GetField(TIFFTAG_INKSET) ) { if ( $xuint16 != INKSET_CMYK ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s because its inkset is not CMYK", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } if ( $t2p->{tiff_samplesperpixel} == 4 ) { $t2p->{pdf_colorspace} = $T2P_CS_CMYK; } else { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s because it has %u samples per pixel", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } break; PHOTOMETRIC_PALETTE_CMYK: if ( $t2p->{tiff_samplesperpixel} != 1 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for palettized CMYK image %s with not one sample per pixel", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } $t2p->{pdf_colorspace} = $T2P_CS_CMYK | $T2P_CS_PALETTE; $t2p->{pdf_palettesize} = 0x0001 << $t2p->{tiff_bitspersample}; my @rgba = $input->GetField( TIFFTAG_COLORMAP, &r, &g, &b, &a ); if ( !@rgba ) { my $msg = sprintf "$TIFF2PDF_MODULE: Palettized image %s has no color map", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } for my $i ( 0 .. $t2p->{pdf_palettesize} - 1 ) { $t2p->{pdf_palette}[ $i * 4 ] = $rgba[0][$i] >> 8; $t2p->{pdf_palette}[ $i * 4 + 1 ] = $rgba[1][$i] >> 8; $t2p->{pdf_palette}[ $i * 4 + 2 ] = $rgba[2][$i] >> 8; $t2p->{pdf_palette}[ $i * 4 + 3 ] = $rgba[3][$i] >> 8; } $t2p->{pdf_palettesize} *= 4; } when (PHOTOMETRIC_YCBCR) { $t2p->{pdf_colorspace} = $T2P_CS_RGB; if ( $t2p->{tiff_samplesperpixel} == 1 ) { $t2p->{pdf_colorspace} = $T2P_CS_GRAY; $t2p->{tiff_photometric} = PHOTOMETRIC_MINISBLACK; break; } $t2p->{pdf_sample} = $T2P_SAMPLE_YCBCR_TO_RGB; if ( $t2p->{pdf_defaultcompression} == $T2P_COMPRESS_JPEG ) { $t2p->{pdf_sample} = $T2P_SAMPLE_NOTHING; } } when (PHOTOMETRIC_CIELAB) { $t2p->{pdf_labrange}[0] = -127; $t2p->{pdf_labrange}[1] = 127; $t2p->{pdf_labrange}[2] = -127; $t2p->{pdf_labrange}[3] = 127; $t2p->{pdf_sample} = $T2P_SAMPLE_LAB_SIGNED_TO_UNSIGNED; $t2p->{pdf_colorspace} = $T2P_CS_LAB; } when (PHOTOMETRIC_ICCLAB) { $t2p->{pdf_labrange}[0] = 0; $t2p->{pdf_labrange}[1] = 255; $t2p->{pdf_labrange}[2] = 0; $t2p->{pdf_labrange}[3] = 255; $t2p->{pdf_colorspace} = $T2P_CS_LAB; } when (PHOTOMETRIC_ITULAB) { $t2p->{pdf_labrange}[0] = -85; $t2p->{pdf_labrange}[1] = 85; $t2p->{pdf_labrange}[2] = -75; $t2p->{pdf_labrange}[3] = 124; $t2p->{pdf_sample} = $T2P_SAMPLE_LAB_SIGNED_TO_UNSIGNED; $t2p->{pdf_colorspace} = $T2P_CS_LAB; } when (PHOTOMETRIC_LOGL) { } when (PHOTOMETRIC_LOGLUV) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with photometric interpretation LogL/LogLuv", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } default { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with photometric interpretation %u", $input->FileName(), $t2p->{tiff_photometric}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } if ( $t2p->{tiff_planar} = $input->GetField(TIFFTAG_PLANARCONFIG) ) { given ( $t2p->{tiff_planar} ) { when (0) { my $msg = sprintf "$TIFF2PDF_MODULE: Image %s has planar configuration 0, assuming 1", $input->FileName(); warn "$msg\n"; $t2p->{tiff_planar} = PLANARCONFIG_CONTIG; } when (PLANARCONFIG_CONTIG) { } when (PLANARCONFIG_SEPARATE) { $t2p->{pdf_sample} = $T2P_SAMPLE_PLANAR_SEPARATE_TO_CONTIG; if ( $t2p->{tiff_bitspersample} != 8 ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with separated planar configuration and %u bits per sample", $input->FileName(), $t2p->{tiff_bitspersample}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } default { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with planar configuration %u", $input->FileName(), $t2p->{tiff_planar}; warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } } $t2p->{tiff_orientation} = $input->GetFieldDefaulted(TIFFTAG_ORIENTATION); if ( $t2p->{tiff_orientation} > 8 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Image %s has orientation %u, assuming 0", $input->FileName(), $t2p->{tiff_orientation}; warn "$msg\n"; $t2p->{tiff_orientation} = 0; } $t2p->{tiff_xres} = $input->GetField(TIFFTAG_XRESOLUTION); if ( not defined $t2p->{tiff_xres} ) { $t2p->{tiff_xres} = 0.0; } $t2p->{tiff_yres} = $input->GetField(TIFFTAG_YRESOLUTION); if ( not defined $t2p->{tiff_yres} ) { $t2p->{tiff_yres} = 0.0; } $t2p->{tiff_resunit} = $input->GetFieldDefaulted(TIFFTAG_RESOLUTIONUNIT); if ( $t2p->{tiff_resunit} == RESUNIT_CENTIMETER ) { $t2p->{tiff_xres} *= 2.54; $t2p->{tiff_yres} *= 2.54; } elsif ($t2p->{tiff_resunit} != RESUNIT_INCH && $t2p->{pdf_centimeters} != 0 ) { $t2p->{tiff_xres} *= 2.54; $t2p->{tiff_yres} *= 2.54; } t2p_compose_pdf_page($t2p); $t2p->{pdf_transcode} = $T2P_TRANSCODE_ENCODE; if ( not defined $t2p->{pdf_nopassthrough} or $t2p->{pdf_nopassthrough} == 0 ) { if ( $t2p->{tiff_compression} == COMPRESSION_CCITTFAX4 ) { if ( $input->IsTiled() || ( $input->NumberOfStrips() == 1 ) ) { $t2p->{pdf_transcode} = $T2P_TRANSCODE_RAW; $t2p->{pdf_compression} = $T2P_COMPRESS_G4; } } if ( $t2p->{tiff_compression} == COMPRESSION_ADOBE_DEFLATE || $t2p->{tiff_compression} == COMPRESSION_DEFLATE ) { if ( $input->IsTiled() || ( $input->NumberOfStrips() == 1 ) ) { $t2p->{pdf_transcode} = $T2P_TRANSCODE_RAW; $t2p->{pdf_compression} = $T2P_COMPRESS_ZIP; } } if ( $t2p->{tiff_compression} == COMPRESSION_OJPEG ) { $t2p->{pdf_transcode} = $T2P_TRANSCODE_RAW; $t2p->{pdf_compression} = $T2P_COMPRESS_JPEG; t2p_process_ojpeg_tables( $t2p, $input ); } if ( $t2p->{tiff_compression} == COMPRESSION_JPEG ) { $t2p->{pdf_transcode} = $T2P_TRANSCODE_RAW; $t2p->{pdf_compression} = $T2P_COMPRESS_JPEG; } } if ( $t2p->{pdf_transcode} != $T2P_TRANSCODE_RAW ) { $t2p->{pdf_compression} = $t2p->{pdf_defaultcompression}; } if ( $t2p->{pdf_defaultcompression} == $T2P_COMPRESS_JPEG ) { if ( $t2p->{pdf_colorspace} & $T2P_CS_PALETTE ) { $t2p->{pdf_sample} |= $T2P_SAMPLE_REALIZE_PALETTE; $t2p->{pdf_colorspace} ^= $T2P_CS_PALETTE; $t2p->{tiff_pages}[ $t2p->{pdf_page} ]{page_extra}--; } } if ( $t2p->{tiff_compression} == COMPRESSION_JPEG ) { if ( $t2p->{tiff_planar} == PLANARCONFIG_SEPARATE ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with JPEG compression and separated planar configuration", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } if ( $t2p->{tiff_compression} == COMPRESSION_OJPEG ) { if ( $t2p->{tiff_planar} == PLANARCONFIG_SEPARATE ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for %s with OJPEG compression and separated planar configuration", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_REALIZE_PALETTE ) { if ( $t2p->{pdf_colorspace} & $T2P_CS_CMYK ) { $t2p->{tiff_samplesperpixel} = 4; $t2p->{tiff_photometric} = PHOTOMETRIC_SEPARATED; } else { $t2p->{tiff_samplesperpixel} = 3; $t2p->{tiff_photometric} = PHOTOMETRIC_RGB; } } if ( $t2p->{tiff_transferfunction} = $input->GetField(TIFFTAG_TRANSFERFUNCTION) ) { if ( $t2p->{tiff_transferfunction}[1] != $t2p->{tiff_transferfunction}[0] ) { $t2p->{tiff_transferfunctioncount} = 3; } else { $t2p->{tiff_transferfunctioncount} = 1; } } else { $t2p->{tiff_transferfunctioncount} = 0; } my @xfloat = $input->GetField(TIFFTAG_WHITEPOINT); if (@xfloat) { $t2p->{tiff_whitechromaticities} = [@xfloat]; if ( $t2p->{pdf_colorspace} & $T2P_CS_GRAY ) { $t2p->{pdf_colorspace} |= $T2P_CS_CALGRAY; } if ( $t2p->{pdf_colorspace} & $T2P_CS_RGB ) { $t2p->{pdf_colorspace} |= $T2P_CS_CALRGB; } } if ( @xfloat = $input->GetField(TIFFTAG_PRIMARYCHROMATICITIES) ) { $t2p->{tiff_primarychromaticities} = [@xfloat]; if ( $t2p->{pdf_colorspace} & $T2P_CS_RGB ) { $t2p->{pdf_colorspace} |= $T2P_CS_CALRGB; } } if ( $t2p->{pdf_colorspace} & $T2P_CS_LAB ) { if ( @xfloat = $input->GetField(TIFFTAG_WHITEPOINT) ) { $t2p->{tiff_whitechromaticities} = [@xfloat]; } else { $t2p->{tiff_whitechromaticities}[0] = 0.3457; $t2p->{tiff_whitechromaticities}[1] = 0.3585; } } if ( ( $t2p->{tiff_iccprofilelength}, $t2p->{tiff_iccprofile} ) = $input->GetField(TIFFTAG_ICCPROFILE) ) { $t2p->{pdf_colorspace} |= $T2P_CS_ICCBASED; } else { $t2p->{tiff_iccprofilelength} = 0; $t2p->{tiff_iccprofile} = undef; } if ( $t2p->{tiff_bitspersample} == 1 && $t2p->{tiff_samplesperpixel} == 1 ) { $t2p->{pdf_compression} = $T2P_COMPRESS_G4; } return; } # This function returns the necessary size of a data buffer to contain the raw or # uncompressed image data from the input TIFF for a page. sub t2p_read_tiff_size { my ( $t2p, $input ) = @_; my $k = 0; if ( $t2p->{pdf_transcode} == $T2P_TRANSCODE_RAW ) { if ( $t2p->{pdf_compression} == $T2P_COMPRESS_G4 ) { my @sbc = $input->GetField(TIFFTAG_STRIPBYTECOUNTS); $t2p->{tiff_datasize} = $sbc[0]; return; } if ( $t2p->{pdf_compression} == $T2P_COMPRESS_ZIP ) { my @sbc = $input->GetField(TIFFTAG_STRIPBYTECOUNTS); $t2p->{tiff_datasize} = $sbc[0]; return; } if ( $t2p->{tiff_compression} == COMPRESSION_OJPEG ) { my @sbc = $input->GetField(TIFFTAG_STRIPBYTECOUNTS); if ( !@sbc ) { my $msg = sprintf "$TIFF2PDF_MODULE: Input file %s missing field: TIFFTAG_STRIPBYTECOUNTS", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } my $stripcount = $input->NumberOfStrips; for ( my $i = 0 ; $i < $stripcount ; $i++ ) { $k += $sbc[$i]; } $t2p->{tiff_dataoffset} = $input->GetField(TIFFTAG_JPEGIFOFFSET); if ( $t2p->{tiff_dataoffset} != 0 ) { $t2p->{tiff_datasize} = $input->GetField(TIFFTAG_JPEGIFBYTECOUNT); if ( $t2p->{tiff_datasize} != 0 ) { if ( $t2p->{tiff_datasize} < $k ) { my $msg = sprintf "$TIFF2PDF_MODULE: Input file %s has short JPEG interchange file byte count", $input->FileName(); warn "$msg\n"; $t2p->{pdf_ojpegiflength} = $t2p->{tiff_datasize}; $k += $t2p->{tiff_datasize}; $k += 6; $k += $stripcount; $k += $stripcount; $t2p->{tiff_datasize} = $k; return; } return; } else { my $msg = sprintf 'Input file %s missing field: TIFFTAG_JPEGIFBYTECOUNT', $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } } $k += $stripcount; $k += $stripcount; $k += 2048; $t2p->{tiff_datasize} = $k; return; } if ( $t2p->{tiff_compression} == COMPRESSION_JPEG ) { my ( $count, @jpt ) = $input->GetField(TIFFTAG_JPEGTABLES); if ( $count != 0 ) { if ( $count > 4 ) { $k += $count; $k -= 2; # don't use EOI of header } } else { $k = 2; # SOI for first strip } my $stripcount = $input->NumberOfStrips; my @sbc = $input->GetField(TIFFTAG_STRIPBYTECOUNTS); if ( !@sbc ) { my $msg = sprintf 'Input file %s missing field: TIFFTAG_STRIPBYTECOUNTS', $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return; } for ( my $i = 0 ; $i < $stripcount ; $i++ ) { $k += $sbc[$i]; $k -= 4; # don't use SOI or EOI of strip */ } $k += 2; # use EOI of last strip $t2p->{tiff_datasize} = $k; return; } } $k = $input->ScanlineSize * $t2p->{tiff_length}; if ( $t2p->{tiff_planar} == PLANARCONFIG_SEPARATE ) { $k *= $t2p->{tiff_samplesperpixel}; } if ( $k == 0 ) { # Assume we had overflow inside TIFFScanlineSize $t2p->{t2p_error} = $T2P_ERR_ERROR; } $t2p->{tiff_datasize} = $k; return; } # Returns a non-zero value when the tile is on the right edge # and does not have full imaged tile width. sub t2p_tile_is_right_edge { my ( $tiles, $tile ) = @_; if ( ( ( $tile + 1 ) % $tiles->{tiles_tilecountx} == 0 ) && ( $tiles->{tiles_edgetilewidth} != 0 ) ) { return 1; } return 0; } # Returns a non-zero value when the tile is on the bottom edge # and does not have full imaged tile length. sub t2p_tile_is_bottom_edge { my ( $tiles, $tile ) = @_; if ( ( ( $tile + 1 ) > ( $tiles->{tiles_tilecount} - $tiles->{tiles_tilecountx} ) ) && ( $tiles->{tiles_edgetilelength} != 0 ) ) { return 1; } return 0; } # Returns a non-zero value when the tile is a right edge tile # or a bottom edge tile. sub t2p_tile_is_edge { my ( $tiles, $tile ) = @_; return t2p_tile_is_right_edge( $tiles, $tile ) | t2p_tile_is_bottom_edge( $tiles, $tile ); } # Returns a non-zero value when the tile is a right edge tile and a bottom # edge tile. sub t2p_tile_is_corner_edge { my ( $tiles, $tile ) = @_; return t2p_tile_is_right_edge( $tiles, $tile ) & t2p_tile_is_bottom_edge( $tiles, $tile ); } # Reads the raster image data from the input TIFF for an image and writes # the data to the output PDF XObject image dictionary stream. It returns the amount written # or zero on error. sub t2p_readwrite_pdf_image { my ( $t2p, $input, $output ) = @_; my $written = 0; my $buffer = q{}; my $samplebuffer = 0; my $read = 0; my $i = 0; my $j = 0; my $stripcount = 0; my $stripsize = 0; my $sepstripcount = 0; my $sepstripsize = 0; my $inputoffset = 0; my $h_samp = 1; my $v_samp = 1; my $ri = 1; my $rows = 0; my $striplength = 0; my $max_striplength = 0; # Fail if prior error (in particular, can't trust tiff_datasize) if ( $t2p->{t2p_error} != $T2P_ERR_OK ) { return 0 } if ( $t2p->{pdf_transcode} == $T2P_TRANSCODE_RAW ) { if ( $t2p->{pdf_compression} == $T2P_COMPRESS_G4 ) { $buffer = $input->ReadRawStrip( 0, $t2p->{tiff_datasize} ); if ( $t2p->{tiff_fillorder} == FILLORDER_LSB2MSB ) { # make sure is lsb-to-msb # bit-endianness fill order Graphics::TIFF::ReverseBits( $buffer, $t2p->{tiff_datasize} ); } print {$output} $buffer; return $t2p->{tiff_datasize}; } if ( $t2p->{pdf_compression} == $T2P_COMPRESS_ZIP ) { $buffer = $input->ReadRawStrip( 0, $t2p->{tiff_datasize} ); if ( $t2p->{tiff_fillorder} == FILLORDER_LSB2MSB ) { Graphics::TIFF::ReverseBits( $buffer, $t2p->{tiff_datasize} ); } print {$output} $buffer; return $t2p->{tiff_datasize}; } if ( $t2p->{tiff_compression} == COMPRESSION_OJPEG ) { if ( $t2p->{tiff_dataoffset} != 0 ) { if ( $t2p->{pdf_ojpegiflength} == 0 ) { $inputoffset = t2pSeekFile( $input, 0, $SEEK_CUR ); t2pSeekFile( $input, $t2p->{tiff_dataoffset}, $SEEK_SET ); t2pReadFile( $input, $buffer, $t2p->{tiff_datasize} ); t2pSeekFile( $input, $inputoffset, $SEEK_SET ); print {$output} $buffer; return $t2p->{tiff_datasize}; } else { $inputoffset = t2pSeekFile( $input, 0, $SEEK_CUR ); t2pSeekFile( $input, $t2p->{tiff_dataoffset}, $SEEK_SET ); $buffer = t2pReadFile( $input, $t2p->{pdf_ojpegiflength} ); $t2p->{pdf_ojpegiflength} = 0; t2pSeekFile( $input, $inputoffset, $SEEK_SET ); ( $h_samp, $v_samp ) = $input->GetField(TIFFTAG_YCBCRSUBSAMPLING); $buffer .= 0xff; $buffer .= 0xdd; $buffer .= 0x00; $buffer .= 0x04; $h_samp *= 8; $v_samp *= 8; $ri = ( $t2p->{tiff_width} + $h_samp - 1 ) / $h_samp; $rows->$input->GetField(TIFFTAG_ROWSPERSTRIP); $ri *= ( $rows + $v_samp - 1 ) / $v_samp; $buffer .= ( $ri >> 8 ) & 0xff; $buffer .= $ri & 0xff; $stripcount = $input->NumberOfStrips(); for my $i ( 0 .. $stripcount - 1 ) { if ( $i != 0 ) { $buffer .= 0xff; $buffer .= ( 0xd0 | ( ( $i - 1 ) % 8 ) ); } $buffer .= $input->ReadRawStrip( $i, -1 ); } return t2pWriteFile( $output, $buffer ); } } else { if ( !$t2p->{pdf_ojpegdata} ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for OJPEG image %s with bad tables", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } _TIFFmemcpy( $buffer, $t2p->{pdf_ojpegdata}, $t2p->{pdf_ojpegdatalength} ); $stripcount = $input->NumberOfStrips(); for my $i ( 0 .. $stripcount - 1 ) { if ( $i != 0 ) { $buffer .= 0xff; $buffer .= ( 0xd0 | ( ( $i - 1 ) % 8 ) ); } $buffer .= $input->ReadRawStrip( $i, -1 ); } if ( substr( $buffer, length($buffer), 1 ) != 0xd9 or substr( $buffer, length($buffer) - 1, 1 ) != 0xff ) { $buffer .= 0xff; $buffer .= 0xd9; } t2pWriteFile( $output, $buffer ); } return $t2p->{tiff_datasize}; } if ( $t2p->{tiff_compression} == COMPRESSION_JPEG ) { if ( my ( $count, $jpt ) = $input->GetField(TIFFTAG_JPEGTABLES) != 0 ) { if ( $count > 4 ) { _TIFFmemcpy( $buffer, $jpt, $count ); } } $stripcount = $input->NumberOfStrips(); my @sbc = $input->GetField(TIFFTAG_STRIPBYTECOUNTS); for my $i ( 0 .. $stripcount - 1 ) { if ( $sbc[$i] > $max_striplength ) { $max_striplength = $sbc[$i]; } } for my $i ( 0 .. $stripcount - 1 ) { my $stripbuffer = $input->ReadRawStrip( $i, -1 ); if ( !t2p_process_jpeg_strip( $stripbuffer, length($stripbuffer), $buffer, length($buffer), $i, $t2p->{tiff_length} ) ) { my $msg = sprintf "$TIFF2PDF_MODULE: Can't process JPEG data in input file %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } } $buffer .= 0xff; $buffer .= 0xd9; t2pWriteFile( $output, $buffer ); } } if ( $t2p->{pdf_sample} == $T2P_SAMPLE_NOTHING ) { $stripsize = $input->StripSize(); $stripcount = $input->NumberOfStrips(); for my $i ( 0 .. $stripcount - 1 ) { my $stripbuffer = $input->ReadEncodedStrip( $i, $stripsize ); if ( length($stripbuffer) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding strip %u of %s", $i, $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer .= $stripbuffer; } } else { if ( $t2p->{pdf_sample} & $T2P_SAMPLE_PLANAR_SEPARATE_TO_CONTIG ) { $sepstripsize = $input->StripSize(); $sepstripcount = $input->NumberOfStrips(); $stripsize = $sepstripsize * $t2p->{tiff_samplesperpixel}; $stripcount = $sepstripcount / $t2p->{tiff_samplesperpixel}; for my $i ( 0 .. $stripcount - 1 ) { for my $j ( 0 .. $t2p->{tiff_samplesperpixel} - 1 ) { my $stripbuffer = $input->ReadEncodedStrip( $i + $j * $stripcount, $sepstripsize ); if ( length($stripbuffer) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding strip %u of %s", $i + $j * $stripcount, $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer .= $stripbuffer; } $buffer .= t2p_sample_planar_separate_to_contig( $t2p, $samplebuffer, length $samplebuffer ); } goto DATAREADY; } $stripsize = $input->StripSize(); $stripcount = $input->NumberOfStrips(); for my $i ( 0 .. $stripcount - 1 ) { my $stripbuffer = $input->ReadEncodedStrip( $i, $stripsize ); if ( length($stripbuffer) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding strip %u of %s", $i, $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer .= $stripbuffer; } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_REALIZE_PALETTE ) { # FIXME: overflow? $buffer = $samplebuffer; $t2p->{tiff_datasize} *= $t2p->{tiff_samplesperpixel}; t2p_sample_realize_palette( $t2p, $buffer ); } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_RGBA_TO_RGB ) { $t2p->{tiff_datasize} = t2p_sample_rgba_to_rgb( $buffer, $t2p->{tiff_width} * $t2p->{tiff_length} ); } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_RGBAA_TO_RGB ) { $t2p->{tiff_datasize} = t2p_sample_rgbaa_to_rgb( $buffer, $t2p->{tiff_width} * $t2p->{tiff_length} ); } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_YCBCR_TO_RGB ) { $buffer = $input->ReadRGBAImageOriented( $t2p->{tiff_width}, $t2p->{tiff_length}, ORIENTATION_TOPLEFT, 0 ); if ( !$buffer ) { my $msg = sprintf "$TIFF2PDF_MODULE: Can't use TIFFReadRGBAImageOriented to extract RGB image from %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $t2p->{tiff_datasize} = t2p_sample_abgr_to_rgb( $buffer, $t2p->{tiff_width} * $t2p->{tiff_length} ); } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_LAB_SIGNED_TO_UNSIGNED ) { $t2p->{tiff_datasize} = t2p_sample_lab_signed_to_unsigned( $buffer, $t2p->{tiff_width} * $t2p->{tiff_length} ); } } DATAREADY: # use TIFFStreamOpen instead, as in # https://stackoverflow.com/questions/4624144/c-libtiff-read-and-save-file-from-and-to-memory # Temporary TIF to get the image data in correct format # before writing to PDF my $temp = File::Temp->new( SUFFIX => '.tif' ); my $tif = Graphics::TIFF->Open( $temp, 'w' ); $tif->SetField( TIFFTAG_PHOTOMETRIC, $t2p->{tiff_photometric} ); $tif->SetField( TIFFTAG_BITSPERSAMPLE, $t2p->{tiff_bitspersample} ); $tif->SetField( TIFFTAG_SAMPLESPERPIXEL, $t2p->{tiff_samplesperpixel} ); $tif->SetField( TIFFTAG_IMAGEWIDTH, $t2p->{tiff_width} ); $tif->SetField( TIFFTAG_IMAGELENGTH, $t2p->{tiff_length} ); $tif->SetField( TIFFTAG_ROWSPERSTRIP, $t2p->{tiff_length} ); $tif->SetField( TIFFTAG_PLANARCONFIG, PLANARCONFIG_CONTIG ); $tif->SetField( TIFFTAG_FILLORDER, FILLORDER_MSB2LSB ); given ( $t2p->{pdf_compression} ) { when ($T2P_COMPRESS_NONE) { $tif->SetField( TIFFTAG_COMPRESSION, COMPRESSION_NONE ); } when ($T2P_COMPRESS_G4) { $tif->SetField( TIFFTAG_COMPRESSION, COMPRESSION_CCITTFAX4 ); } when ($T2P_COMPRESS_JPEG) { if ( $t2p->{tiff_photometric} == PHOTOMETRIC_YCBCR ) { my ( $hor, $ver ) = ( 0, 0 ); if ( ( $hor, $ver ) = $input->GetField(TIFFTAG_YCBCRSUBSAMPLING) != 0 ) { if ( $hor != 0 && $ver != 0 ) { $tif->SetField( TIFFTAG_YCBCRSUBSAMPLING, $hor, $ver ); } } my $xfloatp = $input->GetField(TIFFTAG_REFERENCEBLACKWHITE); if ( $xfloatp != 0 ) { $tif->SetField( TIFFTAG_REFERENCEBLACKWHITE, $xfloatp ); } } if ( $tif->SetField( TIFFTAG_COMPRESSION, COMPRESSION_JPEG ) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Unable to use JPEG compression for input %s and output %s", $input->FileName(), $tif->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $tif->SetField( TIFFTAG_JPEGTABLESMODE, 0 ); if ( $t2p->{pdf_colorspace} & ( $T2P_CS_RGB | $T2P_CS_LAB ) ) { $tif->SetField( TIFFTAG_PHOTOMETRIC, PHOTOMETRIC_YCBCR ); if ( $t2p->{tiff_photometric} != PHOTOMETRIC_YCBCR ) { $tif->SetField( TIFFTAG_JPEGCOLORMODE, JPEGCOLORMODE_RGB ); } else { $tif->SetField( TIFFTAG_JPEGCOLORMODE, JPEGCOLORMODE_RAW ); } } if ( $t2p->{pdf_colorspace} & $T2P_CS_GRAY ) { 0; } if ( $t2p->{pdf_colorspace} & $T2P_CS_CMYK ) { 0; } if ( $t2p->{pdf_defaultcompressionquality} ) { $tif->SetField( TIFFTAG_JPEGQUALITY, $t2p->{pdf_defaultcompressionquality} ); } } when ($T2P_COMPRESS_ZIP) { $tif->SetField( TIFFTAG_COMPRESSION, COMPRESSION_DEFLATE ); if ( $t2p->{pdf_defaultcompressionquality} % 100 != 0 ) { $tif->SetField( TIFFTAG_PREDICTOR, $t2p->{pdf_defaultcompressionquality} % 100 ); } if ( $t2p->{pdf_defaultcompressionquality} / 100 != 0 ) { $tif->SetField( TIFFTAG_ZIPQUALITY, ( $t2p->{pdf_defaultcompressionquality} / 100 ) ); } } } $t2p->{outputwritten} = 0; my $bufferoffset; if ( $t2p->{pdf_compression} == $T2P_COMPRESS_JPEG && $t2p->{tiff_photometric} == PHOTOMETRIC_YCBCR ) { $bufferoffset = $tif->WriteEncodedStrip( 0, $buffer, $stripsize * $stripcount ); $buffer = q{}; for my $i ( 0 .. $stripcount - 1 ) { my $stripbuffer = $tif->ReadEncodedStrip( $i, $stripsize ); if ( length($stripbuffer) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding strip %u of %s", $i, $tif->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer .= $stripbuffer; } } else { $bufferoffset = $tif->WriteEncodedStrip( 0, $buffer, $t2p->{tiff_datasize} ); $tif->Close; $tif = Graphics::TIFF->Open( $temp, 'r' ); $buffer = q{}; for my $i ( 0 .. $tif->NumberOfStrips() - 1 ) { my $stripbuffer = $tif->ReadEncodedStrip( $i, $stripsize ); if ( length($stripbuffer) == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding strip %u of %s", $i, $tif->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer .= $stripbuffer; } } if ( $bufferoffset == -1 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error writing encoded strip to temporary TIFF %s", $tif->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } print {$output} $buffer; return length $buffer; } # This function reads the raster image data from the input TIFF for an image # tile and writes the data to the output PDF XObject image dictionary stream # for the tile. It returns the amount written or zero on error. sub t2p_readwrite_pdf_image_tile { my ( $t2p, $input, $output, $tile ) = @_; my $edge = 0; my $written = 0; my $read = 0; my $tilecount = 0; my $tilesize = 0; my $septilecount = 0; my $septilesize = 0; my ($buffer); # Fail if prior error (in particular, can't trust tiff_datasize) if ( $t2p->{t2p_error} != $T2P_ERR_OK ) { return 0 } $edge |= t2p_tile_is_right_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ); $edge |= t2p_tile_is_bottom_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ); if ( $t2p->{pdf_transcode} == $T2P_TRANSCODE_RAW && ( $edge == 0 || $t2p->{pdf_compression} == $T2P_COMPRESS_JPEG ) ) { if ( $t2p->{pdf_compression} == $T2P_COMPRESS_G4 ) { $buffer = $input->ReadRawTile( $tile, $t2p->{tiff_datasize} ); if ( $t2p->{tiff_fillorder} == FILLORDER_LSB2MSB ) { Graphics::TIFF::ReverseBits( $buffer, $t2p->{tiff_datasize} ); } $output .= $buffer; return $t2p->{tiff_datasize}; } if ( $t2p->{pdf_compression} == $T2P_COMPRESS_ZIP ) { $buffer = $input->ReadRawTile( $tile, $t2p->{tiff_datasize} ); if ( $t2p->{tiff_fillorder} == FILLORDER_LSB2MSB ) { Graphics::TIFF::ReverseBits( $buffer, $t2p->{tiff_datasize} ); } $output .= $buffer; return $t2p->{tiff_datasize}; } if ( $t2p->{tiff_compression} == COMPRESSION_OJPEG ) { if ( !$t2p->{pdf_ojpegdata} ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for OJPEG image %s with bad tables", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer = $t2p->{pdf_ojpegdata}; if ( $edge != 0 ) { if ( t2p_tile_is_bottom_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ) ) { substr( $buffer, 7 ) = ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ] {tiles_edgetilelength} >> 8 ) & 0xff; substr( $buffer, 8 ) = ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ] {tiles_edgetilelength} ) & 0xff; } if ( t2p_tile_is_right_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ) ) { substr( $buffer, 9 ) = ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ] {tiles_edgetilewidth} >> 8 ) & 0xff; substr( $buffer, 10 ) = ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ] {tiles_edgetilewidth} ) & 0xff; } } my $bufferoffset = $t2p->{pdf_ojpegdatalength}; $buffer .= $input->ReadRawTile( $tile, -1 ); $buffer .= chr 0xff; $buffer .= chr 0xd9; $output .= $buffer; return length $buffer; } if ( $t2p->{tiff_compression} == COMPRESSION_JPEG ) { my $count = 0; my $jpt; my @table_end; if ( ( my ( $count, $jpt ) = $input->GetField(TIFFTAG_JPEGTABLES) ) != 0 ) { if ( $count > 0 ) { $buffer = $jpt; my $xuint32 = length($buffer) - $count - 2; $table_end[0] = substr $buffer, -2; $table_end[1] = substr $buffer, -1; $buffer = substr $buffer, 0, -2; $buffer .= $input->ReadRawTile( $tile, -1 ); substr( $buffer, $xuint32 - 2 ) = $table_end[0]; substr( $buffer, $xuint32 - 1 ) = $table_end[1]; } else { $buffer .= $input->ReadRawTile( $tile, -1 ); } } $output .= $buffer; return length $buffer; } 0; } if ( $t2p->{pdf_sample} == $T2P_SAMPLE_NOTHING ) { my $samplebuffer = $input->ReadEncodedTile( $tile, $t2p->{tiff_datasize} ); if ( length $samplebuffer == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding tile %u of %s", $tile, $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $buffer .= $samplebuffer; } else { if ( $t2p->{pdf_sample} == $T2P_SAMPLE_PLANAR_SEPARATE_TO_CONTIG ) { my $septilesize = $input->TIFFTileSize(); my $septilecount = $input->TIFFNumberOfTiles(); my $tilesize = $septilesize * $t2p->{tiff_samplesperpixel}; my $tilecount = $septilecount / $t2p->{tiff_samplesperpixel}; my $samplebuffer; for my $i ( 0 .. $t2p->{tiff_samplesperpixel} - 1 ) { my $tilebuffer = $input->TIFFReadEncodedTile( $tile + $i * $tilecount, $septilesize ); if ( length $tilebuffer == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding tile %u of %s", $tile + $i * $tilecount, $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $samplebuffer .= $tilebuffer; } $buffer .= t2p_sample_planar_separate_to_contig( $t2p, $samplebuffer, length $samplebuffer ); } if ( length $buffer == 0 ) { $buffer = $input->ReadEncodedTile( $tile, $t2p->{tiff_datasize} ); if ( length $buffer == 0 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error on decoding tile %u of %s", $tile, $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_RGBA_TO_RGB ) { $t2p->{tiff_datasize} = t2p_sample_rgba_to_rgb( $buffer, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ); } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_RGBAA_TO_RGB ) { $t2p->{tiff_datasize} = t2p_sample_rgbaa_to_rgb( $buffer, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ); } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_YCBCR_TO_RGB ) { my $msg = sprintf "$TIFF2PDF_MODULE: No support for YCbCr to RGB in tile for %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } if ( $t2p->{pdf_sample} & $T2P_SAMPLE_LAB_SIGNED_TO_UNSIGNED ) { $t2p->{tiff_datasize} = t2p_sample_lab_signed_to_unsigned( $buffer, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ); } } if ( t2p_tile_is_right_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ) != 0 ) { t2p_tile_collapse_left( $buffer, $input->TileRowSize(), $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilewidth}, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ); } $output->{outputdisable} = 1; $output->SetField( TIFFTAG_PHOTOMETRIC, $t2p->{tiff_photometric} ); $output->SetField( TIFFTAG_BITSPERSAMPLE, $t2p->{tiff_bitspersample} ); $output->SetField( TIFFTAG_SAMPLESPERPIXEL, $t2p->{tiff_samplesperpixel} ); if ( t2p_tile_is_right_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ) == 0 ) { $output->TIFFSetField( TIFFTAG_IMAGEWIDTH, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth} ); } else { $output->SetField( TIFFTAG_IMAGEWIDTH, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilewidth} ); } if ( t2p_tile_is_bottom_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile ) == 0 ) { $output->SetField( TIFFTAG_IMAGELENGTH, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ); $output->TIFFSetField( TIFFTAG_ROWSPERSTRIP, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ); } else { $output->SetField( TIFFTAG_IMAGELENGTH, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilelength} ); $output->SetField( TIFFTAG_ROWSPERSTRIP, $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilelength} ); } $output->SetField( TIFFTAG_PLANARCONFIG, PLANARCONFIG_CONTIG ); $output->SetField( TIFFTAG_FILLORDER, FILLORDER_MSB2LSB ); given ( $t2p->{pdf_compression} ) { when ($T2P_COMPRESS_NONE) { $output->SetField( TIFFTAG_COMPRESSION, COMPRESSION_NONE ); } when ($T2P_COMPRESS_G4) { $output->SetField( TIFFTAG_COMPRESSION, COMPRESSION_CCITTFAX4 ); } when ($T2P_COMPRESS_JPEG) { if ( $t2p->{tiff_photometric} == PHOTOMETRIC_YCBCR ) { my $hor = 0; my $ver = 0; ( $hor, $ver ) = $input->GetField(TIFFTAG_YCBCRSUBSAMPLING); if ( $hor != 0 && $ver != 0 ) { $output->SetField( TIFFTAG_YCBCRSUBSAMPLING, $hor, $ver ); } if ( my $xfloatp = $input->GetField(TIFFTAG_REFERENCEBLACKWHITE) != 0 ) { $output->SetField( TIFFTAG_REFERENCEBLACKWHITE, $xfloatp ); } } $output->SetField( TIFFTAG_COMPRESSION, COMPRESSION_JPEG ); $output->SetField( TIFFTAG_JPEGTABLESMODE, 0 ) ; # JPEGTABLESMODE_NONE if ( $t2p->{pdf_colorspace} & ( $T2P_CS_RGB | $T2P_CS_LAB ) ) { $output->SetField( TIFFTAG_PHOTOMETRIC, PHOTOMETRIC_YCBCR ); if ( $t2p->{tiff_photometric} != PHOTOMETRIC_YCBCR ) { $output->SetField( TIFFTAG_JPEGCOLORMODE, JPEGCOLORMODE_RGB ); } else { $output->SetField( TIFFTAG_JPEGCOLORMODE, JPEGCOLORMODE_RAW ); } } if ( $t2p->{pdf_colorspace} & $T2P_CS_GRAY ) { 0; } if ( $t2p->{pdf_colorspace} & $T2P_CS_CMYK ) { 0; } if ( $t2p->{pdf_defaultcompressionquality} != 0 ) { $output->SetField( TIFFTAG_JPEGQUALITY, $t2p->{pdf_defaultcompressionquality} ); } } when ($T2P_COMPRESS_ZIP) { $output->SetField( TIFFTAG_COMPRESSION, COMPRESSION_DEFLATE ); if ( $t2p->{pdf_defaultcompressionquality} % 100 != 0 ) { $output->SetField( TIFFTAG_PREDICTOR, $t2p->{pdf_defaultcompressionquality} % 100 ); } if ( $t2p->{pdf_defaultcompressionquality} / 100 != 0 ) { $output->SetField( TIFFTAG_ZIPQUALITY, ( $t2p->{pdf_defaultcompressionquality} / 100 ) ); } } } $output->{outputdisable} = 0; $t2p->{outputwritten} = 0; my $bufferoffset = $output->WriteEncodedStrip( 0, $buffer, $output->StripSize() ); if ( $bufferoffset == -1 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error writing encoded tile to output PDF %s", $output->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } return $t2p->{outputwritten}; } sub t2p_process_ojpeg_tables { my ( $t2p, $input ) = @_; my ( $proc, $q_length, $q, $dc_length, $dc, $h_samp, $v_samp, $code_count, $ac_length, $ac, $lp, $pt ); if ( !( $proc = $input->GetField(TIFFTAG_JPEGPROC) ) ) { my $msg = sprintf "$TIFF2PDF_MODULE: Missing JPEGProc field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } if ( $proc != JPEGPROC_BASELINE && $proc != JPEGPROC_LOSSLESS ) { my $msg = sprintf "$TIFF2PDF_MODULE: Bad JPEGProc field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } if ( !( ( $q_length, $q ) = $input->GetField(TIFFTAG_JPEGQTABLES) ) ) { my $msg = sprintf "$TIFF2PDF_MODULE: Missing JPEGQTables field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } if ( $q_length < ( 64 * $t2p->{tiff_samplesperpixel} ) ) { my $msg = sprintf "$TIFF2PDF_MODULE: Bad JPEGQTables field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } if ( !( ( $dc_length, $dc ) = $input->GetField(TIFFTAG_JPEGDCTABLES) ) ) { my $msg = sprintf "$TIFF2PDF_MODULE: Missing JPEGDCTables field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } if ( $proc == JPEGPROC_BASELINE ) { if ( !( ( $ac_length, $ac ) = $input->GetField(TIFFTAG_JPEGACTABLES) ) ) { my $msg = sprintf "$TIFF2PDF_MODULE: Missing JPEGACTables field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } } else { $lp = $input->GetField(TIFFTAG_JPEGLOSSLESSPREDICTORS); if ( !defined $lp ) { my $msg = sprintf "$TIFF2PDF_MODULE: Missing JPEGLosslessPredictors field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $pt = $input->GetField(TIFFTAG_JPEGPOINTTRANSFORM); if ( !defined $pt ) { my $msg = sprintf "$TIFF2PDF_MODULE: Missing JPEGPointTransform field in OJPEG image %s", $input->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } } if ( !( ( $h_samp, $v_samp ) = $input->GetField(TIFFTAG_YCBCRSUBSAMPLING) ) ) { $h_samp = 1; $v_samp = 1; } my $table_count = $t2p->{tiff_samplesperpixel}; if ( $proc == JPEGPROC_BASELINE and $table_count > 2 ) { $table_count = 2 } my $ojpegdata = $t2p->{pdf_ojpegdata}; $ojpegdata .= chr 0xff; $ojpegdata .= chr 0xd8; $ojpegdata .= chr 0xff; if ( $proc == JPEGPROC_BASELINE ) { $ojpegdata .= chr 0xc0; } else { $ojpegdata .= chr 0xc3; } $ojpegdata .= chr 0x00; $ojpegdata .= chr 8 + 3 * $t2p->{tiff_samplesperpixel}; $ojpegdata .= chr $t2p->{tiff_bitspersample} & 0xff; if ( $input->IsTiled() ) { $ojpegdata .= chr( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} >> 8 ) & 0xff; $ojpegdata .= chr( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength} ) & 0xff; $ojpegdata .= chr( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth} >> 8 ) & 0xff; $ojpegdata .= chr( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth} ) & 0xff; } else { $ojpegdata .= chr( $t2p->{tiff_length} >> 8 ) & 0xff; $ojpegdata .= chr $t2p->{tiff_length} & 0xff; $ojpegdata .= chr( $t2p->{tiff_width} >> 8 ) & 0xff; $ojpegdata .= chr $t2p->{tiff_width} & 0xff; } $ojpegdata .= chr $t2p->{tiff_samplesperpixel} & 0xff; for my $i ( 0 .. $t2p->{tiff_samplesperpixel} - 1 ) { $ojpegdata .= chr $i; if ( $i == 0 ) { substr( $ojpegdata, -1 ) |= chr $h_samp << 4 & 0xf0; $ojpegdata .= chr $v_samp & 0x0f; } else { $ojpegdata .= chr 0x11; } $ojpegdata .= chr $i; } for my $dest ( 0 .. $t2p->{tiff_samplesperpixel} - 1 ) { $ojpegdata .= chr 0xff; $ojpegdata .= chr 0xdb; $ojpegdata .= chr 0x00; $ojpegdata .= chr 0x43; $ojpegdata .= chr $dest; $ojpegdata .= substr $q, 64 * $dest, 64; } my $offset_table = 0; for my $dest ( 0 .. $table_count - 1 ) { $ojpegdata .= chr 0xff; $ojpegdata .= chr 0xc4; my $offset_ms_l = length $ojpegdata; $ojpegdata .= q{..}; #placeholders to be filled below $ojpegdata .= chr $dest & 0x0f; $ojpegdata .= substr $dc, $offset_table, 16; $code_count = 0; $offset_table += 16; for my $i ( 0 .. 15 ) { $code_count += ord substr $ojpegdata, $i - 16, 1; } substr( $ojpegdata, $offset_ms_l ) = chr( ( 19 + $code_count ) >> 8 ) & 0xff; substr( $ojpegdata, $offset_ms_l + 1 ) = chr( 19 + $code_count ) & 0xff; $ojpegdata .= substr $dc, $offset_table, $code_count; $offset_table += $code_count; } if ( $proc == JPEGPROC_BASELINE ) { $offset_table = 0; for my $dest ( 0 .. $table_count - 1 ) { $ojpegdata .= chr 0xff; $ojpegdata .= chr 0xc4; my $offset_ms_l = length $ojpegdata; $ojpegdata .= q{..}; #placeholders to be filled below $ojpegdata .= chr 0x10; $ojpegdata .= chr $dest & 0x0f; $ojpegdata .= substr $ac, $offset_table, 16; $code_count = 0; $offset_table += 16; for my $i ( 0 .. 15 ) { $code_count += ord substr $ojpegdata, $i - 16, 1; } substr( $ojpegdata, $offset_ms_l ) = chr( ( 19 + $code_count ) >> 8 ) & 0xff; substr( $ojpegdata, $offset_ms_l + 1 ) = chr( 19 + $code_count ) & 0xff; $ojpegdata .= substr $dc, $offset_table, $code_count; $offset_table += $code_count; } } if ( $input->NumberOfStrips() > 1 ) { $ojpegdata .= chr 0xff; $ojpegdata .= chr 0xdd; $ojpegdata .= chr 0x00; $ojpegdata .= chr 0x04; $h_samp *= 8; $v_samp *= 8; my $ri = ( $t2p->{tiff_width} + $h_samp - 1 ) / $h_samp; my $rows->$input->GetField(TIFFTAG_ROWSPERSTRIP); $ri *= ( $rows + $v_samp - 1 ) / $v_samp; $ojpegdata .= chr( $ri >> 8 ) & 0xff; $ojpegdata .= chr $ri & 0xff; } $ojpegdata .= chr 0xff; $ojpegdata .= chr 0xda; $ojpegdata .= chr 0x00; $ojpegdata .= chr 6 + 2 * $t2p->{tiff_samplesperpixel}; $ojpegdata .= chr $t2p->{tiff_samplesperpixel} & 0xff; for my $i ( 0 .. t2p->tiff_samplesperpixel- 1 ) { $ojpegdata .= chr $i & 0xff; if ( $proc == JPEGPROC_BASELINE ) { $ojpegdata .= chr( ( ( $i > ( $table_count - 1 ) ) ? ( $table_count - 1 ) : $i ) << 4 ) & 0xf0; $ojpegdata .= chr( ( $i > ( $table_count - 1 ) ) ? ( $table_count - 1 ) : $i ) & 0x0f; } else { $ojpegdata .= chr( $i << 4 ) & 0xf0; } } if ( $proc == JPEGPROC_BASELINE ) { $ojpegdata .= chr 0x00; $ojpegdata .= chr 0x3f; $ojpegdata .= chr 0x00; } else { $ojpegdata .= chr substr $lp, 0 & 0xff; $ojpegdata .= chr 0x00; $ojpegdata .= chr substr $pt, 0 & 0x0f; } return 1; } sub t2p_process_jpeg_strip { my ( $strip, $striplength, $buffer, $bufferoffset, $no, $height ) = @_; my $v_samp = 1; my $h_samp = 1; my $i = 1; while ( $i < $striplength ) { given ( ord( substr $i, 1 ) ) { when (0xd8) { # SOI - start of image $buffer .= substr $strip, $i - 1, 2; $i += 2; } when ( ( 0xc0 | 0xc1 | 0xc3 | 0xc9 | 0xca ) ) { if ( $no == 0 ) { $bufferoffset = length $buffer; $buffer .= substr $strip, $i - 1, ord( substr $strip, $i + 2, 1 ) + 2; for my $j ( 0 .. ord( substr $buffer, $bufferoffset + 9, 1 ) ) { if ( ( ord( substr $buffer, $bufferoffset + 11 + ( 2 * $j ), 1 ) >> 4 ) > $h_samp ) { $h_samp = ord( substr $buffer, $bufferoffset + 11 + ( 2 * $j ), 1 ) >> 4; } if ( ( ord( substr $buffer, $bufferoffset + 11 + ( 2 * $j ), 1 ) & 0x0f ) > $v_samp ) { $v_samp = ord( substr $buffer, $bufferoffset + 11 + ( 2 * $j ), 1 ) & 0x0f; } } $v_samp *= 8; $h_samp *= 8; my $ri = ( ( ( substr( $buffer, $bufferoffset + 5, 1 ) << 8 ) | substr $buffer, $bufferoffset + 6, 1 ) + $v_samp - 1 ) / $v_samp; $ri *= ( ( ( substr( $buffer, $bufferoffset + 7, 1 ) << 8 ) | substr $buffer, $bufferoffset + 8, 1 ) + $h_samp - 1 ) / $h_samp; substr( $buffer, $bufferoffset + 5, 1 ) = ( $height >> 8 ) & 0xff; substr( $buffer, $bufferoffset + 6, 1 ) = $height & 0xff; $i += ord( substr $strip, $i + 2, 1 ) + 2; $buffer .= chr 0xff; $buffer .= chr 0xdd; $buffer .= chr 0x00; $buffer .= chr 0x04; $buffer .= chr( $ri >> 8 ) & 0xff; $buffer .= chr $ri & 0xff; } else { $i += ord( substr $strip, $i + 2, 1 ) + 2; } } when ( ( 0xc4 | 0xdb ) ) { $buffer .= substr $strip, $i - 1, ord( substr $strip, $i + 2, 1 ) + 2; $i += ord( substr $strip, $i + 2, 1 ) + 2; } when (0xda) { if ( $no == 0 ) { $buffer .= substr $strip, $i - 1, ord( substr $strip, $i + 2, 1 ) + 2; $i += ord( substr $strip, $i + 2, 1 ) + 2; } else { $buffer .= chr 0xff; $buffer .= chr 0xd0 | ( ( $no - 1 ) % 8 ); $i += ord( substr $strip, $i + 2, 1 ) + 2; } $buffer .= substr $strip, $i - 1, $striplength - $i - 1; return 1; } default { $i += ord( substr $strip, $i + 2, 1 ) + 2; } } } return 0; } # This functions converts a tilewidth x tilelength buffer of samples into an edgetilewidth x # tilelength buffer of samples. sub t2p_tile_collapse_left { my ( $buffer, $scanwidth, $tilewidth, $edgetilewidth, $tilelength ) = @_; my $edgescanwidth = ( $scanwidth * $edgetilewidth + ( $tilewidth - 1 ) ) / $tilewidth; for my $i ( 0 .. $tilelength - 1 ) { substr( $buffer, $edgescanwidth * $i, $edgescanwidth ) = substr $buffer, $scanwidth * $i, $edgescanwidth; } return; } # This function calls TIFFWriteDirectory on the output after blanking its # output by replacing the read, write, and seek procedures with empty # implementations, then it replaces the original implementations. sub t2p_write_advance_directory { my ( $t2p, $output ) = @_; $output->{outputdisable} = 1; if ( !$output->WriteDirectory() ) { my $msg = sprintf "$TIFF2PDF_MODULE: Error writing virtual directory to output PDF %s", $output->FileName(); warn "$msg\n"; $t2p->{t2p_error} = $T2P_ERR_ERROR; return 0; } $output->{outputdisable} = 0; return; } sub t2p_sample_planar_separate_to_contig { my ( $t2p, $buffer, $samplebuffer, $samplebuffersize ) = @_; my $stride = $samplebuffersize / $t2p->{tiff_samplesperpixel}; for my $i ( 0 .. $stride - 1 ) { for my $j ( 0 .. $t2p->{tiff_samplesperpixel} - 1 ) { substr( $buffer, $i * $t2p->{tiff_samplesperpixel} + $j, 1 ) = substr $samplebuffer, $i + $j * $stride, 1; } } return $samplebuffersize; } # This function writes the PDF header to output. sub t2p_write_pdf_header { my ( $t2p, $output ) = @_; my $buffer = sprintf '%%PDF-%u.%u ', $t2p->{pdf_majorversion} & 0xff, $t2p->{pdf_minorversion} & 0xff; $buffer .= "\n%\342\343\317\323\n"; return t2pWriteFile( $output, $buffer ); } # This function writes the beginning of a PDF object to output. sub t2p_write_pdf_obj_start { my ( $number, $output ) = @_; my $buffer = sprintf "%lu 0 obj\n", $number; return t2pWriteFile( $output, $buffer ); } # This function writes the end of a PDF object to output. sub t2p_write_pdf_obj_end { my ($output) = @_; return t2pWriteFile( $output, "endobj\n" ); } # This function writes a buffer of data to output. sub t2p_write_pdf_stream { my ( $buffer, $len, $output ) = @_; return t2pWriteFile( $output, $buffer ); } # This functions writes the beginning of a PDF stream to output. sub t2p_write_pdf_stream_start { my ($output) = @_; return t2pWriteFile( $output, "stream\n" ); } # This function writes the end of a PDF stream to output. sub t2p_write_pdf_stream_end { my ($output) = @_; return t2pWriteFile( $output, "\nendstream\n" ); } # This function writes a stream dictionary for a PDF stream to output. sub t2p_write_pdf_stream_dict { my ( $len, $number, $output ) = @_; my $buffer = '/Length '; my $written = 0; if ( $len != 0 ) { $written += t2pWriteFile( $output, $buffer ); $written += t2p_write_pdf_stream_length( $len, $output ); } else { $buffer .= sprintf '%lu', $number; $buffer .= " 0 R \n"; $written += t2pWriteFile( $output, $buffer ); } return $written; } # This functions writes the beginning of a PDF stream dictionary to output. sub t2p_write_pdf_stream_dict_start { my ($output) = @_; return t2pWriteFile( $output, "<< \n" ); } # This function writes the end of a PDF stream dictionary to output. sub t2p_write_pdf_stream_dict_end { my ($output) = @_; return t2pWriteFile( $output, " >>\n" ); } # This function writes a number to output. sub t2p_write_pdf_stream_length { my ( $len, $output ) = @_; my $buffer = sprintf "%lu\n", $len; return t2pWriteFile( $output, $buffer ); } # This function writes the PDF Catalog structure to output. sub t2p_write_pdf_catalog { my ( $t2p, $output ) = @_; my $buffer = "<< \n/Type /Catalog \n/Pages "; $buffer .= sprintf '%lu', $t2p->{pdf_pages}; $buffer .= " 0 R \n"; if ( $t2p->{pdf_fitwindow} ) { $buffer .= "/ViewerPreferences <>\n"; } $buffer .= ">>\n"; return t2pWriteFile( $output, $buffer ); } # This function writes the PDF Info structure to output. sub t2p_write_pdf_info { my ( $t2p, $input, $output ) = @_; my $buffer = q{}; if ( not defined $t2p->{pdf_datetime} ) { t2p_pdf_tifftime( $t2p, $input ) } if ( length $t2p->{pdf_datetime} > 0 ) { $buffer .= "<< \n/CreationDate ("; $buffer .= $t2p->{pdf_datetime}; $buffer .= ")\n/ModDate ("; $buffer .= $t2p->{pdf_datetime}; } $buffer .= ")\n/Producer "; $buffer .= sprintf "(libtiff / tiff2pdf - %d)\n", TIFFLIB_VERSION; if ( defined $t2p->{pdf_creator} ) { $buffer .= "/Creator ($t2p->{pdf_creator})\n"; } else { my $info = $input->GetField(TIFFTAG_SOFTWARE); if ( defined $info and length $info > 0 ) { $buffer .= "/Creator ($info)\n"; } } if ( defined $t2p->{pdf_author} ) { $buffer .= "/Author ($t2p->{pdf_author})\n"; } else { my $info = $input->GetField(TIFFTAG_ARTIST); if ( not defined $info or length $info > 0 ) { $info = $input->GetField(TIFFTAG_COPYRIGHT); } if ( defined $info and length $info > 0 ) { $buffer .= "/Author ($info)\n"; } } if ( defined $t2p->{pdf_title} ) { $buffer .= "/Title ($t2p->{pdf_title})\n"; } else { my $info = $input->GetField(TIFFTAG_DOCUMENTNAME); if ( defined $info and length $info > 0 ) { $buffer .= "/Title ($info)\n"; } } if ( defined $t2p->{pdf_subject} ) { $buffer .= "/Subject ($t2p->{pdf_subject})\n"; } else { my $info = $input->GetField(TIFFTAG_IMAGEDESCRIPTION); if ( defined $info and length $info > 0 ) { $buffer .= "/Subject ($info)\n"; } } if ( defined $t2p->{pdf_keywords} ) { $buffer .= "/Keywords ($t2p->{pdf_keywords})\n"; } $buffer .= ">> \n"; return t2pWriteFile( $output, $buffer ); } # This function fills a string of a T2P struct with the current time as a PDF # date string, it is called by t2p_pdf_tifftime. sub t2p_pdf_currenttime { my ($t2p) = @_; my $timenow = time; if ( $timenow == -1 ) { my $msg = sprintf "$TIFF2PDF_MODULE: Can't get the current time: %s", $ERRNO; warn "$msg\n"; $timenow = 0; } my @currenttime = localtime $timenow; $t2p->{pdf_datetime} = sprintf 'D:%.4d%.2d%.2d%.2d%.2d%.2d', $currenttime[5] + 1900, $currenttime[4] + 1, $currenttime[3], $currenttime[2], $currenttime[1], $currenttime[0]; return; } # This function fills a string of a T2P struct with the date and time of a # TIFF file if it exists or the current time as a PDF date string. sub t2p_pdf_tifftime { my ( $t2p, $input ) = @_; my $datetime = $input->GetField(TIFFTAG_DATETIME); if ( defined $datetime and ( length $datetime >= 19 ) ) { $t2p->{pdf_datetime} = 'D:' . substr( $datetime, 0, 4 ) . substr( $datetime, 5, 2 ) . substr( $datetime, 8, 2 ) . substr( $datetime, 11, 2 ) . substr( $datetime, 14, 2 ) . substr $datetime, 17, 2; } else { t2p_pdf_currenttime($t2p); } return; } # This function writes a PDF Pages Tree structure to output. sub t2p_write_pdf_pages { my ( $t2p, $output ) = @_; my $buffer = "<< \n/Type /Pages \n/Kids [ "; my $page = $t2p->{pdf_pages} + 1; for my $i ( 0 .. $t2p->{tiff_pagecount} - 1 ) { $buffer .= sprintf '%d', $page; $buffer .= ' 0 R '; if ( ( ( $i + 1 ) % 8 ) == 0 ) { $buffer .= "\n"; } $page += 3; $page += $t2p->{tiff_pages}[$i]{page_extra}; if ( $t2p->{tiff_pages}[$i]{page_tilecount} > 0 ) { $page += ( 2 * $t2p->{tiff_pages}[$i]{page_tilecount} ); } else { $page += 2; } } $buffer .= "] \n/Count "; $buffer .= sprintf '%d', $t2p->{tiff_pagecount}; $buffer .= " \n>> \n"; return t2pWriteFile( $output, $buffer ); } # This function writes a PDF Page structure to output. sub t2p_write_pdf_page { my ( $object, $t2p, $output ) = @_; my $buffer = "<<\n/Type /Page \n/Parent "; $buffer .= sprintf '%lu', $t2p->{pdf_pages}; $buffer .= " 0 R \n"; $buffer .= sprintf "/MediaBox [%.4f %.4f %.4f %.4f] \n", $t2p->{pdf_mediabox}{x1}, $t2p->{pdf_mediabox}{y1}, $t2p->{pdf_mediabox}{x2}, $t2p->{pdf_mediabox}{y2}; $buffer .= sprintf "/Contents %lu 0 R \n", ( $object + 1 ); $buffer .= "/Resources << \n"; if ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} != 0 ) { $buffer .= "/XObject <<\n"; for ( my $i = 0 ; $i < $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} ; $i++ ) { $buffer .= '/Im'; $buffer .= sprintf '%u', ( $t2p->{pdf_page} + 1 ); $buffer .= '_'; $buffer .= sprintf '%u', ( $i + 1 ); $buffer .= q{ }; $buffer .= sprintf '%lu', ( $object + 3 + ( 2 * $i ) + $t2p->{tiff_pages}[ $t2p->{pdf_page} ]{page_extra} ); $buffer .= ' 0 R '; if ( $i % 4 == 3 ) { $buffer .= "\n"; } } $buffer .= ">>\n"; } else { $buffer .= "/XObject <<\n"; $buffer .= '/Im'; $buffer .= sprintf '%u', ( $t2p->{pdf_page} + 1 ); $buffer .= q{ }; $buffer .= sprintf '%lu', ( $object + 3 + ( 2 * $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} ) + $t2p->{tiff_pages}[ $t2p->{pdf_page} ]{page_extra} ); $buffer .= ' 0 R '; $buffer .= ">>\n"; } if ( $t2p->{tiff_transferfunctioncount} != 0 ) { $buffer .= '/ExtGState <<'; $buffer .= '/GS1 '; $buffer .= sprintf '%lu', ( $object + 3 ); $buffer .= ' 0 R '; $buffer .= ">> \n"; } $buffer .= '/ProcSet [ '; if ( $t2p->{pdf_colorspace} == $T2P_CS_BILEVEL || $t2p->{pdf_colorspace} == $T2P_CS_GRAY ) { $buffer .= '/ImageB '; } else { $buffer .= '/ImageC '; if ( $t2p->{pdf_colorspace} & $T2P_CS_PALETTE ) { $buffer .= '/ImageI '; } } $buffer .= "]\n>>\n>>\n"; return t2pWriteFile( $output, $buffer ); } # This function composes the page size and image and tile locations on a page. sub t2p_compose_pdf_page { my ($t2p) = @_; $t2p->{pdf_xres} = $t2p->{tiff_xres}; $t2p->{pdf_yres} = $t2p->{tiff_yres}; if ( $t2p->{pdf_overrideres} ) { $t2p->{pdf_xres} = $t2p->{pdf_defaultxres}; $t2p->{pdf_yres} = $t2p->{pdf_defaultyres}; } if ( $t2p->{pdf_xres} == 0.0 ) { $t2p->{pdf_xres} = $t2p->{pdf_defaultxres}; } if ( $t2p->{pdf_yres} == 0.0 ) { $t2p->{pdf_yres} = $t2p->{pdf_defaultyres}; } if ( $t2p->{pdf_image_fillpage} ) { my $width_ratio = $t2p->{pdf_defaultpagewidth} / $t2p->{tiff_width}; my $length_ratio = $t2p->{pdf_defaultpagelength} / $t2p->{tiff_length}; if ( $width_ratio < $length_ratio ) { $t2p->{pdf_imagewidth} = $t2p->{pdf_defaultpagewidth}; $t2p->{pdf_imagelength} = $t2p->{tiff_length} * $width_ratio; } else { $t2p->{pdf_imagewidth} = $t2p->{tiff_width} * $length_ratio; $t2p->{pdf_imagelength} = $t2p->{pdf_defaultpagelength}; } } elsif ( $t2p->{tiff_resunit} != RESUNIT_CENTIMETER # RESUNIT_NONE and && $t2p->{tiff_resunit} != RESUNIT_INCH # other cases ) { $t2p->{pdf_imagewidth} = $t2p->{tiff_width} / $t2p->{pdf_xres}; $t2p->{pdf_imagelength} = $t2p->{tiff_length} / $t2p->{pdf_yres}; } else { $t2p->{pdf_imagewidth} = $t2p->{tiff_width} * $PS_UNIT_SIZE / $t2p->{pdf_xres}; $t2p->{pdf_imagelength} = $t2p->{tiff_length} * $PS_UNIT_SIZE / $t2p->{pdf_yres}; } if ( $t2p->{pdf_overridepagesize} ) { $t2p->{pdf_pagewidth} = $t2p->{pdf_defaultpagewidth}; $t2p->{pdf_pagelength} = $t2p->{pdf_defaultpagelength}; } else { $t2p->{pdf_pagewidth} = $t2p->{pdf_imagewidth}; $t2p->{pdf_pagelength} = $t2p->{pdf_imagelength}; } $t2p->{pdf_mediabox}{x1} = 0.0; $t2p->{pdf_mediabox}{y1} = 0.0; $t2p->{pdf_mediabox}{x2} = $t2p->{pdf_pagewidth}; $t2p->{pdf_mediabox}{y2} = $t2p->{pdf_pagelength}; $t2p->{pdf_imagebox}{x1} = 0.0; $t2p->{pdf_imagebox}{y1} = 0.0; $t2p->{pdf_imagebox}{x2} = $t2p->{pdf_imagewidth}; $t2p->{pdf_imagebox}{y2} = $t2p->{pdf_imagelength}; if ( $t2p->{pdf_overridepagesize} != 0 ) { $t2p->{pdf_imagebox}{x1} += ( $t2p->{pdf_pagewidth} - $t2p->{pdf_imagewidth} ) / 2.0; $t2p->{pdf_imagebox}{y1} += ( $t2p->{pdf_pagelength} - $t2p->{pdf_imagelength} ) / 2.0; $t2p->{pdf_imagebox}{x2} += ( $t2p->{pdf_pagewidth} - $t2p->{pdf_imagewidth} ) / 2.0; $t2p->{pdf_imagebox}{y2} += ( $t2p->{pdf_pagelength} - $t2p->{pdf_imagelength} ) / 2.0; } if ( $t2p->{tiff_orientation} > 4 ) { ( $t2p->{pdf_mediabox}{x2}, $t2p->{pdf_mediabox}{y2} ) = ( $t2p->{pdf_mediabox}{y2}, $t2p->{pdf_mediabox}{x2} ); } my $tiles; if ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} == 0 ) { t2p_compose_pdf_page_orient( $t2p->{pdf_imagebox}, $t2p->{tiff_orientation} ); return; } else { my $tilewidth = $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}; my $tilelength = $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength}; my $tilecountx = ( $t2p->{tiff_width} + $tilewidth - 1 ) / $tilewidth; $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecountx} = $tilecountx; my $tilecounty = ( $t2p->{tiff_length} + $tilelength - 1 ) / $tilelength; $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecounty} = $tilecounty; $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilewidth} = $t2p->{tiff_width} % {$tilewidth}; $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilelength} = $t2p->{tiff_length} % $tilelength; $tiles = $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tiles}; for my $i2 ( 0 .. $tilecounty - 2 ) { for my $i ( 0 .. $tilecountx - 2 ) { my $boxp = $tiles->[ $i2 * $tilecountx + $i ]{tile_box}; $boxp->{x1} = $t2p->{pdf_imagebox}{x1} + $t2p->{pdf_imagewidth} * $i * $tilewidth / $t2p->{tiff_width}; $boxp->{x2} = $t2p->{pdf_imagebox}{x1} + $t2p->{pdf_imagewidth} * ( $i + 1 ) * $tilewidth / $t2p->{tiff_width}; $boxp->{y1} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagelength} * ( $i2 + 1 ) * $tilelength / $t2p->{tiff_length}; $boxp->{y2} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagelength} * $i2 * $tilelength / $t2p->{tiff_length}; } my $boxp = $tiles->[ $i2 * $tilecountx + $tilecountx - 1 ]{tile_box}; $boxp->{x1} = $t2p->{pdf_imagebox}{x1} + $t2p->{pdf_imagewidth} * $tilecountx - 1 * $tilewidth / $t2p->{tiff_width}; $boxp->{x2} = $t2p->{pdf_imagebox}{x2}; $boxp->{y1} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagelength} * ( $i2 + 1 ) * $tilelength / $t2p->{tiff_length}; $boxp->{y2} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagelength} * $i2 * {$tilelength} / $t2p->{tiff_length}; } for my $i ( 0 .. $tilecountx - 2 ) { my $boxp = $tiles->[ ( $tilecounty - 1 ) * $tilecountx + $i ]{tile_box}; $boxp->{x1} = $t2p->{pdf_imagebox}{x1} + $t2p->{pdf_imagewidth} * $i * $tilewidth / $t2p->{tiff_width}; $boxp->{x2} = $t2p->{pdf_imagebox}{x1} + $t2p->{pdf_imagewidth} * ( $i + 1 ) * $tilewidth / $t2p->{tiff_width}; $boxp->{y1} = $t2p->{pdf_imagebox}{y1}; $boxp->{y2} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagelength} * ( $tilecounty - 1 ) * $tilelength / $t2p->{tiff_length}; } my $boxp = $tiles->[ ( $tilecounty - 1 ) * $tilecountx + $tilecountx - 1 ] {tile_box}; $boxp->{x1} = $t2p->{pdf_imagebox}{x1} + $t2p->{pdf_imagewidth} * ( $tilecountx - 1 ) * $tilewidth / $t2p->{tiff_width}; $boxp->{x2} = $t2p->{pdf_imagebox}{x2}; $boxp->{y1} = $t2p->{pdf_imagebox}{y1}; $boxp->{y2} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagelength} * ( $tilecounty - 1 ) * $tilelength / $t2p->{tiff_length}; } if ( $t2p->{tiff_orientation} == 0 || $t2p->{tiff_orientation} == 1 ) { for my $i ( 0 .. $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} - 1 ) { t2p_compose_pdf_page_orient( $tiles->[$i]{tile_box}, 0 ); } return; } for my $i ( 0 .. $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} - 1 ) { my $boxp = $tiles->[$i]{tile_box}; $boxp->{x1} -= $t2p->{pdf_imagebox}{x1}; $boxp->{x2} -= $t2p->{pdf_imagebox}{x1}; $boxp->{y1} -= $t2p->{pdf_imagebox}{y1}; $boxp->{y2} -= $t2p->{pdf_imagebox}{y1}; if ( $t2p->{tiff_orientation} == 2 || $t2p->{tiff_orientation} == 3 ) { $boxp->{x1} = $t2p->{pdf_imagebox}{x2} - $t2p->{pdf_imagebox}{x1} - $boxp->{x1}; $boxp->{x2} = $t2p->{pdf_imagebox}{x2} - $t2p->{pdf_imagebox}{x1} - $boxp->{x2}; } if ( $t2p->{tiff_orientation} == 3 || $t2p->{tiff_orientation} == 4 ) { $boxp->{y1} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagebox}{y1} - $boxp->{y1}; $boxp->{y2} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagebox}{y1} - $boxp->{y2}; } if ( $t2p->{tiff_orientation} == 8 || $t2p->{tiff_orientation} == 5 ) { $boxp->{y1} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagebox}{y1} - $boxp->{y1}; $boxp->{y2} = $t2p->{pdf_imagebox}{y2} - $t2p->{pdf_imagebox}{y1} - $boxp->{y2}; } if ( $t2p->{tiff_orientation} == 5 || $t2p->{tiff_orientation} == 6 ) { $boxp->{x1} = $t2p->{pdf_imagebox}{x2} - $t2p->{pdf_imagebox}{x1} - $boxp->{x1}; $boxp->{x2} = $t2p->{pdf_imagebox}{x2} - $t2p->{pdf_imagebox}{x1} - $boxp->{x2}; } if ( $t2p->{tiff_orientation} > 4 ) { my $f = $boxp->{x1}; $boxp->{x1} = $boxp->{y1}; $boxp->{y1} = $f; $f = $boxp->{x2}; $boxp->{x2} = $boxp->{y2}; $boxp->{y2} = $f; t2p_compose_pdf_page_orient_flip( $boxp, $t2p->{tiff_orientation} ); } else { t2p_compose_pdf_page_orient( $boxp, $t2p->{tiff_orientation} ); } } return; } sub t2p_compose_pdf_page_orient { my ( $boxp, $orientation ) = @_; if ( $boxp->{x1} > $boxp->{x2} ) { ( $boxp->{x1}, $boxp->{x2} ) = ( $boxp->{x2}, $boxp->{x1} ); } if ( $boxp->{y1} > $boxp->{y2} ) { ( $boxp->{y1}, $boxp->{y2} ) = ( $boxp->{y2}, $boxp->{y1} ); } my @m1; $boxp->{mat}[0] = $m1[0] = $boxp->{x2} - $boxp->{x1}; $boxp->{mat}[1] = $m1[1] = 0.0; $boxp->{mat}[2] = $m1[2] = 0.0; $boxp->{mat}[3] = $m1[3] = 0.0; $boxp->{mat}[4] = $m1[4] = $boxp->{y2} - $boxp->{y1}; $boxp->{mat}[5] = $m1[5] = 0.0; $boxp->{mat}[6] = $m1[6] = $boxp->{x1}; $boxp->{mat}[7] = $m1[7] = $boxp->{y1}; $boxp->{mat}[8] = $m1[8] = 1.0; given ($orientation) { when (2) { $boxp->{mat}[0] = 0.0 - $m1[0]; $boxp->{mat}[6] += $m1[0]; } when (3) { $boxp->{mat}[0] = 0.0 - $m1[0]; $boxp->{mat}[4] = 0.0 - $m1[4]; $boxp->{mat}[6] += $m1[0]; $boxp->{mat}[7] += $m1[4]; } when (4) { $boxp->{mat}[4] = 0.0 - $m1[4]; $boxp->{mat}[7] += $m1[4]; } when (5) { $boxp->{mat}[0] = 0.0; $boxp->{mat}[1] = 0.0 - $m1[0]; $boxp->{mat}[3] = 0.0 - $m1[4]; $boxp->{mat}[4] = 0.0; $boxp->{mat}[6] += $m1[4]; $boxp->{mat}[7] += $m1[0]; } when (6) { $boxp->{mat}[0] = 0.0; $boxp->{mat}[1] = 0.0 - $m1[0]; $boxp->{mat}[3] = $m1[4]; $boxp->{mat}[4] = 0.0; $boxp->{mat}[7] += $m1[0]; } when (7) { $boxp->{mat}[0] = 0.0; $boxp->{mat}[1] = $m1[0]; $boxp->{mat}[3] = $m1[4]; $boxp->{mat}[4] = 0.0; } when (8) { $boxp->{mat}[0] = 0.0; $boxp->{mat}[1] = $m1[0]; $boxp->{mat}[3] = 0.0 - $m1[4]; $boxp->{mat}[4] = 0.0; $boxp->{mat}[6] += $m1[4]; } } return; } # This function writes a PDF Contents stream to output. sub t2p_write_pdf_page_content_stream { my ( $t2p, $output ) = @_; my $written = 0; if ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} > 0 ) { for ( my $i = 0 ; $i < $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} ; $i++ ) { my $box = $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tiles}[$i]{tile_box}; my $buffer = sprintf "q %s %.4f %.4f %.4f %.4f %.4f %.4f cm /Im%d_%ld Do Q\n", $t2p->{tiff_transferfunctioncount} ? '/GS1 gs ' : q{}, $box->{mat}[0], $box->{mat}[1], $box->{mat}[3], $box->{mat}[4], $box->{mat}[6], $box->{mat}[7], $t2p->{pdf_page} + 1, $i + 1; $written += t2pWriteFile( $output, $buffer ); } } else { my $box = $t2p->{pdf_imagebox}; my $buffer = sprintf "q %s %.4f %.4f %.4f %.4f %.4f %.4f cm /Im%d Do Q\n", $t2p->{tiff_transferfunctioncount} ? '/GS1 gs ' : q{}, $box->{mat}[0], $box->{mat}[1], $box->{mat}[3], $box->{mat}[4], $box->{mat}[6], $box->{mat}[7], $t2p->{pdf_page} + 1; $written += t2pWriteFile( $output, $buffer ); } return $written; } # This function writes a PDF Image XObject stream dictionary to output. sub t2p_write_pdf_xobject_stream_dict { my ( $tile, $t2p, $output ) = @_; my $written = t2p_write_pdf_stream_dict( 0, $t2p->{pdf_xrefcount} + 1, $output ); my $buffer = "/Type /XObject \n/Subtype /Image \n/Name /Im"; $buffer .= sprintf '%u', $t2p->{pdf_page} + 1; if ( $tile != 0 ) { $buffer .= sprintf '_%lu', $tile; } $buffer .= "\n/Width "; if ( $tile == 0 ) { $buffer .= sprintf '%lu', $t2p->{tiff_width}; } else { if ( t2p_tile_is_right_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile - 1 ) != 0 ) { $buffer .= sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilewidth}; } else { $buffer .= sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}; } } $buffer .= "\n/Height "; if ( $tile == 0 ) { $buffer .= sprintf '%lu', $t2p->{tiff_length}; } else { if ( t2p_tile_is_bottom_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile - 1 ) != 0 ) { $buffer .= sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_edgetilelength}; } else { $buffer .= sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength}; } } $buffer .= "\n/BitsPerComponent "; $buffer .= sprintf '%u', $t2p->{tiff_bitspersample}; $buffer .= "\n/ColorSpace "; $written += t2pWriteFile( $output, $buffer ); $written += t2p_write_pdf_xobject_cs( $t2p, $output ); if ( $t2p->{pdf_image_interpolate} ) { $buffer = "\n/Interpolate true"; $written += t2pWriteFile( $output, $buffer ); } if ( $t2p->{pdf_switchdecode} && !( $t2p->{pdf_colorspace} == $T2P_CS_BILEVEL && $t2p->{pdf_compression} == $T2P_COMPRESS_G4 ) ) { $written += t2p_write_pdf_xobject_decode( $t2p, $output ); } $written += t2p_write_pdf_xobject_stream_filter( $tile, $t2p, $output ); return $written; } # This function writes a PDF Image XObject Colorspace name to output. sub t2p_write_pdf_xobject_cs { my ( $t2p, $output ) = @_; my $X_W = 1.0; my $Y_W = 1.0; my $Z_W = 1.0; my $written = 0; if ( ( $t2p->{pdf_colorspace} & $T2P_CS_ICCBASED ) != 0 ) { return t2p_write_pdf_xobject_icccs( $t2p, $output ); } if ( ( $t2p->{pdf_colorspace} & $T2P_CS_PALETTE ) != 0 ) { my $buffer = '[ /Indexed '; $written += t2pWriteFile( $output, $buffer ); $t2p->{pdf_colorspace} ^= $T2P_CS_PALETTE; $written += t2p_write_pdf_xobject_cs( $t2p, $output ); $t2p->{pdf_colorspace} |= $T2P_CS_PALETTE; $buffer = sprintf '%u', ( 0x0001 << $t2p->{tiff_bitspersample} ) - 1; $buffer .= q{ }; $buffer .= sprintf '%lu', $t2p->{pdf_palettecs}; $buffer .= " 0 R ]\n"; $written += t2pWriteFile( $output, $buffer ); return $written; } if ( $t2p->{pdf_colorspace} & $T2P_CS_BILEVEL ) { my $buffer = "/DeviceGray \n"; $written += t2pWriteFile( $output, $buffer ); } if ( $t2p->{pdf_colorspace} & $T2P_CS_GRAY ) { if ( $t2p->{pdf_colorspace} & $T2P_CS_CALGRAY ) { $written += t2p_write_pdf_xobject_calcs( $t2p, $output ); } else { $written += t2pWriteFile( $output, "/DeviceGray \n" ); } } if ( $t2p->{pdf_colorspace} & $T2P_CS_RGB ) { if ( $t2p->{pdf_colorspace} & $T2P_CS_CALRGB ) { $written += t2p_write_pdf_xobject_calcs( $t2p, $output ); } else { $written += t2pWriteFile( $output, "/DeviceRGB \n" ); } } if ( $t2p->{pdf_colorspace} & $T2P_CS_CMYK ) { $written += t2pWriteFile( $output, "/DeviceCMYK \n" ); } if ( $t2p->{pdf_colorspace} & $T2P_CS_LAB ) { $written += t2pWriteFile( $output, "[/Lab << \n" ); $written += t2pWriteFile( $output, '/WhitePoint ' ); $X_W = $t2p->{tiff_whitechromaticities}[0]; $Y_W = $t2p->{tiff_whitechromaticities}[1]; $Z_W = 1.0 - ( $X_W + $Y_W ); $X_W /= $Y_W; $Z_W /= $Y_W; $Y_W = 1.0; my $buffer = sprintf "[%.4f %.4f %.4f] \n", $X_W, $Y_W, $Z_W; $buffer .= '/Range '; $buffer .= sprintf "[%d %d %d %d] \n", $t2p->{pdf_labrange}[0], $t2p->{pdf_labrange}[1], $t2p->{pdf_labrange}[2], $t2p->{pdf_labrange}[3]; $buffer .= ">>] \n"; $written += t2pWriteFile( $output, $buffer ); } return $written; } # This function writes a PDF Image XObject Colorspace array to output. sub t2p_write_pdf_xobject_calcs { my ( $t2p, $output ) = @_; my $written = 0; my $X_W = 0.0; my $Y_W = 0.0; my $Z_W = 0.0; my $X_R = 0.0; my $Y_R = 0.0; my $Z_R = 0.0; my $X_G = 0.0; my $Y_G = 0.0; my $Z_G = 0.0; my $X_B = 0.0; my $Y_B = 0.0; my $Z_B = 0.0; my $x_w = 0.0; my $y_w = 0.0; my $z_w = 0.0; my $x_r = 0.0; my $y_r = 0.0; my $x_g = 0.0; my $y_g = 0.0; my $x_b = 0.0; my $y_b = 0.0; my $R = 1.0; my $G = 1.0; my $B = 1.0; $written += t2pWriteFile( $output, '[', 1 ); if ( $t2p->{pdf_colorspace} & $T2P_CS_CALGRAY ) { $written += t2pWriteFile( $output, '/CalGray ' ); $X_W = $t2p->{tiff_whitechromaticities}[0]; $Y_W = $t2p->{tiff_whitechromaticities}[1]; $Z_W = 1.0 - ( $X_W + $Y_W ); $X_W /= $Y_W; $Z_W /= $Y_W; $Y_W = 1.0; } if ( $t2p->{pdf_colorspace} & $T2P_CS_CALRGB ) { $written += t2pWriteFile( $output, '/CalRGB ' ); $x_w = $t2p->{tiff_whitechromaticities}[0]; $y_w = $t2p->{tiff_whitechromaticities}[1]; $x_r = $t2p->{tiff_primarychromaticities}[0]; $y_r = $t2p->{tiff_primarychromaticities}[1]; $x_g = $t2p->{tiff_primarychromaticities}[2]; $y_g = $t2p->{tiff_primarychromaticities}[3]; $x_b = $t2p->{tiff_primarychromaticities}[4]; $y_b = $t2p->{tiff_primarychromaticities}[5]; $z_w = $y_w * ( ( $x_g - $x_b ) * $y_r - ( $x_r - $x_b ) * $y_g + ( $x_r - $x_g ) * $y_b ); $Y_R = ( $y_r / $R ) * ( ( $x_g - $x_b ) * $y_w - ( $x_w - $x_b ) * $y_g + ( $x_w - $x_g ) * $y_b ) / $z_w; $X_R = $Y_R * $x_r / $y_r; $Z_R = $Y_R * ( ( ( 1 - $x_r ) / $y_r ) - 1 ); $Y_G = ( ( 0.0 - ($y_g) ) / $G ) * ( ( $x_r - $x_b ) * $y_w - ( $x_w - $x_b ) * $y_r + ( $x_w - $x_r ) * $y_b ) / $z_w; $X_G = $Y_G * $x_g / $y_g; $Z_G = $Y_G * ( ( ( 1 - $x_g ) / $y_g ) - 1 ); $Y_B = ( $y_b / $B ) * ( ( $x_r - $x_g ) * $y_w - ( $x_w - $x_g ) * $y_r + ( $x_w - $x_r ) * $y_g ) / $z_w; $X_B = $Y_B * $x_b / $y_b; $Z_B = $Y_B * ( ( ( 1 - $x_b ) / $y_b ) - 1 ); $X_W = ( $X_R * $R ) + ( $X_G * $G ) + ( $X_B * $B ); $Y_W = ( $Y_R * $R ) + ( $Y_G * $G ) + ( $Y_B * $B ); $Z_W = ( $Z_R * $R ) + ( $Z_G * $G ) + ( $Z_B * $B ); $X_W /= $Y_W; $Z_W /= $Y_W; $Y_W = 1.0; } $written += t2pWriteFile( $output, "<< \n", 4 ); if ( $t2p->{pdf_colorspace} & $T2P_CS_CALGRAY ) { $written += t2pWriteFile( $output, '/WhitePoint ' ); my $buffer = sprintf "[%.4f %.4f %.4f] \n", $X_W, $Y_W, $Z_W; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, "/Gamma 2.2 \n" ); } if ( $t2p->{pdf_colorspace} & $T2P_CS_CALRGB ) { $written += t2pWriteFile( $output, '/WhitePoint ' ); my $buffer = sprintf "[%.4f %.4f %.4f] \n", $X_W, $Y_W, $Z_W; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, '/Matrix ' ); $buffer = sprintf "[%.4f %.4f %.4f %.4f %.4f %.4f %.4f %.4f %.4f] \n", $X_R, $Y_R, $Z_R, $X_G, $Y_G, $Z_G, $X_B, $Y_B, $Z_B; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, "/Gamma [2.2 2.2 2.2] \n" ); } $written += t2pWriteFile( $output, ">>] \n" ); return $written; } # This function writes a PDF Image XObject stream filter name and parameters to # output. sub t2p_write_pdf_xobject_stream_filter { my ( $tile, $t2p, $output ) = @_; if ( $t2p->{pdf_compression} == $T2P_COMPRESS_NONE ) { return 0; } my $written = t2pWriteFile( $output, '/Filter ' ); given ( $t2p->{pdf_compression} ) { when ($T2P_COMPRESS_G4) { $written += t2pWriteFile( $output, '/CCITTFaxDecode ' ); $written += t2pWriteFile( $output, '/DecodeParms ' ); $written += t2pWriteFile( $output, '<< /K -1 ' ); if ( $tile == 0 ) { $written += t2pWriteFile( $output, '/Columns ' ); my $buffer = sprintf '%lu', $t2p->{tiff_width}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, ' /Rows ' ); $buffer = sprintf '%lu', $t2p->{tiff_length}; $written += t2pWriteFile( $output, $buffer ); } else { if ( t2p_tile_is_right_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile - 1 ) == 0 ) { $written += t2pWriteFile( $output, '/Columns ' ); my $buffer = sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilewidth}; $written += t2pWriteFile( $output, $buffer ); } else { $written += t2pWriteFile( $output, '/Columns ' ); my $buffer = sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ] {tiles_edgetilewidth}; $written += t2pWriteFile( $output, $buffer ); } if ( t2p_tile_is_bottom_edge( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ], $tile - 1 ) == 0 ) { $written += t2pWriteFile( $output, ' /Rows ' ); my $buffer = sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilelength}; $written += t2pWriteFile( $output, $buffer ); } else { $written += t2pWriteFile( $output, ' /Rows ' ); my $buffer = sprintf '%lu', $t2p->{tiff_tiles}[ $t2p->{pdf_page} ] {tiles_edgetilelength}; $written += t2pWriteFile( $output, $buffer ); } } if ( $t2p->{pdf_switchdecode} == 0 ) { $written += t2pWriteFile( $output, ' /BlackIs1 true ' ); } $written += t2pWriteFile( $output, ">>\n" ); } when ($T2P_COMPRESS_JPEG) { $written += t2pWriteFile( $output, '/DCTDecode ' ); if ( $t2p->{tiff_photometric} != PHOTOMETRIC_YCBCR ) { $written += t2pWriteFile( $output, '/DecodeParms ' ); $written += t2pWriteFile( $output, "<< /ColorTransform 0 >>\n" ); } } when ($T2P_COMPRESS_ZIP) { $written += t2pWriteFile( $output, '/FlateDecode ' ); if ( $t2p->{pdf_compressionquality} % 100 ) { $written += t2pWriteFile( $output, '/DecodeParms ' ); $written += t2pWriteFile( $output, '< /Predictor ' ); my $buffer = sprintf '%u', $t2p->{pdf_compressionquality} % 100; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, ' /Columns ' ); $buffer = sprintf '%lu', $t2p->{tiff_width}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, ' /Colors ' ); $buffer = sprintf '%u', $t2p->{tiff_samplesperpixel}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, ' /BitsPerComponent ' ); $buffer = sprintf '%u', $t2p->{tiff_bitspersample}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, ">>\n" ); } } } return $written; } # This function writes a PDF xref table to output. sub t2p_write_pdf_xreftable { my ( $t2p, $output ) = @_; my $written = t2pWriteFile( $output, "xref\n0 " ); my $buffer = sprintf '%lu', $t2p->{pdf_xrefcount} + 1; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, " \n0000000000 65535 f \n" ); for my $i ( 0 .. $t2p->{pdf_xrefcount} - 1 ) { $buffer = sprintf "%.10lu 00000 n \n", $t2p->{pdf_xrefoffsets}[$i]; $written += t2pWriteFile( $output, $buffer ); } return $written; } # This function writes a PDF trailer to output. sub t2p_write_pdf_trailer { my ( $t2p, $output ) = @_; for ( my $i = 0 ; $i < 25 ; $i += 8 ) { $t2p->{pdf_fileid} .= sprintf '%.8X', int( rand( 0xFFFFFFFF + 1 ) ); } my $written = t2pWriteFile( $output, "trailer\n<<\n/Size " ); my $buffer = sprintf '%lu', $t2p->{pdf_xrefcount} + 1; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, "\n/Root " ); $buffer = sprintf '%lu', $t2p->{pdf_catalog}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, " 0 R \n/Info " ); $buffer = sprintf '%lu', $t2p->{pdf_info}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, " 0 R \n/ID[<" ); $written += t2pWriteFile( $output, $t2p->{pdf_fileid} ); $written += t2pWriteFile( $output, '><' ); $written += t2pWriteFile( $output, $t2p->{pdf_fileid} ); $written += t2pWriteFile( $output, ">]\n>>\nstartxref\n" ); $buffer = sprintf '%lu', $t2p->{pdf_startxref}; $written += t2pWriteFile( $output, $buffer ); $written += t2pWriteFile( $output, "\n%%EOF\n" ); return $written; } # This function writes a PDF to a file given a pointer to a TIFF. # The idea with using a TIFF* as output for a PDF file is that the file # can be created with TIFFClientOpen for memory-mapped use within the TIFF # library, and TIFFWriteEncodedStrip can be used to write compressed data to # the output. The output is not actually a TIFF file, it is a PDF file. # This function uses only t2pWriteFile and TIFFWriteEncodedStrip to write to # the output TIFF file. When libtiff would otherwise be writing data to the # output file, the write procedure of the TIFF structure is replaced with an # empty implementation. # The first argument to the function is an initialized and validated T2P # context struct pointer. # The second argument to the function is the TIFF* that is the input that has # been opened for reading and no other functions have been called upon it. # The third argument to the function is the TIFF* that is the output that has # been opened for writing. It has to be opened so that it hasn't written any # data to the output. If the output is seekable then it's OK to seek to the # beginning of the file. The function only writes to the output PDF and does # not seek. See the example usage in the main() function. # TIFF* output = TIFFOpen('output.pdf', 'w'); # assert(output != NULL); # if(output->tif_seekproc != NULL){ # t2pSeekFile(output, (toff_t) 0, SEEK_SET); # } # This function returns the file size of the output PDF file. On error it # returns zero and the t2p->t2p_error variable is set to T2P_ERR_ERROR. # After this function completes, call t2p_free on t2p, TIFFClose on input, # and TIFFClose on output. sub t2p_write_pdf { my ( $t2p, $input, $output ) = @_; t2p_read_tiff_init( $t2p, $input ); if ( $t2p->{t2p_error} != $T2P_ERR_OK ) { return 0 } $t2p->{pdf_xrefcount} = 0; $t2p->{pdf_catalog} = 1; $t2p->{pdf_info} = 2; $t2p->{pdf_pages} = 3; my $written = t2p_write_pdf_header( $t2p, $output ); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $t2p->{pdf_catalog} = $t2p->{pdf_xrefcount}; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_catalog( $t2p, $output ); $written += t2p_write_pdf_obj_end($output); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $t2p->{pdf_info} = $t2p->{pdf_xrefcount}; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_info( $t2p, $input, $output ); $written += t2p_write_pdf_obj_end($output); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $t2p->{pdf_pages} = $t2p->{pdf_xrefcount}; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_pages( $t2p, $output ); $written += t2p_write_pdf_obj_end($output); for my $j ( 0 .. $t2p->{tiff_pagecount} - 1 ) { $t2p->{pdf_page} = $j; t2p_read_tiff_data( $t2p, $input ); if ( $t2p->{t2p_error} != $T2P_ERR_OK ) { return 0 } $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_page( $t2p->{pdf_xrefcount}, $t2p, $output ); $written += t2p_write_pdf_obj_end($output); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_dict_start($output); $written += t2p_write_pdf_stream_dict( 0, $t2p->{pdf_xrefcount} + 1, $output ); $written += t2p_write_pdf_stream_dict_end($output); $written += t2p_write_pdf_stream_start($output); my $streamlen = $written; $written += t2p_write_pdf_page_content_stream( $t2p, $output ); $streamlen = $written - $streamlen; $written += t2p_write_pdf_stream_end($output); $written += t2p_write_pdf_obj_end($output); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_length( $streamlen, $output ); $written += t2p_write_pdf_obj_end($output); if ( $t2p->{tiff_transferfunctioncount} != 0 ) { $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_transfer( $t2p, $output ); $written += t2p_write_pdf_obj_end($output); for my $i ( 0 .. $t2p->{tiff_transferfunctioncount} - 1 ) { $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_dict_start($output); $written += t2p_write_pdf_transfer_dict( $t2p, $output, $i ); $written += t2p_write_pdf_stream_dict_end($output); $written += t2p_write_pdf_stream_start($output); $written += t2p_write_pdf_transfer_stream( $t2p, $output, $i ); $written += t2p_write_pdf_stream_end($output); $written += t2p_write_pdf_obj_end($output); } } if ( ( $t2p->{pdf_colorspace} & $T2P_CS_PALETTE ) != 0 ) { $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $t2p->{pdf_palettecs} = $t2p->{pdf_xrefcount}; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_dict_start($output); $written += t2p_write_pdf_stream_dict( $t2p->{pdf_palettesize}, 0, $output ); $written += t2p_write_pdf_stream_dict_end($output); $written += t2p_write_pdf_stream_start($output); $written += t2p_write_pdf_xobject_palettecs_stream( $t2p, $output ); $written += t2p_write_pdf_stream_end($output); $written += t2p_write_pdf_obj_end($output); } if ( ( $t2p->{pdf_colorspace} & $T2P_CS_ICCBASED ) != 0 ) { $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $t2p->{pdf_icccs} = $t2p->{pdf_xrefcount}; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_dict_start($output); $written += t2p_write_pdf_xobject_icccs_dict( $t2p, $output ); $written += t2p_write_pdf_stream_dict_end($output); $written += t2p_write_pdf_stream_start($output); $written += t2p_write_pdf_xobject_icccs_stream( $t2p, $output ); $written += t2p_write_pdf_stream_end($output); $written += t2p_write_pdf_obj_end($output); } if ( $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} != 0 ) { for my $i ( 0 .. $t2p->{tiff_tiles}[ $t2p->{pdf_page} ]{tiles_tilecount} - 1 ) { $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_dict_start($output); $written += t2p_write_pdf_xobject_stream_dict( $i + 1, $t2p, $output ); $written += t2p_write_pdf_stream_dict_end($output); $written += t2p_write_pdf_stream_start($output); my $streamlen = $written; t2p_read_tiff_size_tile( $t2p, $input, $i ); $written += t2p_readwrite_pdf_image_tile( $t2p, $input, $output, $i ); # t2p_write_advance_directory( $t2p, $output ); if ( $t2p->{t2p_error} != $T2P_ERR_OK ) { return 0 } $streamlen = $written - $streamlen; $written += t2p_write_pdf_stream_end($output); $written += t2p_write_pdf_obj_end($output); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_length( $streamlen, $output ); $written += t2p_write_pdf_obj_end($output); } } else { $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_dict_start($output); $written += t2p_write_pdf_xobject_stream_dict( 0, $t2p, $output ); $written += t2p_write_pdf_stream_dict_end($output); $written += t2p_write_pdf_stream_start($output); my $streamlen = $written; t2p_read_tiff_size( $t2p, $input ); $written += t2p_readwrite_pdf_image( $t2p, $input, $output ); # t2p_write_advance_directory( $t2p, $output ); if ( $t2p->{t2p_error} != $T2P_ERR_OK ) { return 0 } $streamlen = $written - $streamlen; $written += t2p_write_pdf_stream_end($output); $written += t2p_write_pdf_obj_end($output); $t2p->{pdf_xrefoffsets}[ $t2p->{pdf_xrefcount}++ ] = $written; $written += t2p_write_pdf_obj_start( $t2p->{pdf_xrefcount}, $output ); $written += t2p_write_pdf_stream_length( $streamlen, $output ); $written += t2p_write_pdf_obj_end($output); } } $t2p->{pdf_startxref} = $written; $written += t2p_write_pdf_xreftable( $t2p, $output ); $written += t2p_write_pdf_trailer( $t2p, $output ); return $written; } exit main(); Graphics-TIFF-20/examples/tiffinfo.pl0000644000175000017500000002024014436713615016160 0ustar jeffjeff#!/usr/bin/perl use warnings; use strict; use Graphics::TIFF ':all'; use feature 'switch'; no if $] >= 5.018, warnings => 'experimental::smartmatch'; use English qw( -no_match_vars ); use Readonly; Readonly my $EXIT_ERROR => -1; Readonly my $TIFF_4_4_0 => 4.004000; our $VERSION; my ( $optarg, $dirnum, $showdata, $rawdata, $showwords, $readdata, $chopstrips ); my $optind = 0; my $stoponerr = 1; my $diroff = 0; sub main { my $flags = 0; my $order = 0; while ( my $c = getopt('f:o:cdDijrswz0123456789') ) { given ($c) { when (/\d/xsm) { $dirnum = substr $ARGV[ $optind - 1 ], 1; } when ('c') { $flags |= TIFFPRINT_COLORMAP | TIFFPRINT_CURVES; } when ('d') { $showdata++; $readdata++; } when ('D') { $readdata++; } when ('f') { if ( $optarg eq 'lsb2msb' ) { $order = FILLORDER_LSB2MSB; } elsif ( $optarg eq 'msb2lsb' ) { $order = FILLORDER_MSB2LSB; } } when ('i') { $stoponerr = 0; } when ('j') { $flags |= TIFFPRINT_JPEGQTABLES | TIFFPRINT_JPEGACTABLES | TIFFPRINT_JPEGDCTABLES; } when ('o') { $diroff = $optarg; } when ('r') { $rawdata = 1; } when ('s') { $flags |= TIFFPRINT_STRIPS; } when ('w') { $showwords = 1; } when ('z') { $chopstrips = 1; } default { usage(); } } } my $multiplefiles = @ARGV - $optind > 1; while ( $optind < @ARGV ) { if ($multiplefiles) { print "$ARGV[$optind]\n" } process_file( $ARGV[ $optind++ ], $order, $flags ); } return 0; } sub getopt { my ($options) = @_; my $c; if ( substr( $ARGV[$optind], 0, 1 ) eq qw{-} ) { $c = substr $ARGV[ $optind++ ], 1, 1; my $regex = $c; if ( $regex eq qw{?} ) { $regex = qw{\?} } if ( $options =~ /$regex(:)?/xsm ) { if ( defined $1 ) { $optarg = $ARGV[ $optind++ ] } } else { if ( $OSNAME eq 'freebsd' ) { warn "tiffinfo: illegal option -- $c\n"; } else { warn "tiffinfo: invalid option -- $c\n"; } usage(); } } return $c; } sub usage { warn Graphics::TIFF->GetVersion() . "\n\n"; warn <<'EOS'; usage: tiffinfo [options] input... where options are: -D read data -i ignore read errors -c display data for grey/color response curve or colormap -d display raw/decoded image data -f lsb2msb force lsb-to-msb FillOrder for input -f msb2lsb force msb-to-lsb FillOrder for input -j show JPEG tables -o offset set initial directory offset -r read/display raw image data instead of decoded data -s display strip offsets and byte counts -w display raw data in words rather than bytes -z enable strip chopping -# set initial directory (first directory is # 0) EOS exit $EXIT_ERROR; } sub process_file { my ( $file, $order, $flags ) = @_; my $tif = Graphics::TIFF->Open( $file, $chopstrips ? 'rC' : 'rc' ); if ( defined $tif ) { if ( defined $dirnum ) { if ( $tif->SetDirectory($dirnum) ) { tiffinfo( $tif, $order, $flags, 1 ); } } elsif ( $diroff != 0 ) { if ( $tif->SetSubDirectory($diroff) ) { tiffinfo( $tif, $order, $flags, 1 ); } } else { my $next = 1; while ($next) { tiffinfo( $tif, $order, $flags, 1 ); my $offset = $tif->GetField(TIFFTAG_EXIFIFD); if ( defined $offset ) { if ( $tif->ReadEXIFDirectory($offset) ) { tiffinfo( $tif, $order, $flags, 0 ); } } $next = $tif->ReadDirectory; } } } $tif->Close; return; } sub showstrip { my ( $strip, $pp, $nrow, $scanline ) = @_; printf "Strip %lu:\n", $strip; my $i = 0; while ( $nrow-- > 0 ) { for my $cc ( 0 .. $scanline - 1 ) { printf ' %02x', ord( substr $pp, $i++, 1 ); if ( ( ( $cc + 1 ) % 24 ) == 0 ) ## no critic (ProhibitMagicNumbers) { print "\n"; } } print "\n"; } return; } sub readcontigstripdata { my ($tif) = @_; my $scanline = $tif->ScanlineSize; my $h = $tif->GetField(TIFFTAG_IMAGELENGTH); my $rowsperstrip = $tif->GetField(TIFFTAG_ROWSPERSTRIP); for ( my $row = 0 ; $row < $h ; $row += $rowsperstrip ) { ## no critic (ProhibitCStyleForLoops) my $nrow = ( $row + $rowsperstrip > $h ? $h - $row : $rowsperstrip ); my $strip = $tif->ComputeStrip( $row, 0 ); if ( not( my $buf = $tif->ReadEncodedStrip( $strip, $nrow * $scanline ) ) ) { if ($stoponerr) { last } } elsif ($showdata) { showstrip( $strip, $buf, $nrow, $scanline ); } } return; } sub readdata { my ($tif) = @_; my $config = $tif->GetField(TIFFTAG_PLANARCONFIG); if ( $tif->IsTiled ) { if ( $config == PLANARCONFIG_CONTIG ) { TIFFReadContigTileData($tif); } else { TIFFReadSeparateTileData($tif); } } else { if ( $config == PLANARCONFIG_CONTIG ) { readcontigstripdata($tif); } else { ReadSeparateStripData($tif); } } return; } sub showrawbytes { my ( $pp, $n ) = @_; for my $i ( 0 .. $n - 1 ) { printf ' %02x', ord( substr $pp, $i, 1 ); if ( ( ( $i + 1 ) % 24 ) == 0 ) { ## no critic (ProhibitMagicNumbers) print "\n "; } } print "\n"; return; } sub showrawwords { my ( $pp, $n ) = @_; for my $i ( 0 .. $n - 1 ) { printf ' %04x', ord( substr $pp, $i, 1 ); if ( ( ( $i + 1 ) % 15 ) == 0 ) { ## no critic (ProhibitMagicNumbers) print "\n "; } } print "\n"; return; } sub readrawdata { my ( $tif, $bitrev ) = @_; my $nstrips = $tif->NumberOfStrips(); my $what = $tif->IsTiled() ? 'Tile' : 'Strip'; my @stripbc = $tif->GetField(TIFFTAG_STRIPBYTECOUNTS); if ( $nstrips > 0 ) { for my $s ( 0 .. $#stripbc ) { my $buf; if ( $buf = $tif->ReadRawStrip( $s, $stripbc[$s] ) ) { if ($showdata) { if ($bitrev) { TIFFReverseBits( $buf, $stripbc[$s] ); printf "%s %lu: (bit reversed)\n ", $what, $s; } else { printf "%s %lu:\n ", $what, $s; } if ($showwords) { showrawwords( $buf, $stripbc[$s] >> 1 ); } else { showrawbytes( $buf, $stripbc[$s] ); } } } else { warn "Error reading strip $s\n"; if ($stoponerr) { last } } } } return; } sub tiffinfo { my ( $tif, $order, $flags, $is_image ) = @_; if ( Graphics::TIFF->get_version_scalar >= $TIFF_4_4_0 ) { printf "=== TIFF directory %d ===\n", $tif->CurrentDirectory; } $tif->PrintDirectory( *STDOUT, $flags ); if ( not $readdata or not $is_image ) { return } if ($rawdata) { if ($order) { my $o = $tif->GetFieldDefaulted(TIFFTAG_FILLORDER); readrawdata( $tif, $o != $order ); } else { readrawdata( $tif, 0 ); } } else { if ($order) { $tif->SetField( TIFFTAG_FILLORDER, $order ) } readdata($tif); } return; } exit main(); Graphics-TIFF-20/META.json0000664000175000017500000000256714437671602013640 0ustar jeffjeff{ "abstract" : "Perl extension for the libtiff library", "author" : [ "Jeffrey Ratcliffe" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Graphics-TIFF", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::Depends" : "0", "ExtUtils::PkgConfig" : "0" } }, "runtime" : { "requires" : { "Readonly" : "0" } }, "test" : { "requires" : { "File::Spec" : "0", "File::Temp" : "0.19", "Test::Deep" : "0", "Test::More" : "0", "Test::Requires" : "0" } } }, "release_status" : "stable", "resources" : { "repository" : { "type" : "git", "url" : "https://github.com/carygravel/graphics-tiff.git", "web" : "https://github.com/carygravel/graphics-tiff" } }, "version" : 20, "x_serialization_backend" : "JSON::PP version 4.06" } Graphics-TIFF-20/META.yml0000664000175000017500000000135214437671602013457 0ustar jeffjeff--- abstract: 'Perl extension for the libtiff library' author: - 'Jeffrey Ratcliffe' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' File::Temp: '0.19' Test::Deep: '0' Test::More: '0' Test::Requires: '0' configure_requires: ExtUtils::Depends: '0' ExtUtils::PkgConfig: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.62, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Graphics-TIFF no_index: directory: - t - inc requires: Readonly: '0' resources: repository: https://github.com/carygravel/graphics-tiff.git version: '20' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Graphics-TIFF-20/README0000644000175000017500000000355514437662606013077 0ustar jeffjeffNAME Graphics::TIFF - Perl extension for the libtiff library VERSION 20 SYNOPSIS Perl bindings for the libtiff library. This module allows you to access TIFF images in a Perlish and object-oriented way, freeing you from the casting and memory management in C, yet remaining very close in spirit to original API. The following snippet can be used to read the image data from a TIFF: use Graphics::TIFF ':all'; my $tif = Graphics::TIFF->Open( 'test.tif', 'r' ); my $stripsize = $tif->StripSize; for my $stripnum ( 0 .. $tif->NumberOfStrips - 1 ) { my $buffer = $tif->ReadEncodedStrip( $stripnum, $stripsize ); # do something with $buffer } $tif->Close; DESCRIPTION The Graphics::TIFF module allows a Perl developer to access TIFF images. Find out more about libtiff at http://www.libtiff.org. DIAGNOSTICS CONFIGURATION AND ENVIRONMENT DEPENDENCIES Runtime The runtime dependencies are just libtiff itself. In Windows this is satisfied by Alien::libtiff. Build The build dependencies are additionally the development headers for libtiff and Perl. Test In addition to the above, the Perl module Image::Magick is required to run some of the tests. INCOMPATIBILITIES BUGS AND LIMITATIONS SEE ALSO The LIBTIFF Standard Reference http://www.libtiff.org/libtiff.html is a handy companion. The Perl bindings follow the C API very closely, and the C reference documentation should be considered the canonical source. AUTHOR Jeffrey Ratcliffe, LICENSE AND COPYRIGHT Copyright (C) 2017--2023 by Jeffrey Ratcliffe This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.5 or, at your option, any later version of Perl 5 you may have available.