File Coverage

blib/lib/PDF/API2.pm
Criterion Covered Total %
statement 633 1029 61.5
branch 219 582 37.6
condition 49 214 22.9
subroutine 83 119 69.7
pod 89 95 93.6
total 1073 2039 52.6


line stmt bran cond sub pod time code
1             package PDF::API2;
2              
3 38     38   2550653 use strict;
  38         433  
  38         1268  
4 38     38   209 no warnings qw[ deprecated recursion uninitialized ];
  38         79  
  38         2027  
5              
6             our $VERSION = '2.044'; # VERSION
7              
8 38     38   276 use Carp;
  38         84  
  38         2829  
9 38     38   22180 use Encode qw(:all);
  38         403840  
  38         9926  
10 38     38   18319 use English;
  38         135224  
  38         241  
11 38     38   32690 use FileHandle;
  38         375888  
  38         228  
12              
13 38     38   29412 use PDF::API2::Basic::PDF::Utils;
  38         140  
  38         3202  
14 38     38   17950 use PDF::API2::Util;
  38         141  
  38         5583  
15              
16 38     38   25060 use PDF::API2::Basic::PDF::File;
  38         118  
  38         1538  
17 38     38   300 use PDF::API2::Basic::PDF::Pages;
  38         80  
  38         781  
18 38     38   19589 use PDF::API2::Page;
  38         150  
  38         1538  
19              
20 38     38   17415 use PDF::API2::Resource::XObject::Form::Hybrid;
  38         112  
  38         1388  
21              
22 38     38   17158 use PDF::API2::Resource::ExtGState;
  38         121  
  38         1280  
23 38     38   16064 use PDF::API2::Resource::Pattern;
  38         118  
  38         1156  
24 38     38   15352 use PDF::API2::Resource::Shading;
  38         115  
  38         1258  
25              
26 38     38   16312 use PDF::API2::NamedDestination;
  38         109  
  38         1376  
27              
28 38     38   289 use List::Util qw(max);
  38         82  
  38         2555  
29 38     38   262 use Scalar::Util qw(weaken);
  38         85  
  38         525921  
