Update. PDF::API2 supports incremental PDF modification only, raw file size can only grow, comparing "snapshots" is useless. Modified objects must be marked as such, so they'll be "slapped" after original %%EOF on save. That, mostly, is what patch does (plus a few more things), all "setter" methods should include $self->{' api'}->{'pdf'}->out_obj($self);, and/or similar line if parent/siblings are modified. I stopped patching half way, now I see your particular intent was to change bookmark titles, then patch title setter too, it'll work then. Note PDF::API2::Outline::outline always adds a new descendant to invocant; PDF::API2::outline is different.
Line added to "main" module API2.pm is lazy way to ensure objects are re-blessed, so that e.g. $pdf->outline->first->delete won't boom. Two lines commented-out in patch look harmless but useless to me: parent method never called as setter, deleting ' children' array achieves nothing. + See modified PDF content in OP, object number is skipped, it's just not tidy, I wonder if it always was this way. These latter comments are for maintainer (Steve?) if they are interested.
__________
(PDF::API2... patch and fix and patch again). Below there are patches for 2 files in distribution, and your modified test program which produces four PDF files with expected content I think. I'll add later to this node as to why your tests as designed make no sense and why it's only "demo" patch, I gave up patching further because out of time, only your immediate test files are fixed.
--- C:\berrybrew\strawberry-perl-5.32.1.1-64bit-PDL\perl\site\lib\PDF\
+API2.pm.backup Wed Dec 8 07:53:45 2021
+++ C:\berrybrew\strawberry-perl-5.32.1.1-64bit-PDL\perl\site\lib\PDF\
+API2.pm Sat Sep 3 13:36:58 2022
@@ -824,6 +824,7 @@
bless $obj, 'PDF::API2::Outlines';
$obj->{' api'} = $self;
weaken $obj->{' api'};
+ $obj->count();
}
else {
$obj = PDF::API2::Outlines->new($self);
--- C:\berrybrew\strawberry-perl-5.32.1.1-64bit-PDL\perl\site\lib\PDF\
+API2\Outline.pm.backup Wed Dec 8 07:53:45 2021
+++ C:\berrybrew\strawberry-perl-5.32.1.1-64bit-PDL\perl\site\lib\PDF\
+API2\Outline.pm Sat Sep 3 16:23:35 2022
@@ -90,25 +90,25 @@
if ($count) {
$self->{'Count'} = PDFNum($self->is_open() ? $count : -$count
+);
}
+ else {
+ delete $self->{'Count'}
+ }
return $count;
}
sub _load_children {
my $self = shift();
+ $self->{' children'} = [];
my $item = $self->{'First'};
- return unless $item;
- $item->realise();
- bless $item, __PACKAGE__;
-
- push @{$self->{' children'}}, $item;
- while ($item->next()) {
- $item = $item->next();
+
+ while ($item) {
$item->realise();
bless $item, __PACKAGE__;
+ $item->{' api'} = $self->{' api'};
push @{$self->{' children'}}, $item;
+ $item = $item->next()
}
- return $self;
}
=head3 first
@@ -121,8 +121,10 @@
sub first {
my $self = shift();
- if (defined $self->{' children'} and defined $self->{' children'}
+->[0]) {
- $self->{'First'} = $self->{' children'}->[0];
+ if (exists $self->{' children'}) {
+ $self->{'First'} = @{$self->{' children'}}
+ ? $self->{' children'}[0]
+ : undef
}
return $self->{'First'};
}
@@ -137,8 +139,10 @@
sub last {
my $self = shift();
- if (defined $self->{' children'} and defined $self->{' children'}
+->[-1]) {
- $self->{'Last'} = $self->{' children'}->[-1];
+ if (exists $self->{' children'}) {
+ $self->{'Last'} = @{$self->{' children'}}
+ ? $self->{' children'}[-1]
+ : undef
}
return $self->{'Last'};
}
@@ -154,7 +158,7 @@
sub parent {
my $self = shift();
- $self->{'Parent'} = shift() if defined $_[0];
+# $self->{'Parent'} = shift() if defined $_[0];
return $self->{'Parent'};
}
@@ -167,8 +171,11 @@
=cut
sub prev {
- my $self = shift();
- $self->{'Prev'} = shift() if defined $_[0];
+ my ($self, $other) = @_;
+ if ($other) {
+ $self->{'Prev'} = $other;
+ $self->{' api'}{'pdf'}->out_obj($self);
+ }
return $self->{'Prev'};
}
@@ -181,8 +188,11 @@
=cut
sub next {
- my $self = shift();
- $self->{'Next'} = shift() if defined $_[0];
+ my ($self, $other) = @_;
+ if ($other) {
+ $self->{'Next'} = $other;
+ $self->{' api'}{'pdf'}->out_obj($self);
+ }
return $self->{'Next'};
}
@@ -200,7 +210,9 @@
my $self = shift();
my $child = PDF::API2::Outline->new($self->{' api'}, $self);
- $self->{' children'} //= [];
+
+ $self->_load_children() unless exists $self->{' children'};
+
$child->prev($self->{' children'}->[-1]) if @{$self->{' children'
+}};
$self->{' children'}->[-1]->next($child) if @{$self->{' children'
+}};
push @{$self->{' children'}}, $child;
@@ -208,6 +220,7 @@
$self->{' api'}->{'pdf'}->new_obj($child);
}
+ $self->{' api'}->{'pdf'}->out_obj($self);
return $child;
}
@@ -268,6 +281,7 @@
$item = $item->next();
push @{$self->{' children'}}, $item;
}
+ $self->{' api'}->{'pdf'}->out_obj($self);
return $self;
}
@@ -291,7 +305,8 @@
my $siblings = $self->parent->{' children'};
@$siblings = grep { $_ ne $self } @$siblings;
- delete $self->parent->{' children'} unless $self->parent->has_chi
+ldren();
+# delete $self->parent->{' children'} unless $self->parent->has_ch
+ildren();
+ $self->{' api'}->{'pdf'}->out_obj($self->parent);
return;
}
############
#!/usr/bin/perl
use 5.032;
use warnings;
use strict;
use PDF::API2;
my ($stringy_bare_pdf, $stringy_outline_pdf);
BARE_PDF: {
my $pdf = PDF::API2->new(-compress => 0);
my $page1 = $pdf->page();
$pdf->save('bare.pdf');
}
OUTLINE: {
my $pdf = PDF::API2->new(-compress => 0);
my $page1 = $pdf->page();
my $outlines = $pdf->outlines();
my $outline = $outlines->outline();
$outline->title('Test Outline 1');
$outline->dest(1);
$stringy_outline_pdf = $pdf->to_string();
open my $fh, '>', 'outline.pdf' or die;
binmode $fh;
print $fh $stringy_outline_pdf;
close $fh;
}
DELETE_OUTLINE: {
my $pdf = PDF::API2->from_string($stringy_outline_pdf, -compress =
+> 0) or die $!;
my $root = $pdf->outlines();
my $outline = $root->first();
$outline->delete();
$pdf->save('outline_deleted.pdf');
}
MODIFY_OUTLINE: {
my $pdf = PDF::API2->from_string($stringy_outline_pdf, -compress =
+> 0) or die $!;
my $root = $pdf->outlines();
my $outline = $root->outline();
$outline->title('Test Outline 2');
$outline->dest(1);
$pdf->save('outline_modified.pdf');
}
| 