File Coverage

blib/lib/PDF/Builder.pm
Criterion Covered Total %
statement 869 1428 60.8
branch 350 854 40.9
condition 130 384 33.8
subroutine 85 128 66.4
pod 84 99 84.8
total 1518 2893 52.4


line stmt bran cond sub pod time code
1             package PDF::Builder;
2              
3 38     38   2301705 use strict;
  38         374  
  38         1064  
4 38     38   167 use warnings;
  38         66  
  38         2649  
5              
6             # $VERSION defined here so developers can run PDF::Builder from git.
7             # it should be automatically updated as part of the CPAN build.
8             our $VERSION = '3.024'; # VERSION
9             our $LAST_UPDATE = '3.024'; # manually update whenever code is changed
10              
11             # updated during CPAN build
12             my $GrTFversion = 19; # minimum version of Graphics::TIFF
13             my $HBShaperVer = 0.024; # minimum version of HarfBuzz::Shaper
14             my $LpngVersion = 0.57; # minimum version of Image::PNG::Libpng
15              
16 38     38   248 use Carp;
  38         66  
  38         2372  
17 38     38   20629 use Encode qw(:all);
  38         349634  
  38         9072  
18 38     38   16697 use English;
  38         116660  
  38         209  
19 38     38   29372 use FileHandle;
  38         318040  
  38         210  
20              
21 38     38   28297 use PDF::Builder::Basic::PDF::Utils;
  38         122  
  38         3089  
22 38     38   17406 use PDF::Builder::Util;
  38         127  
  38         5281  
23              
24 38     38   24701 use PDF::Builder::Basic::PDF::File;
  38         110  
  38         1540  
25 38     38   314 use PDF::Builder::Basic::PDF::Pages;
  38         74  
  38         726  
26 38     38   20417 use PDF::Builder::Page;
  38         118  
  38         1683  
27              
28 38     38   18438 use PDF::Builder::Resource::XObject::Form::Hybrid;
  38         118  
  38         1285  
29              
30 38     38   15830 use PDF::Builder::Resource::ExtGState;
  38         106  
  38         1218  
31 38     38   14666 use PDF::Builder::Resource::Pattern;
  38         100  
  38         1033  
32 38     38   13240 use PDF::Builder::Resource::Shading;
  38         91  
  38         1116  
33              
34 38     38   14715 use PDF::Builder::NamedDestination;
  38         98  
  38         1274  
35              
36 38     38   265 use List::Util qw(max);
  38         70  
  38         2054  
37 38     38   224 use Scalar::Util qw(weaken);
  38         80  
  38         611494  
