Bug#514380: libpdf-api2-perl: corrupts certain PNMs when embedding them
Jeff
jffry at posteo.net
Sat Jun 20 11:14:58 BST 2020
This patch fixes things for me, adapted from:
https://github.com/PhilterPaper/Perl-PDF-Builder/commit/0c38fe27a1641216bda30fecdb42af356035d23e
-------------- next part --------------
diff --git a/lib/PDF/API2/Content.pm b/lib/PDF/API2/Content.pm
index b82cc36..756b735 100644
--- a/lib/PDF/API2/Content.pm
+++ b/lib/PDF/API2/Content.pm
@@ -1246,6 +1246,8 @@ sub shade {
=item $content->image($image_object, $x, $y)
+=item $content->image($image_object)
+
# Example
my $image_object = $pdf->image_jpeg($my_image_file);
$content->image($image_object, 100, 200);
@@ -1267,6 +1269,8 @@ sub image {
my $self = shift;
my $img = shift;
my ($x,$y,$w,$h) = @_;
+ if (!defined $y) { $y = 0; }
+ if (!defined $x) { $x = 0; }
if (defined $img->{Metadata}) {
$self->metaStart('PPAM:PlacedImage',$img->{Metadata});
}
@@ -1295,7 +1299,10 @@ sub image {
=item $content->formimage($form_object, $x, $y)
+=item $content->formimage($form_object)
+
Places an XObject on the page in the specified location.
+The C<$x,$y> default is C<[0,0]>.
=cut
@@ -1303,6 +1310,8 @@ sub formimage {
my $self = shift;
my $img = shift;
my ($x,$y,$s) = @_;
+ if (!defined $y) { $y = 0; }
+ if (!defined $x) { $x = 0; }
$self->save;
if (!defined $s) {
$self->matrix(1,0,0,1,$x,$y);
diff --git a/lib/PDF/API2/Resource/XObject/Image/PNM.pm b/lib/PDF/API2/Resource/XObject/Image/PNM.pm
index a3b22e4..89e146f 100644
--- a/lib/PDF/API2/Resource/XObject/Image/PNM.pm
+++ b/lib/PDF/API2/Resource/XObject/Image/PNM.pm
@@ -145,6 +145,9 @@ sub read_pnm {
}
} else {
read($inf,$self->{' stream'},$info->{width}*$info->{height});
+
+ # part of file was already read into $buf but not otherwise used
+ $self->{' stream'} = $buf . $self->{' stream'};
}
$cs='DeviceGray';
} elsif($info->{type} == 6) {
-------------- next part --------------
A non-text attachment was scrubbed...
Name: signature.asc
Type: application/pgp-signature
Size: 833 bytes
Desc: OpenPGP digital signature
URL: <http://alioth-lists.debian.net/pipermail/pkg-perl-maintainers/attachments/20200620/99830e20/attachment-0001.sig>
More information about the pkg-perl-maintainers
mailing list