30              
31             my @font_path = __PACKAGE__->set_font_path('/usr/share/fonts',
32             '/usr/local/share/fonts',
33             'c:/windows/fonts');
34              
35             =head1 NAME
36              
37             PDF::API2 - Create, modify, and examine PDF files
38              
39             =head1 SYNOPSIS
40              
41             use PDF::API2;
42              
43             # Create a blank PDF file
44             $pdf = PDF::API2->new();
45              
46             # Open an existing PDF file
47             $pdf = PDF::API2->open('some.pdf');
48              
49             # Add a blank page
50             $page = $pdf->page();
51              
52             # Retrieve an existing page
53             $page = $pdf->open_page($page_number);
54              
55             # Set the page size
56             $page->size('Letter');
57              
58             # Add a built-in font to the PDF
59             $font = $pdf->font('Helvetica-Bold');
60              
61             # Add an external TrueType font to the PDF
62             $font = $pdf->font('/path/to/font.ttf');
63              
64             # Add some text to the page
65             $text = $page->text();
66             $text->font($font, 20);
67             $text->position(200, 700);
68             $text->text('Hello World!');
69              
70             # Save the PDF
71             $pdf->save('/path/to/new.pdf');
72              
73             =head1 INPUT/OUTPUT METHODS
74              
75             =head2 new
76              
77             my $pdf = PDF::API2->new(%options);
78              
79             Create a new PDF.
80              
81             The following options are available:
82              
83             =over
84              
85             =item * file
86              
87             If you will be saving the PDF to disk and already know the filename, you can
88             include it here to open the file for writing immediately. C may also be
89             a filehandle.
90              
91             =item * compress
92              
93             By default, most of the PDF will be compressed to save space. To turn this off
94             (generally only useful for testing or debugging), set C to 0.
95              
96             =back
97              
98             =cut
99              
100             sub new {
101 164     164 1 16365 my ($class, %options) = @_;
102              
103 164         391 my $self = {};
104 164         358 bless $self, $class;
105 164         1135 $self->{'pdf'} = PDF::API2::Basic::PDF::File->new();
106              
107 164         608 $self->{'pdf'}->{' version'} = '1.4';
108 164         1052 $self->{'pages'} = PDF::API2::Basic::PDF::Pages->new($self->{'pdf'});
109 164         702 $self->{'pages'}->proc_set(qw(PDF Text ImageB ImageC ImageI));
110 164   33     539 $self->{'pages'}->{'Resources'} ||= PDFDict();
111 164 50       681 $self->{'pdf'}->new_obj($self->{'pages'}->{'Resources'}) unless $self->{'pages'}->{'Resources'}->is_obj($self->{'pdf'});
112 164         404 $self->{'catalog'} = $self->{'pdf'}->{'Root'};
113 164         634 weaken $self->{'catalog'};
114 164         360 $self->{'fonts'} = {};
115 164         391 $self->{'pagestack'} = [];
116              
117             # -compress is deprecated (remove the hyphen)
118 164 100       488 if (exists $options{'-compress'}) {
119 27   33     156 $options{'compress'} //= delete $options{'-compress'};
120             }
121              
122 164 100       406 if (exists $options{'compress'}) {
123 114 50       304 $self->{'forcecompress'} = $options{'compress'} ? 1 : 0;
124             }
125             else {
126 50         134 $self->{'forcecompress'} = 1;
127             }
128 164         1757 $self->preferences(%options);
129              
130             # -file is deprecated (remove the hyphen)
131 164 50 0     517 $options{'file'} //= $options{'-file'} if $options{'-file'};
132              
133 164 50       417 if ($options{'file'}) {
134 0         0 $self->{'pdf'}->create_file($options{'file'});
135 0         0 $self->{'partial_save'} = 1;
136             }
137              
138             # Deprecated; used by info and infoMetaAttributes but not their replacements
139 164         609 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title
140             Subject Keywords)];
141              
142 164   50     300 my $version = eval { $PDF::API2::VERSION } || 'Development Version';
143 164         1027 $self->producer("PDF::API2 $version ($OSNAME)");
144              
145 164         1025 return $self;
146             }
147              
148             =head2 open
149              
150             my $pdf = PDF::API2->open('/path/to/file.pdf', %options);
151              
152             Open an existing PDF file.
153              
154             The following option is available:
155              
156             =over
157              
158             =item * compress
159              
160             By default, most of the PDF will be compressed to save space. To turn this off
161             (generally only useful for testing or debugging), set C to 0.
162              
163             =back
164              
165             =cut
166              
167             sub open {
168 8     8 1 2052 my ($class, $file, %options) = @_;
169 8 50       182 croak "File '$file' does not exist" unless -f $file;
170 8 50       119 croak "File '$file' is not readable" unless -r $file;
171              
172 8         39 my $self = {};
173 8         27 bless $self, $class;
174 8         39 foreach my $parameter (keys %options) {
175 2         12 $self->default($parameter, $options{$parameter});
176             }
177              
178 8         108 my $is_writable = -w $file;
179 8         109 $self->{'pdf'} = PDF::API2::Basic::PDF::File->open($file, $is_writable);
180 8         43 _open_common($self, %options);
181 8         23 $self->{'pdf'}->{' fname'} = $file;
182 8 50       28 $self->{'opened_readonly'} = 1 unless $is_writable;
183              
184 8         74 return $self;
185             }
186              
187             sub _open_common {
188 16     16   49 my ($self, %options) = @_;
189              
190 16         76 $self->{'pdf'}->{'Root'}->realise();
191 16   50     67 $self->{'pdf'}->{' version'} ||= '1.3';
192              
193 16         73 $self->{'pages'} = $self->{'pdf'}->{'Root'}->{'Pages'}->realise();
194 16         110 weaken $self->{'pages'};
195 16         79 my @pages = proc_pages($self->{'pdf'}, $self->{'pages'});
196 16         89 $self->{'pagestack'} = [sort { $a->{' pnum'} <=> $b->{' pnum'} } @pages];
  3         24  
197 16         38 weaken $self->{'pagestack'}->[$_] for (0 .. scalar @{$self->{'pagestack'}});
  16         160  
198              
199 16         60 $self->{'catalog'} = $self->{'pdf'}->{'Root'};
200 16         78 weaken $self->{'catalog'};
201              
202 16         44 $self->{'opened'} = 1;
203              
204             # -compress is deprecated (remove the hyphen)
205 16 100       62 if (exists $options{'-compress'}) {
206 2   33     11 $options{'compress'} //= delete $options{'-compress'};
207             }
208              
209 16 100       54 if (exists $options{'compress'}) {
210 2 50       6 $self->{'forcecompress'} = $options{'compress'} ? 1 : 0;
211             }
212             else {
213 14         48 $self->{'forcecompress'} = 1;
214             }
215 16         81 $self->{'fonts'} = {};
216 16         107 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title Subject Keywords)];
217 16         39 return $self;
218             }
219              
220             =head2 save
221              
222             $pdf->save('/path/to/file.pdf');
223              
224             Write the PDF to disk and close the file. A filename is optional if one was
225             specified while opening or creating the PDF.
226              
227             As a side effect, the document structure is removed from memory when the file is
228             saved, so it will no longer be usable.
229              
230             =cut
231              
232             # Deprecated (renamed)
233 0     0 1 0 sub saveas { return save(@_) } ## no critic
234              
235             sub save {
236 1     1 1 8 my ($self, $file) = @_;
237              
238 1 50 33     8 if ($self->{'partial_save'} and not $file) {
    50          
239 0         0 $self->{'pdf'}->close_file();
240             }
241             elsif ($self->{'opened_scalar'}) {
242 0 0       0 croak 'A filename argument is required' unless $file;
243 0         0 $self->{'pdf'}->append_file();
244 0         0 my $fh;
245 0 0       0 CORE::open($fh, '>', $file) or die "Unable to open $file for writing: $!";
246 0         0 binmode($fh, ':raw');
247 0         0 print $fh ${$self->{'content_ref'}};
  0         0  
248 0         0 CORE::close($fh);
249             }
250             else {
251 1 50       6 croak 'A filename argument is required' unless $file;
252 1 50       7 unless ($self->{'pdf'}->{' fname'}) {
    50          
253 0         0 $self->{'pdf'}->out_file($file);
254             }
255 0         0 elsif ($self->{'pdf'}->{' fname'} eq $file) {
256 1 50       5 croak "File is read-only" if $self->{'opened_readonly'};
257 1         6 $self->{'pdf'}->close_file();
258             }
259             else {
260 0         0 $self->{'pdf'}->clone_file($file);
261 0         0 $self->{'pdf'}->close_file();
262             }
263             }
264              
265             # This can be eliminated once we're confident that circular references are
266             # no longer an issue. See t/circular-references.t.
267 1         9 $self->close();
268              
269 1         4 return;
270             }
271              
272             # Deprecated (use save instead)
273             #
274             # This method allows for objects to be written to disk in advance of finally
275             # saving and closing the file. Otherwise, it's no different than just calling
276             # save when all changes have been made. There's no memory advantage since
277             # ship_out doesn't remove objects from memory.
278             sub finishobjects {
279 0     0 1 0 my ($self, @objs) = @_;
280              
281 0 0       0 if ($self->{'partial_save'}) {
282 0         0 $self->{'pdf'}->ship_out(@objs);
283             }
284              
285 0         0 return;
286             }
287              
288             # Deprecated (use save instead)
289             sub update {
290 0     0 1 0 my $self = shift();
291 0 0       0 croak "File is read-only" if $self->{'opened_readonly'};
292 0         0 $self->{'pdf'}->close_file();
293 0         0 return;
294             }
295              
296             =head2 close
297              
298             $pdf->close();
299              
300             Close an open file (if relevant) and remove the object structure from memory.
301              
302             PDF::API2 contains circular references, so this call is necessary in
303             long-running processes to keep from running out of memory.
304              
305             This will be called automatically when you save or stringify a PDF.
306             You should only need to call it explicitly if you are reading PDF
307             files and not writing them.
308              
309             =cut
310              
311             # Deprecated (renamed)
312 154     154 1 441 sub release { return $_[0]->close() }
313 0     0 1 0 sub end { return $_[0]->close() }
314              
315             sub close {
316 302     302 1 496 my $self = shift();
317 302 100       1320 $self->{'pdf'}->release() if defined $self->{'pdf'};
318              
319 302         830 foreach my $key (keys %$self) {
320 1054         1693 $self->{$key} = undef;
321 1054         1524 delete $self->{$key};
322             }
323              
324 302         901 return;
325             }
326              
327             =head2 from_string
328              
329             my $pdf = PDF::API2->from_string($pdf_string, %options);
330              
331             Read a PDF document contained in a string.
332              
333             The following option is available:
334              
335             =over
336              
337             =item * compress
338              
339             By default, most of the PDF will be compressed to save space. To turn this off
340             (generally only useful for testing or debugging), set C to 0.
341              
342             =back
343              
344             =cut
345              
346             # Deprecated (renamed)
347 1     1 1 9 sub openScalar { return from_string(@_); } ## no critic
348 0     0 1 0 sub open_scalar { return from_string(@_); } ## no critic
349              
350             sub from_string {
351 8     8 1 1547 my ($class, $content, %options) = @_;
352              
353 8         22 my $self = {};
354 8         20 bless $self, $class;
355 8         27 foreach my $parameter (keys %options) {
356 0         0 $self->default($parameter, $options{$parameter});
357             }
358              
359 8         25 $self->{'content_ref'} = \$content;
360 8         16 my $fh;
361 8 50       125 CORE::open($fh, '+<', \$content) or die "Can't begin scalar IO";
362              
363 8         71 $self->{'pdf'} = PDF::API2::Basic::PDF::File->open($fh, 1);
364 8         45 _open_common($self, %options);
365 8         20 $self->{'opened_scalar'} = 1;
366              
367 8         71 return $self;
368             }
369              
370             =head2 to_string
371              
372             my $string = $pdf->to_string();
373              
374             Return the PDF document as a string.
375              
376             As a side effect, the document structure is removed from memory when the string
377             is created, so it will no longer be usable.
378              
379             =cut
380              
381             # Maintainer's note: The object is being destroyed because it contains
382             # (contained?) circular references that would otherwise result in memory not
383             # being freed if the object merely goes out of scope. If possible, the circular
384             # references should be eliminated so that to_string doesn't need to be
385             # destructive. See t/circular-references.t.
386             #
387             # I've opted not to just require a separate call to close() because it would
388             # likely introduce memory leaks in many existing programs that use this module.
389              
390             # Deprecated (renamed)
391 0     0 1 0 sub stringify { return to_string(@_) } ## no critic
392              
393             sub to_string {
394 147     147 1 1324 my $self = shift();
395              
396 147         276 my $string = '';
397 147 100       548 if ($self->{'opened_scalar'}) {
    100          
398 3         18 $self->{'pdf'}->append_file();
399 3         6 $string = ${$self->{'content_ref'}};
  3         16  
400             }
401             elsif ($self->{'opened'}) {
402 4         33 my $fh = FileHandle->new();
403 4 50       283 CORE::open($fh, '>', \$string) || die "Can't begin scalar IO";
404 4         1685 $self->{'pdf'}->clone_file($fh);
405 4         22 $self->{'pdf'}->close_file();
406 4         37 $fh->close();
407             }
408             else {
409 140         854 my $fh = FileHandle->new();
410 140 50   25   7632 CORE::open($fh, '>', \$string) || die "Can't begin scalar IO";
  25         193  
  25         93  
  25         212  
411 140         19992 $self->{'pdf'}->out_file($fh);
412 140         546 $fh->close();
413             }
414              
415             # This can be eliminated once we're confident that circular references are
416             # no longer an issue. See t/circular-references.t.
417 147         1400 $self->close();
418              
419 147         1824 return $string;
420             }
421              
422             =head1 METADATA METHODS
423              
424             =head2 title
425              
426             $title = $pdf->title();
427             $pdf = $pdf->title($title);
428              
429             Get/set/clear the document's title.
430              
431             =cut
432              
433             sub title {
434 0     0 1 0 my $self = shift();
435 0         0 return $self->info_metadata('Title', @_);
436             }
437              
438             =head2 author
439              
440             $author = $pdf->author();
441             $pdf = $pdf->author($author);
442              
443             Get/set/clear the name of the person who created the document.
444              
445             =cut
446              
447             sub author {
448 0     0 1 0 my $self = shift();
449 0         0 return $self->info_metadata('Author', @_);
450             }
451              
452             =head2 subject
453              
454             $subject = $pdf->subject();
455             $pdf = $pdf->subject($subject);
456              
457             Get/set/clear the subject of the document.
458              
459             =cut
460              
461             sub subject {
462 0     0 1 0 my $self = shift();
463 0         0 return $self->info_metadata('Subject', @_);
464             }
465              
466             =head2 keywords
467              
468             $keywords = $pdf->keywords();
469             $pdf = $pdf->keywords($keywords);
470              
471             Get/set/clear a space-separated string of keywords associated with the document.
472              
473             =cut
474              
475             sub keywords {
476 0     0 1 0 my $self = shift();
477 0         0 return $self->info_metadata('Keywords', @_);
478             }
479              
480             =head2 creator
481              
482             $creator = $pdf->creator();
483             $pdf = $pdf->creator($creator);
484              
485             Get/set/clear the name of the product that created the document prior to its
486             conversion to PDF.
487              
488             =cut
489              
490             sub creator {
491 0     0 1 0 my $self = shift();
492 0         0 return $self->info_metadata('Creator', @_);
493             }
494              
495             =head2 producer
496              
497             $producer = $pdf->producer();
498             $pdf = $pdf->producer($producer);
499              
500             Get/set/clear the name of the product that converted the original document to
501             PDF.
502              
503             PDF::API2 fills in this field when creating a PDF.
504              
505             =cut
506              
507             sub producer {
508 169     169 1 361 my $self = shift();
509 169         537 return $self->info_metadata('Producer', @_);
510             }
511              
512             =head2 created
513              
514             $date = $pdf->created();
515             $pdf = $pdf->created($date);
516              
517             Get/set/clear the document's creation date.
518              
519             The date format is C, where C is a static prefix
520             identifying the string as a PDF date. The date may be truncated at any point
521             after the year. C is one of C<+>, C<->, or C, with the following C
522             representing an offset from UTC.
523              
524             When setting the date, C will be prepended automatically if omitted.
525              
526             =cut
527              
528             sub created {
529 1     1 1 3 my $self = shift();
530 1         4 return $self->info_metadata('CreationDate', @_);
531             }
532              
533             =head2 modified
534              
535             $date = $pdf->modified();
536             $pdf = $pdf->modified($date);
537              
538             Get/set/clear the document's modification date. The date format is as described
539             in C above.
540              
541             =cut
542              
543             sub modified {
544 0     0 1 0 my $self = shift();
545 0         0 return $self->info_metadata('ModDate', @_);
546             }
547              
548             sub _is_date {
549 1     1   3 my $value = shift();
550              
551             # PDF 1.7 section 7.9.4 describes the required date format. Other than the
552             # D: prefix and the year, all components are optional but must be present if
553             # a later component is present. No provision is made in the specification
554             # for leap seconds, etc.
555 1 50       9 return unless $value =~ /^D:([0-9]{4}) # D:YYYY (required)
556             (?:([01][0-9]) # Month (01-12)
557             (?:([0123][0-9]) # Day (01-31)
558             (?:([012][0-9]) # Hour (00-23)
559             (?:([012345][0-9]) # Minute (00-59)
560             (?:([012345][0-9]) # Second (00-59)
561             (?:([Z+-]) # UT Offset Direction
562             (?:([012][0-9]) # UT Offset Hours
563             (?:\'([012345][0-9]) # UT Offset Minutes
564             )?)?)?)?)?)?)?)?$/x;
565 1         10 my ($year, $month, $day, $hour, $minute, $second, $od, $oh, $om)
566             = ($1, $2, $3, $4, $5, $6, $7, $8, $9);
567              
568             # Do some basic validation to catch accidental date formatting issues.
569             # Complete date validation is out of scope.
570 1 50       4 if (defined $month) {
571 1 50 33     6 return unless $month >= 1 and $month <= 12;
572             }
573 1 50       4 if (defined $day) {
574 1 50 33     5 return unless $day >= 1 and $day <= 31;
575             }
576 1 50       4 if (defined $hour) {
577 1 50       4 return unless $hour <= 23;
578             }
579 1 50       4 if (defined $minute) {
580 1 50       3 return unless $minute <= 59;
581             }
582 1 50       4 if (defined $second) {
583 1 50       4 return unless $second <= 59;
584             }
585 1 50       6 if (defined $od) {
586 1 50 33     7 return if $od eq 'Z' and defined($oh);
587             }
588 1 50       4 if (defined $oh) {
589 0 0       0 return unless $oh <= 23;
590             }
591 1 50       2 if (defined $om) {
592 0 0       0 return unless $om <= 59;
593             }
594              
595 1         3 return 1;
596             }
597              
598             =head2 info_metadata
599              
600             # Get all keys and values
601             %info = $pdf->info_metadata();
602              
603             # Get the value of one key
604             $value = $pdf->info_metadata($key);
605              
606             # Set the value of one key
607             $pdf = $pdf->info_metadata($key, $value);
608              
609             Get/set/clear a key in the document's information dictionary. The standard keys
610             (title, author, etc.) have their own accessors, so this is primarily intended
611             for interacting with custom metadata.
612              
613             Pass C as the value in order to remove the key from the dictionary.
614              
615             =cut
616              
617             sub info_metadata {
618 170     170 1 312 my $self = shift();
619 170         292 my $field = shift();
620              
621             # Return a hash of the Info table if called without arguments
622 170 50       468 unless (defined $field) {
623 0 0       0 return unless exists $self->{'pdf'}->{'Info'};
624 0         0 $self->{'pdf'}->{'Info'}->realise();
625 0         0 my %info;
626 0         0 foreach my $key (keys %{$self->{'pdf'}->{'Info'}}) {
  0         0  
627 0 0       0 next if $key =~ /^ /;
628 0 0       0 next unless defined $self->{'pdf'}->{'Info'}->{$key};
629 0         0 $info{$key} = $self->{'pdf'}->{'Info'}->{$key}->val();
630             }
631 0         0 return %info;
632             }
633              
634             # Set
635 170 100       433 if (@_) {
636 167         276 my $value = shift();
637 167 50 66     783 $value = undef if defined($value) and not length($value);
638              
639 167 100 66     745 if ($field eq 'CreationDate' or $field eq 'ModDate') {
640 1 50       4 if (defined ($value)) {
641 1 50       6 $value = 'D:' . $value unless $value =~ /^D:/;
642 1 50       5 croak "Invalid date string: $value" unless _is_date($value);
643             }
644             }
645              
646 167 100       2147 unless (exists $self->{'pdf'}->{'Info'}) {
647 164 50       3458 return $self unless defined $value;
648 164         512 $self->{'pdf'}->{'Info'} = PDFDict();
649 164         591 $self->{'pdf'}->new_obj($self->{'pdf'}->{'Info'});
650             }
651             else {
652 3         11 $self->{'pdf'}->{'Info'}->realise();
653             }
654              
655 167 100       425 if (defined $value) {
656 166         476 $self->{'pdf'}->{'Info'}->{$field} = PDFStr($value);
657             }
658             else {
659 1         4 delete $self->{'pdf'}->{'Info'}->{$field};
660             }
661              
662 167         377 return $self;
663             }
664              
665             # Get
666 3 50       11 return unless $self->{'pdf'}->{'Info'};
667 3         12 $self->{'pdf'}->{'Info'}->realise();
668 3 100       15 return unless $self->{'pdf'}->{'Info'}->{$field};
669 2         7 return $self->{'pdf'}->{'Info'}->{$field}->val();
670             }
671              
672             # Deprecated; replace with individual accessors or info_metadata
673             sub info {
674 3     3 1 18 my ($self, %opt) = @_;
675              
676 3 50       10 if (not defined($self->{'pdf'}->{'Info'})) {
677 0         0 $self->{'pdf'}->{'Info'} = PDFDict();
678 0         0 $self->{'pdf'}->new_obj($self->{'pdf'}->{'Info'});
679             }
680             else {
681 3         12 $self->{'pdf'}->{'Info'}->realise();
682             }
683              
684             # Maintenance Note: Since we're not shifting at the beginning of
685             # this sub, this "if" will always be true
686 3 50       9 if (scalar @_) {
687 3         5 foreach my $k (@{$self->{'infoMeta'}}) {
  3         8  
688 24 100       76 next unless defined $opt{$k};
689 1   50     6 $self->{'pdf'}->{'Info'}->{$k} = PDFStr($opt{$k} || 'NONE');
690             }
691 3         12 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Info'});
692             }
693              
694 3 50       10 if (defined $self->{'pdf'}->{'Info'}) {
695 3         6 %opt = ();
696 3         4 foreach my $k (@{$self->{'infoMeta'}}) {
  3         8  
697 24 100       48 next unless defined $self->{'pdf'}->{'Info'}->{$k};
698 3         10 $opt{$k} = $self->{'pdf'}->{'Info'}->{$k}->val();
699 3 50 33     26 if ( (unpack('n', $opt{$k}) == 0xfffe)
700             or (unpack('n', $opt{$k}) == 0xfeff))
701             {
702 0         0 $opt{$k} = decode('UTF-16', $self->{'pdf'}->{'Info'}->{$k}->val());
703             }
704             }
705             }
706              
707 3         13 return %opt;
708             }
709              
710             # Deprecated; replace with info_metadata
711             sub infoMetaAttributes {
712 0     0 1 0 my ($self, @attr) = @_;
713              
714 0 0       0 if (scalar @attr) {
715 0         0 my %at = map { $_ => 1 } @{$self->{'infoMeta'}}, @attr;
  0         0  
  0         0  
716 0         0 @{$self->{'infoMeta'}} = keys %at;
  0         0  
717             }
718              
719 0         0 return @{$self->{'infoMeta'}};
  0         0  
720             }
721              
722             =head2 xml_metadata
723              
724             $xml = $pdf->xml_metadata();
725             $pdf = $pdf->xml_metadata($xml);
726              
727             Get/set the document's XML metadata stream.
728              
729             =cut
730              
731             # Deprecated (renamed, changed set return value for consistency)
732             sub xmpMetadata {
733 0     0 1 0 my $self = shift();
734 0 0       0 if (@_) {
735 0         0 my $value = shift();
736 0         0 $self->xml_metadata($value);
737 0         0 return $value;
738             }
739              
740 0         0 return $self->xml_metadata();
741             }
742              
743             sub xml_metadata {
744 0     0 1 0 my ($self, $value) = @_;
745              
746 0 0       0 if (not defined($self->{'catalog'}->{'Metadata'})) {
747 0         0 $self->{'catalog'}->{'Metadata'} = PDFDict();
748 0         0 $self->{'catalog'}->{'Metadata'}->{'Type'} = PDFName('Metadata');
749 0         0 $self->{'catalog'}->{'Metadata'}->{'Subtype'} = PDFName('XML');
750 0         0 $self->{'pdf'}->new_obj($self->{'catalog'}->{'Metadata'});
751             }
752             else {
753 0         0 $self->{'catalog'}->{'Metadata'}->realise();
754 0         0 $self->{'catalog'}->{'Metadata'}->{' stream'} = unfilter($self->{'catalog'}->{'Metadata'}->{'Filter'}, $self->{'catalog'}->{'Metadata'}->{' stream'});
755 0         0 delete $self->{'catalog'}->{'Metadata'}->{' nofilt'};
756 0         0 delete $self->{'catalog'}->{'Metadata'}->{'Filter'};
757             }
758              
759 0         0 my $md = $self->{'catalog'}->{'Metadata'};
760              
761 0 0       0 if (defined $value) {
762 0         0 $md->{' stream'} = $value;
763 0         0 delete $md->{'Filter'};
764 0         0 delete $md->{' nofilt'};
765 0         0 $self->{'pdf'}->out_obj($md);
766 0         0 $self->{'pdf'}->out_obj($self->{'catalog'});
767             }
768              
769 0         0 return $md->{' stream'};
770             }
771              
772             =head2 version
773              
774             $version = $pdf->version($new_version);
775              
776             Get/set the PDF version (e.g. 1.4).
777              
778             =cut
779              
780             sub version {
781 5     5 1 21 my $self = shift();
782 5         15 return $self->{'pdf'}->version(@_);
783             }
784              
785             =head2 is_encrypted
786              
787             $boolean = $pdf->is_encrypted();
788              
789             Returns true if the opened PDF is encrypted.
790              
791             =cut
792              
793             # Deprecated (renamed)
794 0     0 1 0 sub isEncrypted { return is_encrypted(@_) }
795              
796             sub is_encrypted {
797 0     0 1 0 my $self = shift();
798 0 0       0 return defined($self->{'pdf'}->{'Encrypt'}) ? 1 : 0;
799             }
800              
801             =head1 INTERACTIVE FEATURE METHODS
802              
803             =head2 outline
804              
805             $outline = $pdf->outlines();
806              
807             Creates (if needed) and returns the document's outline tree, which is also known
808             as its bookmarks or the table of contents, depending on the PDF reader.
809              
810             To examine or modify the outline tree, see L.
811              
812             =cut
813              
814             # Deprecated (renamed)
815 4     4 1 26 sub outlines { return outline(@_) }
816              
817             sub outline {
818 4     4 1 7 my $self = shift();
819              
820 4         497 require PDF::API2::Outlines;
821 4         13 my $obj = $self->{'pdf'}->{'Root'}->{'Outlines'};
822 4 100       12 if ($obj) {
823 1         5 $obj->realise();
824 1         8 bless $obj, 'PDF::API2::Outlines';
825 1         4 $obj->{' api'} = $self;
826 1         4 weaken $obj->{' api'};
827             }
828             else {
829 3         18 $obj = PDF::API2::Outlines->new($self);
830              
831 3         11 $self->{'pdf'}->{'Root'}->{'Outlines'} = $obj;
832 3 50       17 $self->{'pdf'}->new_obj($obj) unless $obj->is_obj($self->{'pdf'});
833 3         9 $self->{'pdf'}->out_obj($obj);
834 3         7 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Root'});
835             }
836              
837 4         17 return $obj;
838             }
839              
840             =head2 open_action
841              
842             $pdf = $pdf->open_action($page, $location, @args);
843              
844             Set the destination in the PDF that should be displayed when the document is
845             opened.
846              
847             C<$page> may be either a page number or a page object. The other parameters are
848             as described in L.
849              
850             =cut
851              
852             sub open_action {
853 2     2 1 8 my ($self, $page, @args) = @_;
854              
855             # $page can be either a page number or a page object
856 2 100       9 $page = PDFNum($page) unless ref($page);
857              
858 2         15 require PDF::API2::NamedDestination;
859 2         11 my $array = PDF::API2::NamedDestination::_destination($page, @args);
860 2         10 $self->{'catalog'}->{'OpenAction'} = $array;
861 2         8 $self->{'pdf'}->out_obj($self->{'catalog'});
862 2         5 return $self;
863             }
864              
865             =head2 page_layout
866              
867             $layout = $pdf->page_layout();
868             $pdf = $pdf->page_layout($layout);
869              
870             Get/set the page layout that should be used when the PDF is opened.
871              
872             C<$layout> is one of the following:
873              
874             =over
875              
876             =item * single_page (or undef)
877              
878             Display one page at a time.
879              
880             =item * one_column
881              
882             Display the pages in one column (a.k.a. continuous).
883              
884             =item * two_column_left
885              
886             Display the pages in two columns, with odd-numbered pages on the left.
887              
888             =item * two_column_right
889              
890             Display the pages in two columns, with odd-numbered pages on the right.
891              
892             =item * two_page_left
893              
894             Display two pages at a time, with odd-numbered pages on the left.
895              
896             =item * two_page_right
897              
898             Display two pages at a time, with odd-numbered pages on the right.
899              
900             =back
901              
902             =cut
903              
904             sub page_layout {
905 169     169 1 365 my $self = shift();
906              
907 169 50       452 unless (@_) {
908 0 0       0 return 'single_page' unless $self->{'catalog'}->{'PageLayout'};
909 0         0 my $layout = $self->{'catalog'}->{'PageLayout'}->val();
910 0 0       0 return 'single_page' if $layout eq 'SinglePage';
911 0 0       0 return 'one_column' if $layout eq 'OneColumn';
912 0 0       0 return 'two_column_left' if $layout eq 'TwoColumnLeft';
913 0 0       0 return 'two_column_right' if $layout eq 'TwoColumnRight';
914 0 0       0 return 'two_page_left' if $layout eq 'TwoPageLeft';
915 0 0       0 return 'two_page_right' if $layout eq 'TwoPageRight';
916 0         0 warn "Unknown page layout: $layout";
917 0         0 return $layout;
918             }
919              
920 169   50     418 my $name = shift() // 'single_page';
921 169 0       479 my $layout = ($name eq 'single_page' ? 'SinglePage' :
    0          
    0          
    0          
    0          
    50          
922             $name eq 'one_column' ? 'OneColumn' :
923             $name eq 'two_column_left' ? 'TwoColumnLeft' :
924             $name eq 'two_column_right' ? 'TwoColumnRight' :
925             $name eq 'two_page_left' ? 'TwoPageLeft' :
926             $name eq 'two_page_right' ? 'TwoPageRight' : '');
927              
928 169 50       387 croak "Invalid page layout: $name" unless $layout;
929 169         481 $self->{'catalog'}->{'PageLayout'} = PDFName($layout);
930 169         563 $self->{'pdf'}->out_obj($self->{'catalog'});
931 169         289 return $self;
932             }
933              
934             =head2 page_mode
935              
936             # Get
937             $mode = $pdf->page_mode();
938              
939             # Set
940             $pdf = $pdf->page_mode($mode);
941              
942             Get/set the page mode, which describes how the PDF should be displayed when
943             opened.
944              
945             C<$mode> is one of the following:
946              
947             =over
948              
949             =item * none (or undef)
950              
951             Neither outlines nor thumbnails should be displayed.
952              
953             =item * outlines
954              
955             Show the document outline.
956              
957             =item * thumbnails
958              
959             Show the page thumbnails.
960              
961             =item * full_screen
962              
963             Open in full-screen mode, with no menu bar, window controls, or any other window
964             visible.
965              
966             =item * optional_content
967              
968             Show the optional content group panel.
969              
970             =item * attachments
971              
972             Show the attachments panel.
973              
974             =back
975              
976             =cut
977              
978             sub page_mode {
979 169     169 1 307 my $self = shift();
980              
981 169 50       456 unless (@_) {
982 0 0       0 return 'none' unless $self->{'catalog'}->{'PageMode'};
983 0         0 my $mode = $self->{'catalog'}->{'PageMode'}->val();
984 0 0       0 return 'none' if $mode eq 'UseNone';
985 0 0       0 return 'outlines' if $mode eq 'UseOutlines';
986 0 0       0 return 'thumbnails' if $mode eq 'UseThumbs';
987 0 0       0 return 'full_screen' if $mode eq 'FullScreen';
988 0 0       0 return 'optional_content' if $mode eq 'UseOC';
989 0 0       0 return 'attachments' if $mode eq 'UseAttachments';
990 0         0 warn "Unknown page mode: $mode";
991 0         0 return $mode;
992             }
993              
994 169   50     474 my $name = shift() // 'none';
995 169 0       460 my $mode = ($name eq 'none' ? 'UseNone' :
    0          
    0          
    0          
    0          
    50          
996             $name eq 'outlines' ? 'UseOutlines' :
997             $name eq 'thumbnails' ? 'UseThumbs' :
998             $name eq 'full_screen' ? 'FullScreen' :
999             $name eq 'optional_content' ? 'UseOC' :
1000             $name eq 'attachments' ? 'UseAttachments' : '');
1001              
1002 169 50       413 croak "Invalid page mode: $name" unless $mode;
1003 169         500 $self->{'catalog'}->{'PageMode'} = PDFName($mode);
1004 169         704 $self->{'pdf'}->out_obj($self->{'catalog'});
1005 169         306 return $self;
1006             }
1007              
1008             =head2 viewer_preferences
1009              
1010             # Get
1011             %preferences = $pdf->viewer_preferences();
1012              
1013             # Set
1014             $pdf = $pdf->viewer_preferences(%preferences);
1015              
1016             Get or set PDF viewer preferences, as described in
1017             L.
1018              
1019             =cut
1020              
1021             sub viewer_preferences {
1022 172     172 1 299 my $self = shift();
1023 172         15696 require PDF::API2::ViewerPreferences;
1024 172         1011 my $prefs = PDF::API2::ViewerPreferences->new($self);
1025 172 50       520 unless (@_) {
1026 0         0 return $prefs->get_preferences();
1027             }
1028 172         568 return $prefs->set_preferences(@_);
1029             }
1030              
1031             # Deprecated; the various preferences have been split out into their own methods
1032             sub preferences {
1033 169     169 1 561 my ($self, %options) = @_;
1034              
1035             # Page Mode Options
1036 169 50       768 if ($options{'-fullscreen'}) {
    50          
    50          
1037 0         0 $self->page_mode('full_screen');
1038             }
1039             elsif ($options{'-thumbs'}) {
1040 0         0 $self->page_mode('thumbnails');
1041             }
1042             elsif ($options{'-outlines'}) {
1043 0         0 $self->page_mode('outlines');
1044             }
1045             else {
1046 169         518 $self->page_mode('none');
1047             }
1048              
1049             # Page Layout Options
1050 169 50       876 if ($options{'-singlepage'}) {
    50          
    50          
    50          
1051 0         0 $self->page_layout('single_page');
1052             }
1053             elsif ($options{'-onecolumn'}) {
1054 0         0 $self->page_layout('one_column');
1055             }
1056             elsif ($options{'-twocolumnleft'}) {
1057 0         0 $self->page_layout('two_column_left');
1058             }
1059             elsif ($options{'-twocolumnright'}) {
1060 0         0 $self->page_layout('two_column_right');
1061             }
1062             else {
1063 169         553 $self->page_layout('single_page');
1064             }
1065              
1066             # Viewer Preferences
1067 169 50       509 if ($options{'-hidetoolbar'}) {
1068 0         0 $self->viewer_preferences(hide_toolbar => 1);
1069             }
1070 169 50       442 if ($options{'-hidemenubar'}) {
1071 0         0 $self->viewer_preferences(hide_menubar => 1);
1072             }
1073 169 50       411 if ($options{'-hidewindowui'}) {
1074 0         0 $self->viewer_preferences(hide_window_ui => 1);
1075             }
1076 169 50       373 if ($options{'-fitwindow'}) {
1077 0         0 $self->viewer_preferences(fit_window => 1);
1078             }
1079 169 50       368 if ($options{'-centerwindow'}) {
1080 0         0 $self->viewer_preferences(center_window => 1);
1081             }
1082 169 50       401 if ($options{'-displaytitle'}) {
1083 0         0 $self->viewer_preferences(display_doc_title => 1);
1084             }
1085 169 50       412 if ($options{'-righttoleft'}) {
1086 0         0 $self->viewer_preferences(direction => 'r2l');
1087             }
1088              
1089 169 50       934 if ($options{'-afterfullscreenthumbs'}) {
    50          
1090 0         0 $self->viewer_preferences(non_full_screen_page_mode => 'thumbnails');
1091             }
1092             elsif ($options{'-afterfullscreenoutlines'}) {
1093 0         0 $self->viewer_preferences(non_full_screen_page_mode => 'outlines');
1094             }
1095             else {
1096 169         487 $self->viewer_preferences(non_full_screen_page_mode => 'none');
1097             }
1098              
1099 169 50       525 if ($options{'-printscalingnone'}) {
1100 0         0 $self->viewer_preferences(print_scaling => 'none');
1101             }
1102              
1103 169 100       703 if ($options{'-simplex'}) {
    100          
    100          
1104 1         4 $self->viewer_preferences(duplex => 'simplex');
1105             }
1106             elsif ($options{'-duplexfliplongedge'}) {
1107 1         7 $self->viewer_preferences(duplex => 'duplex_long');
1108             }
1109             elsif ($options{'-duplexflipshortedge'}) {
1110 1         3 $self->viewer_preferences(duplex => 'duplex_short');
1111             }
1112              
1113             # Open Action
1114 169 100       468 if ($options{'-firstpage'}) {
1115 2         4 my ($page, %args) = @{$options{'-firstpage'}};
  2         12  
1116 2 50       9 $args{'-fit'} = 1 unless keys %args;
1117              
1118 2 50       6 if (defined $args{'-fit'}) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1119 2         19 $self->open_action($page, 'fit');
1120             }
1121             elsif (defined $args{'-fith'}) {
1122 0         0 $self->open_action($page, 'fith', $args{'-fith'});
1123             }
1124             elsif (defined $args{'-fitb'}) {
1125 0         0 $self->open_action($page, 'fitb');
1126             }
1127             elsif (defined $args{'-fitbh'}) {
1128 0         0 $self->open_action($page, 'fitbh', $args{'-fitbh'});
1129             }
1130             elsif (defined $args{'-fitv'}) {
1131 0         0 $self->open_action($page, 'fitv', $args{'-fitv'});
1132             }
1133             elsif (defined $args{'-fitbv'}) {
1134 0         0 $self->open_action($page, 'fitbv', $args{'-fitbv'});
1135             }
1136             elsif (defined $args{'-fitr'}) {
1137 0         0 $self->open_action($page, 'fitr', @{$args{'-fitr'}});
  0         0  
1138             }
1139             elsif (defined $args{'-xyz'}) {
1140 0         0 $self->open_action($page, 'xyz', @{$args{'-xyz'}});
  0         0  
1141             }
1142             }
1143 169         581 $self->{'pdf'}->out_obj($self->{'catalog'});
1144              
1145 169         370 return $self;
1146             }
1147              
1148             sub proc_pages {
1149 16     16 0 50 my ($pdf, $object) = @_;
1150              
1151 16 50       65 if (defined $object->{'Resources'}) {
1152 16         37 eval {
1153 16         67 $object->{'Resources'}->realise();
1154             };
1155             }
1156              
1157 16         49 my @pages;
1158 16   50     116 $pdf->{' apipagecount'} ||= 0;
1159 16         78 foreach my $page ($object->{'Kids'}->elements()) {
1160 18         68 $page->realise();
1161 18 50       96 if ($page->{'Type'}->val() eq 'Pages') {
1162 0         0 push @pages, proc_pages($pdf, $page);
1163             }
1164             else {
1165 18         49 $pdf->{' apipagecount'}++;
1166 18         56 $page->{' pnum'} = $pdf->{' apipagecount'};
1167 18 50       75 if (defined $page->{'Resources'}) {
1168 18         42 eval {
1169 18         85 $page->{'Resources'}->realise();
1170             };
1171             }
1172 18         69 push @pages, $page;
1173             }
1174             }
1175              
1176 16         65 return @pages;
1177             }
1178              
1179             =head1 PAGE METHODS
1180              
1181             =head2 page
1182              
1183             # Add a page to the end of the document
1184             $page = $pdf->page();
1185              
1186             # Insert a page before the specified page number
1187             $page = $pdf->page($page_number);
1188              
1189             Returns a new page object. By default, the page is added to the end
1190             of the document. If you include an existing page number, the new page
1191             will be inserted in that position, pushing existing pages back.
1192              
1193             If C<$page_number> is -1, the new page is inserted as the second-last page; if
1194             C<$page_number> is 0, the new page is inserted as the last page.
1195              
1196             =cut
1197              
1198             sub page {
1199 142     142 1 18385 my $self = shift();
1200 142   100     610 my $index = shift() || 0;
1201 142         231 my $page;
1202 142 100       347 if ($index == 0) {
1203 140         936 $page = PDF::API2::Page->new($self->{'pdf'}, $self->{'pages'});
1204             }
1205             else {
1206 2         11 $page = PDF::API2::Page->new($self->{'pdf'}, $self->{'pages'}, $index - 1);
1207             }
1208 142         459 $page->{' apipdf'} = $self->{'pdf'};
1209 142         311 $page->{' api'} = $self;
1210 142         484 weaken $page->{' apipdf'};
1211 142         328 weaken $page->{' api'};
1212 142         413 $self->{'pdf'}->out_obj($page);
1213 142         468 $self->{'pdf'}->out_obj($self->{'pages'});
1214 142 100       363 if ($index == 0) {
    50          
1215 140         228 push @{$self->{'pagestack'}}, $page;
  140         307  
1216 140         468 weaken $self->{'pagestack'}->[-1];
1217             }
1218             elsif ($index < 0) {
1219 0         0 splice @{$self->{'pagestack'}}, $index, 0, $page;
  0         0  
1220 0         0 weaken $self->{'pagestack'}->[$index];
1221             }
1222             else {
1223 2         3 splice @{$self->{'pagestack'}}, $index - 1, 0, $page;
  2         6  
1224 2         9 weaken $self->{'pagestack'}->[$index - 1];
1225             }
1226             # $page->{'Resources'} = $self->{'pages'}->{'Resources'};
1227 142         772 return $page;
1228             }
1229              
1230             =head2 open_page
1231              
1232             $page = $pdf->open_page($page_number);
1233              
1234             Returns the L object of page C<$page_number>, if it exists.
1235              
1236             If $page_number is 0 or -1, it will return the last page in the document.
1237              
1238             =cut
1239              
1240             # Deprecated (renamed)
1241 1     1 1 8 sub openpage { return open_page(@_); } ## no critic
1242              
1243             sub open_page {
1244 6     6 1 23 my $self = shift();
1245 6   50     19 my $index = shift() || 0;
1246 6         13 my ($page, $rotate, $media, $trans);
1247              
1248 6 50       31 if ($index == 0) {
    50          
1249 0         0 $page = $self->{'pagestack'}->[-1];
1250             }
1251             elsif ($index < 0) {
1252 0         0 $page = $self->{'pagestack'}->[$index];
1253             }
1254             else {
1255 6         29 $page = $self->{'pagestack'}->[$index - 1];
1256             }
1257 6 50       29 return unless ref($page);
1258              
1259 6 100       30 if (ref($page) ne 'PDF::API2::Page') {
1260 5         25 bless $page, 'PDF::API2::Page';
1261 5         14 $page->{' apipdf'} = $self->{'pdf'};
1262 5         14 $page->{' api'} = $self;
1263 5         23 weaken $page->{' apipdf'};
1264 5         20 weaken $page->{' api'};
1265 5         22 $self->{'pdf'}->out_obj($page);
1266 5 50 33     23 if (($rotate = $page->find_prop('Rotate')) and not $page->{' opened'}) {
1267 0         0 $rotate = ($rotate->val() + 360) % 360;
1268              
1269 0 0 0     0 if ($rotate != 0 and not $self->default('nounrotate')) {
1270 0         0 $page->{'Rotate'} = PDFNum(0);
1271 0         0 foreach my $mediatype (qw(MediaBox CropBox BleedBox TrimBox ArtBox)) {
1272 0 0       0 if ($media = $page->find_prop($mediatype)) {
1273 0         0 $media = [ map { $_->val() } $media->elements() ];
  0         0  
1274             }
1275             else {
1276 0         0 $media = [0, 0, 612, 792];
1277 0 0       0 next if $mediatype ne 'MediaBox';
1278             }
1279 0 0       0 if ($rotate == 90) {
    0          
    0          
1280 0 0       0 $trans = "0 -1 1 0 0 $media->[2] cm" if $mediatype eq 'MediaBox';
1281 0         0 $media = [$media->[1], $media->[0], $media->[3], $media->[2]];
1282             }
1283             elsif ($rotate == 180) {
1284 0 0       0 $trans = "-1 0 0 -1 $media->[2] $media->[3] cm" if $mediatype eq 'MediaBox';
1285             }
1286             elsif ($rotate == 270) {
1287 0 0       0 $trans = "0 1 -1 0 $media->[3] 0 cm" if $mediatype eq 'MediaBox';
1288 0         0 $media = [$media->[1], $media->[0], $media->[3], $media->[2]];
1289             }
1290 0         0 $page->{$mediatype} = PDFArray(map { PDFNum($_) } @$media);
  0         0  
1291             }
1292             }
1293             else {
1294 0         0 $trans = '';
1295             }
1296             }
1297             else {
1298 5         26 $trans = '';
1299             }
1300              
1301 5 100 66     44 if (defined $page->{'Contents'} and not $page->{' opened'}) {
1302 3         26 $page->fixcontents();
1303 3         8 my $uncontent = delete $page->{'Contents'};
1304 3         25 my $content = $page->gfx();
1305 3         22 $content->add(" $trans ");
1306              
1307 3 50       14 if ($self->default('pageencaps')) {
1308 0         0 $content->{' stream'} .= ' q ';
1309             }
1310 3         11 foreach my $k ($uncontent->elements()) {
1311 3         11 $k->realise();
1312 3         34 $content->{' stream'} .= ' ' . unfilter($k->{'Filter'}, $k->{' stream'}) . ' ';
1313             }
1314 3 50       15 if ($self->default('pageencaps')) {
1315 0         0 $content->{' stream'} .= ' Q ';
1316             }
1317              
1318             # if we like compress we will do it now to do quicker saves
1319 3 50       23 if ($self->{'forcecompress'}) {
1320 3         20 $content->{' stream'} = dofilter($content->{'Filter'}, $content->{' stream'});
1321 3         10 $content->{' nofilt'} = 1;
1322 3         9 delete $content->{'-docompress'};
1323 3         17 $content->{'Length'} = PDFNum(length($content->{' stream'}));
1324             }
1325             }
1326 5         17 $page->{' opened'} = 1;
1327             }
1328              
1329 6         78 $self->{'pdf'}->out_obj($page);
1330 6         36 $self->{'pdf'}->out_obj($self->{'pages'});
1331 6         26 $page->{' apipdf'} = $self->{'pdf'};
1332 6         17 $page->{' api'} = $self;
1333 6         24 weaken $page->{' apipdf'};
1334 6         21 weaken $page->{' api'};
1335 6         17 return $page;
1336             }
1337              
1338             =head2 import_page
1339              
1340             $page = $pdf->import_page($source_pdf, $source_page_num, $target_page_num);
1341              
1342             Imports a page from C<$source_pdf> and adds it to the specified position in
1343             C<$pdf>.
1344              
1345             If C<$source_page_num> or C<$target_page_num> is 0, -1, or unspecified, the last
1346             page in the document is used.
1347              
1348             B If you pass a page object instead of a page number for
1349             C<$target_page_num>, the contents of the page will be merged into the existing
1350             page.
1351              
1352             B
1353              
1354             my $pdf = PDF::API2->new();
1355             my $source = PDF::API2->open('source.pdf');
1356              
1357             # Add page 2 from the source PDF as page 1 of the new PDF
1358             my $page = $pdf->import_page($source, 2);
1359              
1360             $pdf->save('sample.pdf');
1361              
1362             B You can only import a page from an existing PDF file.
1363              
1364             =cut
1365              
1366             # Deprecated (renamed)
1367 1     1 1 11 sub importpage { return import_page(@_); } ## no critic
1368              
1369             sub import_page {
1370 1     1 1 5 my ($self, $s_pdf, $s_idx, $t_idx) = @_;
1371 1   50     4 $s_idx ||= 0;
1372 1   50     6 $t_idx ||= 0;
1373 1         5 my ($s_page, $t_page);
1374              
1375 1 50 33     26 unless (ref($s_pdf) and $s_pdf->isa('PDF::API2')) {
1376 0         0 die "Invalid usage: first argument must be PDF::API2 instance, not: " . ref($s_pdf);
1377             }
1378              
1379 1 50       5 if (ref($s_idx) eq 'PDF::API2::Page') {
1380 0         0 $s_page = $s_idx;
1381             }
1382             else {
1383 1         7 $s_page = $s_pdf->open_page($s_idx);
1384 1 50       4 die "Unable to open page '$s_idx' in source PDF" unless defined $s_page;
1385             }
1386              
1387 1 50       4 if (ref($t_idx) eq 'PDF::API2::Page') {
1388 0         0 $t_page = $t_idx;
1389             }
1390             else {
1391 1 50       6 if ($self->pages() < $t_idx) {
1392 0         0 $t_page = $self->page();
1393             }
1394             else {
1395 1         5 $t_page = $self->page($t_idx);
1396             }
1397             }
1398              
1399 1   50     8 $self->{'apiimportcache'} = $self->{'apiimportcache'} || {};
1400 1   50     7 $self->{'apiimportcache'}->{$s_pdf} = $self->{'apiimportcache'}->{$s_pdf} || {};
1401              
1402             # we now import into a form to keep
1403             # all that nasty resources from polluting
1404             # our very own resource naming space.
1405 1         5 my $xo = $self->importPageIntoForm($s_pdf, $s_page);
1406              
1407             # copy all page dimensions
1408 1         3 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) {
1409 5         11 my $prop = $s_page->find_prop($k);
1410 5 50       12 next unless defined $prop;
1411              
1412 0         0 my $box = walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $prop);
1413 0         0 my $method = lc $k;
1414              
1415 0         0 $t_page->$method(map { $_->val() } $box->elements());
  0         0  