38              
39             my @font_path = __PACKAGE__->set_font_path(
40             '/usr/share/fonts',
41             '/usr/local/share/fonts',
42             'C:/Windows/Fonts',
43             'C:/WinNT/Fonts'
44             );
45              
46             our @MSG_COUNT = (0, # [0] Graphics::TIFF not installed
47             0, # [1] Image::PNG::Libpng not installed
48             0, # [2] TBD...
49             );
50             our $outVer = 1.4; # desired PDF version for output, bump up w/ warning on read or feature output
51             our $msgVer = 1; # 0=don't, 1=do issue message when PDF output version is bumped up
52             our $myself; # holds self->pdf
53             our $global_pdf; # holds self ($pdf)
54              
55             =head1 NAME
56              
57             PDF::Builder - Facilitates the creation and modification of PDF files
58              
59             =head1 SYNOPSIS
60              
61             use PDF::Builder;
62              
63             # Create a blank PDF file
64             $pdf = PDF::Builder->new();
65              
66             # Open an existing PDF file
67             $pdf = PDF::Builder->open('some.pdf');
68              
69             # Add a blank page
70             $page = $pdf->page();
71              
72             # Retrieve an existing page
73             $page = $pdf->open_page($page_number);
74              
75             # Set the page size
76             $page->size('Letter'); # or mediabox('Letter')
77              
78             # Add a built-in font to the PDF
79             $font = $pdf->font('Helvetica-Bold'); # or corefont('Helvetica-Bold')
80              
81             # Add an external TrueType (TTF) font to the PDF
82             $font = $pdf->font('/path/to/font.ttf'); # or ttfont() in this case
83              
84             # Add some text to the page
85             $text = $page->text();
86             $text->font($font, 20);
87             $text->position(200, 700); # or translate()
88             $text->text('Hello World!');
89              
90             # Save the PDF
91             $pdf->saveas('/path/to/new.pdf');
92              
93             =head1 SOME SPECIAL NOTES
94              
95             See the file README.md (in downloadable package and on CPAN) for a summary of
96             prerequisites and tools needed to install PDF::Builder, both mandatory and
97             optional.
98              
99             =head2 SOFTWARE DEVELOPMENT KIT
100              
101             There are four levels of involvement with PDF::Builder. Depending on what you
102             want to do, different kinds of installs are recommended.
103             See L for suggestions.
104              
105             =head2 OPTIONAL LIBRARIES
106              
107             PDF::Builder can make use of some optional libraries, which are not I
108             for a successful installation, but improve speed and capabilities. See
109             L for more information.
110              
111             =head2 STRINGS (CHARACTER TEXT)
112              
113             There are some things you should know about character encoding (for text),
114             before you dive in to coding. Please go to L and have a read.
115              
116             =head2 RENDERING ORDER
117              
118             Invoking "text" and "graphics" methods can lead to unexpected results (a
119             different ordering of output than intended). See L for more information.
120              
121             =head2 PDF VERSIONS SUPPORTED
122              
123             PDF::Builder is mostly PDF 1.4-compliant, but there I complications you
124             should be aware of. Please read L
125             for details.
126              
127             =head2 SUPPORTED PERL VERSIONS (BACKWARDS COMPATIBILITY GOALS)
128              
129             PDF::Builder intends to support all major Perl versions that were released in
130             the past six years, plus one, in order to continue working for the life of
131             most long-term-stable (LTS) server distributions.
132             See the L table
133             B x.xxxx0 "Major" release dates.
134              
135             For example, a version of PDF::Builder released on 2018-06-05 would support
136             the last major version of Perl released I 2012-06-05 (5.18), and
137             then one before that, which would be 5.16. Alternatively, the last major
138             version of Perl released I 2012-06-05 is 5.16.
139              
140             The intent is to avoid expending unnecessary effort in supporting very old
141             (obsolete) versions of Perl.
142              
143             =head3 Anticipated Support Cutoff Dates
144              
145             =over
146              
147             =item * 5.24 current minimum supported version, until next PDF::Builder release after 30 May, 2023
148              
149             =item * 5.26 future minimum supported version, until next PDF::Builder release after 23 June, 2024
150              
151             =item * 5.28 future minimum supported version, until next PDF::Builder release after 22 May, 2025
152              
153             =item * 5.30 future minimum supported version, until next PDF::Builder release after 20 June, 2026
154              
155             =item * 5.32 future minimum supported version, until next PDF::Builder release after 20 May, 2027
156              
157             =item * 5.34 future minimum supported version, until next PDF::Builder release after 28 May, 2028
158              
159             =back
160              
161             If you need to use this module on a server with an extremely out-of-date version
162             of Perl, consider using either plenv or Perlbrew to run a newer version of Perl
163             without needing admin privileges.
164              
165             On the other hand, any feature in PDF::Builder should continue to work
166             unchanged for the life of most long-term-stable (LTS) server distributions.
167             Their lifetime is usually about six (6) years. Note that this does B
168             constitute a statement of warranty, but that we I to try to keep any
169             particular release of PDF::Builder working for a period of years. Of course,
170             it helps if you periodically update your Perl installation to something
171             released in the recent past.
172              
173             =head2 KNOWN ISSUES
174              
175             This module does not work with perl's -l command-line switch.
176              
177             There is a file INFO/KNOWN_INCOMP which lists known incompatibilities with
178             PDF::API2, in case you're thinking of porting over something from that world,
179             or have experience there and want to try PDF::Builder. There is also a file
180             INFO/DEPRECATED, which lists things which are planned to be removed at some
181             point.
182              
183             =head2 HISTORY
184              
185             The history of PDF::Builder is a complex and exciting saga... OK, it may be
186             mildly interesting. Have a look at L section.
187              
188             =head2 AUTHOR
189              
190             PDF::API2 was originally written by Alfred Reibenschuh. See the HISTORY section
191             for more information.
192              
193             It was maintained by Steve Simms, who is still contributing new code to it
194             (which often ends up in PDF::Builder).
195              
196             PDF::Builder is currently being maintained by Phil M. Perry.
197              
198             =head2 SUPPORT
199              
200             The full source is on https://github.com/PhilterPaper/Perl-PDF-Builder.
201              
202             The release distribution is on CPAN: https://metacpan.org/pod/PDF::Builder.
203              
204             Bug reports are on https://github.com/PhilterPaper/Perl-PDF-Builder/issues?q=is%3Aissue+sort%3Aupdated-desc
205             (with "bug" label), feature requests have an "enhancement" label, and general
206             discussions (architecture, roadmap, etc.) have a "general discussion" label.
207              
208             Do B under I circumstances open a PR (Pull Request) to report a bug.
209             It is a waste of both your and our time and effort. Open a regular ticket
210             (issue), and attach a Perl (.pl) program illustrating the problem, if possible.
211             If you believe that you have a program patch, and offer to share it as a PR, we
212             may give the go-ahead. Unsolicited PRs may be closed without further action.
213              
214             =head2 LICENSE
215              
216             This software is Copyright (c) 2017-2022 by Phil M. Perry.
217              
218             This is free software, licensed under:
219              
220             The GNU Lesser General Public License (LGPL) Version 2.1, February 1999
221              
222             (The master copy of this license lives on the GNU website.)
223             (A copy is provided in the INFO/LICENSE file for your convenience.)
224              
225             This section of Builder.pm is intended only as a very brief summary
226             of the license; please consider INFO/LICENSE to be the controlling version,
227             if there is any conflict or ambiguity between the two.
228              
229             This program is free software; you can redistribute it and/or modify it under
230             the terms of the GNU Lesser General Public License, as published by the Free
231             Software Foundation, either version 2.1 of the License, or (at your option) any
232             later version of this license.
233              
234             NOTE: there are several files in this distribution which were incorporated from
235             outside sources and carry different licenses. If a file states that it is under
236             a license different than LGPL 2.1, that license and its terms will apply to
237             that file, and not LGPL 2.1.
238              
239             This library is distributed in the hope that it will be useful, but WITHOUT ANY
240             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
241             PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.
242              
243             =head1 GENERAL PURPOSE METHODS
244              
245             =over
246              
247             =item $pdf = PDF::Builder->new(%opts)
248              
249             Creates a new PDF object.
250              
251             B
252              
253             =over
254              
255             =item file
256              
257             If you will be saving it as a file and
258             already know the filename, you can give the 'file' option to minimize
259             possible memory requirements later on (the file is opened immediately for
260             writing, rather than waiting until the C). The C may also be
261             a filehandle.
262              
263             =item compress
264              
265             The 'compress' option can be
266             given to specify stream compression: default is 'flate', 'none' (or 0) is no
267             compression. No other compression methods are currently supported.
268              
269             =item outver
270              
271             The 'outver' option defaults to 1.4 as the output PDF version and the highest
272             allowed feature version (attempts to use anything higher will give a warning).
273             If an existing PDF with a higher version is read in, C will be
274             increased to that version, with a warning.
275              
276             =item msgver
277              
278             The 'msgver' option value of 1 (default) gives a warning message if the
279             'outver' PDF level has to be bumped up due to either a higher PDF level file
280             being read in, or a higher level feature was requested. A value of 0
281             suppresses the warning message.
282              
283             =item diaglevel
284              
285             The 'diaglevel' option can be
286             given to specify the level of diagnostics given by IntegrityCheck(). The
287             default is level 2 (errors and warnings).
288             See L for more information.
289              
290             =back
291              
292             B
293              
294             $pdf = PDF::Builder->new();
295             ...
296             print $pdf->to_string();
297              
298             $pdf = PDF::Builder->new(compress => 'none');
299             # equivalent to $pdf->{'forcecompress'} = 'none'; (or older, 0)
300              
301             $pdf = PDF::Builder->new();
302             ...
303             $pdf->saveas('our/new.pdf');
304              
305             $pdf = PDF::Builder->new(file => 'our/new.pdf');
306             ...
307             $pdf->save();
308              
309             =cut
310              
311             sub new {
312 217     217 1 22087 my ($class, %opts) = @_;
313             # copy dashed option names to preferred undashed names
314 217 100 66     1376 if (defined $opts{'-compress'} && !defined $opts{'compress'}) { $opts{'compress'} = delete($opts{'-compress'}); }
  99         309  
315 217 50 33     771 if (defined $opts{'-diaglevel'} && !defined $opts{'diaglevel'}) { $opts{'diaglevel'} = delete($opts{'-diaglevel'}); }
  0         0  
316 217 100 66     824 if (defined $opts{'-outver'} && !defined $opts{'outver'}) { $opts{'outver'} = delete($opts{'-outver'}); }
  1         3  
317 217 50 33     645 if (defined $opts{'-msgver'} && !defined $opts{'msgver'}) { $opts{'msgver'} = delete($opts{'-msgver'}); }
  0         0  
318 217 50 33     702 if (defined $opts{'-file'} && !defined $opts{'file'}) { $opts{'file'} = delete($opts{'-file'}); }
  0         0  
319              
320 217         452 my $self = {};
321 217         434 bless $self, $class;
322 217         1755 $self->{'pdf'} = PDF::Builder::Basic::PDF::File->new();
323              
324             # make available to other routines
325 217         682 $myself = $self->{'pdf'};
326              
327             # default output version
328 217         693 $self->{'pdf'}->{' version'} = $outVer;
329 217         1405 $self->{'pages'} = PDF::Builder::Basic::PDF::Pages->new($self->{'pdf'});
330 217         922 $self->{'pages'}->proc_set(qw(PDF Text ImageB ImageC ImageI));
331 217   33     622 $self->{'pages'}->{'Resources'} ||= PDFDict();
332             $self->{'pdf'}->new_obj($self->{'pages'}->{'Resources'})
333 217 50       874 unless $self->{'pages'}->{'Resources'}->is_obj($self->{'pdf'});
334 217         562 $self->{'catalog'} = $self->{'pdf'}->{'Root'};
335 217         816 weaken $self->{'catalog'};
336 217         529 $self->{'fonts'} = {};
337 217         480 $self->{'pagestack'} = [];
338              
339 217         473 $self->{'pdf'}->{' userUnit'} = 1.0; # default global User Unit
340 217         811 $self->mediabox('letter'); # PDF defaults to US Letter 8.5in x 11in
341              
342 217 100       552 if (exists $opts{'compress'}) {
343 152         406 $self->{'forcecompress'} = $opts{'compress'};
344             # at this point, no validation of given value! none/flate (0/1).
345             # note that >0 is often used as equivalent to 'flate'
346             } else {
347 65         152 $self->{'forcecompress'} = 'flate';
348             # code should also allow integers 0 (= 'none') and >0 (= 'flate')
349             # for compatibility with old usage where forcecompress is directly set.
350             }
351 217 50       467 if (exists $opts{'diaglevel'}) {
352 0         0 my $diaglevel = $opts{'diaglevel'};
353 0 0 0     0 if ($diaglevel < 0 || $diaglevel > 5) {
354 0         0 print "diaglevel must be in range 0-5. using 2\n";
355 0         0 $diaglevel = 2;
356             }
357 0         0 $self->{'diaglevel'} = $diaglevel;
358             } else {
359 217         400 $self->{'diaglevel'} = 2; # default: errors and warnings
360             }
361              
362 217         930 $self->preferences(%opts);
363 217 100       550 if (defined $opts{'outver'}) {
364 1 50       4 if ($opts{'outver'} >= 1.4) {
365 1         3 $self->{'pdf'}->{' version'} = $opts{'outver'};
366             } else {
367 0         0 print STDERR "Invalid outver given, or less than 1.4. Ignored.\n";
368             }
369             }
370 217 100       476 if (defined $opts{'msgver'}) {
371 1 50 33     5 if ($opts{'msgver'} == 0 || $opts{'msgver'} == 1) {
372 1         9 $msgVer = $opts{'msgver'};
373             } else {
374 0         0 print STDERR "Invalid msgver given, not 0 or 1. Ignored.\n";
375             }
376             }
377 217 50       587 if ($opts{'file'}) {
378 0         0 $self->{'pdf'}->create_file($opts{'file'});
379 0         0 $self->{'partial_save'} = 1;
380             }
381             # used by info and infoMetaAttributes but not by their replacements
382 217         1093 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer
383             Title Subject Keywords)];
384              
385 217   50     429 my $version = eval { $PDF::Builder::VERSION } || '(Development Version)';
386             #$self->info('Producer' => "PDF::Builder $version [$^O]");
387 217         1320 $self->info('Producer' => "PDF::Builder $version [see ".
388             "https://github.com/PhilterPaper/Perl-PDF-Builder/blob/master/INFO/SUPPORT]");
389              
390 217         483 $global_pdf = $self;
391 217         1950 return $self;
392             } # end of new()
393              
394             =item $pdf->default_page_size($size); # Set
395              
396             =item @rectangle = $pdf->default_page_size() # Get
397              
398             Set the default physical size for pages in the PDF. If called without
399             arguments, return the coordinates of the rectangle describing the default
400             physical page size.
401              
402             This is essentially an alternate method of defining the C call,
403             and added for compatibility with PDF::API2.
404              
405             See L for possible values.
406              
407             =cut
408              
409             sub default_page_size {
410 1     1 1 2116 my $self = shift();
411              
412             # Set
413 1 50       5 if (@_) {
414 1         16 return $self->default_page_boundaries(media => @_);
415             }
416              
417             # Get
418 0         0 my $boundaries = $self->default_page_boundaries();
419 0         0 return @{$boundaries->{'media'}};
  0         0  
420             }
421              
422             =item $pdf->default_page_boundaries(%boundaries); # Set
423              
424             =item %boundaries = $pdf->default_page_boundaries(); # Get
425              
426             Set default prepress page boundaries for pages in the PDF. If called without
427             arguments, returns the coordinates of the rectangles describing each of the
428             supported page boundaries.
429              
430             See the equivalent C method in L for
431             details.
432              
433             =cut
434              
435             # Called by PDF::Builder::Page::boundaries via the default_page_* methods below
436             sub _bounding_box {
437 8     8   2145 my $self = shift();
438 8         11 my $type = shift();
439              
440             # Get
441 8 100       16 unless (scalar @_) {
442 4 50       9 unless ($self->{'pages'}->{$type}) {
443 0 0       0 return if $type eq 'MediaBox';
444              
445             # Use defaults per PDF 1.7 section 14.11.2 Page Boundaries
446 0 0       0 return $self->_bounding_box('MediaBox') if $type eq 'CropBox';
447 0         0 return $self->_bounding_box('CropBox');
448             }
449 4         12 return map { $_->val() } $self->{'pages'}->{$type}->elements();
  16         25  
450             }
451              
452             # Set
453 4         8 $self->{'pages'}->{$type} = PDFArray(map { PDFNum(float($_)) } @_);
  16         27  
454 4         8 return $self;
455             }
456              
457             sub default_page_boundaries {
458 3     3 1 4718 return PDF::Builder::Page::boundaries(@_);
459             }
460              
461             # Deprecated; use default_page_size or default_page_boundaries
462             # alternate implementations of media, crop, etc. boxes
463             #sub mediabox {
464             # my $self = shift();
465             # return $self->_bounding_box('MediaBox') unless @_;
466             # return $self->_bounding_box('MediaBox', page_size(@_));
467             #}
468              
469             # Deprecated; use default_page_boundaries
470             #sub cropbox {
471             # my $self = shift();
472             # return $self->_bounding_box('CropBox') unless @_;
473             # return $self->_bounding_box('CropBox', page_size(@_));
474             #}
475              
476             # Deprecated; use default_page_boundaries
477             #sub bleedbox {
478             # my $self = shift();
479             # return $self->_bounding_box('BleedBox') unless @_;
480             # return $self->_bounding_box('BleedBox', page_size(@_));
481             #}
482              
483             # Deprecated; use default_page_boundaries
484             #sub trimbox {
485             # my $self = shift();
486             # return $self->_bounding_box('TrimBox') unless @_;
487             # return $self->_bounding_box('TrimBox', page_size(@_));
488             #}
489              
490             # Deprecated; use default_page_boundaries
491             #sub artbox {
492             # my $self = shift();
493             # return $self->_bounding_box('ArtBox') unless @_;
494             # return $self->_bounding_box('ArtBox', page_size(@_));
495             #}
496              
497             =back
498              
499             =head1 INPUT/OUTPUT METHODS
500              
501             =over
502              
503             =item $pdf = PDF::Builder->open($pdf_file, %opts)
504              
505             Opens an existing PDF file. See C for options.
506              
507             B
508              
509             $pdf = PDF::Builder->open('our/old.pdf');
510             ...
511             $pdf->saveas('our/new.pdf');
512              
513             $pdf = PDF::Builder->open('our/to/be/updated.pdf');
514             ...
515             $pdf->update();
516              
517             =cut
518              
519             sub open { ## no critic
520 8     8 1 1677 my ($class, $file, %opts) = @_;
521 8 50       149 croak "File '$file' does not exist" unless -f $file;
522 8 50       98 croak "File '$file' is not readable" unless -r $file;
523              
524 8         20 my $content;
525 8         71 my $scalar_fh = FileHandle->new();
526 8 50   28   534 CORE::open($scalar_fh, '+<', \$content) or die "Can't begin scalar IO";
  28         252  
  28         57  
  28         225  
527 8         3417 binmode $scalar_fh, ':raw';
528              
529 8         40 my $disk_fh = FileHandle->new();
530 8 50       421 CORE::open($disk_fh, '<', $file) or die "Can't open $file for reading: $!";
531 8         47 binmode $disk_fh, ':raw';
532 8         55 $disk_fh->seek(0, 0);
533 8         92 my $data;
534 8         40 while (not $disk_fh->eof()) {
535 49         734 $disk_fh->read($data, 512);
536 49         304 $scalar_fh->print($data);
537             }
538             # check if final %%EOF lacks a carriage return on the end (add one)
539 8 50       126 if ($data =~ m/%%EOF$/) {
540             #print "open() says missing final EOF\n";
541 8         25 $scalar_fh->print("\n");
542             }
543 8         63 $disk_fh->close();
544 8         143 $scalar_fh->seek(0, 0);
545              
546 8         78 my $self = $class->from_string($content, %opts);
547 8         24 $self->{'pdf'}->{' fname'} = $file;
548              
549 8         78 return $self;
550             } # end of open()
551              
552             =item $pdf = PDF::Builder->from_string($pdf_string, %opts)
553              
554             Opens a PDF contained in a string. See C for other options.
555              
556             =over
557              
558             =item diags => 1
559              
560             Display warnings when non-conforming PDF structure is found, and fix up
561             where possible. See L for more information.
562              
563             =back
564              
565             B
566              
567             # Read a PDF into a string, for the purpose of demonstration
568             open $fh, 'our/old.pdf' or die $@;
569             undef $/; # Read the whole file at once
570             $pdf_string = <$fh>;
571              
572             $pdf = PDF::Builder->from_string($pdf_string);
573             ...
574             $pdf->saveas('our/new.pdf');
575              
576             B C
577              
578             C was formerly known as C (and even before that,
579             as C), and this older name is still
580             valid as an alternative to C. It is I that C
581             will be deprecated and then removed some time in the future, so it may be
582             advisable to use C in new work.
583              
584             =cut
585              
586 1     1 0 1139 sub open_scalar { return from_string(@_); } ## no critic
587 1     1 0 11 sub openScalar { return from_string(@_); } ## no critic
588              
589             sub from_string {
590 18     18 1 2059 my ($class, $content, %opts) = @_;
591             # copy dashed option names to preferred undashed names
592 18 50 33     78 if (defined $opts{'-diags'} && !defined $opts{'diags'}) { $opts{'diags'} = delete($opts{'-diags'}); }
  0         0  
593 18 50 33     65 if (defined $opts{'-compress'} && !defined $opts{'compress'}) { $opts{'compress'} = delete($opts{'-compress'}); }
  0         0  
594 18 50 33     56 if (defined $opts{'-diaglevel'} && !defined $opts{'diaglevel'}) { $opts{'diaglevel'} = delete($opts{'-diaglevel'}); }
  0         0  
595              
596 18         39 my $self = {};
597 18         36 bless $self, $class;
598 18         56 foreach my $parameter (keys %opts) {
599 3         11 $self->default($parameter, $opts{$parameter});
600             }
601              
602 18         65 $self->{'content_ref'} = \$content;
603 18         46 my $diaglevel = 2;
604 18 50       53 if (defined $self->{'diaglevel'}) { $diaglevel = $self->{'diaglevel'}; }
  0         0  
605 18 50 33     103 if ($diaglevel < 0 || $diaglevel > 5) { $diaglevel = 2; }
  0         0  
606 18         99 my $newVer = $self->IntegrityCheck($diaglevel, $content);
607             # if Version override defined in PDF, need to overwrite the %PDF-x.y
608             # statement with the new (if higher) value. it's too late to wait until
609             # after File->open, as it's already complained about some >1.4 features.
610 18 50       44 if (defined $newVer) {
611 0         0 my ($verStr, $currentVer, $pos);
612 0         0 $pos = index $content, "%PDF-";
613 0 0       0 if ($pos < 0) { die "no PDF version found in PDF input!\n"; }
  0         0  
614             # assume major and minor PDF version numbers max 2 digits each for now
615             # (are 1 or 2 and 0-7 at this writing)
616 0         0 $verStr = substr($content, $pos, 10);
617 0 0       0 if ($verStr =~ m#^%PDF-(\d+)\.(\d+)#) {
618 0         0 $currentVer = "$1.$2";
619             } else {
620 0         0 die "unable to get PDF input's version number.\n";
621             }
622 0 0       0 if ($newVer > $currentVer) {
623 0 0       0 if (length($newVer) > length($currentVer)) {
624 0         0 print STDERR "Unable to update 'content' version because override '$newVer' is longer ".
625             "than header version '$currentVer'.\nYou may receive warnings about features ".
626             "that bump up the PDF level.\n";
627             } else {
628 0 0       0 if (length($newVer) < length($currentVer)) {
629             # unlikely, but cover all the bases
630 0         0 $newVer = substr($newVer, 0, length($currentVer));
631             }
632 0         0 substr($content, $pos+5, length($newVer)) = $newVer;
633 0         0 $self->version($newVer);
634             }
635             }
636             }
637              
638 18         31 my $fh;
639 18 50       234 CORE::open($fh, '+<', \$content) or die "Can't begin scalar IO";
640              
641             # this would replace any existing self->pdf with a new one
642 18         488 $self->{'pdf'} = PDF::Builder::Basic::PDF::File->open($fh, 1, %opts);
643 18         75 $self->{'pdf'}->{'Root'}->realise();
644 18         62 $self->{'pages'} = $self->{'pdf'}->{'Root'}->{'Pages'}->realise();
645 18         72 weaken $self->{'pages'};
646              
647 18   50     57 $self->{'pdf'}->{' version'} ||= 1.4; # default minimum
648             # if version higher than desired output PDF level, give warning and
649             # bump up desired output PDF level
650 18         74 $self->verCheckInput($self->{'pdf'}->{' version'});
651              
652 18         61 my @pages = _proc_pages($self->{'pdf'}, $self->{'pages'});
653 18         69 $self->{'pagestack'} = [sort { $a->{' pnum'} <=> $b->{' pnum'} } @pages];
  3         14  
654 18         30 weaken $self->{'pagestack'}->[$_] for (0 .. scalar @{$self->{'pagestack'}});
  18         161  
655 18         55 $self->{'catalog'} = $self->{'pdf'}->{'Root'};
656 18         62 weaken $self->{'catalog'};
657 18         34 $self->{'opened_scalar'} = 1;
658 18 100       57 if (exists $opts{'compress'}) {
659 3         10 $self->{'forcecompress'} = $opts{'compress'};
660             # at this point, no validation of given value! none/flate (0/1).
661             # note that >0 is often used as equivalent to 'flate'
662             } else {
663 15         81 $self->{'forcecompress'} = 'flate';
664             # code should also allow integers 0 (= 'none') and >0 (= 'flate')
665             # for compatibility with old usage where forcecompress is directly set.
666             }
667 18 50       48 if (exists $opts{'diaglevel'}) {
668 0         0 $self->{'diaglevel'} = $opts{'diaglevel'};
669 0 0 0     0 if ($self->{'diaglevel'} < 0 || $self->{'diaglevel'} > 5) {
670 0         0 $self->{'diaglevel'} = 2;
671             }
672             } else {
673 18         58 $self->{'diaglevel'} = 2;
674             }
675 18         43 $self->{'fonts'} = {};
676 18         78 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title Subject Keywords)];
677              
678 18         120 return $self;
679             } # end of from_string()
680              
681             =item $string = $pdf->to_string()
682              
683             Return the document as a string and remove the object structure from memory.
684              
685             B Although the object C<$pdf> will still exist, it is no longer
686             usable for any purpose after invoking this method! You will receive error
687             messages about "can't call method new_obj on an undefined value".
688              
689             B
690              
691             $pdf = PDF::Builder->new();
692             ...
693             print $pdf->to_string();
694              
695             B C
696              
697             C was formerly known as C, and this older name is still
698             valid as an alternative to C. It is I that C
699             will be deprecated and then removed some time in the future, so it may be
700             advisable to use C in new work.
701              
702             =cut
703              
704             # Maintainer's note: The object is being destroyed because it contains
705             # circular references that would otherwise result in memory not being
706             # freed if the object merely goes out of scope. If possible, the
707             # circular references should be eliminated so that to_string doesn't
708             # need to be destructive. See t/circular-references.t.
709             #
710             # I've opted not to just require a separate call to release() because
711             # it would likely introduce memory leaks in many existing programs
712             # that use this module.
713             # - Steve S. (see bug RT 81530)
714              
715 0     0 0 0 sub stringify { return to_string(@_); } ## no critic
716              
717             sub to_string {
718 178     178 1 1474 my $self = shift();
719              
720 178         395 my $string = '';
721             # is only set to 1 (within from_string()), otherwise is undef
722 178 100       585 if ($self->{'opened_scalar'}) {
723 7         36 $self->{'pdf'}->append_file();
724 7         11 $string = ${$self->{'content_ref'}};
  7         42  
725             } else {
726 171         1256 my $fh = FileHandle->new();
727             # we should be writing to the STRING $str
728 171 50       10785 CORE::open($fh, '>', \$string) || die "Can't begin scalar IO";
729 171         19156 $self->{'pdf'}->out_file($fh);
730 171         782 $fh->close();
731             }
732              
733             # This can be eliminated once we're confident that circular references are
734             # no longer an issue. See t/circular-references.t
735 178         1931 $self->end();
736              
737 178         3597 return $string;
738             }
739              
740             =item $pdf->finishobjects(@objects)
741              
742             Force objects to be written to file if possible.
743              
744             B
745              
746             $pdf = PDF::Builder->new(file => 'our/new.pdf');
747             ...
748             $pdf->finishobjects($page, $gfx, $txt);
749             ...
750             $pdf->save();
751              
752             B this method is now considered obsolete, and may be deprecated. It
753             allows for objects to be written to disk in advance of finally
754             saving and closing the file. Otherwise, it's no different than just calling
755             C when all changes have been made. There's no memory advantage since
756             C doesn't remove objects from memory.
757              
758             =cut
759              
760             # obsolete, use save instead
761             #
762             # This method allows for objects to be written to disk in advance of finally
763             # saving and closing the file. Otherwise, it's no different than just calling
764             # save when all changes have been made. There's no memory advantage since
765             # ship_out doesn't remove objects from memory.
766             sub finishobjects {
767 0     0 1 0 my ($self, @objs) = @_;
768              
769 0 0       0 if ($self->{'opened_scalar'}) {
    0          
770 0         0 die "invalid method invocation: no file, use 'saveas' instead.";
771             } elsif ($self->{'partial_save'}) {
772 0         0 $self->{'pdf'}->ship_out(@objs);
773             } else {
774 0         0 die "invalid method invocation: no file, use 'saveas' instead.";
775             }
776              
777 0         0 return;
778             }
779              
780             sub _proc_pages {
781 18     18   46 my ($pdf, $object) = @_;
782              
783 18 50       59 if (defined $object->{'Resources'}) {
784 18         35 eval {
785 18         66 $object->{'Resources'}->realise();
786             };
787             }
788              
789 18         39 my @pages;
790 18   50     107 $pdf->{' apipagecount'} ||= 0;
791 18         67 foreach my $page ($object->{'Kids'}->elements()) {
792 20         68 $page->realise();
793 20 50       67 if ($page->{'Type'}->val() eq 'Pages') {
794 0         0 push @pages, _proc_pages($pdf, $page);
795             }
796             else {
797 20         38 $pdf->{' apipagecount'}++;
798 20         41 $page->{' pnum'} = $pdf->{' apipagecount'};
799 20 50       54 if (defined $page->{'Resources'}) {
800 20         32 eval {
801 20         59 $page->{'Resources'}->realise();
802             };
803             }
804 20         65 push @pages, $page;
805             }
806             }
807              
808 18         62 return @pages;
809             } # end of _proc_pages()
810              
811             =item $pdf->update()
812              
813             Saves a previously opened document.
814              
815             B
816              
817             $pdf = PDF::Builder->open('our/to/be/updated.pdf');
818             ...
819             $pdf->update();
820              
821             B it is considered better to simply C the file, rather than
822             calling C. They end up doing the same thing, anyway. This method
823             may be deprecated in the future.
824              
825             =cut
826              
827             # obsolete, use save instead
828             sub update {
829 0     0 1 0 my $self = shift();
830 0         0 $self->saveas($self->{'pdf'}->{' fname'});
831 0         0 return;
832             }
833              
834             =item $pdf->saveas($file)
835              
836             Save the document to $file and remove the object structure from memory.
837              
838             B Although the object C<$pdf> will still exist, it is no longer
839             usable for any purpose after invoking this method! You will receive error
840             messages about "can't call method new_obj on an undefined value".
841              
842             B
843              
844             $pdf = PDF::Builder->new();
845             ...
846             $pdf->saveas('our/new.pdf');
847              
848             =cut
849              
850             sub saveas {
851 1     1 1 8 my ($self, $file) = @_;
852              
853 1 50       4 if ($self->{'opened_scalar'}) {
    0          
854 1         4 $self->{'pdf'}->append_file();
855 1         2 my $fh;
856 1 50       89 CORE::open($fh, '>', $file) or die "Can't open $file for writing: $!";
857 1         8 binmode($fh, ':raw');
858 1         5 print $fh ${$self->{'content_ref'}};
  1         5  
859 1         120 CORE::close($fh);
860             } elsif ($self->{'partial_save'}) {
861 0         0 $self->{'pdf'}->close_file();
862             } else {
863 0         0 $self->{'pdf'}->out_file($file);
864             }
865              
866 1         7 $self->end();
867 1         4 return;
868             }
869              
870             =item $pdf->save()
871              
872             =item $pdf->save(filename)
873              
874             Save the document to an already-defined file (or filename) and
875             remove the object structure from memory.
876             Optionally, a new filename may be given.
877              
878             B Although the object C<$pdf> will still exist, it is no longer
879             usable for any purpose after invoking this method! You will receive error
880             messages about "can't call method new_obj on an undefined value".
881              
882             B
883              
884             $pdf = PDF::Builder->new(file => 'file_to_output');
885             ...
886             $pdf->save();
887              
888             B now that C can take a filename as an argument, it effectively
889             is interchangeable with C. This is strictly for compatibility with
890             recent changes to PDF::API2. Unlike PDF::API2, we are not deprecating
891             the C method, because in user interfaces, "save" normally means that
892             the current filename is known and is to be used, while "saveas" normally means
893             that (whether or not there is a current filename) a new filename is to be used.
894              
895             =cut
896              
897             sub save {
898 0     0 1 0 my ($self, $file) = @_;
899              
900 0 0       0 if (defined $file) {
901 0         0 return $self->saveas($file);
902             }
903              
904             # NOTE: the current PDF::API2 version is quite different, but this may be
905             # a consequence of merging save() and saveas(). Let's give this unchanged
906             # version a try.
907 0 0       0 if ($self->{'opened_scalar'}) {
    0          
908 0         0 die "Invalid method invocation: use 'saveas' instead of 'save'.";
909             } elsif ($self->{'partial_save'}) {
910 0         0 $self->{'pdf'}->close_file();
911             } else {
912 0         0 die "Invalid method invocation: use 'saveas' instead of 'save'.";
913             }
914              
915 0         0 $self->end();
916 0         0 return;
917             }
918              
919             =item $pdf->close();
920              
921             Close an open file (if relevant) and remove the object structure from memory.
922              
923             PDF::API2 contains circular references, so this call is necessary in
924             long-running processes to keep from running out of memory.
925              
926             This will be called automatically when you save or stringify a PDF.
927             You should only need to call it explicitly if you are reading PDF
928             files and not writing them.
929              
930             B C and C
931              
932             =cut
933              
934             =item $pdf->end()
935              
936             Remove the object structure from memory. PDF::Builder contains circular
937             references, so this call is necessary in long-running processes to
938             keep from running out of memory.
939              
940             This will be called automatically when you save or to_string a PDF.
941             You should only need to call it explicitly if you are reading PDF
942             files and not writing them.
943              
944             This (and I) are older and now deprecated names formerly used in
945             PDF::API2 and PDF::Builder. You should try to avoid having to explicitly
946             call them.
947              
948             =cut
949              
950             # Deprecated (renamed)
951 0     0 1 0 sub release { return $_[0]->close(); }
952 179     179 1 688 sub end { return $_[0]->close(); }
953              
954             sub close {
955 179     179 1 293 my $self = shift();
956 179 50       1100 $self->{'pdf'}->release() if defined $self->{'pdf'};
957              
958 179         760 foreach my $key (keys %$self) {
959 1453         2248 $self->{$key} = undef;
960 1453         1822 delete $self->{$key};
961             }
962              
963 179         452 return;
964             }
965              
966             =back
967              
968             =head2 METADATA METHODS
969              
970             =over
971              
972             =item $title = $pdf->title();
973              
974             =item $pdf = $pdf->title($title);
975              
976             Get/set/clear the document's title.
977              
978             =cut
979              
980             sub title {
981 0     0 1 0 my $self = shift();
982 0         0 return $self->info_metadata('Title', @_);
983             }
984              
985             =item $author = $pdf->author();
986              
987             =item $pdf = $pdf->author($author);
988              
989             Get/set/clear the name of the person who created the document.
990              
991             =cut
992              
993             sub author {
994 0     0 1 0 my $self = shift();
995 0         0 return $self->info_metadata('Author', @_);
996             }
997              
998             =item $subject = $pdf->subject();
999              
1000             =item $pdf = $pdf->subject($subject);
1001              
1002             Get/set/clear the subject of the document.
1003              
1004             =cut
1005              
1006             sub subject {
1007 0     0 1 0 my $self = shift();
1008 0         0 return $self->info_metadata('Subject', @_);
1009             }
1010              
1011             =item $keywords = $pdf->keywords();
1012              
1013             =item $pdf = $pdf->keywords($keywords);
1014              
1015             Get/set/clear a space-separated string of keywords associated with the document.
1016              
1017             =cut
1018              
1019             sub keywords {
1020 0     0 1 0 my $self = shift();
1021 0         0 return $self->info_metadata('Keywords', @_);
1022             }
1023              
1024             =item $creator = $pdf->creator();
1025              
1026             =item $pdf = $pdf->creator($creator);
1027              
1028             Get/set/clear the name of the product that created the document prior to its
1029             conversion to PDF.
1030              
1031             =cut
1032              
1033             sub creator {
1034 0     0 1 0 my $self = shift();
1035 0         0 return $self->info_metadata('Creator', @_);
1036             }
1037              
1038             =item $producer = $pdf->producer();
1039              
1040             =item $pdf = $pdf->producer($producer);
1041              
1042             Get/set/clear the name of the product that converted the original document to
1043             PDF.
1044              
1045             PDF::Builder fills in this field when creating a PDF.
1046              
1047             =cut
1048              
1049             sub producer {
1050 5     5 1 10 my $self = shift();
1051 5         14 return $self->info_metadata('Producer', @_);
1052             }
1053              
1054             =item $date = $pdf->created();
1055              
1056             =item $pdf = $pdf->created($date);
1057              
1058             Get/set/clear the document's creation date.
1059              
1060             The date format is C, where C is a static prefix
1061             identifying the string as a PDF date. The date may be truncated at any point
1062             after the year. C is one of C<+>, C<->, or C, with the following C
1063             representing an offset from UTC.
1064              
1065             When setting the date, C will be prepended automatically if omitted.
1066              
1067             =cut
1068              
1069             sub created {
1070 1     1 1 2 my $self = shift();
1071 1         4 return $self->info_metadata('CreationDate', @_);
1072             }
1073              
1074             =item $date = $pdf->modified();
1075              
1076             =item $pdf = $pdf->modified($date);
1077              
1078             Get/set/clear the document's modification date. The date format is as described
1079             in C above.
1080              
1081             =cut
1082              
1083             sub modified {
1084 0     0 1 0 my $self = shift();
1085 0         0 return $self->info_metadata('ModDate', @_);
1086             }
1087              
1088             sub _is_date {
1089 1     1   2 my $value = shift();
1090              
1091             # PDF 1.7 section 7.9.4 describes the required date format. Other than the
1092             # D: prefix and the year, all components are optional but must be present if
1093             # a later component is present. No provision is made in the specification
1094             # for leap seconds, etc.
1095 1 50       8 return unless $value =~ /^D:([0-9]{4}) # D:YYYY (required)
1096             (?:([01][0-9]) # Month (01-12)
1097             (?:([0123][0-9]) # Day (01-31)
1098             (?:([012][0-9]) # Hour (00-23)
1099             (?:([012345][0-9]) # Minute (00-59)
1100             (?:([012345][0-9]) # Second (00-59)
1101             (?:([Z+-]) # UT Offset Direction
1102             (?:([012][0-9]) # UT Offset Hours
1103             (?:\'([012345][0-9]) # UT Offset Minutes
1104             )?)?)?)?)?)?)?)?$/x;
1105 1         9 my ($year, $month, $day, $hour, $minute, $second, $od, $oh, $om)
1106             = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
1107              
1108             # Do some basic validation to catch accidental date formatting issues.
1109             # Complete date validation is out of scope.
1110 1 50       3 if (defined $month) {
1111 1 50 33     6 return unless $month >= 1 and $month <= 12;
1112             }
1113 1 50       3 if (defined $day) {
1114 1 50 33     6 return unless $day >= 1 and $day <= 31;
1115             }
1116 1 50       3 if (defined $hour) {
1117 1 50       3 return unless $hour <= 23;
1118             }
1119 1 50       3 if (defined $minute) {
1120 1 50       3 return unless $minute <= 59;
1121             }
1122 1 50       3 if (defined $second) {
1123 1 50       2 return unless $second <= 59;
1124             }
1125 1 50       3 if (defined $od) {
1126 1 50 33     6 return if $od eq 'Z' and defined($oh);
1127             }
1128 1 50       4 if (defined $oh) {
1129 0 0       0 return unless $oh <= 23;
1130             }
1131 1 50       2 if (defined $om) {
1132 0 0       0 return unless $om <= 59;
1133             }
1134              
1135 1         3 return 1;
1136             }
1137              
1138             =item %info = $pdf->info_metadata(); # Get all keys and values
1139              
1140             =item $value = $pdf->info_metadata($key); # Get the value of one key
1141              
1142             =item $pdf = $pdf->info_metadata($key, $value); # Set the value of one key
1143              
1144             Get/set/clear a key in the document's information dictionary. The standard keys
1145             (title, author, etc.) have their own accessors, so this is primarily intended
1146             for interacting with custom metadata.
1147              
1148             Pass C as the value in order to remove the key from the dictionary.
1149              
1150             =cut
1151              
1152             sub info_metadata {
1153 6     6 1 8 my $self = shift();
1154 6         7 my $field = shift();
1155              
1156             # Return a hash of the Info table if called without arguments
1157 6 50       11 unless (defined $field) {
1158 0 0       0 return unless exists $self->{'pdf'}->{'Info'};
1159 0         0 $self->{'pdf'}->{'Info'}->realise();
1160 0         0 my %info;
1161 0         0 foreach my $key (keys %{$self->{'pdf'}->{'Info'}}) {
  0         0  
1162 0 0       0 next if $key =~ /^ /;
1163 0 0       0 next unless defined $self->{'pdf'}->{'Info'}->{$key};
1164 0         0 $info{$key} = $self->{'pdf'}->{'Info'}->{$key}->val();
1165             }
1166 0         0 return %info;
1167             }
1168              
1169             # Set
1170 6 100       15 if (@_) {
1171 3         4 my $value = shift();
1172 3 50 66     13 $value = undef if defined($value) and not length($value);
1173              
1174 3 100 66     12 if ($field eq 'CreationDate' or $field eq 'ModDate') {
1175 1 50       4 if (defined ($value)) {
1176 1 50       6 $value = 'D:' . $value unless $value =~ /^D:/;
1177 1 50       4 croak "Invalid date string: $value" unless _is_date($value);
1178             }
1179             }
1180              
1181 3 50       8 unless (exists $self->{'pdf'}->{'Info'}) {
1182 0 0       0 return $self unless defined $value;
1183 0         0 $self->{'pdf'}->{'Info'} = PDFDict();
1184 0         0 $self->{'pdf'}->new_obj($self->{'pdf'}->{'Info'});
1185             }
1186             else {
1187 3         10 $self->{'pdf'}->{'Info'}->realise();
1188             }
1189              
1190 3 100       7 if (defined $value) {
1191 2         6 $self->{'pdf'}->{'Info'}->{$field} = PDFStr($value);
1192             }
1193             else {
1194 1         4 delete $self->{'pdf'}->{'Info'}->{$field};
1195             }
1196              
1197 3         7 return $self;
1198             }
1199              
1200             # Get
1201 3 50       7 return unless $self->{'pdf'}->{'Info'};
1202 3         8 $self->{'pdf'}->{'Info'}->realise();
1203 3 100       10 return unless $self->{'pdf'}->{'Info'}->{$field};
1204 2         14 return $self->{'pdf'}->{'Info'}->{$field}->val();
1205             }
1206              
1207             =item %infohash = $pdf->info()
1208              
1209             =item %infohash = $pdf->info(%infohash)
1210              
1211             Gets/sets the info structure of the document.
1212              
1213             See L section for an example of the use
1214             of this method.
1215              
1216             B this method is still available, for compatibility purposes. It is
1217             better to use individual accessors or C instead.
1218              
1219             =cut
1220              
1221             sub info {
1222 220     220 1 747 my ($self, %opt) = @_;
1223              
1224 220 100       960 if (not defined($self->{'pdf'}->{'Info'})) {
1225 217         585 $self->{'pdf'}->{'Info'} = PDFDict();
1226 217         751 $self->{'pdf'}->new_obj($self->{'pdf'}->{'Info'});
1227             } else {
1228 3         7 $self->{'pdf'}->{'Info'}->realise();
1229             }
1230              
1231             # Maintenance Note: Since we're not shifting at the beginning of
1232             # this sub, this "if" will always be true
1233 220 50       886 if (scalar @_) {
1234 220         331 foreach my $k (@{$self->{'infoMeta'}}) {
  220         528  
1235 1760 100       2974 next unless defined $opt{$k};
1236 218   50     894 $self->{'pdf'}->{'Info'}->{$k} = PDFString($opt{$k} || 'NONE', 'm');
1237             }
1238 220         622 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Info'});
1239             }
1240              
1241 220 50       609 if (defined $self->{'pdf'}->{'Info'}) {
1242 220         508 %opt = ();
1243 220         310 foreach my $k (@{$self->{'infoMeta'}}) {
  220         584  
1244 1760 100       3060 next unless defined $self->{'pdf'}->{'Info'}->{$k};
1245 220         620 $opt{$k} = $self->{'pdf'}->{'Info'}->{$k}->val();
1246 220 50 33     1800 if ((unpack('n', $opt{$k}) == 0xfffe) or (unpack('n', $opt{$k}) == 0xfeff)) {
1247 0         0 $opt{$k} = decode('UTF-16', $self->{'pdf'}->{'Info'}->{$k}->val());
1248             }
1249             }
1250             }
1251              
1252 220         436 return %opt;
1253             } # end of info()
1254              
1255             =item @metadata_attributes = $pdf->infoMetaAttributes()
1256              
1257             =item @metadata_attributes = $pdf->infoMetaAttributes(@metadata_attributes)
1258              
1259             Gets/sets the supported info-structure tags.
1260              
1261             B
1262              
1263             @attributes = $pdf->infoMetaAttributes;
1264             print "Supported Attributes: @attr\n";
1265              
1266             @attributes = $pdf->infoMetaAttributes('CustomField1');
1267             print "Supported Attributes: @attributes\n";
1268              
1269             B this method is still available for compatibility purposes, but the
1270             use of C instead is encouraged.
1271              
1272             =cut
1273              
1274             sub infoMetaAttributes {
1275 0     0 1 0 my ($self, @attr) = @_;
1276              
1277 0 0       0 if (scalar @attr) {
1278 0         0 my %at = map { $_ => 1 } @{$self->{'infoMeta'}}, @attr;
  0         0  
  0         0  
1279 0         0 @{$self->{'infoMeta'}} = keys %at;
  0         0  
1280             }
1281              
1282 0         0 return @{$self->{'infoMeta'}};
  0         0  
1283             }
1284              
1285             =item $xml = $pdf->xml_metadata();
1286              
1287             =item $pdf = $pdf->xml_metadata($xml);
1288              
1289             Gets/sets the document's XML metadata stream.
1290              
1291             =cut
1292              
1293             sub xml_metadata {
1294 0     0 1 0 my ($self, $value) = @_;
1295              
1296 0 0       0 if (not defined($self->{'catalog'}->{'Metadata'})) {
1297 0         0 $self->{'catalog'}->{'Metadata'} = PDFDict();
1298 0         0 $self->{'catalog'}->{'Metadata'}->{'Type'} = PDFName('Metadata');
1299 0         0 $self->{'catalog'}->{'Metadata'}->{'Subtype'} = PDFName('XML');
1300 0         0 $self->{'pdf'}->new_obj($self->{'catalog'}->{'Metadata'});
1301             }
1302             else {
1303 0         0 $self->{'catalog'}->{'Metadata'}->realise();
1304 0         0 $self->{'catalog'}->{'Metadata'}->{' stream'} = unfilter($self->{'catalog'}->{'Metadata'}->{'Filter'}, $self->{'catalog'}->{'Metadata'}->{' stream'});
1305 0         0 delete $self->{'catalog'}->{'Metadata'}->{' nofilt'};
1306 0         0 delete $self->{'catalog'}->{'Metadata'}->{'Filter'};
1307             }
1308              
1309 0         0 my $md = $self->{'catalog'}->{'Metadata'};
1310              
1311 0 0       0 if (defined $value) {
1312 0         0 $md->{' stream'} = $value;
1313 0         0 delete $md->{'Filter'};
1314 0         0 delete $md->{' nofilt'};
1315 0         0 $self->{'pdf'}->out_obj($md);
1316 0         0 $self->{'pdf'}->out_obj($self->{'catalog'});
1317             }
1318              
1319 0         0 return $md->{' stream'};
1320             }
1321              
1322             =item $xml = $pdf->xmpMetadata() # Get
1323              
1324             =item $xml = $pdf->xmpMetadata($xml) # Set (also returns $xml value)
1325              
1326             Gets/sets the XMP XML data stream.
1327              
1328             See L section for an example of the use
1329             of this method.
1330              
1331             This method is considered B. Use C instead.
1332              
1333             =cut
1334              
1335             sub xmpMetadata {
1336 0     0 1 0 my ($self, $value) = @_;
1337              
1338 0 0       0 if (@_) { # Set
1339 0         0 my $value = shift();
1340 0         0 $self->xml_metadata($value);
1341 0         0 return $value;
1342             }
1343              
1344             # Get
1345 0         0 return $self->xml_metadata();
1346             }
1347              
1348             =item $val = $pdf->default($parameter)
1349              
1350             =item $pdf->default($parameter, $value)
1351              
1352             Gets/sets the default value for a behavior of PDF::Builder.
1353              
1354             B
1355              
1356             =over
1357              
1358             =item nounrotate
1359              
1360             prohibits Builder from rotating imported/opened page to re-create a
1361             default pdf-context.
1362              
1363             =item pageencaps
1364              
1365             enables Builder's adding save/restore commands upon importing/opening
1366             pages to preserve graphics-state for modification.
1367              
1368             =item copyannots
1369              
1370             enables importing of annotations (B<*EXPERIMENTAL*>).
1371              
1372             =back
1373              
1374             B Perl::Critic (tools/1_pc.pl) has started flagging the name
1375             "default" as a reserved keyword in higher Perl versions. Use with caution, and
1376             be aware that this name I have to be changed in the future.
1377              
1378             =cut
1379              
1380             sub default {
1381 11     11 1 22 my ($self, $parameter, $value) = @_;
1382              
1383             # Parameter names may consist of lowercase letters, numbers, and underscores
1384 11         23 $parameter = lc $parameter;
1385 11         33 $parameter =~ s/[^a-z\d_]//g;
1386              
1387 11         23 my $previous_value = $self->{$parameter};
1388 11 100       23 if (defined $value) {
1389 3         7 $self->{$parameter} = $value;
1390             }
1391              
1392 11         26 return $previous_value;
1393             }
1394              
1395             =item $version = $pdf->version() # Get
1396              
1397             =item $version = $pdf->version($version) # Set (also returns newly set version)
1398              
1399             Gets/sets the PDF version (e.g., 1.5).
1400             For compatibility with earlier releases, if no decimal point is given, assume
1401             "1." precedes the number given.
1402              
1403             A warning message is given if you attempt to I the PDF version, as you
1404             might have already read in a higher level file, or used a higher level feature.
1405              
1406             See L for additional information on the
1407             C method.
1408              
1409             =cut
1410              
1411             sub version {
1412 27     27 1 61 my $self = shift(); # includes any %opts
1413              
1414 27         121 return $self->{'pdf'}->version(@_); # just pass it over to the "real" one
1415             }
1416              
1417             # when outputting a PDF feature, verCheckOutput(n, 'feature name') returns TRUE
1418             # if n > $pdf->{' version'), plus a warning message. It returns FALSE otherwise.
1419             #
1420             # a typical use:
1421             #
1422             # $PDF::Builder::global_pdf->verCheckOutput(1.6, "portzebie with foo-dangle");
1423             #
1424             # if msgver defaults to 1, a message will be output if the output PDF version
1425             # has to be increased to 1.6 in order to use the "portzebie" feature
1426             #
1427             # this is still somewhat experimental, and as experience is gained, the code
1428             # might have to be modified.
1429             #
1430             sub verCheckOutput {
1431 3     3 0 12 my ($self, $PDFver, $featureName) = @_;
1432              
1433             # check if feature required PDF version is higher than planned output
1434 3         10 my $version = $self->version(); # current version
1435 3 100       11 if ($PDFver > $version) {
1436 1 50       3 if ($msgVer) {
1437 0         0 print "PDF version of requested feature '$featureName' is higher\n". " than current output version $version ".
1438             "(version reset to $PDFver)\n";
1439             }
1440 1         3 $self->version($PDFver);
1441 1         2 return 1;
1442             } else {
1443 2         4 return 0;
1444             }
1445             }
1446              
1447             # when reading in a PDF, verCheckInput(n) gives a warning message if n (the PDF
1448             # version just read in) > version, and resets version to n. return TRUE if
1449             # version changed, FALSE otherwise.
1450             #
1451             # this is still somewhat experimental, and as experience is gained, the code
1452             # might have to be modified.
1453             #
1454             # WARNING: just because the PDF output version has been increased does NOT
1455             # guarantee that any particular content will be handled correctly! There are
1456             # many known cases of PDF 1.5 and up files being read in, that have content
1457             # that PDF::Builder does not handle correctly, corrupting the resulting PDF.
1458             # Pay attention to run-time warning messages that the PDF output level has
1459             # been increased due to a PDF file being read in, and check the resulting
1460             # file carefully.
1461              
1462             sub verCheckInput {
1463 18     18 0 45 my ($self, $PDFver) = @_;
1464              
1465 18         103 my $version = $self->version();
1466             # warning message and bump up version if read-in PDF level higher
1467 18 50       66 if ($PDFver > $version) {
1468 0 0       0 if ($msgVer) {
1469 0         0 print "PDF version just read in is higher than version of $version (version reset to $PDFver)\n";
1470             }
1471 0         0 $self->version($PDFver);
1472 0         0 return 1;
1473             } else {
1474 18         37 return 0;
1475             }
1476             }
1477              
1478             =item $bool = $pdf->is_encrypted()
1479              
1480             Checks if the previously opened PDF is encrypted.
1481              
1482             B C
1483              
1484             This is the older name; it is kept for compatibility with PDF::API2.
1485              
1486             =cut
1487              
1488 0     0 0 0 sub isEncrypted { return is_encrypted(@_); } ## no critic
1489              
1490             sub is_encrypted {
1491 0     0 1 0 my $self = shift();
1492 0 0       0 return defined($self->{'pdf'}->{'Encrypt'}) ? 1 : 0;
1493             }
1494              
1495             =back
1496              
1497             =head1 INTERACTIVE FEATURE METHODS
1498              
1499             =over
1500              
1501             =item $otls = $pdf->outline()
1502              
1503             Creates (if needed) and returns the document's 'outline' tree, which is also
1504             known as its 'bookmarks' or the 'table of contents', depending on the
1505             PDF reader being used.
1506              
1507             To examine or modify the outline tree, see L.
1508              
1509             B C
1510              
1511             This is the older name; it is kept for compatibility.
1512              
1513             =cut
1514              
1515 4     4 1 18 sub outlines { return outline(@_); } ## no critic
1516              
1517             sub outline {
1518 4     4 1 6 my $self = shift();
1519              
1520 4         424 require PDF::Builder::Outlines;
1521 4         14 my $obj = $self->{'pdf'}->{'Root'}->{'Outlines'};
1522 4 100       9 if ($obj) {
1523 1         3 $obj->realise();
1524 1         4 bless $obj, 'PDF::Builder::Outlines';
1525 1         2 $obj->{' api'} = $self;
1526 1         4 weaken $obj->{' api'};
1527             } else {
1528 3         13 $obj = PDF::Builder::Outlines->new($self);
1529              
1530 3         10 $self->{'pdf'}->{'Root'}->{'Outlines'} = $obj;
1531 3 50       12 $self->{'pdf'}->new_obj($obj) unless $obj->is_obj($self->{'pdf'});
1532 3         13 $self->{'pdf'}->out_obj($obj);
1533 3         8 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Root'});
1534             }
1535 4         17 return $obj;
1536             }
1537              
1538             =item $pdf = $pdf->open_action($page, $location, @args);
1539              
1540             Set the destination in the PDF that should be displayed when the document is
1541             opened.
1542              
1543             C<$page> may be either a page number or a page object. The other parameters are
1544             as described in L.
1545              
1546             This has been split out from C for compatibility with PDF::API2.
1547             It also can both set (assign) and get (query) the settings used.
1548              
1549             =cut
1550              
1551             sub open_action {
1552 0     0 1 0 my ($self, $page, @args) = @_;
1553              
1554             # $page can be either a page number or a page object
1555 0 0       0 $page = PDFNum($page) unless ref($page);
1556              
1557 0         0 require PDF::Builder::NamedDestination;
1558 0         0 my $array = PDF::Builder::NamedDestination::_destination($page, @args);
1559 0         0 $self->{'catalog'}->{'OpenAction'} = $array;
1560 0         0 $self->{'pdf'}->out_obj($self->{'catalog'});
1561 0         0 return $self;
1562             }
1563              
1564             =item $layout = $pdf->page_layout();
1565              
1566             =item $pdf = $pdf->page_layout($layout);
1567              
1568             Gets/sets the page layout that should be used when the PDF is opened.
1569              
1570             C<$layout> is one of the following:
1571              
1572             =over
1573              
1574             =item single_page (or undef)
1575              
1576             Display one page at a time.
1577              
1578             =item one_column
1579              
1580             Display the pages in one column (a.k.a. continuous).
1581              
1582             =item two_column_left
1583              
1584             Display the pages in two columns, with odd-numbered pages on the left.
1585              
1586             =item two_column_right
1587              
1588             Display the pages in two columns, with odd-numbered pages on the right.
1589              
1590             =item two_page_left
1591              
1592             Display two pages at a time, with odd-numbered pages on the left.
1593              
1594             =item two_page_right
1595              
1596             Display two pages at a time, with odd-numbered pages on the right.
1597              
1598             =back
1599              
1600             This has been split out from C for compatibility with PDF::API2.
1601             It also can both set (assign) and get (query) the settings used.
1602              
1603             =cut
1604              
1605             sub page_layout {
1606 0     0 1 0 my $self = shift();
1607              
1608 0 0       0 unless (@_) {
1609 0 0       0 return 'single_page' unless $self->{'catalog'}->{'PageLayout'};
1610 0         0 my $layout = $self->{'catalog'}->{'PageLayout'}->val();
1611 0 0       0 return 'single_page' if $layout eq 'SinglePage';
1612 0 0       0 return 'one_column' if $layout eq 'OneColumn';
1613 0 0       0 return 'two_column_left' if $layout eq 'TwoColumnLeft';
1614 0 0       0 return 'two_column_right' if $layout eq 'TwoColumnRight';
1615 0 0       0 return 'two_page_left' if $layout eq 'TwoPageLeft';
1616 0 0       0 return 'two_page_right' if $layout eq 'TwoPageRight';
1617 0         0 warn "Unknown page layout: $layout";
1618 0         0 return $layout;
1619             }
1620              
1621 0   0     0 my $name = shift() // 'single_page';
1622 0 0       0 my $layout = ($name eq 'single_page' ? 'SinglePage' :
    0          
    0          
    0          
    0          
    0          
1623             $name eq 'one_column' ? 'OneColumn' :
1624             $name eq 'two_column_left' ? 'TwoColumnLeft' :
1625             $name eq 'two_column_right' ? 'TwoColumnRight' :
1626             $name eq 'two_page_left' ? 'TwoPageLeft' :
1627             $name eq 'two_page_right' ? 'TwoPageRight' : '');
1628              
1629 0 0       0 croak "Invalid page layout: $name" unless $layout;
1630 0         0 $self->{'catalog'}->{'PageMode'} = PDFName($layout);
1631 0         0 $self->{'pdf'}->out_obj($self->{'catalog'});
1632 0         0 return $self;
1633             }
1634              
1635             =item $mode = $pdf->page_mode(); # Get
1636              
1637             =item $pdf = $pdf->page_mode($mode); # Set
1638              
1639             Gets/sets the page mode, which describes how the PDF should be displayed when
1640             opened.
1641              
1642             C<$mode> is one of the following:
1643              
1644             =over
1645              
1646             =item none (or undef)
1647              
1648             Neither outlines nor thumbnails should be displayed.
1649              
1650             =item outlines
1651              
1652             Show the document outline.
1653              
1654             =item thumbnails
1655              
1656             Show the page thumbnails.
1657              
1658             =item full_screen
1659              
1660             Open in full-screen mode, with no menu bar, window controls, or any other window
1661             visible.
1662              
1663             =item optional_content
1664              
1665             Show the optional content group panel.
1666              
1667             =item attachments
1668              
1669             Show the attachments panel.
1670              
1671             =back
1672              
1673             This has been split out from C for compatibility with PDF::API2.
1674             It also can both set (assign) and get (query) the settings used.
1675              
1676             =cut
1677              
1678             sub page_mode {
1679 0     0 1 0 my $self = shift();
1680              
1681 0 0       0 unless (@_) {
1682 0 0       0 return 'none' unless $self->{'catalog'}->{'PageMode'};
1683 0         0 my $mode = $self->{'catalog'}->{'PageMode'}->val();
1684 0 0       0 return 'none' if $mode eq 'UseNone';
1685 0 0       0 return 'outlines' if $mode eq 'UseOutlines';
1686 0 0       0 return 'thumbnails' if $mode eq 'UseThumbs';
1687 0 0       0 return 'full_screen' if $mode eq 'FullScreen';
1688 0 0       0 return 'optional_content' if $mode eq 'UseOC';
1689 0 0       0 return 'attachments' if $mode eq 'UseAttachments';
1690 0         0 warn "Unknown page mode: $mode";
1691 0         0 return $mode;
1692             }
1693              
1694 0   0     0 my $name = shift() // 'none';
1695 0 0       0 my $mode = ($name eq 'none' ? 'UseNone' :
    0          
    0          
    0          
    0          
    0          
1696             $name eq 'outlines' ? 'UseOutlines' :
1697             $name eq 'thumbnails' ? 'UseThumbs' :
1698             $name eq 'full_screen' ? 'FullScreen' :
1699             $name eq 'optional_content' ? 'UseOC' :
1700             $name eq 'attachments' ? 'UseAttachments' : '');
1701              
1702 0 0       0 croak "Invalid page mode: $name" unless $mode;
1703 0         0 $self->{'catalog'}->{'PageMode'} = PDFName($mode);
1704 0         0 $self->{'pdf'}->out_obj($self->{'catalog'});
1705 0         0 return $self;
1706             }
1707              
1708             =item %preferences = $pdf->viewer_preferences(); # Get
1709              
1710             =item $pdf = $pdf->viewer_preferences(%preferences); # Set
1711              
1712             Gets/sets PDF viewer preferences, as described in
1713             L.
1714              
1715             This has been split out from C for compatibility with PDF::API2.
1716             It also can both set (assign) and get (query) the settings used.
1717              
1718             =cut
1719              
1720             sub viewer_preferences {
1721 0     0 1 0 my $self = shift();
1722 0         0 require PDF::Builder::ViewerPreferences;
1723 0         0 my $prefs = PDF::Builder::ViewerPreferences->new($self);
1724 0 0       0 unless (@_) {
1725 0         0 return $prefs->get_preferences();
1726             }
1727 0         0 return $prefs->set_preferences(@_);
1728             }
1729              
1730             =item $pdf->preferences(%opts)
1731              
1732             Controls viewing preferences for the PDF, including the B,
1733             B, B, and B Options. See
1734             L for details
1735             on all these
1736             option groups, and L for page positioning.
1737              
1738             B the various preferences have been split out into their own methods.
1739             It is preferred that you use these specific methods.
1740              
1741             =cut
1742              
1743             sub preferences {
1744 222     222 1 632 my ($self, %opts) = @_;
1745             # copy dashed option names to the preferred undashed format
1746             # Page Mode Options
1747 222 50 33     731 if (defined $opts{'-fullscreen'} && !defined $opts{'fullscreen'}) { $opts{'fullscreen'} = delete($opts{'-fullscreen'}); }
  0         0  
1748 222 50 33     623 if (defined $opts{'-thumbs'} && !defined $opts{'thumbs'}) { $opts{'thumbs'} = delete($opts{'-thumbs'}); }
  0         0  
1749 222 50 33     606 if (defined $opts{'-outlines'} && !defined $opts{'outlines'}) { $opts{'outlines'} = delete($opts{'-outlines'}); }
  0         0  
1750             # Page Layout Options
1751 222 50 33     599 if (defined $opts{'-singlepage'} && !defined $opts{'singlepage'}) { $opts{'singlepage'} = delete($opts{'-singlepage'}); }
  0         0  
1752 222 50 33     548 if (defined $opts{'-onecolumn'} && !defined $opts{'onecolumn'}) { $opts{'onecolumn'} = delete($opts{'-onecolumn'}); }
  0         0  
1753 222 50 33     715 if (defined $opts{'-twocolumnleft'} && !defined $opts{'twocolumnleft'}) { $opts{'twocolumnleft'} = delete($opts{'-twocolumnleft'}); }
  0         0  
1754 222 50 33     587 if (defined $opts{'-twocolumnright'} && !defined $opts{'twocolumnright'}) { $opts{'twocolumnright'} = delete($opts{'-twocolumnright'}); }
  0         0  
1755             # Viewer Preferences
1756 222 50 33     619 if (defined $opts{'-hidetoolbar'} && !defined $opts{'hidetoolbar'}) { $opts{'hidetoolbar'} = delete($opts{'-hidetoolbar'}); }
  0         0  
1757 222 50 33     534 if (defined $opts{'-hidemenubar'} && !defined $opts{'hidemenubar'}) { $opts{'hidemenubar'} = delete($opts{'-hidemenubar'}); }
  0         0  
1758 222 50 33     559 if (defined $opts{'-hidewindowui'} && !defined $opts{'hidewindowui'}) { $opts{'hidewindowui'} = delete($opts{'-hidewindowui'}); }
  0         0  
1759 222 50 33     540 if (defined $opts{'-fitwindow'} && !defined $opts{'fitwindow'}) { $opts{'fitwindow'} = delete($opts{'-fitwindow'}); }
  0         0  
1760 222 50 33     576 if (defined $opts{'-centerwindow'} && !defined $opts{'centerwindow'}) { $opts{'centerwindow'} = delete($opts{'-centerwindow'}); }
  0         0  
1761 222 50 33     546 if (defined $opts{'-displaytitle'} && !defined $opts{'displaytitle'}) { $opts{'displaytitle'} = delete($opts{'-displaytitle'}); }
  0         0  
1762 222 50 33     557 if (defined $opts{'-righttoleft'} && !defined $opts{'righttoleft'}) { $opts{'righttoleft'} = delete($opts{'-righttoleft'}); }
  0         0  
1763 222 50 33     582 if (defined $opts{'-afterfullscreenthumbs'} && !defined $opts{'afterfullscreenthumbs'}) { $opts{'afterfullscreenthumbs'} = delete($opts{'-afterfullscreenthumbs'}); }
  0         0  
1764 222 50 33     550 if (defined $opts{'-afterfullscreenoutlines'} && !defined $opts{'afterfullscreenoutlines'}) { $opts{'afterfullscreenoutlines'} = delete($opts{'-afterfullscreenoutlines'}); }
  0         0  
1765 222 50 33     525 if (defined $opts{'-printscalingnone'} && !defined $opts{'printscalingnone'}) { $opts{'printscalingnone'} = delete($opts{'-printscalingnone'}); }
  0         0  
1766 222 100 66     514 if (defined $opts{'-simplex'} && !defined $opts{'simplex'}) { $opts{'simplex'} = delete($opts{'-simplex'}); }
  1         3  
1767 222 100 66     571 if (defined $opts{'-duplexfliplongedge'} && !defined $opts{'duplexfliplongedge'}) { $opts{'duplexfliplongedge'} = delete($opts{'-duplexfliplongedge'}); }
  1         3  
1768 222 100 66     560 if (defined $opts{'-duplexflipshortedge'} && !defined $opts{'duplexflipshortedge'}) { $opts{'duplexflipshortedge'} = delete($opts{'-duplexflipshortedge'}); }
  1         3  
1769             # Open Action
1770 222 100 66     669 if (defined $opts{'-firstpage'} && !defined $opts{'firstpage'}) { $opts{'firstpage'} = delete($opts{'-firstpage'}); }
  2         5  
1771 222 50 33     574 if (defined $opts{'-fit'} && !defined $opts{'fit'}) { $opts{'fit'} = delete($opts{'-fit'}); }
  0         0  
1772 222 50 33     566 if (defined $opts{'-fith'} && !defined $opts{'fith'}) { $opts{'fith'} = delete($opts{'-fith'}); }
  0         0  
1773 222 50 33     513 if (defined $opts{'-fitb'} && !defined $opts{'fitb'}) { $opts{'fitb'} = delete($opts{'-fitb'}); }
  0         0  
1774 222 50 33     654 if (defined $opts{'-fitbh'} && !defined $opts{'fitbh'}) { $opts{'fitbh'} = delete($opts{'-fitbh'}); }
  0         0  
1775 222 50 33     568 if (defined $opts{'-fitv'} && !defined $opts{'fitv'}) { $opts{'fitv'} = delete($opts{'-fitv'}); }
  0         0  
1776 222 50 33     533 if (defined $opts{'-fitbv'} && !defined $opts{'fitbv'}) { $opts{'fitbv'} = delete($opts{'-fitbv'}); }
  0         0  
1777 222 50 33     535 if (defined $opts{'-fitr'} && !defined $opts{'fitr'}) { $opts{'fitr'} = delete($opts{'-fitr'}); }
  0         0  
1778 222 50 33     614 if (defined $opts{'-xyz'} && !defined $opts{'xyz'}) { $opts{'xyz'} = delete($opts{'-xyz'}); }
  0         0  
1779              
1780             # Page Mode Options
1781 222 50       940 if ($opts{'fullscreen'}) {
    50          
    50          
1782 0         0 $self->{'catalog'}->{'PageMode'} = PDFName('FullScreen');
1783             } elsif ($opts{'thumbs'}) {
1784 0         0 $self->{'catalog'}->{'PageMode'} = PDFName('UseThumbs');
1785             } elsif ($opts{'outlines'}) {
1786 0         0 $self->{'catalog'}->{'PageMode'} = PDFName('UseOutlines');
1787             } else {
1788 222         682 $self->{'catalog'}->{'PageMode'} = PDFName('UseNone');
1789             }
1790              
1791             # Page Layout Options
1792 222 50       1033 if ($opts{'singlepage'}) {
    50          
    50          
    50          
1793 0         0 $self->{'catalog'}->{'PageLayout'} = PDFName('SinglePage');
1794             } elsif ($opts{'onecolumn'}) {
1795 0         0 $self->{'catalog'}->{'PageLayout'} = PDFName('OneColumn');
1796             } elsif ($opts{'twocolumnleft'}) {
1797 0         0 $self->{'catalog'}->{'PageLayout'} = PDFName('TwoColumnLeft');
1798             } elsif ($opts{'twocolumnright'}) {
1799 0         0 $self->{'catalog'}->{'PageLayout'} = PDFName('TwoColumnRight');
1800             } else {
1801 222         449 $self->{'catalog'}->{'PageLayout'} = PDFName('SinglePage');
1802             }
1803              
1804             # Viewer Preferences
1805 222   66     1003 $self->{'catalog'}->{'ViewerPreferences'} ||= PDFDict();
1806 222         925 $self->{'catalog'}->{'ViewerPreferences'}->realise();
1807              
1808 222 50       531 if ($opts{'hidetoolbar'}) {
1809 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'HideToolbar'} = PDFBool(1);
1810             }
1811 222 50       536 if ($opts{'hidemenubar'}) {
1812 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'HideMenubar'} = PDFBool(1);
1813             }
1814 222 50       493 if ($opts{'hidewindowui'}) {
1815 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'HideWindowUI'} = PDFBool(1);
1816             }
1817 222 50       470 if ($opts{'fitwindow'}) {
1818 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'FitWindow'} = PDFBool(1);
1819             }
1820 222 50       533 if ($opts{'centerwindow'}) {
1821 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'CenterWindow'} = PDFBool(1);
1822             }
1823 222 50       508 if ($opts{'displaytitle'}) {
1824 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'DisplayDocTitle'} = PDFBool(1);
1825             }
1826 222 50       507 if ($opts{'righttoleft'}) {
1827 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'Direction'} = PDFName('R2L');
1828             }
1829              
1830 222 50       592 if ($opts{'afterfullscreenthumbs'}) {
    50          
1831 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'NonFullScreenPageMode'} = PDFName('UseThumbs');
1832             } elsif ($opts{'afterfullscreenoutlines'}) {
1833 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'NonFullScreenPageMode'} = PDFName('UseOutlines');
1834             } else {
1835 222         491 $self->{'catalog'}->{'ViewerPreferences'}->{'NonFullScreenPageMode'} = PDFName('UseNone');
1836             }
1837              
1838 222 50       568 if ($opts{'printscalingnone'}) {
1839 0         0 $self->{'catalog'}->{'ViewerPreferences'}->{'PrintScaling'} = PDFName('None');
1840             }
1841              
1842 222 100       872 if ($opts{'simplex'}) {
    100          
    100          
1843 1         4 $self->{'catalog'}->{'ViewerPreferences'}->{'Duplex'} = PDFName('Simplex');
1844             } elsif ($opts{'duplexfliplongedge'}) {
1845 1         5 $self->{'catalog'}->{'ViewerPreferences'}->{'Duplex'} = PDFName('DuplexFlipLongEdge');
1846             } elsif ($opts{'duplexflipshortedge'}) {
1847 1         3 $self->{'catalog'}->{'ViewerPreferences'}->{'Duplex'} = PDFName('DuplexFlipShortEdge');
1848             }
1849              
1850             # Open Action
1851 222 100       500 if ($opts{'firstpage'}) {
1852 2         3 my ($page, %args) = @{$opts{'firstpage'}};
  2         5  
1853 2 50       5 $args{'fit'} = 1 unless scalar keys %args;
1854              
1855             # $page can be either a page number (which needs to be wrapped
1856             # in PDFNum) or a page object (which doesn't).
1857 2 100       7 $page = PDFNum($page) unless ref($page);
1858              
1859             # copy dashed args names to preferred undashed names
1860 2 50 33     12 if (defined $args{'-fit'} && !defined $args{'fit'}) { $args{'fit'} = delete($args{'-fit'}); }
  2         4  
1861 2 50 33     5 if (defined $args{'-fith'} && !defined $args{'fith'}) { $args{'fith'} = delete($args{'-fith'}); }
  0         0  
1862 2 50 33     5 if (defined $args{'-fitb'} && !defined $args{'fitb'}) { $args{'fitb'} = delete($args{'-fitb'}); }
  0         0  
1863 2 50 33     6 if (defined $args{'-fitbh'} && !defined $args{'fitbh'}) { $args{'fitbh'} = delete($args{'-fitbh'}); }
  0         0  
1864 2 50 33     13 if (defined $args{'-fitv'} && !defined $args{'fitv'}) { $args{'fitv'} = delete($args{'-fitv'}); }
  0         0  
1865 2 50 33     8 if (defined $args{'-fitbv'} && !defined $args{'fitbv'}) { $args{'fitbv'} = delete($args{'-fitbv'}); }
  0         0  
1866 2 50 33     11 if (defined $args{'-fitr'} && !defined $args{'fitr'}) { $args{'fitr'} = delete($args{'-fitr'}); }
  0         0  
1867 2 50 33     6 if (defined $args{'-xyz'} && !defined $args{'xyz'}) { $args{'xyz'} = delete($args{'-xyz'}); }
  0         0  
1868            
1869 2 50       4 if (defined $args{'fit'}) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1870 2         6 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('Fit'));
1871             } elsif (defined $args{'fith'}) {
1872 0         0 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitH'), PDFNum($args{'fith'}));
1873             } elsif (defined $args{'fitb'}) {
1874 0         0 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitB'));
1875             } elsif (defined $args{'fitbh'}) {
1876 0         0 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitBH'), PDFNum($args{'fitbh'}));
1877             } elsif (defined $args{'fitv'}) {
1878 0         0 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitV'), PDFNum($args{'fitv'}));
1879             } elsif (defined $args{'fitbv'}) {
1880 0         0 $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitBV'), PDFNum($args{'fitbv'}));
1881             } elsif (defined $args{'fitr'}) {
1882 0 0       0 croak 'insufficient parameters to fitr => []' unless scalar @{$args{'fitr'}} == 4;
  0         0  
1883             $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('FitR'),
1884 0         0 map { PDFNum($_) } @{$args{'fitr'}});
  0         0  
  0         0  
