File Coverage

blib/lib/PDF/API2.pm
Criterion Covered Total %
statement 632 1021 61.9
branch 218 576 37.8
condition 49 206 23.7
subroutine 83 119 69.7
pod 89 95 93.6
total 1071 2017 53.1


line stmt bran cond sub pod time code
1             package PDF::API2;
2              
3 38     38   2681707 use strict;
  38         409  
  38         1401  
4 38     38   227 no warnings qw[ deprecated recursion uninitialized ];
  38         73  
  38         2267  
5              
6             our $VERSION = '2.043'; # VERSION
7              
8 38     38   259 use Carp;
  38         81  
  38         2913  
9 38     38   23327 use Encode qw(:all);
  38         421383  
  38         10532  
10 38     38   20014 use English;
  38         142263  
  38         255  
11 38     38   35360 use FileHandle;
  38         390194  
  38         278  
12              
13 38     38   33282 use PDF::API2::Basic::PDF::Utils;
  38         151  
  38         3355  
14 38     38   18975 use PDF::API2::Util;
  38         136  
  38         6051  
15              
16 38     38   26860 use PDF::API2::Basic::PDF::File;
  38         119  
  38         1889  
17 38     38   351 use PDF::API2::Basic::PDF::Pages;
  38         74  
  38         790  
18 38     38   21306 use PDF::API2::Page;
  38         138  
  38         1802  
19              
20 38     38   19815 use PDF::API2::Resource::XObject::Form::Hybrid;
  38         122  
  38         1563  
21              
22 38     38   18705 use PDF::API2::Resource::ExtGState;
  38         126  
  38         1418  
23 38     38   16902 use PDF::API2::Resource::Pattern;
  38         116  
  38         1256  
24 38     38   15904 use PDF::API2::Resource::Shading;
  38         110  
  38         1247  
25              
26 38     38   16821 use PDF::API2::NamedDestination;
  38         120  
  38         1467  
27              
28 38     38   282 use List::Util qw(max);
  38         83  
  38         2590  
