From 3d3cff9d76b64e38b9e40962582067ca3681e60a Mon Sep 17 00:00:00 2001
From: Jeffrey Ratcliffe <jffry@posteo.net>
Date: Fri, 14 Jul 2017 19:27:48 +0200
Subject: [PATCH] Use libtiff to decode image data in TIFF, fixing RT 118047

---
 Makefile.PL                                 |   3 +-
 lib/PDF/API2/Resource/XObject/Image/TIFF.pm | 534 ++++++----------------------
 t/tiff.t                                    |  71 +++-
 3 files changed, 182 insertions(+), 426 deletions(-)

diff --git a/Makefile.PL b/Makefile.PL
index 32341a8..8ec4af7 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -21,7 +21,8 @@ my %WriteMakefileArgs = (
   "NAME" => "PDF::API2",
   "PREREQ_PM" => {
     "Compress::Zlib" => "1.0",
-    "Font::TTF" => 0
+    "Font::TTF" => 0,
+    "Graphics::TIFF" => 0,
   },
   "VERSION" => "2.020",
   "test" => {
diff --git a/lib/PDF/API2/Resource/XObject/Image/TIFF.pm b/lib/PDF/API2/Resource/XObject/Image/TIFF.pm
index 154006e..bd60de4 100644
--- a/lib/PDF/API2/Resource/XObject/Image/TIFF.pm
+++ b/lib/PDF/API2/Resource/XObject/Image/TIFF.pm
@@ -8,6 +8,7 @@ use Compress::Zlib;
 
 use PDF::API2::Basic::PDF::Utils;
 use PDF::API2::Util;
+use Graphics::TIFF ':all';
 
 no warnings qw[ deprecated recursion uninitialized ];
 
@@ -66,152 +67,32 @@ sub new_api
     return($obj);
 }
 
-sub deLZW 
-{
-    my ($ibits,$stream)=@_;
-    my $bits=$ibits;
-    my $resetcode=1<<($ibits-1);
-    my $endcode=$resetcode+1;
-    my $nextcode=$endcode+1;
-    my $ptr=0;
-    $stream=unpack('B*',$stream);
-    my $maxptr=length($stream);
-    my $tag;
-    my $out='';
-    my $outptr=0;
-
-#    print STDERR "reset=$resetcode\nend=$endcode\nmax=$maxptr\n";
-
-    my @d=map { chr($_) } (0..$resetcode-1);
-
-    while(($ptr+$bits)<=$maxptr) 
-    {
-        $tag=0;
-        foreach my $off (reverse 1..$bits) 
-        {
-            $tag<<=1;
-            $tag|=substr($stream,$ptr+$bits-$off,1);
-        }
-#        print STDERR "ptr=$ptr,tag=$tag,bits=$bits,next=$nextcode\n";
-#        print STDERR "tag to large\n" if($tag>$nextcode);
-        $ptr+=$bits;
-        if($tag==$resetcode) 
-        {
-            $bits=$ibits;
-            $nextcode=$endcode+1;
-            next;
-        } 
-        elsif($tag==$endcode) {
-            last;
-        } 
-        elsif($tag<$resetcode) {
-            $d[$nextcode]=$d[$tag];
-            $out.=$d[$nextcode];
-            $nextcode++;
-        } 
-        elsif($tag>$endcode) 
-        {
-            $d[$nextcode]=$d[$tag];
-            $d[$nextcode].=substr($d[$tag+1],0,1);
-            $out.=$d[$nextcode];
-            $nextcode++;
-        }
-        $bits++ if($nextcode == (1<<$bits));
-    }
-    return($out);
-}
-
 sub handle_generic 
 {
     my ($self,$pdf,$tif)=@_;
-    
-    if($tif->{filter}) 
-    {
-        # should we die here ?
-        # die "unknown tiff-compression ";
-        $self->filters($tif->{filter});
-        $self->{' nofilt'}=1;
-    } 
-    else 
-    {
-        $self->filters('FlateDecode');
-    }
 
-    if(ref($tif->{imageOffset})) 
-    {
-        $self->{' stream'}='';
-        my $d=scalar @{$tif->{imageOffset}};
-        foreach (1..$d) 
-        {
-            my $buf;
-            $tif->{fh}->seek(shift @{$tif->{imageOffset}},0);
-            $tif->{fh}->read($buf,shift @{$tif->{imageLength}});
-            $self->{' stream'}.=$buf;
-        }
-    } 
-    else 
-    {
-        $tif->{fh}->seek($tif->{imageOffset},0);
-        $tif->{fh}->read($self->{' stream'},$tif->{imageLength});
-    }
-}
-
-sub handle_flate 
-{
-    my ($self,$pdf,$tif)=@_;
     $self->filters('FlateDecode');
 
-    if(ref($tif->{imageOffset})) 
-    {
-        $self->{' stream'}='';
-        my $d=scalar @{$tif->{imageOffset}};
-        foreach (1..$d) 
-        {
-            my $buf;
-            $tif->{fh}->seek(shift @{$tif->{imageOffset}},0);
-            $tif->{fh}->read($buf,shift @{$tif->{imageLength}});
-            $buf=uncompress($buf);
-            $self->{' stream'}.=$buf;
-        }
-    } 
-    else 
-    {
-        $tif->{fh}->seek($tif->{imageOffset},0);
-        $tif->{fh}->read($self->{' stream'},$tif->{imageLength});
-        $self->{' stream'}=uncompress($self->{' stream'});
+    my $stripcount = $tif->{object}->NumberOfStrips();
+    my $buffer = '';
+    for my $i ( 0 .. $stripcount - 1 ) {
+        $buffer .= $tif->{object}->ReadEncodedStrip( $i, -1 );
     }
-}
 
-sub handle_lzw 
-{
-    my ($self,$pdf,$tif)=@_;
-    $self->filters('FlateDecode');
-    my $imageWidth = $tif->{imageWidth};
-    my $mod = $imageWidth % 8;
-    if ($mod > 0) {$imageWidth += 8 - $mod}
-    my $max_raw_strip = $imageWidth*$tif->{bitsPerSample}*$tif->{RowsPerStrip}/8;
-
-    if(ref($tif->{imageOffset})) {
-        $self->{' stream'}='';
-        my $d=scalar @{$tif->{imageOffset}};
-        foreach (1..$d) 
-        {
-            my $buf;
-            $tif->{fh}->seek(shift @{$tif->{imageOffset}},0);
-            $tif->{fh}->read($buf,shift @{$tif->{imageLength}});
-            $buf=deLZW(9,$buf);
-            if (length($buf) > $max_raw_strip) {
-                $buf = substr($buf, 0, $max_raw_strip)
+    if ($tif->{SamplesPerPixel} == $tif->{bitsPerSample} + 1) {
+        if ($tif->{ExtraSamples} == EXTRASAMPLE_ASSOCALPHA) {
+            if ($tif->{bitsPerSample} == 1) {
+                $buffer = sample_greya_to_a($buffer);
+            }
+            else {
+                warn "Don't know what to do with RGBA image\n";
             }
-            $self->{' stream'}.=$buf;
         }
-    } 
-    else 
-    {
-        $tif->{fh}->seek($tif->{imageOffset},0);
-        $tif->{fh}->read($self->{' stream'},$tif->{imageLength});
-        $self->{' stream'}=deLZW(9,$self->{' stream'});
+        else {
+            warn "Don't know what to do with alpha layer in TIFF\n";
+        }
     }
+    $self->{' stream'} .= $buffer;
 }
 
 sub handle_ccitt 
@@ -239,8 +120,10 @@ sub handle_ccitt
     } 
     else 
     {
-        $tif->{fh}->seek($tif->{imageOffset},0);
-        $tif->{fh}->read($self->{' stream'},$tif->{imageLength});
+        my $stripcount = $tif->{object}->NumberOfStrips();
+        for my $i ( 0 .. $stripcount - 1 ) {
+            $self->{' stream'} .= $tif->{object}->ReadRawStrip( $i, -1 );
+        }
     }
 }
 
@@ -287,330 +170,133 @@ sub read_tiff
     {
         $self->handle_ccitt($pdf,$tif);
     } 
-    elsif($tif->{filter} eq 'LZWDecode') 
-    {
-        $self->handle_lzw($pdf,$tif);
-    } 
-    elsif($tif->{filter} eq 'FlateDecode') 
-    {
-        $self->handle_flate($pdf,$tif);
-    } 
     else 
     {
         $self->handle_generic($pdf,$tif);
     }
 
-    if($tif->{fillOrder}==2) 
-    {
-        my @bl=();
-        foreach my $n (0..255) 
-        {
-            my $b=$n;
-            my $f=0;
-            foreach (0..7) 
-            {
-                my $bit=0;
-                if($b &0x1) 
-                {
-                    $bit=1;
-                }
-                $b>>=1;
-                $f<<=1;
-                $f|=$bit;
-            }
-            $bl[$n]=$f;
-        }
-        my $l=length($self->{' stream'})-1;
-        foreach my $n (0..$l) 
-        {
-            vec($self->{' stream'},$n,8)=$bl[vec($self->{' stream'},$n,8)];
-        }
-    }
     $self->{' tiff'}=$tif;
 
     return($self);
 }
 
-=item $value = $tif->tiffTag $tag
-
-returns the value of the internal tiff-tag.
-
-B<Useful Tags:>
+# converts a buffer of interleaved data GreyA to Grey, discarding A.
 
-    imageDescription, imageId (strings)
-    xRes, yRes (dpi; pixel/cm if resUnit==3)
-    resUnit
+sub sample_greya_to_a {
+    my ($buffer) = @_;
 
-=cut
-
-sub tiffTag {
-    my $self=shift @_;
-    my $tag=shift @_;
-    return($self->{' tiff'}->{$tag});
+    my $sampled = '';
+    for my $i (0 .. length($buffer)/2) {
+        $sampled .= substr($buffer, $i*2 + 1, 1);
+    }
+    return $sampled;
 }
 
 package PDF::API2::Resource::XObject::Image::Tiff::File;
 
 use IO::File;
+use Graphics::TIFF ':all';
 
 sub new {
   my $class=shift @_;
   my $file=shift @_;
   my $self={};
   bless($self,$class);
-  if(ref($file)) {
-    $self->{fh} = $file;
-    seek($self->{fh},0,0);
-  } else {
-    $self->{fh} = IO::File->new;
-    open($self->{fh},"< $file");
-  }
-  binmode($self->{fh},':raw');
-  my $fh = $self->{fh};
-
-  $self->{offset}=0;
-  $fh->seek( $self->{offset}, 0 );
-
-  # checking byte order of data
-  $fh->read( $self->{byteOrder}, 2 );
-  $self->{byte}='C';
-  $self->{short}=(($self->{byteOrder} eq 'MM') ? 'n' : 'v' );
-  $self->{long}=(($self->{byteOrder} eq 'MM') ? 'N' : 'V' );
-  $self->{rational}=(($self->{byteOrder} eq 'MM') ? 'NN' : 'VV' );;
 
-  # get/check version id
-  $fh->read( $self->{version}, 2 );
-  $self->{version}=unpack($self->{short},$self->{version});
-  die "Wrong TIFF Id '$self->{version}' (should be 42)." if($self->{version} != 42);
-
-  # get the offset to the first tag directory.
-  $fh->read( $self->{ifdOffset}, 4 );
-  $self->{ifdOffset}=unpack($self->{long},$self->{ifdOffset});
+  $self->{object} = Graphics::TIFF->Open( $file, 'r' );
 
   $self->readTags;
 
   return($self);
 }
 
-sub readTag {
-  my $self = shift @_;
-  my $fh = $self->{fh};
-  my $buf;
-  $fh->read( $buf, 12 );
-  my $tag = unpack($self->{short}, substr($buf, 0, 2 ) );
-  my $type = unpack($self->{short}, substr($buf, 2, 2 ) );
-  my $count = unpack($self->{long}, substr($buf, 4, 4 ) );
-  my $len=0;
-
-  if($type==1) {
-    # byte
-    $len=$count;
-  } elsif($type==2) {
-    # charZ
-    $len=$count;
-  } elsif($type==3) {
-    # int16
-    $len=$count*2;
-  } elsif($type==4) {
-    # int32
-    $len=$count*4;
-  } elsif($type==5) {
-    # rational: 2 * int32
-    $len=$count*8;
-  } else {
-    $len=$count;
-  }
-
-  my $off = substr($buf, 8, 4 );
-
-  if($len>4) {
-    $off=unpack($self->{long},$off);
-  } else {
-    if($type==1) {
-      $off=unpack($self->{byte},$off);
-    } elsif($type==2) {
-      $off=unpack($self->{long},$off);
-    } elsif($type==3) {
-      $off=unpack($self->{short},$off);
-    } elsif($type==4) {
-      $off=unpack($self->{long},$off);
-    } else {
-      $off=unpack($self->{short},$off);
-    }
-  }
-
-  return ($tag,$type,$count,$len,$off);
-}
-
 sub close {
   my $self = shift @_;
-  my $fh = $self->{fh};
-  $fh->close;
-#  %{$self}=();
+  $self->{object}->Close;
+  delete $self->{object};
 }
 
 sub readTags {
   my $self = shift @_;
-  my $fh = $self->{fh};
-  $self->{fillOrder}=1;
-  $self->{ifd}=$self->{ifdOffset};
-
-  while($self->{ifd} > 0) {
-    $fh->seek( $self->{ifd}, 0 );
-    $fh->read( $self->{ifdNum}, 2 );
-    $self->{ifdNum}=unpack($self->{short},$self->{ifdNum});
-    $self->{bitsPerSample}=1;
-    foreach (1..$self->{ifdNum}) {
-      my ($valTag,$valType,$valCount,$valLen,$valOffset)=$self->readTag;
-  #    print "tag=$valTag type=$valType count=$valCount len=$valLen off=$valOffset\n";
-      if($valTag==0) {
-      } elsif($valTag==256) {
-        # imagewidth
-        $self->{imageWidth}=$valOffset;
-      } elsif($valTag==257) {
-        # imageheight
-        $self->{imageHeight}=$valOffset;
-      } elsif($valTag==258) {
-        # bits per sample
-        if($valCount>1) {
-          my $here=$fh->tell;
-          my $val;
-          $fh->seek($valOffset,0);
-          $fh->read($val,2);
-          $self->{bitsPerSample}=unpack($self->{short},$val);
-          $fh->seek($here,0);
-        } else {
-          $self->{bitsPerSample}=$valOffset;
-        }
-      } elsif($valTag==259) {
-        # compression
-        $self->{filter}=$valOffset;
-        if($valOffset==1) {
-          delete $self->{filter};
-        } elsif($valOffset==3 || $valOffset==4) {
-          $self->{filter}='CCITTFaxDecode';
-          $self->{ccitt}=$valOffset;
-        } elsif($valOffset==5) {
-          $self->{filter}='LZWDecode';
-        } elsif($valOffset==6 || $valOffset==7) {
-          $self->{filter}='DCTDecode';
-        } elsif($valOffset==8 || $valOffset==0x80b2) {
-          $self->{filter}='FlateDecode';
-        } elsif($valOffset==32773) {
-          $self->{filter}='RunLengthDecode';
-        } else {
-          die "unknown/unsupported TIFF compression method with id '$self->{filter}'.";
-        }
-      } elsif($valTag==262) {
-        # photometric interpretation
-        $self->{colorSpace}=$valOffset;
-        if($valOffset==0) {
-          $self->{colorSpace}='DeviceGray';
-          $self->{whiteIsZero}=1;
-        } elsif($valOffset==1) {
-          $self->{colorSpace}='DeviceGray';
-          $self->{blackIsZero}=1;
-        } elsif($valOffset==2) {
-          $self->{colorSpace}='DeviceRGB';
-        } elsif($valOffset==3) {
-          $self->{colorSpace}='Indexed';
-      #  } elsif($valOffset==4) {
-      #    $self->{colorSpace}='TransMask';
-        } elsif($valOffset==5) {
-          $self->{colorSpace}='DeviceCMYK';
-        } elsif($valOffset==6) {
-          $self->{colorSpace}='DeviceRGB';
-        } elsif($valOffset==8) {
-          $self->{colorSpace}='Lab';
-        } else {
-          die "unknown/unsupported TIFF photometric interpretation with id '$self->{colorSpace}'.";
-        }
-      } elsif($valTag==266) {
-        $self->{fillOrder}=$valOffset;
-      } elsif($valTag==270) {
-        # ImageDescription
-        my $here=$fh->tell;
-        $fh->seek($valOffset,0);
-        $fh->read($self->{imageDescription},$valLen);
-        $fh->seek($here,0);
-      } elsif($valTag==282) {
-        # xRes
-        my $here=$fh->tell;
-        $fh->seek($valOffset,0);
-        $fh->read($self->{xRes},$valLen);
-        $fh->seek($here,0);
-        $self->{xRes}=[unpack($self->{rational},$self->{xRes})];
-        $self->{xRes}=($self->{xRes}->[0]/$self->{xRes}->[1]);
-      } elsif($valTag==283) {
-        # yRes
-        my $here=$fh->tell;
-        $fh->seek($valOffset,0);
-        $fh->read($self->{yRes},$valLen);
-        $fh->seek($here,0);
-        $self->{yRes}=[unpack($self->{rational},$self->{yRes})];
-        $self->{yRes}=($self->{yRes}->[0]/$self->{yRes}->[1]);
-      } elsif($valTag==296) {
-        # resolution Unit
-        $self->{resUnit}=$valOffset;
-      } elsif($valTag==273) {
-        # image data offset/strip offsets
-        if($valCount==1) {
-          $self->{imageOffset}=$valOffset;
-        } else {
-          my $here=$fh->tell;
-          my $val;
-          $fh->seek($valOffset,0);
-          $fh->read($val,$valLen);
-          $fh->seek($here,0);
-          $self->{imageOffset}=[ unpack($self->{long}.'*',$val) ];
-        }
-      } elsif($valTag==277) {
-        # samples per pixel
-        $self->{samplesPerPixel}=$valOffset;
-      } elsif($valTag==278) {
-        # RowsPerStrip
-        $self->{RowsPerStrip}=$valOffset;
-      } elsif($valTag==279) {
-        # image data length/strip lengths
-        if($valCount==1) {
-          $self->{imageLength}=$valOffset;
-        } else {
-          my $here=$fh->tell;
-          my $val;
-          $fh->seek($valOffset,0);
-          $fh->read($val,$valLen);
-          $fh->seek($here,0);
-          $self->{imageLength}=[ unpack($self->{long}.'*',$val) ];
-        }
-      } elsif($valTag==292) {
-        $self->{g3Options}=$valOffset;
-      } elsif($valTag==293) {
-        $self->{g4Options}=$valOffset;
-      } elsif($valTag==320) {
-        # color map
-        $self->{colorMapOffset}=$valOffset;
-        $self->{colorMapSamples}=$valCount;
-        $self->{colorMapLength}=$valCount*2; # shorts!
-      } elsif($valTag==317) {
-        # lzwPredictor
-        $self->{lzwPredictor}=$valOffset;
-      } elsif($valTag==0x800d) {
-        # imageID
-        my $here=$fh->tell;
-        $fh->seek($valOffset,0);
-        $fh->read($self->{imageId},$valLen);
-        $fh->seek($here,0);
-#      } elsif($valTag==) {
-#      } elsif($valTag==) {
-#      } elsif($valTag==) {
-#      } elsif($valTag==) {
-#      } else {
-#        print "tag=$valTag, type=$valType, len=$valLen\n";
-      }
-    }
-    $fh->read( $self->{ifd}, 4 );
-    $self->{ifd}=unpack($self->{long},$self->{ifd});
+
+  $self->{imageWidth}=$self->{object}->GetField(TIFFTAG_IMAGEWIDTH);
+  $self->{imageHeight}=$self->{object}->GetField(TIFFTAG_IMAGELENGTH);
+  $self->{bitsPerSample}=$self->{object}->GetField(TIFFTAG_BITSPERSAMPLE);
+  $self->{SamplesPerPixel}=$self->{object}->GetField(TIFFTAG_SAMPLESPERPIXEL);
+  $self->{ExtraSamples}=$self->{object}->GetField(TIFFTAG_EXTRASAMPLES);
+
+  $self->{filter}=$self->{object}->GetField(TIFFTAG_COMPRESSION);
+  if ($self->{filter}==COMPRESSION_NONE) {
+      delete $self->{filter};
+  }
+  elsif ($self->{filter}==COMPRESSION_CCITTFAX3 || $self->{filter}==COMPRESSION_CCITT_T4) {
+      $self->{filter}='CCITTFaxDecode';
+      $self->{ccitt}=$self->{filter};
+  }
+  elsif ($self->{filter}==COMPRESSION_LZW) {
+      $self->{filter}='LZWDecode';
+  }
+  elsif ($self->{filter}==COMPRESSION_OJPEG || $self->{filter}==COMPRESSION_JPEG) {
+      $self->{filter}='DCTDecode';
+  }
+  elsif ($self->{filter}==COMPRESSION_ADOBE_DEFLATE || $self->{filter}==COMPRESSION_DEFLATE) {
+      $self->{filter}='FlateDecode';
   }
+  elsif ($self->{filter}==COMPRESSION_PACKBITS) {
+      $self->{filter}='RunLengthDecode';
+  }
+  else {
+      die "unknown/unsupported TIFF compression method with id '$self->{filter}'.";
+  }
+
+  $self->{colorSpace}=$self->{object}->GetField(TIFFTAG_PHOTOMETRIC);
+  if ($self->{colorSpace}==PHOTOMETRIC_MINISWHITE) {
+      $self->{colorSpace}='DeviceGray';
+      $self->{whiteIsZero}=1;
+  }
+  elsif ($self->{colorSpace}==PHOTOMETRIC_MINISBLACK) {
+      $self->{colorSpace}='DeviceGray';
+      $self->{blackIsZero}=1;
+  }
+  elsif ($self->{colorSpace}==PHOTOMETRIC_RGB) {
+      $self->{colorSpace}='DeviceRGB';
+  }
+  elsif ($self->{colorSpace}==PHOTOMETRIC_PALETTE) {
+      $self->{colorSpace}='Indexed';
+  }
+  #  elsif($self->{colorSpace}==PHOTOMETRIC_MASK) {
+  #    $self->{colorSpace}='TransMask';
+  elsif ($self->{colorSpace}==PHOTOMETRIC_SEPARATED) {
+      $self->{colorSpace}='DeviceCMYK';
+  }
+  elsif ($self->{colorSpace}==PHOTOMETRIC_YCBCR) {
+      $self->{colorSpace}='DeviceRGB';
+  }
+  elsif($self->{colorSpace}==PHOTOMETRIC_CIELAB) {
+      $self->{colorSpace}='Lab';
+  }
+  else {
+      die "unknown/unsupported TIFF photometric interpretation with id '$self->{colorSpace}'.";
+  }
+
+  $self->{fillOrder}=$self->{object}->GetField(TIFFTAG_FILLORDER);
+  $self->{imageDescription}=$self->{object}->GetField(TIFFTAG_IMAGEDESCRIPTION);
+  $self->{xRes}=$self->{object}->GetField(TIFFTAG_XRESOLUTION);
+  $self->{yRes}=$self->{object}->GetField(TIFFTAG_YRESOLUTION);
+  $self->{resUnit}=$self->{object}->GetField(TIFFTAG_RESOLUTIONUNIT);
+  $self->{imageOffset}=$self->{object}->GetField(TIFFTAG_STRIPOFFSETS);
+  $self->{samplesPerPixel}=$self->{object}->GetField(TIFFTAG_SAMPLESPERPIXEL);
+  $self->{RowsPerStrip}=$self->{object}->GetField(TIFFTAG_ROWSPERSTRIP);
+  $self->{imageLength}=$self->{object}->GetField(TIFFTAG_STRIPBYTECOUNTS);
+  $self->{g3Options}=$self->{object}->GetField(TIFFTAG_GROUP3OPTIONS);
+  $self->{g4Options}=$self->{object}->GetField(TIFFTAG_GROUP4OPTIONS);
+
+  $self->{colorMapOffset}=$self->{object}->GetField(TIFFTAG_COLORMAP);
+  $self->{colorMapSamples}=$#{$self->{colorMapOffset}}+1;
+  $self->{colorMapLength}=$self->{colorMapSamples}*2; # shorts!
+
+  $self->{lzwPredictor}=$self->{object}->GetField(TIFFTAG_PREDICTOR);
+  $self->{imageId}=$self->{object}->GetField(TIFFTAG_OPIIMAGEID);
 }
 
 1;
diff --git a/t/tiff.t b/t/tiff.t
index 252e45b..86c8c4b 100644
--- a/t/tiff.t
+++ b/t/tiff.t
@@ -1,4 +1,4 @@
-use Test::More tests => 4;
+use Test::More tests => 7;
 
 use warnings;
 use strict;
@@ -29,3 +29,72 @@ $gfx->image($lzw_tiff, 72, 360, 216, 432);
 
 like($pdf->stringify(), qr/q 216 0 0 432 72 360 cm \S+ Do Q/,
      q{Add TIFF to PDF});
+
+##############################################################
+
+my $width = 568;
+my $height = 1000;
+$tiff = 'test.tif';
+my $pdfout = 'test.pdf';
+
+SKIP: {
+    skip "tiff2pdf doesn't deal with the alpha layer properly either in this case", 1;
+system(sprintf"convert -depth 1 -gravity center -pointsize 78 -size %dx%d caption:'Lorem ipsum etc etc' %s", $width, $height, $tiff);
+$pdf = PDF::API2->new(-file => $pdfout);
+my $page = $pdf->page;
+$page->mediabox( $width, $height );
+$gfx = $page->gfx;
+my $img = $pdf->image_tiff($tiff);
+$gfx->image( $img, 0, 0, $width, $height );
+$pdf->save;
+$pdf->end;
+
+my $example = `convert $pdfout -depth 1 -resize 1x1 txt:-`;
+my $expected = `convert $tiff -depth 1 -resize 1x1 txt:-`;
+
+is($example, $expected, 'alpha');
+}
+
+##############################################################
+
+SKIP: {
+    skip "files created with tiffcp -c g3 previously produced the 'message chunked ccitt g4 tif not supported'", 1;
+system(sprintf"convert -depth 1 -gravity center -pointsize 78 -size %dx%d caption:'Lorem ipsum etc etc' -background white -alpha off %s", $width, $height, $tiff);
+system("tiffcp -c g3 $tiff tmp.tif && mv tmp.tif $tiff");
+$pdf = PDF::API2->new(-file => $pdfout);
+my $page = $pdf->page;
+$page->mediabox( $width, $height );
+$gfx = $page->gfx;
+my $img = $pdf->image_tiff($tiff);
+$gfx->image( $img, 0, 0, $width, $height );
+$pdf->save;
+$pdf->end;
+
+my $example = `convert $pdfout -depth 1 -resize 1x1 txt:-`;
+my $expected = `convert $tiff -depth 1 -resize 1x1 txt:-`;
+
+is($example, $expected, 'g3 (not converted to flate)');
+}
+##############################################################
+
+system(sprintf"convert -depth 1 -gravity center -pointsize 78 -size %dx%d caption:'Lorem ipsum etc etc' -background white -alpha off %s", $width, $height, $tiff);
+system("tiffcp -c lzw $tiff tmp.tif && mv tmp.tif $tiff");
+$pdf = PDF::API2->new(-file => $pdfout);
+my $page = $pdf->page;
+$page->mediabox( $width, $height );
+$gfx = $page->gfx;
+my $img = $pdf->image_tiff($tiff);
+$gfx->image( $img, 0, 0, $width, $height );
+$pdf->save;
+$pdf->end;
+
+my $example = `convert $pdfout -depth 1 -colorspace gray -alpha off -resize 1x1 txt:-`;
+my $expected = `convert $tiff -depth 1 -resize 1x1 txt:-`;
+
+is($example, $expected, 'lzw (converted to flate)');
+
+##############################################################
+
+unlink $pdfout, $tiff;
+
+##############################################################
-- 
2.4.4