1885             } elsif (defined $args{'xyz'}) {
1886 0 0       0 croak 'insufficient parameters to xyz => []' unless scalar @{$args{'xyz'}} == 3;
  0         0  
1887             $self->{'catalog'}->{'OpenAction'} = PDFArray($page, PDFName('XYZ'),
1888 0         0 map { PDFNum($_) } @{$args{'xyz'}});
  0         0  
  0         0  
1889             }
1890             }
1891 222         835 $self->{'pdf'}->out_obj($self->{'catalog'});
1892              
1893 222         481 return $self;
1894             } # end of preferences()
1895              
1896             sub proc_pages {
1897 0     0 0 0 my ($pdf, $object) = @_;
1898              
1899 0 0       0 if (defined $object->{'Resources'}) {
1900 0         0 eval {
1901 0         0 $object->{'Resources'}->realise();
1902             };
1903             }
1904              
1905 0         0 my @pages;
1906 0   0     0 $pdf->{' apipagecount'} ||= 0;
1907 0         0 foreach my $page ($object->{'Kids'}->elements()) {
1908 0         0 $page->realise();
1909 0 0       0 if ($page->{'Type'}->val() eq 'Pages') {
1910 0         0 push @pages, proc_pages($pdf, $page);
1911             }
1912             else {
1913 0         0 $pdf->{' apipagecount'}++;
1914 0         0 $page->{' pnum'} = $pdf->{' apipagecount'};
1915 0 0       0 if (defined $page->{'Resources'}) {
1916 0         0 eval {
1917 0         0 $page->{'Resources'}->realise();
1918             };
1919             }
1920 0         0 push @pages, $page;
1921             }
1922             }
1923              
1924 0         0 return @pages;
1925             }
1926              
1927             =back
1928              
1929             =head1 PAGE METHODS
1930              
1931             =over
1932              
1933             =item $page = $pdf->page()
1934              
1935             =item $page = $pdf->page($page_number)
1936              
1937             Returns a I page object. By default, the page is added to the end
1938             of the document. If you give an existing page number, the new page
1939             will be inserted in that position, pushing existing pages back by 1 (e.g.,
1940             C would insert an empty page 5, with the old page 5 now page 6,
1941             etc.
1942              
1943             If $page_number is -1, the new page is inserted as the second-to-last page;
1944             if $page_number is 0, the new page is inserted as the last page.
1945              
1946             B
1947              
1948             $pdf = PDF::Builder->new();
1949              
1950             # Add a page. This becomes page 1.
1951             $page = $pdf->page();
1952              
1953             # Add a new first page. $page becomes page 2.
1954             $another_page = $pdf->page(1);
1955              
1956             =cut
1957              
1958             sub page {
1959 194     194 1 16051 my $self = shift();
1960 194   100     837 my $index = shift() || 0; # default to new "last" page
1961 194         261 my $page;
1962              
1963 194 100       610 if ($index == 0) {
1964 192         1384 $page = PDF::Builder::Page->new($self->{'pdf'}, $self->{'pages'});
1965             } else {
1966 2         8 $page = PDF::Builder::Page->new($self->{'pdf'}, $self->{'pages'}, $index-1);
1967             }
1968 194         504 $page->{' apipdf'} = $self->{'pdf'};
1969 194         553 $page->{' api'} = $self;
1970 194         599 weaken $page->{' apipdf'};
1971 194         632 weaken $page->{' api'};
1972 194         597 $self->{'pdf'}->out_obj($page);
1973 194         568 $self->{'pdf'}->out_obj($self->{'pages'});
1974 194 100       423 if ($index == 0) {
    50          
1975 192         358 push @{$self->{'pagestack'}}, $page;
  192         467  
1976 192         552 weaken $self->{'pagestack'}->[-1];
1977             } elsif ($index < 0) {
1978 0         0 splice @{$self->{'pagestack'}}, $index, 0, $page;
  0         0  
1979 0         0 weaken $self->{'pagestack'}->[$index];
1980             } else {
1981 2         3 splice @{$self->{'pagestack'}}, $index-1, 0, $page;
  2         5  
1982 2         5 weaken $self->{'pagestack'}->[$index - 1];
1983             }
1984              
1985             # $page->{'Resources'}=$self->{'pages'}->{'Resources'};
1986 194         976 return $page;
1987             } # end of page()
1988              
1989             =item $page = $pdf->open_page($page_number)
1990              
1991             Returns the L object of page $page_number.
1992             This is similar to C<< $page = $pdf->page() >>, except that C<$page> is
1993             I a new, empty page; but contains the contents of that existing page.
1994              
1995             If $page_number is 0 or -1, it will return the last page in the
1996             document.
1997              
1998             B
1999              
2000             $pdf = PDF::Builder->open('our/99page.pdf');
2001             $page = $pdf->open_page(1); # returns the first page
2002             $page = $pdf->open_page(99); # returns the last page
2003             $page = $pdf->open_page(-1); # returns the last page
2004             $page = $pdf->open_page(999); # returns undef
2005              
2006             B C
2007              
2008             This is the older name; it is kept for compatibility until after June 2023
2009             (deprecated, as previously announced).
2010              
2011             =cut
2012              
2013 1     1 0 7 sub openpage { return open_page(@_); } ## no critic
2014              
2015             sub open_page {
2016 7     7 1 738 my $self = shift();
2017 7   50     24 my $index = shift() || 0;
2018 7         14 my ($page, $rotate, $media, $trans);
2019              
2020 7 50       40 if ($index == 0) {
    50          
2021 0         0 $page = $self->{'pagestack'}->[-1];
2022             } elsif ($index < 0) {
2023 0         0 $page = $self->{'pagestack'}->[$index];
2024             } else {
2025 7         23 $page = $self->{'pagestack'}->[$index - 1];
2026             }
2027 7 50       20 return unless ref($page);
2028              
2029 7 100       27 if (ref($page) ne 'PDF::Builder::Page') {
2030 6         25 bless $page, 'PDF::Builder::Page';
2031 6         19 $page->{' apipdf'} = $self->{'pdf'};
2032 6         14 $page->{' api'} = $self;
2033 6         23 weaken $page->{' apipdf'};
2034 6         19 weaken $page->{' api'};
2035 6         21 $self->{'pdf'}->out_obj($page);
2036 6 50 33     26 if (($rotate = $page->find_prop('Rotate')) and not $page->{' opened'}) {
2037 0         0 $rotate = ($rotate->val() + 360) % 360;
2038              
2039 0 0 0     0 if ($rotate != 0 and not $self->default('nounrotate')) {
2040 0         0 $page->{'Rotate'} = PDFNum(0);
2041 0         0 foreach my $mediatype (qw(MediaBox CropBox BleedBox TrimBox ArtBox)) {
2042 0 0       0 if ($media = $page->find_prop($mediatype)) {
2043 0         0 $media = [ map { $_->val() } $media->elements() ];
  0         0  
2044             } else {
2045 0         0 $media = [0, 0, 612, 792]; # US Letter default
2046 0 0       0 next if $mediatype ne 'MediaBox';
2047             }
2048 0 0       0 if ($rotate == 90) {
    0          
    0          
2049 0 0       0 $trans = "0 -1 1 0 0 $media->[2] cm" if $mediatype eq 'MediaBox';
2050 0         0 $media = [$media->[1], $media->[0], $media->[3], $media->[2]];
2051             } elsif ($rotate == 180) {
2052 0 0       0 $trans = "-1 0 0 -1 $media->[2] $media->[3] cm" if $mediatype eq 'MediaBox';
2053             } elsif ($rotate == 270) {
2054 0 0       0 $trans = "0 1 -1 0 $media->[3] 0 cm" if $mediatype eq 'MediaBox';
2055 0         0 $media = [$media->[1], $media->[0], $media->[3], $media->[2]];
2056             }
2057 0         0 $page->{$mediatype} = PDFArray(map { PDFNum($_) } @$media);
  0         0  
2058             }
2059             } else {
2060 0         0 $trans = '';
2061             }
2062             } else {
2063 6         12 $trans = '';
2064             }
2065              
2066 6 100 66     29 if (defined $page->{'Contents'} and not $page->{' opened'}) {
2067 4         51 $page->fixcontents();
2068 4         9 my $uncontent = delete $page->{'Contents'};
2069 4         15 my $content = $page->gfx();
2070 4         20 $content->add(" $trans ");
2071              
2072 4 50       13 if ($self->default('pageencaps')) {
2073 0         0 $content->{' stream'} .= ' q ';
2074             }
2075 4         14 foreach my $k ($uncontent->elements()) {
2076 4         13 $k->realise();
2077 4         23 $content->{' stream'} .= ' ' . unfilter($k->{'Filter'}, $k->{' stream'}) . ' ';
2078             }
2079 4 50       13 if ($self->default('pageencaps')) {
2080 0         0 $content->{' stream'} .= ' Q ';
2081             }
2082              
2083             # if we like compress we will do it now to do quicker saves
2084 4 50 33     25 if ($self->{'forcecompress'} eq 'flate' ||
2085             $self->{'forcecompress'} =~ m/^[1-9]\d*$/) {
2086 4         19 $content->{' stream'} = dofilter($content->{'Filter'}, $content->{' stream'});
2087 4         9 $content->{' nofilt'} = 1;
2088 4         6 delete $content->{'-docompress'};
2089 4         26 $content->{'Length'} = PDFNum(length($content->{' stream'}));
2090             }
2091             }
2092 6         22 $page->{' opened'} = 1;
2093             }
2094              
2095 7         25 $self->{'pdf'}->out_obj($page);
2096 7         93 $self->{'pdf'}->out_obj($self->{'pages'});
2097 7         18 $page->{' apipdf'} = $self->{'pdf'};
2098 7         12 $page->{' api'} = $self;
2099 7         28 weaken $page->{' apipdf'};
2100 7         19 weaken $page->{' api'};
2101              
2102 7         15 return $page;
2103             } # end of open_page()
2104              
2105             =item $page = $pdf->import_page($source_pdf)
2106              
2107             =item $page = $pdf->import_page($source_pdf, $source_page_number)
2108              
2109             =item $page = $pdf->import_page($source_pdf, $source_page_number, $target_page_number)
2110              
2111             =item $page = $pdf->import_page($source_pdf, $source_page_number, $target_page_object)
2112              
2113             Imports a page from $source_pdf and adds it to the specified position
2114             in $pdf.
2115              
2116             If the C<$source_page_number> is omitted, 0, or -1; the last page of the
2117             source is imported.
2118             If the C<$target_page_number> is omitted, 0, or -1; the imported page will be
2119             placed as the new last page of the target (C<$pdf>).
2120             Otherwise, as with the C method, the page will be inserted before an
2121             existing page of that number.
2122              
2123             B If you pass a page I instead of a page I for
2124             C<$target_page_number>, the contents of the page will be B into the
2125             existing page.
2126              
2127             B
2128              
2129             my $pdf = PDF::Builder->new();
2130             my $source = PDF::Builder->open('source.pdf');
2131              
2132             # Add page 2 from the old PDF as page 1 of the new PDF
2133             my $page = $pdf->import_page($source, 2);
2134              
2135             $pdf->saveas('sample.pdf');
2136              
2137             B You can only import a page from an existing PDF file.
2138              
2139             =cut
2140              
2141             # removed years ago, but is still in API2, so for code compatibility...
2142 0     0 0 0 sub importpage{ return import_page(@_); } ## no critic
2143              
2144             sub import_page {
2145 1     1 1 8 my ($self, $s_pdf, $s_idx, $t_idx) = @_;
2146              
2147 1   50     4 $s_idx ||= 0; # default to last page
2148 1   50     5 $t_idx ||= 0; # default to last page
2149 1         2 my ($s_page, $t_page);
2150              
2151 1 50 33     11 unless (ref($s_pdf) and $s_pdf->isa('PDF::Builder')) {
2152 0         0 die "Invalid usage: first argument must be PDF::Builder instance, not: " . ref($s_pdf);
2153             }
2154              
2155 1 50       5 if (ref($s_idx) eq 'PDF::Builder::Page') {
2156 0         0 $s_page = $s_idx;
2157             } else {
2158 1         3 $s_page = $s_pdf->open_page($s_idx);
2159 1 50       4 die "Unable to open page '$s_idx' in source PDF" unless defined $s_page;
2160             }
2161              
2162 1 50       4 if (ref($t_idx) eq 'PDF::Builder::Page') {
2163 0         0 $t_page = $t_idx;
2164             } else {
2165 1 50       3 if ($self->pages() < $t_idx) {
2166 0         0 $t_page = $self->page();
2167             } else {
2168 1         4 $t_page = $self->page($t_idx);
2169             }
2170             }
2171              
2172 1   50     7 $self->{'apiimportcache'} = $self->{'apiimportcache'} || {};
2173 1   50     6 $self->{'apiimportcache'}->{$s_pdf} = $self->{'apiimportcache'}->{$s_pdf} || {};
2174              
2175             # we now import into a form to keep
2176             # all those nasty resources from polluting
2177             # our very own resource naming space.
2178 1         4 my $xo = $self->importPageIntoForm($s_pdf, $s_page);
2179              
2180             # copy all page dimensions
2181 1         3 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) {
2182 5         11 my $prop = $s_page->find_prop($k);
2183 5 100       12 next unless defined $prop;
2184              
2185 1         4 my $box = _walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $prop);
2186 1         3 my $method = lc $k;
2187              
2188 1         5 $t_page->$method(map { $_->val() } $box->elements());
  4         9  
2189             }
2190              
2191 1         14 $t_page->gfx()->formimage($xo, 0, 0, 1);
2192              
2193             # copy annotations and/or form elements as well
2194 1 0 33     4 if (exists $s_page->{'Annots'} and $s_page->{'Annots'} and $self->{'copyannots'}) {
      0        
2195             # first set up the AcroForm, if required
2196 0         0 my $AcroForm;
2197 0 0       0 if (my $a = $s_pdf->{'pdf'}->{'Root'}->realise()->{'AcroForm'}) {
2198 0         0 $a->realise();
2199              
2200 0         0 $AcroForm = _walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a,
2201             qw(NeedAppearances SigFlags CO DR DA Q));
2202             }
2203 0         0 my @Fields = ();
2204 0         0 my @Annots = ();
2205 0         0 foreach my $a ($s_page->{'Annots'}->elements()) {
2206 0         0 $a->realise();
2207 0         0 my $t_a = PDFDict();
2208 0         0 $self->{'pdf'}->new_obj($t_a);
2209             # these objects are likely to be both annotations and Acroform fields
2210             # key names are copied from PDF Reference 1.4 (Tables)
2211 0         0 my @k = (
2212             qw( Type Subtype Contents P Rect NM M F BS Border AP AS C CA T Popup A AA StructParent Rotate
2213             ), # Annotations - Common (8.10)
2214             qw( Subtype Contents Open Name ), # Text Annotations (8.15)
2215             qw( Subtype Contents Dest H PA ), # Link Annotations (8.16)
2216             qw( Subtype Contents DA Q ), # Free Text Annotations (8.17)
2217             qw( Subtype Contents L BS LE IC ), # Line Annotations (8.18)
2218             qw( Subtype Contents BS IC ), # Square and Circle Annotations (8.20)
2219             qw( Subtype Contents QuadPoints ), # Markup Annotations (8.21)
2220             qw( Subtype Contents Name ), # Rubber Stamp Annotations (8.22)
2221             qw( Subtype Contents InkList BS ), # Ink Annotations (8.23)
2222             qw( Subtype Contents Parent Open ), # Popup Annotations (8.24)
2223             qw( Subtype FS Contents Name ), # File Attachment Annotations (8.25)
2224             qw( Subtype Sound Contents Name ), # Sound Annotations (8.26)
2225             qw( Subtype Movie Contents A ), # Movie Annotations (8.27)
2226             qw( Subtype Contents H MK ), # Widget Annotations (8.28)
2227             # Printers Mark Annotations (none)
2228             # Trap Network Annotations (none)
2229             );
2230 0 0       0 push @k, (
2231             qw( Subtype FT Parent Kids T TU TM Ff V DV AA
2232             ), # Fields - Common (8.49)
2233             qw( DR DA Q ), # Fields containing variable text (8.51)
2234             qw( Opt ), # Checkbox field (8.54)
2235             qw( Opt ), # Radio field (8.55)
2236             qw( MaxLen ), # Text field (8.57)
2237             qw( Opt TI I ), # Choice field (8.59)
2238             ) if $AcroForm;
2239              
2240             # sorting out dupes
2241 0         0 my %ky = map { $_ => 1 } @k;
  0         0  
2242             # we do P separately, as it points to the page the Annotation is on
2243 0         0 delete $ky{'P'};
2244             # copy everything else
2245 0         0 foreach my $k (keys %ky) {
2246 0 0       0 next unless defined $a->{$k};
2247 0         0 $a->{$k}->realise();
2248 0         0 $t_a->{$k} = _walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a->{$k});
2249             }
2250 0         0 $t_a->{'P'} = $t_page;
2251 0         0 push @Annots, $t_a;
2252 0 0 0     0 push @Fields, $t_a if ($AcroForm and $t_a->{'Subtype'}->val() eq 'Widget');
2253             }
2254 0         0 $t_page->{'Annots'} = PDFArray(@Annots);
2255 0 0       0 $AcroForm->{'Fields'} = PDFArray(@Fields) if $AcroForm;
2256 0         0 $self->{'pdf'}->{'Root'}->{'AcroForm'} = $AcroForm;
2257             }
2258 1         2 $t_page->{' imported'} = 1;
2259              
2260 1         4 $self->{'pdf'}->out_obj($t_page);
2261 1         10 $self->{'pdf'}->out_obj($self->{'pages'});
2262              
2263 1         3 return $t_page;
2264             } # end of import_page()
2265              
2266             =item $xoform = $pdf->embed_page($source_pdf, $source_page_number)
2267              
2268             Returns a Form XObject created by extracting the specified page from
2269             C<$source_pdf>.
2270              
2271             This is useful if you want to transpose the imported page somewhat
2272             differently onto a page (e.g. two-up, four-up, etc.).
2273              
2274             If C<$source_page_number> is 0 or -1, it will return the last page in the
2275             document.
2276              
2277             B
2278              
2279             my $pdf = PDF::Builder->new();
2280             my $source = PDF::Builder->open('source.pdf');
2281             my $page = $pdf->page();
2282              
2283             # Import Page 2 from the source PDF
2284             my $object = $pdf->embed_page($source, 2);
2285              
2286             # Add it to the new PDF's first page at 1/2 scale
2287             my ($x, $y) = (0, 0);
2288             $page->object($xo, $x, $y, 0.5);
2289              
2290             $pdf->save('sample.pdf');
2291              
2292             B You can only import a page from an existing PDF file.
2293              
2294             B C
2295              
2296             This is the older name; it is kept for compatibility.
2297              
2298             =cut
2299              
2300 4     4 0 31 sub importPageIntoForm { return embed_page(@_); } ## no critic
2301              
2302             sub embed_page {
2303 4     4 1 11 my ($self, $s_pdf, $s_idx) = @_;
2304 4   50     14 $s_idx ||= 0;
2305              
2306 4 50 33     55 unless (ref($s_pdf) and $s_pdf->isa('PDF::Builder')) {
2307 0         0 die "Invalid usage: first argument must be PDF::Builder instance, not: " . ref($s_pdf);
2308             }
2309              
2310 4         8 my ($s_page, $xo);
2311              
2312 4         19 $xo = $self->xo_form();
2313              
2314 4 100       16 if (ref($s_idx) eq 'PDF::Builder::Page') {
2315 1         3 $s_page = $s_idx;
2316             } else {
2317 3         137 $s_page = $s_pdf->open_page($s_idx);
2318 3 50       12 die "Unable to open page '$s_idx' in source PDF" unless defined $s_page;
2319             }
2320              
2321 4   100     30 $self->{'apiimportcache'} ||= {};
2322 4   100     31 $self->{'apiimportcache'}->{$s_pdf} ||= {};
2323              
2324             # This should never get past MediaBox, since it's a required object.
2325 4         13 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) {
2326             #next unless defined $s_page->{$k};
2327             #my $box = _walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'},
2328             # $self->{'pdf'}, $s_page->{$k});
2329 4 50       15 next unless defined $s_page->find_prop($k);
2330             my $box = _walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'},
2331 4         21 $self->{'pdf'}, $s_page->find_prop($k));
2332 4         12 $xo->bbox(map { $_->val() } $box->elements());
  16         38  