1416             }
1417              
1418 1         4 $t_page->gfx->formimage($xo, 0, 0, 1);
1419              
1420             # copy annotations and/or form elements as well
1421 1 0 33     8 if (exists $s_page->{'Annots'} and $s_page->{'Annots'} and $self->{'copyannots'}) {
      0        
1422             # first set up the AcroForm, if required
1423 0         0 my $AcroForm;
1424 0 0       0 if (my $a = $s_pdf->{'pdf'}->{'Root'}->realise->{'AcroForm'}) {
1425 0         0 $a->realise();
1426              
1427 0         0 $AcroForm = walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a, qw(NeedAppearances SigFlags CO DR DA Q));
1428             }
1429 0         0 my @Fields = ();
1430 0         0 my @Annots = ();
1431 0         0 foreach my $a ($s_page->{'Annots'}->elements()) {
1432 0         0 $a->realise();
1433 0         0 my $t_a = PDFDict();
1434 0         0 $self->{'pdf'}->new_obj($t_a);
1435             # these objects are likely to be both annotations and Acroform fields
1436             # key names are copied from PDF Reference 1.4 (Tables)
1437 0         0 my @k = (
1438             qw( Type Subtype Contents P Rect NM M F BS Border AP AS C CA T Popup A AA StructParent Rotate
1439             ), # Annotations - Common (8.10)
1440             qw( Subtype Contents Open Name ), # Text Annotations (8.15)
1441             qw( Subtype Contents Dest H PA ), # Link Annotations (8.16)
1442             qw( Subtype Contents DA Q ), # Free Text Annotations (8.17)
1443             qw( Subtype Contents L BS LE IC ) , # Line Annotations (8.18)
1444             qw( Subtype Contents BS IC ), # Square and Circle Annotations (8.20)
1445             qw( Subtype Contents QuadPoints ), # Markup Annotations (8.21)
1446             qw( Subtype Contents Name ), # Rubber Stamp Annotations (8.22)
1447             qw( Subtype Contents InkList BS ), # Ink Annotations (8.23)
1448             qw( Subtype Contents Parent Open ), # Popup Annotations (8.24)
1449             qw( Subtype FS Contents Name ), # File Attachment Annotations (8.25)
1450             qw( Subtype Sound Contents Name ), # Sound Annotations (8.26)
1451             qw( Subtype Movie Contents A ), # Movie Annotations (8.27)
1452             qw( Subtype Contents H MK ), # Widget Annotations (8.28)
1453             # Printers Mark Annotations (none)
1454             # Trap Network Annotations (none)
1455             );
1456              
1457 0 0       0 push @k, (
1458             qw( Subtype FT Parent Kids T TU TM Ff V DV AA
1459             ), # Fields - Common (8.49)
1460             qw( DR DA Q ), # Fields containing variable text (8.51)
1461             qw( Opt ), # Checkbox field (8.54)
1462             qw( Opt ), # Radio field (8.55)
1463             qw( MaxLen ), # Text field (8.57)
1464             qw( Opt TI I ), # Choice field (8.59)
1465             ) if $AcroForm;
1466              
1467             # sorting out dups
1468 0         0 my %ky = map { $_ => 1 } @k;
  0         0  
1469             # we do P separately, as it points to the page the Annotation is on
1470 0         0 delete $ky{'P'};
1471             # copy everything else
1472 0         0 foreach my $k (keys %ky) {
1473 0 0       0 next unless defined $a->{$k};
1474 0         0 $a->{$k}->realise();
1475 0         0 $t_a->{$k} = walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a->{$k});
1476             }
1477 0         0 $t_a->{'P'} = $t_page;
1478 0         0 push @Annots, $t_a;
1479 0 0 0     0 push @Fields, $t_a if ($AcroForm and $t_a->{'Subtype'}->val() eq 'Widget');
1480             }
1481 0         0 $t_page->{'Annots'} = PDFArray(@Annots);
1482 0 0       0 $AcroForm->{'Fields'} = PDFArray(@Fields) if $AcroForm;
1483 0         0 $self->{'pdf'}->{'Root'}->{'AcroForm'} = $AcroForm;
1484             }
1485 1         3 $t_page->{' imported'} = 1;
1486              
1487 1         5 $self->{'pdf'}->out_obj($t_page);
1488 1         3 $self->{'pdf'}->out_obj($self->{'pages'});
1489              
1490 1         3 return $t_page;
1491             }
1492              
1493             =head2 embed_page
1494              
1495             $xobject = $pdf->embed_page($source_pdf, $source_page_number);
1496              
1497             Returns a Form XObject created by extracting the specified page from a
1498             C<$source_pdf>.
1499              
1500             This is useful if you want to transpose the imported page somewhat differently
1501             onto a page (e.g. two-up, four-up, etc.).
1502              
1503             If $source_page_number is 0 or -1, it will return the last page in the document.
1504              
1505             B
1506              
1507             my $pdf = PDF::API2->new();
1508             my $source = PDF::API2->open('source.pdf');
1509             my $page = $pdf->page();
1510              
1511             # Import Page 2 from the source PDF
1512             my $object = $pdf->embed_page($source, 2);
1513              
1514             # Add it to the new PDF's first page at 1/2 scale
1515             my ($x, $y) = (0, 0);
1516             $page->object($object, $x, $y, 0.5);
1517              
1518             $pdf->save('sample.pdf');
1519              
1520             B You can only import a page from an existing PDF file.
1521              
1522             =cut
1523              
1524             # Deprecated (renamed)
1525 4     4 1 31 sub importPageIntoForm { return embed_page(@_) }
1526              
1527             sub embed_page {
1528 4     4 1 13 my ($self, $s_pdf, $s_idx) = @_;
1529 4   50     14 $s_idx ||= 0;
1530              
1531 4 50 33     58 unless (ref($s_pdf) and $s_pdf->isa('PDF::API2')) {
1532 0         0 die "Invalid usage: first argument must be PDF::API2 instance, not: " . ref($s_pdf);
1533             }
1534              
1535 4         10 my ($s_page, $xo);
1536              
1537 4         17 $xo = $self->xo_form();
1538              
1539 4 100       27 if (ref($s_idx) eq 'PDF::API2::Page') {
1540 1         2 $s_page = $s_idx;
1541             }
1542             else {
1543 3         18 $s_page = $s_pdf->open_page($s_idx);
1544             }
1545              
1546 4   100     37 $self->{'apiimportcache'} ||= {};
1547 4   100     40 $self->{'apiimportcache'}->{$s_pdf} ||= {};
1548              
1549             # This should never get past MediaBox, since it's a required object.
1550 4         22 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) {
1551             # next unless defined $s_page->{$k};
1552             # my $box = walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k});
1553 12 100       33 next unless defined $s_page->find_prop($k);
1554 2         12 my $box = walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->find_prop($k));
1555 2         20 $xo->bbox(map { $_->val() } $box->elements());
  8         22  