29 38     38   244 use Scalar::Util qw(weaken);
  38         88  
  38         524613  
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 17243 my ($class, %options) = @_;
102              
103 164         398 my $self = {};
104 164         375 bless $self, $class;
105 164         1174 $self->{'pdf'} = PDF::API2::Basic::PDF::File->new();
106              
107 164         590 $self->{'pdf'}->{' version'} = '1.4';
108 164         1012 $self->{'pages'} = PDF::API2::Basic::PDF::Pages->new($self->{'pdf'});
109 164         715 $self->{'pages'}->proc_set(qw(PDF Text ImageB ImageC ImageI));
110 164   33     491 $self->{'pages'}->{'Resources'} ||= PDFDict();
111 164 50       654 $self->{'pdf'}->new_obj($self->{'pages'}->{'Resources'}) unless $self->{'pages'}->{'Resources'}->is_obj($self->{'pdf'});
112 164         408 $self->{'catalog'} = $self->{'pdf'}->{'Root'};
113 164         651 weaken $self->{'catalog'};
114 164         331 $self->{'fonts'} = {};
115 164         397 $self->{'pagestack'} = [];
116              
117             # -compress is deprecated (remove the hyphen)
118 164 100       481 if (exists $options{'-compress'}) {
119 27   33     155 $options{'compress'} //= delete $options{'-compress'};
120             }
121              
122 164 100       414 if (exists $options{'compress'}) {
123 114 50       292 $self->{'forcecompress'} = $options{'compress'} ? 1 : 0;
124             }
125             else {
126 50         131 $self->{'forcecompress'} = 1;
127             }
128 164         1747 $self->preferences(%options);
129              
130             # -file is deprecated (remove the hyphen)
131 164 50 0     493 $options{'file'} //= $options{'-file'} if $options{'-file'};
132              
133 164 50       376 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         590 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title
140             Subject Keywords)];
141              
142 164   50     306 my $version = eval { $PDF::API2::VERSION } || 'Development Version';
143 164         971 $self->producer("PDF::API2 $version ($OSNAME)");
144              
145 164         1135 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 2264 my ($class, $file, %options) = @_;
169 8 50       182 croak "File '$file' does not exist" unless -f $file;
170 8 50       125 croak "File '$file' is not readable" unless -r $file;
171              
172 8         31 my $self = {};
173 8         28 bless $self, $class;
174 8         36 foreach my $parameter (keys %options) {
175 2         12 $self->default($parameter, $options{$parameter});
176             }
177              
178 8         105 my $is_writable = -w $file;
179 8         102 $self->{'pdf'} = PDF::API2::Basic::PDF::File->open($file, $is_writable);
180 8         42 _open_common($self, %options);
181 8         25 $self->{'pdf'}->{' fname'} = $file;
182 8 50       26 $self->{'opened_readonly'} = 1 unless $is_writable;
183              
184 8         109 return $self;
185             }
186              
187             sub _open_common {
188 16     16   53 my ($self, %options) = @_;
189              
190 16         87 $self->{'pdf'}->{'Root'}->realise();
191 16   50     87 $self->{'pdf'}->{' version'} ||= '1.3';
192              
193 16         89 $self->{'pages'} = $self->{'pdf'}->{'Root'}->{'Pages'}->realise();
194 16         107 weaken $self->{'pages'};
195 16         78 my @pages = proc_pages($self->{'pdf'}, $self->{'pages'});
196 16         88 $self->{'pagestack'} = [sort { $a->{' pnum'} <=> $b->{' pnum'} } @pages];
  3         26  
197 16         41 weaken $self->{'pagestack'}->[$_] for (0 .. scalar @{$self->{'pagestack'}});
  16         183  
198              
199 16         58 $self->{'catalog'} = $self->{'pdf'}->{'Root'};
200 16         63 weaken $self->{'catalog'};
201              
202 16         37 $self->{'opened'} = 1;
203              
204             # -compress is deprecated (remove the hyphen)
205 16 100       64 if (exists $options{'-compress'}) {
206 2   33     12 $options{'compress'} //= delete $options{'-compress'};
207             }
208              
209 16 100       58 if (exists $options{'compress'}) {
210 2 50       8 $self->{'forcecompress'} = $options{'compress'} ? 1 : 0;
211             }
212             else {
213 14         41 $self->{'forcecompress'} = 1;
214             }
215 16         59 $self->{'fonts'} = {};
216 16         99 $self->{'infoMeta'} = [qw(Author CreationDate ModDate Creator Producer Title Subject Keywords)];
217 16         47 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 7 my ($self, $file) = @_;
237              
238 1 50 33     9 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       3 croak 'A filename argument is required' unless $file;
252 1 50       6 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       4 croak "File is read-only" if $self->{'opened_readonly'};
257 1         4 $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         7 $self->close();
268              
269 1         9 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 161     161 1 452 sub release { return $_[0]->close() }
313 0     0 1 0 sub end { return $_[0]->close() }
314              
315             sub close {
316 309     309 1 480 my $self = shift();
317 309 100       1293 $self->{'pdf'}->release() if defined $self->{'pdf'};
318              
319 309         819 foreach my $key (keys %$self) {
320 1054         1649 $self->{$key} = undef;
321 1054         1440 delete $self->{$key};
322             }
323              
324 309         876 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 14 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 2475 my ($class, $content, %options) = @_;
352              
353 8         21 my $self = {};
354 8         21 bless $self, $class;
355 8         32 foreach my $parameter (keys %options) {
356 0         0 $self->default($parameter, $options{$parameter});
357             }
358              
359 8         29 $self->{'content_ref'} = \$content;
360 8         26 my $fh;
361 8 50       151 CORE::open($fh, '+<', \$content) or die "Can't begin scalar IO";
362              
363 8         77 $self->{'pdf'} = PDF::API2::Basic::PDF::File->open($fh, 1);
364 8         59 _open_common($self, %options);
365 8         39 $self->{'opened_scalar'} = 1;
366              
367 8         96 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 1206 my $self = shift();
395              
396 147         279 my $string = '';
397 147 100       530 if ($self->{'opened_scalar'}) {
    100          
398 3         15 $self->{'pdf'}->append_file();
399 3         6 $string = ${$self->{'content_ref'}};
  3         20  
400             }
401             elsif ($self->{'opened'}) {
402 4         44 my $fh = FileHandle->new();
403 4 50       344 CORE::open($fh, '>', \$string) || die "Can't begin scalar IO";
404 4         2122 $self->{'pdf'}->clone_file($fh);
405 4         23 $self->{'pdf'}->close_file();
406 4         19 $fh->close();
407             }
408             else {
409 140         828 my $fh = FileHandle->new();
410 140 50   25   7620 CORE::open($fh, '>', \$string) || die "Can't begin scalar IO";
  25         217  
  25         52  
  25         208  
411 140         20816 $self->{'pdf'}->out_file($fh);
412 140         515 $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         1358 $self->close();
418              
419 147         1785 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 300 my $self = shift();
509 169         549 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         5 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   2 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       10 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         11 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       3 if (defined $month) {
571 1 50 33     8 return unless $month >= 1 and $month <= 12;
572             }
573 1 50       3 if (defined $day) {
574 1 50 33     6 return unless $day >= 1 and $day <= 31;
575             }
576 1 50       4 if (defined $hour) {
577 1 50       6 return unless $hour <= 23;
578             }
579 1 50       5 if (defined $minute) {
580 1 50       2 return unless $minute <= 59;
581             }
582 1 50       4 if (defined $second) {
583 1 50       3 return unless $second <= 59;
584             }
585 1 50       2 if (defined $od) {
586 1 50 33     10 return if $od eq 'Z' and defined($oh);
587             }
588 1 50       5 if (defined $oh) {
589 0 0       0 return unless $oh <= 23;
590             }
591 1 50       5 if (defined $om) {
592 0 0       0 return unless $om <= 59;
593             }
594              
595 1         4 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 300 my $self = shift();
619 170         266 my $field = shift();
620              
621             # Return a hash of the Info table if called without arguments
622 170 50       403 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       439 if (@_) {
636 167         252 my $value = shift();
637 167 50 66     804 $value = undef if defined($value) and not length($value);
638              
639 167 100 66     717 if ($field eq 'CreationDate' or $field eq 'ModDate') {
640 1 50       4 if (defined ($value)) {
641 1 50       8 $value = 'D:' . $value unless $value =~ /^D:/;
642 1 50       4 croak "Invalid date string: $value" unless _is_date($value);
643             }
644             }
645              
646 167 100       441 unless (exists $self->{'pdf'}->{'Info'}) {
647 164 50       2201 return $self unless defined $value;
648 164         3358 $self->{'pdf'}->{'Info'} = PDFDict();
649 164         612 $self->{'pdf'}->new_obj($self->{'pdf'}->{'Info'});
650             }
651             else {
652 3         10 $self->{'pdf'}->{'Info'}->realise();
653             }
654              
655 167 100       398 if (defined $value) {
656 166         456 $self->{'pdf'}->{'Info'}->{$field} = PDFStr($value);
657             }
658             else {
659 1         3 delete $self->{'pdf'}->{'Info'}->{$field};
660             }
661              
662 167         372 return $self;
663             }
664              
665             # Get
666 3 50       8 return unless $self->{'pdf'}->{'Info'};
667 3         14 $self->{'pdf'}->{'Info'}->realise();
668 3 100       12 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 20 my ($self, %opt) = @_;
675              
676 3 50       9 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       7 if (scalar @_) {
687 3         5 foreach my $k (@{$self->{'infoMeta'}}) {
  3         7  
688 24 100       55 next unless defined $opt{$k};
689 1   50     5 $self->{'pdf'}->{'Info'}->{$k} = PDFStr($opt{$k} || 'NONE');
690             }
691 3         17 $self->{'pdf'}->out_obj($self->{'pdf'}->{'Info'});
692             }
693              
694 3 50       10 if (defined $self->{'pdf'}->{'Info'}) {
695 3         7 %opt = ();
696 3         4 foreach my $k (@{$self->{'infoMeta'}}) {
  3         6  
697 24 100       48 next unless defined $self->{'pdf'}->{'Info'}->{$k};
698 3         13 $opt{$k} = $self->{'pdf'}->{'Info'}->{$k}->val();
699 3 50 33     28 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         14 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 25 my $self = shift();
782 5         19 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 24 sub outlines { return outline(@_) }
816              
817             sub outline {
818 4     4 1 8 my $self = shift();
819              
820 4         529 require PDF::API2::Outlines;
821 4         12 my $obj = $self->{'pdf'}->{'Root'}->{'Outlines'};
822 4 100       9 if ($obj) {
823 1         4 $obj->realise();
824 1         5 bless $obj, 'PDF::API2::Outlines';
825 1         3 $obj->{' api'} = $self;
826 1         3 weaken $obj->{' api'};
827             }
828             else {
829 3         15 $obj = PDF::API2::Outlines->new($self);
830              
831 3         6 $self->{'pdf'}->{'Root'}->{'Outlines'} = $obj;
832 3 50       23 $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         18 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 6 my ($self, $page, @args) = @_;
854              
855             # $page can be either a page number or a page object
856 2 100       7 $page = PDFNum($page) unless ref($page);
857              
858 2         9 require PDF::API2::NamedDestination;
859 2         8 my $array = PDF::API2::NamedDestination::_destination($page, @args);
860 2         4 $self->{'catalog'}->{'OpenAction'} = $array;
861 2         7 $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 310 my $self = shift();
906              
907 169 50       407 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     415 my $name = shift() // 'single_page';
921 169 0       433 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       416 croak "Invalid page layout: $name" unless $layout;
929 169         406 $self->{'catalog'}->{'PageMode'} = PDFName($layout);
930 169         586 $self->{'pdf'}->out_obj($self->{'catalog'});
931 169         292 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 293 my $self = shift();
980              
981 169 50       432 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     432 my $name = shift() // 'none';
995 169 0       451 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       383 croak "Invalid page mode: $name" unless $mode;
1003 169         482 $self->{'catalog'}->{'PageMode'} = PDFName($mode);
1004 169         671 $self->{'pdf'}->out_obj($self->{'catalog'});
1005 169         304 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 283 my $self = shift();
1023 172         16902 require PDF::API2::ViewerPreferences;
1024 172         1003 my $prefs = PDF::API2::ViewerPreferences->new($self);
1025 172 50       497 unless (@_) {
1026 0         0 return $prefs->get_preferences();
1027             }
1028 172         572 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 507 my ($self, %options) = @_;
1034              
1035             # Page Mode Options
1036 169 50       679 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         487 $self->page_mode('none');
1047             }
1048              
1049             # Page Layout Options
1050 169 50       780 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         464 $self->page_layout('single_page');
1064             }
1065              
1066             # Viewer Preferences
1067 169 50       452 if ($options{'-hidetoolbar'}) {
1068 0         0 $self->viewer_preferences(hide_toolbar => 1);
1069             }
1070 169 50       432 if ($options{'-hidemenubar'}) {
1071 0         0 $self->viewer_preferences(hide_menubar => 1);
1072             }
1073 169 50       369 if ($options{'-hidewindowui'}) {
1074 0         0 $self->viewer_preferences(hide_window_ui => 1);
1075             }
1076 169 50       386 if ($options{'-fitwindow'}) {
1077 0         0 $self->viewer_preferences(fit_window => 1);
1078             }
1079 169 50       369 if ($options{'-centerwindow'}) {
1080 0         0 $self->viewer_preferences(center_window => 1);
1081             }
1082 169 50       396 if ($options{'-displaytitle'}) {
1083 0         0 $self->viewer_preferences(display_doc_title => 1);
1084             }
1085 169 50       387 if ($options{'-righttoleft'}) {
1086 0         0 $self->viewer_preferences(direction => 'r2l');
1087             }
1088              
1089 169 50       528 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         462 $self->viewer_preferences(non_full_screen_page_mode => 'none');
1097             }
1098              
1099 169 50       479 if ($options{'-printscalingnone'}) {
1100 0         0 $self->viewer_preferences(print_scaling => 'none');
1101             }
1102              
1103 169 100       609 if ($options{'-simplex'}) {
    100          
    100          
1104 1         12 $self->viewer_preferences(duplex => 'simplex');
1105             }
1106             elsif ($options{'-duplexfliplongedge'}) {
1107 1         4 $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       374 if ($options{'-firstpage'}) {
1115 2         4 my ($page, %args) = @{$options{'-firstpage'}};
  2         5  
1116 2 50       4 $args{'-fit'} = 1 unless keys %args;
1117              
1118 2 50       5 if (defined $args{'-fit'}) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
1119 2         14 $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         560 $self->{'pdf'}->out_obj($self->{'catalog'});
1144              
1145 169         307 return $self;
1146             }
1147              
1148             sub proc_pages {
1149 16     16 0 52 my ($pdf, $object) = @_;
1150              
1151 16 50       64 if (defined $object->{'Resources'}) {
1152 16         36 eval {
1153 16         52 $object->{'Resources'}->realise();
1154             };
1155             }
1156              
1157 16         50 my @pages;
1158 16   50     103 $pdf->{' apipagecount'} ||= 0;
1159 16         71 foreach my $page ($object->{'Kids'}->elements()) {
1160 18         67 $page->realise();
1161 18 50       76 if ($page->{'Type'}->val() eq 'Pages') {
1162 0         0 push @pages, proc_pages($pdf, $page);
1163             }
1164             else {
1165 18         39 $pdf->{' apipagecount'}++;
1166 18         48 $page->{' pnum'} = $pdf->{' apipagecount'};
1167 18 50       56 if (defined $page->{'Resources'}) {
1168 18         41 eval {
1169 18         94 $page->{'Resources'}->realise();
1170             };
1171             }
1172 18         72 push @pages, $page;
1173             }
1174             }
1175              
1176 16         70 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 21146 my $self = shift();
1200 142   100     534 my $index = shift() || 0;
1201 142         212 my $page;
1202 142 100       342 if ($index == 0) {
1203 140         825 $page = PDF::API2::Page->new($self->{'pdf'}, $self->{'pages'});
1204             }
1205             else {
1206 2         13 $page = PDF::API2::Page->new($self->{'pdf'}, $self->{'pages'}, $index - 1);
1207             }
1208 142         327 $page->{' apipdf'} = $self->{'pdf'};
1209 142         299 $page->{' api'} = $self;
1210 142         483 weaken $page->{' apipdf'};
1211 142         340 weaken $page->{' api'};
1212 142         436 $self->{'pdf'}->out_obj($page);
1213 142         419 $self->{'pdf'}->out_obj($self->{'pages'});
1214 142 100       364 if ($index == 0) {
    50          
1215 140         253 push @{$self->{'pagestack'}}, $page;
  140         320  
1216 140         442 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         6 splice @{$self->{'pagestack'}}, $index - 1, 0, $page;
  2         7  
1224 2         8 weaken $self->{'pagestack'}->[$index - 1];
1225             }
1226             # $page->{'Resources'} = $self->{'pages'}->{'Resources'};
1227 142         688 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 11 sub openpage { return open_page(@_); } ## no critic
1242              
1243             sub open_page {
1244 6     6 1 17 my $self = shift();
1245 6   50     19 my $index = shift() || 0;
1246 6         27 my ($page, $rotate, $media, $trans);
1247              
1248 6 50       28 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         40 $page = $self->{'pagestack'}->[$index - 1];
1256             }
1257 6 50       24 return unless ref($page);
1258              
1259 6 100       24 if (ref($page) ne 'PDF::API2::Page') {
1260 5         24 bless $page, 'PDF::API2::Page';
1261 5         14 $page->{' apipdf'} = $self->{'pdf'};
1262 5         13 $page->{' api'} = $self;
1263 5         23 weaken $page->{' apipdf'};
1264 5         25 weaken $page->{' api'};
1265 5         25 $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         19 $trans = '';
1299             }
1300              
1301 5 100 66     55 if (defined $page->{'Contents'} and not $page->{' opened'}) {
1302 3         14 $page->fixcontents();
1303 3         8 my $uncontent = delete $page->{'Contents'};
1304 3         15 my $content = $page->gfx();
1305 3         21 $content->add(" $trans ");
1306              
1307 3 50       18 if ($self->default('pageencaps')) {
1308 0         0 $content->{' stream'} .= ' q ';
1309             }
1310 3         15 foreach my $k ($uncontent->elements()) {
1311 3         12 $k->realise();
1312 3         21 $content->{' stream'} .= ' ' . unfilter($k->{'Filter'}, $k->{' stream'}) . ' ';
1313             }
1314 3 50       17 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       13 if ($self->{'forcecompress'}) {
1320 3         18 $content->{' stream'} = dofilter($content->{'Filter'}, $content->{' stream'});
1321 3         15 $content->{' nofilt'} = 1;
1322 3         9 delete $content->{'-docompress'};
1323 3         16 $content->{'Length'} = PDFNum(length($content->{' stream'}));
1324             }
1325             }
1326 5         50 $page->{' opened'} = 1;
1327             }
1328              
1329 6         89 $self->{'pdf'}->out_obj($page);
1330 6         32 $self->{'pdf'}->out_obj($self->{'pages'});
1331 6         17 $page->{' apipdf'} = $self->{'pdf'};
1332 6         26 $page->{' api'} = $self;
1333 6         26 weaken $page->{' apipdf'};
1334 6         18 weaken $page->{' api'};
1335 6         18 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 or -1, the last page in the
1346             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 4 my ($self, $s_pdf, $s_idx, $t_idx) = @_;
1371 1   50     8 $s_idx ||= 0;
1372 1   50     9 $t_idx ||= 0;
1373 1         2 my ($s_page, $t_page);
1374              
1375 1 50 33     39 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       6 if (ref($s_idx) eq 'PDF::API2::Page') {
1380 0         0 $s_page = $s_idx;
1381             }
1382             else {
1383 1         5 $s_page = $s_pdf->open_page($s_idx);
1384             }
1385              
1386 1 50       6 if (ref($t_idx) eq 'PDF::API2::Page') {
1387 0         0 $t_page = $t_idx;
1388             }
1389             else {
1390 1 50       6 if ($self->pages() < $t_idx) {
1391 0         0 $t_page = $self->page();
1392             }
1393             else {
1394 1         7 $t_page = $self->page($t_idx);
1395             }
1396             }
1397              
1398 1   50     11 $self->{'apiimportcache'} = $self->{'apiimportcache'} || {};
1399 1   50     19 $self->{'apiimportcache'}->{$s_pdf} = $self->{'apiimportcache'}->{$s_pdf} || {};
1400              
1401             # we now import into a form to keep
1402             # all that nasty resources from polluting
1403             # our very own resource naming space.
1404 1         7 my $xo = $self->importPageIntoForm($s_pdf, $s_page);
1405              
1406             # copy all page dimensions
1407 1         4 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) {
1408 5         14 my $prop = $s_page->find_prop($k);
1409 5 50       13 next unless defined $prop;
1410              
1411 0         0 my $box = walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $prop);
1412 0         0 my $method = lc $k;
1413              
1414 0         0 $t_page->$method(map { $_->val() } $box->elements());
  0         0  
1415             }
1416              
1417 1         6 $t_page->gfx->formimage($xo, 0, 0, 1);
1418              
1419             # copy annotations and/or form elements as well
1420 1 0 33     5 if (exists $s_page->{'Annots'} and $s_page->{'Annots'} and $self->{'copyannots'}) {
      0        
1421             # first set up the AcroForm, if required
1422 0         0 my $AcroForm;
1423 0 0       0 if (my $a = $s_pdf->{'pdf'}->{'Root'}->realise->{'AcroForm'}) {
1424 0         0 $a->realise();
1425              
1426 0         0 $AcroForm = walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a, qw(NeedAppearances SigFlags CO DR DA Q));
1427             }
1428 0         0 my @Fields = ();
1429 0         0 my @Annots = ();
1430 0         0 foreach my $a ($s_page->{'Annots'}->elements()) {
1431 0         0 $a->realise();
1432 0         0 my $t_a = PDFDict();
1433 0         0 $self->{'pdf'}->new_obj($t_a);
1434             # these objects are likely to be both annotations and Acroform fields
1435             # key names are copied from PDF Reference 1.4 (Tables)
1436 0         0 my @k = (
1437             qw( Type Subtype Contents P Rect NM M F BS Border AP AS C CA T Popup A AA StructParent Rotate
1438             ), # Annotations - Common (8.10)
1439             qw( Subtype Contents Open Name ), # Text Annotations (8.15)
1440             qw( Subtype Contents Dest H PA ), # Link Annotations (8.16)
1441             qw( Subtype Contents DA Q ), # Free Text Annotations (8.17)
1442             qw( Subtype Contents L BS LE IC ) , # Line Annotations (8.18)
1443             qw( Subtype Contents BS IC ), # Square and Circle Annotations (8.20)
1444             qw( Subtype Contents QuadPoints ), # Markup Annotations (8.21)
1445             qw( Subtype Contents Name ), # Rubber Stamp Annotations (8.22)
1446             qw( Subtype Contents InkList BS ), # Ink Annotations (8.23)
1447             qw( Subtype Contents Parent Open ), # Popup Annotations (8.24)
1448             qw( Subtype FS Contents Name ), # File Attachment Annotations (8.25)
1449             qw( Subtype Sound Contents Name ), # Sound Annotations (8.26)
1450             qw( Subtype Movie Contents A ), # Movie Annotations (8.27)
1451             qw( Subtype Contents H MK ), # Widget Annotations (8.28)
1452             # Printers Mark Annotations (none)
1453             # Trap Network Annotations (none)
1454             );
1455              
1456 0 0       0 push @k, (
1457             qw( Subtype FT Parent Kids T TU TM Ff V DV AA
1458             ), # Fields - Common (8.49)
1459             qw( DR DA Q ), # Fields containing variable text (8.51)
1460             qw( Opt ), # Checkbox field (8.54)
1461             qw( Opt ), # Radio field (8.55)
1462             qw( MaxLen ), # Text field (8.57)
1463             qw( Opt TI I ), # Choice field (8.59)
1464             ) if $AcroForm;
1465              
1466             # sorting out dups
1467 0         0 my %ky = map { $_ => 1 } @k;
  0         0  
1468             # we do P separately, as it points to the page the Annotation is on
1469 0         0 delete $ky{'P'};
1470             # copy everything else
1471 0         0 foreach my $k (keys %ky) {
1472 0 0       0 next unless defined $a->{$k};
1473 0         0 $a->{$k}->realise();
1474 0         0 $t_a->{$k} = walk_obj({}, $s_pdf->{'pdf'}, $self->{'pdf'}, $a->{$k});
1475             }
1476 0         0 $t_a->{'P'} = $t_page;
1477 0         0 push @Annots, $t_a;
1478 0 0 0     0 push @Fields, $t_a if ($AcroForm and $t_a->{'Subtype'}->val() eq 'Widget');
1479             }
1480 0         0 $t_page->{'Annots'} = PDFArray(@Annots);
1481 0 0       0 $AcroForm->{'Fields'} = PDFArray(@Fields) if $AcroForm;
1482 0         0 $self->{'pdf'}->{'Root'}->{'AcroForm'} = $AcroForm;
1483             }
1484 1         217 $t_page->{' imported'} = 1;
1485              
1486 1         144 $self->{'pdf'}->out_obj($t_page);
1487 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
1488              
1489 1         6 return $t_page;
1490             }
1491              
1492             =head2 embed_page
1493              
1494             $xobject = $pdf->embed_page($source_pdf, $source_page_number);
1495              
1496             Returns a Form XObject created by extracting the specified page from a
1497             C<$source_pdf>.
1498              
1499             This is useful if you want to transpose the imported page somewhat differently
1500             onto a page (e.g. two-up, four-up, etc.).
1501              
1502             If $source_page_number is 0 or -1, it will return the last page in the document.
1503              
1504             B
1505              
1506             my $pdf = PDF::API2->new();
1507             my $source = PDF::API2->open('source.pdf');
1508             my $page = $pdf->page();
1509              
1510             # Import Page 2 from the source PDF
1511             my $object = $pdf->embed_page($source, 2);
1512              
1513             # Add it to the new PDF's first page at 1/2 scale
1514             my ($x, $y) = (0, 0);
1515             $page->object($object, $x, $y, 0.5);
1516              
1517             $pdf->save('sample.pdf');
1518              
1519             B You can only import a page from an existing PDF file.
1520              
1521             =cut
1522              
1523             # Deprecated (renamed)
1524 4     4 1 34 sub importPageIntoForm { return embed_page(@_) }
1525              
1526             sub embed_page {
1527 4     4 1 11 my ($self, $s_pdf, $s_idx) = @_;
1528 4   50     16 $s_idx ||= 0;
1529              
1530 4 50 33     47 unless (ref($s_pdf) and $s_pdf->isa('PDF::API2')) {
1531 0         0 die "Invalid usage: first argument must be PDF::API2 instance, not: " . ref($s_pdf);
1532             }
1533              
1534 4         11 my ($s_page, $xo);
1535              
1536 4         21 $xo = $self->xo_form();
1537              
1538 4 100       17 if (ref($s_idx) eq 'PDF::API2::Page') {
1539 1         2 $s_page = $s_idx;
1540             }
1541             else {
1542 3         14 $s_page = $s_pdf->open_page($s_idx);
1543             }
1544              
1545 4   100     27 $self->{'apiimportcache'} ||= {};
1546 4   100     24 $self->{'apiimportcache'}->{$s_pdf} ||= {};
1547              
1548             # This should never get past MediaBox, since it's a required object.
1549 4         14 foreach my $k (qw(MediaBox ArtBox TrimBox BleedBox CropBox)) {
1550             # next unless defined $s_page->{$k};
1551             # my $box = walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k});
1552 12 100       28 next unless defined $s_page->find_prop($k);
1553 2         20 my $box = walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->find_prop($k));
1554 2         12 $xo->bbox(map { $_->val() } $box->elements());
  8         15  
1555 2         6 last;
1556             }
1557 4 100       33 $xo->bbox(0, 0, 612, 792) unless defined $xo->{'BBox'};
1558              
1559 4         20 foreach my $k (qw(Resources)) {
1560 4         25 $s_page->{$k} = $s_page->find_prop($k);
1561 4 50       18 next unless defined $s_page->{$k};
1562 4 50       32 $s_page->{$k}->realise() if ref($s_page->{$k}) =~ /Objind$/;
1563              
1564 4         44 foreach my $sk (qw(XObject ExtGState Font ProcSet Properties ColorSpace Pattern Shading)) {
1565 32 100       76 next unless defined $s_page->{$k}->{$sk};
1566 5 50       23 $s_page->{$k}->{$sk}->realise() if ref($s_page->{$k}->{$sk}) =~ /Objind$/;
1567 5         10 foreach my $ssk (keys %{$s_page->{$k}->{$sk}}) {
  5         42  
1568 10 100       43 next if $ssk =~ /^ /;
1569 1         9 $xo->resource($sk, $ssk, walk_obj($self->{'apiimportcache'}->{$s_pdf}, $s_pdf->{'pdf'}, $self->{'pdf'}, $s_page->{$k}->{$sk}->{$ssk}));
1570             }
1571             }
1572             }
1573              
1574             # create a whole content stream
1575             ## technically it is possible to submit an unfinished
1576             ## (eg. newly created) source-page, but that's nonsense,
1577             ## so we expect a page fixed by open_page and die otherwise
1578 4 50       14 unless ($s_page->{' opened'}) {
1579 0         0 croak join(' ',
1580             "Pages may only be imported from a complete PDF.",
1581             "Save and reopen the source PDF object first");
1582             }
1583              
1584 4 100       17 if (defined $s_page->{'Contents'}) {
1585 3         17 $s_page->fixcontents();
1586              
1587 3         8 $xo->{' stream'} = '';
1588             # open_page pages only contain one stream
1589 3         31 my ($k) = $s_page->{'Contents'}->elements();
1590 3         22 $k->realise();
1591 3 50       13 if ($k->{' nofilt'}) {
1592             # we have a finished stream here so we unfilter
1593 3         24 $xo->add('q', unfilter($k->{'Filter'}, $k->{' stream'}), 'Q');
1594             }
1595             else {
1596             # stream is an unfinished/unfiltered content
1597             # so we just copy it and add the required "qQ"
1598 0         0 $xo->add('q', $k->{' stream'}, 'Q');
1599             }
1600 3 50       21 $xo->compressFlate() if $self->{'forcecompress'};
1601             }
1602              
1603 4         30 return $xo;
1604             }
1605              
1606             # Used by embed_page and import_page
1607             sub walk_obj {
1608 16     16 0 32 my ($object_cache, $source_pdf, $target_pdf, $source_object, @keys) = @_;
1609              
1610 16 100       41 if (ref($source_object) =~ /Objind$/) {
1611 1         3 $source_object->realise();
1612             }
1613              
1614 16 50       39 return $object_cache->{scalar $source_object} if defined $object_cache->{scalar $source_object};
1615             # die "infinite loop while copying objects" if $source_object->{' copied'};
1616              
1617 16         39 my $target_object = $source_object->copy($source_pdf); ## thanks to: yaheath // Fri, 17 Sep 2004
1618              
1619             # $source_object->{' copied'} = 1;
1620 16 100       37 $target_pdf->new_obj($target_object) if $source_object->is_obj($source_pdf);
1621              
1622 16         45 $object_cache->{scalar $source_object} = $target_object;
1623              
1624 16 100       69 if (ref($source_object) =~ /Array$/) {
    100          
1625 2         12 $target_object->{' val'} = [];
1626 2         9 foreach my $k ($source_object->elements()) {
1627 8 50       24 $k->realise() if ref($k) =~ /Objind$/;
1628 8         21 $target_object->add_elements(walk_obj($object_cache, $source_pdf, $target_pdf, $k));
1629             }
1630             }
1631             elsif (ref($source_object) =~ /Dict$/) {
1632 1 50       8 @keys = keys(%$target_object) unless scalar @keys;
1633 1         4 foreach my $k (@keys) {
1634 6 100       15 next if $k =~ /^ /;
1635 5 50       10 next unless defined $source_object->{$k};
1636 5         10 $target_object->{$k} = walk_obj($object_cache, $source_pdf, $target_pdf, $source_object->{$k});
1637             }
1638 1 50       3 if ($source_object->{' stream'}) {
1639 0 0       0 if ($target_object->{'Filter'}) {
1640 0         0 $target_object->{' nofilt'} = 1;
1641             }
1642             else {
1643 0         0 delete $target_object->{' nofilt'};
1644 0         0 $target_object->{'Filter'} = PDFArray(PDFName('FlateDecode'));
1645             }
1646 0         0 $target_object->{' stream'} = $source_object->{' stream'};
1647             }
1648             }
1649 16         23 delete $target_object->{' streamloc'};
1650 16         19 delete $target_object->{' streamsrc'};
1651              
1652 16         49 return $target_object;
1653             }
1654              
1655             =head2 page_count
1656              
1657             $integer = $pdf->page_count();
1658              
1659             Return the number of pages in the document.
1660              
1661             =cut
1662              
1663             # Deprecated (renamed)
1664 3     3 1 415 sub pages { return page_count(@_) }
1665              
1666             sub page_count {
1667 3     3 1 6 my $self = shift();
1668 3         5 return scalar @{$self->{'pagestack'}};
  3         17  
1669             }
1670              
1671             =head2 page_labels
1672              
1673             $pdf = $pdf->page_labels($page_number, %options);
1674              
1675             Describes how pages should be numbered beginning at the specified page number.
1676              
1677             # Generate a 30-page PDF
1678             my $pdf = PDF::API2->new();
1679             $pdf->page() for 1..30;
1680              
1681             # Number pages i to v, 1 to 20, and A-1 to A-5, respectively
1682             $pdf->page_labels(1, style => 'roman');
1683             $pdf->page_labels(6, style => 'decimal');
1684             $pdf->page_labels(26, style => 'decimal', prefix => 'A-');
1685              
1686             $pdf->save('sample.pdf');
1687              
1688             The following options are available:
1689              
1690             =over
1691              
1692             =item * style
1693              
1694             One of C (standard decimal arabic numerals), C (uppercase roman
1695             numerals), C (lowercase roman numerals), C (uppercase letters),
1696             or C (lowercase letters).
1697              
1698             There is no default numbering style. If omitted, the page label will be just
1699             the prefix (if set) or an empty string.
1700              
1701             =item * prefix
1702              
1703             The label prefix for pages in this range.
1704              
1705             =item * start
1706              
1707             An integer (default: 1) representing the first value to be used in this page
1708             range.
1709              
1710             =back
1711              
1712             =cut
1713              
1714             # Deprecated; replace with page_labels, updating arguments as shown
1715             sub pageLabel {
1716 8     8 1 80 my $self = shift();
1717 8         24 while (@_) {
1718 8         13 my $page_index = shift();
1719              
1720             # Pass options as a hash rather than a hashref
1721 8   50     14 my %options = %{shift() // {}};
  8         39  
1722              
1723             # Remove leading hyphens from option names
1724 8 100       25 if (exists $options{'-prefix'}) {
1725 1         3 $options{'prefix'} = delete $options{'-prefix'};
1726             }
1727 8 100       23 if (exists $options{'-start'}) {
1728 1         4 $options{'start'} = delete $options{'-start'};
1729             }
1730 8 100       20 if (exists $options{'-style'}) {
1731 6         15 $options{'style'} = delete $options{'-style'};
1732 6 100       34 unless ($options{'style'} =~ /^(?:[Rr]oman|[Aa]lpha|decimal)$/) {
1733 1         165 carp "Invalid -style for page labels; defaulting to decimal";
1734 1         89 $options{'style'} = 'decimal';
1735             }
1736             }
1737              
1738             # page_labels doesn't have a default numbering style, to be consistent
1739             # with the spec.
1740 8   100     29 $options{'style'} //= 'D';
1741              
1742             # Set one set of page labels at a time (support for multiple sets of
1743             # page labels by pageLabel was undocumented). Switch from 0-based to
1744             # 1-based numbering.
1745 8         29 $self->page_labels($page_index + 1, %options);
1746             }
1747              
1748             # Return nothing (page_labels returns $self, matching other setters)
1749 8         18 return;
1750             }
1751              
1752             sub page_labels {
1753 8     8 1 23 my ($self, $page_number, %options) = @_;
1754              
1755             # $page_number is 1-based in order to be consistent with other PDF::API2
1756             # methods, but the page label numbering is 0-based.
1757 8         16 my $page_index = $page_number - 1;
1758              
1759 8   33     40 $self->{'catalog'}->{'PageLabels'} //= PDFDict();
1760 8   33     43 $self->{'catalog'}->{'PageLabels'}->{'Nums'} //= PDFArray();
1761              
1762 8         16 my $nums = $self->{'catalog'}->{'PageLabels'}->{'Nums'};
1763 8         20 $nums->add_elements(PDFNum($page_index));
1764              
1765 8         20 my $d = PDFDict();
1766 8 50       22 if (exists $options{'style'}) {
1767 8 50 33     50 unless ($options{'style'} and $options{'style'} =~ /^([rad])/i) {
1768 0         0 croak 'Invalid page numbering style';
1769             }
1770 8 100       39 $d->{'S'} = PDFName($1 eq 'd' ? 'D' : $1);
1771             }
1772              
1773 8 100       22 if (exists $options{'prefix'}) {
1774 1   50     13 $d->{'P'} = PDFStr($options{'prefix'} // '');
1775             }
1776              
1777 8 100       22 if (exists $options{'start'}) {
1778 1   50     6 $d->{'St'} = PDFNum($options{'start'} // '');
1779             }
1780              
1781 8         24 $nums->add_elements($d);
1782              
1783 8         33 return $self;
1784             }
1785              
1786             =head2 default_page_size
1787              
1788             # Set
1789             $pdf->default_page_size($size);
1790              
1791             # Get
1792             @rectangle = $pdf->default_page_size()
1793              
1794             Set the default physical size for pages in the PDF. If called without
1795             arguments, return the coordinates of the rectangle describing the default
1796             physical page size.
1797              
1798             See L for possible values.
1799              
1800             =cut
1801              
1802             sub default_page_size {
1803 1     1 1 2612 my $self = shift();
1804              
1805             # Set
1806 1 50       5 if (@_) {
1807 1         4 return $self->default_page_boundaries(media => @_);
1808             }
1809              
1810             # Get
1811 0         0 my $boundaries = $self->default_page_boundaries();
1812 0         0 return @{$boundaries->{'media'}};
  0         0  
1813             }
1814              
1815             =head2 default_page_boundaries
1816              
1817             # Set
1818             $pdf->default_page_boundaries(%boundaries);
1819              
1820             # Get
1821             %boundaries = $pdf->default_page_boundaries();
1822              
1823             Set default prepress page boundaries for pages in the PDF. If called without
1824             arguments, returns the coordinates of the rectangles describing each of the
1825             supported page boundaries.
1826              
1827             See the equivalent C method in L for details.
1828              
1829             =cut
1830              
1831             # Called by PDF::API2::Page::boundaries via the default_page_* methods below
1832             sub _bounding_box {
1833 17     17   2620 my $self = shift();
1834 17         30 my $type = shift();
1835              
1836             # Get
1837 17 100       41 unless (scalar @_) {
1838 6 100       17 unless ($self->{'pages'}->{$type}) {
1839 1 50       8 return if $type eq 'MediaBox';
1840              
1841             # Use defaults per PDF 1.7 section 14.11.2 Page Boundaries
1842 0 0       0 return $self->_bounding_box('MediaBox') if $type eq 'CropBox';
1843 0         0 return $self->_bounding_box('CropBox');
1844             }
1845 5         18 return map { $_->val() } $self->{'pages'}->{$type}->elements();
  20         44  
1846             }
1847              
1848             # Set
1849 11         27 $self->{'pages'}->{$type} = PDFArray(map { PDFNum(float($_)) } @_);
  44         92  
1850 11         26 return $self;
1851             }
1852              
1853             sub default_page_boundaries {
1854 3     3 1 5159 return PDF::API2::Page::boundaries(@_);
1855             }
1856              
1857             # Deprecated; use default_page_size or default_page_boundaries
1858             sub mediabox {
1859 5     5 1 20 my $self = shift();
1860 5 100       19 return $self->_bounding_box('MediaBox') unless @_;
1861 3         14 return $self->_bounding_box('MediaBox', page_size(@_));
1862             }
1863              
1864             # Deprecated; use default_page_boundaries
1865             sub cropbox {
1866 1     1 1 3269 my $self = shift();
1867 1 50       5 return $self->_bounding_box('CropBox') unless @_;
1868 1         5 return $self->_bounding_box('CropBox', page_size(@_));
1869             }
1870              
1871             # Deprecated; use default_page_boundaries
1872             sub bleedbox {
1873 1     1 1 2603 my $self = shift();
1874 1 50       4 return $self->_bounding_box('BleedBox') unless @_;
1875 1         6 return $self->_bounding_box('BleedBox', page_size(@_));
1876             }
1877              
1878             # Deprecated; use default_page_boundaries
1879             sub trimbox {
1880 1     1 1 2568 my $self = shift();
1881 1 50       6 return $self->_bounding_box('TrimBox') unless @_;
1882 1         5 return $self->_bounding_box('TrimBox', page_size(@_));
1883             }
1884              
1885             # Deprecated; use default_page_boundaries
1886             sub artbox {
1887 1     1 1 2638 my $self = shift();
1888 1 50       5 return $self->_bounding_box('ArtBox') unless @_;
1889 1         5 return $self->_bounding_box('ArtBox', page_size(@_));
1890             }
1891              
1892             =head1 FONT METHODS
1893              
1894             =head2 font
1895              
1896             my $font = $pdf->font($name, %options)
1897              
1898             Add a font to the PDF. Returns the font object, to be used by
1899             L.
1900              
1901             The font C<$name> is either the name of one of the L
1902             fonts|PDF::API2::Resource::Font::CoreFont/"STANDARD FONTS"> (e.g. Helvetica) or
1903             the path to a font file.
1904              
1905             my $pdf = PDF::API2->new();
1906             my $font1 = $pdf->font('Helvetica-Bold');
1907             my $font2 = $pdf->font('/path/to/ComicSans.ttf');
1908             my $page = $pdf->page();
1909             my $content = $page->text();
1910              
1911             $content->position(1 * 72, 9 * 72);
1912             $content->font($font1, 24);
1913             $content->text('Hello, World!');
1914              
1915             $content->position(0, -36);
1916             $content->font($font2, 12);
1917             $content->text('This is some sample text.');
1918              
1919             $pdf->save('sample.pdf');
1920              
1921             The path can be omitted if the font file is in the current directory or one of
1922             the directories returned by C.
1923              
1924             TrueType (ttf/otf), Adobe PostScript Type 1 (pfa/pfb), and Adobe Glyph Bitmap
1925             Distribution Format (bdf) fonts are supported.
1926              
1927             The following C<%options> are available:
1928              
1929             =over
1930              
1931             =item * format
1932              
1933             The font format is normally detected automatically based on the file's
1934             extension. If you're using a font with an atypical extension, you can set
1935             C to one of C (TrueType or OpenType), C (PostScript
1936             Type 1), or C (Adobe Bitmap).
1937              
1938             =item * kerning
1939              
1940             Kerning (automatic adjustment of space between pairs of characters) is enabled
1941             by default if the font includes this information. Set this option to false to
1942             disable.
1943              
1944             =item * afm_file (PostScript Type 1 fonts only)
1945              
1946             Specifies the location of the font metrics file.
1947              
1948             =item * pfm_file (PostScript Type 1 fonts only)
1949              
1950             Specifies the location of the printer font metrics file. This option overrides
1951             the -encode option.
1952              
1953             =item * embed (TrueType fonts only)
1954              
1955             Fonts are embedded in the PDF by default, which is required to ensure that they
1956             can be viewed properly on a device that doesn't have the font installed. Set
1957             this option to false to prevent the font from being embedded.
1958              
1959             =back
1960              
1961             =cut
1962              
1963             sub font {
1964 1     1 1 12 my ($self, $name, %options) = @_;
1965              
1966 1 50       4 if (exists $options{'kerning'}) {
1967 0         0 $options{'-dokern'} = delete $options{'kerning'};
1968             }
1969              
1970 1         1013 require PDF::API2::Resource::Font::CoreFont;
1971 1 50       10 if (PDF::API2::Resource::Font::CoreFont->is_standard($name)) {
1972 1         7 return $self->corefont($name, %options);
1973             }
1974              
1975 0         0 my $format = $options{'format'};
1976 0 0 0     0 $format //= ($name =~ /\.[ot]tf$/i ? 'truetype' :
    0          
    0          
1977             $name =~ /\.pf[ab]$/i ? 'type1' :
1978             $name =~ /\.bdf$/i ? 'bitmap' : '');
1979              
1980 0 0       0 if ($format eq 'truetype') {
    0          
    0          
    0          
    0          
1981 0   0     0 $options{'embed'} //= 1;
1982 0         0 return $self->ttfont($name, %options);
1983             }
1984             elsif ($format eq 'type1') {
1985 0 0       0 if (exists $options{'afm_file'}) {
1986 0         0 $options{'-afmfile'} = delete $options{'afm_file'};
1987             }
1988 0 0       0 if (exists $options{'pfm_file'}) {
1989 0         0 $options{'-pfmfile'} = delete $options{'pfm_file'};
1990             }
1991 0         0 return $self->psfont($name, %options);
1992             }
1993             elsif ($format eq 'bitmap') {
1994 0         0 return $self->bdfont($name, %options);
1995             }
1996             elsif ($format) {
1997 0         0 croak "Unrecognized font format: $format";
1998             }
1999             elsif ($name =~ /(\..*)$/) {
2000 0         0 croak "Unrecognized font file extension: $1";
2001             }
2002             else {
2003 0         0 croak "Unrecognized font: $name";
2004             }
2005             }
2006              
2007             =head2 synthetic_font
2008              
2009             $font = $pdf->synthetic_font($base_font, %options)
2010              
2011             Create and return a new synthetic font object. See
2012             L for details.
2013              
2014             =cut
2015              
2016             # Deprecated (renamed)
2017 0     0 1 0 sub synfont { return synthetic_font(@_) }
2018              
2019             sub synthetic_font {
2020 0     0 1 0 my ($self, $font, %opts) = @_;
2021              
2022             # PDF::API2 doesn't set BaseEncoding for TrueType fonts, so text
2023             # isn't searchable unless a ToUnicode CMap is included. Include
2024             # the ToUnicode CMap by default, but allow it to be disabled (for
2025             # performance and file size reasons) by setting -unicodemap to 0.
2026 0 0       0 $opts{-unicodemap} = 1 unless exists $opts{-unicodemap};
2027              
2028 0         0 require PDF::API2::Resource::Font::SynFont;
2029 0         0 my $obj = PDF::API2::Resource::Font::SynFont->new($self->{'pdf'}, $font, %opts);
2030              
2031 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2032 0 0       0 $obj->tounicodemap() if $opts{-unicodemap};
2033              
2034 0         0 return $obj;
2035             }
2036              
2037             =head2 font_path
2038              
2039             @directories = PDF::API2->font_path()
2040              
2041             Return the list of directories that will be searched (in order) in addition to
2042             the current directory when you add a font to a PDF without including the full
2043             path to the font file.
2044              
2045             =cut
2046              
2047             sub font_path {
2048 0     0 1 0 return @font_path;
2049             }
2050              
2051             =head2 add_to_font_path
2052              
2053             @directories = PDF::API2->add_to_font_path('/my/fonts', '/path/to/fonts');
2054              
2055             Add one or more directories to the list of paths to be searched for font files.
2056              
2057             Returns the font search path.
2058              
2059             =cut
2060              
2061             # Deprecated (renamed)
2062 0     0 1 0 sub addFontDirs { return add_to_font_path(@_) }
2063              
2064             sub add_to_font_path {
2065             # Allow this method to be called using either :: or -> notation.
2066 0 0   0 1 0 shift() if ref($_[0]);
2067 0 0       0 shift() if $_[0] eq __PACKAGE__;
2068              
2069 0         0 push @font_path, @_;
2070 0         0 return @font_path;
2071             }
2072              
2073             =head2 set_font_path
2074              
2075             @directories = PDF::API2->set_font_path('/my/fonts', '/path/to/fonts');
2076              
2077             Replace the existing font search path. This should only be necessary if you
2078             need to remove a directory from the path for some reason, or if you need to
2079             reorder the list.
2080              
2081             Returns the font search path.
2082              
2083             =cut
2084              
2085             sub set_font_path {
2086             # Allow this method to be called using either :: or -> notation.
2087 38 50   38 1 265 shift() if ref($_[0]);
2088 38 50       290 shift() if $_[0] eq __PACKAGE__;
2089              
2090 38         164 @font_path = ((map { "$_/PDF/API2/fonts" } @INC), @_);
  418         1132  
2091              
2092 38         196 return @font_path;
2093             }
2094              
2095             sub _find_font {
2096 0     0   0 my $font = shift();
2097              
2098             # Check the current directory
2099 0 0       0 return $font if -f $font;
2100              
2101             # Check the font search path
2102 0         0 foreach my $directory (@font_path) {
2103 0 0       0 return "$directory/$font" if -f "$directory/$font";
2104             }
2105              
2106 0         0 return;
2107             }
2108              
2109             sub corefont {
2110 53     53 1 28118 my ($self, $name, %opts) = @_;
2111 53         4414 require PDF::API2::Resource::Font::CoreFont;
2112 53         410 my $obj = PDF::API2::Resource::Font::CoreFont->new($self->{'pdf'}, $name, %opts);
2113 53         484 $self->{'pdf'}->out_obj($self->{'pages'});
2114 53 50       170 $obj->tounicodemap() if $opts{-unicodemap};
2115 53         562 return $obj;
2116             }
2117              
2118             sub psfont {
2119 0     0 1 0 my ($self, $psf, %opts) = @_;
2120              
2121 0         0 foreach my $o (qw(-afmfile -pfmfile)) {
2122 0 0       0 next unless defined $opts{$o};
2123 0         0 $opts{$o} = _find_font($opts{$o});
2124             }
2125 0 0       0 $psf = _find_font($psf) or croak "Unable to find font \"$psf\"";
2126 0         0 require PDF::API2::Resource::Font::Postscript;
2127 0         0 my $obj = PDF::API2::Resource::Font::Postscript->new($self->{'pdf'}, $psf, %opts);
2128              
2129 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2130 0 0       0 $obj->tounicodemap() if $opts{-unicodemap};
2131              
2132 0         0 return $obj;
2133             }
2134              
2135             sub ttfont {
2136 0     0 1 0 my ($self, $name, %opts) = @_;
2137              
2138             # PDF::API2 doesn't set BaseEncoding for TrueType fonts, so text
2139             # isn't searchable unless a ToUnicode CMap is included. Include
2140             # the ToUnicode CMap by default, but allow it to be disabled (for
2141             # performance and file size reasons) by setting -unicodemap to 0.
2142 0 0       0 $opts{-unicodemap} = 1 unless exists $opts{-unicodemap};
2143              
2144             # -noembed is deprecated (replace with embed => 0)
2145 0 0       0 if ($opts{'-noembed'}) {
2146 0   0     0 $opts{'embed'} //= 1;
2147             }
2148 0   0     0 $opts{'embed'} //= 1;
2149              
2150 0 0       0 my $file = _find_font($name) or croak "Unable to find font \"$name\"";
2151 0         0 require PDF::API2::Resource::CIDFont::TrueType;
2152 0         0 my $obj = PDF::API2::Resource::CIDFont::TrueType->new($self->{'pdf'}, $file, %opts);
2153              
2154 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2155 0 0       0 $obj->tounicodemap() if $opts{-unicodemap};
2156              
2157 0         0 return $obj;
2158             }
2159              
2160             sub bdfont {
2161 0     0 1 0 my ($self, @opts) = @_;
2162              
2163 0         0 require PDF::API2::Resource::Font::BdFont;
2164 0         0 my $obj = PDF::API2::Resource::Font::BdFont->new($self->{'pdf'}, @opts);
2165              
2166 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2167             # $obj->tounicodemap(); # does not support Unicode
2168              
2169 0         0 return $obj;
2170             }
2171              
2172             # Deprecated. Use Unicode-supporting TrueType fonts instead.
2173             # See PDF::API2::Resource::CIDFont::CJKFont for details.
2174             sub cjkfont {
2175 1     1 1 9 my ($self, $name, %opts) = @_;
2176              
2177 1         617 require PDF::API2::Resource::CIDFont::CJKFont;
2178 1         14 my $obj = PDF::API2::Resource::CIDFont::CJKFont->new($self->{'pdf'}, $name, %opts);
2179              
2180 1         10 $self->{'pdf'}->out_obj($self->{'pages'});
2181 1 50       4 $obj->tounicodemap() if $opts{-unicodemap};
2182              
2183 1         5 return $obj;
2184             }
2185              
2186             # Deprecated. Use Unicode-supporting TrueType fonts instead.
2187             sub unifont {
2188 1     1 1 25 my ($self, @opts) = @_;
2189              
2190 1         550 require PDF::API2::Resource::UniFont;
2191 1         11 my $obj = PDF::API2::Resource::UniFont->new($self->{'pdf'}, @opts);
2192              
2193 1         5 return $obj;
2194             }
2195              
2196             =head1 GRAPHICS METHODS
2197              
2198             =head2 image
2199              
2200             $object = $pdf->image($file, %options);
2201              
2202             Import a supported image type and return an object that can be placed as part of
2203             a page's content:
2204              
2205             my $pdf = PDF::API2->new();
2206             my $page = $pdf->page();
2207              
2208             my $image = $pdf->image('/path/to/image.jpg');
2209             $page->object($image, 100, 100);
2210              
2211             $pdf->save('sample.pdf');
2212              
2213             C<$file> may be either a file name, a filehandle, or a L object.
2214              
2215             See L for details about placing images on a page
2216             once they're imported.
2217              
2218             The image format is normally detected automatically based on the file's
2219             extension. If passed a filehandle, image formats GIF, JPEG, and PNG will be
2220             detected based on the file's header.
2221              
2222             If the file has an atypical extension or the filehandle is for a different kind
2223             of image, you can set the C option to one of the supported types:
2224             C, C, C, C, or C.
2225              
2226             Note: PNG images that include an alpha (transparency) channel go through a
2227             relatively slow process of splitting the image into separate RGB and alpha
2228             components as is required by images in PDFs. If you're having performance
2229             issues, install PDF::API2::XS or Image::PNG::Libpng to speed this process up by
2230             an order of magnitude; either module will be used automatically if available.
2231              
2232             =cut
2233              
2234             sub image {
2235 3     3 1 305 my ($self, $file, %options) = @_;
2236              
2237 3   50     30 my $format = lc($options{'format'} // '');
2238              
2239 3 50       27 if (ref($file) eq 'GD::Image') {
    50          
2240 0         0 return image_gd($file, %options);
2241             }
2242             elsif (ref($file)) {
2243 3   33     25 $format ||= _detect_image_format($file);
2244             }
2245 3 50       15 unless (ref($file)) {
2246 0 0 0     0 $format ||= ($file =~ /\.jpe?g$/i ? 'jpeg' :
    0          
    0          
    0          
    0          
2247             $file =~ /\.png$/i ? 'png' :
2248             $file =~ /\.gif$/i ? 'gif' :
2249             $file =~ /\.tiff?$/i ? 'tiff' :
2250             $file =~ /\.p[bgp]m$/i ? 'pnm' : '');
2251             }
2252              
2253 3 100       20 if ($format eq 'jpeg') {
    100          
    50          
    0          
    0          
    0          
    0          
    0          
2254 1         8 return $self->image_jpeg($file, %options);
2255             }
2256             elsif ($format eq 'png') {
2257 1         8 return $self->image_png($file, %options);
2258             }
2259             elsif ($format eq 'gif') {
2260 1         5 return $self->image_gif($file, %options);
2261             }
2262             elsif ($format eq 'tiff') {
2263 0         0 return $self->image_tiff($file, %options);
2264             }
2265             elsif ($format eq 'pnm') {
2266 0         0 return $self->image_pnm($file, %options);
2267             }
2268             elsif ($format) {
2269 0         0 croak "Unrecognized image format: $format";
2270             }
2271             elsif (ref($file)) {
2272 0         0 croak "Unspecified image format";
2273             }
2274             elsif ($file =~ /(\..*)$/) {
2275 0         0 croak "Unrecognized image extension: $1";
2276             }
2277             else {
2278 0         0 croak "Unrecognized image: $file";
2279             }
2280             }
2281              
2282             sub _detect_image_format {
2283 3     3   7 my $fh = shift();
2284 3         37 $fh->seek(0, 0);
2285 3         68 binmode $fh, ':raw';
2286              
2287 3         7 my $test;
2288 3         25 my $bytes_read = $fh->read($test, 8);
2289 3         116 $fh->seek(0, 0);
2290 3 50 33     99 return unless $bytes_read and $bytes_read == 8;
2291              
2292 3 100       22 return 'gif' if $test =~ /^GIF\d\d[a-z]/;
2293 2 100       14 return 'jpeg' if $test =~ /^\xFF\xD8\xFF/;
2294 1 50       12 return 'png' if $test =~ /^\x89PNG\x0D\x0A\x1A\x0A/;
2295 0         0 return;
2296             }
2297              
2298             sub image_jpeg {
2299 3     3 1 23 my ($self, $file, %opts) = @_;
2300              
2301 3         702 require PDF::API2::Resource::XObject::Image::JPEG;
2302 3         35 my $obj = PDF::API2::Resource::XObject::Image::JPEG->new($self->{'pdf'}, $file);
2303              
2304 2         15 $self->{'pdf'}->out_obj($self->{'pages'});
2305              
2306 2         27 return $obj;
2307             }
2308              
2309             sub image_tiff {
2310 4     4 1 71 my ($self, $file, %opts) = @_;
2311              
2312 4         518 require PDF::API2::Resource::XObject::Image::TIFF;
2313 4         30 my $obj = PDF::API2::Resource::XObject::Image::TIFF->new($self->{'pdf'}, $file);
2314              
2315 3         16 $self->{'pdf'}->out_obj($self->{'pages'});
2316              
2317 3         23 return $obj;
2318             }
2319              
2320             sub image_pnm {
2321 3     3 1 70 my ($self, $file, %opts) = @_;
2322              
2323 3   66     17 $opts{'-compress'} //= $self->{'forcecompress'};
2324              
2325 3         524 require PDF::API2::Resource::XObject::Image::PNM;
2326 3         26 my $obj = PDF::API2::Resource::XObject::Image::PNM->new($self->{'pdf'}, $file, %opts);
2327              
2328 2         11 $self->{'pdf'}->out_obj($self->{'pages'});
2329              
2330 2         18 return $obj;
2331             }
2332              
2333             sub image_png {
2334 5     5 1 34 my ($self, $file, %opts) = @_;
2335              
2336 5         625 require PDF::API2::Resource::XObject::Image::PNG;
2337 5         60 my $obj = PDF::API2::Resource::XObject::Image::PNG->new($self->{'pdf'}, $file);
2338              
2339 4         63 $self->{'pdf'}->out_obj($self->{'pages'});
2340              
2341 4         69 return $obj;
2342             }
2343              
2344             sub image_gif {
2345 3     3 1 16 my ($self, $file, %opts) = @_;
2346              
2347 3         503 require PDF::API2::Resource::XObject::Image::GIF;
2348 3         25 my $obj = PDF::API2::Resource::XObject::Image::GIF->new($self->{'pdf'}, $file);
2349              
2350 2         11 $self->{'pdf'}->out_obj($self->{'pages'});
2351              
2352 2         19 return $obj;
2353             }
2354              
2355             sub image_gd {
2356 0     0 1 0 my ($self, $gd, %opts) = @_;
2357              
2358 0         0 require PDF::API2::Resource::XObject::Image::GD;
2359 0         0 my $obj = PDF::API2::Resource::XObject::Image::GD->new($self->{'pdf'}, $gd, undef, %opts);
2360              
2361 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2362              
2363 0         0 return $obj;
2364             }
2365              
2366             =head2 barcode
2367              
2368             $object = $pdf->barcode($format, $code, %options);
2369              
2370             Generate and return a barcode that can be placed as part of a page's content:
2371              
2372             my $pdf = PDF::API2->new();
2373             my $page = $pdf->page();
2374              
2375             my $barcode = $pdf->barcode('ean13', '0123456789012');
2376             $page->object($barcode, 100, 100);
2377              
2378             $pdf->save('sample.pdf');
2379              
2380             C<$format> can be one of C, C, C (a.k.a. 3 of 9),
2381             C, C, or C (a.k.a. interleaved 2 of 5).
2382              
2383             C<$code> is the value to be encoded. Start and stop characters are only
2384             required when they're not static (e.g. for Codabar).
2385              
2386             The following options are available:
2387              
2388             =over
2389              
2390             =item * bar_width
2391              
2392             The width of the smallest bar or space in points (72 points = 1 inch).
2393              
2394             If you're following a specification that gives bar width in mils (thousandths of
2395             an inch), use this conversion: C<$points = $mils / 1000 * 72>.
2396              
2397             =item * bar_height
2398              
2399             The base height of the barcode in points.
2400              
2401             =item * bar_extend
2402              
2403             If present, bars for non-printing characters (e.g. start and stop characters)
2404             will be extended downward by this many points, and printing characters will be
2405             shown below their respective bars.
2406              
2407             This is enabled by default for EAN-13 barcodes.
2408              
2409             =item * caption
2410              
2411             If present, this value will be printed, centered, beneath the barcode, and
2412             should be a human-readable representation of the barcode.
2413              
2414             =item * font
2415              
2416             A font object (created by L) that will be used to print the caption, or
2417             the printable characters when C is set.
2418              
2419             Helvetica will be used by default.
2420              
2421             =item * font_size
2422              
2423             The size of the font used for printing the caption or printable characters.
2424              
2425             The default will be calculated based on the barcode size, if C is
2426             set, or 10 otherwise.
2427              
2428             =item * quiet_zone
2429              
2430             A margin, in points, that will be place before the left and bottom edges of the
2431             barcode (including the caption, if present). This is used to help barcode
2432             scanners tell where the barcode begins and ends.
2433              
2434             The default is the width of one encoded character.
2435              
2436             =item * bar_overflow
2437              
2438             Shrinks the horizontal width of bars by this amount in points to account for ink
2439             spread when printing.
2440              
2441             The default is 0.01 points.
2442              
2443             =item * color
2444              
2445             Draw bars using this color, which may be any value accepted by
2446             L.
2447              
2448             The default is black.
2449              
2450             =back
2451              
2452             =cut
2453              
2454             sub barcode {
2455 0     0 1 0 my ($self, $format, $value, %options) = @_;
2456 0 0       0 croak "Missing barcode format" unless defined $format;
2457 0 0       0 croak "Missing barcode value" unless defined $value;
2458              
2459             # Set defaults to approximately the minimums for each barcode format.
2460 0 0 0     0 if ($format eq 'codabar') {
    0 0        
    0          
    0          
2461 0   0     0 $options{'bar_width'} //= 1.8; # 0.025"
2462 0   0     0 $options{'bar_extend'} //= 0;
2463 0   0     0 $options{'quiet_zone'} //= 10 * $options{'bar_width'};
2464 0 0       0 if ($options{'bar_extend'}) {
2465 0   0     0 $options{'font_size'} //= 9 * $options{'bar_width'};
2466             }
2467              
2468             # Minimum height is the larger of 0.25" or 15% of barcode length.
2469 0         0 my $length = (10 * length($value) + 2) * $options{'bar_width'};
2470 0   0     0 $options{'bar_height'} //= max(18, $length * 0.15);
2471             }
2472             elsif ($format eq 'code128' or $format eq 'ean128' or $format eq 'code39') {
2473 0   0     0 $options{'bar_width'} //= 1;
2474 0   0     0 $options{'bar_extend'} //= 0;
2475 0   0     0 $options{'quiet_zone'} //= 11 * $options{'bar_width'};
2476 0 0       0 if ($options{'bar_extend'}) {
2477 0   0     0 $options{'font_size'} //= 10 * $options{'bar_width'};
2478             }
2479              
2480             # Minimum height is the larger of 0.5" or 15% of barcode length.
2481 0         0 my $length = 11 * (length($value) + 1) * $options{'bar_width'};
2482 0   0     0 $options{'bar_height'} //= max(36, $length * 0.15);
2483             }
2484             elsif ($format eq 'itf') {
2485 0   0     0 $options{'bar_width'} //= 1;
2486 0   0     0 $options{'bar_height'} //= 40;
2487 0   0     0 $options{'bar_extend'} //= 0;
2488 0   0     0 $options{'quiet_zone'} //= 10 * $options{'bar_width'};
2489 0 0       0 if ($options{'bar_extend'}) {
2490 0   0     0 $options{'font_size'} //= 9 * $options{'bar_width'};
2491             }
2492             }
2493             elsif ($format eq 'ean13') {
2494 0   0     0 $options{'bar_width'} //= 1;
2495 0   0     0 $options{'bar_height'} //= 64.8;
2496 0   0     0 $options{'quiet_zone'} //= 11 * $options{'bar_width'};
2497 0 0       0 unless ($options{'caption'}) {
2498 0   0     0 $options{'bar_extend'} //= 5 * $options{'bar_width'};
2499             }
2500 0 0       0 if ($options{'bar_extend'}) {
2501 0   0     0 $options{'font_size'} //= 10 * $options{'bar_width'};
2502             }
2503             }
2504             else {
2505 0         0 croak "Unrecognized barcode format: $format";
2506             }
2507              
2508 0 0       0 if (exists $options{'caption'}) {
2509 0   0     0 $options{'font_size'} //= 10;
2510             }
2511 0 0 0     0 if ($options{'bar_extend'} or $options{'font_size'}) {
2512 0   0     0 $options{'font'} //= $self->font('Helvetica');
2513             }
2514              
2515             # Convert from new arguments to old arguments
2516 0         0 $options{'-color'} = delete $options{'color'};
2517 0         0 $options{'-fnsz'} = delete $options{'font_size'};
2518 0         0 $options{'-font'} = delete $options{'font'};
2519 0         0 $options{'-lmzn'} = delete $options{'bar_extend'};
2520 0         0 $options{'-mils'} = (delete $options{'bar_width'}) * 1000 / 72;
2521 0         0 $options{'-ofwt'} = delete $options{'bar_overflow'};
2522 0         0 $options{'-quzn'} = delete $options{'quiet_zone'};
2523 0         0 $options{'-zone'} = delete $options{'bar_height'};
2524              
2525 0 0       0 if ($format eq 'codabar') {
    0          
    0          
    0          
    0          
    0          
2526 0         0 return $self->xo_codabar(%options, -code => $value);
2527             }
2528             elsif ($format eq 'code128') {
2529 0         0 return $self->xo_code128(%options, -code => $value);
2530             }
2531             elsif ($format eq 'code39') {
2532 0         0 return $self->xo_3of9(%options, -code => $value);
2533             }
2534             elsif ($format eq 'ean128') {
2535 0         0 return $self->xo_code128(%options, -code => $value, -ean => 1);
2536             }
2537             elsif ($format eq 'ean13') {
2538 0         0 return $self->xo_ean13(%options, -code => $value);
2539             }
2540             elsif ($format eq 'itf') {
2541 0         0 return $self->xo_2of5int(%options, -code => $value);
2542             }
2543             }
2544              
2545             sub xo_code128 {
2546 1     1 1 593 my ($self, @opts) = @_;
2547              
2548 1         588 require PDF::API2::Resource::XObject::Form::BarCode::code128;
2549 1         6 my $obj = PDF::API2::Resource::XObject::Form::BarCode::code128->new($self->{'pdf'}, @opts);
2550              
2551 1         5 $self->{'pdf'}->out_obj($self->{'pages'});
2552              
2553 1         14 return $obj;
2554             }
2555              
2556             sub xo_codabar {
2557 1     1 1 8 my ($self, @opts) = @_;
2558              
2559 1         503 require PDF::API2::Resource::XObject::Form::BarCode::codabar;
2560 1         12 my $obj = PDF::API2::Resource::XObject::Form::BarCode::codabar->new($self->{'pdf'}, @opts);
2561              
2562 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2563              
2564 1         4 return $obj;
2565             }
2566              
2567             sub xo_2of5int {
2568 1     1 1 399 my ($self, @opts) = @_;
2569              
2570 1         579 require PDF::API2::Resource::XObject::Form::BarCode::int2of5;
2571 1         8 my $obj = PDF::API2::Resource::XObject::Form::BarCode::int2of5->new($self->{'pdf'}, @opts);
2572              
2573 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2574              
2575 1         3 return $obj;
2576             }
2577              
2578             sub xo_3of9 {
2579 2     2 1 393 my ($self, @opts) = @_;
2580              
2581 2         595 require PDF::API2::Resource::XObject::Form::BarCode::code3of9;
2582 2         22 my $obj = PDF::API2::Resource::XObject::Form::BarCode::code3of9->new($self->{'pdf'}, @opts);
2583              
2584 2         11 $self->{'pdf'}->out_obj($self->{'pages'});
2585              
2586 2         6 return $obj;
2587             }
2588              
2589             sub xo_ean13 {
2590 1     1 1 457 my ($self, @opts) = @_;
2591              
2592 1         559 require PDF::API2::Resource::XObject::Form::BarCode::ean13;
2593 1         8 my $obj = PDF::API2::Resource::XObject::Form::BarCode::ean13->new($self->{'pdf'}, @opts);
2594              
2595 1         6 $self->{'pdf'}->out_obj($self->{'pages'});
2596              
2597 1         3 return $obj;
2598             }
2599              
2600             =head2 colorspace
2601              
2602             $colorspace = $pdf->colorspace($type, @arguments);
2603              
2604             Colorspaces can be added to a PDF to either specifically control the output
2605             color on a particular device (spot colors, device colors) or to save space by
2606             limiting the available colors to a defined color palette (web-safe palette, ACT
2607             file).
2608              
2609             Once added to the PDF, they can be used in place of regular hex codes or named
2610             colors:
2611              
2612             my $pdf = PDF::API2->new();
2613             my $page = $pdf->page();
2614             my $content = $page->graphics();
2615              
2616             # Add colorspaces for a spot color and the web-safe color palette
2617             my $spot = $pdf->colorspace('spot', 'PANTONE Red 032 C', '#EF3340');
2618             my $web = $pdf->colorspace('web');
2619              
2620             # Fill using the spot color with 100% coverage
2621             $content->fill_color($spot, 1.0);
2622              
2623             # Stroke using the first color of the web-safe palette
2624             $content->stroke_color($web, 0);
2625              
2626             # Add a rectangle to the page
2627             $content->rectangle(100, 100, 200, 200);
2628             $content->paint();
2629              
2630             $pdf->save('sample.pdf');
2631              
2632             The following types of colorspaces are supported
2633              
2634             =over
2635              
2636             =item * spot
2637              
2638             my $spot = $pdf->colorspace('spot', $tint, $alt_color);
2639              
2640             Spot colors are used to instruct a device (usually a printer) to use or emulate
2641             a particular ink color (C<$tint>) for parts of the document. An C<$alt_color>
2642             is provided for devices (e.g. PDF viewers) that don't know how to produce the
2643             named color. It can either be an approximation of the color in RGB, CMYK, or
2644             HSV formats, or a wildly different color (e.g. 100% magenta, C<%0F00>) to make
2645             it clear if the spot color isn't being used as expected.
2646              
2647             =item * web
2648              
2649             my $web = $pdf->colorspace('web');
2650              
2651             The web-safe color palette is a historical collection of colors that was used
2652             when many display devices only supported 256 colors.
2653              
2654             =item * act
2655              
2656             my $act = $pdf->colorspace('act', $filename);
2657              
2658             An Adobe Color Table (ACT) file provides a custom palette of colors that can be
2659             referenced by PDF graphics and text drawing commands.
2660              
2661             =item * device
2662              
2663             my $devicen = $pdf->colorspace('device', @colorspaces);
2664              
2665             A device-specific colorspace allows for precise color output on a given device
2666             (typically a printing press), bypassing the normal color interpretation
2667             performed by raster image processors (RIPs).
2668              
2669             Device colorspaces are also needed if you want to blend spot colors:
2670              
2671             my $pdf = PDF::API2->new();
2672             my $page = $pdf->page();
2673             my $content = $page->graphics();
2674              
2675             # Create a two-color device colorspace
2676             my $yellow = $pdf->colorspace('spot', 'Yellow', '%00F0');
2677             my $spot = $pdf->colorspace('spot', 'PANTONE Red 032 C', '#EF3340');
2678             my $device = $pdf->colorspace('device', $yellow, $spot);
2679              
2680             # Fill using a blend of 25% yellow and 75% spot color
2681             $content->fill_color($device, 0.25, 0.75);
2682              
2683             # Stroke using 100% spot color
2684             $content->stroke_color($device, 0, 1);
2685              
2686             # Add a rectangle to the page
2687             $content->rectangle(100, 100, 200, 200);
2688             $content->paint();
2689              
2690             $pdf->save('sample.pdf');
2691              
2692             =back
2693              
2694             =cut
2695              
2696             sub colorspace {
2697 0     0 1 0 my $self = shift();
2698 0         0 my $type = shift();
2699              
2700 0 0       0 if ($type eq 'act') {
    0          
    0          
    0          
    0          
2701 0         0 my $file = shift();
2702 0         0 return $self->colorspace_act($file);
2703             }
2704             elsif ($type eq 'web') {
2705 0         0 return $self->colorspace_web();
2706             }
2707             elsif ($type eq 'hue') {
2708             # This type is undocumented until either a reference can be found for
2709             # this being a standard palette like the web color palette, or POD is
2710             # added to the Hue colorspace class that describes how to use it.
2711 0         0 return $self->colorspace_hue();
2712             }
2713             elsif ($type eq 'spot') {
2714 0         0 my $name = shift();
2715 0         0 my $alt_color = shift();
2716 0         0 return $self->colorspace_separation($name, $alt_color);
2717             }
2718             elsif ($type eq 'device') {
2719 0         0 my @colors = @_;
2720 0         0 return $self->colorspace_devicen(\@colors);
2721             }
2722             else {
2723 0         0 croak "Unrecognized or unsupported colorspace: $type";
2724             }
2725             }
2726              
2727             sub colorspace_act {
2728 0     0 1 0 my ($self, $file) = @_;
2729              
2730 0         0 require PDF::API2::Resource::ColorSpace::Indexed::ACTFile;
2731 0         0 return PDF::API2::Resource::ColorSpace::Indexed::ACTFile->new($self->{'pdf'},
2732             $file);
2733             }
2734              
2735             sub colorspace_web {
2736 1     1 1 8 my $self = shift();
2737              
2738 1         472 require PDF::API2::Resource::ColorSpace::Indexed::WebColor;
2739 1         12 return PDF::API2::Resource::ColorSpace::Indexed::WebColor->new($self->{'pdf'});
2740             }
2741              
2742             sub colorspace_hue {
2743 0     0 1 0 my $self = shift();
2744              
2745 0         0 require PDF::API2::Resource::ColorSpace::Indexed::Hue;
2746 0         0 return PDF::API2::Resource::ColorSpace::Indexed::Hue->new($self->{'pdf'});
2747             }
2748              
2749             sub colorspace_separation {
2750 0     0 1 0 my ($self, $name, @clr) = @_;
2751              
2752 0         0 require PDF::API2::Resource::ColorSpace::Separation;
2753 0         0 return PDF::API2::Resource::ColorSpace::Separation->new($self->{'pdf'},
2754             pdfkey(),
2755             $name,
2756             @clr);
2757             }
2758              
2759             sub colorspace_devicen {
2760 0     0 1 0 my ($self, $clrs) = @_;
2761              
2762 0         0 require PDF::API2::Resource::ColorSpace::DeviceN;
2763 0         0 return PDF::API2::Resource::ColorSpace::DeviceN->new($self->{'pdf'},
2764             pdfkey(),
2765             $clrs);
2766             }
2767              
2768             =head2 egstate
2769              
2770             $resource = $pdf->egstate();
2771              
2772             Creates and returns a new extended graphics state object, described in
2773             L.
2774              
2775             =cut
2776              
2777             sub egstate {
2778 3     3 1 16 my $self = shift();
2779              
2780 3         20 my $obj = PDF::API2::Resource::ExtGState->new($self->{'pdf'}, pdfkey());
2781              
2782 3         14 $self->{'pdf'}->out_obj($self->{'pages'});
2783              
2784 3         14 return $obj;
2785             }
2786              
2787             sub default {
2788 8     8 1 25 my ($self, $parameter, $value) = @_;
2789              
2790             # Parameter names may consist of lowercase letters, numbers, and underscores
2791 8         20 $parameter = lc $parameter;
2792 8         32 $parameter =~ s/[^a-z\d_]//g;
2793              
2794 8         18 my $previous_value = $self->{$parameter};
2795 8 100       22 if (defined $value) {
2796 2         6 $self->{$parameter} = $value;
2797             }
2798 8         24 return $previous_value;
2799             }
2800              
2801             sub xo_form {
2802 4     4 0 8 my $self = shift();
2803              
2804 4         98 my $obj = PDF::API2::Resource::XObject::Form::Hybrid->new($self->{'pdf'});
2805              
2806 4         19 $self->{'pdf'}->out_obj($self->{'pages'});
2807              
2808 4         9 return $obj;
2809             }
2810              
2811             sub pattern {
2812 0     0 0 0 my ($self, %opts) = @_;
2813              
2814 0         0 my $obj = PDF::API2::Resource::Pattern->new($self->{'pdf'}, undef, %opts);
2815              
2816 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2817              
2818 0         0 return $obj;
2819             }
2820              
2821             sub shading {
2822 0     0 0 0 my ($self, %opts) = @_;
2823              
2824 0         0 my $obj = PDF::API2::Resource::Shading->new($self->{'pdf'}, undef, %opts);
2825              
2826 0         0 $self->{'pdf'}->out_obj($self->{'pages'});
2827              
2828 0         0 return $obj;
2829             }
2830              
2831             sub named_destination {
2832 0     0 0 0 my ($self, $cat, $name, $obj) = @_;
2833 0         0 my $root = $self->{'catalog'};
2834              
2835 0   0     0 $root->{'Names'} ||= PDFDict();
2836 0   0     0 $root->{'Names'}->{$cat} ||= PDFDict();
2837 0   0     0 $root->{'Names'}->{$cat}->{'-vals'} ||= {};
2838 0   0     0 $root->{'Names'}->{$cat}->{'Limits'} ||= PDFArray();
2839 0   0     0 $root->{'Names'}->{$cat}->{'Names'} ||= PDFArray();
2840              
2841 0 0       0 unless (defined $obj) {
2842 0         0 $obj = PDF::API2::NamedDestination->new($self->{'pdf'});
2843             }
2844 0         0 $root->{'Names'}->{$cat}->{'-vals'}->{$name} = $obj;
2845              
2846 0         0 my @names = sort {$a cmp $b} keys %{$root->{'Names'}->{$cat}->{'-vals'}};
  0         0  
  0         0  
2847              
2848 0         0 $root->{'Names'}->{$cat}->{'Limits'}->{' val'}->[0] = PDFStr($names[0]);
2849 0         0 $root->{'Names'}->{$cat}->{'Limits'}->{' val'}->[1] = PDFStr($names[-1]);
2850              
2851 0         0 @{$root->{'Names'}->{$cat}->{'Names'}->{' val'}} = ();
  0         0  
2852              
2853 0         0 foreach my $k (@names) {
2854 0         0 push @{$root->{'Names'}->{$cat}->{'Names'}->{' val'}}, (
2855             PDFStr($k),
2856 0         0 $root->{'Names'}->{$cat}->{'-vals'}->{$k}
2857             );
2858             }
2859              
2860 0         0 return $obj;
2861             }
2862              
2863             1;
2864              
2865             __END__