2333 4         9 last;
2334             }
2335 4 50       16 $xo->bbox(0,0, 612,792) unless defined $xo->{'BBox'}; # US Letter default
2336              
2337 4         13 foreach my $k (qw(Resources)) {
2338 4         14 $s_page->{$k} = $s_page->find_prop($k);
2339 4 50       15 next unless defined $s_page->{$k};
2340 4 50       15 $s_page->{$k}->realise() if ref($s_page->{$k}) =~ /Objind$/;
2341              
2342 4         14 foreach my $sk (qw(XObject ExtGState Font ProcSet Properties ColorSpace Pattern Shading)) {
2343 32 100       78 next unless defined $s_page->{$k}->{$sk};
2344 5 50       21 $s_page->{$k}->{$sk}->realise() if ref($s_page->{$k}->{$sk}) =~ /Objind$/;
2345 5         8 foreach my $ssk (keys %{$s_page->{$k}->{$sk}}) {
  5         24  
2346 10 100       48 next if $ssk =~ /^ /;
2347             $xo->resource($sk, $ssk, _walk_obj($self->{'apiimportcache'}->{$s_pdf},
2348 1         7 $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k}->{$sk}->{$ssk}));
2349             }
2350             }
2351             }
2352              
2353             # create a whole content stream
2354             ## technically it is possible to submit an unfinished
2355             ## (e.g., newly created) source-page, but that's nonsense,
2356             ## so we expect a page fixed by open_page and die otherwise
2357 4 50       22 unless ($s_page->{' opened'}) {
2358 0         0 croak join(' ',
2359             "Pages may only be imported from a complete PDF.",
2360             "Save and reopen the source PDF object first.");
2361             }
2362              
2363 4 100       16 if (defined $s_page->{'Contents'}) {
2364 3         20 $s_page->fixcontents();
2365              
2366 3         8 $xo->{' stream'} = '';
2367             # open_page pages only contain one stream
2368 3         11 my ($k) = $s_page->{'Contents'}->elements();
2369 3         20 $k->realise();
2370 3 50       19 if ($k->{' nofilt'}) {
2371             # we have a finished stream here, so we unfilter
2372 3         21 $xo->add('q', unfilter($k->{'Filter'}, $k->{' stream'}), 'Q');
2373             } else {
2374             # stream is an unfinished/unfiltered content
2375             # so we just copy it and add the required "qQ"
2376 0         0 $xo->add('q', $k->{' stream'}, 'Q');
2377             }
2378             $xo->compressFlate() if $self->{'forcecompress'} eq 'flate' ||
2379 3 100 66     27 $self->{'forcecompress'} =~ m/^[1-9]\d*$/;
2380             }
2381              
2382 4         65 return $xo;
2383             } # end of embed_page()
2384              
2385             # internal utility used by embed_page and import_page
2386              
2387             sub _walk_obj {
2388 518     518   706 my ($object_cache, $source_pdf, $target_pdf, $source_object, @keys) = @_;
2389              
2390 518 100       768 if (ref($source_object) =~ /Objind$/) {
2391 1         5 $source_object->realise();
2392             }
2393              
2394 518 50       886 return $object_cache->{scalar $source_object} if defined $object_cache->{scalar $source_object};
2395             #die "infinite loop while copying objects" if $source_object->{' copied'};
2396              
2397 518         775 my $target_object = $source_object->copy($source_pdf); ## thanks to: yaheath // Fri, 17 Sep 2004
2398              
2399             #$source_object->{' copied'} = 1;
2400 518 100       811 $target_pdf->new_obj($target_object) if $source_object->is_obj($source_pdf);
2401              
2402 518         1218 $object_cache->{scalar $source_object} = $target_object;
2403              
2404 518 100       1115 if (ref($source_object) =~ /Array$/) {
    100          
2405 7         105 $target_object->{' val'} = [];
2406 7         35 foreach my $k ($source_object->elements()) {
2407 501 50       870 $k->realise() if ref($k) =~ /Objind$/;
2408 501         704 $target_object->add_elements(_walk_obj($object_cache, $source_pdf, $target_pdf, $k));
2409             }
2410             } elsif (ref($source_object) =~ /Dict$/) {
2411 2 50       12 @keys = keys(%$target_object) unless scalar @keys;
2412 2         5 foreach my $k (@keys) {
2413 12 100       23 next if $k =~ /^ /;
2414 11 50       21 next unless defined $source_object->{$k};
2415 11         25 $target_object->{$k} = _walk_obj($object_cache, $source_pdf, $target_pdf, $source_object->{$k});
2416             }
2417 2 50       8 if ($source_object->{' stream'}) {
2418 0 0       0 if ($target_object->{'Filter'}) {
2419 0         0 $target_object->{' nofilt'} = 1;
2420             } else {
2421 0         0 delete $target_object->{' nofilt'};
2422 0         0 $target_object->{'Filter'} = PDFArray(PDFName('FlateDecode'));
2423             }
2424 0         0 $target_object->{' stream'} = $source_object->{' stream'};
2425             }
2426             }
2427 518         584 delete $target_object->{' streamloc'};
2428 518         516 delete $target_object->{' streamsrc'};
2429              
2430 518         1144 return $target_object;
2431             } # end of _walk_obj()
2432              
2433             =item $count = $pdf->page_count()
2434              
2435             Returns the number of pages in the document.
2436              
2437             B C
2438              
2439             This is the old name; it is kept for compatibility.
2440              
2441             =cut
2442              
2443 3     3 0 315 sub pages { return page_count(@_); } ## no critic
2444              
2445             sub page_count {
2446 3     3 1 5 my $self = shift();
2447 3         14 return scalar @{$self->{'pagestack'}};
  3         14  
2448             }
2449              
2450             =item $pdf->page_labels($page_number, $opts)
2451              
2452             Sets page label numbering format, for the Reader's page-selection slider thumb
2453             (I the outline/bookmarks). At this time, there is no method to
2454             automatically synchronize a page's label with the outline/bookmarks, or to
2455             somewhere on the printed page.
2456              
2457             Note that many PDF Readers ignore these settings, and (at most) simply give
2458             you the physical page number 1, 2, 3,... instead of the page label specified
2459             here.
2460              
2461             # Generate a 30-page PDF
2462             my $pdf = PDF::Builder->new();
2463             $pdf->page() for 1..30;
2464              
2465             # Number pages i to v, 1 to 20, and A-1 to A-5, respectively
2466             $pdf->page_labels(1, 'style' => 'roman');
2467             $pdf->page_labels(6, 'style' => 'decimal');
2468             $pdf->page_labels(26, 'style' => 'decimal', 'prefix' => 'A-');
2469              
2470             $pdf->save('sample.pdf');
2471              
2472             B
2473              
2474             =over
2475              
2476             =item style
2477              
2478             B (I,II,III,...), B (i,ii,iii,...), B (1,2,3,...),
2479             B (A,B,C,...), B (a,b,c,...), or B. This is the
2480             styling of the counter part of the label (unless C, in which case
2481             there is no counter output).
2482              
2483             =item start
2484              
2485             (Re)start numbering the I at given page number (this is a decimal
2486             integer, I the styled counter). By default it starts at 1, and B
2487             to 1 at each call to C! You need to explicitly give C if
2488             you want to I counting at the current page number when you call
2489             C, whether or not you are changing the format.
2490              
2491             Also note that the counter starts at physical page B<1>, while the page
2492             C<$index> number in the C call (as well as the PDF PageLabels
2493             dictionary) starts at logical page (index) B<0>.
2494              
2495             =item prefix
2496              
2497             Text prefix for numbering, such as an Appendix letter B. If C