1556 2         6 last;
1557             }
1558 4 100       36 $xo->bbox(0, 0, 612, 792) unless defined $xo->{'BBox'};
1559              
1560 4         10 foreach my $k (qw(Resources)) {
1561 4         15 $s_page->{$k} = $s_page->find_prop($k);
1562 4 50       19 next unless defined $s_page->{$k};
1563 4 50       20 $s_page->{$k}->realise() if ref($s_page->{$k}) =~ /Objind$/;
1564              
1565 4         11 foreach my $sk (qw(XObject ExtGState Font ProcSet Properties ColorSpace Pattern Shading)) {
1566 32 100       77 next unless defined $s_page->{$k}->{$sk};
1567 5 50       29 $s_page->{$k}->{$sk}->realise() if ref($s_page->{$k}->{$sk}) =~ /Objind$/;
1568 5         10 foreach my $ssk (keys %{$s_page->{$k}->{$sk}}) {
  5         25  
1569 10 100       42 next if $ssk =~ /^ /;
1570 1         6 $xo->resource($sk, $ssk, walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k}->{$sk}->{$ssk}));
1571             }
1572             }
1573             }
1574              
1575             # create a whole content stream
1576             ## technically it is possible to submit an unfinished
1577             ## (eg. newly created) source-page, but that's nonsense,
1578             ## so we expect a page fixed by open_page and die otherwise
1579 4 50       15 unless ($s_page->{' opened'}) {
1580 0         0 croak join(' ',
1581             "Pages may only be imported from a complete PDF.",
1582             "Save and reopen the source PDF object first");
1583             }
1584              
1585 4 100       15 if (defined $s_page->{'Contents'}) {
1586 3         11 $s_page->fixcontents();
1587              
1588 3         7 $xo->{' stream'} = '';
1589             # open_page pages only contain one stream
1590 3         13 my ($k) = $s_page->{'Contents'}->elements();
1591 3         21 $k->realise();
1592 3 50       11 if ($k->{' nofilt'}) {
1593             # we have a finished stream here so we unfilter
1594 3         24 $xo->add('q', unfilter($k->{'Filter'}, $k->{' stream'}), 'Q');
1595             }
1596             else {
1597             # stream is an unfinished/unfiltered content
1598             # so we just copy it and add the required "qQ"
1599 0         0 $xo->add('q', $k->{' stream'}, 'Q');
1600             }
1601 3 50       20 $xo->compressFlate() if $self->{'forcecompress'};
1602             }
1603              
1604 4         30 return $xo;
1605             }
1606              
1607             # Used by embed_page and import_page
1608             sub walk_obj {
1609 16     16 0 34 my ($object_cache, $source_pdf, $target_pdf, $source_object, @keys) = @_;
1610              
1611 16 100       41 if (ref($source_object) =~ /Objind$/) {
1612 1         4 $source_object->realise();
1613             }
1614              
1615 16 50       38 return $object_cache->{scalar $source_object} if defined $object_cache->{scalar $source_object};
1616             # die "infinite loop while copying objects" if $source_object->{' copied'};
1617              
1618 16         36 my $target_object = $source_object->copy($source_pdf); ## thanks to: yaheath // Fri, 17 Sep 2004
1619              
1620             # $source_object->{' copied'} = 1;
1621 16 100       44 $target_pdf->new_obj($target_object) if $source_object->is_obj($source_pdf);
1622              
1623 16         56 $object_cache->{scalar $source_object} = $target_object;
1624              
1625 16 100       63 if (ref($source_object) =~ /Array$/) {
    100          
1626 2         11 $target_object->{' val'} = [];
1627 2         8 foreach my $k ($source_object->elements()) {
1628 8 50       27 $k->realise() if ref($k) =~ /Objind$/;
1629 8         21 $target_object->add_elements(walk_obj($object_cache, $source_pdf, $target_pdf, $k));
1630             }
1631             }
1632             elsif (ref($source_object) =~ /Dict$/) {
1633 1 50       8 @keys = keys(%$target_object) unless scalar @keys;
1634 1         3 foreach my $k (@keys) {
1635 6 100       15 next if $k =~ /^ /;
1636 5 50       12 next unless defined $source_object->{$k};
1637 5         10 $target_object->{$k} = walk_obj($object_cache, $source_pdf, $target_pdf, $source_object->{$k});
1638             }
1639 1 50       3 if ($source_object->{' stream'}) {
1640 0 0       0 if ($target_object->{'Filter'}) {
1641 0         0 $target_object->{' nofilt'} = 1;
1642             }
1643             else {
1644 0         0 delete $target_object->{' nofilt'};
1645 0         0 $target_object->{'Filter'} = PDFArray(PDFName('FlateDecode'));
1646             }
1647 0         0 $target_object->{' stream'} = $source_object->{' stream'};
1648             }
1649             }
1650 16         25 delete $target_object->{' streamloc'};
1651 16         20 delete $target_object->{' streamsrc'};
1652              
1653 16         64 return $target_object;
1654             }
1655              
1656             =head2 page_count
1657              
1658             $integer = $pdf->page_count();
1659              
1660             Return the number of pages in the document.
1661              
1662             =cut
1663              
1664             # Deprecated (renamed)
1665 3     3 1 382 sub pages { return page_count(@_) }
1666              
1667             sub page_count {
1668 3     3 1 5 my $self = shift();
1669 3         5 return scalar @{$self->{'pagestack'}};
  3         16  
1670             }
1671              
1672             =head2 page_labels
1673              
1674             $pdf = $pdf->page_labels($page_number, %options);
1675              
1676             Describes how pages should be numbered beginning at the specified page number.
1677              
1678             # Generate a 30-page PDF
1679             my $pdf = PDF::API2->new();
1680             $pdf->page() for 1..30;
1681              
1682             # Number pages i to v, 1 to 20, and A-1 to A-5, respectively
1683             $pdf->page_labels(1, style => 'roman');
1684             $pdf->page_labels(6, style => 'decimal');
1685             $pdf->page_labels(26, style => 'decimal', prefix => 'A-');
1686              
1687             $pdf->save('sample.pdf');
1688              
1689             The following options are available:
1690              
1691             =over
1692              
1693             =item * style
1694              
1695             One of C (standard decimal arabic numerals), C (uppercase roman
1696             numerals), C (lowercase roman numerals), C (uppercase letters),
1697             or C (lowercase letters).
1698              
1699             There is no default numbering style. If omitted, the page label will be just
1700             the prefix (if set) or an empty string.
1701              
1702             =item * prefix
1703              
1704             The label prefix for pages in this range.
1705              
1706             =item * start
1707              
1708             An integer (default: 1) representing the first value to be used in this page
1709             range.
1710              
1711             =back
1712              
1713             =cut
1714              
1715             # Deprecated; replace with page_labels, updating arguments as shown
1716             sub pageLabel {
1717 8     8 1 67 my $self = shift();
1718 8         23 while (@_) {
1719 8         13 my $page_index = shift();
1720              
1721             # Pass options as a hash rather than a hashref
1722 8   50     13 my %options = %{shift() // {}};
  8         36  
1723              
1724             # Remove leading hyphens from option names
1725 8 100       26 if (exists $options{'-prefix'}) {
1726 1         3 $options{'prefix'} = delete $options{'-prefix'};
1727             }
1728 8 100       22 if (exists $options{'-start'}) {
1729 1         5 $options{'start'} = delete $options{'-start'};
1730             }
1731 8 100       17 if (exists $options{'-style'}) {
1732 6         15 $options{'style'} = delete $options{'-style'};
1733 6 100       34 unless ($options{'style'} =~ /^(?:[Rr]oman|[Aa]lpha|decimal)$/) {
1734 1         145 carp "Invalid -style for page labels; defaulting to decimal";
1735 1         83 $options{'style'} = 'decimal';
1736             }
1737             }
1738              
1739             # page_labels doesn't have a default numbering style, to be consistent
1740             # with the spec.
1741 8   100     29 $options{'style'} //= 'D';
1742              
1743             # Set one set of page labels at a time (support for multiple sets of
1744             # page labels by pageLabel was undocumented). Switch from 0-based to
1745             # 1-based numbering.
1746 8         31 $self->page_labels($page_index + 1, %options);
1747             }
1748              
1749             # Return nothing (page_labels returns $self, matching other setters)
1750 8         19 return;
1751             }
1752              
1753             sub page_labels {
1754 8     8 1 22 my ($self, $page_number, %options) = @_;
1755              
1756             # $page_number is 1-based in order to be consistent with other PDF::API2
1757             # methods, but the page label numbering is 0-based.
1758 8         16 my $page_index = $page_number - 1;
1759              
1760 8   33     54 $self->{'catalog'}->{'PageLabels'} //= PDFDict();
1761 8   33     37 $self->{'catalog'}->{'PageLabels'}->{'Nums'} //= PDFArray();
1762              
1763 8         17 my $nums = $self->{'catalog'}->{'PageLabels'}->{'Nums'};
1764 8         19 $nums->add_elements(PDFNum($page_index));
1765              
1766 8         17 my $d = PDFDict();
1767 8 50       21 if (exists $options{'style'}) {
1768 8 50 33     49 unless ($options{'style'} and $options{'style'} =~ /^([rad])/i) {
1769 0         0 croak 'Invalid page numbering style';
1770             }
1771 8 100       39 $d->{'S'} = PDFName($1 eq 'd' ? 'D' : $1);
1772             }
1773              
1774 8 100       23 if (exists $options{'prefix'}) {
1775 1   50     6 $d->{'P'} = PDFStr($options{'prefix'} // '');
1776             }
1777              
1778 8 100       17 if (exists $options{'start'}) {
1779 1   50     8 $d->{'St'} = PDFNum($options{'start'} // '');
1780             }
1781              
1782 8         25 $nums->add_elements($d);
1783              
1784 8         28 return $self;
1785             }
1786              
1787             =head2 default_page_size
1788              
1789             # Set
1790             $pdf->default_page_size($size);
1791              
1792             # Get
1793             @rectangle = $pdf->default_page_size()
1794              
1795             Set the default physical size for pages in the PDF. If called without
1796             arguments, return the coordinates of the rectangle describing the default
1797             physical page size.
1798              
1799             See L for possible values.
1800              
1801             =cut
1802              
1803             sub default_page_size {
1804 1     1 1 2557 my $self = shift();
1805              
1806             # Set
1807 1 50       6 if (@_) {
1808 1         8 return $self->default_page_boundaries(media => @_);
1809             }
1810              
1811             # Get
1812 0         0 my $boundaries = $self->default_page_boundaries();
1813 0         0 return @{$boundaries->{'media'}};
  0         0  
1814             }
1815              
1816             =head2 default_page_boundaries
1817              
1818             # Set
1819             $pdf->default_page_boundaries(%boundaries);
1820              
1821             # Get
1822             %boundaries = $pdf->default_page_boundaries();
1823              
1824             Set default prepress page boundaries for pages in the PDF. If called without
1825             arguments, returns the coordinates of the rectangles describing each of the
1826             supported page boundaries.
1827              
1828             See the equivalent C method in L for details.
1829              
1830             =cut
1831              
1832             # Called by PDF::API2::Page::boundaries via the default_page_* methods below
1833             sub _bounding_box {
1834 17     17   2610 my $self = shift();
1835 17         28 my $type = shift();
1836              
1837             # Get
1838 17 100       39 unless (scalar @_) {
1839 6 100       18 unless ($self->{'pages'}->{$type}) {
1840 1 50       9 return if $type eq 'MediaBox';
1841              
1842             # Use defaults per PDF 1.7 section 14.11.2 Page Boundaries
1843 0 0       0 return $self->_bounding_box('MediaBox') if $type eq 'CropBox';
1844 0         0 return $self->_bounding_box('CropBox');
1845             }
1846 5         20 return map { $_->val() } $self->{'pages'}->{$type}->elements();
  20         55  
1847             }
1848              
1849             # Set
1850 11         30 $self->{'pages'}->{$type} = PDFArray(map { PDFNum(float($_)) } @_);
  44         99  
1851 11         33 return $self;
1852             }
1853              
1854             sub default_page_boundaries {
1855 3     3 1 5068 return PDF::API2::Page::boundaries(@_);
1856             }
1857              
1858             # Deprecated; use default_page_size or default_page_boundaries
1859             sub mediabox {
1860 5     5 1 22 my $self = shift();
1861 5 100       22 return $self->_bounding_box('MediaBox') unless @_;
1862 3         20 return $self->_bounding_box('MediaBox', page_size(@_));
1863             }
1864              
1865             # Deprecated; use default_page_boundaries
1866             sub cropbox {
1867 1     1 1 3284 my $self = shift();
1868 1 50       5 return $self->_bounding_box('CropBox') unless @_;
1869 1         5 return $self->_bounding_box('CropBox', page_size(@_));
1870             }
1871              
1872             # Deprecated; use default_page_boundaries
1873             sub bleedbox {
1874 1     1 1 2516 my $self = shift();
1875 1 50       6 return $self->_bounding_box('BleedBox') unless @_;
1876 1         5 return $self->_bounding_box('BleedBox', page_size(@_));
1877             }
1878              
1879             # Deprecated; use default_page_boundaries
1880             sub trimbox {
1881 1     1 1 2545 my $self = shift();
1882 1 50       6 return $self->_bounding_box('TrimBox') unless @_;
1883 1         4 return $self->_bounding_box('TrimBox', page_size(@_));
1884             }
1885              
1886             # Deprecated; use default_page_boundaries
1887             sub artbox {
1888 1     1 1 2587 my $self = shift();
1889 1 50       4 return $self->_bounding_box('ArtBox') unless @_;
1890 1         5 return $self->_bounding_box('ArtBox', page_size(@_));
1891             }
1892              
1893             =head1 FONT METHODS
1894              
1895             =head2 font
1896              
1897             my $font = $pdf->font($name, %options)
1898              
1899             Add a font to the PDF. Returns the font object, to be used by
1900             L.
1901              
1902             The font C<$name> is either the name of one of the L
1903             fonts|PDF::API2::Resource::Font::CoreFont/"STANDARD FONTS"> (e.g. Helvetica) or
1904             the path to a font file.
1905              
1906             my $pdf = PDF::API2->new();
1907             my $font1 = $pdf->font('Helvetica-Bold');
1908             my $font2 = $pdf->font('/path/to/ComicSans.ttf');
1909             my $page = $pdf->page();
1910             my $content = $page->text();
1911              
1912             $content->position(1 * 72, 9 * 72);
1913             $content->font($font1, 24);
1914             $content->text('Hello, World!');
1915              
1916             $content->position(0, -36);
1917             $content->font($font2, 12);
1918             $content->text('This is some sample text.');
1919              
1920             $pdf->save('sample.pdf');
1921              
1922             The path can be omitted if the font file is in the current directory or one of
1923             the directories returned by C.
1924              
1925             TrueType (ttf/otf), Adobe PostScript Type 1 (pfa/pfb), and Adobe Glyph Bitmap
1926             Distribution Format (bdf) fonts are supported.
1927              
1928             The following C<%options> are available:
1929              
1930             =over
1931              
1932             =item * format
1933              
1934             The font format is normally detected automatically based on the file's
1935             extension. If you're using a font with an atypical extension, you can set
1936             C to one of C (TrueType or OpenType), C (PostScript
1937             Type 1), or C (Adobe Bitmap).
1938              
1939             =item * kerning
1940              
1941             Kerning (automatic adjustment of space between pairs of characters) is enabled
1942             by default if the font includes this information. Set this option to false to
1943             disable.
1944              
1945             =item * afm_file (PostScript Type 1 fonts only)
1946              
1947             Specifies the location of the font metrics file.
1948              
1949             =item * pfm_file (PostScript Type 1 fonts only)
1950              
1951             Specifies the location of the printer font metrics file. This option overrides
1952             the -encode option.
1953              
1954             =item * embed (TrueType fonts only)
1955              
1956             Fonts are embedded in the PDF by default, which is required to ensure that they
1957             can be viewed properly on a device that doesn't have the font installed. Set
1958             this option to false to prevent the font from being embedded.
1959              
1960             =back
1961              
1962             =cut
1963              
1964             sub font {
1965 1     1 1 12 my ($self, $name, %options) = @_;
1966              
1967 1 50       5 if (exists $options{'kerning'}) {
1968 0         0 $options{'-dokern'} = delete $options{'kerning'};
1969             }
1970              
1971 1         926 require PDF::API2::Resource::Font::CoreFont;
1972 1 50       10 if (PDF::API2::Resource::Font::CoreFont->is_standard($name)) {
1973 1         7 return $self->corefont($name, %options);
1974             }
1975              
1976 0         0 my $format = $options{'format'};
1977 0 0 0     0 $format //= ($name =~ /\.[ot]tf$/i ? 'truetype' :
    0          
    0          
1978             $name =~ /\.pf[ab]$/i ? 'type1' :
1979             $name =~ /\.bdf$/i ? 'bitmap' : '');
1980              
1981 0 0       0 if ($format eq 'truetype') {
    0          
    0          
    0          
    0          
1982 0   0     0 $options{'embed'} //= 1;
1983 0         0 return $self->ttfont($name, %options);
1984             }
1985             elsif ($format eq 'type1') {
1986 0 0       0 if (exists $options{'afm_file'}) {
1987 0         0 $options{'-afmfile'} = delete $options{'afm_file'};
1988             }
1989 0 0       0 if (exists $options{'pfm_file'}) {
1990 0         0 $options{'-pfmfile'} = delete $options{'pfm_file'};
1991             }
1992 0         0 return $self->psfont($name, %options);
1993             }
1994             elsif ($format eq 'bitmap') {
1995 0         0 return $self->bdfont($name, %options);
1996             }
1997             elsif ($format) {
1998 0         0 croak "Unrecognized font format: $format";
1999             }
2000             elsif ($name =~ /(\..*)$/) {
2001 0         0 croak "Unrecognized font file extension: $1";
2002             }
2003             else {
2004 0         0 croak "Unrecognized font: $name";
2005             }
2006             }
2007              
2008             =head2 synthetic_font
2009              
2010             $font = $pdf->synthetic_font($base_font, %options)
2011              
2012             Create and return a new synthetic font object. See
2013             L for details.
2014              
2015             =cut
2016              
2017             # Deprecated (renamed)
2018 0     0 1 0 sub synfont { return synthetic_font(@_) }
2019              
2020             sub synthetic_font {
2021 0     0 1 0 my ($self, $font, %opts) = @_;
2022              
2023             # PDF::API2 doesn't set BaseEncoding for TrueType fonts, so text
2024             # isn't searchable unless a ToUnicode CMap is included. Include
2025             # the ToUnicode CMap by default, but allow it to be disabled (for
2026             # performance and file size reasons) by setting -unicodemap to 0.
2027 0 0       0 $opts{-unicodemap} = 1 unless exists $opts{-unicodemap};
2028              
2029 0         0 require PDF::API2::Resource::Font::SynFont;
2030 0         0 my $obj = PDF::API2::Resource::Font::SynFont->new($self->{'pdf'}, $font, %opts);
2031              
2032 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2033 0 0       0 $obj->tounicodemap() if $opts{-unicodemap};
2034              
2035 0         0 return $obj;
2036             }
2037              
2038             =head2 font_path
2039              
2040             @directories = PDF::API2->font_path()
2041              
2042             Return the list of directories that will be searched (in order) in addition to
2043             the current directory when you add a font to a PDF without including the full
2044             path to the font file.
2045              
2046             =cut
2047              
2048             sub font_path {
2049 0     0 1 0 return @font_path;
2050             }
2051              
2052             =head2 add_to_font_path
2053              
2054             @directories = PDF::API2->add_to_font_path('/my/fonts', '/path/to/fonts');
2055              
2056             Add one or more directories to the list of paths to be searched for font files.
2057              
2058             Returns the font search path.
2059              
2060             =cut
2061              
2062             # Deprecated (renamed)
2063 0     0 1 0 sub addFontDirs { return add_to_font_path(@_) }
2064              
2065             sub add_to_font_path {
2066             # Allow this method to be called using either :: or -> notation.
2067 0 0   0 1 0 shift() if ref($_[0]);
2068 0 0       0 shift() if $_[0] eq __PACKAGE__;
2069              
2070 0         0 push @font_path, @_;
2071 0         0 return @font_path;
2072             }
2073              
2074             =head2 set_font_path
2075              
2076             @directories = PDF::API2->set_font_path('/my/fonts', '/path/to/fonts');
2077              
2078             Replace the existing font search path. This should only be necessary if you
2079             need to remove a directory from the path for some reason, or if you need to
2080             reorder the list.
2081              
2082             Returns the font search path.
2083              
2084             =cut
2085              
2086             sub set_font_path {
2087             # Allow this method to be called using either :: or -> notation.
2088 38 50   38 1 235 shift() if ref($_[0]);
2089 38 50       228 shift() if $_[0] eq __PACKAGE__;
2090              
2091 38         129 @font_path = ((map { "$_/PDF/API2/fonts" } @INC), @_);
  418         1014  
2092              
2093 38         189 return @font_path;
2094             }
2095              
2096             sub _find_font {
2097 0     0   0 my $font = shift();
2098              
2099             # Check the current directory
2100 0 0       0 return $font if -f $font;
2101              
2102             # Check the font search path
2103 0         0 foreach my $directory (@font_path) {
2104 0 0       0 return "$directory/$font" if -f "$directory/$font";
2105             }
2106              
2107 0         0 return;
2108             }
2109              
2110             sub corefont {
2111 53     53 1 23188 my ($self, $name, %opts) = @_;
2112 53         4536 require PDF::API2::Resource::Font::CoreFont;
2113 53         410 my $obj = PDF::API2::Resource::Font::CoreFont->new($self->{'pdf'}, $name, %opts);
2114 53         466 $self->{'pdf'}->out_obj($self->{'pages'});
2115 53 50       194 $obj->tounicodemap() if $opts{-unicodemap};
2116 53         461 return $obj;
2117             }
2118              
2119             sub psfont {
2120 0     0 1 0 my ($self, $psf, %opts) = @_;
2121              
2122 0         0 foreach my $o (qw(-afmfile -pfmfile)) {
2123 0 0       0 next unless defined $opts{$o};
2124 0         0 $opts{$o} = _find_font($opts{$o});
2125             }
2126 0 0       0 $psf = _find_font($psf) or croak "Unable to find font \"$psf\"";
2127 0         0 require PDF::API2::Resource::Font::Postscript;
2128 0         0 my $obj = PDF::API2::Resource::Font::Postscript->new($self->{'pdf'}, $psf, %opts);
2129              
2130 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2131 0 0       0 $obj->tounicodemap() if $opts{-unicodemap};
2132              
2133 0         0 return $obj;
2134             }
2135              
2136             sub ttfont {
2137 0     0 1 0 my ($self, $name, %opts) = @_;
2138              
2139             # PDF::API2 doesn't set BaseEncoding for TrueType fonts, so text
2140             # isn't searchable unless a ToUnicode CMap is included. Include
2141             # the ToUnicode CMap by default, but allow it to be disabled (for
2142             # performance and file size reasons) by setting -unicodemap to 0.
2143 0 0       0 $opts{-unicodemap} = 1 unless exists $opts{-unicodemap};
2144              
2145             # -noembed is deprecated (replace with embed => 0)
2146 0 0       0 if ($opts{'-noembed'}) {
2147 0   0     0 $opts{'embed'} //= 1;
2148             }
2149 0   0     0 $opts{'embed'} //= 1;
2150              
2151 0 0       0 my $file = _find_font($name) or croak "Unable to find font \"$name\"";
2152 0         0 require PDF::API2::Resource::CIDFont::TrueType;
2153 0         0 my $obj = PDF::API2::Resource::CIDFont::TrueType->new($self->{'pdf'}, $file, %opts);
2154              
2155 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2156 0 0       0 $obj->tounicodemap() if $opts{-unicodemap};
2157              
2158 0         0 return $obj;
2159             }
2160              
2161             sub bdfont {
2162 0     0 1 0 my ($self, @opts) = @_;
2163              
2164 0         0 require PDF::API2::Resource::Font::BdFont;
2165 0         0 my $obj = PDF::API2::Resource::Font::BdFont->new($self->{'pdf'}, @opts);
2166              
2167 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2168             # $obj->tounicodemap(); # does not support Unicode
2169              
2170 0         0 return $obj;
2171             }
2172              
2173             # Deprecated. Use Unicode-supporting TrueType fonts instead.
2174             # See PDF::API2::Resource::CIDFont::CJKFont for details.
2175             sub cjkfont {
2176 1     1 1 7 my ($self, $name, %opts) = @_;
2177              
2178 1         481 require PDF::API2::Resource::CIDFont::CJKFont;
2179 1         15 my $obj = PDF::API2::Resource::CIDFont::CJKFont->new($self->{'pdf'}, $name, %opts);
2180              
2181 1         7 $self->{'pdf'}->out_obj($self->{'pages'});
2182 1 50       5 $obj->tounicodemap() if $opts{-unicodemap};
2183              
2184 1         4 return $obj;
2185             }
2186              
2187             # Deprecated. Use Unicode-supporting TrueType fonts instead.
2188             sub unifont {
2189 1     1 1 16 my ($self, @opts) = @_;
2190              
2191 1         609 require PDF::API2::Resource::UniFont;
2192 1         12 my $obj = PDF::API2::Resource::UniFont->new($self->{'pdf'}, @opts);
2193              
2194 1         4 return $obj;
2195             }
2196              
2197             =head1 GRAPHICS METHODS
2198              
2199             =head2 image
2200              
2201             $object = $pdf->image($file, %options);
2202              
2203             Import a supported image type and return an object that can be placed as part of
2204             a page's content:
2205              
2206             my $pdf = PDF::API2->new();
2207             my $page = $pdf->page();
2208              
2209             my $image = $pdf->image('/path/to/image.jpg');
2210             $page->object($image, 100, 100);
2211              
2212             $pdf->save('sample.pdf');
2213              
2214             C<$file> may be either a file name, a filehandle, or a L object.
2215              
2216             See L for details about placing images on a page
2217             once they're imported.
2218              
2219             The image format is normally detected automatically based on the file's
2220             extension. If passed a filehandle, image formats GIF, JPEG, and PNG will be
2221             detected based on the file's header.
2222              
2223             If the file has an atypical extension or the filehandle is for a different kind
2224             of image, you can set the C option to one of the supported types:
2225             C, C, C, C, or C.
2226              
2227             Note: PNG images that include an alpha (transparency) channel go through a
2228             relatively slow process of splitting the image into separate RGB and alpha
2229             components as is required by images in PDFs. If you're having performance
2230             issues, install PDF::API2::XS or Image::PNG::Libpng to speed this process up by
2231             an order of magnitude; either module will be used automatically if available.
2232              
2233             =cut
2234              
2235             sub image {
2236 3     3 1 218 my ($self, $file, %options) = @_;
2237              
2238 3   50     28 my $format = lc($options{'format'} // '');
2239              
2240 3 50       27 if (ref($file) eq 'GD::Image') {
    50          
2241 0         0 return image_gd($file, %options);
2242             }
2243             elsif (ref($file)) {
2244 3   33     19 $format ||= _detect_image_format($file);
2245             }
2246 3 50       17 unless (ref($file)) {
2247 0 0 0     0 $format ||= ($file =~ /\.jpe?g$/i ? 'jpeg' :
    0          
    0          
    0          
    0          
2248             $file =~ /\.png$/i ? 'png' :
2249             $file =~ /\.gif$/i ? 'gif' :
2250             $file =~ /\.tiff?$/i ? 'tiff' :
2251             $file =~ /\.p[bgp]m$/i ? 'pnm' : '');
2252             }
2253              
2254 3 100       20 if ($format eq 'jpeg') {
    100          
    50          
    0          
    0          
    0          
    0          
    0          
2255 1         17 return $self->image_jpeg($file, %options);
2256             }
2257             elsif ($format eq 'png') {
2258 1         5 return $self->image_png($file, %options);
2259             }
2260             elsif ($format eq 'gif') {
2261 1         5 return $self->image_gif($file, %options);
2262             }
2263             elsif ($format eq 'tiff') {
2264 0         0 return $self->image_tiff($file, %options);
2265             }
2266             elsif ($format eq 'pnm') {
2267 0         0 return $self->image_pnm($file, %options);
2268             }
2269             elsif ($format) {
2270 0         0 croak "Unrecognized image format: $format";
2271             }
2272             elsif (ref($file)) {
2273 0         0 croak "Unspecified image format";
2274             }
2275             elsif ($file =~ /(\..*)$/) {
2276 0         0 croak "Unrecognized image extension: $1";
2277             }
2278             else {
2279 0         0 croak "Unrecognized image: $file";
2280             }
2281             }
2282              
2283             sub _detect_image_format {
2284 3     3   8 my $fh = shift();
2285 3         27 $fh->seek(0, 0);
2286 3         56 binmode $fh, ':raw';
2287              
2288 3         7 my $test;
2289 3         19 my $bytes_read = $fh->read($test, 8);
2290 3         84 $fh->seek(0, 0);
2291 3 50 33     62 return unless $bytes_read and $bytes_read == 8;
2292              
2293 3 100       21 return 'gif' if $test =~ /^GIF\d\d[a-z]/;
2294 2 100       14 return 'jpeg' if $test =~ /^\xFF\xD8\xFF/;
2295 1 50       8 return 'png' if $test =~ /^\x89PNG\x0D\x0A\x1A\x0A/;
2296 0         0 return;
2297             }
2298              
2299             sub image_jpeg {
2300 3     3 1 17 my ($self, $file, %opts) = @_;
2301              
2302 3         563 require PDF::API2::Resource::XObject::Image::JPEG;
2303 3         24 my $obj = PDF::API2::Resource::XObject::Image::JPEG->new($self->{'pdf'}, $file);
2304              
2305 2         12 $self->{'pdf'}->out_obj($self->{'pages'});
2306              
2307 2         19 return $obj;
2308             }
2309              
2310             sub image_tiff {
2311 4     4 1 78 my ($self, $file, %opts) = @_;
2312              
2313 4         575 require PDF::API2::Resource::XObject::Image::TIFF;
2314 4         36 my $obj = PDF::API2::Resource::XObject::Image::TIFF->new($self->{'pdf'}, $file);
2315              
2316 3         18 $self->{'pdf'}->out_obj($self->{'pages'});
2317              
2318 3         23 return $obj;
2319             }
2320              
2321             sub image_pnm {
2322 3     3 1 69 my ($self, $file, %opts) = @_;
2323              
2324 3   66     18 $opts{'-compress'} //= $self->{'forcecompress'};
2325              
2326 3         516 require PDF::API2::Resource::XObject::Image::PNM;
2327 3         26 my $obj = PDF::API2::Resource::XObject::Image::PNM->new($self->{'pdf'}, $file, %opts);
2328              
2329 2         8 $self->{'pdf'}->out_obj($self->{'pages'});
2330              
2331 2         18 return $obj;
2332             }
2333              
2334             sub image_png {
2335 5     5 1 32 my ($self, $file, %opts) = @_;
2336              
2337 5         570 require PDF::API2::Resource::XObject::Image::PNG;
2338 5         43 my $obj = PDF::API2::Resource::XObject::Image::PNG->new($self->{'pdf'}, $file);
2339              
2340 4         40 $self->{'pdf'}->out_obj($self->{'pages'});
2341              
2342 4         57 return $obj;
2343             }
2344              
2345             sub image_gif {
2346 3     3 1 18 my ($self, $file, %opts) = @_;
2347              
2348 3         522 require PDF::API2::Resource::XObject::Image::GIF;
2349 3         25 my $obj = PDF::API2::Resource::XObject::Image::GIF->new($self->{'pdf'}, $file);
2350              
2351 2         9 $self->{'pdf'}->out_obj($self->{'pages'});
2352              
2353 2         20 return $obj;
2354             }
2355              
2356             sub image_gd {
2357 0     0 1 0 my ($self, $gd, %opts) = @_;
2358              
2359 0         0 require PDF::API2::Resource::XObject::Image::GD;
2360 0         0 my $obj = PDF::API2::Resource::XObject::Image::GD->new($self->{'pdf'}, $gd, undef, %opts);
2361              
2362 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2363              
2364 0         0 return $obj;
2365             }
2366              
2367             =head2 barcode
2368              
2369             $object = $pdf->barcode($format, $code, %options);
2370              
2371             Generate and return a barcode that can be placed as part of a page's content:
2372              
2373             my $pdf = PDF::API2->new();
2374             my $page = $pdf->page();
2375              
2376             my $barcode = $pdf->barcode('ean13', '0123456789012');
2377             $page->object($barcode, 100, 100);
2378              
2379             my $qr_code = $pdf->barcode('qr', 'http://www.example.com');
2380             $page->object($qr_code, 100, 300, 144 / $qr_code->width())
2381              
2382             $pdf->save('sample.pdf');
2383              
2384             C<$format> can be one of C, C, C (a.k.a. 3 of 9),
2385             C, C, C (a.k.a. interleaved 2 of 5), or C.
2386              
2387             C<$code> is the value to be encoded. Start and stop characters are only
2388             required when they're not static (e.g. for Codabar).
2389              
2390             The following options are available:
2391              
2392             =over
2393              
2394             =item * bar_width
2395              
2396             The width of the smallest bar or space in points (72 points = 1 inch).
2397              
2398             If you're following a specification that gives bar width in mils (thousandths of
2399             an inch), use this conversion: C<$points = $mils / 1000 * 72>.
2400              
2401             =item * bar_height
2402              
2403             The base height of the barcode in points.
2404              
2405             =item * bar_extend
2406              
2407             If present, bars for non-printing characters (e.g. start and stop characters)
2408             will be extended downward by this many points, and printing characters will be
2409             shown below their respective bars.
2410              
2411             This is enabled by default for EAN-13 barcodes.
2412              
2413             =item * caption
2414              
2415             If present, this value will be printed, centered, beneath the barcode, and
2416             should be a human-readable representation of the barcode.
2417              
2418             =item * font
2419              
2420             A font object (created by L) that will be used to print the caption, or
2421             the printable characters when C is set.
2422              
2423             Helvetica will be used by default.
2424              
2425             =item * font_size
2426              
2427             The size of the font used for printing the caption or printable characters.
2428              
2429             The default will be calculated based on the barcode size, if C is
2430             set, or 10 otherwise.
2431              
2432             =item * quiet_zone
2433              
2434             A margin, in points, that will be place before the left and bottom edges of the
2435             barcode (including the caption, if present). This is used to help barcode
2436             scanners tell where the barcode begins and ends.
2437              
2438             The default is the width of one encoded character.
2439              
2440             =item * bar_overflow
2441              
2442             Shrinks the horizontal width of bars by this amount in points to account for ink
2443             spread when printing.
2444              
2445             The default is 0.01 points.
2446              
2447             =item * color
2448              
2449             Draw bars using this color, which may be any value accepted by
2450             L.
2451              
2452             The default is black.
2453              
2454             =back
2455              
2456             =cut
2457              
2458             sub barcode {
2459 0     0 1 0 my ($self, $format, $value, %options) = @_;
2460 0 0       0 croak "Missing barcode format" unless defined $format;
2461 0 0       0 croak "Missing barcode value" unless defined $value;
2462              
2463             # Set defaults to approximately the minimums for each barcode format.
2464 0 0 0     0 if ($format eq 'codabar') {
    0 0        
    0          
    0          
    0          
2465 0   0     0 $options{'bar_width'} //= 1.8; # 0.025"
2466 0   0     0 $options{'bar_extend'} //= 0;
2467 0   0     0 $options{'quiet_zone'} //= 10 * $options{'bar_width'};
2468 0 0       0 if ($options{'bar_extend'}) {
2469 0   0     0 $options{'font_size'} //= 9 * $options{'bar_width'};
2470             }
2471              
2472             # Minimum height is the larger of 0.25" or 15% of barcode length.
2473 0         0 my $length = (10 * length($value) + 2) * $options{'bar_width'};
2474 0   0     0 $options{'bar_height'} //= max(18, $length * 0.15);
2475             }
2476             elsif ($format eq 'code128' or $format eq 'ean128' or $format eq 'code39') {
2477 0   0     0 $options{'bar_width'} //= 1;
2478 0   0     0 $options{'bar_extend'} //= 0;
2479 0   0     0 $options{'quiet_zone'} //= 11 * $options{'bar_width'};
2480 0 0       0 if ($options{'bar_extend'}) {
2481 0   0     0 $options{'font_size'} //= 10 * $options{'bar_width'};
2482             }
2483              
2484             # Minimum height is the larger of 0.5" or 15% of barcode length.
2485 0         0 my $length = 11 * (length($value) + 1) * $options{'bar_width'};
2486 0   0     0 $options{'bar_height'} //= max(36, $length * 0.15);
2487             }
2488             elsif ($format eq 'itf') {
2489 0   0     0 $options{'bar_width'} //= 1;
2490 0   0     0 $options{'bar_height'} //= 40;
2491 0   0     0 $options{'bar_extend'} //= 0;
2492 0   0     0 $options{'quiet_zone'} //= 10 * $options{'bar_width'};
2493 0 0       0 if ($options{'bar_extend'}) {
2494 0   0     0 $options{'font_size'} //= 9 * $options{'bar_width'};
2495             }
2496             }
2497             elsif ($format eq 'ean13') {
2498 0   0     0 $options{'bar_width'} //= 1;
2499 0   0     0 $options{'bar_height'} //= 64.8;
2500 0   0     0 $options{'quiet_zone'} //= 11 * $options{'bar_width'};
2501 0 0       0 unless ($options{'caption'}) {
2502 0   0     0 $options{'bar_extend'} //= 5 * $options{'bar_width'};
2503             }
2504 0 0       0 if ($options{'bar_extend'}) {
2505 0   0     0 $options{'font_size'} //= 10 * $options{'bar_width'};
2506             }
2507             }
2508             elsif ($format eq 'qr') {
2509 0   0     0 $options{'bar_width'} //= 1;
2510 0   0     0 $options{'bar_height'} //= $options{'bar_width'};
2511 0   0     0 $options{'quiet_zone'} //= 4 * $options{'bar_width'};
2512             }
2513             else {
2514 0         0 croak "Unrecognized barcode format: $format";
2515             }
2516              
2517 0 0       0 if (exists $options{'caption'}) {
2518 0   0     0 $options{'font_size'} //= 10;
2519             }
2520 0 0 0     0 if ($options{'bar_extend'} or $options{'font_size'}) {
2521 0   0     0 $options{'font'} //= $self->font('Helvetica');
2522             }
2523              
2524             # Convert from new arguments to old arguments
2525 0         0 $options{'-color'} = delete $options{'color'};
2526 0         0 $options{'-fnsz'} = delete $options{'font_size'};
2527 0         0 $options{'-font'} = delete $options{'font'};
2528 0         0 $options{'-lmzn'} = delete $options{'bar_extend'};
2529 0         0 $options{'-mils'} = (delete $options{'bar_width'}) * 1000 / 72;
2530 0         0 $options{'-ofwt'} = delete $options{'bar_overflow'};
2531 0         0 $options{'-quzn'} = delete $options{'quiet_zone'};
2532 0         0 $options{'-zone'} = delete $options{'bar_height'};
2533              
2534 0 0       0 if ($format eq 'codabar') {
    0          
    0          
    0          
    0          
    0          
    0          
2535 0         0 return $self->xo_codabar(%options, -code => $value);
2536             }
2537             elsif ($format eq 'code128') {
2538 0         0 return $self->xo_code128(%options, -code => $value);
2539             }
2540             elsif ($format eq 'code39') {
2541 0         0 return $self->xo_3of9(%options, -code => $value);
2542             }
2543             elsif ($format eq 'ean128') {
2544 0         0 return $self->xo_code128(%options, -code => $value, -ean => 1);
2545             }
2546             elsif ($format eq 'ean13') {
2547 0         0 return $self->xo_ean13(%options, -code => $value);
2548             }
2549             elsif ($format eq 'itf') {
2550 0         0 return $self->xo_2of5int(%options, -code => $value);
2551             }
2552             elsif ($format eq 'qr') {
2553 0         0 my $qr_class = 'PDF::API2::Resource::XObject::Form::BarCode::qrcode';
2554 0         0 eval "require $qr_class";
2555 0         0 my $obj = $qr_class->new($self->{'pdf'}, %options, code => $value);
2556             # $self->{'pdf'}->out_obj($self->{'pages'});
2557 0         0 return $obj;
2558             }
2559             }
2560              
2561             sub xo_code128 {
2562 1     1 1 617 my ($self, @opts) = @_;
2563              
2564 1         577 require PDF::API2::Resource::XObject::Form::BarCode::code128;
2565 1         6 my $obj = PDF::API2::Resource::XObject::Form::BarCode::code128->new($self->{'pdf'}, @opts);
2566              
2567 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2568              
2569 1         3 return $obj;
2570             }
2571              
2572             sub xo_codabar {
2573 1     1 1 24 my ($self, @opts) = @_;
2574              
2575 1         482 require PDF::API2::Resource::XObject::Form::BarCode::codabar;
2576 1         11 my $obj = PDF::API2::Resource::XObject::Form::BarCode::codabar->new($self->{'pdf'}, @opts);
2577              
2578 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2579              
2580 1         4 return $obj;
2581             }
2582              
2583             sub xo_2of5int {
2584 1     1 1 507 my ($self, @opts) = @_;
2585              
2586 1         587 require PDF::API2::Resource::XObject::Form::BarCode::int2of5;
2587 1         8 my $obj = PDF::API2::Resource::XObject::Form::BarCode::int2of5->new($self->{'pdf'}, @opts);
2588              
2589 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2590              
2591 1         6 return $obj;
2592             }
2593              
2594             sub xo_3of9 {
2595 2     2 1 407 my ($self, @opts) = @_;
2596              
2597 2         539 require PDF::API2::Resource::XObject::Form::BarCode::code3of9;
2598 2         22 my $obj = PDF::API2::Resource::XObject::Form::BarCode::code3of9->new($self->{'pdf'}, @opts);
2599              
2600 2         11 $self->{'pdf'}->out_obj($self->{'pages'});
2601              
2602 2         8 return $obj;
2603             }
2604              
2605             sub xo_ean13 {
2606 1     1 1 482 my ($self, @opts) = @_;
2607              
2608 1         557 require PDF::API2::Resource::XObject::Form::BarCode::ean13;
2609 1         7 my $obj = PDF::API2::Resource::XObject::Form::BarCode::ean13->new($self->{'pdf'}, @opts);
2610              
2611 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2612              
2613 1         4 return $obj;
2614             }
2615              
2616             =head2 colorspace
2617              
2618             $colorspace = $pdf->colorspace($type, @arguments);
2619              
2620             Colorspaces can be added to a PDF to either specifically control the output
2621             color on a particular device (spot colors, device colors) or to save space by
2622             limiting the available colors to a defined color palette (web-safe palette, ACT
2623             file).
2624              
2625             Once added to the PDF, they can be used in place of regular hex codes or named
2626             colors:
2627              
2628             my $pdf = PDF::API2->new();
2629             my $page = $pdf->page();
2630             my $content = $page->graphics();
2631              
2632             # Add colorspaces for a spot color and the web-safe color palette
2633             my $spot = $pdf->colorspace('spot', 'PANTONE Red 032 C', '#EF3340');
2634             my $web = $pdf->colorspace('web');
2635              
2636             # Fill using the spot color with 100% coverage
2637             $content->fill_color($spot, 1.0);
2638              
2639             # Stroke using the first color of the web-safe palette
2640             $content->stroke_color($web, 0);
2641              
2642             # Add a rectangle to the page
2643             $content->rectangle(100, 100, 200, 200);
2644             $content->paint();
2645              
2646             $pdf->save('sample.pdf');
2647              
2648             The following types of colorspaces are supported
2649              
2650             =over
2651              
2652             =item * spot
2653              
2654             my $spot = $pdf->colorspace('spot', $tint, $alt_color);
2655              
2656             Spot colors are used to instruct a device (usually a printer) to use or emulate
2657             a particular ink color (C<$tint>) for parts of the document. An C<$alt_color>
2658             is provided for devices (e.g. PDF viewers) that don't know how to produce the
2659             named color. It can either be an approximation of the color in RGB, CMYK, or
2660             HSV formats, or a wildly different color (e.g. 100% magenta, C<%0F00>) to make
2661             it clear if the spot color isn't being used as expected.
2662              
2663             =item * web
2664              
2665             my $web = $pdf->colorspace('web');
2666              
2667             The web-safe color palette is a historical collection of colors that was used
2668             when many display devices only supported 256 colors.
2669              
2670             =item * act
2671              
2672             my $act = $pdf->colorspace('act', $filename);
2673              
2674             An Adobe Color Table (ACT) file provides a custom palette of colors that can be
2675             referenced by PDF graphics and text drawing commands.
2676              
2677             =item * device
2678              
2679             my $devicen = $pdf->colorspace('device', @colorspaces);
2680              
2681             A device-specific colorspace allows for precise color output on a given device
2682             (typically a printing press), bypassing the normal color interpretation
2683             performed by raster image processors (RIPs).
2684              
2685             Device colorspaces are also needed if you want to blend spot colors:
2686              
2687             my $pdf = PDF::API2->new();
2688             my $page = $pdf->page();
2689             my $content = $page->graphics();
2690              
2691             # Create a two-color device colorspace
2692             my $yellow = $pdf->colorspace('spot', 'Yellow', '%00F0');
2693             my $spot = $pdf->colorspace('spot', 'PANTONE Red 032 C', '#EF3340');
2694             my $device = $pdf->colorspace('device', $yellow, $spot);
2695              
2696             # Fill using a blend of 25% yellow and 75% spot color
2697             $content->fill_color($device, 0.25, 0.75);
2698              
2699             # Stroke using 100% spot color
2700             $content->stroke_color($device, 0, 1);
2701              
2702             # Add a rectangle to the page
2703             $content->rectangle(100, 100, 200, 200);
2704             $content->paint();
2705              
2706             $pdf->save('sample.pdf');
2707              
2708             =back
2709              
2710             =cut
2711              
2712             sub colorspace {
2713 0     0 1 0 my $self = shift();
2714 0         0 my $type = shift();
2715              
2716 0 0       0 if ($type eq 'act') {
    0          
    0          
    0          
    0          
2717 0         0 my $file = shift();
2718 0         0 return $self->colorspace_act($file);
2719             }
2720             elsif ($type eq 'web') {
2721 0         0 return $self->colorspace_web();
2722             }
2723             elsif ($type eq 'hue') {
2724             # This type is undocumented until either a reference can be found for
2725             # this being a standard palette like the web color palette, or POD is
2726             # added to the Hue colorspace class that describes how to use it.
2727 0         0 return $self->colorspace_hue();
2728             }
2729             elsif ($type eq 'spot') {
2730 0         0 my $name = shift();
2731 0         0 my $alt_color = shift();
2732 0         0 return $self->colorspace_separation($name, $alt_color);
2733             }
2734             elsif ($type eq 'device') {
2735 0         0 my @colors = @_;
2736 0         0 return $self->colorspace_devicen(\@colors);
2737             }
2738             else {
2739 0         0 croak "Unrecognized or unsupported colorspace: $type";
2740             }
2741             }
2742              
2743             sub colorspace_act {
2744 0     0 1 0 my ($self, $file) = @_;
2745              
2746 0         0 require PDF::API2::Resource::ColorSpace::Indexed::ACTFile;
2747 0         0 return PDF::API2::Resource::ColorSpace::Indexed::ACTFile->new($self->{'pdf'},
2748             $file);
2749             }
2750              
2751             sub colorspace_web {
2752 1     1 1 7 my $self = shift();
2753              
2754 1         461 require PDF::API2::Resource::ColorSpace::Indexed::WebColor;
2755 1         12 return PDF::API2::Resource::ColorSpace::Indexed::WebColor->new($self->{'pdf'});
2756             }
2757              
2758             sub colorspace_hue {
2759 0     0 1 0 my $self = shift();
2760              
2761 0         0 require PDF::API2::Resource::ColorSpace::Indexed::Hue;
2762 0         0 return PDF::API2::Resource::ColorSpace::Indexed::Hue->new($self->{'pdf'});
2763             }
2764              
2765             sub colorspace_separation {
2766 0     0 1 0 my ($self, $name, @clr) = @_;
2767              
2768 0         0 require PDF::API2::Resource::ColorSpace::Separation;
2769 0         0 return PDF::API2::Resource::ColorSpace::Separation->new($self->{'pdf'},
2770             pdfkey(),
2771             $name,
2772             @clr);
2773             }
2774              
2775             sub colorspace_devicen {
2776 0     0 1 0 my ($self, $clrs) = @_;
2777              
2778 0         0 require PDF::API2::Resource::ColorSpace::DeviceN;
2779 0         0 return PDF::API2::Resource::ColorSpace::DeviceN->new($self->{'pdf'},
2780             pdfkey(),
2781             $clrs);
2782             }
2783              
2784             =head2 egstate
2785              
2786             $resource = $pdf->egstate();
2787              
2788             Creates and returns a new extended graphics state object, described in
2789             L.
2790              
2791             =cut
2792              
2793             sub egstate {
2794 3     3 1 14 my $self = shift();
2795              
2796 3         16 my $obj = PDF::API2::Resource::ExtGState->new($self->{'pdf'}, pdfkey());
2797              
2798 3         14 $self->{'pdf'}->out_obj($self->{'pages'});
2799              
2800 3         15 return $obj;
2801             }
2802              
2803             sub default {
2804 8     8 1 26 my ($self, $parameter, $value) = @_;
2805              
2806             # Parameter names may consist of lowercase letters, numbers, and underscores
2807 8         22 $parameter = lc $parameter;
2808 8         32 $parameter =~ s/[^a-z\d_]//g;
2809              
2810 8         17 my $previous_value = $self->{$parameter};
2811 8 100       25 if (defined $value) {
2812 2         5 $self->{$parameter} = $value;
2813             }
2814 8         24 return $previous_value;
2815             }
2816              
2817             sub xo_form {
2818 4     4 0 19 my $self = shift();
2819              
2820 4         54 my $obj = PDF::API2::Resource::XObject::Form::Hybrid->new($self->{'pdf'});
2821              
2822 4         31 $self->{'pdf'}->out_obj($self->{'pages'});
2823              
2824 4         12 return $obj;
2825             }
2826              
2827             sub pattern {
2828 0     0 0 0 my ($self, %opts) = @_;
2829              
2830 0         0 my $obj = PDF::API2::Resource::Pattern->new($self->{'pdf'}, undef, %opts);
2831              
2832 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2833              
2834 0         0 return $obj;
2835             }
2836              
2837             sub shading {
2838 0     0 0 0 my ($self, %opts) = @_;
2839              
2840 0         0 my $obj = PDF::API2::Resource::Shading->new($self->{'pdf'}, undef, %opts);
2841              
2842 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2843              
2844 0         0 return $obj;
2845             }
2846              
2847             sub named_destination {
2848 0     0 0 0 my ($self, $cat, $name, $obj) = @_;
2849 0         0 my $root = $self->{'catalog'};
2850              
2851 0   0     0 $root->{'Names'} ||= PDFDict();
2852 0   0     0 $root->{'Names'}->{$cat} ||= PDFDict();
2853 0   0     0 $root->{'Names'}->{$cat}->{'-vals'} ||= {};
2854 0   0     0 $root->{'Names'}->{$cat}->{'Limits'} ||= PDFArray();
2855 0   0     0 $root->{'Names'}->{$cat}->{'Names'} ||= PDFArray();
2856              
2857 0 0       0 unless (defined $obj) {
2858 0         0 $obj = PDF::API2::NamedDestination->new($self->{'pdf'});
2859             }
2860 0         0 $root->{'Names'}->{$cat}->{'-vals'}->{$name} = $obj;
2861              
2862 0         0 my @names = sort {$a cmp $b} keys %{$root->{'Names'}->{$cat}->{'-vals'}};
  0         0  
  0         0  
2863              
2864 0         0 $root->{'Names'}->{$cat}->{'Limits'}->{' val'}->[0] = PDFStr($names[0]);
2865 0         0 $root->{'Names'}->{$cat}->{'Limits'}->{' val'}->[1] = PDFStr($names[-1]);
2866              
2867 0         0 @{$root->{'Names'}->{$cat}->{'Names'}->{' val'}} = ();
  0         0  
2868              
2869 0         0 foreach my $k (@names) {
2870 0         0 push @{$root->{'Names'}->{$cat}->{'Names'}->{' val'}}, (
2871             PDFStr($k),
2872 0         0 $root->{'Names'}->{$cat}->{'-vals'}->{$k}
2873             );
2874             }
2875              
2876 0         0 return $obj;
2877             }
2878              
2879             1;
2880              
2881             __END__